From aa01f2adde9514d4744432c6edb9667ea86bd2b2 Mon Sep 17 00:00:00 2001
From: vincentdarley <vincentdarley>
Date: Fri, 12 Dec 2003 17:09:27 +0000
Subject: allow creation of relative links

---
 unix/tclUnixFile.c | 27 ++++++++++++++++++++++++---
 win/tclWinFile.c   |  4 ++--
 2 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index f268ad5..66c31b9 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.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: tclUnixFile.c,v 1.34 2003/11/03 12:48:30 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.35 2003/12/12 17:09:34 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -735,9 +735,30 @@ TclpObjLink(pathPtr, toPtr, linkAction)
 	 * create these.
 	 */
 	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
-	    if (symlink(target, src) != 0) return NULL;
+	    int targetLen;
+	    Tcl_DString ds;
+	    Tcl_Obj *transPtr;
+	    /* 
+	     * Now we don't want to link to the absolute, normalized path.
+	     * Relative links are quite acceptable, as are links to '~user',
+	     * for example.
+	     */
+	    transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr);
+	    if (transPtr == NULL) {
+		return NULL;
+	    }
+	    target = Tcl_GetStringFromObj(transPtr, &targetLen);
+	    target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds);
+	    Tcl_DecrRefCount(transPtr);
+	    
+	    if (symlink(target, src) != 0) {
+	        toPtr = NULL;
+	    }
+	    Tcl_DStringFree(&ds);
 	} else if (linkAction & TCL_CREATE_HARD_LINK) {
-	    if (link(target, src) != 0) return NULL;
+	    if (link(target, src) != 0) {
+		return NULL;
+	    }
 	} else {
 	    errno = ENODEV;
 	    return NULL;
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 548fd65..697bff3 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.56 2003/12/09 14:57:18 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.57 2003/12/12 17:09:27 vincentdarley Exp $
  */
 
 //#define _WIN32_WINNT  0x0500
@@ -218,7 +218,7 @@ WinLink(LinkSource, LinkTarget, linkAction)
 	return -1;
     }
 
-    /* Get the full path referenced by the directory */
+    /* Get the full path referenced by the source file/directory */
     if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, 
 			  MAX_PATH, tempFileName, &tempFilePart)) {
 	/* Invalid file */
-- 
cgit v0.12