Import tcl7.5p1

3 files changed, 65 insertions, 33 deletions

diff --git a/contrib/tcl/library/init.tcl b/contrib/tcl/library/init.tcl
index 7ffc647ed5d6..2a7cb4978cb9 100644
--- a/contrib/tcl/library/init.tcl
+++ b/contrib/tcl/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# SCCS: @(#) init.tcl 1.54 96/04/21 13:55:08
+# SCCS: @(#) init.tcl 1.57 96/07/23 08:53:03
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -24,7 +24,10 @@ if {[lsearch -exact $auto_path [info library]] < 0} {
 }
 package unknown tclPkgUnknown
 if {[info commands exec] == ""} {
-    # Some machines, such as the Macintosh, do not have exec 
+
+    # Some machines, such as the Macintosh, do not have exec. Also, on all
+    # platforms, safe interpreters do not have exec.
+
     set auto_noexec 1
 }
 set errorCode ""
@@ -228,7 +231,7 @@ proc auto_execok name {
     }
     set auto_execs($name) 0
     if {[file pathtype $name] != "relative"} {
-	foreach ext {.exe .bat .cmd} {
+	foreach ext {{} .exe .bat .cmd} {
 	    if {[file exists ${name}${ext}]
 		&& ![file isdirectory ${name}${ext}]} {
 		set auto_execs($name) 1
@@ -249,7 +252,7 @@ proc auto_execok name {
 	if {$dir == ""} {
 	    set dir .
 	}
-	foreach ext {.exe .bat .cmd} {
+	foreach ext {{} .exe .bat .cmd} {
 	    set file [file join $dir ${name}${ext}]
 	    if {[file exists $file] && ![file isdirectory $file]} {
 		set auto_execs($name) 1
@@ -295,7 +298,7 @@ proc auto_execok name {
 # Destroy all cached information for auto-loading and auto-execution,
 # so that the information gets recomputed the next time it's needed.
 # Also delete any procedures that are listed in the auto-load index
-# except those related to auto-loading.
+# except those defined in this file.
 #
 # Arguments: 
 # None.
@@ -303,8 +306,9 @@ proc auto_execok name {
 proc auto_reset {} {
     global auto_execs auto_index auto_oldpath
     foreach p [info procs] {
-	if {[info exists auto_index($p)] && ($p != "unknown")
-		&& ![string match auto_* $p]} {
+	if {[info exists auto_index($p)] && ![string match auto_* $p]
+		&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
+			tclPkgUnknown} $p] < 0)} {
 	    rename $p {}
 	}
     }
@@ -411,6 +415,17 @@ proc pkg_mkIndex {dir args} {
 	# that there are no recursive package inclusions.
 
 	set c [interp create]
+
+	# If Tk is loaded in the parent interpreter, load it into the
+	# child also, in case the extension depends on it.
+
+	foreach pkg [info loaded] {
+	    if {[lindex $pkg 1] == "Tk"} {
+		$c eval {set argv {-geometry +0+0}}
+		load [lindex $pkg 0] Tk $c
+		break
+	    }
+	}
 	$c eval [list set file $file]
 	if [catch {
 	    $c eval {
@@ -420,20 +435,25 @@ proc pkg_mkIndex {dir args} {
 		set dir ""		;# in case file is pkgIndex.tcl
 		set pkgs ""
 
-		# The "file join ." command below is necessary.  Without it,
-		# if the file name has no \'s and we're on UNIX, the
-		# LD_LIBRARY_PATH search mechanism will be invoked, which
-		# could cause the wrong file to be used.
-
-		if [catch {load [file join . $file]}] {
-		    if [catch {source $file}] {
-			puts $errorInfo
-			error "can't either load or source $file"
-		    } else {
-			set type source
-		    }
-		} else {
+		# Try to load the file if it has the shared library extension,
+		# otherwise source it.  It's important not to try to load
+		# files that aren't shared libraries, because on some systems
+		# (like SunOS) the loader will abort the whole application
+		# when it gets an error.
+
+		if {[string compare [file extension $file] \
+			[info sharedlibextension]] == 0} {
+
+		    # The "file join ." command below is necessary.  Without
+		    # it, if the file name has no \'s and we're on UNIX, the
+		    # load command will invoke the LD_LIBRARY_PATH search
+		    # mechanism, which could cause the wrong file to be used.
+
+		    load [file join . $file]
 		    set type load
+		} else {
+		    source $file
+		    set type source
 		}
 		foreach i [info commands] {
 		    set cmds($i) 1
@@ -443,14 +463,14 @@ proc pkg_mkIndex {dir args} {
 		}
 		foreach i [package names] {
 		    if {([string compare [package provide $i] ""] != 0)
-			    && ([string compare $i Tcl] != 0)} {
+			    && ([string compare $i Tcl] != 0)
+			    && ([string compare $i Tk] != 0)} {
 			lappend pkgs [list $i [package provide $i]]
 		    }
 		}
 	    }
 	} msg] {
-	    interp delete $c
-	    error $msg $errorInfo $errorCode
+	    puts "error while loading or sourcing $file: $msg"
 	}
 	foreach pkg [$c eval set pkgs] {
 	    lappend files($pkg) [list $file [$c eval set type] \
@@ -460,8 +480,8 @@ proc pkg_mkIndex {dir args} {
     }
     foreach pkg [lsort [array names files]] {
 	append index "\npackage ifneeded $pkg\
-		\"tclPkgSetup \$dir [lrange $pkg 0 0] [lrange $pkg 1 1]\
-		[list $files($pkg)]\""
+		\[list tclPkgSetup \$dir [lrange $pkg 0 0] [lrange $pkg 1 1]\
+		[list $files($pkg)]\]"
     }
     set f [open pkgIndex.tcl w]
     puts $f $index
diff --git a/contrib/tcl/library/ldAout.tcl b/contrib/tcl/library/ldAout.tcl
index 2e532d39b043..5a928931d597 100644
--- a/contrib/tcl/library/ldAout.tcl
+++ b/contrib/tcl/library/ldAout.tcl
@@ -18,7 +18,7 @@
 #	its .o file placed before all others in the command; then
 #	"ld" is executed to bind the objects together.
 #
-# SCCS: @(#) ldAout.tcl 1.9 96/04/11 10:03:24
+# SCCS: @(#) ldAout.tcl 1.10 96/05/18 16:40:42
 #
 # Copyright (c) 1995, by General Electric Company. All rights reserved.
 #
@@ -144,9 +144,14 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
   if [string compare [string range $m $l end] $shlib_suffix] {
     error "Output file does not appear to have a $shlib_suffix suffix"
   }
-  set modName [string toupper [string index $m 0]]
-  append modName [string tolower [string range $m 1 [expr $l-1]]]
-  regsub -all \\. $modName _ modName
+  set modName [string tolower [string range $m 0 [expr $l-1]]]
+  if [regexp {^lib} $modName] {
+    set modName [string range $modName 3 end]
+  }
+  if [regexp {[0-9\.]*(_g0)?$} $modName match] {
+    set modName [string range $modName 0 [expr [string length $modName]-[string length $match]-1]]
+  }
+  set modName "[string toupper [string index $modName 0]][string range $modName 1 end]"
   
   # Catalog initialization entry points found in the module
 
diff --git a/contrib/tcl/library/license.terms b/contrib/tcl/library/license.terms
index 3dcd816f4a3f..96ad96637376 100644
--- a/contrib/tcl/library/license.terms
+++ b/contrib/tcl/library/license.terms
@@ -26,7 +26,14 @@ IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
 NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
 MODIFICATIONS.
 
-RESTRICTED RIGHTS: Use, duplication or disclosure by the government
-is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
-of the Rights in Technical Data and Computer Software Clause as DFARS
-252.227-7013 and FAR 52.227-19.
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.