Implement file tildeexpand

1 files changed, 44 insertions, 36 deletions

diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 82b79f5..2fbeea3 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -2422,11 +2422,17 @@ TclNativePathInFilesystem(
 /*
  *----------------------------------------------------------------------
  *
- * TclGetHomeDir --
+ * MakeTildeRelativePath --
  *
- *      Returns the home directory of a user.  Note there is a difference
- *	between not specifying a user and explicitly specifying the current
- *	user. This mimics Tcl8's tilde expansion.
+ *      Returns a path relative to the home directory of a user.
+ *      Note there is a difference between not specifying a user and
+ *	explicitly specifying the current user. This mimics Tcl8's tilde
+ *	expansion.
+ *
+ *	The subPath argument is joined to the expanded home directory
+ *	as in Tcl_JoinPath. This means if it is not relative, it will
+ *	returned as the result with the home directory only checked
+ *	for user name validity.
  *
  * Results:
  *	Returns TCL_OK on success with home directory path in *dsPtr
@@ -2435,22 +2441,23 @@ TclNativePathInFilesystem(
  *----------------------------------------------------------------------
  */
 int
-TclGetHomeDir(
-    Tcl_Interp *interp, /* May be NULL. Only used for error messages */
-    const char *user,   /* User name. NULL -> current user */
-    Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must be
+MakeTildeRelativePath(
+    Tcl_Interp *interp,  /* May be NULL. Only used for error messages */
+    const char *user,    /* User name. NULL -> current user */
+    const char *subPath, /* Rest of path. May be NULL */
+    Tcl_DString *dsPtr)  /* Output. Is initialized by the function. Must be
                            freed on success */
 {
     const char *dir;
-    Tcl_DString nativeString;
+    Tcl_DString dirString;
 
     Tcl_DStringInit(dsPtr);
-    Tcl_DStringInit(&nativeString);
+    Tcl_DStringInit(&dirString);
 
     if (user == NULL || user[0] == 0) {
         /* No user name specified -> current user */
 
-	dir = TclGetEnv("HOME", &nativeString);
+	dir = TclGetEnv("HOME", &dirString);
 	if (dir == NULL) {
             if (interp) {
                 Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -2463,7 +2470,7 @@ TclGetHomeDir(
         }
     } else {
         /* User name specified - ~user */
-	dir = TclpGetUserHome(user, &nativeString);
+	dir = TclpGetUserHome(user, &dirString);
 	if (dir == NULL) {
 	    if (interp != NULL) {
                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2474,7 +2481,16 @@ TclGetHomeDir(
             return TCL_ERROR;
 	}
     }
-    Tcl_JoinPath(1, &dir, dsPtr);
+    if (subPath) {
+	const char *parts[2];
+	parts[0] = dir;
+	parts[1] = subPath;
+	Tcl_JoinPath(2, parts, dsPtr);
+    } else {
+	Tcl_JoinPath(1, &dir, dsPtr);
+    }
+
+    Tcl_DStringFree(&dirString);
 
     return TCL_OK;
 }
@@ -2484,7 +2500,7 @@ TclGetHomeDir(
  *
  * TclGetHomeDirObj --
  *
- *	Wrapper around TclGetHomeDir. See that function.
+ *	Wrapper around MakeTildeRelativePath. See that function.
  *
  * Results:
  *      Returns a Tcl_Obj containing the home directory of a user
@@ -2499,7 +2515,7 @@ TclGetHomeDirObj(
 {
     Tcl_DString dirString;
 
-    if (TclGetHomeDir(interp, user, &dirString) != TCL_OK) {
+    if (MakeTildeRelativePath(interp, user, NULL, &dirString) != TCL_OK) {
 	return NULL;
     }
     return TclDStringToObj(&dirString);
@@ -2515,12 +2531,6 @@ TclGetHomeDirObj(
  *	component cannot be resolved, returns NULL. If the path does not
  *	begin with a tilde, returns as is.
  *
- *      The trailing components of the path are returned verbatim. No
- *	processing is done on them. Moreover, no assumptions should be
- *	made about the separators in the returned path. They may be /
- *	or native. Appropriate path manipulations functions should be
- *	used by caller if desired.
- *
  * Results:
  *      Returns a Tcl_Obj with resolved path. This may be a new Tcl_Obj
  *	with ref count 0 or that pathObj that was passed in without its
@@ -2537,9 +2547,8 @@ TclResolveTildePath(
 {
     const char *path;
     size_t len;
-    Tcl_Obj *resolvedObj;
-    Tcl_DString dirString;
     size_t split;
+    Tcl_DString resolvedPath;
 
     path = Tcl_GetStringFromObj(pathObj, &len);
     if (path[0] != '~') {
@@ -2556,12 +2565,13 @@ TclResolveTildePath(
 
     if (split == 1) {
         /* No user name specified -> current user */
-	if (TclGetHomeDir(interp, NULL, &dirString) != TCL_OK) {
+	if (MakeTildeRelativePath(
+		interp, NULL, path[1] ? 2 + path : NULL, &resolvedPath)
+	    != TCL_OK) {
 	    return NULL;
 	}
     } else {
         /* User name specified - ~user */
-
         const char *expandedUser;
         Tcl_DString userName;
 
@@ -2569,20 +2579,18 @@ TclResolveTildePath(
         Tcl_DStringAppend(&userName, path+1, split-1);
         expandedUser = Tcl_DStringValue(&userName);
 
-	if (TclGetHomeDir(interp, expandedUser, &dirString) != TCL_OK) {
-            Tcl_DStringFree(&userName);
+	/* path[split] is / or \0 */
+	if (MakeTildeRelativePath(interp,
+				  expandedUser,
+				  path[split] ? &path[split+1] : NULL,
+				  &resolvedPath)
+	    != TCL_OK) {
+	    Tcl_DStringFree(&userName);
 	    return NULL;
 	}
-        Tcl_DStringFree(&userName);
-    }
-    resolvedObj = TclDStringToObj(&dirString);
-
-    if (split < len) {
-        /* If any trailer, append it verbatim */
-        Tcl_AppendToObj(resolvedObj, split + path, len-split);
+	Tcl_DStringFree(&userName);
     }
-
-    return resolvedObj;
+    return TclDStringToObj(&resolvedPath);
 }
 
 /*