diff options
57 files changed, 1820 insertions, 1035 deletions
@@ -1,3 +1,61 @@ +2013-03-27 Jan Nijtmans <nijtmans@users.sf.net> + + * library/button.tcl: [Bug 3608074]: Add <<Invoke>> bindings to + * library/listbox.tcl: Button's, Listbox and Menu. + * library/menu.tcl: + * doc/event.n: Document <<Invoke>>, <<ThemeChanged>>, + * doc/ttk_panedwindow.n: <<EnteredChild>> (ttk_pandedwindow only) and + * doc/ttk_spinbox.n: <<Increment/Decrement>> (ttk_spinbox only) + +2013-03-22 Don Porter <dgp@users.sourceforge.net> + + * generic/tkWindow.c: Updates so that Tk 8.5.14+ will be able to + * unix/Makefile.in: configure and build against Tcl 8.6+ + * unix/configure.in: header files. + + * unix/configure: autoconf-2.59 + +2013-03-13 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: Patch by Andrew Shadura, providing better support for + three architectures they have in Debian. + +2013-03-11 Don Porter <dgp@users.sourceforge.net> + + * generic/tkListbox.c: [Bug 3607326] Stop segfault from + * tests/listbox.test: [listbox .l -listvariable $array]. + +2013-02-28 Donal K. Fellows <dkf@users.sf.net> + + * unix/tkUnixKey.c (TkpGetKeySym): [Bug 3599312]: Put the + initialization of the key mapping before the input method handling so + that Alt key handling is correct on non-OSX Unix. Thanks to Colin + McDonald for developing the fix. + +2013-01-16 Jan Nijtmans <nijtmans@users.sf.net> + + * win/Makefile.in: Don't compile Tk with -DTCL_NO_DEPRECATED by + * unix/Makefile.in: default any more, it might hurt when we compile Tk + 8.x against Tcl 8.y with y > x, because new deprecated constructs + might be added in higher Tcl versions (except for Tk 8.6, for now, + because there is no higher 8.x yet). + +2013-01-14 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tcl.m4: More flexible search for win32 tclConfig.sh, + * win/configure: backported from TEA. + +2012-12-03 François Vogel <fvogelnew1@free.fr> + + * generic/tkTextIndex.c: [Bug 3588824]: bug in image index handling + * tests/textIndex.test: for weird image names + +2012-11-13 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinTest.c: [Bug 3585396]: winDialog.test requires user + * tests/winDialog.test: interaction. Renumber test-cases as in Tk 8.6, + and convert various to tcltest-2 style. + 2012-11-09 Don Porter <dgp@users.sourceforge.net> *** 8.5.13 TAGGED FOR RELEASE *** @@ -109,7 +167,7 @@ * win/rules.vc: Backport some improvements from Tcl 8.6 * win/makefile.vc: -2012-08-11 Francois Vogel <fvogelnew1@free.fr> +2012-08-11 François Vogel <fvogelnew1@free.fr> * generic/tkTextTag.c: [Bug 3554273]: Test textDisp-32.2 failed @@ -120,11 +178,11 @@ * unix/tkUnixKey.c: The warnings were false flags from a * unix/tkUnixRFont.c: faulty OpenBSD C compiler. -2012-08-03 Francois Vogel <fvogelnew1@free.fr> +2012-08-03 François Vogel <fvogelnew1@free.fr> * tests/bind.test: [Bug 3554081]: Test bind-22.10 failed -2012-08-02 Francois Vogel <fvogelnew1@free.fr> +2012-08-02 François Vogel <fvogelnew1@free.fr> * tests/spinbox.test: [Bug 3553311]: Test spinbox-3.70 failed @@ -255,11 +313,11 @@ * generic/tk*Decls.h: re-generated * win/Makefile.in: "make genstubs" when cross-compiling on UNIX -2012-05-28 Francois Vogel <fvogelnew1@free.fr> +2012-05-28 François Vogel <fvogelnew1@free.fr> * doc/text.n: [Bug 1630251]: Doc for -endline option was wrong -2012-05-28 Francois Vogel <fvogelnew1@free.fr> +2012-05-28 François Vogel <fvogelnew1@free.fr> * generic/tkTextDisp.c: [Bug 1630254]: missing scrolling of text widget when from a -startline == -endline initial state it is configured to @@ -369,7 +427,7 @@ * unix/tcl.m4: Patch from the cygwin folks * unix/configure: (re-generated) -2012-02-28 Francois Vogel <fvogelnew1@free.fr> +2012-02-28 François Vogel <fvogelnew1@free.fr> * generic/tkText.c: [Bug 1630262, Bug 1615425]: segfault * generic/tkTextBTree.c when deleting lines or tagging outside of @@ -415,7 +473,7 @@ * win/tkWinDialog.c: [Bug 3480471]: tk_getOpenFile crashes on Win64 -2012-01-26 Francois Vogel <fvogelnew1@free.fr> +2012-01-26 François Vogel <fvogelnew1@free.fr> * generic/tkTextDisp.c: [Bug-1754043] and [Bug-2321450]: When -blockcursor is true, the cursor appears as a blinking bar which @@ -426,26 +484,26 @@ * generic/tkImgPhoto.c: [Bug 2433260]: non-critical error in Tk_PhotoPutBlock -2012-01-25 Francois Vogel <fvogelnew1@free.fr> +2012-01-25 François Vogel <fvogelnew1@free.fr> * generic/tkText.c: Don't increase the epoch twice -2012-01-25 Francois Vogel <fvogelnew1@free.fr> +2012-01-25 François Vogel <fvogelnew1@free.fr> * generic/tkText.c: [Bug-1630271]: segfault/infinite loop * generic/tkTextMark.c: when a mark is before -startline * tests/textMark.test: -2012-01-25 Francois Vogel <fvogelnew1@free.fr> +2012-01-25 François Vogel <fvogelnew1@free.fr> * generic/tkText.c: [Bug-3475627]: Test text-31.11 fails -2012-01-22 Francois Vogel <fvogelnew1@free.fr> +2012-01-22 François Vogel <fvogelnew1@free.fr> * generic/tkTextMark.c: [Bug-3288113,3288121]: Missing marks/endless * tests/textMark.test: loop in text mark prev/next -2012-01-19 Francois Vogel <fvogelnew1@free.fr> +2012-01-19 François Vogel <fvogelnew1@free.fr> * generic/tkText.c: [Bug-3021557]: Moving the cursor in * tests/text.test: elided text freezes Tk diff --git a/doc/event.n b/doc/event.n index 69f336a..77d6f18 100644 --- a/doc/event.n +++ b/doc/event.n @@ -318,6 +318,10 @@ been pressed in combination with the Alt key. The usual response to this is to either focus into the widget (or some related widget) or to invoke the widget. .TP +\fB<<Invoke>>\fR +This can be sent to some widgets (e.g. button, listbox, menu) as an +alternative to <space>. +.TP \fB<<ListboxSelect>>\fR This is sent to a listbox when the set of selected item(s) in the listbox is updated. @@ -334,6 +338,9 @@ changed. This is sent to a text widget when the selection in the widget is changed. .TP +\fB<<ThemeChanged>>\fR +This is sent to a text widget when the ttk (Tile) theme changed. +.TP \fB<<TraverseIn>>\fR This is sent to a widget when the focus enters the widget because of a user-driven diff --git a/doc/ttk_panedwindow.n b/doc/ttk_panedwindow.n index c5851c3..474f56d 100644 --- a/doc/ttk_panedwindow.n +++ b/doc/ttk_panedwindow.n @@ -105,6 +105,12 @@ and the total size of the widget. .\" depending on which changed most recently. Returns the new position of sash number \fIindex\fR. .\" Full story: new position may be different than the requested position. +.SH "VIRTUAL EVENTS" +.PP +The panedwindow widget generates an \fB<<EnteredChild>>\fR virtual event on +LeaveNotify/NotifyInferior events, because Tk does not execute binding scripts +for <Leave> events when the pointer crosses from a parent to a child. The +panedwindow widget needs to know when that happens. .SH "SEE ALSO" ttk::widget(n), ttk::notebook(n), panedwindow(n) '\" Local Variables: diff --git a/doc/ttk_spinbox.n b/doc/ttk_spinbox.n index fefd287..7b291a9 100644 --- a/doc/ttk_spinbox.n +++ b/doc/ttk_spinbox.n @@ -77,6 +77,11 @@ Set the spinbox string to \fIvalue\fR. If a \fI\-format\fR option has been configured then this format will be applied. If formatting fails or is not set or the \fI\-values\fR option has been used then the value is set directly. +.SH "VIRTUAL EVENTS" +.PP +The spinbox widget generates a \fB<<Increment>>\fR virtual event when +the user presses <Up>, and a \fB<<Decrement>>\fR virtual event when the +user presses <Down>. .SH "SEE ALSO" ttk::widget(n), ttk::entry(n), spinbox(n) .SH KEYWORDS diff --git a/generic/tk.decls b/generic/tk.decls index 50b2837..2825111 100644 --- a/generic/tk.decls +++ b/generic/tk.decls @@ -1067,6 +1067,9 @@ declare 272 { declare 273 { void Tk_CreateOldPhotoImageFormat(Tk_PhotoImageFormat *formatPtr) } +declare 275 { + void TkUnusedStubEntry(void) +} # Define the platform specific public Tk interface. These functions are # only available on the designated platform. diff --git a/generic/tk.h b/generic/tk.h index 8c13df2..7c686a3 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -17,10 +17,18 @@ #define _TK #include <tcl.h> -#if (TCL_MAJOR_VERSION != 8) || (TCL_MINOR_VERSION != 5) -# error Tk 8.5 must be compiled with tcl.h from Tcl 8.5 +#if (TCL_MAJOR_VERSION != 8) || (TCL_MINOR_VERSION < 5) +# error Tk 8.5 must be compiled with tcl.h from Tcl 8.5 or better #endif +#ifndef _ANSI_ARGS_ +# ifndef NO_PROTOTYPES +# define _ANSI_ARGS_(x) x +# else +# define _ANSI_ARGS_(x) () +# endif +#endif + /* * For C++ compilers, use extern "C" */ @@ -69,11 +77,9 @@ extern "C" { #ifndef RC_INVOKED #ifndef _XLIB_H -# if defined(MAC_OSX_TK) -# include <X11/Xlib.h> +# include <X11/Xlib.h> +# ifdef MAC_OSX_TK # include <X11/X.h> -# else -# include <X11/Xlib.h> # endif #endif #ifdef __STDC__ @@ -81,18 +87,20 @@ extern "C" { #endif #ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT #endif - + /* + *---------------------------------------------------------------------- + * * Decide whether or not to use input methods. */ #ifdef XNQueryInputStyle #define TK_USE_INPUT_METHODS #endif - + /* * Dummy types that are used by clients: */ @@ -118,8 +126,10 @@ typedef struct Tk_StyledElement_ *Tk_StyledElement; */ typedef const char *Tk_Uid; - + /* + *---------------------------------------------------------------------- + * * The enum below defines the valid types for Tk configuration options as * implemented by Tk_InitOptions, Tk_SetOptions, etc. */ @@ -217,7 +227,7 @@ typedef void (Tk_CustomOptionFreeProc) _ANSI_ARGS_((ClientData clientData, Tk_Window tkwin, char *internalPtr)); typedef struct Tk_ObjCustomOption { - const char *name; /* Name of the custom option. */ + const char *name; /* Name of the custom option. */ Tk_CustomOptionSetProc *setProc; /* Function to use to set a record's option * value from a Tcl_Obj */ @@ -293,7 +303,7 @@ typedef struct Tk_SavedOptions { * old values in a single structure. NULL * means no more structures. */ } Tk_SavedOptions; - + /* * Structure used to describe application-specific configuration options: * indicates procedures to call to parse an option and to return a text string @@ -392,7 +402,7 @@ typedef enum { #define TK_CONFIG_OPTION_SPECIFIED (1 << 4) #define TK_CONFIG_USER_BIT 0x100 #endif /* __NO_OLD_CONFIG */ - + /* * Structure used to specify how to handle argv options. */ @@ -436,7 +446,7 @@ typedef struct { #define TK_ARGV_NO_LEFTOVERS 0x2 #define TK_ARGV_NO_ABBREV 0x4 #define TK_ARGV_DONT_SKIP_FIRST_ARG 0x8 - + /* * Enumerated type for describing actions to be taken in response to a * restrictProc established by Tk_RestrictEvents. @@ -494,7 +504,7 @@ typedef enum { TK_ANCHOR_S, TK_ANCHOR_SW, TK_ANCHOR_W, TK_ANCHOR_NW, TK_ANCHOR_CENTER } Tk_Anchor; - + /* * Enumerated type for describing a style of justification: */ @@ -538,7 +548,7 @@ typedef struct Tk_FontMetrics { #define TK_IGNORE_TABS 8 #define TK_IGNORE_NEWLINES 16 - + /* * Widget class procedures used to implement platform specific widget * behavior. @@ -582,7 +592,7 @@ typedef struct Tk_ClassProcs { #define Tk_GetClassProc(procs, which) \ (((procs) == NULL) ? NULL : \ (((procs)->size <= Tk_Offset(Tk_ClassProcs, which)) ? NULL:(procs)->which)) - + /* * Each geometry manager (the packer, the placer, etc.) is represented by a * structure of the following form, which indicates procedures to invoke in @@ -616,13 +626,13 @@ typedef struct Tk_GeomMgr { #define TK_SCROLL_PAGES 2 #define TK_SCROLL_UNITS 3 #define TK_SCROLL_ERROR 4 - + /* - *--------------------------------------------------------------------------- + *---------------------------------------------------------------------- * * Extensions to the X event set * - *--------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ #define VirtualEvent (MappingNotify + 1) @@ -681,12 +691,12 @@ typedef XActivateDeactivateEvent XActivateEvent; typedef XActivateDeactivateEvent XDeactivateEvent; /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Macros for querying Tk_Window structures. See the manual entries for * documentation. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ #define Tk_Display(tkwin) (((Tk_FakeWin *) (tkwin))->display) @@ -883,11 +893,11 @@ typedef struct Tk_FakeWin { #define TK_WM_MANAGEABLE 0x80000 /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Procedure prototypes and structures used for defining new canvas items: * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ typedef enum { @@ -1124,7 +1134,7 @@ typedef struct Tk_CanvasTextInfo { * should be displayed in focusItemPtr. * Read-only to items.*/ } Tk_CanvasTextInfo; - + /* * Structures used for Dashing and Outline. */ @@ -1180,11 +1190,11 @@ typedef struct Tk_Outline { } Tk_Outline; /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Procedure prototypes and structures used for managing images: * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ typedef struct Tk_ImageType Tk_ImageType; @@ -1247,13 +1257,13 @@ struct Tk_ImageType { * manager. */ char *reserved; /* reserved for future expansion */ }; - + /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Additional definitions used to manage images of type "photo". * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ /* @@ -1363,18 +1373,13 @@ struct Tk_PhotoImageFormat { * currently known. Filled in by Tk, not by * image format handler. */ }; - -#ifdef USE_OLD_IMAGE -#define Tk_CreateImageType Tk_CreateOldImageType -#define Tk_CreatePhotoImageFormat Tk_CreateOldPhotoImageFormat -#endif /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Procedure prototypes and structures used for managing styles: * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ /* @@ -1438,13 +1443,13 @@ typedef struct Tk_ElementSpec { #define TK_ELEMENT_STATE_PRESSED 1<<3 /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * The definitions below provide backward compatibility for functions and * types related to event handling that used to be in Tk but have moved to * Tcl. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ #define TK_READABLE TCL_READABLE @@ -1491,21 +1496,18 @@ EXTERN const char * Tk_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp, const char *version, int exact)); #ifndef USE_TK_STUBS - #define Tk_InitStubs(interp, version, exact) \ Tk_PkgInitStubsCheck(interp, version, exact) - -#endif +#endif /* USE_TK_STUBS */ #define Tk_InitImageArgs(interp, argc, argv) /**/ - /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Additional procedure types defined by Tk. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ typedef int (Tk_ErrorProc) _ANSI_ARGS_((ClientData clientData, @@ -1523,18 +1525,27 @@ typedef Tk_RestrictAction (Tk_RestrictProc) _ANSI_ARGS_(( ClientData clientData, XEvent *eventPtr)); typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData, int offset, char *buffer, int maxBytes)); - + /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * - * Platform independant exported procedures and variables. + * Platform independent exported procedures and variables. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ #include "tkDecls.h" + +#ifdef USE_OLD_IMAGE +#undef Tk_CreateImageType +#define Tk_CreateImageType Tk_CreateOldImageType +#undef Tk_CreatePhotoImageFormat +#define Tk_CreatePhotoImageFormat Tk_CreateOldPhotoImageFormat +#endif /* USE_OLD_IMAGE */ /* + *---------------------------------------------------------------------- + * * Allow users to say that they don't want to alter their source to add extra * arguments to Tk_PhotoPutBlock() et al; DO NOT DEFINE THIS WHEN BUILDING TK. * @@ -1574,11 +1585,7 @@ typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData, # endif # define Tk_PhotoSetSize Tk_PhotoSetSize_Panic #endif /* USE_PANIC_ON_PHOTO_ALLOC_FAILURE */ - -/* - * Tcl commands exported by Tk: - */ - + #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT diff --git a/generic/tkBind.c b/generic/tkBind.c index 21bfb5c..8d20fa9 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -4595,7 +4595,7 @@ TkKeysymToString( * * TkCopyAndGlobalEval -- * - * This function makes a copy of a script then calls Tcl_GlobalEval to + * This function makes a copy of a script then calls Tcl_EvalEx to * evaluate it. It's used in situations where the execution of a command * may cause the original command string to be reallocated. * diff --git a/generic/tkCmds.c b/generic/tkCmds.c index a86ef84..ebf6444 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -22,6 +22,10 @@ #include "tkUnixInt.h" #endif +#if (TCL_MAJOR_VERSION==8) && (TCL_MINOR_VERSION<6) +# define Tcl_Canceled(interp, flags) (TCL_OK) +#endif + /* * Forward declarations for functions defined later in this file: */ @@ -232,7 +236,7 @@ TkBindEventProc( ClientData objects[MAX_OBJS], *objPtr; TkWindow *topLevPtr; int i, count; - char *p; + const char *p; Tcl_HashEntry *hPtr; if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) { @@ -251,7 +255,7 @@ TkBindEventProc( (winPtr->numTags * sizeof(ClientData))); } for (i = 0; i < winPtr->numTags; i++) { - p = (char *) winPtr->tagPtr[i]; + p = winPtr->tagPtr[i]; if (*p == '.') { hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p); if (hPtr != NULL) { @@ -327,7 +331,6 @@ Tk_BindtagsObjCmd( } if (objc == 2) { listPtr = Tcl_NewObj(); - Tcl_IncrRefCount(listPtr); if (winPtr->numTags == 0) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(winPtr->pathName, -1)); @@ -350,7 +353,6 @@ Tk_BindtagsObjCmd( } } Tcl_SetObjResult(interp, listPtr); - Tcl_DecrRefCount(listPtr); return TCL_OK; } if (winPtr->tagPtr != NULL) { @@ -411,17 +413,17 @@ TkFreeBindingTags( TkWindow *winPtr) /* Window whose tags are to be released. */ { int i; - char *p; + const char *p; for (i = 0; i < winPtr->numTags; i++) { - p = (char *) (winPtr->tagPtr[i]); + p = winPtr->tagPtr[i]; if (*p == '.') { /* * Names starting with "." are malloced rather than Uids, so they * have to be freed. */ - ckfree(p); + ckfree((char *)p); } } ckfree((char *) winPtr->tagPtr); @@ -913,6 +915,7 @@ Tk_TkwaitObjCmd( { Tk_Window tkwin = (Tk_Window) clientData; int done, index; + int code = TCL_OK; static const char *optionStrings[] = { "variable", "visibility", "window", NULL }; @@ -939,6 +942,10 @@ Tk_TkwaitObjCmd( } done = 0; while (!done) { + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } Tcl_DoOneEvent(0); } Tcl_UntraceVar(interp, Tcl_GetString(objv[2]), @@ -958,9 +965,13 @@ Tk_TkwaitObjCmd( WaitVisibilityProc, (ClientData) &done); done = 0; while (!done) { + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } Tcl_DoOneEvent(0); } - if (done != 1) { + if ((done != 0) && (done != 1)) { /* * Note that we do not delete the event handler because it was * deleted automatically when the window was destroyed. @@ -988,25 +999,37 @@ Tk_TkwaitObjCmd( WaitWindowProc, (ClientData) &done); done = 0; while (!done) { + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } Tcl_DoOneEvent(0); } /* - * Note: there's no need to delete the event handler. It was deleted - * automatically when the window was destroyed. + * Note: normally there's no need to delete the event handler. It was + * deleted automatically when the window was destroyed; however, if + * the wait operation was canceled, we need to delete it. */ + if (done == 0) { + Tk_DeleteEventHandler(window, StructureNotifyMask, + WaitWindowProc, &done); + } break; } } /* * Clear out the interpreter's result, since it may have been set by event - * handlers. + * handlers. This is skipped if an error occurred above, such as the wait + * operation being canceled. */ + if (code == TCL_OK) Tcl_ResetResult(interp); - return TCL_OK; + + return code; } /* ARGSUSED */ @@ -1034,8 +1057,7 @@ WaitVisibilityProc( if (eventPtr->type == VisibilityNotify) { *donePtr = 1; - } - if (eventPtr->type == DestroyNotify) { + } else if (eventPtr->type == DestroyNotify) { *donePtr = 2; } } @@ -1080,6 +1102,7 @@ Tk_UpdateObjCmd( static const char *updateOptions[] = {"idletasks", NULL}; int flags, index; TkDisplay *dispPtr; + int code = TCL_OK; if (objc == 1) { flags = TCL_DONT_WAIT; @@ -1104,12 +1127,35 @@ Tk_UpdateObjCmd( while (1) { while (Tcl_DoOneEvent(flags) != 0) { - /* Empty loop body */ + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } } + + /* + * If event processing was canceled proceed no further. + */ + + if (code == TCL_ERROR) + break; + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { XSync(dispPtr->display, False); } + + /* + * Check again if event processing has been canceled because the inner + * loop (above) may not have checked (i.e. no events were processed and + * the loop body was skipped). + */ + + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + code = TCL_ERROR; + break; + } + if (Tcl_DoOneEvent(flags) == 0) { break; } @@ -1117,11 +1163,14 @@ Tk_UpdateObjCmd( /* * Must clear the interpreter's result because event handlers could have - * executed commands. + * executed commands. This is skipped if an error occurred above, such as + * the wait operation being canceled. */ + if (code == TCL_OK) Tcl_ResetResult(interp); - return TCL_OK; + + return code; } /* @@ -1503,9 +1552,7 @@ Tk_WinfoObjCmd( Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1); } break; - case WIN_INTERPS: { - int result; - + case WIN_INTERPS: skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); if (skip < 0) { return TCL_ERROR; @@ -1514,9 +1561,7 @@ Tk_WinfoObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?"); return TCL_ERROR; } - result = TkGetInterpNames(interp, tkwin); - return result; - } + return TkGetInterpNames(interp, tkwin); case WIN_PATHNAME: { Window id; diff --git a/generic/tkConsole.c b/generic/tkConsole.c index b10aaaf..2cd2632 100644 --- a/generic/tkConsole.c +++ b/generic/tkConsole.c @@ -220,11 +220,10 @@ Tk_InitConsoleChannels( Tcl_Channel consoleChannel; /* - * Ensure that we are getting the matching version of Tcl. This is really - * only an issue when Tk is loaded dynamically. + * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) { return; } @@ -436,7 +435,8 @@ Tk_CreateConsoleWindow( } Tcl_Preserve((ClientData) consoleInterp); - result = Tcl_GlobalEval(consoleInterp, "source $tk_library/console.tcl"); + result = Tcl_EvalEx(consoleInterp, "source $tk_library/console.tcl", + -1, TCL_EVAL_GLOBAL); if (result == TCL_ERROR) { Tcl_SetReturnOptions(interp, Tcl_GetReturnOptions(consoleInterp, result)); @@ -528,7 +528,7 @@ ConsoleOutput( Tcl_DStringFree(&ds); Tcl_IncrRefCount(cmd); - Tcl_GlobalEvalObj(consoleInterp, cmd); + Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmd); } } @@ -732,7 +732,7 @@ ConsoleObjCmd( Tcl_IncrRefCount(cmd); if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) { Tcl_Preserve((ClientData) consoleInterp); - result = Tcl_GlobalEvalObj(consoleInterp, cmd); + result = Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL); Tcl_SetReturnOptions(interp, Tcl_GetReturnOptions(consoleInterp, result)); Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp)); @@ -794,7 +794,7 @@ InterpreterObjCmd( Tcl_Preserve((ClientData) otherInterp); switch ((enum option) index) { case OTHER_EVAL: - result = Tcl_GlobalEvalObj(otherInterp, objv[2]); + result = Tcl_EvalObjEx(otherInterp, objv[2], TCL_EVAL_GLOBAL); /* * TODO: Should exceptions be filtered here? */ @@ -929,7 +929,7 @@ ConsoleEventProc( Tcl_Interp *consoleInterp = info->consoleInterp; if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) { - Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit"); + Tcl_EvalEx(consoleInterp, "tk::ConsoleExit", -1, TCL_EVAL_GLOBAL); } if (--info->refCount <= 0) { diff --git a/generic/tkDecls.h b/generic/tkDecls.h index d06df4b..6a2cca0 100644 --- a/generic/tkDecls.h +++ b/generic/tkDecls.h @@ -1674,6 +1674,12 @@ EXTERN void Tk_CreateOldImageType(Tk_ImageType *typePtr); EXTERN void Tk_CreateOldPhotoImageFormat( Tk_PhotoImageFormat *formatPtr); #endif +/* Slot 274 is reserved */ +#ifndef TkUnusedStubEntry_TCL_DECLARED +#define TkUnusedStubEntry_TCL_DECLARED +/* 275 */ +EXTERN void TkUnusedStubEntry(void); +#endif typedef struct TkStubHooks { struct TkPlatStubs *tkPlatStubs; @@ -1960,6 +1966,8 @@ typedef struct TkStubs { Tcl_Interp * (*tk_Interp) (Tk_Window tkwin); /* 271 */ void (*tk_CreateOldImageType) (Tk_ImageType *typePtr); /* 272 */ void (*tk_CreateOldPhotoImageFormat) (Tk_PhotoImageFormat *formatPtr); /* 273 */ + VOID *reserved274; + void (*tkUnusedStubEntry) (void); /* 275 */ } TkStubs; #ifdef __cplusplus @@ -3066,6 +3074,11 @@ extern TkStubs *tkStubsPtr; #define Tk_CreateOldPhotoImageFormat \ (tkStubsPtr->tk_CreateOldPhotoImageFormat) /* 273 */ #endif +/* Slot 274 is reserved */ +#ifndef TkUnusedStubEntry +#define TkUnusedStubEntry \ + (tkStubsPtr->tkUnusedStubEntry) /* 275 */ +#endif #endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ @@ -3074,5 +3087,7 @@ extern TkStubs *tkStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +#undef TkUnusedStubEntry + #endif /* _TKDECLS */ diff --git a/generic/tkInt.decls b/generic/tkInt.decls index 6794edb..17f39ba 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -568,6 +568,9 @@ declare 180 { char *TkSmoothPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr) } +declare 184 { + void TkUnusedStubEntry(void) +} ############################################################################## diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h index 5fcce30..063301d 100644 --- a/generic/tkIntDecls.h +++ b/generic/tkIntDecls.h @@ -962,6 +962,14 @@ EXTERN char * TkSmoothPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); #endif +/* Slot 181 is reserved */ +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ +#ifndef TkUnusedStubEntry_TCL_DECLARED +#define TkUnusedStubEntry_TCL_DECLARED +/* 184 */ +EXTERN void TkUnusedStubEntry(void); +#endif typedef struct TkIntStubs { int magic; @@ -1175,6 +1183,10 @@ typedef struct TkIntStubs { char * (*tkOrientPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 178 */ int (*tkSmoothParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, CONST char *value, char *widgRec, int offset); /* 179 */ char * (*tkSmoothPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 180 */ + VOID *reserved181; + VOID *reserved182; + VOID *reserved183; + void (*tkUnusedStubEntry) (void); /* 184 */ } TkIntStubs; #ifdef __cplusplus @@ -1846,6 +1858,13 @@ extern TkIntStubs *tkIntStubsPtr; #define TkSmoothPrintProc \ (tkIntStubsPtr->tkSmoothPrintProc) /* 180 */ #endif +/* Slot 181 is reserved */ +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ +#ifndef TkUnusedStubEntry +#define TkUnusedStubEntry \ + (tkIntStubsPtr->tkUnusedStubEntry) /* 184 */ +#endif #endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ @@ -1881,6 +1900,7 @@ extern TkIntStubs *tkIntStubsPtr; (Region) (src), (Region) (ret)) #endif /* !__CYGWIN__*/ +#undef TkUnusedStubEntry #if defined(__CYGWIN__) && defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) # undef TkBindDeadWindow # define TkBindDeadWindow(winPtr) /* Removed from Cygwins stub table, just do nothing */ diff --git a/generic/tkListbox.c b/generic/tkListbox.c index d803d7b..248dd7b 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -1630,9 +1630,6 @@ ConfigureListbox( if (Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL, listVarObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - if (oldListObj == NULL) { - Tcl_DecrRefCount(listVarObj); - } continue; } } diff --git a/generic/tkMain.c b/generic/tkMain.c index 3be7189..8bebb3d 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -132,12 +132,15 @@ Tk_MainEx( Tcl_DString appName; /* - * Ensure that we are getting the matching version of Tcl. This is really - * only an issue when Tk is loaded dynamically. + * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { - abort(); + if (Tcl_InitStubs(interp, TCL_VERSION ".0", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + abort(); + } else { + Tcl_Panic("%s", Tcl_GetStringResult(interp)); + } } #if defined(__WIN32__) && !defined(__WIN64__) && !defined(STATIC_BUILD) @@ -168,6 +171,12 @@ Tk_MainEx( tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); +#if !defined(STATIC_BUILD) +# undef Tcl_FindExecutable +# define Tcl_FindExecutable \ + (tclStubsPtr->tcl_FindExecutable) /* 144 */ +#endif + Tcl_FindExecutable(argv[0]); tsdPtr->interp = interp; Tcl_Preserve((ClientData) interp); diff --git a/generic/tkObj.c b/generic/tkObj.c index 7672240..f30742b 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -189,7 +189,7 @@ GetPixelsFromObjEx( int *intPtr, double *dblPtr) /* Places to store resulting pixels. */ { - int result,fresh; + int result, fresh; double d; PixelRep *pixelPtr; static double bias[] = { @@ -204,16 +204,16 @@ GetPixelsFromObjEx( */ if (objPtr->typePtr != &pixelObjType) { - ThreadSpecificData *tsdPtr = GetTypeCache(); + ThreadSpecificData *typeCache = GetTypeCache(); - if (objPtr->typePtr == tsdPtr->doubleTypePtr) { + if (objPtr->typePtr == typeCache->doubleTypePtr) { (void) Tcl_GetDoubleFromObj(interp, objPtr, &d); if (dblPtr != NULL) { *dblPtr = d; } *intPtr = (int) (d<0 ? d-0.5 : d+0.5); return TCL_OK; - } else if (objPtr->typePtr == tsdPtr->intTypePtr) { + } else if (objPtr->typePtr == typeCache->intTypePtr) { (void) Tcl_GetIntFromObj(interp, objPtr, intPtr); if (dblPtr) { *dblPtr = (double) (*intPtr); @@ -223,14 +223,12 @@ GetPixelsFromObjEx( } retry: - if (objPtr->typePtr != &pixelObjType) { + fresh = (objPtr->typePtr != &pixelObjType); + if (fresh) { result = SetPixelFromAny(interp, objPtr); if (result != TCL_OK) { return result; } - fresh = 1; - } else { - fresh = 0; } if (SIMPLE_PIXELREP(objPtr)) { @@ -242,14 +240,14 @@ GetPixelsFromObjEx( pixelPtr = GET_COMPLEXPIXEL(objPtr); if ((!fresh) && (pixelPtr->tkwin != tkwin)) { /* - * In case of exo-screen conversions of non-pixels we force a + * In the case of exo-screen conversions of non-pixels, we force a * recomputation from the string. */ FreePixelInternalRep(objPtr); goto retry; } - if ((pixelPtr->tkwin != tkwin)||dblPtr) { + if ((pixelPtr->tkwin != tkwin) || dblPtr) { d = pixelPtr->value; if (pixelPtr->units >= 0) { d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin)); @@ -294,7 +292,7 @@ Tk_GetPixelsFromObj( Tcl_Obj *objPtr, /* The object from which to get pixels. */ int *intPtr) /* Place to store resulting pixels. */ { - return GetPixelsFromObjEx(interp,tkwin,objPtr,intPtr,NULL); + return GetPixelsFromObjEx(interp, tkwin, objPtr, intPtr, NULL); } /* @@ -326,7 +324,7 @@ Tk_GetDoublePixelsFromObj( double *doublePtr) /* Place to store resulting pixels. */ { double d; - int result,val; + int result, val; result = GetPixelsFromObjEx(interp, tkwin, objPtr, &val, &d); if (result != TCL_OK) { @@ -448,7 +446,7 @@ SetPixelFromAny( double d; int i, units; - string = Tcl_GetStringFromObj(objPtr, NULL); + string = Tcl_GetString(objPtr); d = strtod(string, &rest); if (rest == string) { @@ -561,7 +559,7 @@ Tk_GetMMFromObj( } } - mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; + mmPtr = (MMRep *) objPtr->internalRep.twoPtrValue.ptr1; if (mmPtr->tkwin != tkwin) { d = mmPtr->value; if (mmPtr->units == -1) { @@ -600,8 +598,8 @@ static void FreeMMInternalRep( Tcl_Obj *objPtr) /* MM object with internal rep to free. */ { - ckfree((char *) objPtr->internalRep.otherValuePtr); - objPtr->internalRep.otherValuePtr = NULL; + ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1); + objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->typePtr = NULL; } @@ -631,13 +629,13 @@ DupMMInternalRep( MMRep *oldPtr, *newPtr; copyPtr->typePtr = srcPtr->typePtr; - oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr; + oldPtr = (MMRep *) srcPtr->internalRep.twoPtrValue.ptr1; newPtr = (MMRep *) ckalloc(sizeof(MMRep)); newPtr->value = oldPtr->value; newPtr->units = oldPtr->units; newPtr->tkwin = oldPtr->tkwin; newPtr->returnValue = oldPtr->returnValue; - copyPtr->internalRep.otherValuePtr = (VOID *) newPtr; + copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) newPtr; } /* @@ -667,7 +665,7 @@ UpdateStringOfMM( char buffer[TCL_DOUBLE_SPACE]; register int len; - mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; + mmPtr = (MMRep *) objPtr->internalRep.twoPtrValue.ptr1; /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */ if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) { Tcl_Panic("UpdateStringOfMM: false precondition"); @@ -705,17 +703,17 @@ SetMMFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { - ThreadSpecificData *tsdPtr = GetTypeCache(); + ThreadSpecificData *typeCache = GetTypeCache(); const Tcl_ObjType *typePtr; char *string, *rest; double d; int units; MMRep *mmPtr; - if (objPtr->typePtr == tsdPtr->doubleTypePtr) { + if (objPtr->typePtr == typeCache->doubleTypePtr) { Tcl_GetDoubleFromObj(interp, objPtr, &d); units = -1; - } else if (objPtr->typePtr == tsdPtr->intTypePtr) { + } else if (objPtr->typePtr == typeCache->intTypePtr) { Tcl_GetIntFromObj(interp, objPtr, &units); d = (double) units; units = -1; @@ -726,13 +724,13 @@ SetMMFromAny( * ints again from mm obj types. */ - (void) Tcl_GetStringFromObj(objPtr, NULL); + (void) Tcl_GetString(objPtr); } else { /* * It wasn't a known int or double, so parse it. */ - string = Tcl_GetStringFromObj(objPtr, NULL); + string = Tcl_GetString(objPtr); d = strtod(string, &rest); if (rest == string) { @@ -780,15 +778,15 @@ SetMMFromAny( (*typePtr->freeIntRepProc)(objPtr); } - objPtr->typePtr = &mmObjType; + objPtr->typePtr = &mmObjType; - mmPtr = (MMRep *) ckalloc(sizeof(MMRep)); - mmPtr->value = d; - mmPtr->units = units; - mmPtr->tkwin = NULL; + mmPtr = (MMRep *) ckalloc(sizeof(MMRep)); + mmPtr->value = d; + mmPtr->units = units; + mmPtr->tkwin = NULL; mmPtr->returnValue = d; - objPtr->internalRep.otherValuePtr = (VOID *) mmPtr; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mmPtr; return TCL_OK; } @@ -821,7 +819,7 @@ TkGetWindowFromObj( Tcl_Obj *objPtr, /* The object from which to get window. */ Tk_Window *windowPtr) /* Place to store resulting window. */ { - TkMainInfo *mainPtr = ((TkWindow *)tkwin)->mainPtr; + TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr; register WindowRep *winPtr; int result; @@ -830,28 +828,28 @@ TkGetWindowFromObj( return result; } - winPtr = (WindowRep *) objPtr->internalRep.otherValuePtr; - if ( winPtr->tkwin == NULL - || winPtr->mainPtr == NULL - || winPtr->mainPtr != mainPtr - || winPtr->epoch != mainPtr->deletionEpoch) + winPtr = (WindowRep *) objPtr->internalRep.twoPtrValue.ptr1; + if (winPtr->tkwin == NULL + || winPtr->mainPtr == NULL + || winPtr->mainPtr != mainPtr + || winPtr->epoch != mainPtr->deletionEpoch) { /* * Cache is invalid. */ winPtr->tkwin = Tk_NameToWindow(interp, - Tcl_GetStringFromObj(objPtr, NULL), tkwin); + Tcl_GetString(objPtr), tkwin); + if (winPtr->tkwin == NULL) { + /* ASSERT: Tk_NameToWindow has left error message in interp */ + return TCL_ERROR; + } + winPtr->mainPtr = mainPtr; winPtr->epoch = mainPtr ? mainPtr->deletionEpoch : 0; } *windowPtr = winPtr->tkwin; - - if (winPtr->tkwin == NULL) { - /* ASSERT: Tk_NameToWindow has left error message in interp */ - return TCL_ERROR; - } return TCL_OK; } @@ -887,7 +885,7 @@ SetWindowFromAny( * Free the old internalRep before setting the new one. */ - Tcl_GetStringFromObj(objPtr, NULL); + (void)Tcl_GetString(objPtr); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(objPtr); @@ -898,7 +896,7 @@ SetWindowFromAny( winPtr->mainPtr = NULL; winPtr->epoch = 0; - objPtr->internalRep.otherValuePtr = (VOID*)winPtr; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID*)winPtr; objPtr->typePtr = &windowObjType; return TCL_OK; @@ -929,12 +927,12 @@ DupWindowInternalRep( { register WindowRep *oldPtr, *newPtr; - oldPtr = srcPtr->internalRep.otherValuePtr; + oldPtr = srcPtr->internalRep.twoPtrValue.ptr1; newPtr = (WindowRep *) ckalloc(sizeof(WindowRep)); newPtr->tkwin = oldPtr->tkwin; newPtr->mainPtr = oldPtr->mainPtr; newPtr->epoch = oldPtr->epoch; - copyPtr->internalRep.otherValuePtr = (VOID *)newPtr; + copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *)newPtr; copyPtr->typePtr = srcPtr->typePtr; } @@ -960,13 +958,13 @@ static void FreeWindowInternalRep( Tcl_Obj *objPtr) /* Window object with internal rep to free. */ { - ckfree((char *) objPtr->internalRep.otherValuePtr); - objPtr->internalRep.otherValuePtr = NULL; + ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1); + objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->typePtr = NULL; } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * TkParsePadAmount -- * @@ -984,7 +982,7 @@ FreeWindowInternalRep( * An error message is written to the interpreter if something is not * right. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ int diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index c2ef290..79edc4d 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -30,6 +30,8 @@ #include "tkPlatDecls.h" #include "tkIntXlibDecls.h" +#define TkUnusedStubEntry NULL + #ifdef __WIN32__ static int @@ -476,6 +478,10 @@ TkIntStubs tkIntStubs = { TkOrientPrintProc, /* 178 */ TkSmoothParseProc, /* 179 */ TkSmoothPrintProc, /* 180 */ + NULL, /* 181 */ + NULL, /* 182 */ + NULL, /* 183 */ + TkUnusedStubEntry, /* 184 */ }; TkIntPlatStubs tkIntPlatStubs = { @@ -1130,6 +1136,8 @@ TkStubs tkStubs = { Tk_Interp, /* 271 */ Tk_CreateOldImageType, /* 272 */ Tk_CreateOldPhotoImageFormat, /* 273 */ + NULL, /* 274 */ + TkUnusedStubEntry, /* 275 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c index 5349a0b..f605b5d 100644 --- a/generic/tkStubLib.c +++ b/generic/tkStubLib.c @@ -1,33 +1,16 @@ /* * tkStubLib.c -- * - * Stub object that will be statically linked into extensions that wish + * Stub object that will be statically linked into extensions that want * to access Tk. * - * Copyright (c) 1998 Paul Duffin. * Copyright (c) 1998-1999 by Scriptics Corporation. + * Copyright (c) 1998 Paul Duffin. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -/* - * We need to ensure that we use the stub macros so that this file contains no - * references to any of the stub functions. This will make it possible to - * build an extension that references Tk_InitStubs but doesn't end up - * including the rest of the stub functions. - */ - -#ifndef USE_TCL_STUBS -#define USE_TCL_STUBS -#endif -#undef USE_TCL_STUB_PROCS - -#ifndef USE_TK_STUBS -#define USE_TK_STUBS -#endif -#undef USE_TK_STUB_PROCS - #include "tkInt.h" #ifdef __WIN32__ @@ -56,7 +39,8 @@ TkIntXlibStubs *tkIntXlibStubsPtr = NULL; * Use our own isdigit to avoid linking to libc on windows */ -static int isDigit(const int c) +static int +isDigit(const int c) { return (c >= '0' && c <= '9'); } @@ -78,66 +62,73 @@ static int isDigit(const int c) * *---------------------------------------------------------------------- */ - -#ifdef Tk_InitStubs #undef Tk_InitStubs -#endif - CONST char * Tk_InitStubs( Tcl_Interp *interp, CONST char *version, int exact) { - CONST char *actualVersion; - TkStubs **stubsPtrPtr = &tkStubsPtr; /* squelch warning */ - - actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0, - (ClientData *) stubsPtrPtr); - if (!actualVersion) { + const char *packageName = "Tk"; + const char *errMsg = NULL; + ClientData clientData = NULL; + CONST char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, + packageName, version, 0, &clientData); + TkStubs *stubsPtr = (TkStubs *)clientData; + + if (actualVersion == NULL) { return NULL; } + if (exact) { - CONST char *p = version; - int count = 0; + CONST char *p = version; + int count = 0; - while (*p) { - count += !isDigit(*p++); - } - if (count == 1) { + while (*p) { + count += !isDigit(*p++); + } + if (count == 1) { CONST char *q = actualVersion; p = version; while (*p && (*p == *q)) { p++; q++; } - if (*p) { + if (*p || isDigit(*q)) { /* Construct error message */ - Tcl_PkgRequireEx(interp, "Tk", version, 1, NULL); - return NULL; - - } - } else { - actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 1, NULL); - if (actualVersion == NULL) { - return NULL; - } - } + tclStubsPtr->tcl_PkgRequireEx(interp, "Tk", version, 1, NULL); + return NULL; + } + } else { + actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, "Tk", + version, 1, NULL); + if (actualVersion == NULL) { + return NULL; + } + } } - - if (!tkStubsPtr) { - Tcl_SetResult(interp, - "This implementation of Tk does not support stubs", - TCL_STATIC); - return NULL; + if (stubsPtr == NULL) { + errMsg = "missing stub table pointer"; + } else { + tkStubsPtr = stubsPtr; + if (stubsPtr->hooks) { + tkPlatStubsPtr = stubsPtr->hooks->tkPlatStubs; + tkIntStubsPtr = stubsPtr->hooks->tkIntStubs; + tkIntPlatStubsPtr = stubsPtr->hooks->tkIntPlatStubs; + tkIntXlibStubsPtr = stubsPtr->hooks->tkIntXlibStubs; + } else { + tkPlatStubsPtr = NULL; + tkIntStubsPtr = NULL; + tkIntPlatStubsPtr = NULL; + tkIntXlibStubsPtr = NULL; + } + return actualVersion; } - - tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs; - tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs; - tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs; - tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs; - - return actualVersion; + tclStubsPtr->tcl_ResetResult(interp); + tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName, + " (requested version ", version, ", actual version ", + actualVersion, "): ", errMsg, NULL); + return NULL; } /* diff --git a/generic/tkStyle.c b/generic/tkStyle.c index dd3b2e8..c2eed8f 100644 --- a/generic/tkStyle.c +++ b/generic/tkStyle.c @@ -62,7 +62,7 @@ typedef struct StyleEngine { StyledElement *elements; /* Table of widget element descriptors. Each * element is indexed by a unique system-wide * ID. Table grows dynamically as new elements - * are registered. Malloc'd*/ + * are registered. Malloc'd. */ struct StyleEngine *parentPtr; /* Parent engine. Engines may be layered to * form a fallback chain, terminated by the @@ -146,7 +146,7 @@ static int SetStyleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); /* * The following structure defines the implementation of the "style" Tcl - * object, used for drawing. The internalRep.otherValuePtr field of each style + * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of each style * object points to the Style structure for the stylefont, or NULL. */ @@ -375,14 +375,12 @@ InitStyleEngine( */ enginePtr->parentPtr = NULL; - } else if (parentPtr == NULL) { /* * The default style engine is the parent. */ enginePtr->parentPtr = tsdPtr->defaultEnginePtr; - } else { enginePtr->parentPtr = parentPtr; } @@ -602,17 +600,16 @@ FreeStyledElement( static int CreateElement( - const char *name, /* Name of the element. */ - int create) /* Boolean, whether the element is being created - * explicitly (being registered) or implicitly (by a - * derived element). */ + const char *name, /* Name of the element. */ + int create) /* Boolean, whether the element is being + * created explicitly (being registered) or + * implicitly (by a derived element). */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_HashEntry *entryPtr, *engineEntryPtr; Tcl_HashSearch search; - int newEntry; - int elementId, genericId = -1; + int newEntry, elementId, genericId = -1; char *dot; StyleEngine *enginePtr; @@ -1261,8 +1258,7 @@ Tk_CreateStyle( stylePtr = (Style *) ckalloc(sizeof(Style)); InitStyle(stylePtr, Tcl_GetHashKey(&tsdPtr->styleTable, entryPtr), - (engine != NULL ? (StyleEngine *) engine : - tsdPtr->defaultEnginePtr), + (engine!=NULL ? (StyleEngine *) engine : tsdPtr->defaultEnginePtr), clientData); Tcl_SetHashValue(entryPtr, (ClientData) stylePtr); @@ -1415,10 +1411,8 @@ Tk_AllocStyleFromObj( if (objPtr->typePtr != &styleObjType) { SetStyleFromAny(interp, objPtr); - stylePtr = (Style *) objPtr->internalRep.otherValuePtr; - } else { - stylePtr = (Style *) objPtr->internalRep.otherValuePtr; } + stylePtr = (Style *) objPtr->internalRep.twoPtrValue.ptr1; return (Tk_Style) stylePtr; } @@ -1450,7 +1444,7 @@ Tk_GetStyleFromObj( SetStyleFromAny(NULL, objPtr); } - return (Tk_Style) objPtr->internalRep.otherValuePtr; + return (Tk_Style) objPtr->internalRep.twoPtrValue.ptr1; } /* @@ -1505,7 +1499,7 @@ SetStyleFromAny( } objPtr->typePtr = &styleObjType; - objPtr->internalRep.otherValuePtr = (VOID *) Tk_GetStyle(interp, name); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) Tk_GetStyle(interp, name); return TCL_OK; } @@ -1528,7 +1522,7 @@ static void FreeStyleObjProc( Tcl_Obj *objPtr) /* The object we are releasing. */ { - objPtr->internalRep.otherValuePtr = NULL; + objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->typePtr = NULL; } @@ -1549,7 +1543,8 @@ DupStyleObjProc( Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { dupObjPtr->typePtr = srcObjPtr->typePtr; - dupObjPtr->internalRep.otherValuePtr=srcObjPtr->internalRep.otherValuePtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = + srcObjPtr->internalRep.twoPtrValue.ptr1; } /* diff --git a/generic/tkTest.c b/generic/tkTest.c index 307ca34..9fe2222 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -400,7 +400,7 @@ CBindingEvalProc( cbindPtr = (CBinding *) clientData; - return Tcl_GlobalEval(interp, cbindPtr->command); + return Tcl_EvalEx(interp, cbindPtr->command, -1, TCL_EVAL_GLOBAL); } static void @@ -410,7 +410,7 @@ CBindingFreeProc( CBinding *cbindPtr = (CBinding *) clientData; if (cbindPtr->delete != NULL) { - Tcl_GlobalEval(cbindPtr->interp, cbindPtr->delete); + Tcl_EvalEx(cbindPtr->interp, cbindPtr->delete, -1, TCL_EVAL_GLOBAL); ckfree((char *) cbindPtr->delete); } ckfree((char *) cbindPtr->command); diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c index 771347d..bc2b7c4 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -779,6 +779,10 @@ TkTextImageIndex( Tcl_HashEntry *hPtr; TkTextSegment *eiPtr; + if (textPtr == NULL) { + return 0; + } + hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->imageTable, name); if (hPtr == NULL) { return 0; diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index a9b0bed..70c94db 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -758,9 +758,11 @@ GetIndex( /* *--------------------------------------------------------------------- - * Stage 1: check to see if the index consists of nothing but a mark name. - * We do this check now even though it's also done later, in order to - * allow mark names that include funny characters such as spaces or "+1c". + * Stage 1: check to see if the index consists of nothing but a mark + * name, an embedded window or an embedded image. We do this check + * now even though it's also done later, in order to allow mark names, + * embedded window names or image names that include funny characters + * such as spaces or "+1c". *--------------------------------------------------------------------- */ @@ -768,6 +770,14 @@ GetIndex( goto done; } + if (TkTextWindowIndex(textPtr, string, indexPtr) != 0) { + return TCL_OK; + } + + if (TkTextImageIndex(textPtr, string, indexPtr) != 0) { + return TCL_OK; + } + /* *------------------------------------------------ * Stage 2: start again by parsing the base index. diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index ecafd4e..8d1f850 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -902,10 +902,10 @@ EmbWinLayoutProc( if (dsPtr != NULL) { Tcl_DStringAppend(dsPtr, before, (int) (string-before)); - code = Tcl_GlobalEval(textPtr->interp, Tcl_DStringValue(dsPtr)); + code = Tcl_EvalEx(textPtr->interp, Tcl_DStringValue(dsPtr), -1, TCL_EVAL_GLOBAL); Tcl_DStringFree(dsPtr); } else { - code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create); + code = Tcl_EvalEx(textPtr->interp, ewPtr->body.ew.create, -1, TCL_EVAL_GLOBAL); } if (code != TCL_OK) { createError: @@ -1329,6 +1329,10 @@ TkTextWindowIndex( Tcl_HashEntry *hPtr; TkTextSegment *ewPtr; + if (textPtr == NULL) { + return 0; + } + hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->windowTable, name); if (hPtr == NULL) { return 0; diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 2a8240b..bfa5d5c 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -976,89 +976,6 @@ TkFindStateNumObj( } /* - * ---------------------------------------------------------------------- - * - * TkBackgroundEvalObjv -- - * - * Evaluate a command while ensuring that we do not affect the - * interpreters state. This is important when evaluating script - * during background tasks. - * - * Results: - * A standard Tcl result code. - * - * Side Effects: - * The interpreters variables and code may be modified by the script - * but the result will not be modified. - * - * ---------------------------------------------------------------------- - */ - -int -TkBackgroundEvalObjv( - Tcl_Interp *interp, - int objc, - Tcl_Obj *const *objv, - int flags) -{ - Tcl_DString errorInfo, errorCode; - Tcl_SavedResult state; - int n, r = TCL_OK; - - Tcl_DStringInit(&errorInfo); - Tcl_DStringInit(&errorCode); - - Tcl_Preserve(interp); - - /* - * Record the state of the interpreter - */ - - Tcl_SaveResult(interp, &state); - Tcl_DStringAppend(&errorInfo, - Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1); - Tcl_DStringAppend(&errorCode, - Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1); - - /* - * Evaluate the command and handle any error. - */ - - for (n = 0; n < objc; ++n) { - Tcl_IncrRefCount(objv[n]); - } - r = Tcl_EvalObjv(interp, objc, objv, flags); - for (n = 0; n < objc; ++n) { - Tcl_DecrRefCount(objv[n]); - } - if (r == TCL_ERROR) { - Tcl_AddErrorInfo(interp, "\n (background event handler)"); - Tcl_BackgroundError(interp); - } - - Tcl_Release(interp); - - /* - * Restore the state of the interpreter - */ - - Tcl_SetVar(interp, "errorInfo", - Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "errorCode", - Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY); - Tcl_RestoreResult(interp, &state); - - /* - * Clean up references. - */ - - Tcl_DStringFree(&errorInfo); - Tcl_DStringFree(&errorCode); - - return r; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 995f71f..d40e7de 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -3021,11 +3021,10 @@ Initialize( ThreadSpecificData *tsdPtr; /* - * Ensure that we are getting the matching version of Tcl. This is really - * only an issue when Tk is loaded dynamically. + * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, TCL_VERSION ".0", 0) == NULL) { return TCL_ERROR; } @@ -3257,11 +3256,6 @@ Initialize( geometry = NULL; } - if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) { - code = TCL_ERROR; - goto done; - } - /* * Provide Tk and its stub table. */ @@ -3281,10 +3275,6 @@ Initialize( Tcl_SetMainLoop(Tk_MainLoop); -#undef Tk_InitStubs - - Tk_InitStubs(interp, TK_VERSION, 1); - /* * Initialized the themed widget set */ diff --git a/generic/ttk/ttkManager.c b/generic/ttk/ttkManager.c index ba9e5c0..2fcb190 100644 --- a/generic/ttk/ttkManager.c +++ b/generic/ttk/ttkManager.c @@ -237,7 +237,7 @@ void Ttk_DeleteManager(Ttk_Manager *mgr) ckfree((ClientData)mgr->slaves); } - Tk_CancelIdleCall(ManagerIdleProc, mgr); + Tcl_CancelIdleCall(ManagerIdleProc, mgr); ckfree((ClientData)mgr); } diff --git a/generic/ttk/ttkScroll.c b/generic/ttk/ttkScroll.c index defe05a..b670540 100644 --- a/generic/ttk/ttkScroll.c +++ b/generic/ttk/ttkScroll.c @@ -78,6 +78,7 @@ static int UpdateScrollbar(Tcl_Interp *interp, ScrollHandle h) char arg1[TCL_DOUBLE_SPACE + 2]; char arg2[TCL_DOUBLE_SPACE + 2]; int code; + Tcl_DString buf; h->flags &= ~SCROLL_UPDATE_REQUIRED; @@ -88,9 +89,14 @@ static int UpdateScrollbar(Tcl_Interp *interp, ScrollHandle h) arg1[0] = arg2[0] = ' '; Tcl_PrintDouble(interp, (double)s->first / s->total, arg1+1); Tcl_PrintDouble(interp, (double)s->last / s->total, arg2+1); + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, s->scrollCmd, -1); + Tcl_DStringAppend(&buf, arg1, -1); + Tcl_DStringAppend(&buf, arg2, -1); Tcl_Preserve(corePtr); - code = Tcl_VarEval(interp, s->scrollCmd, arg1, arg2, NULL); + code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, TCL_EVAL_GLOBAL); + Tcl_DStringFree(&buf); if (WidgetDestroyed(corePtr)) { Tcl_Release(corePtr); return TCL_ERROR; diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c index 5095487..a2c51c0 100644 --- a/generic/ttk/ttkTheme.c +++ b/generic/ttk/ttkTheme.c @@ -509,7 +509,7 @@ static void ThemeChangedProc(ClientData clientData) static char ThemeChangedScript[] = "ttk::ThemeChanged"; StylePackageData *pkgPtr = clientData; - if (Tcl_GlobalEval(pkgPtr->interp, ThemeChangedScript) != TCL_OK) { + if (Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL) != TCL_OK) { Tcl_BackgroundError(pkgPtr->interp); } pkgPtr->themeChangePending = 0; diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c index 862c7f6..f0a3003 100644 --- a/generic/ttk/ttkTreeview.c +++ b/generic/ttk/ttkTreeview.c @@ -3169,6 +3169,8 @@ static int TreeviewTagAddCommand( AddTag(items[i], tag); } + TtkRedisplayWidget(&tv->core); + return TCL_OK; } @@ -3213,6 +3215,9 @@ static int TreeviewTagRemoveCommand( item=NextPreorder(item); } } + + TtkRedisplayWidget(&tv->core); + return TCL_OK; } diff --git a/library/button.tcl b/library/button.tcl index d095b8a..75378cc 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -109,6 +109,15 @@ bind Checkbutton <space> { bind Radiobutton <space> { tk::CheckRadioInvoke %W } +bind Button <<Invoke>> { + tk::ButtonInvoke %W +} +bind Checkbutton <<Invoke>> { + tk::CheckRadioInvoke %W +} +bind Radiobutton <<Invoke>> { + tk::CheckRadioInvoke %W +} bind Button <FocusIn> {} bind Button <Enter> { diff --git a/library/listbox.tcl b/library/listbox.tcl index f3434a5..2d9af20 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -142,6 +142,9 @@ bind Listbox <<Copy>> { bind Listbox <space> { tk::ListboxBeginSelect %W [%W index active] } +bind Listbox <<Invoke>> { + tk::ListboxBeginSelect %W [%W index active] +} bind Listbox <Select> { tk::ListboxBeginSelect %W [%W index active] } diff --git a/library/menu.tcl b/library/menu.tcl index cc57532..f133c87 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -106,6 +106,10 @@ bind Menubutton <space> { tk::MbPost %W tk::MenuFirstEntry [%W cget -menu] } +bind Menubutton <<Invoke>> { + tk::MbPost %W + tk::MenuFirstEntry [%W cget -menu] +} # Must set focus when mouse enters a menu, in order to allow # mixed-mode processing using both the mouse and the keyboard. @@ -143,6 +147,9 @@ bind Menu <ButtonRelease> { bind Menu <space> { tk::MenuInvoke %W 0 } +bind Menu <<Invoke>> { + tk::MenuInvoke %W 0 +} bind Menu <Return> { tk::MenuInvoke %W 0 } diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index d9e824a..bc11b96 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -14,6 +14,9 @@ #include "tkMacOSXPrivate.h" #include "tkFileFilter.h" +static int TkBackgroundEvalObjv(Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv, int flags); + static const char *colorOptionStrings[] = { "-initialcolor", "-parent", "-title", NULL }; @@ -1057,6 +1060,68 @@ end: } /* + * ---------------------------------------------------------------------- + * + * TkBackgroundEvalObjv -- + * + * Evaluate a command while ensuring that we do not affect the + * interpreters state. This is important when evaluating script + * during background tasks. + * + * Results: + * A standard Tcl result code. + * + * Side Effects: + * The interpreters variables and code may be modified by the script + * but the result will not be modified. + * + * ---------------------------------------------------------------------- + */ + +int +TkBackgroundEvalObjv( + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv, + int flags) +{ + Tcl_InterpState state; + int n, r = TCL_OK; + + /* + * Record the state of the interpreter. + */ + + Tcl_Preserve(interp); + state = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Evaluate the command and handle any error. + */ + + for (n = 0; n < objc; ++n) { + Tcl_IncrRefCount(objv[n]); + } + r = Tcl_EvalObjv(interp, objc, objv, flags); + for (n = 0; n < objc; ++n) { + Tcl_DecrRefCount(objv[n]); + } + if (r == TCL_ERROR) { + Tcl_AddErrorInfo(interp, "\n (background event handler)"); + Tcl_BackgroundError(interp); + } + + /* + * Restore the state of the interpreter. + */ + + (void) Tcl_RestoreInterpState(interp, state); + Tcl_Release(interp); + + return r; +} + +/* * Local Variables: * mode: objc * c-basic-offset: 4 diff --git a/macosx/tkMacOSXHLEvents.c b/macosx/tkMacOSXHLEvents.c index 43117a1..9671ab9 100644 --- a/macosx/tkMacOSXHLEvents.c +++ b/macosx/tkMacOSXHLEvents.c @@ -222,7 +222,7 @@ OappHandler( if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){ - int code = Tcl_GlobalEval(interp, "::tk::mac::OpenApplication"); + int code = Tcl_EvalEx(interp, "::tk::mac::OpenApplication", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_BackgroundError(interp); } @@ -259,7 +259,7 @@ RappHandler( if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::ReopenApplication", &dummy)) { - int code = Tcl_GlobalEval(interp, "::tk::mac::ReopenApplication"); + int code = Tcl_EvalEx(interp, "::tk::mac::ReopenApplication", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK){ Tcl_BackgroundError(interp); } @@ -295,7 +295,7 @@ PrefsHandler( if (interp && Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){ - int code = Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences"); + int code = Tcl_EvalEx(interp, "::tk::mac::ShowPreferences", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_BackgroundError(interp); } @@ -625,7 +625,7 @@ ReallyKillMe( Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp; Tcl_CmdInfo dummy; int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy); - int code = Tcl_GlobalEval(interp, quit ? "::tk::mac::Quit" : "exit"); + int code = Tcl_EvalEx(interp, quit ? "::tk::mac::Quit" : "exit", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { /* diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index 6ced470..87504b3 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -701,7 +701,7 @@ TkWmProtocolEventProc( Tcl_Preserve(protPtr); interp = protPtr->interp; Tcl_Preserve(interp); - result = Tcl_GlobalEval(interp, protPtr->command); + result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command for \""); Tcl_AddErrorInfo(interp, diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 45f0fd5..fbc167d 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -321,6 +321,10 @@ static void GetMaxSize(TkWindow *winPtr, int *maxWidthPtr, static void RemapWindows(TkWindow *winPtr, MacDrawable *parentWin); +#if MAC_OS_X_VERSION_MIN_REQUIRED >= 1060 +#define TK_GOT_AT_LEAST_SNOW_LEOPARD 1 +#endif + #pragma mark TKWindow(TKWm) #if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 @@ -665,7 +669,7 @@ TkWmMapWindow( wmPtr->flags |= WM_ABOUT_TO_MAP; if (wmPtr->flags & WM_UPDATE_PENDING) { - Tk_CancelIdleCall(UpdateGeometryInfo, winPtr); + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); } UpdateGeometryInfo(winPtr); wmPtr->flags &= ~WM_ABOUT_TO_MAP; @@ -769,7 +773,7 @@ TkWmDeadWindow( ckfree(wmPtr->clientMachine); } if (wmPtr->flags & WM_UPDATE_PENDING) { - Tk_CancelIdleCall(UpdateGeometryInfo, winPtr); + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); } /* @@ -4396,7 +4400,7 @@ Tk_MoveToplevelWindow( if (!(wmPtr->flags & WM_NEVER_MAPPED)) { if (wmPtr->flags & WM_UPDATE_PENDING) { - Tk_CancelIdleCall(UpdateGeometryInfo, winPtr); + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); } UpdateGeometryInfo(winPtr); } @@ -4539,7 +4543,7 @@ TkWmAddToColormapWindows( * add the toplevel itself as the last element of the list. */ - newPtr = ckalloc((count+2) * sizeof(TkWindow *)); + newPtr = (TkWindow**)ckalloc((count+2) * sizeof(TkWindow *)); if (count > 0) { memcpy(newPtr, oldPtr, count * sizeof(TkWindow *)); } @@ -5438,10 +5442,14 @@ TkMacOSXMakeRealWindowExist( /* Set background color and opacity of window if those flags are set. */ if (colorName != NULL) { [window setBackgroundColor: colorName]; - } + } if (opaqueTag != NULL) { +#ifdef TK_GOT_AT_LEAST_SNOW_LEOPARD [window setOpaque: opaqueTag]; +#else + [window setOpaque: YES]; +#endif } [window setDocumentEdited:NO]; @@ -5942,7 +5950,7 @@ TkWmStackorderToplevel( Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS); WmStackorderToplevelWrapperMap(parentPtr, parentPtr->display, &table); - windows = ckalloc((table.numEntries+1) * sizeof(TkWindow *)); + windows = (TkWindow**)ckalloc((table.numEntries+1) * sizeof(TkWindow *)); /* * Special cases: If zero or one toplevels were mapped there is no need to @@ -5967,7 +5975,7 @@ TkWmStackorderToplevel( } else { window_ptr = windows + table.numEntries; *window_ptr-- = NULL; - windowNumbers = ckalloc(windowCount * sizeof(NSInteger)); + windowNumbers = (NSInteger*)ckalloc(windowCount * sizeof(NSInteger)); NSWindowList(windowCount, windowNumbers); for (NSInteger index = 0; index < windowCount; index++) { NSWindow *w = [NSApp windowWithWindowNumber:windowNumbers[index]]; @@ -6286,7 +6294,9 @@ TkMacOSXMakeFullscreen( WmInfo *wmPtr = winPtr->wmInfoPtr; int result = TCL_OK, wasFullscreen = (wmPtr->flags & WM_FULLSCREEN); +#ifdef TK_GOT_AT_LEAST_SNOW_LEOPARD static unsigned long prevMask = 0, prevPres = 0; +#endif /*TK_GOT_AT_LEAST_SNOW_LEOPARD*/ if (fullscreen) { int screenWidth = WidthOfScreen(Tk_Screen(winPtr)); @@ -6325,15 +6335,26 @@ TkMacOSXMakeFullscreen( wmPtr->flags |= WM_FULLSCREEN; } +#ifdef TK_GOT_AT_LEAST_SNOW_LEOPARD + /* + * We can't set these features on Leopard or earlier, as they don't + * exist (neither options nor API that uses them). This formally means + * that there's a bug with full-screen windows with Tk on old OSX, but + * it isn't worth blocking a build just for this. + */ + prevMask = [window styleMask]; prevPres = [NSApp presentationOptions]; [window setStyleMask: NSBorderlessWindowMask]; [NSApp setPresentationOptions: NSApplicationPresentationAutoHideDock | NSApplicationPresentationAutoHideMenuBar]; +#endif /*TK_GOT_AT_LEAST_SNOW_LEOPARD*/ } else { wmPtr->flags &= ~WM_FULLSCREEN; +#ifdef TK_GOT_AT_LEAST_SNOW_LEOPARD [NSApp setPresentationOptions: prevPres]; [window setStyleMask: prevMask]; +#endif /*TK_GOT_AT_LEAST_SNOW_LEOPARD*/ } if (wasFullscreen && !(wmPtr->flags & WM_FULLSCREEN)) { diff --git a/tests/font.test b/tests/font.test index 34e4b83..82af541 100644 --- a/tests/font.test +++ b/tests/font.test @@ -46,10 +46,9 @@ proc csetup {{str ""}} { setup -case [tk windowingsystem] { +switch [tk windowingsystem] { x11 {set fixed "fixed"} win32 {set fixed "courier 12"} - classic - aqua {set fixed "monaco 9"} } diff --git a/tests/listbox.test b/tests/listbox.test index 25bc606..b4046b6 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -2158,6 +2158,17 @@ test listbox-29.1 {listbox selection behavior, -state disabled} { lappend out [.l selection includes 2] [.l curselection] } {1 1 2} +test listbox-30.1 {Bug 3607326} -setup { + destroy .l + unset -nocomplain a +} -body { + array set a {} + listbox .l -listvariable a +} -cleanup { + destroy .l + unset -nocomplain a +} -result * -match glob -returnCodes error + resetGridInfo deleteWindows option clear diff --git a/tests/textIndex.test b/tests/textIndex.test index 6341b6d..28dc0df 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -214,9 +214,31 @@ set weirdTag "funny . +- 22.1\n\t{" set weirdMark "asdf \n{-+ 66.2\t" .t mark set $weirdMark 4.0 .t tag config y -relief raised +set weirdImage "foo-1" +.t image create 2.1 -image [image create photo $weirdImage] +set weirdEmbWin ".t.bar-1" +entry $weirdEmbWin +.t window create 3.1 -window $weirdEmbWin test textIndex-3.1 {TkTextGetIndex, weird mark names} { list [catch {.t index $weirdMark} msg] $msg } {0 4.0} +test textIndex-3.2 {TkTextGetIndex, weird mark names} knownBug { + list [catch {.t index "$weirdMark -1char"} msg] $msg +} {0 4.0} +test textIndex-3.3 {TkTextGetIndex, weird embedded window names} { + list [catch {.t index $weirdEmbWin} msg] $msg +} {0 3.1} +test textIndex-3.4 {TkTextGetIndex, weird embedded window names} knownBug { + list [catch {.t index "$weirdEmbWin -1char"} msg] $msg +} {0 3.0} +test textIndex-3.5 {TkTextGetIndex, weird image names} { + list [catch {.t index $weirdImage} msg] $msg +} {0 2.1} +test textIndex-3.6 {TkTextGetIndex, weird image names} knownBug { + list [catch {.t index "$weirdImage -1char"} msg] $msg +} {0 2.0} +.t delete 3.1 ; # remove the weirdEmbWin +.t delete 2.1 ; # remove the weirdImage test textIndex-4.1 {TkTextGetIndex, tags} { list [catch {.t index x.first} msg] $msg diff --git a/tests/winDialog.test b/tests/winDialog.test index 80eb297..bb515af 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -70,7 +70,7 @@ proc SetText {id text} { return [testwinevent $::tk_dialog $id WM_SETTEXT $text] } -test winDialog-1.1.0 {Tk_ChooseColorObjCmd} -constraints { +test winDialog-1.1 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { start {tk_chooseColor} @@ -78,7 +78,7 @@ test winDialog-1.1.0 {Tk_ChooseColorObjCmd} -constraints { Click cancel } } -result {0} -test winDialog-1.1.1 {Tk_ChooseColorObjCmd} -constraints { +test winDialog-1.2 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { start {set clr [tk_chooseColor -initialcolor "#ff9933"]} @@ -87,7 +87,7 @@ test winDialog-1.1.1 {Tk_ChooseColorObjCmd} -constraints { } list $x $clr } -result {0 {}} -test winDialog-1.1.2 {Tk_ChooseColorObjCmd} -constraints { +test winDialog-1.3 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { start {set clr [tk_chooseColor -initialcolor "#ff9933"]} @@ -96,9 +96,11 @@ test winDialog-1.1.2 {Tk_ChooseColorObjCmd} -constraints { } list $x $clr } -result [list 0 "#ff9933"] -test winDialog-1.1.3 {Tk_ChooseColorObjCmd: -title} -constraints { +test winDialog-1.4 {Tk_ChooseColorObjCmd: -title} -constraints { testwinevent -} -setup {unset -nocomplain a x} -body { +} -setup { + catch {unset a x} +} -body { set x {} start {set clr [tk_chooseColor -initialcolor "#ff9933" -title "Hello"]} then { @@ -110,9 +112,11 @@ test winDialog-1.1.3 {Tk_ChooseColorObjCmd: -title} -constraints { } lappend x $clr } -result [list Hello 0 "#ff9933"] -test winDialog-1.1.4 {Tk_ChooseColorObjCmd: -title} -constraints { +test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints { testwinevent -} -setup {unset -nocomplain a x} -body { +} -setup { + catch {unset a x} +} -body { set x {} start { set clr [tk_chooseColor -initialcolor "#ff9933" \ @@ -127,9 +131,11 @@ test winDialog-1.1.4 {Tk_ChooseColorObjCmd: -title} -constraints { } lappend x $clr } -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"] -test winDialog-1.1.5 {Tk_ChooseColorObjCmd: -parent} -constraints { +test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints { testwinevent -} -setup {unset -nocomplain a x} -body { +} -setup { + catch {unset a x} +} -body { start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]} set x {} then { @@ -143,98 +149,135 @@ test winDialog-1.1.5 {Tk_ChooseColorObjCmd: -parent} -constraints { } list $x $clr } -result [list 1 "#ff9933"] -test winDialog-1.1.6 {Tk_ChooseColorObjCmd: -parent} -constraints { +test winDialog-1.7 {Tk_ChooseColorObjCmd: -parent} -constraints { testwinevent } -body { tk_chooseColor -initialcolor "#ff9933" -parent .xyzzy12 } -returnCodes error -match glob -result {bad window path name*} -test winDialog-2.1 {ColorDlgHookProc} {emptyTest nt} { -} {} -test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent english} { +test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints { + nt testwinevent english +} -body { start {tk_getOpenFile} then { set x [GetText cancel] Click cancel } - set x -} {Cancel} + return $x +} -result {Cancel} -test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent english} { + +test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints { + nt testwinevent english +} -body { start {tk_getSaveFile} then { set x [GetText cancel] Click cancel } - set x -} {Cancel} + return $x +} -result {Cancel} -test winDialog-5.1 {GetFileName: no arguments} {nt testwinevent} { +test winDialog-5.1 {GetFileName: no arguments} -constraints { + nt testwinevent +} -body { start {tk_getOpenFile -title Open} then { Click cancel } -} {0} -test winDialog-5.2 {GetFileName: one argument} {nt} { - list [catch {tk_getOpenFile -foo} msg] $msg -} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}} -test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} { +} -result {0} +test winDialog-5.2 {GetFileName: one argument} -constraints { + nt +} -body { + tk_getOpenFile -foo +} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable} +test winDialog-5.3 {GetFileName: many arguments} -constraints { + nt testwinevent +} -body { start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} then { Click cancel } -} {0} -test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} { - list [catch {tk_getOpenFile -foo bar -abc} msg] $msg -} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}} -test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} { +} -result {0} +test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints { + nt +} -body { + tk_getOpenFile -foo bar -abc +} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable} +test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints { + nt testwinevent +} -body { start {tk_getOpenFile -title bar} then { Click cancel } -} {0} -test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} { - list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg -} {1 {value for "-title" missing}} -test winDialog-5.8 {GetFileName: extension begins with .} {nt testwinevent knownBug} { +} -result {0} +test winDialog-5.6 {GetFileName: valid option, but missing value} -constraints { + nt +} -body { + tk_getOpenFile -initialdir bar -title +} -returnCodes error -result {value for "-title" missing} +test winDialog-5.7 {GetFileName: extension begins with .} -constraints { + nt testwinevent +} -body { # if (string[0] == '.') { # string++; # } start {set x [tk_getSaveFile -defaultextension .foo -title Save]} + set msg {} then { - SetText 0x480 bar - Click ok + if {[catch {SetText 0x47C bar} msg]} { + Click cancel + } else { + Click ok + } } - string totitle $x -} [string totitle [file join [pwd] bar.foo]] -test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt testwinevent knownBug} { + return [string totitle $x]$msg +} -cleanup { + unset msg +} -result [string totitle [file join [pwd] bar.foo]] +test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { + nt testwinevent +} -body { start {set x [tk_getSaveFile -defaultextension foo -title Save]} + set msg {} then { - SetText 0x480 bar - Click ok + if {[catch {SetText 0x47C bar} msg]} { + Click cancel + } else { + Click ok + } } - string totitle $x -} [string totitle [file join [pwd] bar.foo]] -test winDialog-5.10 {GetFileName: file types} {nt testwinevent} { -# case FILE_TYPES: + return [string totitle $x]$msg +} -cleanup { + unset msg +} -result [string totitle [file join [pwd] bar.foo]] +test winDialog-5.9 {GetFileName: file types} -constraints { + nt testwinevent +} -body { +# case FILE_TYPES: start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} then { set x [GetText 0x470] Click cancel } - set x -} {foo files (*.foo)} -test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} { -# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) + return $x +} -result {foo files (*.foo)} +test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints { + nt +} -body { +# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) - list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg -} {1 {bad Macintosh file type "FOO"}} + tk_getSaveFile -filetypes {{"foo" .foo FOO}} +} -returnCodes error -result {bad Macintosh file type "FOO"} if {[info exists ::env(TEMP)]} { -test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} { -# case FILE_INITDIR: +test winDialog-5.11 {GetFileName: initial directory} -constraints { + nt testwinevent +} -body { +# case FILE_INITDIR: start {set x [tk_getSaveFile \ -initialdir [file normalize $::env(TEMP)] \ @@ -242,41 +285,50 @@ test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} { then { Click ok } - set x -} [file join [file normalize $::env(TEMP)] "12x 455"] + return $x +} -result [file join [file normalize $::env(TEMP)] "12x 455"] } -test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \ - {nt} { -# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) - - list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg -} {1 {user "12x" doesn't exist}} -test winDialog-5.14 {GetFileName: initial file} {nt testwinevent} { -# case FILE_INITFILE: +test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints { + nt +} -body { +# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) + + tk_getOpenFile -initialdir ~12x/455 +} -returnCodes error -result {user "12x" doesn't exist} +test winDialog-5.13 {GetFileName: initial file} -constraints { + nt testwinevent +} -body { +# case FILE_INITFILE: start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} then { Click ok } string totitle $x -} [string totitle [file join [pwd] "12x 456"]] -test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} { -# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) - list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg -} {1 {user "12x" doesn't exist}} -test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} { +} -result [string totitle [file join [pwd] "12x 456"]] +test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints { + nt +} -body { +# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) + tk_getOpenFile -initialfile ~12x/455 +} -returnCodes error -result {user "12x" doesn't exist} +test winDialog-5.15 {GetFileName: initial file: long name} -constraints { + nt testwinevent +} -body { start { - set dialogresult [catch { - tk_getSaveFile -initialfile [string repeat a 1024] -title Long - } x] + set dialogresult [catch { + tk_getSaveFile -initialfile [string repeat a 1024] -title Long + } x] } then { Click ok } list $dialogresult [string match "invalid filename *" $x] -} {1 1} -test winDialog-5.17 {GetFileName: parent} {nt} { -# case FILE_PARENT: +} -result {1 1} +test winDialog-5.16 {GetFileName: parent} -constraints { + nt +} -body { +# case FILE_PARENT: toplevel .t set x 0 @@ -284,151 +336,185 @@ test winDialog-5.17 {GetFileName: parent} {nt} { then { destroy .t } - set x -} {1} -test winDialog-5.18 {GetFileName: title} {nt testwinevent} { -# case FILE_TITLE: - + return $x +} -result {1} +test winDialog-5.17 {GetFileName: title} -constraints { + nt testwinevent +} -body { +# case FILE_TITLE: + start {tk_getOpenFile -title Narf} then { Click cancel } -} {0} -test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} { -# if (ofn.lpstrFilter == NULL) +} -result {0} +test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent +} -body { +# if (ofn.lpstrFilter == NULL) - start {tk_getOpenFile -title Filter} + start {tk_getOpenFile -title Filter} then { set x [GetText 0x470] Click cancel } - set x -} {All Files (*.*)} -test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} { -# if (Tk_WindowId(parent) == None) + return $x +} -result {All Files (*.*)} +test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints { + nt +} -setup { + destroy .t +} -body { +# if (Tk_WindowId(parent) == None) toplevel .t start {tk_getOpenFile -parent .t -title Open} then { destroy .t } -} {} -test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} { +} -result {} +test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints { + nt +} -setup { + destroy .t +} -body { toplevel .t update start {tk_getOpenFile -parent .t -title Open} then { destroy .t } -} {} -test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent english} { -# winCode = GetOpenFileName(&ofn); - +} -result {} +test winDialog-5.21 {GetFileName: call GetOpenFileName} -constraints { + nt testwinevent english +} -body { +# winCode = GetOpenFileName(&ofn); + start {tk_getOpenFile -title Open} then { set x [GetText ok] Click cancel } - set x -} {&Open} -test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent english} { -# winCode = GetSaveFileName(&ofn); + return $x +} -result {&Open} +test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints { + nt testwinevent english +} -body { +# winCode = GetSaveFileName(&ofn); start {tk_getSaveFile -title Save} then { set x [GetText ok] Click cancel } - set x -} {&Save} + return $x +} -result {&Save} if {[info exists ::env(TEMP)]} { -test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent knownBug} { +test winDialog-5.23 {GetFileName: convert \ to /} -constraints { + nt testwinevent +} -body { + set msg {} start {set x [tk_getSaveFile -title Back]} then { - SetText 0x480 [file nativename \ - [file join [file normalize $::env(TEMP)] "12x 457"]] - Click ok + if {[catch {SetText 0x47C [file nativename \ + [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} { + Click cancel + } else { + Click ok + } } - set x -} [file join [file normalize $::env(TEMP)] "12x 457"] + return $x$msg +} -cleanup { + unset msg +} -result [file join [file normalize $::env(TEMP)] "12x 457"] } -test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} {nt} { +test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraints { + nt +} -body { # MacOS type that is correct, but has embedded nulls. start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0}}}}]} then { Click cancel } - set x -} {0} -test winDialog-5.26 {GetFileName: file types: MakeFilter() succeeds} {nt} { + return $x +} -result {0} +test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraints { + nt +} -body { # MacOS type that is correct, but has embedded high-bit chars. start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]} then { Click cancel } - set x -} {0} - -test winDialog-6.1 {MakeFilter} {emptyTest nt} {} {} - -test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {} - -test winDialog-8.1 {OFNHookProc} {emptyTest nt} {} {} + return $x +} -result {0} ## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows ## because somehow the GetOpenFileName ends up a noop in the static ## build. ## -test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt testwinevent} { +test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} -constraints { + nt testwinevent +} -body { start {tk_chooseDirectory} then { Click cancel } -} {0} -test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} { - list [catch {tk_chooseDirectory -foo} msg] $msg -} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} -test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt testwinevent} { +} -result {0} +test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints { + nt +} -body { + tk_chooseDirectory -foo +} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title} +test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints { + nt testwinevent +} -body { start { tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test } then { Click cancel } -} {0} -test winDialog-9.4 {Tk_ChooseDirectoryObjCmd:\ - Tcl_GetIndexFromObj() != TCL_OK} {nt} { - list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg -} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} -test winDialog-9.5 {Tk_ChooseDirectoryObjCmd:\ - Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} { +} -result {0} +test winDialog-9.4 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} -constraints { + nt +} -body { + tk_chooseDirectory -foo bar -abc +} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title} +test winDialog-9.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} -constraints { + nt testwinevent +} -body { start {tk_chooseDirectory -title bar} then { Click cancel } -} {0} -test winDialog-9.6 {Tk_ChooseDirectoryObjCmd:\ - valid option, but missing value} {nt} { - list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg -} {1 {value for "-title" missing}} -test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt testwinevent} { -# case DIR_INITIAL: +} -result {0} +test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} -constraints { + nt +} -body { + tk_chooseDirectory -initialdir bar -title +} -returnCodes error -result {value for "-title" missing} +test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints { + nt testwinevent +} -body { +# case DIR_INITIAL: start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} then { Click ok } string tolower [set x] -} {c:/} -test winDialog-9.8 {Tk_ChooseDirectoryObjCmd:\ - initial directory: Tcl_TranslateFilename()} {nt} { -# if (Tcl_TranslateFileName(interp, string, -# &utfDirString) == NULL) - - list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg -} {1 {user "12x" doesn't exist}} +} -result {c:/} +test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints { + nt +} -body { +# if (Tcl_TranslateFileName(interp, string, +# &utfDirString) == NULL) + + tk_chooseDirectory -initialdir ~12x/455 +} -returnCodes error -result {user "12x" doesn't exist} if {[testConstraint testwinevent]} { catch {testwinevent debug 0} @@ -437,3 +523,7 @@ if {[testConstraint testwinevent]} { # cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/unix/Makefile.in b/unix/Makefile.in index c530368..bfa4bc0 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -8,7 +8,6 @@ # Current Tk version; used in various names. TCLVERSION = @TCL_VERSION@ -TCLPATCHL = @TCL_PATCH_LEVEL@ VERSION = @TK_VERSION@ MAJOR_VERSION = @TK_MAJOR_VERSION@ MINOR_VERSION = @TK_MINOR_VERSION@ @@ -187,7 +186,7 @@ KEYSYM_FLAGS = # Tk does not used deprecated Tcl constructs so it should # compile fine with -DTCL_NO_DEPRECATED. To remove its own # set of deprecated code uncomment the second line. -NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED +NO_DEPRECATED_FLAGS = #NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED # Some versions of make, like SGI's, use the following variable to @@ -373,7 +372,7 @@ TTK_OBJS = \ ttkTagSet.o ttkTheme.o ttkTrace.o ttkTrack.o ttkTreeview.o \ ttkWidget.o ttkStubInit.o -STUB_OBJS = tkStubInit.o tkStubLib.o +STUB_OBJS = tkStubInit.o STUB_LIB_OBJS = tkStubLib.o ttkStubLib.o @@ -703,13 +702,13 @@ install-binaries: $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) ${WISH_EXE} echo "if {[catch {package present Tcl 8.5.0}]} return";\ relative=`echo | awk '{ORS=" "; split("$(TK_PKG_DIR)",a,"/"); for (f in a) {print ".."}}'`;\ if test "x$(DLL_INSTALL_DIR)" != "x$(BIN_INSTALL_DIR)"; then \ - echo "package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file join \$$dir $${relative}$(TK_LIB_FILE)] Tk]";\ + echo "package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir $${relative}$(TK_LIB_FILE)]] Tk]";\ else \ echo "if {(\$$::tcl_platform(platform) eq \"unix\") && ([info exists ::env(DISPLAY)]";\ echo " || ([info exists ::argv] && (\"-display\" in \$$::argv)))} {";\ - echo " package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file join \$$dir $${relative}.. bin $(TK_LIB_FILE)] Tk]";\ + echo " package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir $${relative}.. bin $(TK_LIB_FILE)]] Tk]";\ echo "} else {";\ - echo " package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file join \$$dir $${relative}.. bin tk${MAJOR_VERSION}${MINOR_VERSION}.dll] Tk]";\ + echo " package ifneeded Tk $(MAJOR_VERSION).$(MINOR_VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir $${relative}.. bin tk${MAJOR_VERSION}${MINOR_VERSION}.dll]] Tk]";\ echo "}";\ fi \ ) > "$(PKG_INDEX)"; \ diff --git a/unix/configure b/unix/configure index cc918fa..01274fe 100755 --- a/unix/configure +++ b/unix/configure @@ -862,8 +862,8 @@ Optional Features: on) --enable-symbols build with debugging symbols (default: off) --enable-aqua use Aqua windowingsystem on Mac OS X (default: off) - --enable-xss use XScreenSaver for activity timer (default: on) --enable-xft use freetype/fontconfig/xft (default: on) + --enable-xss use XScreenSaver for activity timer (default: on) --enable-framework package shared libraries in MacOSX frameworks (default: off) @@ -1585,7 +1585,16 @@ echo "${ECHO_T}$BUILD_TCLSH" >&6 -if test "${TCL_VERSION}" != "${TK_VERSION}"; then +if test "${TCL_MAJOR_VERSION}" != "${TK_MAJOR_VERSION}"; then + { { echo "$as_me:$LINENO: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&5 +echo "$as_me: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;} + { (exit 1); exit 1; }; } +fi +if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then { { echo "$as_me:$LINENO: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&5 @@ -1594,6 +1603,12 @@ Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;} { (exit 1); exit 1; }; } fi +if test "${TCL_MINOR_VERSION}" != "${TK_MINOR_VERSION}"; then + { echo "$as_me:$LINENO: WARNING: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}" >&5 +echo "$as_me: WARNING: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}" >&2;} +fi #------------------------------------------------------------------------ # Handle the --prefix=... option @@ -5623,7 +5638,7 @@ fi fi ;; - Linux*) + Linux*|GNU*|NetBSD-Debian) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" @@ -5729,21 +5744,6 @@ fi fi ;; - GNU*) - SHLIB_CFLAGS="-fPIC" - SHLIB_SUFFIX=".so" - - SHLIB_LD='${CC} -shared' - DL_OBJS="" - DL_LIBS="-ldl" - LDFLAGS="$LDFLAGS -Wl,--export-dynamic" - CC_SEARCH_FLAGS="" - LD_SEARCH_FLAGS="" - if test "`uname -m`" = "alpha"; then - CFLAGS="$CFLAGS -mieee" -fi - - ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" @@ -10106,7 +10106,7 @@ ac_x_header_dirs=' /usr/openwin/share/include' if test "$ac_x_includes" = no; then - # Guess where to find include files, by looking for Xlib.h. + # Guess where to find include files, by looking for Intrinsic.h. # First, try using that file with no special directory specified. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -10114,7 +10114,7 @@ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include <X11/Xlib.h> +#include <X11/Intrinsic.h> _ACEOF if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 @@ -10141,7 +10141,7 @@ else sed 's/^/| /' conftest.$ac_ext >&5 for ac_dir in $ac_x_header_dirs; do - if test -r "$ac_dir/X11/Xlib.h"; then + if test -r "$ac_dir/X11/Intrinsic.h"; then ac_x_includes=$ac_dir break fi @@ -10155,18 +10155,18 @@ if test "$ac_x_libraries" = no; then # See if we find them without any special options. # Don't add to $LIBS permanently. ac_save_LIBS=$LIBS - LIBS="-lX11 $LIBS" + LIBS="-lXt $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ -#include <X11/Xlib.h> +#include <X11/Intrinsic.h> int main () { -XrmInitialize () +XtMalloc (0) ; return 0; } @@ -10632,6 +10632,374 @@ rm -f conftest.err conftest.$ac_objext \ fi #-------------------------------------------------------------------- +# Check for freetype / fontconfig / Xft support. +#-------------------------------------------------------------------- + +if test $tk_aqua = no; then + echo "$as_me:$LINENO: checking whether to use xft" >&5 +echo $ECHO_N "checking whether to use xft... $ECHO_C" >&6 + # Check whether --enable-xft or --disable-xft was given. +if test "${enable_xft+set}" = set; then + enableval="$enable_xft" + enable_xft=$enableval +else + enable_xft="default" +fi; + XFT_CFLAGS="" + XFT_LIBS="" + if test "$enable_xft" = "no" ; then + echo "$as_me:$LINENO: result: $enable_xft" >&5 +echo "${ECHO_T}$enable_xft" >&6 + else + found_xft="yes" + XFT_CFLAGS=`xft-config --cflags 2>/dev/null` || found_xft="no" + XFT_LIBS=`xft-config --libs 2>/dev/null` || found_xft="no" + if test "$found_xft" = "no" ; then + found_xft=yes + XFT_CFLAGS=`pkg-config --cflags xft 2>/dev/null` || found_xft="no" + XFT_LIBS=`pkg-config --libs xft 2>/dev/null` || found_xft="no" + fi + echo "$as_me:$LINENO: result: $found_xft" >&5 +echo "${ECHO_T}$found_xft" >&6 + if test "$found_xft" = "yes" ; then + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" + tk_oldLibs=$LIBS + LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW" + echo "$as_me:$LINENO: checking for X11/Xft/Xft.h" >&5 +echo $ECHO_N "checking for X11/Xft/Xft.h... $ECHO_C" >&6 +if test "${ac_cv_header_X11_Xft_Xft_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <X11/Xlib.h> + +#include <X11/Xft/Xft.h> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_header_X11_Xft_Xft_h=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_header_X11_Xft_Xft_h=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_header_X11_Xft_Xft_h" >&5 +echo "${ECHO_T}$ac_cv_header_X11_Xft_Xft_h" >&6 +if test $ac_cv_header_X11_Xft_Xft_h = yes; then + : +else + + found_xft=no + +fi + + + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs + fi + if test "$found_xft" = "yes" ; then + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" + tk_oldLibs=$LIBS + LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW" + +echo "$as_me:$LINENO: checking for XftFontOpen in -lXft" >&5 +echo $ECHO_N "checking for XftFontOpen in -lXft... $ECHO_C" >&6 +if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lXft $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char XftFontOpen (); +int +main () +{ +XftFontOpen (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_Xft_XftFontOpen=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_Xft_XftFontOpen=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_lib_Xft_XftFontOpen" >&5 +echo "${ECHO_T}$ac_cv_lib_Xft_XftFontOpen" >&6 +if test $ac_cv_lib_Xft_XftFontOpen = yes; then + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBXFT 1 +_ACEOF + + LIBS="-lXft $LIBS" + +else + + found_xft=no + +fi + + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs + fi + if test "$found_xft" = "no" ; then + if test "$enable_xft" = "yes" ; then + { echo "$as_me:$LINENO: WARNING: Can't find xft configuration, or xft is unusable" >&5 +echo "$as_me: WARNING: Can't find xft configuration, or xft is unusable" >&2;} + fi + enable_xft=no + XFT_CFLAGS="" + XFT_LIBS="" + else + enable_xft=yes + fi + fi + if test $enable_xft = "yes" ; then + UNIX_FONT_OBJS=tkUnixRFont.o + +cat >>confdefs.h <<\_ACEOF +#define HAVE_XFT 1 +_ACEOF + + else + UNIX_FONT_OBJS=tkUnixFont.o + fi + + + +fi + +#-------------------------------------------------------------------- +# Check for XkbKeycodeToKeysym. +#-------------------------------------------------------------------- + +if test $tk_aqua = no; then + tk_oldCFlags=$CFLAGS + tk_oldLibs=$LIBS + CFLAGS="$CFLAGS $XINCLUDES" + LIBS="$LIBS $XLIBSW" + echo "$as_me:$LINENO: checking for X11/XKBlib.h" >&5 +echo $ECHO_N "checking for X11/XKBlib.h... $ECHO_C" >&6 +if test "${ac_cv_header_X11_XKBlib_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <X11/Xlib.h> + +#include <X11/XKBlib.h> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_header_X11_XKBlib_h=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_header_X11_XKBlib_h=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_header_X11_XKBlib_h" >&5 +echo "${ECHO_T}$ac_cv_header_X11_XKBlib_h" >&6 +if test $ac_cv_header_X11_XKBlib_h = yes; then + + xkblib_header_found=yes + +else + + xkblib_header_found=no + +fi + + + if test $xkblib_header_found = "yes" ; then + echo "$as_me:$LINENO: checking for XkbKeycodeToKeysym in -lX11" >&5 +echo $ECHO_N "checking for XkbKeycodeToKeysym in -lX11... $ECHO_C" >&6 +if test "${ac_cv_lib_X11_XkbKeycodeToKeysym+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lX11 $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char XkbKeycodeToKeysym (); +int +main () +{ +XkbKeycodeToKeysym (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_lib_X11_XkbKeycodeToKeysym=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_lib_X11_XkbKeycodeToKeysym=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_lib_X11_XkbKeycodeToKeysym" >&5 +echo "${ECHO_T}$ac_cv_lib_X11_XkbKeycodeToKeysym" >&6 +if test $ac_cv_lib_X11_XkbKeycodeToKeysym = yes; then + + xkbkeycodetokeysym_found=yes + +else + + xkbkeycodetokeysym_found=no + +fi + + else + xkbkeycodetokeysym_found=no + fi + if test $xkbkeycodetokeysym_found = "yes" ; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_XKBKEYCODETOKEYSYM 1 +_ACEOF + + fi + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs +fi + +#-------------------------------------------------------------------- +# XXX Do this last. +# It might modify XLIBSW which could affect other tests. +# # Check whether the header and library for the XScreenSaver # extension are available, and set HAVE_XSS if so. # XScreenSaver is needed for Tk_GetUserInactiveTime(). @@ -10975,214 +11343,6 @@ _ACEOF fi #-------------------------------------------------------------------- -# Check for freetype / fontconfig / Xft support. -#-------------------------------------------------------------------- - -if test $tk_aqua = no; then - echo "$as_me:$LINENO: checking whether to use xft" >&5 -echo $ECHO_N "checking whether to use xft... $ECHO_C" >&6 - # Check whether --enable-xft or --disable-xft was given. -if test "${enable_xft+set}" = set; then - enableval="$enable_xft" - enable_xft=$enableval -else - enable_xft="default" -fi; - XFT_CFLAGS="" - XFT_LIBS="" - if test "$enable_xft" = "no" ; then - echo "$as_me:$LINENO: result: $enable_xft" >&5 -echo "${ECHO_T}$enable_xft" >&6 - else - found_xft="yes" - XFT_CFLAGS=`xft-config --cflags 2>/dev/null` || found_xft="no" - XFT_LIBS=`xft-config --libs 2>/dev/null` || found_xft="no" - if test "$found_xft" = "no" ; then - found_xft=yes - XFT_CFLAGS=`pkg-config --cflags xft 2>/dev/null` || found_xft="no" - XFT_LIBS=`pkg-config --libs xft 2>/dev/null` || found_xft="no" - fi - echo "$as_me:$LINENO: result: $found_xft" >&5 -echo "${ECHO_T}$found_xft" >&6 - if test "$found_xft" = "yes" ; then - tk_oldCFlags=$CFLAGS - CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" - tk_oldLibs=$LIBS - LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW" - echo "$as_me:$LINENO: checking for X11/Xft/Xft.h" >&5 -echo $ECHO_N "checking for X11/Xft/Xft.h... $ECHO_C" >&6 -if test "${ac_cv_header_X11_Xft_Xft_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <X11/Xlib.h> - -#include <X11/Xft/Xft.h> -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" - || test ! -s conftest.err' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } && - { ac_try='test -s conftest.$ac_objext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - ac_cv_header_X11_Xft_Xft_h=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_header_X11_Xft_Xft_h=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_header_X11_Xft_Xft_h" >&5 -echo "${ECHO_T}$ac_cv_header_X11_Xft_Xft_h" >&6 -if test $ac_cv_header_X11_Xft_Xft_h = yes; then - : -else - - found_xft=no - -fi - - - CFLAGS=$tk_oldCFlags - LIBS=$tk_oldLibs - fi - if test "$found_xft" = "yes" ; then - tk_oldCFlags=$CFLAGS - CFLAGS="$CFLAGS $XINCLUDES $XFT_CFLAGS" - tk_oldLibs=$LIBS - LIBS="$tk_oldLIBS $XFT_LIBS $XLIBSW" - -echo "$as_me:$LINENO: checking for XftFontOpen in -lXft" >&5 -echo $ECHO_N "checking for XftFontOpen in -lXft... $ECHO_C" >&6 -if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lXft $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char XftFontOpen (); -int -main () -{ -XftFontOpen (); - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" - || test ! -s conftest.err' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } && - { ac_try='test -s conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - ac_cv_lib_Xft_XftFontOpen=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_lib_Xft_XftFontOpen=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -echo "$as_me:$LINENO: result: $ac_cv_lib_Xft_XftFontOpen" >&5 -echo "${ECHO_T}$ac_cv_lib_Xft_XftFontOpen" >&6 -if test $ac_cv_lib_Xft_XftFontOpen = yes; then - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBXFT 1 -_ACEOF - - LIBS="-lXft $LIBS" - -else - - found_xft=no - -fi - - CFLAGS=$tk_oldCFlags - LIBS=$tk_oldLibs - fi - if test "$found_xft" = "no" ; then - if test "$enable_xft" = "yes" ; then - { echo "$as_me:$LINENO: WARNING: Can't find xft configuration, or xft is unusable" >&5 -echo "$as_me: WARNING: Can't find xft configuration, or xft is unusable" >&2;} - fi - enable_xft=no - XFT_CFLAGS="" - XFT_LIBS="" - else - enable_xft=yes - fi - fi - if test $enable_xft = "yes" ; then - UNIX_FONT_OBJS=tkUnixRFont.o - -cat >>confdefs.h <<\_ACEOF -#define HAVE_XFT 1 -_ACEOF - - else - UNIX_FONT_OBJS=tkUnixFont.o - fi - - - -fi - -#-------------------------------------------------------------------- # Figure out whether "char" is unsigned. If so, set a # #define for __CHAR_UNSIGNED__. #-------------------------------------------------------------------- diff --git a/unix/configure.in b/unix/configure.in index d052675..6c6e68b 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -39,11 +39,20 @@ SC_LOAD_TCLCONFIG SC_PROG_TCLSH SC_BUILD_TCLSH -if test "${TCL_VERSION}" != "${TK_VERSION}"; then +if test "${TCL_MAJOR_VERSION}" != "${TK_MAJOR_VERSION}"; then AC_MSG_ERROR([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.]) fi +if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then + AC_MSG_ERROR([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.]) +fi +if test "${TCL_MINOR_VERSION}" != "${TK_MINOR_VERSION}"; then + AC_MSG_WARN([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}]) +fi #------------------------------------------------------------------------ # Handle the --prefix=... option @@ -457,56 +466,6 @@ if test -d /usr/include/mit -a $tk_aqua = no; then fi #-------------------------------------------------------------------- -# Check whether the header and library for the XScreenSaver -# extension are available, and set HAVE_XSS if so. -# XScreenSaver is needed for Tk_GetUserInactiveTime(). -#-------------------------------------------------------------------- - -if test $tk_aqua = no; then - tk_oldCFlags=$CFLAGS - CFLAGS="$CFLAGS $XINCLUDES" - tk_oldLibs=$LIBS - LIBS="$tk_oldLibs $XLIBSW" - xss_header_found=no - xss_lib_found=no - AC_MSG_CHECKING([whether to try to use XScreenSaver]) - AC_ARG_ENABLE(xss, - AC_HELP_STRING([--enable-xss], - [use XScreenSaver for activity timer (default: on)]), - [enable_xss=$enableval], [enable_xss=yes]) - if test "$enable_xss" = "no" ; then - AC_MSG_RESULT([$enable_xss]) - else - AC_MSG_RESULT([$enable_xss]) - AC_CHECK_HEADER(X11/extensions/scrnsaver.h, [ - xss_header_found=yes - ],,[#include <X11/Xlib.h>]) - AC_CHECK_FUNC(XScreenSaverQueryInfo,,[ - AC_CHECK_LIB(Xext, XScreenSaverQueryInfo, [ - XLIBSW="$XLIBSW -lXext" - xss_lib_found=yes - ], [ - AC_CHECK_LIB(Xss, XScreenSaverQueryInfo, [ - if test "$tcl_cv_ld_weak_l" = yes; then - # On Darwin, weak link libXss if possible, - # as it is only available on Tiger or later. - XLIBSW="$XLIBSW -Wl,-weak-lXss -lXext" - else - XLIBSW="$XLIBSW -lXss -lXext" - fi - xss_lib_found=yes - ],, -lXext) - ]) - ]) - fi - if test $enable_xss = yes -a $xss_lib_found = yes -a $xss_header_found = yes; then - AC_DEFINE(HAVE_XSS, 1, [Is XScreenSaver available?]) - fi - CFLAGS=$tk_oldCFlags - LIBS=$tk_oldLibs -fi - -#-------------------------------------------------------------------- # Check for freetype / fontconfig / Xft support. #-------------------------------------------------------------------- @@ -580,6 +539,89 @@ if test $tk_aqua = no; then fi #-------------------------------------------------------------------- +# Check for XkbKeycodeToKeysym. +#-------------------------------------------------------------------- + +if test $tk_aqua = no; then + tk_oldCFlags=$CFLAGS + tk_oldLibs=$LIBS + CFLAGS="$CFLAGS $XINCLUDES" + LIBS="$LIBS $XLIBSW" + AC_CHECK_HEADER(X11/XKBlib.h, [ + xkblib_header_found=yes + ], [ + xkblib_header_found=no + ], [#include <X11/Xlib.h>]) + if test $xkblib_header_found = "yes" ; then + AC_CHECK_LIB(X11, XkbKeycodeToKeysym, [ + xkbkeycodetokeysym_found=yes + ], [ + xkbkeycodetokeysym_found=no + ]) + else + xkbkeycodetokeysym_found=no + fi + if test $xkbkeycodetokeysym_found = "yes" ; then + AC_DEFINE(HAVE_XKBKEYCODETOKEYSYM, 1, [Do we have XkbKeycodeToKeysym?]) + fi + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs +fi + +#-------------------------------------------------------------------- +# XXX Do this last. +# It might modify XLIBSW which could affect other tests. +# +# Check whether the header and library for the XScreenSaver +# extension are available, and set HAVE_XSS if so. +# XScreenSaver is needed for Tk_GetUserInactiveTime(). +#-------------------------------------------------------------------- + +if test $tk_aqua = no; then + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS $XINCLUDES" + tk_oldLibs=$LIBS + LIBS="$tk_oldLibs $XLIBSW" + xss_header_found=no + xss_lib_found=no + AC_MSG_CHECKING([whether to try to use XScreenSaver]) + AC_ARG_ENABLE(xss, + AC_HELP_STRING([--enable-xss], + [use XScreenSaver for activity timer (default: on)]), + [enable_xss=$enableval], [enable_xss=yes]) + if test "$enable_xss" = "no" ; then + AC_MSG_RESULT([$enable_xss]) + else + AC_MSG_RESULT([$enable_xss]) + AC_CHECK_HEADER(X11/extensions/scrnsaver.h, [ + xss_header_found=yes + ],,[#include <X11/Xlib.h>]) + AC_CHECK_FUNC(XScreenSaverQueryInfo,,[ + AC_CHECK_LIB(Xext, XScreenSaverQueryInfo, [ + XLIBSW="$XLIBSW -lXext" + xss_lib_found=yes + ], [ + AC_CHECK_LIB(Xss, XScreenSaverQueryInfo, [ + if test "$tcl_cv_ld_weak_l" = yes; then + # On Darwin, weak link libXss if possible, + # as it is only available on Tiger or later. + XLIBSW="$XLIBSW -Wl,-weak-lXss -lXext" + else + XLIBSW="$XLIBSW -lXss -lXext" + fi + xss_lib_found=yes + ],, -lXext) + ]) + ]) + fi + if test $enable_xss = yes -a $xss_lib_found = yes -a $xss_header_found = yes; then + AC_DEFINE(HAVE_XSS, 1, [Is XScreenSaver available?]) + fi + CFLAGS=$tk_oldCFlags + LIBS=$tk_oldLibs +fi + +#-------------------------------------------------------------------- # Figure out whether "char" is unsigned. If so, set a # #define for __CHAR_UNSIGNED__. #-------------------------------------------------------------------- diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 3974753..668fa2f 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1410,7 +1410,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ]) ]) ;; - Linux*) + Linux*|GNU*|NetBSD-Debian) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" @@ -1448,18 +1448,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"]) ;; - GNU*) - SHLIB_CFLAGS="-fPIC" - SHLIB_SUFFIX=".so" - - SHLIB_LD='${CC} -shared' - DL_OBJS="" - DL_LIBS="-ldl" - LDFLAGS="$LDFLAGS -Wl,--export-dynamic" - CC_SEARCH_FLAGS="" - LD_SEARCH_FLAGS="" - AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"]) - ;; Lynx*) SHLIB_CFLAGS="-fPIC" SHLIB_SUFFIX=".so" diff --git a/unix/tkUnixEvent.c b/unix/tkUnixEvent.c index 5e5374a..64a76f6 100644 --- a/unix/tkUnixEvent.c +++ b/unix/tkUnixEvent.c @@ -12,7 +12,14 @@ #include "tkUnixInt.h" #include <signal.h> -#include <X11/XKBlib.h> +#ifdef HAVE_XKBKEYCODETOKEYSYM +# include <X11/XKBlib.h> +/* Work around stupid un-const-ified Xkb headers. Grrrrr.... */ +# define XkbOpenDisplay(D,V,E,M,m,R) \ + (XkbOpenDisplay)((char *)(D),(V),(E),(M),(m),(R)) +#else +# define XkbOpenDisplay(D,V,E,M,m,R) (NULL) +#endif /* * The following static indicates whether this module has been initialized in diff --git a/unix/tkUnixKey.c b/unix/tkUnixKey.c index 27425ff..40cc779 100644 --- a/unix/tkUnixKey.c +++ b/unix/tkUnixKey.c @@ -17,7 +17,11 @@ ** does this and sets the USE_XKB flag if xkb is supported. ** (should this be function ptr?) */ -#include <X11/XKBlib.h> +#ifdef HAVE_XKBKEYCODETOKEYSYM +# include <X11/XKBlib.h> +#else +# define XkbKeycodeToKeysym(D,K,G,L) XKeycodeToKeysym(D,K,L) +#endif #define TkKeycodeToKeysym(D,K,G,L) \ ((D)->flags & TK_DISPLAY_USE_XKB) ? \ XkbKeycodeToKeysym((D)->display,K,G,L) : \ @@ -286,6 +290,15 @@ TkpGetKeySym( int index; TkKeyEvent* kePtr = (TkKeyEvent*) eventPtr; + /* + * Refresh the mapping information if it's stale. This must happen before + * we do any input method processing. [Bug 3599312] + */ + + if (dispPtr->bindInfoStale) { + TkpInitKeymapInfo(dispPtr); + } + #ifdef TK_USE_INPUT_METHODS /* * If input methods are active, we may already have determined a keysym. @@ -298,6 +311,7 @@ TkpGetKeySym( Tcl_DString ds; TkWindow *winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, eventPtr->xany.window); + Tcl_DStringInit(&ds); (void) TkpGetString(winPtr, eventPtr, &ds); Tcl_DStringFree(&ds); @@ -309,14 +323,6 @@ TkpGetKeySym( #endif /* - * Refresh the mapping information if it's stale - */ - - if (dispPtr->bindInfoStale) { - TkpInitKeymapInfo(dispPtr); - } - - /* * Figure out which of the four slots in the keymap vector to use for this * key. Refer to Xlib documentation for more info on how this computation * works. diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c index fb4cdd4..3fb745e 100644 --- a/unix/tkUnixSend.c +++ b/unix/tkUnixSend.c @@ -1022,7 +1022,7 @@ Tk_SendCmd( localInterp = riPtr->interp; Tcl_Preserve((ClientData) localInterp); if (firstArg == (argc-1)) { - result = Tcl_GlobalEval(localInterp, argv[firstArg]); + result = Tcl_EvalEx(localInterp, argv[firstArg], -1, TCL_EVAL_GLOBAL); } else { Tcl_DStringInit(&request); Tcl_DStringAppend(&request, argv[firstArg], -1); @@ -1030,7 +1030,7 @@ Tk_SendCmd( Tcl_DStringAppend(&request, " ", 1); Tcl_DStringAppend(&request, argv[i], -1); } - result = Tcl_GlobalEval(localInterp, Tcl_DStringValue(&request)); + result = Tcl_EvalEx(localInterp, Tcl_DStringValue(&request), -1, TCL_EVAL_GLOBAL); Tcl_DStringFree(&request); } if (interp != localInterp) { @@ -1556,7 +1556,7 @@ SendEventProc( remoteInterp = riPtr->interp; Tcl_Preserve((ClientData) remoteInterp); - result = Tcl_GlobalEval(remoteInterp, script); + result = Tcl_EvalEx(remoteInterp, script, -1, TCL_EVAL_GLOBAL); /* * The call to Tcl_Release may have released the interpreter which diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 940cf73..d230b9f 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -6206,7 +6206,7 @@ TkWmProtocolEventProc( Tcl_Preserve((ClientData) protPtr); interp = protPtr->interp; Tcl_Preserve((ClientData) interp); - result = Tcl_GlobalEval(interp, protPtr->command); + result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command for \""); Tcl_AddErrorInfo(interp, protocolName); diff --git a/win/Makefile.in b/win/Makefile.in index eda2aed..2952e03 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -4,8 +4,6 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. -TCLVERSION = @TCL_VERSION@ -TCLPATCHL = @TCL_PATCH_LEVEL@ VERSION = @TK_VERSION@ PATCH_LEVEL = @TK_PATCH_LEVEL@ @@ -165,7 +163,7 @@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ # Tk does not used deprecated Tcl constructs so it should # compile fine with -DTCL_NO_DEPRECATED. To remove its own # set of deprecated code uncomment the second line. -NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED +NO_DEPRECATED_FLAGS = #NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED # To change the compiler switches, for example to change from optimization to @@ -352,7 +350,6 @@ TK_OBJS = \ tkUtil.$(OBJEXT) \ tkVisual.$(OBJEXT) \ tkStubInit.$(OBJEXT) \ - tkStubLib.$(OBJEXT) \ tkWindow.$(OBJEXT) \ $(TTK_OBJS) @@ -484,12 +481,12 @@ install-binaries: binaries @echo "Creating package index $(PKG_INDEX)"; @$(RM) $(PKG_INDEX); @(\ - echo "if {[catch {package present Tcl $(TCLVERSION).0}]} return";\ + echo "if {[catch {package present Tcl 8.5.0}]} return";\ echo "if {(\$$::tcl_platform(platform) eq \"unix\") && ([info exists ::env(DISPLAY)]";\ echo " || ([info exists ::argv] && (\"-display\" in \$$::argv)))} {";\ - echo " package ifneeded Tk $(VERSION)$(PATCH_LEVEL) [list load [file join \$$dir .. .. bin libtk$(VERSION).dll] Tk]";\ + echo " package ifneeded Tk $(VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir .. .. bin libtk$(VERSION).dll]] Tk]";\ echo "} else {";\ - echo " package ifneeded Tk $(VERSION)$(PATCH_LEVEL) [list load [file join \$$dir .. .. bin $(TK_DLL_FILE)] Tk]";\ + echo " package ifneeded Tk $(VERSION)$(PATCH_LEVEL) [list load [file normalize [file join \$$dir .. .. bin $(TK_DLL_FILE)]] Tk]";\ echo "}";\ ) > $(PKG_INDEX); @for i in tkConfig.sh $(TK_LIB_FILE) $(TK_STUB_LIB_FILE); \ diff --git a/win/configure b/win/configure index 5cc7819..33030b9 100755 --- a/win/configure +++ b/win/configure @@ -851,7 +851,8 @@ Optional Features: Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --with-tcl=DIR use Tcl 8.5 binaries from DIR + --with-tcl directory containing tcl configuration + (tclConfig.sh) --with-celib=DIR use Windows/CE support library from DIR Some influential environment variables: @@ -3103,7 +3104,8 @@ echo "${ECHO_T}shared" >&6 echo "$as_me:$LINENO: result: static" >&5 echo "${ECHO_T}static" >&6 SHARED_BUILD=0 - cat >>confdefs.h <<\_ACEOF + +cat >>confdefs.h <<\_ACEOF #define STATIC_BUILD 1 _ACEOF @@ -3115,52 +3117,129 @@ _ACEOF #-------------------------------------------------------------------- - echo "$as_me:$LINENO: checking the location of tclConfig.sh" >&5 -echo $ECHO_N "checking the location of tclConfig.sh... $ECHO_C" >&6 - - if test -d ../../tcl8.5$TK_PATCH_LEVEL/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.5$TK_PATCH_LEVEL/win - elif test -d ../../tcl8.5/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.5/win - else - TCL_BIN_DIR_DEFAULT=../../tcl/win - fi + # + # Ok, lets find the tcl configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tcl + # + if test x"${no_tcl}" = x ; then + # we reset no_tcl in case something fails here + no_tcl=true # Check whether --with-tcl or --without-tcl was given. if test "${with_tcl+set}" = set; then withval="$with_tcl" - TCL_BIN_DIR=$withval -else - TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd` + with_tclconfig="${withval}" fi; - if test ! -d $TCL_BIN_DIR; then - { { echo "$as_me:$LINENO: error: Tcl directory $TCL_BIN_DIR does not exist" >&5 -echo "$as_me: error: Tcl directory $TCL_BIN_DIR does not exist" >&2;} + echo "$as_me:$LINENO: checking for Tcl configuration" >&5 +echo $ECHO_N "checking for Tcl configuration... $ECHO_C" >&6 + if test "${ac_cv_c_tclconfig+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + + # First check to see if --with-tcl was specified. + if test x"${with_tclconfig}" != x ; then + case "${with_tclconfig}" in + */tclConfig.sh ) + if test -f "${with_tclconfig}"; then + { echo "$as_me:$LINENO: WARNING: --with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself" >&5 +echo "$as_me: WARNING: --with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself" >&2;} + with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tclconfig}/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" + else + { { echo "$as_me:$LINENO: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" >&5 +echo "$as_me: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" >&2;} { (exit 1); exit 1; }; } - fi - if test ! -f $TCL_BIN_DIR/tclConfig.sh; then - if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then - { { echo "$as_me:$LINENO: error: There is no tclConfig.sh in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&5 -echo "$as_me: error: There is no tclConfig.sh in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&2;} + fi + fi + + # then check for a private Tcl installation + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ../tcl[8-9].[0-9]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ../../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ../../tcl[8-9].[0-9]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ../../../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ../../../tcl[8-9].[0-9]* 2>/dev/null` ; do + if test -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d /c/Tcl/lib 2>/dev/null` \ + `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[8-9].[0-9]* 2>/dev/null` ; do + if test -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + +fi + + + if test x"${ac_cv_c_tclconfig}" = x ; then + TCL_BIN_DIR="# no Tcl configs found" + { { echo "$as_me:$LINENO: error: Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh" >&5 +echo "$as_me: error: Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh" >&2;} { (exit 1); exit 1; }; } + else + no_tcl= + TCL_BIN_DIR="${ac_cv_c_tclconfig}" + echo "$as_me:$LINENO: result: found ${TCL_BIN_DIR}/tclConfig.sh" >&5 +echo "${ECHO_T}found ${TCL_BIN_DIR}/tclConfig.sh" >&6 fi - TCL_BIN_DIR=`cd ${TCL_BIN_DIR}/../unix; pwd` fi - echo "$as_me:$LINENO: result: $TCL_BIN_DIR/tclConfig.sh" >&5 -echo "${ECHO_T}$TCL_BIN_DIR/tclConfig.sh" >&6 - echo "$as_me:$LINENO: checking for existence of $TCL_BIN_DIR/tclConfig.sh" >&5 -echo $ECHO_N "checking for existence of $TCL_BIN_DIR/tclConfig.sh... $ECHO_C" >&6 + echo "$as_me:$LINENO: checking for existence of ${TCL_BIN_DIR}/tclConfig.sh" >&5 +echo $ECHO_N "checking for existence of ${TCL_BIN_DIR}/tclConfig.sh... $ECHO_C" >&6 - if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then + if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then echo "$as_me:$LINENO: result: loading" >&5 echo "${ECHO_T}loading" >&6 - . $TCL_BIN_DIR/tclConfig.sh + . "${TCL_BIN_DIR}/tclConfig.sh" else - echo "$as_me:$LINENO: result: file not found" >&5 -echo "${ECHO_T}file not found" >&6 + echo "$as_me:$LINENO: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5 +echo "${ECHO_T}could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6 fi # @@ -3205,6 +3284,31 @@ echo "${ECHO_T}file not found" >&6 +if test "${TCL_MAJOR_VERSION}" != "${TK_MAJOR_VERSION}"; then + { { echo "$as_me:$LINENO: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&5 +echo "$as_me: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;} + { (exit 1); exit 1; }; } +fi +if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then + { { echo "$as_me:$LINENO: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&5 +echo "$as_me: error: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}." >&2;} + { (exit 1); exit 1; }; } +fi +if test "${TCL_MINOR_VERSION}" != "${TK_MINOR_VERSION}"; then + { echo "$as_me:$LINENO: WARNING: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}" >&5 +echo "$as_me: WARNING: ${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}" >&2;} +fi + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called diff --git a/win/configure.in b/win/configure.in index ef517e6..c5f09cc 100644 --- a/win/configure.in +++ b/win/configure.in @@ -81,6 +81,21 @@ SC_ENABLE_SHARED SC_PATH_TCLCONFIG($TK_PATCH_LEVEL) SC_LOAD_TCLCONFIG +if test "${TCL_MAJOR_VERSION}" != "${TK_MAJOR_VERSION}"; then + AC_MSG_ERROR([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.]) +fi +if test "${TCL_MINOR_VERSION}" -lt "${TK_MINOR_VERSION}"; then + AC_MSG_ERROR([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Tk ${TK_VERSION}${TK_PATCH_LEVEL} needs Tcl ${TK_VERSION}. +Use --with-tcl= option to indicate location of tclConfig.sh file for Tcl ${TK_VERSION}.]) +fi +if test "${TCL_MINOR_VERSION}" != "${TK_MINOR_VERSION}"; then + AC_MSG_WARN([${TCL_BIN_DIR}/tclConfig.sh is for Tcl ${TCL_VERSION}. +Building Tk ${TK_VERSION} this way results in a binary which is no longer loadable in Tcl ${TK_VERSION}]) +fi + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called diff --git a/win/makefile.bc b/win/makefile.bc index 12fd5b8..295ed23 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -225,7 +225,6 @@ TKOBJS = \ $(TMPDIR)\tkUtil.obj \ $(TMPDIR)\tkVisual.obj \ $(TMPDIR)\tkStubInit.obj \ - $(TMPDIR)\tkStubLib.obj \ $(TMPDIR)\tkWindow.obj # Maintenance hint: Please have multiple members of TKSTUBOBJS be separated diff --git a/win/makefile.vc b/win/makefile.vc index 68df470..a7b0c0a 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -360,7 +360,6 @@ TKOBJS = \ $(TMP_DIR)\tkUtil.obj \ $(TMP_DIR)\tkVisual.obj \ $(TMP_DIR)\tkStubInit.obj \ - $(TMP_DIR)\tkStubLib.obj \ $(TMP_DIR)\tkWindow.obj \ $(TTK_OBJS) \ !if !$(STATIC_BUILD) @@ -3,50 +3,124 @@ # # Locate the tclConfig.sh file and perform a sanity check on # the Tcl compile flags -# Currently a no-op for Windows # # Arguments: -# PATCH_LEVEL The patch level for Tcl if any. +# none # # Results: # # Adds the following arguments to configure: # --with-tcl=... # -# Sets the following vars: -# TCL_BIN_DIR Full path to the tclConfig.sh file +# Defines the following vars: +# TCL_BIN_DIR Full path to the directory containing +# the tclConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TCLCONFIG], [ - AC_MSG_CHECKING([the location of tclConfig.sh]) + # + # Ok, lets find the tcl configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tcl + # - if test -d ../../tcl8.5$1/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.5$1/win - elif test -d ../../tcl8.5/win; then - TCL_BIN_DIR_DEFAULT=../../tcl8.5/win - else - TCL_BIN_DIR_DEFAULT=../../tcl/win - fi + if test x"${no_tcl}" = x ; then + # we reset no_tcl in case something fails here + no_tcl=true + AC_ARG_WITH(tcl, + AC_HELP_STRING([--with-tcl], + [directory containing tcl configuration (tclConfig.sh)]), + with_tclconfig="${withval}") + AC_MSG_CHECKING([for Tcl configuration]) + AC_CACHE_VAL(ac_cv_c_tclconfig,[ + + # First check to see if --with-tcl was specified. + if test x"${with_tclconfig}" != x ; then + case "${with_tclconfig}" in + */tclConfig.sh ) + if test -f "${with_tclconfig}"; then + AC_MSG_WARN([--with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself]) + with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tclconfig}/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh]) + fi + fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR], - TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`) - if test ! -d $TCL_BIN_DIR; then - AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) - fi - if test ! -f $TCL_BIN_DIR/tclConfig.sh; then - if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then - AC_MSG_ERROR(There is no tclConfig.sh in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?) + # then check for a private Tcl installation + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d /c/Tcl/lib 2>/dev/null` \ + `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tclconfig}" = x ; then + TCL_BIN_DIR="# no Tcl configs found" + AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh]) + else + no_tcl= + TCL_BIN_DIR="${ac_cv_c_tclconfig}" + AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) fi - TCL_BIN_DIR=`cd ${TCL_BIN_DIR}/../unix; pwd` fi - AC_MSG_RESULT($TCL_BIN_DIR/tclConfig.sh) ]) #------------------------------------------------------------------------ # SC_PATH_TKCONFIG -- # # Locate the tkConfig.sh file -# Currently a no-op for Windows # # Arguments: # none @@ -56,31 +130,109 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ # Adds the following arguments to configure: # --with-tk=... # -# Sets the following vars: -# TK_BIN_DIR Full path to the tkConfig.sh file +# Defines the following vars: +# TK_BIN_DIR Full path to the directory containing +# the tkConfig.sh file #------------------------------------------------------------------------ AC_DEFUN([SC_PATH_TKCONFIG], [ - AC_MSG_CHECKING([the location of tkConfig.sh]) + # + # Ok, lets find the tk configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tk + # - if test -d ../../tk8.5$1/win; then - TK_BIN_DIR_DEFAULT=../../tk8.5$1/win - elif test -d ../../tk8.5/win; then - TK_BIN_DIR_DEFAULT=../../tk8.5/win - else - TK_BIN_DIR_DEFAULT=../../tk/win - fi + if test x"${no_tk}" = x ; then + # we reset no_tk in case something fails here + no_tk=true + AC_ARG_WITH(tk, + AC_HELP_STRING([--with-tk], + [directory containing tk configuration (tkConfig.sh)]), + with_tkconfig="${withval}") + AC_MSG_CHECKING([for Tk configuration]) + AC_CACHE_VAL(ac_cv_c_tkconfig,[ + + # First check to see if --with-tkconfig was specified. + if test x"${with_tkconfig}" != x ; then + case "${with_tkconfig}" in + */tkConfig.sh ) + if test -f "${with_tkconfig}"; then + AC_MSG_WARN([--with-tk argument should refer to directory containing tkConfig.sh, not to tkConfig.sh itself]) + with_tkconfig="`echo "${with_tkconfig}" | sed 's!/tkConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tkconfig}/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd "${with_tkconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh]) + fi + fi - AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.5 binaries from DIR], - TK_BIN_DIR=$withval, TK_BIN_DIR=`cd $TK_BIN_DIR_DEFAULT; pwd`) - if test ! -d $TK_BIN_DIR; then - AC_MSG_ERROR(Tk directory $TK_BIN_DIR does not exist) - fi - if test ! -f $TK_BIN_DIR/tkConfig.sh; then - AC_MSG_ERROR(There is no tkConfig.sh in $TK_BIN_DIR: perhaps you did not specify the Tk *build* directory (not the toplevel Tk directory) or you forgot to configure Tk?) - fi + # then check for a private Tk library + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ../tk \ + `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tk \ + `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tk \ + `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + done + fi - AC_MSG_RESULT([$TK_BIN_DIR/tkConfig.sh]) + # check in a few common install locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Tcl/lib 2>/dev/null` \ + `ls -d /cygdrive/c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d /c/Tcl/lib 2>/dev/null` \ + `ls -d /c/Progra~1/Tcl/lib 2>/dev/null` \ + `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tkconfig}" = x ; then + TK_BIN_DIR="# no Tk configs found" + AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh]) + else + no_tk= + TK_BIN_DIR="${ac_cv_c_tkconfig}" + AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) + fi + fi ]) #------------------------------------------------------------------------ @@ -103,13 +255,13 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ - AC_MSG_CHECKING([for existence of $TCL_BIN_DIR/tclConfig.sh]) + AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) - if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then + if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then AC_MSG_RESULT([loading]) - . $TCL_BIN_DIR/tclConfig.sh + . "${TCL_BIN_DIR}/tclConfig.sh" else - AC_MSG_RESULT([file not found]) + AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # @@ -158,7 +310,6 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ # SC_LOAD_TKCONFIG -- # # Load the tkConfig.sh file -# Currently a no-op for Windows # # Arguments: # @@ -172,13 +323,13 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TKCONFIG], [ - AC_MSG_CHECKING([for existence of $TK_BIN_DIR/tkConfig.sh]) + AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) - if test -f "$TK_BIN_DIR/tkConfig.sh" ; then + if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then AC_MSG_RESULT([loading]) - . $TK_BIN_DIR/tkConfig.sh + . "${TK_BIN_DIR}/tkConfig.sh" else - AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh]) + AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi @@ -212,7 +363,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ AC_MSG_CHECKING([how to build libraries]) AC_ARG_ENABLE(shared, [ --enable-shared build and link with shared libraries (default: on)], - [tcl_ok=$enableval], [tcl_ok=yes]) + [tcl_ok=$enableval], [tcl_ok=yes]) if test "${enable_shared+set}" = set; then enableval="$enable_shared" @@ -227,7 +378,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ else AC_MSG_RESULT([static]) SHARED_BUILD=0 - AC_DEFINE(STATIC_BUILD) + AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi ]) @@ -270,7 +421,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [ #------------------------------------------------------------------------ # SC_ENABLE_SYMBOLS -- # -# Specify if debugging symbols should be used +# Specify if debugging symbols should be used. # Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging # can also be enabled. # diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c index 2ec6883..46aad58 100644 --- a/win/tkWinScrlbr.c +++ b/win/tkWinScrlbr.c @@ -553,7 +553,7 @@ ScrollbarProc( } interp = scrollPtr->info.interp; - code = Tcl_GlobalEval(interp, cmdString.string); + code = Tcl_EvalEx(interp, cmdString.string, -1, TCL_EVAL_GLOBAL); if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) { Tcl_AddErrorInfo(interp, "\n (scrollbar command)"); Tcl_BackgroundError(interp); diff --git a/win/tkWinTest.c b/win/tkWinTest.c index d361ad7..2498864 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -22,21 +22,20 @@ HWND tkWinCurrentDialog; static int TestclipboardObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int TestwineventCmd(ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestfindwindowObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int TestgetwindowinfoObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int TestwinlocaleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); - /* *---------------------------------------------------------------------- * @@ -99,11 +98,14 @@ AppendSystemError( { int length; WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr; - char *msg; + const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); + if (Tcl_IsShared(resultPtr)) { + resultPtr = Tcl_DuplicateObj(resultPtr); + } length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr, @@ -124,36 +126,41 @@ AppendSystemError( } if (length == 0) { if (error == ERROR_CALL_NOT_IMPLEMENTED) { - msg = "function not supported under Win32s"; + strcpy(msgBuf, "function not supported under Win32s"); } else { sprintf(msgBuf, "unknown error: %ld", error); - msg = msgBuf; } + msg = msgBuf; } else { Tcl_Encoding encoding; + char *msgPtr; encoding = Tcl_GetEncoding(NULL, "unicode"); - msg = Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); + Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); Tcl_FreeEncoding(encoding); LocalFree(wMsgPtr); + msgPtr = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); /* * Trim the trailing CR/LF from the system message. */ - if (msg[length-1] == '\n') { - msg[--length] = 0; + if (msgPtr[length-1] == '\n') { + --length; } - if (msg[length-1] == '\r') { - msg[--length] = 0; + if (msgPtr[length-1] == '\r') { + --length; } + msgPtr[length] = 0; + msg = msgPtr; } sprintf(id, "%ld", error); Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL); Tcl_AppendToObj(resultPtr, msg, length); + Tcl_SetObjResult(interp, resultPtr); if (length != 0) { Tcl_DStringFree(&ds); @@ -182,7 +189,7 @@ TestclipboardObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { HGLOBAL handle; char *data; @@ -194,11 +201,11 @@ TestclipboardObjCmd( } if (OpenClipboard(NULL)) { /* - * We could consider using CF_UNICODETEXT on NT, but then we would - * have to convert it from External. Instead we'll just take this and - * do "bytestring" at the Tcl level for Unicode inclusive text + * We could consider using CF_UNICODETEXT on NT, but then we + * would have to convert it from External. Instead we'll just + * take this and do "bytestring" at the Tcl level for Unicode + * inclusive text */ - handle = GetClipboardData(CF_TEXT); if (handle != NULL) { data = GlobalLock(handle); @@ -240,7 +247,7 @@ TestwineventCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + const char **argv) /* Argument strings. */ { HWND hwnd = 0; HWND child = 0; @@ -273,7 +280,7 @@ TestwineventCmd( return TCL_ERROR; } - hwnd = (HWND) INT2PTR(strtol(argv[1], &rest, 0)); + hwnd = INT2PTR(strtol(argv[1], &rest, 0)); if (rest == argv[1]) { hwnd = FindWindow(NULL, argv[1]); if (hwnd == NULL) { @@ -326,10 +333,16 @@ TestwineventCmd( } case WM_SETTEXT: { Tcl_DString ds; + BOOL result; Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); - SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); + result = SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); + if (result == 0) { + Tcl_SetResult(interp, "failed to send text to dialog: ", TCL_STATIC); + AppendSystemError(interp, GetLastError()); + return TCL_ERROR; + } break; } case WM_COMMAND: { @@ -357,7 +370,7 @@ TestwineventCmd( /* * testfindwindow title ?class? * Find a Windows window using the FindWindow API call. This takes the window - * title and optionally the window class and if found returns the HWND and + * title and optionally the window class and if found returns the HWND and * raises an error if the window is not found. * eg: testfindwindow Console TkTopLevel * Can find the console window if it is visible. @@ -370,7 +383,7 @@ TestfindwindowObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { const char *title = NULL, *class = NULL; HWND hwnd = NULL; @@ -393,13 +406,15 @@ TestfindwindowObjCmd( Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd))); } return r; - } static BOOL CALLBACK -EnumChildrenProc(HWND hwnd, LPARAM lParam) +EnumChildrenProc( + HWND hwnd, + LPARAM lParam) { - Tcl_Obj *listObj = (Tcl_Obj *)lParam; + Tcl_Obj *listObj = (Tcl_Obj *) lParam; + Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewLongObj(PTR2INT(hwnd))); return TRUE; } @@ -409,7 +424,7 @@ TestgetwindowinfoObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]) + Tcl_Obj *const objv[]) { long hwnd; Tcl_Obj *resObj = NULL, *classObj = NULL, *textObj = NULL; @@ -424,7 +439,7 @@ TestgetwindowinfoObjCmd( if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK) return TCL_ERROR; - + if (tkWinProcs->useWide) { cch = GetClassNameW(INT2PTR(hwnd), (LPWSTR)buf, sizeof(buf)/sizeof(WCHAR)); classObj = Tcl_NewUnicodeObj((LPWSTR)buf, cch); @@ -436,14 +451,14 @@ TestgetwindowinfoObjCmd( Tcl_SetResult(interp, "failed to get class name: ", TCL_STATIC); AppendSystemError(interp, GetLastError()); return TCL_ERROR; - } + } resObj = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("class", -1)); Tcl_ListObjAppendElement(interp, resObj, classObj); Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("id", -1)); - Tcl_ListObjAppendElement(interp, resObj, + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewLongObj(GetWindowLong(INT2PTR(hwnd), GWL_ID))); cch = tkWinProcs->getWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf); @@ -456,7 +471,7 @@ TestgetwindowinfoObjCmd( Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("text", -1)); Tcl_ListObjAppendElement(interp, resObj, textObj); Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("parent", -1)); - Tcl_ListObjAppendElement(interp, resObj, + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewLongObj(PTR2INT(GetParent(INT2PTR(hwnd))))); childrenObj = Tcl_NewListObj(0, NULL); @@ -466,7 +481,7 @@ TestgetwindowinfoObjCmd( Tcl_SetObjResult(interp, resObj); return TCL_OK; -} +} static int TestwinlocaleObjCmd( diff --git a/win/tkWinWm.c b/win/tkWinWm.c index e3816ca..9ea4957 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -5309,11 +5309,6 @@ WmStateCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { - return TCL_ERROR; - } - if (winPtr->flags & TK_EMBEDDED) { int state = 0; @@ -6590,7 +6585,7 @@ TkWmProtocolEventProc( Tcl_Preserve((ClientData) protPtr); interp = protPtr->interp; Tcl_Preserve((ClientData) interp); - result = Tcl_GlobalEval(interp, protPtr->command); + result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command for \""); Tcl_AddErrorInfo(interp, name); diff --git a/xlib/xcolors.c b/xlib/xcolors.c index 70ab3cb..66591c7 100644 --- a/xlib/xcolors.c +++ b/xlib/xcolors.c @@ -14,11 +14,14 @@ #include "tkInt.h" /* - * Index array. For each of the characters 'a'-'y', this table gives the first color - * starting with that character in the xColors table. + * Index array. For each of the characters 'a'-'y', this table gives the first + * color starting with that character in the xColors table. */ -static const unsigned char az[] = {0, 5, 13, 21, 45, 46, 50, 60, 62, 65, 66, - 67, 91, 106, 109, 115, 126, 127, 130, 144, 149, 150, 152, 155, 156, 158}; + +static const unsigned char az[] = { + 0, 5, 13, 21, 45, 46, 50, 60, 62, 65, 66, + 67, 91, 106, 109, 115, 126, 127, 130, 144, 149, 150, 152, 155, 156, 158 +}; /* * Define an array that defines the mapping from color names to RGB values. @@ -241,15 +244,17 @@ static const elem xColors[] = { * None. * *---------------------------------------------------------------------- + * + * This only handles hex-strings without 0x prefix. Luckily, that's just what + * we need. */ -#if defined(__WIN32__) && !defined(__CYGWIN__) -# ifdef NO_STRTOI64 -/* This version only handles hex-strings without 0x prefix */ -static __int64 -_strtoi64(const char *spec, char **p, int base) +static Tcl_WideInt +parseHex64bit( + const char *spec, + char **p) { - __int64 result = 0; + Tcl_WideInt result = 0; char c; while ((c = *spec)) { if ((c >= '0') && (c <= '9')) { @@ -267,16 +272,18 @@ _strtoi64(const char *spec, char **p, int base) *p = (char *) spec; return result; } -# endif -#else -# define _strtoi64 strtoll -#endif -static int colorcmp(const char *spec, const char *pname, int *special) { +static int +colorcmp( + const char *spec, + const char *pname, + int *special) +{ int r; int c, d; int notequal = 0; int num = 0; + do { d = *pname++; c = (*spec == ' '); @@ -286,9 +293,12 @@ static int colorcmp(const char *spec, const char *pname, int *special) { if ((unsigned)(d - 'A') <= (unsigned)('Z' - 'A')) { d += 'a' - 'A'; } else if (c) { - /* A space doesn't match a lowercase, but we don't know - * yet whether we should return a negative or positive - * number. That depends on what follows. */ + /* + * A space doesn't match a lowercase, but we don't know yet + * whether we should return a negative or positive number. That + * depends on what follows. + */ + notequal = 1; } c = *spec++; @@ -305,19 +315,24 @@ static int colorcmp(const char *spec, const char *pname, int *special) { } } r = c - d; - } while(!r && d); + } while (!r && d); + if (!r && notequal) { - /* Strings are equal, but difference in spacings only. We should still - * report not-equal, so "burly wood" is not a valid color */ + /* + * Strings are equal, but difference in spacings only. We should still + * report not-equal, so "burly wood" is not a valid color. + */ + r = 1; } *special = num; return r; } -#define RED(p) ((unsigned char)(p)[0]) -#define GREEN(p) ((unsigned char)(p)[1]) -#define BLUE(p) ((unsigned char)(p)[2]) +#define RED(p) ((unsigned char) (p)[0]) +#define GREEN(p) ((unsigned char) (p)[1]) +#define BLUE(p) ((unsigned char) (p)[2]) +#define US(expr) ((unsigned short) (expr)) Status XParseColor( @@ -328,42 +343,44 @@ XParseColor( { if (spec[0] == '#') { char *p; - Tcl_WideInt value = _strtoi64(++spec, &p, 16); + Tcl_WideInt value = parseHex64bit(++spec, &p); switch ((int)(p-spec)) { case 3: - colorPtr->red = (unsigned short) (((value >> 8) & 0xf) * 0x1111); - colorPtr->green = (unsigned short) (((value >> 4) & 0xf) * 0x1111); - colorPtr->blue = (unsigned short) ((value & 0xf) * 0x1111); + colorPtr->red = US(((value >> 8) & 0xf) * 0x1111); + colorPtr->green = US(((value >> 4) & 0xf) * 0x1111); + colorPtr->blue = US((value & 0xf) * 0x1111); break; case 6: - colorPtr->red = (unsigned short) (((value >> 16) & 0xff) | ((value >> 8) & 0xff00)); - colorPtr->green = (unsigned short) (((value >> 8) & 0xff) | (value & 0xff00)); - colorPtr->blue = (unsigned short) ((value & 0xff) | (value << 8)); + colorPtr->red = US(((value >> 16) & 0xff) | ((value >> 8) & 0xff00)); + colorPtr->green = US(((value >> 8) & 0xff) | (value & 0xff00)); + colorPtr->blue = US((value & 0xff) | (value << 8)); break; case 9: - colorPtr->red = (unsigned short) (((value >> 32) & 0xf) | ((value >> 20) & 0xfff0)); - colorPtr->green = (unsigned short) (((value >> 20) & 0xf) | ((value >> 8) & 0xfff0)); - colorPtr->blue = (unsigned short) (((value >> 8) & 0xf) | (value << 4)); + colorPtr->red = US(((value >> 32) & 0xf) | ((value >> 20) & 0xfff0)); + colorPtr->green = US(((value >> 20) & 0xf) | ((value >> 8) & 0xfff0)); + colorPtr->blue = US(((value >> 8) & 0xf) | (value << 4)); break; case 12: - colorPtr->red = (unsigned short) (value >> 32); - colorPtr->green = (unsigned short) (value >> 16); - colorPtr->blue = (unsigned short) value; + colorPtr->red = US(value >> 32); + colorPtr->green = US(value >> 16); + colorPtr->blue = US(value); break; default: return 0; } } else { - int size, num; - const elem *p; - const char *q; /* * Perform a binary search on the sorted array of colors. * size = current size of search range * p = pointer to current element being considered. */ + + int size, num; + const elem *p; + const char *q; int r = (spec[0] - 'A') & 0xdf; + if (r >= (int) sizeof(az) - 1) { return 0; } @@ -386,11 +403,15 @@ XParseColor( r = colorcmp(spec + 1, *p, &num); } if (num > (*p)[31]) { - if (((*p)[31] != 8) || num > 100) + if (((*p)[31] != 8) || num > 100) { return 0; + } num = (num * 255 + 50) / 100; if ((num == 230) || (num == 128)) { - /* Those two entries have a deviation i.r.t the table */ + /* + * Those two entries have a deviation i.r.t the table. + */ + num--; } num |= (num << 8); @@ -408,49 +429,6 @@ XParseColor( return 1; } - -#if 0 -int main() { - XColor color; - char buf[32]; - int charindex; - int i, result; - int repeat = 1; - int num, maxnum; - char *end; - - while (repeat--) { - buf[0] = 'a'; - charindex = 1; - for (i = 0; i < sizeof(xColors)/sizeof(xColors[0]); ++i) { - while (i >= az[charindex]) { - ++charindex; - ++(buf[0]); - } - strcpy(buf + 1, xColors[i]); - end = buf + strlen(buf); - num = 0; - result = XParseColor(0, 0, buf, &color); - printf("%3d %3d %3d\t\t%s\n", color.red >> 8, color.green >> 8, color.blue >> 8, buf); - maxnum = xColors[i][31]; - if (maxnum == 8) maxnum = 100; - while (result && ++num <= maxnum) { - sprintf(end, "%d", num); - result = XParseColor(0, 0, buf, &color); - printf("%3d %3d %3d\t\t%s\n", color.red >> 8, color.green >> 8, color.blue >> 8, buf); - } - if (!result) { - break; - } - } - } - if (!result) { - printf("NOT OK: %s\n", buf); - } else { - printf("OK\n"); - } -} -#endif /* * Local Variables: * mode: c |