*** generic/tcl.decls 13 May 2004 12:59:20 -0000 1.104 --- generic/tcl.decls 2 Nov 2004 19:38:09 -0000 *************** *** 1909,1915 **** declare 534 generic { int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type) } ! ############################################################################## # Define the platform specific public Tcl interface. These functions are --- 1909,1917 ---- declare 534 generic { int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type) } ! declare 535 generic { ! int Tcl_UniMain(int argc, Tcl_UniChar **wargv, Tcl_AppInitProc *appInitProc) ! } ############################################################################## # Define the platform specific public Tcl interface. These functions are *** generic/tclDecls.h 7 Jun 2004 16:48:44 -0000 1.105 --- generic/tclDecls.h 2 Nov 2004 19:38:18 -0000 *************** *** 3314,3319 **** --- 3314,3326 ---- EXTERN int Tcl_LimitGetGranularity _ANSI_ARGS_(( Tcl_Interp * interp, int type)); #endif + #ifndef Tcl_UniMain_TCL_DECLARED + #define Tcl_UniMain_TCL_DECLARED + /* 535 */ + EXTERN int Tcl_UniMain _ANSI_ARGS_((int argc, + Tcl_UniChar ** wargv, + Tcl_AppInitProc * appInitProc)); + #endif typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; *************** *** 3890,3895 **** --- 3897,3903 ---- int (*tcl_LimitGetCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 532 */ void (*tcl_LimitGetTime) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Time * timeLimitPtr)); /* 533 */ int (*tcl_LimitGetGranularity) _ANSI_ARGS_((Tcl_Interp * interp, int type)); /* 534 */ + int (*tcl_UniMain) _ANSI_ARGS_((int argc, Tcl_UniChar ** wargv, Tcl_AppInitProc * appInitProc)); /* 535 */ } TclStubs; #ifdef __cplusplus *************** *** 6070,6075 **** --- 6078,6087 ---- #define Tcl_LimitGetGranularity \ (tclStubsPtr->tcl_LimitGetGranularity) /* 534 */ #endif + #ifndef Tcl_UniMain + #define Tcl_UniMain \ + (tclStubsPtr->tcl_UniMain) /* 535 */ + #endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ *** generic/tclMain.c 25 Oct 2004 17:24:39 -0000 1.29 --- generic/tclMain.c 2 Nov 2004 19:38:22 -0000 *************** *** 324,342 **** * initialization but before starting to * execute commands. */ { Tcl_Obj *path; Tcl_Obj *resultPtr; Tcl_Obj *commandPtr = NULL; CONST char *encodingName = NULL; - char *args; PromptType prompt = PROMPT_START; ! int code, length, tty; int exitCode = 0; Tcl_Channel inChannel, outChannel, errChannel; Tcl_Interp *interp; ! Tcl_DString argString; ! Tcl_FindExecutable(argv[0]); interp = Tcl_CreateInterp(); Tcl_InitMemory(interp); --- 324,405 ---- * initialization but before starting to * execute commands. */ { + int i, exitCode; + Tcl_UniChar **uniArgv; + Tcl_DString dst; + Tcl_Obj **dstObj; + + Tcl_FindExecutable(argv[0]); + + dstObj = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * argc); + uniArgv = (wchar_t **) ckalloc(sizeof(wchar_t *) * argc); + + /* + * Convert all args up to unicode. + */ + for (i = 0; i < argc; i++) { + Tcl_ExternalToUtfDString(NULL, argv[i], -1, &dst); + dstObj[i] = Tcl_NewStringObj(Tcl_DStringValue(&dst), Tcl_DStringLength(&dst)); + uniArgv[i] = Tcl_GetUnicodeFromObj(dstObj[i], NULL); + } + Tcl_DStringFree(&dst); + + exitCode = Tcl_UniMain(argc, uniArgv, appInitProc); + + /* + * Reclaim memory from the conversion. + */ + for (i = 0; i < argc; i++) { + Tcl_DecrRefCount(dstObj[i]); + } + ckfree((char *)dstObj); + ckfree((char *)uniArgv); + + /* exit here, do not return. */ + Tcl_Exit(exitCode); + } + + /*---------------------------------------------------------------------- + * + * Tcl_WMain -- + * + * Main program for tclsh and most other Tcl-based applications. + * + * Results: + * None. This procedure never returns (it exits the process when + * it's done). + * + * Side effects: + * This procedure initializes the Tcl world and then starts + * interpreting commands; almost anything could happen, depending + * on the script being interpreted. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_UniMain(argc, wargv, appInitProc) + int argc; /* Number of arguments. */ + Tcl_UniChar **wargv; /* Array of unicode argument strings. */ + Tcl_AppInitProc *appInitProc; + /* Application-specific initialization + * procedure to call after most + * initialization but before starting to + * execute commands. */ + { Tcl_Obj *path; Tcl_Obj *resultPtr; Tcl_Obj *commandPtr = NULL; CONST char *encodingName = NULL; PromptType prompt = PROMPT_START; ! int code, length, tty, i; int exitCode = 0; Tcl_Channel inChannel, outChannel, errChannel; Tcl_Interp *interp; ! Tcl_Obj *wargvObj; ! Tcl_FindExecutable(_pgmptr); ! // cheat for now -----^ interp = Tcl_CreateInterp(); Tcl_InitMemory(interp); *************** *** 356,398 **** * 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++; } } ! /* ! * The CONST casting is safe, and better we do it here than force ! * all callers of Tcl_Main to do it. (Those callers are likely ! * in a main() that can't easily change its signature.) ! */ ! ! args = Tcl_Merge(argc-1, (CONST char **)argv+1); ! Tcl_ExternalToUtfDString(NULL, args, -1, &argString); ! Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); ! Tcl_DStringFree(&argString); ! ckfree(args); path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { ! Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString); ! } else { ! CONST char *pathName = Tcl_GetStringFromObj(path, &length); ! Tcl_ExternalToUtfDString(NULL, pathName, length, &argString); ! path = Tcl_NewStringObj(Tcl_DStringValue(&argString), -1); ! Tcl_SetStartupScript(path, encodingName); } Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc-1), TCL_GLOBAL_ONLY); ! Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); /* * Set the "tcl_interactive" variable. --- 419,454 ---- * FILENAME */ ! if ((argc > 3) && (0 == wcscmp(L"-encoding", wargv[1])) ! && (L'-' != wargv[3][0])) { ! Tcl_Obj *encoding = Tcl_NewUnicodeObj(wargv[2], -1); ! Tcl_SetStartupScript(Tcl_NewUnicodeObj(wargv[3], -1), ! Tcl_GetString(encoding)); ! Tcl_DecrRefCount(encoding); argc -= 3; ! wargv += 3; ! } else if ((argc > 1) && (L'-' != wargv[1][0])) { ! Tcl_SetStartupScript(Tcl_NewUnicodeObj(wargv[1], -1), NULL); argc--; ! wargv++; } } ! wargvObj = Tcl_NewObj(); ! for (i = 1; i < argc; i++) { ! Tcl_ListObjAppendElement(NULL, wargvObj, ! Tcl_NewUnicodeObj(wargv[i], -1)); ! } ! Tcl_SetVar2Ex(interp, "argv", NULL, wargvObj, TCL_GLOBAL_ONLY); path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { ! path = Tcl_NewUnicodeObj(wargv[0], -1); } Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc-1), TCL_GLOBAL_ONLY); ! Tcl_SetVar2Ex(interp, "argv0", NULL, path, TCL_GLOBAL_ONLY); /* * Set the "tcl_interactive" variable. *************** *** 453,459 **** } goto done; } - Tcl_DStringFree(&argString); /* * We're running interactively. Source a user-specific startup --- 509,514 ---- *************** *** 674,680 **** */ Tcl_Release((ClientData) interp); ! Tcl_Exit(exitCode); } /* --- 729,735 ---- */ Tcl_Release((ClientData) interp); ! return exitCode; } /* *** generic/tclStubInit.c 27 Oct 2004 17:13:58 -0000 1.106 --- generic/tclStubInit.c 2 Nov 2004 19:38:27 -0000 *************** *** 941,946 **** --- 941,947 ---- Tcl_LimitGetCommands, /* 532 */ Tcl_LimitGetTime, /* 533 */ Tcl_LimitGetGranularity, /* 534 */ + Tcl_UniMain, /* 535 */ }; /* !END!: Do not edit above this line. */ *** win/tclAppInit.c 28 Oct 2004 04:53:42 -0000 1.21 --- win/tclAppInit.c 2 Nov 2004 19:38:34 -0000 *************** *** 25,33 **** extern Tcl_PackageInitProc TclObjTest_Init; #endif /* TCL_TEST */ ! #if defined(__GNUC__) ! static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr)); ! #endif /* __GNUC__ */ static BOOL WINAPI sigHandler (DWORD fdwCtrlType); static Tcl_AsyncProc asyncExit; static void AppInitExitHandler(ClientData clientData); --- 25,31 ---- extern Tcl_PackageInitProc TclObjTest_Init; #endif /* TCL_TEST */ ! static void SetWargv (int *argcPtr, Tcl_UniChar ***wargvPtr); static BOOL WINAPI sigHandler (DWORD fdwCtrlType); static Tcl_AsyncProc asyncExit; static void AppInitExitHandler(ClientData clientData); *************** *** 54,61 **** */ int ! main (int argc, char *argv[]) { /* * The following #if block allows you to change the AppInit * function by using a #define of TCL_LOCAL_APPINIT instead --- 52,62 ---- */ int ! main (void) { + int argc; + Tcl_UniChar **wargv; + int exitCode; /* * The following #if block allows you to change the AppInit * function by using a #define of TCL_LOCAL_APPINIT instead *************** *** 75,112 **** */ #ifdef TCL_LOCAL_MAIN_HOOK ! extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv)); #endif - char *p; - /* * Set up the default locale to be standard "C" locale so parsing * is performed correctly. */ ! #if defined(__GNUC__) ! setargv( &argc, &argv ); ! #endif setlocale(LC_ALL, "C"); - /* - * Forward slashes substituted for backslashes. - */ ! for (p = argv[0]; *p != '\0'; p++) { ! if (*p == '\\') { ! *p = '/'; ! } ! } ! ! #ifdef TCL_LOCAL_MAIN_HOOK ! TCL_LOCAL_MAIN_HOOK(&argc, &argv); #endif ! Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); ! return 0; /* Needed only to prevent compiler warning. */ } /* --- 76,102 ---- */ #ifdef TCL_LOCAL_MAIN_HOOK ! extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, Tcl_UniChar ***wargv)); #endif /* * Set up the default locale to be standard "C" locale so parsing * is performed correctly. */ ! SetWargv( &argc, &wargv ); setlocale(LC_ALL, "C"); ! #ifdef TCL_LOCAL_WMAIN_HOOK ! TCL_LOCAL_WMAIN_HOOK(&argc, &wargv); #endif ! exitCode = Tcl_UniMain(argc, wargv, TCL_LOCAL_APPINIT); ! Tcl_Free((char *)wargv); ! Tcl_Finalize(); ! return exitCode; } /* *************** *** 242,248 **** /* *------------------------------------------------------------------------- * ! * setargv -- * * Parse the Windows command line string into argc/argv. Done here * because we don't trust the builtin argument parser in crt0. --- 232,238 ---- /* *------------------------------------------------------------------------- * ! * SetWargv -- * * Parse the Windows command line string into argc/argv. Done here * because we don't trust the builtin argument parser in crt0. *************** *** 266,282 **** *-------------------------------------------------------------------------- */ - #if defined(__GNUC__) static void ! setargv(argcPtr, argvPtr) ! int *argcPtr; /* Filled with number of argument strings. */ ! char ***argvPtr; /* Filled with argument strings (malloc'd). */ { ! char *cmdLine, *p, *arg, *argSpace; ! char **argv; ! int argc, size, inquote, copy, slashes; ! cmdLine = GetCommandLine(); /* INTL: BUG */ /* * Precompute an overly pessimistic guess at the number of arguments --- 256,273 ---- *-------------------------------------------------------------------------- */ static void ! SetWargv( ! int *argcPtr, /* Filled with number of argument strings. */ ! Tcl_UniChar ***wargvPtr) /* Filled with argument wstrings (Tcl_Alloc'd). */ { ! Tcl_UniChar *cmdLine, *p, *arg, *argSpace; ! Tcl_UniChar **argv; ! int argc, size, inquote, copy, slashes, i; ! static Tcl_UniChar argv0[MAX_PATH] = {L'\0'}; ! /* GetCommandLineW is supported on all WIN32 platforms. */ ! cmdLine = GetCommandLineW(); /* * Precompute an overly pessimistic guess at the number of arguments *************** *** 284,313 **** */ size = 2; ! for (p = cmdLine; *p != '\0'; p++) { ! if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ size++; ! while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ p++; } ! if (*p == '\0') { break; } } } ! argSpace = (char *) Tcl_Alloc( ! (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1)); ! argv = (char **) argSpace; ! argSpace += size * sizeof(char *); size--; p = cmdLine; for (argc = 0; argc < size; argc++) { argv[argc] = arg = argSpace; ! while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ p++; } ! if (*p == '\0') { break; } --- 275,306 ---- */ size = 2; ! for (p = cmdLine; *p != L'\0'; p++) { ! if ((*p == L' ') || (*p == L'\t')) { /* INTL: ISO space. */ size++; ! while ((*p == L' ') || (*p == L'\t')) { /* INTL: ISO space. */ p++; } ! if (*p == L'\0') { break; } } } ! argSpace = (Tcl_UniChar *) Tcl_Alloc( ! (unsigned) ((size * sizeof(Tcl_UniChar *)) + ! (wcslen(cmdLine)*sizeof(Tcl_UniChar)) + ! sizeof(Tcl_UniChar))); ! argv = (Tcl_UniChar **) argSpace; ! argSpace += size; size--; p = cmdLine; for (argc = 0; argc < size; argc++) { argv[argc] = arg = argSpace; ! while ((*p == L' ') || (*p == L'\t')) { /* INTL: ISO space. */ p++; } ! if (*p == L'\0') { break; } *************** *** 315,328 **** slashes = 0; while (1) { copy = 1; ! while (*p == '\\') { slashes++; p++; } ! if (*p == '"') { if ((slashes & 1) == 0) { copy = 0; ! if ((inquote) && (p[1] == '"')) { p++; copy = 1; } else { --- 308,321 ---- slashes = 0; while (1) { copy = 1; ! while (*p == L'\\') { slashes++; p++; } ! if (*p == L'"') { if ((slashes & 1) == 0) { copy = 0; ! if ((inquote) && (p[1] == L'"')) { p++; copy = 1; } else { *************** *** 333,345 **** } while (slashes) { ! *arg = '\\'; arg++; slashes--; } ! if ((*p == '\0') ! || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ break; } if (copy != 0) { --- 326,338 ---- } while (slashes) { ! *arg = L'\\'; arg++; slashes--; } ! if ((*p == L'\0') ! || (!inquote && ((*p == L' ') || (*p == L'\t')))) { /* INTL: ISO space. */ break; } if (copy != 0) { *************** *** 348,362 **** } p++; } ! *arg = '\0'; argSpace = arg + 1; } argv[argc] = NULL; *argcPtr = argc; ! *argvPtr = argv; } - #endif /* __GNUC__ */ /* *---------------------------------------------------------------------- --- 341,361 ---- } p++; } ! *arg = L'\0'; argSpace = arg + 1; } + /* Replace argv[0] with the fullpath exe name */ + GetModuleFileNameW(NULL, argv0, MAX_PATH); + for (i = 0; i < MAX_PATH; i++) { + if (argv0[i] == L'\\') argv0[i] = L'/'; + else if (argv0[i] == L'\0') break; + } + argv[0] = argv0; argv[argc] = NULL; *argcPtr = argc; ! *wargvPtr = argv; } /* *----------------------------------------------------------------------