diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-06-08 20:53:38 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2012-06-08 20:53:38 (GMT) |
commit | fdeacfff80a809cc26b4720c429274a5ed6331b4 (patch) | |
tree | 977529b36dc0a15ced58f91aaca5c7cb0610c7e6 | |
parent | 38172ef34fbe08d6cfd4eb8e4ed8d1fa21d69c8f (diff) | |
download | tk-fdeacfff80a809cc26b4720c429274a5ed6331b4.zip tk-fdeacfff80a809cc26b4720c429274a5ed6331b4.tar.gz tk-fdeacfff80a809cc26b4720c429274a5ed6331b4.tar.bz2 |
Implement TkCygwinMainEx for loading Cygwin's Tk_MainEx from the Tk dll
-rw-r--r-- | ChangeLog | 5 | ||||
-rw-r--r-- | generic/tkMain.c | 35 | ||||
-rw-r--r-- | generic/tkWindow.c | 147 | ||||
-rw-r--r-- | unix/Makefile.in | 27 |
4 files changed, 145 insertions, 69 deletions
@@ -1,3 +1,8 @@ +2012-06-08 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkMain.c: Implement TkCygwinMainEx for loading + * generic/tkWindow.c: Cygwin's Tk_MainEx from the Tk dll. + 2012-06-07 Jan Nijtmans <nijtmans@users.sf.net> * generic/tkInt.decls: Change XChangeWindowAttributes signature and diff --git a/generic/tkMain.c b/generic/tkMain.c index f400c05..6b9a393 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -1,4 +1,4 @@ -/* +/* * tkMain.c -- * * This file contains a generic main program for Tk-based applications. @@ -41,7 +41,7 @@ typedef struct ThreadSpecificData { * into Tcl commands. */ Tcl_DString line; /* Used to read the next line from the * terminal input. */ - int tty; /* Non-zero means standard input is a + int tty; /* Non-zero means standard input is a * terminal-like device. Zero means it's * a file. */ } ThreadSpecificData; @@ -155,15 +155,20 @@ Tk_MainEx(argc, argv, appInitProc, interp) abort(); } -#if defined(__WIN32__) && !defined(STATIC_BUILD) +#if defined(__WIN32__) && !defined(__WIN64__) && !defined(STATIC_BUILD) + extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *); + if (tclStubsPtr->reserved9) { /* We are running win32 Tk under Cygwin, so let's check * whether the env("DISPLAY") variable or the -display * argument is set. If so, we really want to run the - * Tk_MainEx function of libtk.dll, not this one. */ - if (Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY)) { + * Tk_MainEx function of libtk8.?.dll, not this one. */ + if (Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY)) { loadCygwinTk: - Tcl_Panic("Should load libtk.dll now, not yet implemented"); + if (TkCygwinMainEx(argc, argv, appInitProc, interp)) { + /* Should never reach here. */ + return; + } } else { int i; @@ -176,9 +181,9 @@ Tk_MainEx(argc, argv, appInitProc, interp) } #endif - tsdPtr = (ThreadSpecificData *) + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - + Tcl_FindExecutable(argv[0]); tsdPtr->interp = interp; Tcl_Preserve((ClientData) interp); @@ -197,7 +202,7 @@ Tk_MainEx(argc, argv, appInitProc, interp) TkMacOSXDefaultStartupScript(); } #endif - + #ifdef TCL_MEM_DEBUG Tcl_InitMemory(interp); #endif @@ -223,7 +228,7 @@ Tk_MainEx(argc, argv, appInitProc, interp) argv++; } } - + /* * Make command-line arguments available in the Tcl variables "argc" * and "argv". @@ -264,7 +269,7 @@ Tk_MainEx(argc, argv, appInitProc, interp) * of length 0, (e.g. /dev/null, which is what Finder sets when double * clicking Wish) then use the GUI console. */ - + if (!tsdPtr->tty) { struct stat st; @@ -375,7 +380,7 @@ StdinProc(clientData, mask) char *cmd; int code, count; Tcl_Channel chan = (Tcl_Channel) clientData; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_Interp *interp = tsdPtr->interp; @@ -389,7 +394,7 @@ StdinProc(clientData, mask) Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); } return; - } + } } (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue( @@ -412,7 +417,7 @@ StdinProc(clientData, mask) Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan); code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); - + chan = Tcl_GetStdChannel(TCL_STDIN); if (chan) { Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, @@ -496,7 +501,7 @@ defaultPrompt: * is possible that someone has transferred stderr out of * this interpreter with "interp transfer". */ - + errChannel = Tcl_GetChannel(interp, "stderr", NULL); if (errChannel != (Tcl_Channel) NULL) { Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 21675d0..c442ef4 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -1,4 +1,4 @@ -/* +/* * tkWindow.c -- * * This file provides basic window-manipulation procedures, @@ -24,7 +24,7 @@ #include "tclInt.h" /* for Tcl_CreateNamespace() */ -/* +/* * Type used to keep track of Window objects that were * only partically deallocated by Tk_DestroyWindow. */ @@ -52,15 +52,15 @@ typedef struct ThreadSpecificData { /* First in list of partially deallocated * windows. */ TkDisplay *displayList; - /* List of all displays currently in use by + /* List of all displays currently in use by * the current thread. */ - int initialized; /* 0 means the structures above need + int initialized; /* 0 means the structures above need * initializing. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -/* - * The Mutex below is used to lock access to the Tk_Uid structs above. +/* + * The Mutex below is used to lock access to the Tk_Uid structs above. */ TCL_DECLARE_MUTEX(windowMutex) @@ -222,7 +222,7 @@ static Tk_ArgvInfo argTable[] = { */ static Tk_Window CreateTopLevelWindow _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Window parent, CONST char *name, + Tk_Window parent, CONST char *name, CONST char *screenName, unsigned int flags)); static void DeleteWindowsExitProc _ANSI_ARGS_(( ClientData clientData)); @@ -335,7 +335,7 @@ CreateTopLevelWindow(interp, parent, name, screenName, flags) register TkWindow *winPtr; register TkDisplay *dispPtr; int screenId; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { @@ -382,9 +382,9 @@ CreateTopLevelWindow(interp, parent, name, screenName, flags) * Set the flags specified in the call. */ winPtr->flags |= flags; - + /* - * Force the window to use a border pixel instead of border pixmap. + * Force the window to use a border pixel instead of border pixmap. * This is needed for the case where the window doesn't use the * default visual. In this case, the default border is a pixmap * inherited from the root window, which won't work because it will @@ -447,7 +447,7 @@ GetScreen(interp, screenName, screenPtr) CONST char *p; int screenId; size_t length; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -523,7 +523,7 @@ GetScreen(interp, screenName, screenPtr) } if (screenId >= ScreenCount(dispPtr->display)) { char buf[32 + TCL_INTEGER_SPACE]; - + sprintf(buf, "bad screen number \"%d\"", screenId); Tcl_SetResult(interp, buf, TCL_VOLATILE); return (TkDisplay *) NULL; @@ -537,7 +537,7 @@ GetScreen(interp, screenName, screenPtr) * * TkGetDisplay -- * - * Given an X display, TkGetDisplay returns the TkDisplay + * Given an X display, TkGetDisplay returns the TkDisplay * structure for the display. * * Results: @@ -555,7 +555,7 @@ TkGetDisplay(display) Display *display; /* X's display pointer */ { TkDisplay *dispPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (dispPtr = tsdPtr->displayList; dispPtr != NULL; @@ -587,9 +587,9 @@ TkGetDisplay(display) TkDisplay * TkGetDisplayList() { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - + return tsdPtr->displayList; } @@ -614,9 +614,9 @@ TkGetDisplayList() TkMainInfo * TkGetMainInfoList() { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - + return tsdPtr->mainWindowList; } /* @@ -859,7 +859,7 @@ TkCreateMainWindow(interp, screenName, baseName) register TkWindow *winPtr; register CONST TkCmd *cmdPtr; ClientData clientData; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -880,7 +880,7 @@ TkCreateMainWindow(interp, screenName, baseName) if (tkwin == NULL) { return NULL; } - + /* * Create the TkMainInfo structure for this application, and set * up name-related information for the new window. @@ -1208,11 +1208,11 @@ Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName) return NULL; } if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, + Tcl_AppendResult(interp, "can't create window: parent has been destroyed", (char *) NULL); return NULL; } else if (((TkWindow *) parent)->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, + Tcl_AppendResult(interp, "can't create window: its parent has -container = yes", (char *) NULL); return NULL; @@ -1269,7 +1269,7 @@ Tk_DestroyWindow(tkwin) TkDisplay *dispPtr = winPtr->dispPtr; XEvent event; TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->flags & TK_ALREADY_DEAD) { @@ -1541,12 +1541,12 @@ Tk_DestroyWindow(tkwin) (void (*) _ANSI_ARGS_((ClientData))) NULL); } Tcl_CreateCommand(winPtr->mainPtr->interp, "send", - TkDeadAppCmd, (ClientData) NULL, + TkDeadAppCmd, (ClientData) NULL, (void (*) _ANSI_ARGS_((ClientData))) NULL); Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif"); Tcl_UnlinkVar(winPtr->mainPtr->interp, "::tk::AlwaysShowSelection"); } - + Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable); TkBindFree(winPtr->mainPtr); TkDeleteAllImages(winPtr->mainPtr); @@ -1555,14 +1555,14 @@ Tk_DestroyWindow(tkwin) TkStylePkgFree(winPtr->mainPtr); /* - * When embedding Tk into other applications, make sure + * When embedding Tk into other applications, make sure * that all destroy events reach the server. Otherwise * the embedding application may also attempt to destroy * the windows, resulting in an X error */ if (winPtr->flags & TK_EMBEDDED) { - XSync(winPtr->display, False); + XSync(winPtr->display, False); } ckfree((char *) winPtr->mainPtr); @@ -1586,13 +1586,13 @@ Tk_DestroyWindow(tkwin) * addressed before this can be enabled. The current cleanup * works except for send event issues. -- hobbs 04/2002 */ - + TkDisplay *theDispPtr, *backDispPtr; - + /* * Splice this display out of the list of displays. */ - + for (theDispPtr = tsdPtr->displayList, backDispPtr = NULL; (theDispPtr != winPtr->dispPtr) && (theDispPtr != NULL); @@ -2118,7 +2118,7 @@ Tk_DefineCursor(tkwin, cursor) #else winPtr->atts.cursor = (Cursor) cursor; #endif - + if (winPtr->window != None) { XDefineCursor(winPtr->display, winPtr->window, winPtr->atts.cursor); } else { @@ -2346,7 +2346,7 @@ Tk_NameToWindow(interp, pathName, tkwin) Tcl_AppendResult(interp, "NULL main window", (char *)NULL); return NULL; } - + hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->nameTable, pathName); if (hPtr == NULL) { @@ -2635,7 +2635,7 @@ Tk_MainWindow(interp) return NULL; } #endif - tsdPtr = (ThreadSpecificData *) + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL; @@ -2704,7 +2704,7 @@ Tk_GetNumMainWindows() } #endif - tsdPtr = (ThreadSpecificData *) + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); return tsdPtr->numMainWindows; @@ -2789,7 +2789,7 @@ DeleteWindowsExitProc(clientData) * Destroy any remaining main windows. */ - while (tsdPtr->mainWindowList != NULL) { + while (tsdPtr->mainWindowList != NULL) { interp = tsdPtr->mainWindowList->interp; Tcl_Preserve((ClientData) interp); Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr); @@ -2815,7 +2815,7 @@ DeleteWindowsExitProc(clientData) * if it needs to dispatch a message. */ - for (tsdPtr->displayList = NULL; dispPtr != NULL; + for (tsdPtr->displayList = NULL; dispPtr != NULL; dispPtr = nextPtr) { nextPtr = dispPtr->nextPtr; TkCloseDisplay(dispPtr); @@ -2827,6 +2827,51 @@ DeleteWindowsExitProc(clientData) tsdPtr->initialized = 0; } +#if defined(__WIN32__) && !defined(__WIN64__) + +static HMODULE tkcygwindll = NULL; + +/* + * Run Tk_MainEx from libtk8.?.dll + * + * This function is only ever called from wish8.4.exe, the cygwin + * port of Tcl. This means that the system encoding is utf-8, + * so we don't have to do any encoding conversions. + */ +int +TkCygwinMainEx(argc, argv, appInitProc, interp) + int argc; /* Number of arguments. */ + char **argv; /* Array of argument strings. */ + Tcl_AppInitProc *appInitProc; /* Application-specific initialization + * procedure to call after most + * initialization but before starting + * to execute commands. */ + Tcl_Interp *interp; +{ + char name[MAX_PATH]; + int len; + void (*sym)(int, char **, Tcl_AppInitProc *, Tcl_Interp *); + + /* construct "<path>/libtk8.?.dll", from "<path>/tk8?.dll" */ + len = GetModuleFileName(Tk_GetHINSTANCE(), name, MAX_PATH); + name[len-2] = '.'; + name[len-1] = name[len-5]; + strcpy(name+len, ".dll"); + memcpy(name+len-8, "libtk8", 6); + + tkcygwindll = LoadLibrary(name); + if (!tkcygwindll) { + /* dll is not present */ + return 0; + } + sym = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_MainEx"); + if (!sym) { + return 0; + } + sym(argc, argv, appInitProc, interp); + return 1; +} +#endif /* *---------------------------------------------------------------------- * @@ -2855,6 +2900,16 @@ int Tk_Init(interp) Tcl_Interp *interp; /* Interpreter to initialize. */ { +#if defined(__WIN32__) && !defined(__WIN64__) + if (tkcygwindll) { + int (*sym)(Tcl_Interp *); + + sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_Init"); + if (sym) { + return sym(interp); + } + } +#endif return Initialize(interp); } @@ -2917,6 +2972,16 @@ Tk_SafeInit(interp) * is checked at several places to differentiate the two initialisations. */ +#if defined(__WIN32__) && !defined(__WIN64__) + if (tkcygwindll) { + int (*sym)(Tcl_Interp *); + + sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_SafeInit"); + if (sym) { + return sym(interp); + } + } +#endif return Initialize(interp); } @@ -2945,12 +3010,12 @@ Initialize(interp) { char *p; int argc, code; - CONST char **argv; + CONST char **argv; char *args[20]; CONST char *argString = NULL; Tcl_DString class; ThreadSpecificData *tsdPtr; - + /* * Ensure that we are getting the matching version of Tcl. This is * really only an issue when Tk is loaded dynamically. @@ -2965,7 +3030,7 @@ Initialize(interp) */ TkRegisterObjTypes(); - tsdPtr = (ThreadSpecificData *) + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -3043,13 +3108,13 @@ Initialize(interp) * We don't. (no API to do it and maybe security reasons). */ Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, + Tcl_AppendResult(interp, "not allowed to start Tk by master's safe::TkInit", (char *) NULL); goto done; } Tcl_DStringFree(&ds); - /* + /* * Use the master's result as argv. * Note: We don't use the Obj interfaces to avoid dealing with * cross interp refcounting and changing the code below. diff --git a/unix/Makefile.in b/unix/Makefile.in index 765bdc1..2aff5cc 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -212,6 +212,7 @@ BUILD_TCLSH = @BUILD_TCLSH@ # make dist. This variable is set to "" if no tclsh is available. TCL_EXE = @TCLSH_PROG@ WISH_EXE = wish +TKTEST_EXE = tktest # Tk used to let the configure script choose which program to use # for installing, but there are just too many different versions of @@ -559,12 +560,12 @@ ${WISH_EXE}: $(WISH_OBJS) $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) @APP_RSRC_FILE@ # picking up an already installed version of the Tcl or # Tk shared libraries. -tktest: $(TKTEST_OBJS) $(TK_LIB_FILE) +$(TKTEST_EXE): $(TKTEST_OBJS) $(TK_LIB_FILE) $(MAKE) tktest-real LIB_RUNTIME_DIR="`pwd`:$(TCL_BIN_DIR)" tktest-real: ${CC} ${CFLAGS} ${LDFLAGS} $(TKTEST_OBJS) @TK_BUILD_LIB_SPEC@ \ - $(WISH_LIBS) $(CC_SEARCH_FLAGS) -o tktest + $(WISH_LIBS) $(CC_SEARCH_FLAGS) -o $(TKTEST_EXE) # FIXME: This xttest rule seems to be broken in a number of ways. # It should use CC_SEARCH_FLAGS, it does not include the shared @@ -584,23 +585,23 @@ xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE) test: test-classic -test-classic: tktest - $(SHELL_ENV) ./tktest $(TEST_DIR)/all.tcl -geometry +0+0 \ +test-classic: $(TKTEST_EXE) + $(SHELL_ENV) ./$(TKTEST_EXE) $(TEST_DIR)/all.tcl -geometry +0+0 \ $(TESTFLAGS) $(TCLTESTARGS) # Tests with different languages -testlang: tktest +testlang: $(TKTEST_EXE) $(SHELL_ENV) \ for lang in $(LOCALES) ; \ do \ LANG=$(lang); export LANG; \ - ./tktest $(TEST_DIR)/all.tcl -geometry +0+0 \ + ./$(TKTEST_EXE) $(TEST_DIR)/all.tcl -geometry +0+0 \ $(TESTFLAGS) $(TCLTESTARGS); \ done # Useful target to launch a built tktest with the proper path,... -runtest: tktest - $(SHELL_ENV) ./tktest +runtest: $(TKTEST_EXE) + $(SHELL_ENV) ./$(TKTEST_EXE) # This target can be used to run wish from the build directory # via `make shell` or `make shell SCRIPT=/tmp/foo.tcl` @@ -620,11 +621,11 @@ gdb: ${WISH_EXE} VALGRINDARGS=--tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v -valgrind: tktest - $(SHELL_ENV) valgrind $(VALGRINDARGS) ./tktest $(TEST_DIR)/all.tcl -geometry +0+0 -singleproc 1 $(TESTFLAGS) +valgrind: $(TKTEST_EXE) + $(SHELL_ENV) valgrind $(VALGRINDARGS) ./$(TKTEST_EXE) $(TEST_DIR)/all.tcl -geometry +0+0 -singleproc 1 $(TESTFLAGS) -valgrindshell: tktest - $(SHELL_ENV) valgrind $(VALGRINDARGS) ./tktest $(SCRIPT) +valgrindshell: $(TKTEST_EXE) + $(SHELL_ENV) valgrind $(VALGRINDARGS) ./$(TKTEST_EXE) $(SCRIPT) INSTALL_TARGETS = install-binaries install-libraries install-demos install-doc @EXTRA_INSTALL@ @@ -767,7 +768,7 @@ install-demos: @for i in $(TOP_DIR)/library/demos/images/*; \ do \ if [ -f $$i ] ; then \ - $(INSTALL_DATA) $$i $(DEMO_INSTALL_DIR)/images; \ + $(INSTALL_DATA) $$i "$(DEMO_INSTALL_DIR)/images"; \ fi; \ done; |