diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 6 | ||||
| -rw-r--r-- | generic/tclCmdAH.c | 41 | ||||
| -rw-r--r-- | generic/tclInt.h | 5 | ||||
| -rw-r--r-- | generic/tclInterp.c | 68 |
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; } /* |