summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-04-19 16:32:51 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-04-19 16:32:51 (GMT)
commit7d6158ddbd0deb5c5320cfa94ce50e58bdf6ecfc (patch)
tree0b4e1a36e2352961dd37023905e31057474481de /generic
parent8083af6181543c3852c249319b540c74186e6967 (diff)
downloadtcl-7d6158ddbd0deb5c5320cfa94ce50e58bdf6ecfc.zip
tcl-7d6158ddbd0deb5c5320cfa94ce50e58bdf6ecfc.tar.gz
tcl-7d6158ddbd0deb5c5320cfa94ce50e58bdf6ecfc.tar.bz2
* 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.)
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclCmdAH.c41
-rw-r--r--generic/tclInt.h5
-rw-r--r--generic/tclInterp.c68
4 files changed, 51 insertions, 69 deletions
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;
}
/*