summaryrefslogtreecommitdiffstats
path: root/unix
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2001-07-31 19:12:05 (GMT)
committervincentdarley <vincentdarley>2001-07-31 19:12:05 (GMT)
commitc1335a91a0a2d1b2b776c7bbb5763b90e3d629ad (patch)
tree1ec44ca71eb2e561881490f7766175daa65dc9eb /unix
parent2414705dd748a119ffa0a2976ed71abc283aff11 (diff)
downloadtcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.zip
tcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.tar.gz
tcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.tar.bz2
Changes from TIP#17 "Redo Tcl's filesystem"
The following files were impacted. * doc/Access.3: * doc/FileSystem.3: * doc/OpenFileChnl.3: * doc/file.n: * doc/glob.n: * generic/tcl.decls: * generic/tcl.h: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclDate.c: * generic/tclDecls.h: * generic/tclEncoding.c: * generic/tclFCmd.c: * generic/tclFileName.c: * generic/tclGetDate.y: * generic/tclIO.c: * generic/tclIOCmd.c: * generic/tclIOUtil.c: * generic/tclInt.decls: * generic/tclInt.h: * generic/tclIntDecls.h: * generic/tclLoad.c: * generic/tclStubInit.c: * generic/tclTest.c: * generic/tclUtil.c: * library/init.tcl: * mac/tclMacFCmd.c: * mac/tclMacFile.c: * mac/tclMacInit.c: * mac/tclMacPort.h: * mac/tclMacResource.c: * mac/tclMacTime.c: * tests/cmdAH.test: * tests/event.test: * tests/fCmd.test: * tests/fileName.test: * tests/io.test: * tests/ioCmd.test: * tests/proc-old.test: * tests/registry.test: * tests/unixFCmd.test: * tests/winDde.test: * tests/winFCmd.test: * unix/mkLinks: * unix/tclUnixFCmd.c: * unix/tclUnixFile.c: * unix/tclUnixInit.c: * unix/tclUnixPipe.c: * win/tclWinFCmd.c: * win/tclWinFile.c: * win/tclWinInit.c: * win/tclWinPipe.c
Diffstat (limited to 'unix')
-rw-r--r--unix/mkLinks72
-rw-r--r--unix/tclUnixFCmd.c118
-rw-r--r--unix/tclUnixFile.c340
-rw-r--r--unix/tclUnixInit.c247
-rw-r--r--unix/tclUnixPipe.c30
5 files changed, 553 insertions, 254 deletions
diff --git a/unix/mkLinks b/unix/mkLinks
index 1b57e15..fa82057 100644
--- a/unix/mkLinks
+++ b/unix/mkLinks
@@ -442,6 +442,74 @@ if test -r ExprLongObj.3; then
ln ExprLongObj.3 Tcl_ExprBooleanObj.3
ln ExprLongObj.3 Tcl_ExprObj.3
fi
+if test -r FileSystem.3; then
+ rm -f Tcl_FSCopyFile.3
+ rm -f Tcl_FSCopyDirectory.3
+ rm -f Tcl_FSCreateDirectory.3
+ rm -f Tcl_FSDeleteFile.3
+ rm -f Tcl_FSRemoveDirectory.3
+ rm -f Tcl_FSRenameFile.3
+ rm -f Tcl_FSListVolumes.3
+ rm -f Tcl_FSEvalFile.3
+ rm -f Tcl_FSLoadFile.3
+ rm -f Tcl_FSMatchInDirectory.3
+ rm -f Tcl_FSReadlink.3
+ rm -f Tcl_FSLstat.3
+ rm -f Tcl_FSUtime.3
+ rm -f Tcl_FSFileAttrsGet.3
+ rm -f Tcl_FSFileAttrsSet.3
+ rm -f Tcl_FSFileAttrStrings.3
+ rm -f Tcl_FSStat.3
+ rm -f Tcl_FSAccess.3
+ rm -f Tcl_FSOpenFileChannel.3
+ rm -f Tcl_FSGetCwd.3
+ rm -f Tcl_FSChdir.3
+ rm -f Tcl_FSPathSeparator.3
+ rm -f Tcl_FSJoinPath.3
+ rm -f Tcl_FSSplitPath.3
+ rm -f Tcl_FSEqualPaths.3
+ rm -f Tcl_FSGetNormalizedPath.3
+ rm -f Tcl_FSJoinToPath.3
+ rm -f Tcl_FSConvertToPathType.3
+ rm -f Tcl_FSGetInternalRep.3
+ rm -f Tcl_FSGetTranslatedPath.3
+ rm -f Tcl_FSNewNativePath.3
+ rm -f Tcl_FSGetNativePath.3
+ rm -f Tcl_FSFileSystemInfo.3
+ ln FileSystem.3 Tcl_FSCopyFile.3
+ ln FileSystem.3 Tcl_FSCopyDirectory.3
+ ln FileSystem.3 Tcl_FSCreateDirectory.3
+ ln FileSystem.3 Tcl_FSDeleteFile.3
+ ln FileSystem.3 Tcl_FSRemoveDirectory.3
+ ln FileSystem.3 Tcl_FSRenameFile.3
+ ln FileSystem.3 Tcl_FSListVolumes.3
+ ln FileSystem.3 Tcl_FSEvalFile.3
+ ln FileSystem.3 Tcl_FSLoadFile.3
+ ln FileSystem.3 Tcl_FSMatchInDirectory.3
+ ln FileSystem.3 Tcl_FSReadlink.3
+ ln FileSystem.3 Tcl_FSLstat.3
+ ln FileSystem.3 Tcl_FSUtime.3
+ ln FileSystem.3 Tcl_FSFileAttrsGet.3
+ ln FileSystem.3 Tcl_FSFileAttrsSet.3
+ ln FileSystem.3 Tcl_FSFileAttrStrings.3
+ ln FileSystem.3 Tcl_FSStat.3
+ ln FileSystem.3 Tcl_FSAccess.3
+ ln FileSystem.3 Tcl_FSOpenFileChannel.3
+ ln FileSystem.3 Tcl_FSGetCwd.3
+ ln FileSystem.3 Tcl_FSChdir.3
+ ln FileSystem.3 Tcl_FSPathSeparator.3
+ ln FileSystem.3 Tcl_FSJoinPath.3
+ ln FileSystem.3 Tcl_FSSplitPath.3
+ ln FileSystem.3 Tcl_FSEqualPaths.3
+ ln FileSystem.3 Tcl_FSGetNormalizedPath.3
+ ln FileSystem.3 Tcl_FSJoinToPath.3
+ ln FileSystem.3 Tcl_FSConvertToPathType.3
+ ln FileSystem.3 Tcl_FSGetInternalRep.3
+ ln FileSystem.3 Tcl_FSGetTranslatedPath.3
+ ln FileSystem.3 Tcl_FSNewNativePath.3
+ ln FileSystem.3 Tcl_FSGetNativePath.3
+ ln FileSystem.3 Tcl_FSFileSystemInfo.3
+fi
if test -r FindExec.3; then
rm -f Tcl_FindExecutable.3
rm -f Tcl_GetNameOfExecutable.3
@@ -651,6 +719,8 @@ if test -r OpenFileChnl.3; then
rm -f Tcl_GetChannelNamesEx.3
rm -f Tcl_RegisterChannel.3
rm -f Tcl_UnregisterChannel.3
+ rm -f Tcl_DetachChannel.3
+ rm -f Tcl_IsStandardChannel.3
rm -f Tcl_Close.3
rm -f Tcl_ReadChars.3
rm -f Tcl_Read.3
@@ -676,6 +746,8 @@ if test -r OpenFileChnl.3; then
ln OpenFileChnl.3 Tcl_GetChannelNamesEx.3
ln OpenFileChnl.3 Tcl_RegisterChannel.3
ln OpenFileChnl.3 Tcl_UnregisterChannel.3
+ ln OpenFileChnl.3 Tcl_DetachChannel.3
+ ln OpenFileChnl.3 Tcl_IsStandardChannel.3
ln OpenFileChnl.3 Tcl_Close.3
ln OpenFileChnl.3 Tcl_ReadChars.3
ln OpenFileChnl.3 Tcl_Read.3
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 20998ca..e3d4d95 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixFCmd.c,v 1.6 2000/04/04 08:05:57 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.7 2001/07/31 19:12:07 vincentdarley Exp $
*
* Portions of this code were derived from NetBSD source code which has
* the following copyright notice:
@@ -150,6 +150,73 @@ static int TraverseUnixTree _ANSI_ARGS_((
Tcl_DString *sourcePtr, Tcl_DString *destPtr,
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));
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -1609,3 +1676,52 @@ GetModeFromPermString(interp, modeStringPtr, modePtr)
}
return TCL_OK;
}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjNormalizePath --
+ *
+ * This function scans through a path specification and replaces
+ * it, in place, with a normalized version. On unix, this simply
+ * ascertains where the valid path ends, and makes no change in
+ * place.
+ *
+ * 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
+ * not modified (unlike Windows, MacOS versions).
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
+ Tcl_Interp *interp;
+ Tcl_Obj *pathPtr;
+ int nextCheckpoint;
+{
+ char *path = Tcl_GetString(pathPtr);
+
+ while (1) {
+ char cur = path[nextCheckpoint];
+ if (cur == 0) {
+ break;
+ }
+ if (cur == '/') {
+ int access;
+ path[nextCheckpoint] = 0;
+ access = TclpAccess(path, F_OK);
+ path[nextCheckpoint] = '/';
+ if (access != 0) {
+ /* File doesn't exist */
+ break;
+ }
+ }
+ nextCheckpoint++;
+ }
+ return nextCheckpoint;
+}
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 2679fdb..308a320 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -9,12 +9,14 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixFile.c,v 1.9 2000/01/11 22:09:19 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.10 2001/07/31 19:12:07 vincentdarley Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
+char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *bufferPtr));
+
/*
*---------------------------------------------------------------------------
@@ -176,46 +178,49 @@ 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.
*
- *----------------------------------------------------------------------
- */
+ *---------------------------------------------------------------------- */
int
-TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types)
- Tcl_Interp *interp; /* Interpreter to receive results. */
- char *separators; /* Directory separators to pass to TclDoGlob */
- Tcl_DString *dirPtr; /* Contains path to directory to search. */
+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. */
- 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. */
+ Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+ * May be NULL. In particular the directory
+ * flag is very important. */
{
- char *native, *fname, *dirName, *patternEnd = tail;
- char savedChar = 0; /* lint. */
+ char *native, *fname, *dirName;
DIR *d;
Tcl_DString ds;
struct stat statBuf;
int matchHidden;
int result = TCL_OK;
- int baseLength = Tcl_DStringLength(dirPtr);
- Tcl_Obj *resultPtr;
+ Tcl_DString dsOrig;
+ char *fileName;
+ int baseLength;
+ fileName = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ if (fileName == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_DStringInit(&dsOrig);
+ Tcl_DStringAppend(&dsOrig, fileName, -1);
+ baseLength = Tcl_DStringLength(&dsOrig);
+
/*
* Make sure that the directory part of the name really is a
* directory. If the directory name is "", use the name "."
@@ -224,14 +229,21 @@ TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types)
* otherwise "glob foo.c" would return "./foo.c".
*/
- if (Tcl_DStringLength(dirPtr) == 0) {
+ if (baseLength == 0) {
dirName = ".";
} else {
- dirName = Tcl_DStringValue(dirPtr);
+ dirName = Tcl_DStringValue(&dsOrig);
+ /* Make sure we have a trailing directory delimiter */
+ if (dirName[baseLength-1] != '/') {
+ Tcl_DStringAppend(&dsOrig, "/", 1);
+ dirName = Tcl_DStringValue(&dsOrig);
+ baseLength++;
+ }
}
if ((TclpStat(dirName, &statBuf) != 0) /* INTL: UTF-8. */
|| !S_ISDIR(statBuf.st_mode)) {
+ Tcl_DStringFree(&dsOrig);
return TCL_OK;
}
@@ -254,6 +266,7 @@ TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types)
d = opendir(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (d == NULL) {
+ char savedChar = '\0';
Tcl_ResetResult(interp);
/*
@@ -261,39 +274,21 @@ TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types)
*/
if (baseLength > 0) {
- savedChar = (Tcl_DStringValue(dirPtr))[baseLength-1];
+ savedChar = (Tcl_DStringValue(&dsOrig))[baseLength-1];
if (savedChar == '/') {
- (Tcl_DStringValue(dirPtr))[baseLength-1] = '\0';
+ (Tcl_DStringValue(&dsOrig))[baseLength-1] = '\0';
}
}
Tcl_AppendResult(interp, "couldn't read directory \"",
- Tcl_DStringValue(dirPtr), "\": ",
+ Tcl_DStringValue(&dsOrig), "\": ",
Tcl_PosixError(interp), (char *) NULL);
if (baseLength > 0) {
- (Tcl_DStringValue(dirPtr))[baseLength-1] = savedChar;
+ (Tcl_DStringValue(&dsOrig))[baseLength-1] = savedChar;
}
+ Tcl_DStringFree(&dsOrig);
return TCL_ERROR;
}
- /*
- * Clean up the end of the pattern and the tail pointer. Leave
- * the tail pointing to the first character after the path separator
- * following the pattern, or NULL. Also, ensure that the pattern
- * is null-terminated.
- */
-
- if (*tail == '\\') {
- tail++;
- }
- if (*tail == '\0') {
- tail = NULL;
- } else {
- tail++;
- }
- savedChar = *patternEnd;
- *patternEnd = '\0';
-
- resultPtr = Tcl_GetObjResult(interp);
while (1) {
char *utf;
struct dirent *entryPtr;
@@ -328,114 +323,85 @@ TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types)
utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &ds);
if (Tcl_StringMatch(utf, pattern) != 0) {
- Tcl_DStringSetLength(dirPtr, baseLength);
- Tcl_DStringAppend(dirPtr, utf, -1);
- fname = Tcl_DStringValue(dirPtr);
- if (tail == NULL) {
- int typeOk = 1;
- if (types != NULL) {
- if (types->perm != 0) {
- struct stat buf;
-
- if (TclpStat(fname, &buf) != 0) {
- panic("stat failed on known file");
- }
- /*
- * readonly means that there are NO write permissions
- * (even for user), but execute is OK for anybody
- */
- if (
- ((types->perm & TCL_GLOB_PERM_RONLY) &&
- (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
- ((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;
- }
+ int typeOk = 1;
+
+ Tcl_DStringSetLength(&dsOrig, baseLength);
+ Tcl_DStringAppend(&dsOrig, utf, -1);
+ fname = Tcl_DStringValue(&dsOrig);
+ if (types != NULL) {
+ if (types->perm != 0) {
+ struct stat buf;
+
+ if (TclpStat(fname, &buf) != 0) {
+ panic("stat failed on known file");
}
- if (typeOk && (types->type != 0)) {
- struct stat buf;
+ /*
+ * readonly means that there are NO write permissions
+ * (even for user), but execute is OK for anybody
+ */
+ if (
+ ((types->perm & TCL_GLOB_PERM_RONLY) &&
+ (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
+ ((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;
}
+ } else {
+ /* Posix error occurred */
}
}
- if (typeOk) {
- Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(fname,
- Tcl_DStringLength(dirPtr)));
- }
- } else if ((TclpStat(fname, &statBuf) == 0)
- && S_ISDIR(statBuf.st_mode)) {
- Tcl_DStringAppend(dirPtr, "/", 1);
- result = TclDoGlob(interp, separators, dirPtr, tail, types);
- if (result != TCL_OK) {
- Tcl_DStringFree(&ds);
- break;
- }
+ }
+ if (typeOk) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
}
}
Tcl_DStringFree(&ds);
}
- *patternEnd = savedChar;
closedir(d);
+ Tcl_DStringFree(&dsOrig);
return result;
}
-/*
- * TclpMatchFiles --
- *
- * This function is now obsolete. Call the above function
- * 'TclpMatchFilesTypes' instead.
- */
-int
-TclpMatchFiles(interp, separators, dirPtr, pattern, tail)
- 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);
-}
-
/*
*---------------------------------------------------------------------------
*
@@ -693,4 +659,106 @@ TclpStat(path, bufPtr)
return result;
}
+
+int
+TclpObjLstat(pathPtr, buf)
+ Tcl_Obj *pathPtr;
+ struct stat *buf;
+{
+ char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return lstat(path, buf);
+ }
+}
+
+int
+TclpObjStat(pathPtr, buf)
+ Tcl_Obj *pathPtr;
+ struct stat *buf;
+{
+ char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return stat(path, buf);
+ }
+}
+
+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;
+{
+ char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return chdir(path);
+ }
+}
+
+int
+TclpObjAccess(pathPtr, mode)
+ Tcl_Obj *pathPtr;
+ int mode;
+{
+ char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return access(path, mode);
+ }
+}
+
+#ifdef S_IFLNK
+
+Tcl_Obj*
+TclpObjReadlink(pathPtr)
+ Tcl_Obj *pathPtr;
+{
+ char link[MAXPATHLEN];
+ int length;
+ char *native;
+ Tcl_Obj* linkPtr;
+
+ if (Tcl_FSGetTranslatedPath(NULL, pathPtr) == NULL) {
+ return NULL;
+ }
+ length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
+ if (length < 0) {
+ return NULL;
+ }
+
+ /*
+ * Allocate and copy the name, taking care since the
+ * name need not be null terminated.
+ */
+ native = (char*)ckalloc((unsigned)(1+length));
+ strncpy(native, link, (unsigned)length);
+ native[length] = '\0';
+
+ linkPtr = Tcl_FSNewNativePath(pathPtr, native);
+ Tcl_IncrRefCount(linkPtr);
+ return linkPtr;
+}
+
+#endif
+
+
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 3fd7d1f..b75acd7 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -7,7 +7,7 @@
* Copyright (c) 1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclUnixInit.c,v 1.22 2001/07/02 20:57:02 dgp Exp $
+ * RCS: @(#) $Id: tclUnixInit.c,v 1.23 2001/07/31 19:12:08 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -29,6 +29,10 @@
*/
#include "tclInitScript.h"
+/* 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;
/*
* Default directory in which to look for Tcl library scripts. The
@@ -370,13 +374,18 @@ CONST char *path; /* Path to the executable in native
* 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.
*
*---------------------------------------------------------------------------
*/
@@ -384,141 +393,147 @@ CONST char *path; /* Path to the executable in native
void
TclpSetInitialEncodings()
{
- CONST char *encoding;
- int i;
- Tcl_Obj *pathPtr;
- char *langEnv;
+ if (libraryPathEncodingFixed == 0) {
+ CONST char *encoding;
+ int i;
+ Tcl_Obj *pathPtr;
+ char *langEnv;
- /*
- * Determine the current encoding from the LC_* or LANG environment
- * variables. We previously used setlocale() to determine the locale,
- * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
- */
+ /*
+ * Determine the current encoding from the LC_* or LANG environment
+ * variables. We previously used setlocale() to determine the locale,
+ * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
+ */
- langEnv = getenv("LC_ALL");
+ langEnv = getenv("LC_ALL");
- if (langEnv == NULL || langEnv[0] == '\0') {
- langEnv = getenv("LC_CTYPE");
- }
- if (langEnv == NULL || langEnv[0] == '\0') {
- langEnv = getenv("LANG");
- }
- if (langEnv == NULL || langEnv[0] == '\0') {
- langEnv = NULL;
- }
-
- encoding = NULL;
- if (langEnv != NULL) {
- for (i = 0; localeTable[i].lang != NULL; i++) {
- if (strcmp(localeTable[i].lang, langEnv) == 0) {
- encoding = localeTable[i].encoding;
- break;
- }
+ if (langEnv == NULL || langEnv[0] == '\0') {
+ langEnv = getenv("LC_CTYPE");
+ }
+ if (langEnv == NULL || langEnv[0] == '\0') {
+ langEnv = getenv("LANG");
+ }
+ if (langEnv == NULL || langEnv[0] == '\0') {
+ langEnv = NULL;
}
- /*
- * There was no mapping in the locale table. If there is an
- * encoding subfield, we can try to guess from that.
- */
- if (encoding == NULL) {
- char *p;
- for (p = langEnv; *p != '\0'; p++) {
- if (*p == '.') {
- p++;
+ encoding = NULL;
+ if (langEnv != NULL) {
+ for (i = 0; localeTable[i].lang != NULL; i++) {
+ if (strcmp(localeTable[i].lang, langEnv) == 0) {
+ encoding = localeTable[i].encoding;
break;
}
}
- if (*p != '\0') {
- Tcl_DString ds;
- Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, p, -1);
+ /*
+ * There was no mapping in the locale table. If there is an
+ * encoding subfield, we can try to guess from that.
+ */
- encoding = Tcl_DStringValue(&ds);
- Tcl_UtfToLower(Tcl_DStringValue(&ds));
- if (Tcl_SetSystemEncoding(NULL, encoding) == TCL_OK) {
+ if (encoding == NULL) {
+ char *p;
+ for (p = langEnv; *p != '\0'; p++) {
+ if (*p == '.') {
+ p++;
+ break;
+ }
+ }
+ if (*p != '\0') {
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, p, -1);
+
+ encoding = Tcl_DStringValue(&ds);
+ Tcl_UtfToLower(Tcl_DStringValue(&ds));
+ if (Tcl_SetSystemEncoding(NULL, encoding) == TCL_OK) {
+ Tcl_DStringFree(&ds);
+ goto resetPath;
+ }
Tcl_DStringFree(&ds);
- goto resetPath;
+ encoding = NULL;
}
- Tcl_DStringFree(&ds);
- encoding = NULL;
}
}
- }
- if (encoding == NULL) {
- encoding = "iso8859-1";
- }
+ if (encoding == NULL) {
+ encoding = "iso8859-1";
+ }
- Tcl_SetSystemEncoding(NULL, encoding);
+ Tcl_SetSystemEncoding(NULL, encoding);
- resetPath:
- /*
- * Initialize the C library's locale subsystem. This is required
- * for input methods to work properly on X11. We only do this for
- * LC_CTYPE because that's the necessary one, and we don't want to
- * affect LC_TIME here. The side effect of setting the default locale
- * should be to load any locale specific modules that are needed by X.
- * [BUG: 5422 3345 4236 2522 2521].
- */
+ resetPath:
+ /*
+ * Initialize the C library's locale subsystem. This is required
+ * for input methods to work properly on X11. We only do this for
+ * LC_CTYPE because that's the necessary one, and we don't want to
+ * affect LC_TIME here. The side effect of setting the default locale
+ * should be to load any locale specific modules that are needed by X.
+ * [BUG: 5422 3345 4236 2522 2521].
+ */
- setlocale(LC_CTYPE, "");
+ setlocale(LC_CTYPE, "");
- /*
- * In case the initial locale is not "C", ensure that the numeric
- * processing is done in "C" locale regardless. This is needed because
- * Tcl relies on routines like strtod, but should not have locale
- * dependent behavior.
- */
+ /*
+ * In case the initial locale is not "C", ensure that the numeric
+ * processing is done in "C" locale regardless. This is needed because
+ * Tcl relies on routines like strtod, but should not have locale
+ * dependent behavior.
+ */
- setlocale(LC_NUMERIC, "C");
+ setlocale(LC_NUMERIC, "C");
- /*
- * Until the system encoding was actually set, the library path was
- * actually in the native multi-byte encoding, and not really UTF-8
- * as advertised. We cheated as follows:
- *
- * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
- * append the ASCII chars that make up the encoding's filename to
- * the names (in the native encoding) of directories in the library
- * path, since all Unix multi-byte encodings have ASCII in the
- * beginning.
- *
- * 2. To open the encoding file, the native bytes in the file name
- * were passed to the OS, without translating from UTF-8 to native,
- * because the name was already in the native encoding.
- *
- * Now that the system encoding was actually successfully set,
- * translate all the names in the library path to UTF-8. That way,
- * next time we search the library path, we'll translate the names
- * from UTF-8 to the system encoding which will be the native
- * encoding.
- */
+ /*
+ * Until the system encoding was actually set, the library path was
+ * actually in the native multi-byte encoding, and not really UTF-8
+ * as advertised. We cheated as follows:
+ *
+ * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
+ * append the ASCII chars that make up the encoding's filename to
+ * the names (in the native encoding) of directories in the library
+ * path, since all Unix multi-byte encodings have ASCII in the
+ * beginning.
+ *
+ * 2. To open the encoding file, the native bytes in the file name
+ * were passed to the OS, without translating from UTF-8 to native,
+ * because the name was already in the native encoding.
+ *
+ * Now that the system encoding was actually successfully set,
+ * translate all the names in the library path to UTF-8. That way,
+ * next time we search the library path, we'll translate the names
+ * from UTF-8 to the system encoding which will be the native
+ * encoding.
+ */
- pathPtr = TclGetLibraryPath();
- if (pathPtr != NULL) {
- int 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);
- }
- }
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ int 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;
- /*
- * Keep the iso8859-1 encoding preloaded. The IO package uses it for
- * gets on a binary channel.
- */
+ 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);
+ }
+ }
- Tcl_GetEncoding(NULL, "iso8859-1");
+ libraryPathEncodingFixed = 1;
+ }
+
+ /* This is only ever called from the startup thread */
+ if (binaryEncoding == NULL) {
+ /*
+ * Keep the iso8859-1 encoding preloaded. The IO package uses
+ * it for gets on a binary channel.
+ */
+ binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ }
}
/*
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 318b9c6..9da1b11 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixPipe.c,v 1.12 2001/05/15 21:23:31 hobbs Exp $
+ * RCS: @(#) $Id: tclUnixPipe.c,v 1.13 2001/07/31 19:12:08 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -221,6 +221,34 @@ TclpCreateTempFile(contents)
/*
*----------------------------------------------------------------------
*
+ * TclpTempFileName --
+ *
+ * This function returns unique filename.
+ *
+ * Results:
+ * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TclpTempFileName()
+{
+ char fileName[L_tmpnam];
+
+ if (tmpnam(fileName) == NULL) { /* INTL: Native. */
+ return NULL;
+ }
+
+ return TclpNativeToNormalized((ClientData) fileName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpCreatePipe --
*
* Creates a pipe - simply calls the pipe() function.