* library/auto.tcl Purged Tcl's script library of all

        * library/clock.tcl     remaining references to global vars
        * library/init.tcl      ::errorInfo and ::errorCode.

        * generic/tclMain.c (Tcl_Main): Updated to make use of
        TclGetReturnOptions instead of ::errorInfo variable.

        * generic/tclInterp.c (tclInit): Bug fix.  Access dict variables
        with [dict get], not array syntax.

6 files changed, 92 insertions, 105 deletions

diff --git a/ChangeLog b/ChangeLog
index 0df87bb..0d25fa5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2004-10-25  Don Porter  <dgp@users.sourceforge.net>
+
+	* library/auto.tcl	Purged Tcl's script library of all
+	* library/clock.tcl	remaining references to global vars
+	* library/init.tcl	::errorInfo and ::errorCode.
+
+	* generic/tclMain.c (Tcl_Main):	Updated to make use of
+	TclGetReturnOptions instead of ::errorInfo variable.
+
+	* generic/tclInterp.c (tclInit): Bug fix.  Access dict variables
+	with [dict get], not array syntax.  
+
 2004-10-25  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* tests/tm.test: Rewrote the tests to actually perform syntax
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 51ce8fd..4ee52f6 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInterp.c,v 1.47 2004/10/15 04:01:32 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.48 2004/10/25 17:24:37 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -84,10 +84,11 @@ static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
 	set tcl_library $i\n\
 	set tclfile [file join $i init.tcl]\n\
 	if {[file exists $tclfile]} {\n\
-	    if {![catch {uplevel #0 [list source $tclfile]} msg opt]} {\n\
+	    if {![catch {uplevel #0 [list source $tclfile]} msg opts]} {\n\
 		return\n\
 	    } else {\n\
-		append errors \"$tclfile: $msg\n$opt(-errorinfo)\n\"\n\
+		append errors \"$tclfile: $msg\n\"\n\
+		append errors \"[dict get $opts -errorinfo]\n\"\n\
 	    }\n\
 	}\n\
     }\n\
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 238b485..7869cec 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclMain.c,v 1.28 2004/10/15 04:01:32 dgp Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.29 2004/10/25 17:24:39 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -435,17 +435,19 @@ Tcl_Main(argc, argv, appInitProc)
 	if (code != TCL_OK) {
 	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
 	    if (errChannel) {
+		Tcl_Obj *options = TclGetReturnOptions(interp, code);
+		Tcl_Obj *keyPtr = Tcl_NewStringObj("-errorinfo", -1);
+		Tcl_Obj *valuePtr;
 
-		/*
-		 * The following statement guarantees that the errorInfo
-		 * variable is set properly when the error has to do with
-		 * the opening or reading of the file.
-		 */
+		Tcl_IncrRefCount(keyPtr);
+		Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
+		Tcl_DecrRefCount(keyPtr);
 
-		Tcl_AddErrorInfo(interp, "");
-		Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
-			NULL, TCL_GLOBAL_ONLY));
+		if (valuePtr) {
+		    Tcl_WriteObj(errChannel, valuePtr);
+		}
 		Tcl_WriteChars(errChannel, "\n", 1);
+		Tcl_DecrRefCount(options);
 	    }
 	    exitCode = 1;
 	}
diff --git a/library/auto.tcl b/library/auto.tcl
index c80e1ea..7552414 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -3,7 +3,7 @@
 # utility procs formerly in init.tcl dealing with auto execution
 # of commands and can be auto loaded themselves.
 #
-# RCS: @(#) $Id: auto.tcl,v 1.18 2004/08/23 17:40:27 dgp Exp $
+# RCS: @(#) $Id: auto.tcl,v 1.19 2004/10/25 17:24:39 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -51,7 +51,7 @@ proc auto_reset {} {
 
 proc tcl_findLibrary {basename version patch initScript enVarName varName} {
     upvar #0 $varName the_library
-    global env errorInfo
+    global env
 
     set dirs {}
     set errors {}
@@ -141,10 +141,11 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
 	# we have a source command, but no file exists command
 
         if {[interp issafe] || [file exists $file]} {
-            if {![catch {uplevel #0 [list source $file]} msg]} {
+            if {![catch {uplevel #0 [list source $file]} msg opts]} {
                 return
             } else {
-                append errors "$file: $msg\n$errorInfo\n"
+                append errors "$file: $msg\n"
+		append errors [dict get $opts -errorinfo]\n
             }
         }
     }
@@ -186,8 +187,6 @@ if {[interp issafe]} {
 #		are given auto_mkindex will look for *.tcl.
 
 proc auto_mkindex {dir args} {
-    global errorCode errorInfo
-
     if {[interp issafe]} {
         error "can't generate index within safe interpreter"
     }
@@ -209,13 +208,11 @@ proc auto_mkindex {dir args} {
 
     auto_mkindex_parser::init
     foreach file [glob {expand}$args] {
-        if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
+        if {[catch {auto_mkindex_parser::mkindex $file} msg opts] == 0} {
             append index $msg
         } else {
-            set code $errorCode
-            set info $errorInfo
             cd $oldDir
-            error $msg $info $code
+	    return -options $opts $msg
         }
     }
     auto_mkindex_parser::cleanup
@@ -230,7 +227,6 @@ proc auto_mkindex {dir args} {
 # code for "proc" at the beginning of the line.
 
 proc auto_mkindex_old {dir args} {
-    global errorCode errorInfo
     set oldDir [pwd]
     cd $dir
     set dir [pwd]
@@ -256,13 +252,11 @@ proc auto_mkindex_old {dir args} {
 		}
 	    }
 	    close $f
-	} msg]
+	} msg opts]
 	if {$error} {
-	    set code $errorCode
-	    set info $errorInfo
 	    catch {close $f}
 	    cd $oldDir
-	    error $msg $info $code
+	    return -options $opts $msg
 	}
     }
     set f ""
@@ -271,13 +265,12 @@ proc auto_mkindex_old {dir args} {
 	puts -nonewline $f $index
 	close $f
 	cd $oldDir
-    } msg]
+    } msg opts]
     if {$error} {
-	set code $errorCode
-	set info $errorInfo
 	catch {close $f}
 	cd $oldDir
 	error $msg $info $code
+	return -options $opts $msg
     }
 }
 
diff --git a/library/clock.tcl b/library/clock.tcl
index 7fdc654..15456d2 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: clock.tcl,v 1.8 2004/10/22 14:27:39 kennykb Exp $
+# RCS: @(#) $Id: clock.tcl,v 1.9 2004/10/25 17:24:39 dgp Exp $
 #
 #----------------------------------------------------------------------
 
@@ -1036,7 +1036,7 @@ proc ::tcl::clock::format { args } {
 
 	set retval
 
-    } result]
+    } result opts]
 
     # Restore the locale
 
@@ -1045,12 +1045,10 @@ proc ::tcl::clock::format { args } {
     }
 
     if { $status == 1 } {
-	if { [lindex $::errorCode 0] eq {clock} } {
+	if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
 	    return -code error $result
 	} else {
-	    return -code error \
-		-errorcode $::errorCode -errorinfo $::errorInfo \
-		$result
+	    return -options $opts $result
 	}
     } else {
 	return $result
@@ -1153,15 +1151,7 @@ proc ::tcl::clock::scan { args } {
 		"legacy \[clock scan\] does not support -locale"
 
 	}
-	if { [catch {
-	    FreeScan $string $base $timezone $locale
-	} retval] } {
-	    return -code error \
-		-errorcode $::errorCode -errorinfo $::errorInfo \
-		$retval
-	} else {
-	    return $retval
-	}
+	return [FreeScan $string $base $timezone $locale]
     }
 
     # Change locale if a fresh locale has been given on the command line.
@@ -1176,7 +1166,7 @@ proc ::tcl::clock::scan { args } {
 	set scanner [ParseClockScanFormat $format]
 	$scanner $string $base $timezone
 
-    } result]
+    } result opts]
 
     # Restore the locale
 
@@ -1185,12 +1175,10 @@ proc ::tcl::clock::scan { args } {
     }
 
     if { $status == 1 } {
-	if { [lindex $::errorCode 0] eq {clock} } {
+	if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
 	    return -code error $result
 	} else {
-	    return -code error \
-		-errorcode $::errorCode -errorinfo $::errorInfo \
-		$result
+	    return -options $opts $result
 	}
     } else {
 	return $result
@@ -2998,8 +2986,9 @@ proc ::tcl::clock::ConvertLocalToUTC { date } {
 
 	if { [catch { 
 	    ConvertLocalToUTCViaC [dict get $date localSeconds]
-	} result] } {
-	    return -code error -errorcode $::errorCode $result
+	} result opts] } {
+	    dict unset opts -errorinfo
+	    return -options $opts $result
 	}
 	dict set date seconds $result
 	return $date
@@ -3008,8 +2997,9 @@ proc ::tcl::clock::ConvertLocalToUTC { date } {
 
 	# Get the time zone data
 
-	if { [catch { SetupTimeZone $timezone } retval] } {
-	    return -code error -errorcode $::errorCode $retval
+	if { [catch { SetupTimeZone $timezone } retval opts] } {
+	    dict unset opts -errorinfo
+	    return -options $opts $retval
 	}
 	
 	# Initially assume that local == UTC, and locate the last time
@@ -3103,8 +3093,9 @@ proc ::tcl::clock::ConvertUTCToLocal { date timezone } {
 
     # Get the data for time changes in the given zone
 
-    if { [catch { SetupTimeZone $timezone } retval] } {
-	return -code error -errorcode $::errorCode $retval
+    if { [catch { SetupTimeZone $timezone } retval opts] } {
+	dict unset opts -errorinfo
+	return -options $opts $retval
     }
 
     if { $timezone eq {:localtime} } {
@@ -3113,8 +3104,9 @@ proc ::tcl::clock::ConvertUTCToLocal { date timezone } {
 	
 	if { [catch {
 	    ConvertUTCToLocalViaC $date
-	} retval] } {
-	    return -code error -errorcode $::errorCode $retval
+	} retval opts] } {
+	    dict unset opts -errorinfo
+	    return -options $opts $retval
 	}
 	return $retval
     }
@@ -3278,12 +3270,11 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
 	    
 	    # This looks like a POSIX time zone - try to process it
 
-	    if { [catch {ProcessPosixTimeZone $tzfields} data] } {
-		if { [lindex $::errorCode 0] eq {CLOCK} } {
-		    return -code error -errorcode $::errorCode $data
-		} else {
-		    error $tzfields $::errorInfo $::errorCode
+	    if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
+		if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
+		    dict unset opts -errorinfo
 		}
+		return -options $opts $data
 	    } else {
 		set TZData($timezone) $data
 	    }
@@ -3294,9 +3285,9 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
 	    # again with a time zone file - this time without a colon
 
 	    if { [catch { LoadTimeZoneFile $timezone }]
-		 && [catch { LoadZoneinfoFile $timezone }] } {
-		return -code error -errorcode $::errorCode \
-		    "time zone $timezone not found"
+		 && [catch { LoadZoneinfoFile $timezone } - opts] } {
+		dict unset opts -errorinfo
+		return -options $opts "time zone $timezone not found"
 	    }
 	    set TZData($timezone) $TZData(:$timezone)
 	}
@@ -4831,7 +4822,7 @@ proc ::tcl::clock::add { clockval args } {
 		}
 	    }
 	}
-    } result]
+    } result opts]
 
     # Restore the locale
 
@@ -4840,11 +4831,10 @@ proc ::tcl::clock::add { clockval args } {
     }
 
     if { $status == 1 } {
-	if { [lindex $::errorCode 0] eq {CLOCK} } {
-	    return -code error -errorcode $::errorCode $result
-	} else {
-	    error $result $::errorInfo $::errorCode
+	if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
+	    dict unset opts -errorinfo
 	}
+	return -options $opts $result
     } else {
 	return $clockval
     }
diff --git a/library/init.tcl b/library/init.tcl
index 7b8d4de..96a2bad 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.65 2004/08/18 22:03:32 andreas_kupries Exp $
+# RCS: @(#) $Id: init.tcl,v 1.66 2004/10/25 17:24:40 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -130,8 +130,6 @@ if {[llength [info commands exec]] == 0} {
 
     set auto_noexec 1
 }
-set errorCode ""
-set errorInfo ""
 
 # Define a log command (which can be overwitten to log errors
 # differently, specially when stderr is not available)
@@ -167,7 +165,6 @@ if {[llength [info commands tclLog]] == 0} {
 proc unknown args {
     variable ::tcl::UnknownPending
     global auto_noexec auto_noload env tcl_interactive
-    global errorCode errorInfo
 
     # If the command word has the form "namespace inscope ns cmd"
     # then concatenate its arguments onto the end and evaluate it.
@@ -175,48 +172,42 @@ proc unknown args {
     set cmd [lindex $args 0]
     if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
         set arglist [lrange $args 1 end]
-	set ret [catch {uplevel 1 ::$cmd $arglist} result]
-        if {$ret == 0} {
-            return $result
-        } else {
-	    return -code $ret -errorcode $errorCode $result
-        }
+	set ret [catch {uplevel 1 ::$cmd $arglist} result opts]
+	dict unset opts -errorinfo
+	return -options $opts $ret
     }
 
-    # Save the values of errorCode and errorInfo variables, since they
-    # may get modified if caught errors occur below.  The variables will
-    # be restored just before re-executing the missing command.
-
-    set savedErrorCode $errorCode
-    set savedErrorInfo $errorInfo
     set name [lindex $args 0]
     if {![info exists auto_noload]} {
 	#
 	# Make sure we're not trying to load the same proc twice.
 	#
 	if {[info exists UnknownPending($name)]} {
-	    return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
+	    return -code error "self-referential recursion\
+		    in \"unknown\" for command \"$name\"";
 	}
 	set UnknownPending($name) pending;
-	set ret [catch {auto_load $name [uplevel 1 {::namespace current}]} msg]
+	set ret [catch {
+		auto_load $name [uplevel 1 {::namespace current}]
+	} msg opts]
 	unset UnknownPending($name);
 	if {$ret != 0} {
-	    append errorInfo "\n    (autoloading \"$name\")"
-	    return -code $ret -errorcode $errorCode -errorinfo $errorInfo $msg
+	    dict append opts -errorinfo "\n    (autoloading \"$name\")"
+	    return -options $opts $msg
 	}
 	if {![array size UnknownPending]} {
 	    unset UnknownPending
 	}
 	if {$msg} {
-	    set errorCode $savedErrorCode
-	    set errorInfo $savedErrorInfo
-	    set code [catch {uplevel 1 $args} msg]
+	    set code [catch {uplevel 1 $args} msg opts]
 	    if {$code ==  1} {
 		#
 		# Compute stack trace contribution from the [uplevel].
 		# Note the dependence on how Tcl_AddErrorInfo, etc. 
 		# construct the stack trace.
 		#
+		set errorInfo [dict get $opts -errorinfo]
+		set errorCode [dict get $opts -errorcode]
 		set cinfo $args
 		if {[string bytelength $cinfo] > 153} {
 		    set cinfo [string range $cinfo 0 152]
@@ -238,7 +229,9 @@ proc unknown args {
 		    # The stack has only the eval from the expanded command
 		    # Do not generate any stack trace here.
 		    #
-		    return -code error -errorcode $errorCode $msg
+		    dict unset opts -errorinfo
+		    dict incr opts -level
+		    return -options $opts $msg
 		}
 		#
 		# Stack trace is nested, trim off just the contribution
@@ -270,8 +263,6 @@ proc unknown args {
 	if {![info exists auto_noexec]} {
 	    set new [auto_execok $name]
 	    if {$new != ""} {
-		set errorCode $savedErrorCode
-		set errorInfo $savedErrorInfo
 		set redir ""
 		if {[string equal [info commands console] ""]} {
 		    set redir ">&@stdout <@stdin"
@@ -279,8 +270,6 @@ proc unknown args {
 		return [uplevel 1 exec $redir $new [lrange $args 1 end]]
 	    }
 	}
-	set errorCode $savedErrorCode
-	set errorInfo $savedErrorInfo
 	if {[string equal $name "!!"]} {
 	    set newcmd [history event]
 	} elseif {[regexp {^!(.+)$} $name dummy event]} {
@@ -300,9 +289,9 @@ proc unknown args {
 	    set name ""
 	}
 	if {$ret != 0} {
-	    return -code $ret -errorcode $errorCode \
-		"error in unknown while checking if \"$name\" is\
-		a unique command abbreviation:\n$msg"
+	    dict append opts -errorinfo \
+		    "\n    (expanding command prefix \"$name\" in unknown)"
+	    return -options $opts $msg
 	}
 	# Filter out bogus matches when $name contained
 	# a glob-special char [Bug 946952]
@@ -393,7 +382,7 @@ proc auto_load {cmd {namespace {}}} {
 
 proc auto_load_index {} {
     variable ::tcl::auto_oldpath
-    global auto_index auto_path errorInfo errorCode
+    global auto_index auto_path
 
     if {[info exists auto_oldpath] && \
 	    [string equal $auto_oldpath $auto_path]} {
@@ -431,12 +420,12 @@ proc auto_load_index {} {
 		} else {
 		    error "[file join $dir tclIndex] isn't a proper Tcl index file"
 		}
-	    } msg]
+	    } msg opts]
 	    if {$f != ""} {
 		close $f
 	    }
 	    if {$error} {
-		error $msg $errorInfo $errorCode
+		return -options $opts $msg
 	    }
 	}
     }