Attachment "patch.txt" to
ticket [491789ffff]
added by
davygrvy
2004-11-03 02:47:18.
*** 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;
}
/*
*----------------------------------------------------------------------
