support for TCL_GLOB_TYPE_MOUNT

diff --git a/ChangeLog b/ChangeLog
index 975d5353f4363feddf8e8e66265cd9d0f4d879f3..969a0ca6cfbea39a883cc68dc82042c4002fd449 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,20 +1,19 @@
 2003-10-13  Vince Darley <vincentdarley@sourceforge.net>
 
-       * generic/vfs.c: added support for TCL_FILESYSTEM_VERSION_2
-       which provides for more seamless boundaries between filesystems
-       (using VfsListMountsInDir), which allows for fixing Tcl's
-       [Bug 800106].  This means (with a suitable version of Tcl) that
-       'glob */*' across a filesystem boundary will now work correctly.
+       * generic/vfs.c: added support for TCL_GLOB_TYPE_MOUNT flag to
+       the MatchInDirectory proc, which provides for more seamless
+       boundaries between filesystems which allows for fixing Tcl's [Bug
+       800106].  This means (with a suitable version of Tcl) that 'glob
+       */*' across a filesystem boundary will now work correctly.
        
-       The code should compile and load successfully with both Tcl 8.4
-       and a future version of Tcl where the newer code will be
-       operational.
+       The code should work fine with Tcl 8.4 and 8.5, although with
+       8.4.4 the mount list will never be queried.
        
        * library/pkgIndex.tcl(.in): 
        * DESCRIPTION.txt:
        * win/makefile.vc:
        * configure.in: updated version to 1.3.0 reflecting the above
-       significant change.
+       significant improvement.
        
 2003-10-06  Jeff Hobbs  <jeffh@ActiveState.com>
 

diff --git a/generic/vfs.c b/generic/vfs.c
index ceb87436322f31532d08251d984be1a7ff25a04d..e096d7a54f18fa7b72b8b1797779d411e56027ed 100644 (file)
--- a/generic/vfs.c
+++ b/generic/vfs.c
@@ -46,13 +46,6 @@ EXTERN int Vfs_Init _ANSI_ARGS_((Tcl_Interp*));
 static void Vfs_AddVolume    _ANSI_ARGS_((Tcl_Obj*));
 static int  Vfs_RemoveVolume _ANSI_ARGS_((Tcl_Obj*));
 
-/* So we can compile against Tcl 8.4 and Tcl 8.5 or newer */
-#ifndef TCL_FILESYSTEM_VERSION_2
-#define TCL_FILESYSTEM_VERSION_2       ((Tcl_FSVersion) 0x2)
-typedef Tcl_Obj* (Tcl_FSListMountsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
-#define VFS_COMPILE_WITH_84
-#endif
-
 /* 
  * Stores the list of volumes registered with the vfs (and therefore
  * also registered with Tcl).  It is maintained as a valid Tcl list at
@@ -200,7 +193,6 @@ static Tcl_FSFilesystemSeparatorProc VfsFilesystemSeparator;
 static Tcl_FSFreeInternalRepProc VfsFreeInternalRep;
 static Tcl_FSDupInternalRepProc VfsDupInternalRep;
 static Tcl_FSListVolumesProc VfsListVolumes;
-static Tcl_FSListMountsProc VfsListMountsInDir;
 
 static Tcl_Filesystem vfsFilesystem = {
     "tclvfs",
@@ -227,11 +219,7 @@ static Tcl_Filesystem vfsFilesystem = {
     &VfsUtime,
     /* We choose not to support symbolic links inside our vfs's */
     NULL,
-#ifdef VFS_COMPILE_WITH_84
     &VfsListVolumes,
-#else
-    &VfsListMountsInDir,
-#endif
     &VfsFileAttrStrings,
     &VfsFileAttrsGet,
     &VfsFileAttrsSet,
@@ -332,30 +320,11 @@ int
 Vfs_Init(interp)
     Tcl_Interp *interp;                /* Interpreter for application. */
 {
-    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
-       if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
-           return TCL_ERROR;
-       }
-       if (Tcl_PkgRequire(interp, "Tcl", "8.4", 0) == NULL) {
-           return TCL_ERROR;
-       }
-       vfsFilesystem.version = TCL_FILESYSTEM_VERSION_1;
-#ifdef VFS_COMPILE_WITH_84
-       vfsFilesystem.listVolumesProc = &VfsListVolumes;
-#else
-       vfsFilesystem.listMountsProc = (Tcl_FSListMountsProc*)&VfsListVolumes;
-#endif
-    } else {
-       if (Tcl_PkgRequire(interp, "Tcl", "8.5", 0) == NULL) {
-           return TCL_ERROR;
-       }
-       vfsFilesystem.version = TCL_FILESYSTEM_VERSION_2;
-#ifdef VFS_COMPILE_WITH_84
-       vfsFilesystem.listVolumesProc = 
-          (Tcl_FSListVolumesProc*)&VfsListMountsInDir;
-#else
-       vfsFilesystem.listMountsProc = &VfsListMountsInDir;
-#endif
+    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
+       return TCL_ERROR;
+    }
+    if (Tcl_PkgRequire(interp, "Tcl", "8.4", 0) == NULL) {
+       return TCL_ERROR;
     }
     
     /* 
@@ -1492,50 +1461,77 @@ VfsMatchInDirectory(
     Tcl_GlobTypeData *types)   /* Object containing list of acceptable types.
                                 * May be NULL. */
 {
-    Tcl_Obj *mountCmd = NULL;
-    Tcl_SavedResult savedResult;
-    int returnVal;
-    Tcl_Interp* interp;
-    int type = 0;
-    Tcl_Obj *vfsResultPtr = NULL;
-    
-    mountCmd = VfsBuildCommandForPath(&interp, "matchindirectory", dirPtr);
-    if (mountCmd == NULL) {
-       return -1;
-    }
+    if ((types != NULL) && (types->type & TCL_GLOB_TYPE_MOUNT)) {
+       VfsMount *mountIter;
+       int len;
+       CONST char *prefix;
 
-    if (types != NULL) {
-       type = types->type;
-    }
+       prefix = Tcl_GetStringFromObj(Tcl_FSGetNormalizedPath(NULL, dirPtr), 
+                                     &len);
+       Tcl_MutexLock(&vfsMountsMutex);
 
-    if (pattern == NULL) {
-       Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewObj());
+       /* Build list of mounts */
+       mountIter = listOfMounts;
+       while (mountIter != NULL) {
+           if (mountIter->mountLen > (len+1) 
+               && !strncmp(mountIter->mountPoint, prefix, len) 
+               && mountIter->mountPoint[len] == '/'
+               && strchr(mountIter->mountPoint+len+1, '/') == NULL
+               && Tcl_StringCaseMatch(mountIter->mountPoint+len+1, 
+                                      pattern, 0)) {
+               Tcl_Obj* mount = Tcl_NewStringObj(mountIter->mountPoint, 
+                                                 mountIter->mountLen);
+               Tcl_ListObjAppendElement(NULL, returnPtr, mount);
+           }
+           mountIter = mountIter->nextMount;
+       }
+       Tcl_MutexUnlock(&vfsMountsMutex);
+       return TCL_OK;
     } else {
-       Tcl_ListObjAppendElement(interp, mountCmd, 
-                                Tcl_NewStringObj(pattern,-1));
-    }
-    Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(type));
-    Tcl_SaveResult(interp, &savedResult);
-    /* Now we execute this mount point's callback. */
-    returnVal = Tcl_EvalObjEx(interp, mountCmd, 
-                             TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
-    if (returnVal != -1) {
-       vfsResultPtr = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
-    }
-    Tcl_RestoreResult(interp, &savedResult);
-    Tcl_DecrRefCount(mountCmd);
+       Tcl_Obj *mountCmd = NULL;
+       Tcl_SavedResult savedResult;
+       int returnVal;
+       Tcl_Interp* interp;
+       int type = 0;
+       Tcl_Obj *vfsResultPtr = NULL;
+       
+       mountCmd = VfsBuildCommandForPath(&interp, "matchindirectory", dirPtr);
+       if (mountCmd == NULL) {
+           return -1;
+       }
 
-    if (vfsResultPtr != NULL) {
-       if (returnVal == TCL_OK) {
-           Tcl_IncrRefCount(vfsResultPtr);
-           Tcl_ListObjAppendList(cmdInterp, returnPtr, vfsResultPtr);
-           Tcl_DecrRefCount(vfsResultPtr);
+       if (types != NULL) {
+           type = types->type;
+       }
+
+       if (pattern == NULL) {
+           Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewObj());
        } else {
-           Tcl_SetObjResult(cmdInterp, vfsResultPtr);
+           Tcl_ListObjAppendElement(interp, mountCmd, 
+                                    Tcl_NewStringObj(pattern,-1));
+       }
+       Tcl_ListObjAppendElement(interp, mountCmd, Tcl_NewIntObj(type));
+       Tcl_SaveResult(interp, &savedResult);
+       /* Now we execute this mount point's callback. */
+       returnVal = Tcl_EvalObjEx(interp, mountCmd, 
+                                 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+       if (returnVal != -1) {
+           vfsResultPtr = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
+       }
+       Tcl_RestoreResult(interp, &savedResult);
+       Tcl_DecrRefCount(mountCmd);
+
+       if (vfsResultPtr != NULL) {
+           if (returnVal == TCL_OK) {
+               Tcl_IncrRefCount(vfsResultPtr);
+               Tcl_ListObjAppendList(cmdInterp, returnPtr, vfsResultPtr);
+               Tcl_DecrRefCount(vfsResultPtr);
+           } else {
+               Tcl_SetObjResult(cmdInterp, vfsResultPtr);
+           }
        }
+       return returnVal;
     }
-    
-    return returnVal;
 }
 
 static int
@@ -1791,51 +1787,6 @@ VfsUtime(pathPtr, tval)
     return returnVal;
 }
 
-static Tcl_Obj*
-VfsListMountsInDir(Tcl_Obj *pathPtr)
-{
-    if (pathPtr == NULL) {
-       Tcl_Obj *retVal;
-       
-       Tcl_MutexLock(&vfsVolumesMutex);
-       if (vfsVolumes != NULL) {
-           Tcl_IncrRefCount(vfsVolumes);
-           retVal = vfsVolumes;
-       } else {
-           retVal = NULL;
-       }
-       Tcl_MutexUnlock(&vfsVolumesMutex);
-    
-       return retVal;
-    } else {
-       VfsMount *mountIter;
-       int len;
-       CONST char *prefix;
-       Tcl_Obj *res = Tcl_NewObj();
-
-       prefix = Tcl_GetStringFromObj(Tcl_FSGetNormalizedPath(NULL, pathPtr), 
-                                     &len);
-                                 
-       Tcl_MutexLock(&vfsMountsMutex);
-
-       /* Build list of mounts */
-       mountIter = listOfMounts;
-       while (mountIter != NULL) {
-           if (mountIter->mountLen > (len+1) 
-               && !strncmp(mountIter->mountPoint, prefix, len) 
-               && mountIter->mountPoint[len] == '/'
-               && strchr(mountIter->mountPoint+len+1, '/') == NULL) {
-               Tcl_Obj* mount = Tcl_NewStringObj(mountIter->mountPoint, 
-                                                 mountIter->mountLen);
-               Tcl_ListObjAppendElement(NULL, res, mount);
-           }
-           mountIter = mountIter->nextMount;
-       }
-       Tcl_MutexUnlock(&vfsMountsMutex);
-       return res;
-    }
-}
-
 static Tcl_Obj*
 VfsListVolumes(void)
 {

diff --git a/win/makefile.vc b/win/makefile.vc
index a08fc0432230b964dda5c40ca1d142c57d382c51..b0e67a1eea8b5383928d49e334972c4d63777a8b 100644 (file)
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -13,7 +13,7 @@ VFS_VERSION = 1.3.0
 DLL_VERSION = 13
 
 # comment the following line to compile with symbols
-NODEBUG=0
+NODEBUG=1
 
 !IF "$(NODEBUG)" == "1"
 DEBUGDEFINES =