summaryrefslogtreecommitdiffstats
path: root/generic/tclMain.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2003-09-05 21:52:11 (GMT)
committerdgp <dgp@users.sourceforge.net>2003-09-05 21:52:11 (GMT)
commitc024a2de4b3868a69fd48901c50a0beedb49ed9d (patch)
treed3430b36c25b01800aa40d815fadb9629ef33770 /generic/tclMain.c
parent4383bd1bfc3daa1d69ddcb095a35c5e723f1ba6b (diff)
downloadtcl-c024a2de4b3868a69fd48901c50a0beedb49ed9d.zip
tcl-c024a2de4b3868a69fd48901c50a0beedb49ed9d.tar.gz
tcl-c024a2de4b3868a69fd48901c50a0beedb49ed9d.tar.bz2
* doc/FileSystem.3: Implementation of
* doc/source.n: TIPs 137/151. Adds * doc/tclsh.1: a -encoding option to * generic/tcl.decls: the [source] command * generic/tclCmdMZ.c (Tcl_SourceObjCmd): and a new C routine, * generic/tclIOUtil.c (Tcl_FSEvalFileEx): Tcl_FSEvalFileEx(), * generic/tclMain.c (Tcl_Main): that provides C access * mac/tclMacResource.c (Tcl_MacSourceObjCmd): to the same function. * tests/cmdMZ.test: Also adds command line * tests/main.test: option handling in Tcl_Main() so that tclsh * tests/source.test: and other apps built on Tcl_Main() respect a -encoding command line option before a script filename. Docs and tests updated as well. [Patch 742683] This is a ***POTENTIAL INCOMPATIBILITY*** only for those C programs that embed Tcl, build on Tcl_Main(), and make use of Tcl_Main's former ability to pass a leading "-encoding" option to interactive shell operations. * generic/tclInt.decls: Added internal stub * generic/tclMain.c (Tcl*StartupScript*): table entries for two new functions Tcl_SetStartupScript() and Tcl_GetStartupScript() that set/get the path and encoding for the startup script to be evaluated by either Tcl_Main() or Tk_Main(). Given public names in anticipation of their exposure by a followup TIP. * generic/tclDecls.h: make genstubs * generic/tclIntDecls.h: * generic/tclStubInit.c:
Diffstat (limited to 'generic/tclMain.c')
-rw-r--r--generic/tclMain.c152
1 files changed, 120 insertions, 32 deletions
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 1380ce8..1065951 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.20 2002/05/29 22:59:33 dgp Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.21 2003/09/05 21:52:12 dgp Exp $
*/
#include "tcl.h"
@@ -32,6 +32,7 @@ extern int isatty _ANSI_ARGS_((int fd));
#endif
static Tcl_Obj *tclStartupScriptPath = NULL;
+static Tcl_Obj *tclStartupScriptEncoding = NULL;
static Tcl_MainLoopProc *mainLoopProc = NULL;
@@ -73,32 +74,102 @@ static void StdinProc _ANSI_ARGS_((ClientData clientData,
/*
*----------------------------------------------------------------------
*
- * TclSetStartupScriptPath --
+ * Tcl_SetStartupScript --
*
- * Primes the startup script VFS path, used to override the
- * command line processing.
+ * Sets the path and encoding of the startup script to be evaluated
+ * by Tcl_Main, used to override the command line processing.
*
* Results:
* None.
*
* Side effects:
- * This procedure initializes the VFS path of the Tcl script to
- * run at startup.
*
*----------------------------------------------------------------------
*/
-void TclSetStartupScriptPath(pathPtr)
- Tcl_Obj *pathPtr;
+void Tcl_SetStartupScript(path, encoding)
+ Tcl_Obj *path; /* Filesystem path of startup script file */
+ CONST char *encoding; /* Encoding of the data in that file */
{
+ Tcl_Obj *newEncoding = NULL;
+ if (encoding != NULL) {
+ newEncoding = Tcl_NewStringObj(encoding, -1);
+ }
+
if (tclStartupScriptPath != NULL) {
Tcl_DecrRefCount(tclStartupScriptPath);
}
- tclStartupScriptPath = pathPtr;
+ tclStartupScriptPath = path;
if (tclStartupScriptPath != NULL) {
Tcl_IncrRefCount(tclStartupScriptPath);
}
+
+ if (tclStartupScriptEncoding != NULL) {
+ Tcl_DecrRefCount(tclStartupScriptEncoding);
+ }
+ tclStartupScriptEncoding = newEncoding;
+ if (tclStartupScriptEncoding != NULL) {
+ Tcl_IncrRefCount(tclStartupScriptEncoding);
+ }
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetStartupScript --
+ *
+ * Gets the path and encoding of the startup script to be evaluated
+ * by Tcl_Main.
+ *
+ * Results:
+ * The path of the startup script; NULL if none has been set.
+ *
+ * Side effects:
+ * If encodingPtr is not NULL, stores a (CONST char *) in it
+ * pointing to the encoding name registered for the startup
+ * script. Tcl retains ownership of the string, and may free
+ * it. Caller should make a copy for long-term use.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *Tcl_GetStartupScript(encodingPtr)
+ CONST char** encodingPtr; /* When not NULL, points to storage for
+ * the (CONST char *) that points to the
+ * registered encoding name for the startup
+ * script */
+{
+ if (encodingPtr != NULL) {
+ if (tclStartupScriptEncoding == NULL) {
+ *encodingPtr = NULL;
+ } else {
+ *encodingPtr = Tcl_GetString(tclStartupScriptEncoding);
+ }
+ }
+ return tclStartupScriptPath;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetStartupScriptPath --
+ *
+ * Primes the startup script VFS path, used to override the
+ * command line processing.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This procedure initializes the VFS path of the Tcl script to
+ * run at startup.
+ *
+ *----------------------------------------------------------------------
+ */
+void TclSetStartupScriptPath(path)
+ Tcl_Obj *path;
+{
+ Tcl_SetStartupScript(path, NULL);
+}
/*
*----------------------------------------------------------------------
@@ -118,10 +189,9 @@ void TclSetStartupScriptPath(pathPtr)
*/
Tcl_Obj *TclGetStartupScriptPath()
{
- return tclStartupScriptPath;
+ return Tcl_GetStartupScript(NULL);
}
-
/*
*----------------------------------------------------------------------
*
@@ -142,8 +212,8 @@ Tcl_Obj *TclGetStartupScriptPath()
void TclSetStartupScriptFileName(fileName)
CONST char *fileName;
{
- Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
- TclSetStartupScriptPath(pathPtr);
+ Tcl_Obj *path = Tcl_NewStringObj(fileName,-1);
+ Tcl_SetStartupScript(path, NULL);
}
@@ -165,15 +235,14 @@ void TclSetStartupScriptFileName(fileName)
*/
CONST char *TclGetStartupScriptFileName()
{
- Tcl_Obj *pathPtr = TclGetStartupScriptPath();
+ Tcl_Obj *path = Tcl_GetStartupScript(NULL);
- if (pathPtr == NULL) {
+ if (path == NULL) {
return NULL;
}
- return Tcl_GetString(pathPtr);
+ return Tcl_GetString(path);
}
-
/*
*----------------------------------------------------------------------
@@ -204,8 +273,10 @@ Tcl_Main(argc, argv, appInitProc)
* initialization but before starting to
* execute commands. */
{
+ Tcl_Obj *path;
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
+ CONST char *encodingName = NULL;
char buffer[TCL_INTEGER_SPACE + 5], *args;
PromptType prompt = PROMPT_START;
int code, length, tty;
@@ -220,14 +291,27 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_InitMemory(interp);
/*
- * Make command-line arguments available in the Tcl variables "argc"
- * and "argv". If the first argument doesn't start with a "-" then
- * strip it off and use it as the name of a script file to process.
+ * If the application has not already set a startup script, parse
+ * the first few command line arguments to determine the script
+ * path and encoding.
*/
- if (TclGetStartupScriptPath() == NULL) {
- if ((argc > 1) && (argv[1][0] != '-')) {
- TclSetStartupScriptFileName(argv[1]);
+ if (NULL == Tcl_GetStartupScript(NULL)) {
+
+ /*
+ * Check whether first 3 args (argv[1] - argv[3]) look like
+ * -encoding ENCODING FILENAME
+ * or like
+ * FILENAME
+ */
+
+ if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
+ && ('-' != argv[3][0])) {
+ Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
+ argc -= 3;
+ argv += 3;
+ } else if ((argc > 1) && ('-' != argv[1][0])) {
+ Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
argc--;
argv++;
}
@@ -245,11 +329,14 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_DStringFree(&argString);
ckfree(args);
- if (TclGetStartupScriptPath() == NULL) {
+ path = Tcl_GetStartupScript(&encodingName);
+ if (path == NULL) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
} else {
- TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
- TclGetStartupScriptFileName(), -1, &argString));
+ CONST char *pathName = Tcl_GetStringFromObj(path, &length);
+ Tcl_ExternalToUtfDString(NULL, pathName, length, &argString);
+ path = Tcl_NewStringObj(Tcl_DStringValue(&argString), -1);
+ Tcl_SetStartupScript(path, encodingName);
}
TclFormatInt(buffer, (long) argc-1);
@@ -261,8 +348,7 @@ Tcl_Main(argc, argv, appInitProc)
*/
tty = isatty(0);
- Tcl_SetVar(interp, "tcl_interactive",
- ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
+ Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0",
TCL_GLOBAL_ONLY);
/*
@@ -285,11 +371,13 @@ Tcl_Main(argc, argv, appInitProc)
/*
* If a script file was specified then just source that file
- * and quit.
+ * and quit. Must fetch it again, as the appInitProc might
+ * have reset it.
*/
- if (TclGetStartupScriptPath() != NULL) {
- code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
+ path = Tcl_GetStartupScript(&encodingName);
+ if (path != NULL) {
+ code = Tcl_FSEvalFileEx(interp, path, encodingName);
if (code != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
@@ -510,7 +598,7 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_DeleteInterp(interp);
}
}
- TclSetStartupScriptPath(NULL);
+ Tcl_SetStartupScript(NULL, NULL);
/*
* If we get here, the master interp has been deleted. Allow