summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdAH.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r--generic/tclCmdAH.c182
1 files changed, 73 insertions, 109 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 5866ac4..0793a2e 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.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: tclCmdAH.c,v 1.13 2001/07/31 19:12:06 vincentdarley Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.14 2001/08/23 17:37:07 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -28,8 +28,6 @@ static int GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_FSStatProc *statProc,
struct stat *statPtr));
static char * GetTypeFromMode _ANSI_ARGS_((int mode));
-static int SplitPath _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, int *argcPtr, char ***argvPtr));
static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
char *varName, struct stat *statPtr));
@@ -782,7 +780,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_Obj *resultPtr;
int index;
/*
@@ -824,7 +821,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
switch ((enum options) index) {
case FILE_ATIME: {
struct stat buf;
@@ -845,7 +841,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
tval.actime = buf.st_atime;
tval.modtime = buf.st_mtime;
if (Tcl_FSUtime(objv[2], &tval) != 0) {
- Tcl_AppendStringsToObj(resultPtr,
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not set access time for file \"",
Tcl_GetString(objv[2]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
@@ -861,7 +857,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
}
- Tcl_SetLongObj(resultPtr, (long) buf.st_atime);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_atime);
return TCL_OK;
}
case FILE_ATTRIBUTES: {
@@ -882,14 +878,28 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TclFileDeleteCmd(interp, objc, objv);
}
case FILE_DIRNAME: {
- int argc;
- char ** argv;
+ int splitElements;
+ Tcl_Obj *splitPtr;
+ Tcl_Obj *splitResultPtr = NULL;
if (objc != 3) {
goto only3Args;
}
- if (SplitPath(interp, objv[2], &argc, &argv) != TCL_OK) {
- return TCL_ERROR;
+ /*
+ * The behaviour we want here is slightly different to
+ * the standard Tcl_FSSplitPath in the handling of home
+ * directories; Tcl_FSSplitPath preserves the "~" while
+ * this code computes the actual full path name, if we
+ * had just a single component.
+ */
+ splitPtr = Tcl_FSSplitPath(objv[2], &splitElements);
+ if ((splitElements == 1) && (Tcl_GetString(objv[2])[0] == '~')) {
+ Tcl_DecrRefCount(splitPtr);
+ splitPtr = Tcl_FSGetNormalizedPath(interp, objv[2]);
+ if (splitPtr == NULL) {
+ return TCL_ERROR;
+ }
+ splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
}
/*
@@ -898,22 +908,17 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
* return the current directory.
*/
- if (argc > 1) {
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
- Tcl_JoinPath(argc - 1, argv, &ds);
- Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- } else if ((argc == 0)
- || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
- Tcl_SetStringObj(resultPtr,
+ if (splitElements > 1) {
+ splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
+ } else if (splitElements == 0 ||
+ (Tcl_FSGetPathType(objv[2], NULL, NULL) == TCL_PATH_RELATIVE)) {
+ splitResultPtr = Tcl_NewStringObj(
((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1);
} else {
- Tcl_SetStringObj(resultPtr, argv[0], -1);
+ Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr);
}
- ckfree((char *) argv);
+ Tcl_SetObjResult(interp, splitResultPtr);
+ Tcl_DecrRefCount(splitPtr);
return TCL_OK;
}
case FILE_EXECUTABLE: {
@@ -936,7 +941,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
fileName = Tcl_GetString(objv[2]);
extension = TclGetExtension(fileName);
if (extension != NULL) {
- Tcl_SetStringObj(resultPtr, extension, -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), extension, -1);
}
return TCL_OK;
}
@@ -951,7 +956,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
value = S_ISDIR(buf.st_mode);
}
- Tcl_SetBooleanObj(resultPtr, value);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
case FILE_ISFILE: {
@@ -965,7 +970,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
value = S_ISREG(buf.st_mode);
}
- Tcl_SetBooleanObj(resultPtr, value);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
case FILE_JOIN: {
@@ -1012,7 +1017,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
tval.actime = buf.st_atime;
tval.modtime = buf.st_mtime;
if (Tcl_FSUtime(objv[2], &tval) != 0) {
- Tcl_AppendStringsToObj(resultPtr,
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not set modification time for file \"",
Tcl_GetString(objv[2]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
@@ -1028,7 +1033,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
}
- Tcl_SetLongObj(resultPtr, (long) buf.st_mtime);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_mtime);
return TCL_OK;
}
case FILE_MKDIR: {
@@ -1050,7 +1055,8 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
if (fileName == NULL) {
return TCL_ERROR;
}
- Tcl_SetStringObj(resultPtr, fileName, Tcl_DStringLength(&ds));
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName,
+ Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
return TCL_OK;
}
@@ -1086,25 +1092,23 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
value = (geteuid() == buf.st_uid);
#endif
}
- Tcl_SetBooleanObj(resultPtr, value);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
case FILE_PATHTYPE: {
- char *fileName;
-
if (objc != 3) {
goto only3Args;
}
- fileName = Tcl_GetString(objv[2]);
- switch (Tcl_GetPathType(fileName)) {
+ switch (Tcl_FSGetPathType(objv[2], NULL, NULL)) {
case TCL_PATH_ABSOLUTE:
- Tcl_SetStringObj(resultPtr, "absolute", -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), "absolute", -1);
break;
case TCL_PATH_RELATIVE:
- Tcl_SetStringObj(resultPtr, "relative", -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), "relative", -1);
break;
case TCL_PATH_VOLUME_RELATIVE:
- Tcl_SetStringObj(resultPtr, "volumerelative", -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "volumerelative", -1);
break;
}
return TCL_OK;
@@ -1126,7 +1130,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- contents = Tcl_FSReadlink(objv[2]);
+ contents = Tcl_FSLink(objv[2], NULL);
if (contents == NULL) {
Tcl_AppendResult(interp, "could not readlink \"",
@@ -1153,7 +1157,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
if (extension == NULL) {
Tcl_SetObjResult(interp, objv[2]);
} else {
- Tcl_SetStringObj(resultPtr, fileName,
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName,
(int) (length - strlen(extension)));
}
return TCL_OK;
@@ -1198,7 +1202,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetLongObj(resultPtr, (long) buf.st_size);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_size);
return TCL_OK;
}
case FILE_SPLIT: {
@@ -1238,14 +1242,27 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
}
}
case FILE_TAIL: {
- int argc;
- char **argv;
+ int splitElements;
+ Tcl_Obj *splitPtr;
if (objc != 3) {
goto only3Args;
}
- if (SplitPath(interp, objv[2], &argc, &argv) != TCL_OK) {
- return TCL_ERROR;
+ /*
+ * The behaviour we want here is slightly different to
+ * the standard Tcl_FSSplitPath in the handling of home
+ * directories; Tcl_FSSplitPath preserves the "~" while
+ * this code computes the actual full path name, if we
+ * had just a single component.
+ */
+ splitPtr = Tcl_FSSplitPath(objv[2], &splitElements);
+ if ((splitElements == 1) && (Tcl_GetString(objv[2])[0] == '~')) {
+ Tcl_DecrRefCount(splitPtr);
+ splitPtr = Tcl_FSGetNormalizedPath(interp, objv[2]);
+ if (splitPtr == NULL) {
+ return TCL_ERROR;
+ }
+ splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
}
/*
@@ -1253,13 +1270,16 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
* and it is the root of an absolute path.
*/
- if (argc > 0) {
- if ((argc > 1)
- || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
- Tcl_SetStringObj(resultPtr, argv[argc - 1], -1);
+ if (splitElements > 0) {
+ if ((splitElements > 1)
+ || (Tcl_FSGetPathType(objv[2], NULL, NULL) == TCL_PATH_RELATIVE)) {
+
+ Tcl_Obj *tail = NULL;
+ Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &tail);
+ Tcl_SetObjResult(interp, tail);
}
}
- ckfree((char *) argv);
+ Tcl_DecrRefCount(splitPtr);
return TCL_OK;
}
case FILE_TYPE: {
@@ -1271,7 +1291,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetStringObj(resultPtr,
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
GetTypeFromMode((unsigned short) buf.st_mode), -1);
return TCL_OK;
}
@@ -1280,7 +1300,8 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- return Tcl_FSListVolumes(interp);
+ Tcl_SetObjResult(interp, Tcl_FSListVolumes());
+ return TCL_OK;
}
case FILE_WRITABLE: {
if (objc != 3) {
@@ -1298,63 +1319,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
/*
*---------------------------------------------------------------------------
*
- * SplitPath --
- *
- * Utility procedure used by Tcl_FileObjCmd() to split a path.
- * Differs from standard Tcl_SplitPath in its handling of home
- * directories; Tcl_SplitPath preserves the "~" while this
- * procedure computes the actual full path name.
- *
- * Results:
- * The return value is TCL_OK if the path could be split, TCL_ERROR
- * otherwise. If TCL_ERROR was returned, an error message is left
- * in interp. If TCL_OK was returned, *argvPtr is set to a newly
- * allocated array of strings that represent the individual
- * directories in the specified path, and *argcPtr is filled with
- * the length of that array.
- *
- * Side effects:
- * Memory allocated. The caller must eventually free this memory
- * by calling ckfree() on *argvPtr.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-SplitPath(interp, objPtr, argcPtr, argvPtr)
- Tcl_Interp *interp; /* Interp for error return. May be NULL. */
- Tcl_Obj *objPtr; /* Path to be split. */
- int *argcPtr; /* Filled with length of following array. */
- char ***argvPtr; /* Filled with array of strings representing
- * the elements of the specified path. */
-{
- char *fileName;
-
- fileName = Tcl_GetString(objPtr);
-
- /*
- * If there is only one element, and it starts with a tilde,
- * perform tilde substitution and resplit the path.
- */
-
- Tcl_SplitPath(fileName, argcPtr, argvPtr);
- if ((*argcPtr == 1) && (fileName[0] == '~')) {
- Tcl_DString ds;
-
- ckfree((char *) *argvPtr);
- fileName = Tcl_TranslateFileName(interp, fileName, &ds);
- if (fileName == NULL) {
- return TCL_ERROR;
- }
- Tcl_SplitPath(fileName, argcPtr, argvPtr);
- Tcl_DStringFree(&ds);
- }
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* CheckAccess --
*
* Utility procedure used by Tcl_FileObjCmd() to query file