* generic/tclBasic.c: Added unsupported command

        * generic/tclCmdAH.c:   [::tcl::unsupported::EncodingDirs] to permit
        * generic/tclInt.h:     query/set of the encoding search path at
        * generic/tclInterp.c:  the script level.  Updated init.tcl to make
        * library/init.tcl:     use of the new command.  Also updated several
        coding practices in init.tcl ("eq" for [string equal], etc.)

6 files changed, 105 insertions, 108 deletions

diff --git a/ChangeLog b/ChangeLog
index adcd6e7..5abc902 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2005-04-19  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclBasic.c:	Added unsupported command
+	* generic/tclCmdAH.c:	[::tcl::unsupported::EncodingDirs] to permit
+	* generic/tclInt.h:	query/set of the encoding search path at
+	* generic/tclInterp.c:	the script level.  Updated init.tcl to make
+	* library/init.tcl:	use of the new command.  Also updated several
+	coding practices in init.tcl ("eq" for [string equal], etc.)
+
 2005-04-19  Kevin B. Kenny  <kennykb@acm.org>
 
 	* library/clock.tcl (Initialize): Put initialization code into a
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index be75a52..17da494 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -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: tclBasic.c,v 1.144 2005/04/10 23:07:36 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.145 2005/04/19 16:32:53 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -405,6 +405,10 @@ Tcl_CreateInterp()
 	    TclDefaultBgErrorHandlerObjCmd,	(ClientData) NULL,
 	    (Tcl_CmdDeleteProc*) NULL );
 
+    /* Register the unsupported encoding search path command */
+    Tcl_CreateObjCommand (interp, "::tcl::unsupported::EncodingDirs",
+	    TclEncodingDirsObjCmd, NULL, NULL);
+
     /*
      * Register the builtin math functions.
      */
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 1ef0dcf..eb57690 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.59 2005/04/08 20:04:03 dgp Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.60 2005/04/19 16:32:55 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -530,6 +530,45 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * TclEncodingDirsObjCmd --
+ *
+ *	This command manipulates the encoding search path.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Can set the encoding search path.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclEncodingDirsObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
+    }
+    if (objc == 1) {
+	Tcl_SetObjResult(interp, TclGetEncodingSearchPath());
+	return TCL_OK;
+    }
+    if (TclSetEncodingSearchPath(objv[1]) == TCL_ERROR) {
+	Tcl_AppendResult(interp, "expected directory list but got \"",
+		Tcl_GetString(objv[1]), "\"", NULL);
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, objv[1]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ErrorObjCmd --
  *
  *	This procedure is invoked to process the "error" Tcl command.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 13a266a..7777cfd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.222 2005/04/16 07:58:45 vasiljevic Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.223 2005/04/19 16:32:55 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -2137,6 +2137,9 @@ MODULE_SCOPE int	Tcl_DictObjCmd _ANSI_ARGS_((ClientData clientData,
 MODULE_SCOPE int	Tcl_EncodingObjCmd _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]));
+MODULE_SCOPE int	TclEncodingDirsObjCmd _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
 MODULE_SCOPE int	Tcl_EofObjCmd _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]));
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 0a1e346..74d4006 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.57 2005/04/15 22:41:43 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.58 2005/04/19 16:32:56 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -298,10 +298,6 @@ int
 Tcl_Init(interp)
     Tcl_Interp *interp;         /* Interpreter to initialize. */
 {
-    int code;
-    Tcl_DString script, encodingName;
-    Tcl_Obj *path;
-
     if (tclPreInitScript != NULL) {
 	if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
 	    return (TCL_ERROR);
@@ -347,7 +343,7 @@ Tcl_Init(interp)
  * Note that this entire search mechanism can be bypassed by defining an
  * alternate tclInit procedure before calling Tcl_Init().
  */
-    code = Tcl_Eval(interp,
+    return Tcl_Eval(interp,
 "if {[info proc tclInit]==\"\"} {\n"
 "  proc tclInit {} {\n"
 "    global tcl_libPath tcl_library env tclDefaultLibrary\n"
@@ -410,66 +406,6 @@ Tcl_Init(interp)
 "  }\n"
 "}\n"
 "tclInit");
-
-    if (code != TCL_OK) {
-	return code;
-    }
-
-    /* 
-     * Now that [info library] is initialized, make sure that
-     * [file join [info library] encoding] is on the encoding
-     * search path.
-     *
-     * Relying on use of original built-in commands.
-     * Should be a safe assumption during interp initialization.
-     * More robust would be to use C-coded equivalents, but that's such
-     * a pain...
-     */
-
-    Tcl_DStringInit(&script);
-    Tcl_DStringAppend(&script, "lsearch -exact", -1);
-    path = Tcl_DuplicateObj(TclGetEncodingSearchPath());
-    Tcl_IncrRefCount(path);
-    Tcl_DStringAppendElement(&script, Tcl_GetString(path));
-    Tcl_DStringAppend(&script, " [file join [info library] encoding]", -1);
-    code = Tcl_EvalEx(interp, Tcl_DStringValue(&script),
-	    Tcl_DStringLength(&script), TCL_EVAL_GLOBAL);
-    Tcl_DStringFree(&script);
-    if (code == TCL_OK) {
-	int index;
-	Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &index);
-	if (index != -1) {
-	    /* [info library]/encoding already on the encoding search path */
-	    goto done;
-	}
-    }
-    Tcl_DStringInit(&script);
-    Tcl_DStringAppend(&script, "file join [info library] encoding", -1);
-    code = Tcl_EvalEx(interp, Tcl_DStringValue(&script),
-	    Tcl_DStringLength(&script), TCL_EVAL_GLOBAL);
-    Tcl_DStringFree(&script);
-    if (code == TCL_OK) {
-	Tcl_ListObjAppendElement(NULL, path, Tcl_GetObjResult(interp));
-	TclSetEncodingSearchPath(path);
-    }
-done:
-    /*
-     * Now that we know the distributed *.enc files are on the encoding
-     * search path, check whether the [encoding system] matches that
-     * specified by the environment, and if not, attempt to correct it
-     */
-    TclpGetEncodingNameFromEnvironment(&encodingName);
-    if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) {
-	code = Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
-	if (code == TCL_ERROR) {
-	    Tcl_Panic("system encoding \"%s\" not available",
-		    Tcl_DStringValue(&encodingName));
-	}
-    }
-    Tcl_DStringFree(&encodingName);
-    Tcl_DecrRefCount(path);
-    Tcl_ResetResult(interp);
-    return TCL_OK;
 }
 
 /*
diff --git a/library/init.tcl b/library/init.tcl
index 2f6e51c..a959beb 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.70 2005/04/15 15:50:35 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.71 2005/04/19 16:32:57 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -48,11 +48,9 @@ if {![info exists auto_path]} {
 }
 namespace eval tcl {
     variable Dir
-    if {$::tcl_library != ""} {
-	foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
-	    if {[lsearch -exact $::auto_path $Dir] < 0} {
-		lappend ::auto_path $Dir
-	    }
+    foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
+	if {[lsearch -exact $::auto_path $Dir] < 0} {
+	    lappend ::auto_path $Dir
 	}
     }
     set Dir [file join [file dirname [file dirname \
@@ -60,18 +58,25 @@ namespace eval tcl {
     if {[lsearch -exact $::auto_path $Dir] < 0} {
 	lappend ::auto_path $Dir
     }
-    if {[info exists ::tcl_pkgPath]} {
+    catch {
 	foreach Dir $::tcl_pkgPath {
 	    if {[lsearch -exact $::auto_path $Dir] < 0} {
 		lappend ::auto_path $Dir
 	    }
 	}
     }
+
+    variable Path [unsupported::EncodingDirs]
+    set Dir [file join $::tcl_library encoding]
+    if {[lsearch -exact $Path $Dir] < 0} {
+	lappend Path $Dir
+	unsupported::EncodingDirs $Path
+    }
 }
-  
+
 # Windows specific end of initialization
 
-if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
+if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
     namespace eval tcl {
 	proc EnvTraceProc {lo n1 n2 op} {
 	    set x $::env($n2)
@@ -82,7 +87,7 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
 	    global env tcl_platform
 	    foreach p [array names env] {
 		set u [string toupper $p]
-		if {![string equal $u $p]} {
+		if {$u ne $p]} {
 		    switch -- $u {
 			COMSPEC -
 			PATH {
@@ -98,7 +103,7 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
 		}
 	    }
 	    if {![info exists env(COMSPEC)]} {
-		if {[string equal $tcl_platform(os) "Windows NT"]} {
+		if {$tcl_platform(os) eq "Windows NT"} {
 		    set env(COMSPEC) cmd.exe
 		} else {
 		    set env(COMSPEC) command.com
@@ -111,16 +116,19 @@ if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
 
 # Setup the unknown package handler
 
-package unknown tclPkgUnknown
 
-if {![interp issafe]} {
-    # setup platform specific unknown package handlers
-    if {[string equal $::tcl_platform(platform) "unix"] && \
-	    [string equal $::tcl_platform(os) "Darwin"]} {
-	package unknown [list tcl::MacOSXPkgUnknown [package unknown]]
-    }
+if {[interp issafe]} {
+    package unknown ::tclPkgUnknown
+} else {
     # Set up search for Tcl Modules (TIP #189).
-    package unknown [list ::tcl::tm::UnknownHandler [package unknown]]
+    # and setup platform specific unknown package handlers
+    if {$::tcl_platform(os) eq "Darwin"
+	    && $::tcl_platform(platform) eq "unix"} {
+	package unknown {::tcl::tm::UnknownHandler \
+		{::tcl::MacOSXPkgUnknown ::tclPkgUnknown}}
+    } else {
+	package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
+    }
 
     # Set up the 'clock' ensemble
 
@@ -290,19 +298,19 @@ proc unknown args {
 	}
     }
 
-    if {([info level] == 1) && [string equal [info script] ""] \
+    if {([info level] == 1) && ([info script] eq "") \
 	    && [info exists tcl_interactive] && $tcl_interactive} {
 	if {![info exists auto_noexec]} {
 	    set new [auto_execok $name]
 	    if {$new != ""} {
 		set redir ""
-		if {[string equal [info commands console] ""]} {
+		if {[info commands console] eq ""} {
 		    set redir ">&@stdout <@stdin"
 		}
 		return [uplevel 1 exec $redir $new [lrange $args 1 end]]
 	    }
 	}
-	if {[string equal $name "!!"]} {
+	if {$name eq "!!"} {
 	    set newcmd [history event]
 	} elseif {[regexp {^!(.+)$} $name dummy event]} {
 	    set newcmd [history event $event]
@@ -317,7 +325,7 @@ proc unknown args {
 	}
 
 	set ret [catch {set candidates [info commands $name*]} msg]
-	if {[string equal $name "::"]} {
+	if {$name eq "::"} {
 	    set name ""
 	}
 	if {$ret != 0} {
@@ -337,7 +345,7 @@ proc unknown args {
 	    return [uplevel 1 [lreplace $args 0 0 $cmds]]
 	}
 	if {[llength $cmds]} {
-	    if {[string equal $name ""]} {
+	    if {$name eq ""} {
 		return -code error "empty command name \"\""
 	    } else {
 		return -code error \
@@ -416,8 +424,7 @@ proc auto_load_index {} {
     variable ::tcl::auto_oldpath
     global auto_index auto_path
 
-    if {[info exists auto_oldpath] && \
-	    [string equal $auto_oldpath $auto_path]} {
+    if {[info exists auto_oldpath] && ($auto_oldpath eq $auto_path)} {
 	return 0
     }
     set auto_oldpath $auto_path
@@ -436,12 +443,11 @@ proc auto_load_index {} {
 	} else {
 	    set error [catch {
 		set id [gets $f]
-		if {[string equal $id \
-			"# Tcl autoload index file, version 2.0"]} {
+		if {$id eq "# Tcl autoload index file, version 2.0"} {
 		    eval [read $f]
-		} elseif {[string equal $id "# Tcl autoload index file: each line identifies a Tcl"]} {
+		} elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"]} {
 		    while {[gets $f line] >= 0} {
-			if {[string equal [string index $line 0] "#"] \
+			if {([string index $line 0] eq "#") \
 				|| ([llength $line] != 2)} {
 			    continue
 			}
@@ -506,14 +512,14 @@ proc auto_qualify {cmd namespace} {
     # (if the current namespace is not the global one)
 
     if {$n == 0} {
-	if {[string equal $namespace ::]} {
+	if {$namespace eq "::"} {
 	    # ( nocolons , :: ) -> nocolons
 	    return [list $cmd]
 	} else {
 	    # ( nocolons , ::sub ) -> ::sub::nocolons nocolons
 	    return [list ${namespace}::$cmd $cmd]
 	}
-    } elseif {[string equal $namespace ::]} {
+    } elseif {$namespace eq "::"} {
 	#  ( foo::bar , :: ) -> ::foo::bar
 	return [list ::$cmd]
     } else {
@@ -568,7 +574,7 @@ proc auto_import {pattern} {
 # Arguments: 
 # name -			Name of a command.
 
-if {[string equal windows $tcl_platform(platform)]} {
+if {$tcl_platform(platform) eq "windows"} {
 # Windows version.
 #
 # Note that info executable doesn't work under Windows, so we have to
@@ -586,7 +592,7 @@ proc auto_execok name {
 
     set shellBuiltins [list cls copy date del erase dir echo mkdir \
 	    md rename ren rmdir rd time type ver vol]
-    if {[string equal $tcl_platform(os) "Windows NT"]} {
+    if {$tcl_platform(os) eq "Windows NT"} {
 	# NT includes the 'start' built-in
 	lappend shellBuiltins "start"
     }
@@ -623,7 +629,7 @@ proc auto_execok name {
 	set windir $env(WINDIR) 
     }
     if {[info exists windir]} {
-	if {[string equal $tcl_platform(os) "Windows NT"]} {
+	if {$tcl_platform(os) eq "Windows NT"} {
 	    append path "$windir/system32;"
 	}
 	append path "$windir/system;$windir;"
@@ -637,7 +643,7 @@ proc auto_execok name {
 
     foreach dir [split $path {;}] {
 	# Skip already checked directories
-	if {[info exists checked($dir)] || [string equal {} $dir]} { continue }
+	if {[info exists checked($dir)] || ($dir eq {})} { continue }
 	set checked($dir) {}
 	foreach ext $execExtensions {
 	    set file [file join $dir ${name}${ext}]
@@ -666,7 +672,7 @@ proc auto_execok name {
 	return $auto_execs($name)
     }
     foreach dir [split $env(PATH) :] {
-	if {[string equal $dir ""]} {
+	if {$dir eq ""} {
 	    set dir .
 	}
 	set file [file join $dir $name]
@@ -698,7 +704,7 @@ proc tcl::CopyDirectory {action src dest} {
     set nsrc [file normalize $src]
     set ndest [file normalize $dest]
 
-    if {[string equal $action "renaming"]} {
+    if {$action eq "renaming"} {
 	# Can't rename volumes.  We could give a more precise
 	# error message here, but that would break the test suite.
 	if {[lsearch -exact [file volumes] $nsrc] != -1} {
@@ -713,7 +719,7 @@ proc tcl::CopyDirectory {action src dest} {
 	      \"$dest\": trying to rename a volume or move a directory\
 	      into itself"
 	}
-	if {[string equal $action "copying"]} {
+	if {$action eq "copying"} {
 	    # We used to throw an error here, but, looking more closely
 	    # at the core copy code in tclFCmd.c, if the destination
 	    # exists, then we should only call this function if -force