summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2001-07-31 19:12:05 (GMT)
committervincentdarley <vincentdarley>2001-07-31 19:12:05 (GMT)
commitc1335a91a0a2d1b2b776c7bbb5763b90e3d629ad (patch)
tree1ec44ca71eb2e561881490f7766175daa65dc9eb /library
parent2414705dd748a119ffa0a2976ed71abc283aff11 (diff)
downloadtcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.zip
tcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.tar.gz
tcl-c1335a91a0a2d1b2b776c7bbb5763b90e3d629ad.tar.bz2
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
Diffstat (limited to 'library')
-rw-r--r--library/init.tcl81
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
+}