Tcl Source Code

    int argc,			/* Number of arguments. */
    char **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc)
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */
{
    Tcl_Obj *path, *resultPtr, *argvPtr, 
	*commandPtr = NULL /* given or input script or command */;
    CONST char *argv0 = argv[0], *encodingName = NULL;
    PromptType prompt = PROMPT_START;
    int code, interact = 0, length, tty, exitCode = 0;
    Tcl_Channel inChannel, outChannel, errChannel;
    Tcl_Interp *interp;
    Tcl_DString appName;

    interp = Tcl_CreateInterp();
    TclpSetInitialEncodings();
    TclpFindExecutable(argv0);

    Tcl_InitMemory(interp);

    /*
     * If the application has not already set a startup script, parse the
     * first few command line arguments to determine the script path and
     * encoding.
     */

    path = Tcl_GetStartupScript(&encodingName);
    argv++; argc--;
    if (path == NULL) {
	/*
	 * Check the enhanced syntax:
	 * 	?-c COMMAND? ?-i? ?-encoding ENCODING? ?FILENAME|--? ?args?
	 */

	while (argc) {
	    const char *opt = argv[0];
	#if defined __WIN32__
	    /* /?   - windows usage wrapper (to -h) */
	    if (*opt == '/' && opt[1] == '?' && opt[2] == '\0') {
		opt = "-h";
	    }
	#endif
	    if (*opt != '-') {
	    	break;
	    }
	    if (argc >= 2) {
		/* -c   - execute the script or the command */
		if (commandPtr == NULL && opt[1] == 'c' && opt[2] == '\0') {
		    commandPtr = Tcl_NewStringObj(argv[1], -1);
		    Tcl_IncrRefCount(commandPtr);
		    argc -= 2;
		    argv += 2;
		    continue;
		}
		/* -e   - encoding of the script to source */
		if ( (opt[1] == 'e' && (opt[2] == '\0' || strcmp("-encoding", opt) == 0))
		  || (opt[1] == '-' && strcmp("--encoding", opt) == 0)) {
		    encodingName = argv[1];
		    argc -= 2;
		    argv += 2;
		    continue;
		}
	    }
	    /* -i   - enter interactive mode after executing the command or the script */
	    if ((opt[1] == 'i' && opt[2] == '\0')
		    || (opt[1] == '-' && strcmp("--interactive", opt) == 0)) {
		interact = 1;
		argc--;
		argv++;
		continue;
	    }
	    /* --   - stop arguments processing (and no file), following all are args */
	    if ((opt[1] == '-' && opt[2] == '\0')) {
		argc--;
		argv++;
		goto start;
	    }
	    /* -v   - print version (and exit if not interactive) */
	    if ((opt[1] == 'v' && opt[2] == '\0')
		    || (opt[1] == '-' && strcmp("--version", opt) == 0)) {
		if (commandPtr) {Tcl_DecrRefCount(commandPtr);};
		commandPtr = Tcl_NewStringObj(
		  "::puts [info patchlevel]", -1);
		Tcl_IncrRefCount(commandPtr);
		argc = 0;
		goto start;
	    }
	    /* -h   - print syntax (and exit if not interactive) */
	    if ((opt[1] == 'h' && opt[2] == '\0')
		    || (opt[1] == '-' && strcmp("--help", opt) == 0)) {
		if (commandPtr) {Tcl_DecrRefCount(commandPtr);};
		commandPtr = Tcl_NewStringObj(
		  "::puts \"[file tail $::argv0] ?-c command? ?-i?"
		    " ?-e|--encoding name? ?fileName|--? ?arg arg ...?\n"
		  "[file tail $::argv0] ?-v|--version? ?-h|--help?\";", -1);
		Tcl_IncrRefCount(commandPtr);
		argc = 0;
		goto start;
	    }
	    /* default - unknown argument (filename?) */
	    break;
	}

	/*
	 * Check whether first args look like FILENAME (avoid if starts with '-'

	 * for backwards-compatibility reasons).

	 */

	if ((argc >= 1) && (*argv[0] != '-')) {

	    path = Tcl_NewStringObj(argv[0], -1);



	    Tcl_SetStartupScript(path, encodingName);
	    argc--;
	    argv++;
	}
    }

start:
    if (path == NULL) {
	Tcl_ExternalToUtfDString(NULL, argv0, -1, &appName);
    } else {
	CONST char *pathName = Tcl_GetStringFromObj(path, &length);
	Tcl_ExternalToUtfDString(NULL, pathName, length, &appName);
	path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
	Tcl_SetStartupScript(path, encodingName);
    }
    Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&appName);



    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);

    argvPtr = Tcl_NewListObj(0, NULL);
    while (argc--) {
	Tcl_DString ds;
	Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
	Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
		Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
	Tcl_DStringFree(&ds);
    }
    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);

    /*
     * Set the "tcl_interactive" variable.
     */

    tty = isatty(0);
    interact |= ((commandPtr == NULL) && (path == NULL) && tty);
    Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, Tcl_NewIntObj(interact),
	    TCL_GLOBAL_ONLY);

    /*
     * Invoke application-specific initialization.
     */

    Tcl_Preserve((ClientData) interp);
    if ((*appInitProc)(interp) != TCL_OK) {
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	if (errChannel) {
	    Tcl_WriteChars(errChannel,
		    "application-specific initialization failed: ", -1);
	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
	    Tcl_WriteChars(errChannel, "\n", 1);
	}
    }
    if (Tcl_InterpDeleted(interp) || Tcl_LimitExceeded(interp)) {
	goto done;
    }

    /*
     * If a (pre)script was specified with "-c" then just execute that here.
     */

    if (commandPtr != NULL) {
	code = Tcl_EvalObjEx(interp, commandPtr, 0);
	if (code != TCL_OK) {
	    goto exit_error;
	}
    }

    if (Tcl_InterpDeleted(interp) || Tcl_LimitExceeded(interp)) {
	goto done;
    }

    /*
     * If a script file was specified then just source that file and quit.
     * Must fetch it again, as the appInitProc might have reset it.
     */

    path = Tcl_GetStartupScript(&encodingName);
    if (path != NULL) {
	code = Tcl_FSEvalFileEx(interp, path, encodingName);
	if (code != TCL_OK) {

exit_error:

	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
	    if (errChannel) {
		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
		Tcl_Obj *keyPtr, *valuePtr;

		TclNewLiteralStringObj(keyPtr, "-errorinfo");
		Tcl_IncrRefCount(keyPtr);
		Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
		Tcl_DecrRefCount(keyPtr);

		if (valuePtr) {
		    Tcl_WriteObj(errChannel, valuePtr);
		}
		Tcl_WriteChars(errChannel, "\n", 1);
		Tcl_DecrRefCount(options);
	    }
	    exitCode = 1;
	}
    }

    /*
     * If not interactive, exit
     */
    if (!interact) {
	if (exitCode == 0 && commandPtr != NULL) {
	    /* output the last result if not empty (enhanced by -c syntax) */
	    Tcl_Obj *res = Tcl_GetObjResult(interp);
	    if (Tcl_GetString(res) && res->length) {
		outChannel = Tcl_GetStdChannel(TCL_STDOUT);
		Tcl_WriteObj(outChannel, res);
		Tcl_WriteChars(outChannel, "\n", 1);
	    }
	}
	goto done;
    }
    exitCode = 0;
    if (commandPtr != NULL) {
	Tcl_DecrRefCount(commandPtr);
	commandPtr = NULL;
    }

    /*
     * We're running interactively. Source a user-specific startup file if the
     * application specified one and if the file exists.
     */

    Tcl_SourceRCFile(interp);