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

1 files changed, 80 insertions, 1 deletions

diff --git a/library/init.tcl b/library/init.tcl
index 4de3ceb..5f7e58f 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# RCS: @(#) $Id: init.tcl,v 1.48 2001/05/28 22:27:08 hobbs Exp $
+# RCS: @(#) $Id: init.tcl,v 1.49 2001/07/31 19:12:07 vincentdarley Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -626,3 +626,82 @@ proc auto_execok name {
 }
 
 }
+
+namespace eval tcl {}
+
+# ::tcl::CopyDirectory --
+#
+# This procedure is called by Tcl's core when attempts to call the
+# filesystem's copydirectory function fail.  The semantics of the call
+# are that 'dest' does not yet exist, i.e. dest should become the exact
+# image of src.  If dest does exist, we throw an error.  
+# 
+# Note that making changes to this procedure can change the results
+# of running Tcl's tests.
+#
+# Arguments: 
+# action -              "renaming" or "copying" 
+# src -			source directory
+# dest -		destination directory
+proc ::tcl::CopyDirectory {action src dest} {
+    set nsrc [file normalize $src]
+    set ndest [file normalize $dest]
+    if {[string equal $action "renaming"]} {
+	# Can't rename volumes
+	if {[lsearch -exact [file volumes] $nsrc] != -1} {
+	    return -code error "error $action \"$src\" to\
+	      \"$dest\": trying to rename a volume or move a directory\
+	      into itself"
+	}
+    }
+    if {[file exists $dest]} {
+	if {$nsrc == $ndest} {
+	    return -code error "error $action \"$src\" to\
+	      \"$dest\": trying to rename a volume or move a directory\
+	      into itself"
+	}
+	if {[string equal $action "copying"]} {
+	    return -code error "error $action \"$src\" to\
+	      \"$dest\": file already exists"
+	} else {
+	    # Depending on the platform, and on the current
+	    # working directory, the directories '.', '..'
+	    # can be returned in various combinations.  Anyway,
+	    # if any other file is returned, we must signal an error.
+	    set existing [glob -nocomplain -directory $dest * .*]
+	    eval [list lappend existing] \
+	      [glob -nocomplain -directory $dest -type hidden * .*]
+	    foreach s $existing {
+		if {([file tail $s] != ".") && ([file tail $s] != "..")} {
+		    return -code error "error $action \"$src\" to\
+		      \"$dest\": file already exists"
+		}
+	    }
+	}
+    } else {
+	if {[string first $nsrc $ndest] != -1} {
+	    set srclen [expr {[llength [file split $nsrc]] -1}]
+	    set ndest [lindex [file split $ndest] $srclen]
+	    if {$ndest == [file tail $nsrc]} {
+		return -code error "error $action \"$src\" to\
+		  \"$dest\": trying to rename a volume or move a directory\
+		  into itself"
+	    }
+	}
+	file mkdir $dest
+    }
+    # Have to be careful to capture both visible and hidden files
+    foreach s [glob -nocomplain -directory $src *] {
+	if {([file tail $s] != ".") && ([file tail $s] != "..")} {
+	    file copy $s [file join $dest [file tail $s]]
+	}
+    }
+    # This will pick up things beginning with '.' on Unix and on
+    # Windows/MacOS those files which the OS considers invisible.
+    foreach s [glob -nocomplain -directory $src -types hidden *] {
+	if {([file tail $s] != ".") && ([file tail $s] != "..")} {
+	    file copy $s [file join $dest [file tail $s]]
+	}
+    }
+    return
+}