diff options
605 files changed, 107556 insertions, 63789 deletions
@@ -1,6 +1,6 @@ <?xml version="1.0" encoding="UTF-8"?> <projectDescription> - <name>tk8.5</name> + <name>tk8.6</name> <comment></comment> <projects> </projects> @@ -2,19 +2,21 @@ A NOTE ON THE CHANGELOG: Starting in early 2011, Tk source code has been under the management of fossil, hosted at http://core.tcl.tk/tk/ . Fossil presents a "Timeline" view of changes made that is superior in every way to a hand edited log file. -Because of this, many Tcl developers are now out of the habit of maintaining +Because of this, many Tk developers are now out of the habit of maintaining this log file. You may still find useful things in it, but the Timeline is a better first place to look now. ============================================================================ 2013-08-30 Don Porter <dgp@users.sourceforge.net> - * generic/tk.h: Bump to 8.5.15 for release. + *** 8.6.1 TAGGED FOR RELEASE *** + + * README: Bump version number to 8.6.1 + * generic/tk.h: * library/tk.tcl: * unix/configure.in: * unix/tk.spec: * win/configure.in: - * README: * unix/configure: autoconf-2.59 * win/configure: @@ -33,6 +35,11 @@ a better first place to look now. the widget is in a consistent state when any write traces on the linked -variable are fired. +2013-08-14 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkConfig.c: Bug [069c9e43c4]: FreeOptionInternalRep() breaks + * tests/config.test: Tk_CreateOptionTable() + 2013-07-02 Jan Nijtmans <nijtmans@users.sf.net> * unix/tcl.m4: Bug [32afa6e256]: dirent64 check is incorrect in tcl.m4 @@ -43,15 +50,6 @@ a better first place to look now. * library/ttk/scale.tcl: [Bug 2501278]: ttk::scale keyboard binding problem. -2012-06-07 Jan Nijtmans <nijtmans@users.sf.net> - - * win/tkWinDialog.c: [Bug 1913750]: tk_chooseDirectory -initialdir - internationalization problem. - [Bug 3500545]: tk_getOpenFile -multiple 1 wrong on windows. - [Bug 3416492]: Crash in open/save file dialog in Windows 7 libraries. - [Bug 3095112]: crash when selecting file from Win7 Library. - (All of those backported from Tk 8.6) - 2013-06-05 Jan Nijtmans <nijtmans@users.sf.net> * generic/ttk/ttkScroll.c: [Bug 3613759]: ttk::entry and symbolic @@ -61,6 +59,18 @@ a better first place to look now. * generic/tkEntry.c: Don't set interp result when it will be overwritten later. +2013-06-04 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: Eliminate NO_VIZ macro as current + zlib uses HAVE_HIDDEN in stead. One more last-moment + fix for FreeBSD by Pietro Cerutti + +2013-05-23 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: [Bug 3613668]: XFilterEvent() hangs. + * unix/configure: + * unix/tkUnixEvent.c: + 2013-05-19 Jan Nijtmans <nijtmans@users.sf.net> * unix/tcl.m4: Fix for FreeBSD, and remove support for older @@ -72,17 +82,7 @@ a better first place to look now. 2013-04-01 Don Porter <dgp@users.sourceforge.net> - *** 8.5.14 TAGGED FOR RELEASE *** - - * generic/tk.h: Bump to 8.5.14 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - * README: - - * unix/configure: autoconf-2.59 - * win/configure: + * tests/window.test: Bring back test window-2.9. No longer hangs. * generic/tkInt.h: [Bug 3607830] Runtime checks that Xkb is * unix/tkUnixEvent.c: available in the X server before trying to @@ -114,50 +114,66 @@ a better first place to look now. 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> +2013-02-18 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). + * unix/tkUnixEvent.c: Call XInitThreads once before the first Xlib + call. Suggested by Brian Griffin. 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> +2013-01-13 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkTextIndex.c: [Bug 3588824]: bug in image index handling - * tests/textIndex.test: for weird image names + * library/tk.tcl: [Bug 3600390]: tk_strictMotif not tested for. Now + * library/ttk/entry.tcl: all key-bindings for Control-a,b,e,f,n,p and + their shift variants respect tk_strictMotif. -2012-11-16 Joe Mistachkin <joe@mistachkin.com> +2013-01-10 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkBind.c: Add support for an 'M' binding substitution - that is replaced with the number of script-based binding patterns - matched so far for the event. - -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. + * library/text.tcl: [Bug 3600251]: Inappropriate replacement of Mac + binding. + * library/tk.tcl: [Bug 3600260]: Errors in new virtual event + definitions -2012-11-09 Don Porter <dgp@users.sourceforge.net> +2012-12-11 Don Porter <dgp@users.sourceforge.net> - *** 8.5.13 TAGGED FOR RELEASE *** + *** 8.6.0 TAGGED FOR RELEASE *** - * generic/tk.h: Bump to 8.5.13 for release. + * README: Bump version number to 8.6.0 + * generic/tk.h: * library/tk.tcl: * unix/configure.in: * unix/tk.spec: * win/configure.in: - * README: * unix/configure: autoconf-2.59 * win/configure: +2012-12-04 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-16 Joe Mistachkin <joe@mistachkin.com> + + * generic/tkBind.c: Add support for an 'M' binding substitution + that is replaced with the number of script-based binding patterns + matched so far for the event. + +2012-11-14 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinDialog.c: [Bug 3500545]: tk_getOpenFile -multiple 1 wrong + on windows. + [Bug 3416492]: Crash in open/save file dialog in Windows 7 libraries. + [Bug 3095112]: crash when selecting file from Win7 Library. + +2012-11-11 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinTest.c: [Bug 3585396]: winDialog.test requires user + * tests/winDialog.test: interaction. + 2012-11-07 Donal K. Fellows <dkf@users.sf.net> * generic/tkFocus.c (TkSetFocusWin): [Bug 3574708]: Move window @@ -171,43 +187,21 @@ a better first place to look now. count maintenance in the [wm manage|forget] operations that could cause segfaults due to premature free of structs. -2012-10-23 Jan Nijtmans <nijtmans@users.sf.net> +2012-09-19 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkButton.h: Backport of ::tk::mac::useCompatibilityMetrics - * generic/tkButton.c handling and scrollbar metrics handling from trunk. - * generic/tkScrollbar.h - * generic/tkScrollbar.c - * macosx/tkMacOSXButton.c - * macosx/tkMacOSXScrlbr.c - * unix/tkUnixPort.h - * win/tkWinButton.c - * win/tkWinScrlbr.c - -2012-10-09 Andreas Kupries <andreask@activestate.com> - - Cherrypick Merge, Backport of [6223d9e067]. Restored from - tk-cocoa-8-5-bacport-branch, did not survive the merge. - See trunk 2012-05-29 Donal K. Fellows - - * generic/tkInt.decls (TkMacOSXDrawable): Added OSX-specific mechanism - to allow retrieval of the drawing surface. Allows Canvas3d to be - adapted to 8.6. - -2012-09-28 Jan Nijtmans <nijtmans@users.sf.net> + * win/Makefile.in: Compile win32 binaries with -DTCL_NO_DEPRECATED + * win/tkiWinWm.c: Fix gcc compiler warning. - * generic/tkInt.h: Add 8 colors to the supported color list - * generic/tkColor.c: (aqua, crimson, fuchsia, indigo, lime, - * unix/tkUnixColor.c: olive, silver and teal), part of TIP #403 - * xlib/rgb.txt - * xlib/xcolors.c +2012-09-17 Don Porter <dgp@users.sourceforge.net> -2012-09-26 Jan Nijtmans <nijtmans@users.sf.net> + *** 8.6b3 TAGGED FOR RELEASE *** - * win/Makefile.in: Compile win32 binaries with -DTCL_NO_DEPRECATED + * macosx/tkMacOSXWm.c: [Bug 3567786] Stop segfault in [wm forget]. -2012-09-25 Kevin Walzer <wordtech@users.sourceforge.net> +2012-09-15 Don Porter <dgp@users.sourceforge.net> - * macosx/*: Merge Tk-Cocoa backport into core-8-5-branch + * macosx/tkMacOSXFont.c: [Bug 3567778] Make Tk_MeasureChars() honor + the TK_AT_LEAST_ONE flag properly. 2012-09-13 Donal K. Fellows <dkf@users.sf.net> @@ -218,6 +212,10 @@ a better first place to look now. Added a clean panic to the non-X11 TkSetRegion to catch this case and stop such confusion from happening again. +2012-09-13 Donal K. Fellows <dkf@users.sf.net> + + * win/tkWinWm.c (WmTransientCmd): [Bug 3567283]: Added missing cast. + 2012-09-11 Donal K. Fellows <dkf@users.sf.net> * generic/ttk/ttkEntry.c (EntryDisplay): [Bug 3566594]: Must manually @@ -226,11 +224,47 @@ a better first place to look now. because the GC sharing code doesn't take into account clip handling. Thanks to Christian Nassau for identifying the problem. +2012-09-07 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkCanvPs.c (TkCanvPostscriptCmd): [Bug 3565533]: Purge use + of variable that was only ever checked once immediately afterwards, + except for one (buggy) case where it was checked without assignment. + +2012-09-07 Don Porter <dgp@users.sourceforge.net> + + * README: Bump version number to 8.6b3 + * generic/tk.h: + * library/tk.tcl: + * unix/configure.in: + * unix/tk.spec: + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: + +2012-08-30 Andreas Kupries <andreask@activestate.com> + + * generic/tkCanvWind.c (CanvasPsWindow): Unbreak AIX, replaced use + of C99 comments in commit [961ae24a3f] (2012-08-27) with C89-style. + * win/tkWinDialog.c: Unbreak windows problems with commit [961ae24a3f] + * win/tkWinMenu.c: as well. + * win/tkWinSend.c: + 2012-08-28 Jan Nijtmans <nijtmans@users.sf.net> * generic/tkMenuDraw.c: [Bug 3562426]: Context menu goes out of edge of screen. +2012-08-27 Donal K. Fellows <dkf@users.sf.net> + + * (very many files): Reworked the generation of error messages and + postscript so that they no longer made nearly as much use of the Tcl + interpreter's string result code, in the process substantially + reducing the amount of ad-hoc stack buffers used for message + generation. There should be no observable changes from this except + that Tk now causes the ::errorCode variable to be set meaningfully in + virtually all places where errors are generated. + 2012-08-24 Donal K. Fellows <dkf@users.sf.net> * library/tkfbox.tcl (GlobFiltered): [Bug 3558535]: Factor out the @@ -244,35 +278,60 @@ a better first place to look now. * unix/tkUnixWm.c: [Bugs 3554026,3561016]: Stop crash with tearoff menus. +2012-08-23 Jan Nijtmans <nijtmans@users.sf.net> + + * library/tk.tcl: [Bug 3555644]: Better use of virtual events, + * library/ttk/entry.tcl Add <<ToggleSelection>> virtual event. + * library/ttk/treeview.tcl + +2012-08-22 Jan Nijtmans <nijtmans@users.sf.net> + + TIP #403 IMPLEMENTATION + + * xlib/xcolors.c: Web Colors for Tk. New colors aqua, crimson, + * xlib/rgb.txt: fuchsia, indigo, lime, olive, silver and teal. + * unix/tkUnixColor.c: Modified RGB values for gray/grey, green, + * generic/tkInt.h: maroon and purple. + * generic/tkColor.c + 2012-08-17 Jan Nijtmans <nijtmans@users.sf.net> - * win/nmakehlp.c: Add "-V<num>" option, in order to be able - to detect partial version numbers. + * win/nmakehlp.c: Add "-V<num>" option, in order to be able to detect + partial version numbers. 2012-08-15 Jan Nijtmans <nijtmans@users.sf.net> - * win/buildall.vc.bat: Only build the threaded builds by default - * win/rules.vc: Backport some improvements from Tcl 8.6 - * win/makefile.vc: + * win/buildall.vc.bat: Only build the threaded builds by default + * win/rules.vc: For msvcrt static builds, allow to link + against libraries where the 'x' is missing + (generated by Makefile.in). + * win/makefile.vc: Always compile Tk with -DUSE_TCL_STUBS, + formatting. + * library/tk.tcl: [FRQ 3555324]: On Windows, re-define Ctrl-A + for Select-All., as most Windows applications + do. -2012-08-11 François Vogel <fvogelnew1@free.fr> +2012-08-11 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkTextTag.c: [Bug 3554273]: Test textDisp-32.2 failed + * library/*.tcl: [Bug 3555644]: Better use of virtual events. + Pre-define 10 new Virtual events, and correct various bindings + according to the Mac OSX documentation. + *** POTENTIAL INCOMPATIBILITY *** for code that assumes that widget + classes are bound to literal events or that was using one of the new + virtual event names itself for other purposes. -2012-08-09 Stuart Cassoff <stwo@users.sourceforge.net> + * win/rules.vc: Sync with tcl version of rules.vc - * generic/tkEvent.c: Remove useless (void *) casts - * unix/tkUnixEvent.c: introduced in checkin [b7a58eae61]. - * unix/tkUnixKey.c: The warnings were false flags from a - * unix/tkUnixRFont.c: faulty OpenBSD C compiler. - -2012-08-03 François Vogel <fvogelnew1@free.fr> +2012-08-11 François Vogel <fvogelnew1@free.fr> - * tests/bind.test: [Bug 3554081]: Test bind-22.10 failed + * generic/tkTextTag.c: [Bug 3554273]: Test textDisp-32.2 failed -2012-08-02 François Vogel <fvogelnew1@free.fr> +2012-08-09 Stuart Cassoff <stwo@users.sourceforge.net> - * tests/spinbox.test: [Bug 3553311]: Test spinbox-3.70 failed + * generic/tkEvent.c: Remove useless (void *) casts introduced in + * unix/tkUnixEvent.c: checkin [81e50c85ed]. The warnings were false + * unix/tkUnixKey.c: flags from a faulty OpenBSD C compiler. + * unix/tkUnixRFont.c: 2012-07-31 Donal K. Fellows <dkf@users.sf.net> @@ -285,30 +344,14 @@ a better first place to look now. * win/nmakehlp.c: Backport from Tcl 8.6, but add -Q option from sampleextension. -2012-07-17 Don Porter <dgp@users.sourceforge.net> - - *** 8.5.12 TAGGED FOR RELEASE *** - - * generic/tk.h: Bump to 8.5.12 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - * README: - - * unix/configure: autoconf-2.59 - * win/configure: - - * changes: Updated for 8.5.12 release. - 2012-07-17 Jan Nijtmans <nijtmans@users.sf.net> * win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails -2012-07-08 Jan Nijtmans <nijtmans@users.sf.net> +2012-07-05 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkIntXlibDecls.h: [Bug 3541305]: Xfree/Xsync... - should not be macros + * win/tkWinDialog.c (GetFileNameW): [Bug 3540127]: Better solution, + using Tcl_GetIndexFromObj in stead of Tcl_GetIndexFromObjStruct 2012-07-05 Donal K. Fellows <dkf@users.sf.net> @@ -333,12 +376,25 @@ a better first place to look now. * unix/tcl.m4: * unix/configure: autoconf-2.59 +2012-06-24 Jan Nijtmans <nijtmans@users.sf.net> + + * doc/SetOptions.3: [FRQ-3536507]: clientData field in Tk_OptionSpec + * generic/tk.h: should be "const void *" + * generic/tk*.c: Eliminate many unnessessary type casts + 2012-06-22 Jan Nijtmans <nijtmans@users.sf.net> * win/Makefile.in: [Bug 1844430]: cygwin make fails in 8.4.14-8.5b3 * unix/tcl.m4: Sync with Tcl version. * unix/configure: autoconf-2.59 +2012-06-20 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tk.decls: [FRQ 2636558] simplification. Restore forwards + * generic/tkBitmap.c: compatibility with Tk 8.5. + * generic/tkdecls.h: + * generic/tkStubInit.c: + 2012-06-15 Donal K. Fellows <dkf@users.sf.net> * generic/ttk/ttkTreeview.c (unshareObj): [Bug 3535362]: Changed name @@ -372,9 +428,6 @@ a better first place to look now. * generic/tkMain.c: Implement TkCygwinMainEx for loading * generic/tkWindow.c: Cygwin's Tk_MainEx from the Tk dll. - -2012-06-07 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkInt.decls: Change XChangeWindowAttributes signature and * generic/tkIntXlibDeclsDecls.h: many others to match Xorg, needed for Cygwin. @@ -384,22 +437,27 @@ a better first place to look now. * unix/Makefile.in: [Bug 3532186] pkgIndex.tcl file complexity * win/Makefile.in: -2012-06-02 Jan Nijtmans <nijtmans@users.sf.net> - - * generic/tkInt.decls: Change XSetDashes signature and many others - * generic/tkIntDecls.h: to match Xorg, needed for Cygwin. - * generic/tkIntXlibDeclsDecls.h - * win/Makefile.in: Generate same pkgIndex.tcl file for win32 and - * unix/Makefile.in: cygwin, one that is equally useable for both. - -2012-05-30 Jan Nijtmans <nijtmans@users.sf.net> +2012-05-31 Jan Nijtmans <nijtmans@users.sf.net> * generic/tkWindow.c: Simplify determination whether we are running * generic/tkStubInit.c: on cygwin. Export Tk_GetHINSTANCE, - * generic/tkInt.decls: TkSetPixmapColormap and TkpPrintWindowId on the - Cygwin dll, sync stub table with Tk 8.6 win32 version. - * generic/tk*Decls.h: re-generated - * win/Makefile.in: "make genstubs" when cross-compiling on UNIX + * generic/tkInt.decls: TkSetPixmapColormap and TkpPrintWindowId from + the Cygwin dll, sync stub table with Tk 8.6 + win32 version. + * generic/tk*Decls.h: re-generated + * win/Makefile.in: "make genstubs" when cross-compiling on UNIX + + * win/stubs.c: Implement XFlush and various others for win32 + * win/tkWinPort.h: as stubs, so win32 extensions using those can + run under CYGWIN as well. + * generic/tkMain.c: Allow tk86.dll to cooperate with the cygwin + console. + +2012-05-29 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkInt.decls (TkMacOSXDrawable): Added OSX-specific mechanism + to allow retrieval of the drawing surface. Allows Canvas3d to be + adapted to 8.6. 2012-05-28 François Vogel <fvogelnew1@free.fr> @@ -436,7 +494,7 @@ a better first place to look now. * library/menu.tcl: [Bug 2768586]: Menu posting on dual monitors -2012-05-02 Jan Nijtmans <nijtmans@users.sf.net> +2012-04-29 Jan Nijtmans <nijtmans@users.sf.net> * library/tk.tcl: [Bug 533519]: Window placement with multiple screens * generic/tkBind.c: @@ -456,8 +514,6 @@ a better first place to look now. * generic/tkPlatDecls.h: * generic/tkintDecls.h: * generic/tkStubInit.c: - * unix/Makefile.in: [Bug 3519917]: Snow Leopard unix/Makefile - `make test` fail 2012-04-22 Donal K. Fellows <dkf@users.sf.net> @@ -468,26 +524,30 @@ a better first place to look now. memory) to Tkinter/Python because of the way they map events between languages. +2012-04-20 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkWindow.c (commands): Ensure that all descriptions of + commands created by Tk are correct. + 2012-04-20 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tk.tcl: Use vroot size in stead of screen size for - clipping window coordinates in ::tk::PlaceWindow. - * generic/dialog.tcl: Use ::tk::PlaceWindow in dialog.tcl, in - stead of dumplicating the code there. - (harmless part of [Bug 533519]) + * generic/tk.tcl: Use vroot size in stead of screen size for clipping + window coordinates in ::tk::PlaceWindow. + * generic/dialog.tcl: Use ::tk::PlaceWindow in dialog.tcl, instead of + dumplicating the code there. (harmless part of [Bug 533519]) 2012-04-13 Jan Nijtmans <nijtmans@users.sf.net> - * win/rules.vc: [Bug 3517448] TclKit build fails (unresolved + * win/rules.vc: [Bug 3517448]: TclKit build fails (unresolved __strtoi64) 2012-04-07 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkBind.c: [Bug 3176239] control-MouseWheel causes segv + * generic/tkBind.c: [Bug 3176239]: control-MouseWheel causes segv 2012-03-30 Jan Nijtmans <nijtmans@users.sf.net> - * unix/tcl.m4: [Bug 3511806] Compiler checks too early + * unix/tcl.m4: [Bug 3511806]: Compiler checks too early * unix/configure.in: This change allows to build the cygwin * unix/configure and mingw32 ports of Tcl/Tk to build * win/tcl.m4: out-of-the-box using a native or cross- @@ -496,15 +556,19 @@ a better first place to look now. 2012-03-21 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkColor.c: [Bug 2809525] Abort on overlong color name. + * generic/tkColor.c: [Bug 2809525]: Abort on overlong color name. * unix/tkUnixColor.c: 2012-03-18 Jan Nijtmans <nijtmans@users.sf.net> - * xlib/xcolors.c: [RFE 3503317]: XParseColor speedup + * xlib/xcolors.c: [FRQ 3503317]: XParseColor speedup * xlib/rgb.txt: List of all colors accepted by Tk in Xorg format * tests/color.test: Added test case for all colors in rgb.txt +2012-03-13 Donal K. Fellows <dkf@users.sf.net> + + * doc/*.3, doc/*.n: Minor spelling fixes. + 2012-03-07 Donal K. Fellows <dkf@users.sf.net> * generic/tkObj.c (GetPixelsFromObjEx): [Bug 3497848]: Better rounding @@ -534,6 +598,11 @@ a better first place to look now. * win/configure.in: Detect whether _strtoi64 is available * win/configure: (regenerated) +2012-02-25 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinDialog.c: [Bug 1913750]: tk_chooseDirectory -initialdir + internationalization problem. + 2012-02-15 Jan Nijtmans <nijtmans@users.sf.net> * xlib/xcolors.c: [Bug 3486474]: Inconsistent color scaling @@ -543,7 +612,7 @@ a better first place to look now. 2012-02-10 Donal K. Fellows <dkf@users.sf.net> - * win/tkWinDialog.c (GetFileNameW): Ensure that we do not convert a + * win/tkWinDialog.c (GetFileName): Ensure that we do not convert a result list to a string inadvertently, as this causes problems with Tkinter's handling of multiple filename results. Issue was reported via StackOverflow: http://stackoverflow.com/q/9227859/301832 @@ -601,19 +670,27 @@ a better first place to look now. * win/tkWinMenu.c: [Bug 3235256] Keep menu entry IDs out of system values. Thanks Colin McDonald. +2011-12-13 Donal K. Fellows <dkf@users.sf.net> + + * doc/getOpenFile.n: Make example follow best practices. Issue spotted + by Emiliano Gavilán. + +2011-11-29 Donal K. Fellows <dkf@users.sf.net> + + * tests/safe.test: [Bug 1847925]: Update list of hidden commands. + 2011-11-22 Jan Nijtmans <nijtmans@users.sf.net> - * doc/wish.1: Use the same shebang comment everywhere. - * library/demos/hello - * library/demos/rmt - * library/demos/square - * library/demos/tcolor - * library/demos/timer - * library/demos/widget * unix/Makefile.in: [Bug 1945073]: Demo square.tcl * win/Makefile.in: cannot run; need package tktest -2011-11-17 Alexandre Ferrieux <ferrieux@users.sourceforge.net> +2011-11-17 Jan Nijtmans <nijtmans@users.sf.net> + + * doc/menu.n: Fix the escaping of leading dots in lines that start with + a widget name, so that nroff doesn't mistake it as a non-existing macro + and skips the entire line. + +2011-11-14 Alexandre Ferrieux <ferrieux@users.sourceforge.net> * generic/tkCanvas.c: [Bug 3437816]: Missing TCL_ERROR return in [canvas lower]. @@ -628,35 +705,15 @@ a better first place to look now. * doc/ttk_notebook.n: doesn't mistake it as a non-existing macro * doc/pack.n: and skips the entire line. -2011-11-04 Don Porter <dgp@users.sourceforge.net> - - *** 8.5.11 TAGGED FOR RELEASE *** - - * generic/tk.h: Bump to 8.5.11 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - * README: - - * unix/configure: autoconf-2.59 - * win/configure: - - * changes: Updated for 8.5.11 release. - 2011-11-01 Donal K. Fellows <dkf@users.sf.net> * generic/tkObj.c (GetPixelsFromObjEx): [Bug 3431491]: Use a bit of type hackery to allow numbers to be interpreted as coordinates (most notably on a canvas) without reinterpreting via a string. -2011-10-26 Don Porter <dgp@users.sourceforge.net> - - * changes: Updates for 8.5.11. - -2011-10-01 Kevin B. Kenny <kennykb@acm.org> +2011-10-27 Kevin B. Kenny <kennykb@acm.org> - * generic/tkInt.h: [Bug 3410609] Change the event mechanism + * generic/tkInt.h: [Bug 3410609]: Change the event mechanism * unix/tkUnixEvent.c: for <KeyPress> events to use the keysym * unix/tkUnixKey.c: returned by XLookupString in preference to the one that appears in the raw X event at any level. This change @@ -664,6 +721,32 @@ a better first place to look now. and similar beasts. KeyRelease events still work as they did before, as does Tk with input methods disabled. +2011-10-13 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinDialog.c: Internationalization of all Windows font + * win/tkWinFont.c: handling. + +2011-10-10 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinDialog.c: [Bug 3163893]: -initialdir option bug for + tk_chooseDirectory under XP + +2011-10-05 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinInt.h: Remove tkWinProcs, as it is no longer + * win/tkWinX.c: being used. + * win/tkWinTest.c: + +2011-09-27 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgPNG.c (WriteExtraChunks): [Bug 3405839]: Write the sDAT + chunk with the correct length. + +2011-09-08 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkDecls.h: Don't let tkDecls.h depend on <tchar.h> on + windows, not even in UNICODE mode. + 2011-09-01 Donal K. Fellows <dkf@users.sf.net> * doc/photo.n: Correctly documented what the [$ph data] command @@ -671,59 +754,78 @@ a better first place to look now. 2011-08-16 Jan Nijtmans <nijtmans@users.sf.net> - * win/tkWinDialog.c: [Bug 3388350] mingw64 compiler warnings - * win/tkWinDraw.c - * win/tkWinSend.c - * win/tkWinSendCom.c - * win/tkWinColor.c - * win/tkWinDialog.c + * win/tkWinDialog.c: [Bug 3388350]: mingw64 compiler warnings * win/tkWinEmbed.c * win/tkWinMenu.c - * win/tkWinPixmap.c * win/tkWinTest.c - * win/tkWinWindow.c * win/tkWinWm.c * win/tkWinX.c - * win/stubs.c - * generic/tkAtom.c - * generic/tkSelect.c 2011-08-13 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkBitmap.c: [Bug 3388350] mingw64 compiler warnings + * generic/tkBitmap.c: [Bug 3388350]: mingw64 compiler warnings * generic/tkConsole.c - * unix/tkUnixMenubu.c - * win/tkWinButton.c + * win/tkWinDialog.c * win/tkWinEmbed.c - * win/tkWinFont.c - * win/tkWinImage.c - * win/tkWinKey.c - * win/tkWinTest.c - * win/tkWinWm.c + * win/tkWinSend.c + * win/tkWinSendCom.c + +2011-08-05 Don Porter <dgp@users.sourceforge.net> + + *** 8.6b2 TAGGED FOR RELEASE *** + + * changes: Updates for 8.6b2 release. + +2011-08-03 Don Porter <dgp@users.sourceforge.net> + + * win/tkWinWm.c: [Bug 2891541]: Merge of 8.5.8 fix from Pat Thoyts. + Permit normal behaviour on Windows for a grabbed toplevel when it + is the main window. 2011-08-03 Jan Nijtmans <nijtmans@users.sf.net> - * win/tkWinDialog.c: [Bug 3314770] regression - Windows file + * win/tkWinDialog.c: [Bug 3314770]: regression - Windows file dialogs not resizable +2011-07-28 Don Porter <dgp@users.sourceforge.net> + + * changes: Updates for 8.6b2 release. + 2011-07-28 Jan Nijtmans <nijtmans@users.sf.net> - * xlib/X11/Xutil.h: [Bug 3380684] XEmptyRegion prototype doesn't + * xlib/X11/Xutil.h: [Bug 3380684]: XEmptyRegion prototype doesn't match usage +2011-07-19 Donal K. Fellows <dkf@users.sf.net> + + * doc/*.3, doc/*.n: Many small fixes to documentation as part of + project to improve quality of generated HTML docs. + +2011-07-18 Don Porter <dgp@users.sourceforge.net> + + * README: Bump version number to 8.6b2 + * generic/tk.h: + * library/tk.tcl: + * unix/configure.in: + * unix/tk.spec: + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: + 2011-06-29 Don Porter <dgp@users.sourceforge.net> - * generic/ttk/ttkTrace.c: [Bug 3341056] Correct segfault due to flaw + * generic/ttk/ttkTrace.c: [Bug 3341056]: Correct segfault due to flaw * tests/ttk/ttk.test: in the 2011-06-17 commit. -2011-06-23 Don Porter <dgp@users.sourceforge.net> +2011-06-19 Donal K. Fellows <dkf@users.sf.net> - * changes: Updated for 8.5.10 release. + * doc/wm.n: Added documentation of the -type attribute that was + introduced in TIP#359, and moved documentation of -alpha to common + section as it is supported on all platforms now. 2011-06-17 Don Porter <dgp@users.sourceforge.net> - *** 8.5.10 TAGGED FOR RELEASE *** - * generic/ttk/ttkTrace.c: Workaround Bug 3062331. * tests/ttk/ttk.test: * changes: Updated @@ -735,31 +837,26 @@ a better first place to look now. 2011-06-10 Don Porter <dgp@users.sourceforge.net> - * README: Correct some README bitrot. - * macosx/README: + * generic/tkEntry.c: [Bug 3315731]: Fix [$entry -invcmd]. - * generic/tkCanvLine.c: [Bug 3175610] Incomplete refresh of line item. - Backport of 2011-03-03 trunk commit from Alexandre Ferrieux. - -2011-06-08 Don Porter <dgp@users.sourceforge.net> +2011-06-10 Don Porter <dgp@users.sourceforge.net> - * changes: Updated for 8.5.10 release. + * README: Correct some README bitrot. + * macosx/README: 2011-06-07 Don Porter <dgp@users.sourceforge.net> - * win/tkWinDialog.c: Backport [Bug 2484771] fix. - - * generic/tkEntry.c: Restore support for values "08" and "09" - in a [spinbox] configured to use -from and -to values. [Bug 2358545]. + * generic/tkEntry.c: [Bug 2358545]: Restore support for values "08" + and "09" in a [spinbox] configured to use -from and -to values. 2011-06-06 Don Porter <dgp@users.sourceforge.net> - * generic/tkConsole.c: Restore proper NUL output to the [console]. - [Bug 2546087] + * generic/tkConsole.c: [Bug 2546087]: Restore proper NUL output to + * library/console.tcl: the [console]. 2011-04-22 Peter Spjuth <peter.spjuth@gmail.com> - * generic/tkCanvPoly.c: [Bug 3291543] There was a crash if dchars + * generic/tkCanvPoly.c: [Bug 3291543]: There was a crash if dchars * tests/canvas.test: removed all coordinates of a polygon. 2011-04-21 Peter Spjuth <peter.spjuth@gmail.com> @@ -774,12 +871,26 @@ a better first place to look now. * doc/ttk_progressbar.n: * doc/ttk_widget.n: +2011-04-06 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tkAppInit.c: Make symbols "main" and "Tcl_AppInit" + MODULE_SCOPE: there is absolutely no reason for exporting them. + * unix/tcl.m4: Don't use -fvisibility=hidden with static + * unix/configure libraries (--disable-shared) + 2011-04-04 Peter Spjuth <peter.spjuth@gmail.com> * tests/grid.test: * generic/tkGrid.c: [Bug 723765]: When a slave was removed from grid, the -in option was not remembered. +2011-04-04 Joe Mistachkin <joe@mistachkin.com> + + * win/tkWinDialog.c (FontchooserShowCmd): Change the CHOOSEFONT and + LOGFONT used with sizeof to CHOOSEFONTA and LOGFONTA to match their + local variable declarations (i.e. mismatch with -DUNICODE). This code + is not present in 8.4 or 8.5. + 2011-04-04 Peter Spjuth <peter.spjuth@gmail.com> * doc/labelframe.n: @@ -789,15 +900,21 @@ a better first place to look now. sense as a container. Added note to frame about restrictions when used as a container. +2011-03-28 Donal K. Fellows <dkf@users.sf.net> + + * library/tk.tcl (::tk::FindAltKeyTarget): Make this handle the + traversal of the logical window manager hierarchy correctly. Based on + comments by Emiliano Gavilan. + 2011-03-28 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkTextBTree.c: [Bug 3129527]: Fix buffer overflow - w/ GCC 4.5 and -D_FORTIFY_SOURCE=2. One more place where this problem - could appear. + * generic/tkTextBTree.c: [Bug 3129527]: Fix buffer overflow w/ GCC 4.5 + and -D_FORTIFY_SOURCE=2. One more place where this problem could + appear. 2011-03-24 Jan Nijtmans <nijtmans@users.sf.net> - * win/tkWinMenu.c: [Bug #3239768] tk8.4.19 (and later) WIN32 + * win/tkWinMenu.c: [Bug #3239768]: tk8.4.19 (and later) WIN32 menu font support. 2011-03-16 Jan Nijtmans <nijtmans@users.sf.net> @@ -807,6 +924,17 @@ a better first place to look now. Backported from TEA, but kept all original platform code which was removed from TEA. +2011-03-14 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkBind.c: Eliminate some more unneeded write-only + * generic/tkCanvUtil.c: variables (discovered by gcc-4.6) + * generic/tkFocus.c: + +2011-03-12 Donal K. Fellows <dkf@users.sf.net> + + Remove casts from uses of ckalloc/ckfree/... now that Tcl declares + them to be using useful casts internally. + 2011-03-12 Jan Nijtmans <nijtmans@users.sf.net> * win/tkWin32Dll.c: Eliminate unneeded _TkFinalize wrapper. @@ -823,33 +951,47 @@ a better first place to look now. test rather than one from libfreetype, because the latter doesn't work when the linker is called with --as-needed. -2011-01-25 Jan Nijtmans <nijtmans@users.sf.net> +2011-03-03 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + + * generic/tkCanvLine.c: [Bug 3175610]: Incomplete refresh of line items. + +2011-03-02 Donal K. Fellows <dkf@users.sf.net> - * generic/tkSelect.c: [Patch #3129527]: Fix buffer overflow - * win/tkWinWm.c: w/ GCC 4.5 and -D_FORTIFY_SOURCE=2. Just the - * unix/tkUnixWm.c: strcpy->memcpy part, to prevent anything - like [Bug #3164879] + * doc/tk_mac.n (new file): Description of OSX-specific functionality + in Tk, contributed by Kevin Walzer. + * doc/button.n, doc/font.n, doc/menu.n: Noted which parts of these + commands are intentionally not fully supported on OSX. + +2011-01-24 Joe English <jenglish@users.sourceforge.net> + + * generic/tkSelect.c: Fix for [Bug #3164879]: (memory allocation + bug introduced by [Patch #3129527]) 2011-01-22 Joe English <jenglish@users.sourceforge.net> * generic/ttk/ttkEntry.c(ttk::combobox): Add missing 'validate' command (reported by schelte). -2011-01-19 Jan Nijtmans <nijtmans@users.sf.net> +2011-01-13 Jan Nijtmans <nijtmans@users.sf.net> - * generic/ttk/ttkGenStubs.tcl: Make sure to use CONST/VOID in stead of - * generic/ttk/ttkDecls.h: const/void when appropriate. This allows to - use const/void in the *.decls file always, genStubs will do the right - thing. + * library/msgbox.tcl: [Patch #3154705]: Close button has no effect -2011-01-17 Jan Nijtmans <nijtmans@users.sf.net> +2011-01-12 Jan Nijtmans <nijtmans@users.sf.net> - * win/tcl.m4: handle --enable-64bit=ia64 for gcc. BACKPORT. + * win/tcl.m4: handle --enable-64bit=ia64 for gcc + * win/configure.in typo * win/configure: (autoconf-2.59) -2011-01-13 Jan Nijtmans <nijtmans@users.sf.net> +2011-01-06 Kevin Walzer <wordtech@users.sourceforge.net> - * library/msgbox.tcl: [Patch #3154705] Close button has no effect + * macosx/README: Added info on textured background windows. + * macosx/tkMacOSXFont.c: Fix for 2857300, improves rounding up on text + width [submitted by treectrl] + * macosx/tkMacOSXMenu.c: Fix for radiobuttons and checkbuttons not + displaying in popup menus, and disabled menu entries. + * macosx/tkMacOSXWindowEvent.c: Fix for 3086887, speeds up scrolling; + also textured background windows + * macosx/tkMacOSXWm.c: Textured background windows. 2011-01-06 Stuart Cassoff <stwo@users.sourceforge.net> @@ -860,245 +1002,490 @@ a better first place to look now. 2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net> + * unix/Makefile.in: Clean up '.PHONY:' targets: Arrange those + common to Tcl and Tk as in Tcl's Makefile.in, + add any missing ones and remove duplicates. + +2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net> + * unix/Makefile.in: [Bug 2446711]: Remove 'allpatch' target. 2010-12-17 Stuart Cassoff <stwo@users.sourceforge.net> - * unix/Makefile.in: Use 'rpmbuild', not 'rpm' [Bug 2537626]. + * unix/Makefile.in: [Bug 2537626]: Use 'rpmbuild', not 'rpm'. + +2010-12-17 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkMain.c: refactor isatty() function for Windows. + * win/tkWinImage.c: better warning message. + * win/tkWinInit.c: Let TkpDisplayWarning() send the message + directly to the debugger, if available, otherwise do as before. + +2010-12-16 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tk.h: [Patch 3124554]: Move WishPanic from Tk to Tcl + * win/winMain.c: Remove special MessageBox'es here, since every + panic-related thing is now handled correctly by Tcl. + +2010-12-15 Stuart Cassoff <stwo@users.sourceforge.net> + + * unix/Makefile.in: Installer Improvements. + * unix/install-sh: Similar to Tcl [Patch 3101127]. + +2010-12-15 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkMain.c: [Patch #3124683]: platform specific stuff + in (tcl|tk)Main.c 2010-12-13 Jan Nijtmans <nijtmans@users.sf.net> - * unix/tcl.m4: Cross-compile support for Win and UNIX (backported) - * unix/configure: (autoconf-2.59) - * win/tcl.m4: - * win/configure.in: - * win/configure: (autoconf-2.59) - * win/tkWin32Dll.c: SEH-emulation for AMD64 - * win/tkWinX.c: mingw-w64 does not accept _WIN32_IE < 0x0501 + * unix/tcl.m4: [Bug 3135271]: Link error due to hidden + * unix/configure: symbols (CentOS 4.2) (autoconf-2.59) + * generic/tkMain.c: Change "Application initialization failed" to + * tests/main.test: "application-specific initialization failed", + for consistency with Tcl. + * win/tkWin32Dll.c: See also: [Patch 1910041] and [Patch 3059922]. + SEH emulation on Win64 was not correct here: it sometimes results in + a crash. Contrary to the other places, the code here is not meant to + protect from OS bugs, but to protect Finalizing Tk when the application + went in an invalid state. 2010-12-12 Stuart Cassoff <stwo@users.sourceforge.net> * unix/tcl.m4: Better building on OpenBSD. * unix/configure: (autoconf-2.59) +2010-12-10 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tcl.m4: Fix manifest-generation for 64-bit gcc (mingw-w64) + * win/configure: (autoconf-2.59) + +2010-12-06 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkSelect.c: [Bug 3129527]: Fix buffer overflow w/ GCC 4.5 + * generic/tkTextDisp.c: and -D_FORTIFY_SOURCE=2 + * unix/tkUnixWm.c: + * win/tkWinWm.c: + +2010-12-05 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: [Patch 3116490]: cross-compile support for unix + * unix/configure (autoconf-2.59) + +2010-12-03 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tcl.m4: [Patch 3116490]: cross-compile Tcl mingw32 on unix + * win/configure: This makes it possible to cross-compile Tcl/Tk for + Windows (either 32-bit or 64-bit) out-of-the-box on UNIX, using + mingw-w64 build tools. + +2010-12-02 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkInt.decls (TkDrawAngledTextLayout,TkDrawAngledChars,...): + Expose angled text API for Emiliano Gavilán. Still only in internal + stub table. + +2010-11-29 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkAtom.c: Fix various 64-bit gcc(-4.5.2) warnings: cast + * generic/tkSelect.c: from pointer to integer of different size. + * win/stubs.c: + * win/tkWinButton.c: + * win/tkWinColor.c: + * win/tkWinPixmap.c: + * win/tkWinScrlbr.c: + * win/tkWinWindow.c: + * win/tkWinWm.c: + * win/ttkWinMonitor.c: + * win/tkWin32Dll.c: Make assembler code compile in Win64 with gcc. + 2010-11-24 Jan Nijtmans <nijtmans@users.sf.net> - * win/tkWinDialog.c: [Bug #3071836]: Crash/Tcl_Panic on WinXP saving - * win/tkWinInit.c: file to C:\ re-wrote TkpDisplayWarning such - that it does not use an Tcl API calls any more, so it works even with - an ill-initialized Tcl. - * win/winMain.c: Teach WishPanic how to thread UTF-8 in it's - messagebox. Backports from Tcl 8.6. No change in functionality. + * win/tkWinDialog.c: [Bug 3071836]: Crash/Tcl_Panic on WinXP saving + * win/tkWinInit.c: file to C:\, and rewrite TkpDisplayWarning not + to use any Tcl functions any more. This allows TkpDisplayWarning to be + used as panic proc. + * win/winMain.c: Use TkpDisplayWarning as panic proc on Windows. + * generic/tkMain.c: Remove unused strrchr, combine outChannel and + errChannel variables to a single variable. 2010-11-19 Jan Nijtmans <nijtmans@users.sf.net> - * win/configure.in: Allow cross-compilation by default. (backported) - * win/tcl.m4: Use -pipe for gcc on win32 (backported) - * win/configure: (regenerated) + * generic/tkCanv*.c: Revise Tcl_Panic() calls ending with a + * generic/tkGeomerty.c: newline removing the newline, because + * generic/tkImgPhInstance.c: Tcl_Panic() outputs a final newline + * generic/tkMenu.c: already. + * generic/tkRectOval.c: + * generic/tkTextBTree.c: + * generic/tkWindow.c: + * unix/tkUnixRFont.c: + * win/tkWinColor.c: + * win/tkWinDraw.c: + * win/tkWinMenu.c: + +2010-11-18 Jan Nijtmans <nijtmans@users.sf.net> + + * win/winMain.c: [FRQ 491789]: "setargv() doesn't support a unicode + cmdline" now implemented for cygwin and mingw32 too. + * win/configure.in: Allow cross-compilation by default. + * win/configure (regenerated) + +2010-11-17 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tcl.m4: [FRQ 491789]: "setargv() doesn't support a unicode + cmdline" now implemented for mingw-w64 + * win/configure (regenerated) + * win/winMain.c Workaround for bug in some versions of mingw-w64 2010-11-16 Jan Nijtmans <nijtmans@users.sf.net> - * win/tkWinPort.h [Bug #3110161]: Extensions using TCHAR don't compile + * win/winMain.c Bring compilation under mingw-w64 a bit closer + * win/tcl.m4 to reality. See for what's missing: + https://sourceforge.net/apps/trac/mingw-w64/wiki/Unicode%20apps + * win/configure: (re-generated) + * win/tkWinPort.h: [Bug 3110161]: Extensions using TCHAR don't compile on VS2005 SP1 -2010-11-04 Jan Nijtmans <nijtmans@users.sf.net> +2010-11-10 Andreas Kupries <andreask@activestate.com> + + * changes: Updates for 8.6b2 release. + +2010-11-06 Jan Nijtmans <nijtmans@users.sf.net> + + * library/msgs/*.msg: Update NL catalog. For other languages, + sorting and fix some locations of "&". + +2010-11-05 Jan Nijtmans <nijtmans@users.sf.net> - * library/msgs/de.msg: Updated German messages. Thanks to Ruediger - Haertel. [Patch 2442309] [Bug 3102739]. + * library/demos/widget: Use unicode copyright sign, instead of + * library/demos/en.msg: depending on translation. + * library/demos/nl.msg: + * generic/tkMain.c: Sync TK_ASCII_MAIN usage with tclMain.c -2010-10-23 Jan Nijtmans <nijtmans@users.sf.net> +2010-11-04 Don Porter <dgp@users.sourceforge.net> - * win/rules.vc Update for VS10 + * changes: Updates for 8.6b2 release. + +2010-11-03 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinClipboard.c: [FRQ 2965056]: Windows build with + * win/tkWinDialog.c: -DUNICODE + * win/tkWinMenu.c: + +2010-10-11 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkDecls.h: [FRQ 491789]: "setargv() doesn't support a + * doc/Tk_Main.3: unicode cmdline" implemented for Tk on MSVC++ + * win/Makefile.in: + * win/makefile.vc: + * win/winMain.c: + * win/rules.vc: Update for VS10 2010-10-11 Joe English <jenglish@users.sourceforge.net> - * generic/ttk/ttkTreeview.c: Fix crash in 'tag add' / 'tag remove' - commands when no -tags specified [Bug 3085489]. + * generic/ttk/ttkTreeview.c: [Bug 3085489]: Fix crash in 'tag add' / + 'tag remove' commands when no -tags specified. + +2010-10-11 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinMenu.c: [FRQ 2965056]: Windows build with -DUNICODE + * win/tkWinWm.c: + * win/tcl.m4: Add netapi32 to the link line, so we no longer + * win/makefile.vc: have to use LoadLibrary to access those + * win/configure: functions. + +2010-10-06 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinClipboard.c: [FRQ 2965056]: Windows build with + * win/tkWinColor.c: -DUNICODE + * win/tkWinCursor.c: + * win/tkWinFont.c: + * win/tkWinTest.c: + * win/tkWinMenu.c: + * win/tkWinPixmap.c: + * win/tkWinX.c: Eliminate isWinNT variable + * win/Makefile.in (genstubs): Generate ttk files as well. 2010-10-06 Donal K. Fellows <dkf@users.sf.net> * win/Makefile.in (genstubs): [Tcl Bug 3082049]: Typo. -2010-09-08 Joe English <jenglish@users.sourceforge.net> +2010-10-05 Jan Nijtmans <nijtmans@users.sf.net> - * generic/ttk/ttkTreeview.c (TreeviewSeeCommand): [Bug 2829363]: - Schedule redisplay if [$tv see] opens any items. + * generic/tkWinX.c: [Bug 3080953]: Malformed Unicode characters in %A + substitution Problem was in the static function GetTranslatedKey(). -2010-09-02 Joe English <jenglish@users.sourceforge.net> +2010-10-01 Donal K. Fellows <dkf@users.sf.net> - * library/ttk/winTheme.tcl, library/ttk/xpTheme.tcl, - * library/ttk/vistaTheme.tcl: [Bug 3057573]: Specify disabled combobox - text foreground color. + * generic/tkImgPhoto.c (Tk_PhotoPutBlock, Tk_PhotoPutZoomedBlock): + [Bug 3078902]: Ensure that zero-dimensioned data blocks cause no + changes at all instead of causing a hang. + +2010-09-29 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: Sync with Tcl version + * unix/configure: Re-generate with autoconf-2.59 + * win/configure: + * generic/tkMain.c Make compilable with -DUNICODE as well + +2010-09-28 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinSend.c: [Bug 3076671]: CVS HEAD Tk build fails on win32 + with msys/mingw. Make it compile on older mingw as well. + * generic/tk.decls: Add explicit scspec "EXTERN", as in Tcl + * generic/tkInt.decls: + * generic/tkStubInit.c: Don't let Tk_MainEx macro disturb compilation + +2010-09-23 Jan Nijtmans <nijtmans@users.sf.net> -2010-09-01 Don Porter <dgp@users.sourceforge.net> + * win/tcl.m4: Add -Wdeclaration-after-statement + * win/configure: (regenerated) + * win/tkWinX.c: Make compilable with -DUNICODE. + * win/winMain.c: + * unix/tkAppInit.c: Many clean-ups in comments, so all + (tcl|tk)AppInit.c variants use the same style. + * generic/ttk/ttkGenStubs.tcl: Dummy genStubs::export (from + genStubs.tcl) - *** 8.5.9 TAGGED FOR RELEASE *** +2010-09-20 Jan Nijtmans <nijtmans@users.sf.net> - * changes: Updated for 8.5.9 release. + * generic/ttk/ttkGenStubs.tcl: Clean-up, port all genStubs.tcl changes + * generic/ttk/ttk.decls: from Tcl to ttkGenStubs.tcl as well (no + * generic/tk.decls: change in any output files). This brings + * generic/tkInt.decls: all *.decls in the same form as tcl.decls - * doc/menu.n: Formatting error. +2010-09-16 Jeff Hobbs <jeffh@ActiveState.com> -2010-09-01 Joe English <jenglish@users.sourceforge.net> + * win/tkWinX.c (_WIN32_IE): update to IE5.5 base expectation - * library/ttk/entry.tcl: Revert keyboard navigation bindings - to use real events instead of virtual events. +2010-09-14 Jan Nijtmans <nijtmans@users.sf.net> + + * win/rules.vc [FRQ 2965056]: Windows build with -DUNICODE + * win/Makefile.in + +2010-09-13 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWin.h Move definitions of WINVER/_WIN32_WINNT + * win/tkWinDialog.h to one place, now that we only support + * win/tkWinMenu.c Win2000+ + * win/tkWinX.c + +2010-09-10 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinEmbed.c: Make compilable with -DUNICODE + * win/tkWinClipboard.c: Mark those files as not compilable with + * win/tkWinColor.c: -DUNICODE, so add a TODO. + * win/tkWinCursor.c: + * win/tkWinDialog.c: + * win/tkWinFont.c: + * win/tkWinMenu.c: + * win/tkWinPixmap.c: + * win/tkWinTest.c: + * win/tkWinWm.c: + * win/tkWinX.c: + * win/winMain.c: + * win/tkWinPort.h: mingw/cygwin fixes: <tchar.h> should always + be included here. + +2010-09-09 Jan Nijtmans <nijtmans@users.sf.net> + + * win/rules.vc: (sync with tcl version) + * win/makefile.vc: mingw should always link with -ladvapi32 + * win/tcl.m4: + * win/configure: (regenerated) + * win/tkWinInt.h: Remove ascii variant of tkWinPocs table, + * win/tkWinX.c: it is no longer necessary. + * win/tkWinTest.c: + +2010-09-08 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTreeview.c (TreeviewSeeCommand): [Bug 2829363]: + Schedule redisplay if [$tv see] opens any items. + +2010-09-05 Donal K. Fellows <dkf@users.sf.net> + + * library/bgerror.tcl: [Bugs 3046742,3046750]: Improve keybindings for + the background error dialog, and allow the use of the window manager + controls for closing it (where supported). The Escape key now causes + all remaining background error messages in the queue to be dropped. + +2010-09-02 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/winTheme.tcl, library/ttk/xpTheme.tcl, + * library/ttk/vistaTheme.tcl: [Bug 3057573]: Specify disabled combobox + text foreground color. 2010-08-31 Andreas Kupries <andreask@activestate.com> - * win/tcl.m4: Applied patch by Jeff fixing issues with the - manifest handling on Win64. + * win/tcl.m4: Applied patch by Jeff fixing issues with the manifest + handling on Win64. * win/configure: Regenerated. 2010-08-26 Jeff Hobbs <jeffh@ActiveState.com> - * generic/tkText.c (DumpLine): [Bug 3053347]: - s/segPtr->size/currentSize/ throughout, but particularly in if - lineChanged block where segPtr may no longer be valid. - - * unix/Makefile.in: add valgrind target + * unix/Makefile.in: Add valgrind target * unix/configure, unix/tcl.m4: [Bug 1230554]: SHLIB_LD_LIBS='${LIBS}' for OSF1-V*. Add /usr/lib64 to set of auto-search dirs. (SC_PATH_X): Correct syntax error when xincludes not found. * win/Makefile.in (VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE): - * win/configure, win/configure.in, win/tcl.m4: SC_EMBED_MANIFEST - macro and --enable-embedded-manifest configure arg added to support - manifest embedding where we know the magic. Help prevents DLL hell - with MSVC8+. - -2010-08-25 Jeff Hobbs <jeffh@ActiveState.com> - - * doc/ttk_spinbox.n (new), doc/ttk_*.3, doc/ttk_*.n: - * generic/ttk/ttkGenStubs.tcl: - * generic/ttk/ttk.decls, generic/ttk/ttkDecls.h: - * generic/ttk/ttkButton.c, generic/ttk/ttkCache.c: - * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c: - * generic/ttk/ttkDefaultTheme.c, generic/ttk/ttkElements.c: - * generic/ttk/ttkEntry.c, generic/ttk/ttkFrame.c: - * generic/ttk/ttkImage.c, generic/ttk/ttkInit.c: - * generic/ttk/ttkLabel.c, generic/ttk/ttkLayout.c: - * generic/ttk/ttkNotebook.c, generic/ttk/ttkPanedwindow.c: - * generic/ttk/ttkProgress.c, generic/ttk/ttkScale.c: - * generic/ttk/ttkScroll.c, generic/ttk/ttkScrollbar.c: - * generic/ttk/ttkSeparator.c, generic/ttk/ttkSquare.c: - * generic/ttk/ttkState.c, generic/ttk/ttkStubInit.c: - * generic/ttk/ttkStubLib.c, generic/ttk/ttkTagSet.c: - * generic/ttk/ttkTheme.c, generic/ttk/ttkTheme.h: - * generic/ttk/ttkThemeInt.h, generic/ttk/ttkTrace.c: - * generic/ttk/ttkTrack.c, generic/ttk/ttkTreeview.c: - * generic/ttk/ttkWidget.c, generic/ttk/ttkWidget.h: - * library/ttk/spinbox.tcl (new): - * library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl: - * library/ttk/button.tcl, library/ttk/clamTheme.tcl: - * library/ttk/classicTheme.tcl, library/ttk/combobox.tcl: - * library/ttk/cursors.tcl, library/ttk/defaults.tcl: - * library/ttk/entry.tcl, library/ttk/notebook.tcl: - * library/ttk/panedwindow.tcl, library/ttk/scale.tcl: - * library/ttk/sizegrip.tcl, library/ttk/treeview.tcl: - * library/ttk/ttk.tcl, library/ttk/utils.tcl: - * library/ttk/vistaTheme.tcl, library/ttk/winTheme.tcl: - * library/ttk/xpTheme.tcl: - * macosx/ttkMacOSXTheme.c: used 8.6/carbon variant - * tests/ttk/combobox.test, tests/ttk/treetags.test: - * tests/ttk/treeview.test, tests/ttk/ttk.test: - * tests/ttk/vsapi.test: - * tests/ttk/checkbutton.test (new): - * tests/ttk/radiobutton.test (new): - * tests/ttk/spinbox.test (new): - * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: - Major backport of 8.6 Ttk for 8.5.9. Most changes were only being - committed to head (8.6), although they could apply for 8.5 as well. - This re-sync makes future work easier to maintain and adds some - useful work for 8.5 users. [Bug 3053320]: Notable changes: - - Lots of code cleanup - - Some bug fixes never backported - - Addition of ttk::spinbox - - minor color changes - - Improved Vista/7 styling - - Move to tile version 0.8.6 (pseudo-package) - - ABI and API compatible (even $w identify) - - minor new features (extended $w identify) - -2010-08-03 Don Porter <dgp@users.sourceforge.net> - - * changes: Updated for 8.5.9 release. - -2010-08-20 Donal K. Fellows <dkf@users.sf.net> - - * doc/listbox.n (SEE ALSO): [Bug 3048809]: Corrected what other page - was referred to (ttk::treeview can work as a listbox). - -2010-08-12 Donal K. Fellows <dkf@users.sf.net> - - * library/text.tcl (TextCursorInSelection): [Patch 2585265]: Backport - of factoring-out of decision logic for whether to delete the selected - text. + * win/configure, win/configure.in, win/tcl.m4: SC_EMBED_MANIFEST macro + and --enable-embedded-manifest configure arg added to support manifest + embedding where we know the magic. Help prevents DLL hell with MSVC8+. + + * generic/tkText.c (DumpLine): [Bug 3053347]: Replace segPtr->size + with currentSize throughout, but particularly in if lineChanged block + where segPtr may no longer be valid. + +2010-08-21 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tk*Decls.h: (regenerated with modified genStubs.tcl) + * generic/tk*StubInit.c + +2010-08-18 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/ttk/ttkGenStubs.tcl: [Patch 3034251]: partly: remove some + more unneeded ifdeffery, as in tcl/tools/genStubs.tcl. + * generic/tk.h: Move USE_OLD_IMAGE support after tkDecls.h + * generic/*Decls.h (regenerated) + * generic/ttk/ttkDecls.h 2010-08-11 Jeff Hobbs <jeffh@ActiveState.com> - * win/Makefile.in (%.${OBJEXT}): better implicit rules support + * win/Makefile.in (%.${OBJEXT}): Better implicit rules support * unix/configure: regen with ac-2.59 * unix/configure.in, unix/Makefile.in: - * unix/tcl.m4 (AIX): remove the need for ldAIX, replace with + * unix/tcl.m4 (AIX): Remove the need for ldAIX, replace with -bexpall/-brtl. Remove TK_EXP_FILE (export file) and other baggage that went with it. Remove pre-4 AIX build support. -2010-08-11 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkCanvLine.c (LineDeleteCoords): [Bug 2900121]: Backport of - fix to sense of test. - -2010-08-10 Don Porter <dgp@users.sourceforge.net> +2010-08-11 Don Porter <dgp@users.sourceforge.net> - * library/msgs/pl.msg: Backport updates to pl.msg from HEAD + * changes: Updates for 8.6b2 release. 2010-08-04 Jeff Hobbs <jeffh@ActiveState.com> - * license.terms: Fix DFARs note for number-adjusted rights clause - -2010-08-04 Don Porter <dgp@users.sourceforge.net> - - * generic/tk.h: Bump to 8.5.9 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - * README: - - * unix/configure: autoconf-2.59 - * win/configure: - - * changes: Updated for 8.5.9 release. + * license.terms: fix DFARs note for number-adjusted rights clause 2010-08-03 Jeff Hobbs <jeffh@ActiveState.com> * library/button.tcl (::tk::CheckEnter): [AS Bug#87409]: Use uplevel set instead of set :: to work with other var resolvers (itcl). -2010-08-03 Don Porter <dgp@users.sourceforge.net> +2010-07-19 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgGIF.c (StringWriteGIF): Added ability to write a GIF to + a string (as a byte array, of course) following comments on c.l.t by + Aric Bills. Also improved readability of some of the function and + field names in this file. - * changes: Updated for 8.5.9 release. +2010-07-16 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkDecls.h: [Tcl Bug 3029891]: Functions that don't belong in + the stub table (Tk part, not really removed from the stub table, just + disabled) + * generic/tkMain.c: [Bug 3027438]: Tk_Main calls Tcl_CreateInterp + * generic/tk.h: before Tcl_FindExecutable 2010-07-06 Andreas Kupries <andreask@activestate.com> * doc/text.n: Fixed minor typo in the description of 'text delete', as reported by <eee@users.sf.net> on the chat. -2010-05-31 Joe English <jenglish@users.sourceforge.net> +2010-07-01 Jan Nijtmans <nijtmans@users.sf.net> + + * win/rules.vc: [Bug 3020677]: wish can't link reg1.2 + +2010-06-22 Anton Kovalenko <a_kovalenko@users.sf.net> + + * generic/tkPlace.c: [Patch 3019624]: modify "place" command, making + it get main window through ClientData (like grid or pack do), instead + of calling Tk_MainWindow(interp). + * generic/tkWindow.c: modify "place" entry in commands[], turn on + passMainWindow flag. + +2010-06-22 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/ttk/ttkGenStubs.tcl: [Bug 3019363]: "make genstubs" failure + * generic/ttk/ttkDecls.h: (regenerated) + * generic/ttk/ttkTheme.c: Unnecessary type cast + +2010-06-21 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkInt.decls: [Patch 2999889]: TkCopyAndGlobalEval obsolete + * generic/tkIntDecls.h + * generic/tkBind.c + * generic/tkStubInit.c + +2010-06-19 Joe English <jenglish@users.sourceforge.net> + + * win/tkWinScrlbr.c, carbon/tkMacOSXScrlbr.c: Replace binding + procedures with ordinary event handlers [Patch 3009998]. + * generic/tkBind.c, generic/tk.h, generic/tkInt.h, + * generic/tkInt.decls: Simplifications enabled by previous change: + TkCreateBindingProcedure() and associated machinery no longer needed; + TkBindDeadWindow() no longer needed; TK_DEFER_MODAL_LOOP and + associated machinery no longer needed. + * generic/tkTest.c, tests/bind.test: Tests related to C binding + procedures no longer needed. + * generic/tkWindow.c: TkBindDeadWindow() no longer needed. + * generic/tkIntDecls.h, generic/tkStubInit.c: Regenerated. + +2010-06-15 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/ttk.tcl: Bump dummy [package ifneeded tile] version to + 0.8.6; see [Bug 3016598]. + +2010-06-15 Donal K. Fellows <dkf@users.sf.net> + + * library/text.tcl (TextCursorInSelection): [Patch 2585265]: Make it + so that pressing delete or backspace when the primary selection does + not include the insertion cursor does not cause the deletion of the + inserted text. + +2010-06-15 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkCanvArc.c: Eliminate many unnecessary (ClientData) type + * generic/tkCanvas.c: casts. + * generic/tkCanvBmap.c: + * generic/tkCanvImg.c: + * generic/tkCanvLine.c: + * generic/tkCanvPoly.c: + * generic/tkCanvTest.c: + * generic/tkCanvWind.c: + * generic/tkRectOval.c: + * generic/tkScrollbar.c: + * generic/tkStyle.c: + * generic/tkTest.c: + * unix/tkUnixEmbed.c: + * unix/tkUnixEvent.c: + * unix/tkUnixScale.c: + * unix/tkUnixScrlbr.c: + * unix/tkUnixSelect.c: + * unix/tkUnixWm.c: + * carbon/tkMacOSXDialog.c: Terminate TkEnsemble definition with NULL + * macosx/tkMacOSXDialog.c: + +2010-05-31 Joe English <jenglish@users.sourceforge.net> * generic/tkBind.c (Tk_CreateBinding): [Bug 3006842]: Silently ignore - empty binding scripts. - * generic/ttk/ttkTreeview.c: [$tv tag bind $tag <...> {}] now removes - binding. + empty scripts. + +2010-05-27 Joe English <jenglish@users.sourceforge.net> -2010-05-31 Jan Nijtmans <nijtmans@users.sf.net> + * generic/ttk/ttkTreeview.c, tests/ttk/treeview.test: + [$tv tag bind $tag <...> {}] now removes binding completely. + Fixes [Bug 3006842] (although there's still a problem somewhere + in Tk_CreateBinding()). - * generic/tkMain.c: Fix CYGWIN warning: "fd_set and assiciated.macros - have been defined in sys/types. This may cause runtime problems with - W32" - * win/winMain.c: Add command line processing for CYGWIN, backported - from trunk. +2010-05-26 Jan Nijtmans <nijtmans@users.sf.net> + + * tests/wm.test: Fix 3 tests on Ubuntu 10.4, two of them timing + dependent, one wm-dependent. + * generic/tkText.c: Fix some gcc strict-aliasing warnings, + * unix/tkUnixFont.c: discovered with "-Wstrict-aliasing=2" + * unix/tkUnixSelect.c: 2010-05-20 Donal K. Fellows <dkf@users.sf.net> @@ -1106,15 +1493,54 @@ a better first place to look now. places that generate key events zero them out first; Tk relies on that being true for the generic parts of the fix for Bug 1924761. -2010-05-19 Jan Nijtmans <nijtmans@users.sf.net> +2010-05-17 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinDialog.c: Fix [Bug 3002230]: tk_chooseDirectory returns + garbage on cancel - * win/tkWinDialog.c: [Bug 3002230]: tk_chooseDirectory returns garbage - on cancel. +2010-05-17 Joe English <jenglish@users.sourceforge.net> + + * generic/tkBind.c: Revert [Patch 2999920], as it entails an + incompatible change to the C API is and is the cause of [Bug 3002768]. 2010-05-17 Jan Nijtmans <nijtmans@users.sf.net> + * generic/tkBind.c: [Patch 2999920]: Optimize Internal Virtual event + string operations. * win/tkWinDialog.c: [Bug 2987995]: Tk_getOpenFile returns garbage - under described circumstances. Backported some formatting from trunk. + under described circumstances + +2010-05-11 Jan Nijtmans <nijtmans@users.sf.net> + + * doc/RestrictEv.3: Consistent use of variable names in RestrictEvent + * generic/tkGrab.c: API documentation and implementation: Use 'prev' + * unix/tkUnixDraw.c: instead of 'old', and 'arg' instead of + * unix/tkUnixSend.c: 'clientData' everywhere, just as in tkEvent.c. + * unix/tkUnixWm.c + +2010-05-10 Jan Nijtmans <nijtmans@users.sf.net> + + * doc/BindTable.3: Bring in line with actual implementation. + * generic/tk.decls: Change Tk_CreateBinding param name, as in doc + * generic/tkInt.decls: CONSTify TkCopyAndGlobalEval, + * generic/tkBind.c: TkpSetMainMenubar, TkpMenuNotifyToplevelCreate, + * generic/tkMenu.c: and TkSetWindowMenuBar + * generic/tkDecls.h: (regenerated) + * generic/tkIntDecls.h: (regenerated) + * carbon/tkMacOSXMenu.c: + * macosx/tkMacOSXMenu.c: + * unix/tkUnixMenu.c: + * win/tkWinMenu.c: + +2010-05-03 Don Porter <dgp@users.sourceforge.net> + + * generic/tk.h: Bump patchlevel to 8.6b1.2 to distinguish + * library/tk.tcl: CVS snapshots from earlier snapshots as well + * unix/configure.in: as the 8.6b1 and 8.6b2 releases. + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: 2010-05-03 Donal K. Fellows <dkf@users.sf.net> @@ -1122,49 +1548,214 @@ a better first place to look now. Apply a bit more care to ensure that things continue to work correctly even when there is no -selectcolor defined. +2010-04-29 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWin.h: Unnecessary TCL_STORAGE_CLASS re-definition + * win/tkWinInt.h: Make various functions MODULE_SCOPE + * win/tkWinButton.c: TCHAR-related fixes, making al those + * win/tkWinFont.c: files compile fine when TCHAR != char. + * win/tkWinScrlbr.c: + * win/tkWinWindow.c: + * win/tkWinWm.c: + * win/tkWinX.c: + * win/ttkWinMonitor.c: + * win/ttkWinXPTheme.c: + +2010-04-25 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgPNG.c (ReadIDAT, DecodePNG): Move the check for overall + termination of the compressed stream until after the final IDAT has + been read, so that multi-segment images will work right. Reported by + Andy Goth on the Wiki. + +2010-04-23 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkImgGIF.c: Formatting + * generic/tkListbox.c: fix typo; + * generic/tkTrig.c: fix typo; + * generic/tkInt.h: fix typo; remove not existing tkDisplayList; + * generic/*.h: Useless re-definitions of TCL_STORAGE_CLASS + +2010-04-20 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkPort.h: Make sure that tkWinPort.h is always + * generic/tkIntXlibDecls.h: included before tcl.h, otherwise the + * win/tkWinPort.h: fallback for TCHAR might go off before the + inclusion of <tchar.h> + * win/tkWinDialog.c: Define OPENFILENAME_SIZE_VERSION_400 if + needed. + * compat/stdlib.h: Include <tcl.h> only when not already + * compat/unistd.h: done. + * generic/tkInt.h: tkPort.h already includes tk.h, which + includes tcl.h. + * generic/tk3d.h: Always use #include "tkInt.h", not + * generic/tkColor.h: <tkInt.h> + * xlib/xcolors.c: + * xlib/xgc.c: + 2010-04-19 Jan Nijtmans <nijtmans@users.sf.net> - * win/tkWinPort.h: Fix [Patch 2986105]: conditionally defining - strcasecmp/strncasecmp * win/tkWinDialog.c: Fix [Bug 2987995]: Tk_GetOpenFile returns garbage - under described circumstances, minor formatting. + under described circumstances. * win/tkWinDialog.c: [Patch 2898255]: Filenames limit with Tk_GetFileName(). Assure modern style dialogs where available +2010-04-13 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinPort.h Fix [Patch 2986105]: conditionally defining + strcasecmp/strncasecmp + +2010-04-12 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgPNG.c (WriteIDAT): [Bug 2984787]: Use the correct + flushing semantics when handling the last data from the image. Without + this, many PNG readers (notably including Firefox) refuse to show the + image and instead complain about errors. + (ReadIDAT): Added sanity checks to ensure that when we've got bad data + of the sorts of forms we were previously generating, we detect it and + error out rather than silently failing. + (WriteExtraChunks): New function to write in some basic metadata. + +2010-04-09 Jan Nijtmans <nijtmans@users.sf.net> + + * doc/photo.n: Follow-up to [Bug 2983824]: update doc. + +2010-04-09 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgPhoto.c (ImgPhotoCmd): [Bug 2983824]: Use the file + extension to guess the output format to use if one isn't specified. + +2010-04-08 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinPort.h: Add <wchar.h> to tkWinPort.h, and + * win/tkWinSend.c: remove some earlier CYGWIN-related + * win/tkWinSendCom.c: hacks which are no longer necessary. + +2010-04-06 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tcl.m4: Sync with Tcl version + * unix/tcl.m4: + * win/configure: (regenerate with autoconf-2.59) + * unix/configure: [Bug 2982540]: configure and install* script + files should always have LF + +2010-03-29 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: Only test for -visibility=hidden with gcc + (Second remark in [Bug 2976508]) + * unix/configure: regen + +2010-03-29 Donal K. Fellows <dkf@users.sf.net> + + * unix/tkUnixRFont.c (GetFont): [Bug 2978410]: Do not use non-constant + initializers for structures, since HP-UX cc doesn't like it. + +2010-03-28 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTagSet.c, generic/ttk/ttkTheme.c, + * generic/ttk/ttkTheme.h, generic/ttk/ttkTreeview.c, + * generic/ttk/ttkWidget.h, doc/ttk_treeview.n, + * tests/ttk/treetags.test: ttk::treeview widget: add 'tag names', + 'tag add', and 'tag remove' methods. + +2010-03-23 Donal K. Fellows <dkf@users.sf.net> + + * unix/configure.in, unix/Makefile.in: [Bug 2965133]: Get rid of the + spurious NONE and some pointless quotes that were causing problems + with building Tk on OSX. Overall bug might not yet be solved. + +2010-03-17 Donal K. Fellows <dkf@users.sf.net> + + * library/entry.tcl: [Bug 2971663]: Make the <Up> and <Down> keys + * library/ttk/entry.tcl: explicitly do nothing, since Tk-on-Cocoa will + generate (invisible zero-width) characters for them otherwise. The + explicitly empty bindings are harmless on other platforms. + +2010-03-16 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/.cvsignore: Ignore .a and .so + 2010-03-12 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkButton.h: [Bug 2956548]: TkpButtonSetDefaults only - * generic/tkButton.c: initializes one button type - * win/tkWinButton.c: - * win/tkWinEmbed.c: Fix various gcc warnings, all - * win/tkWinMenu.c: backported from Tk 8.6 - * win/tkWinPixmap.c: - * win/tkWinSend.c: - * win/tkWinTest.c: - * win/tkWinWm.c: - * win/tkWinX.c: - * win/tkWinInt.h: VC6++ does not have SPI_SETKEYBOARDCUES + * win/rules.vc: Fix [Tcl Bug 2967340]: Static build failure + * win/makefile.vc: * win/.cvsignore: +2010-03-12 Donal K. Fellows <dkf@users.sf.net> + + * library/iconlist.tcl: Factor out some of the machinery for + * library/megawidget.tcl: making a megawidget framework. Not a + public API at the moment. + 2010-03-11 Donal K. Fellows <dkf@users.sf.net> * generic/tkText.c (DumpLine): [Bug 2968379]: When peers are about, there can be unnamed marks present during a dump. Ignore them as they will just be for the peers' insert and current marks, which aren't very important. + (DumpLine): Removed lame reliance on the leading letters of the names + of segment types. Entailed expanding the scope of the declarations of + the types of embedded images and windows. + +2010-03-08 Don Porter <dgp@users.sourceforge.net> + + * generic/tkPlatDecls.h: [Bug 2965600]: Correct broken 2886635 fix. + +2010-03-06 Pat Thoyts <patthoyts@users.sourceforge.net> + + * library/menu.tcl: [Bug 2949774]: When using the non-ClickToFocus + menu mode cascade menus should popdown once the pointer moves to + another entry to be compatible with current X desktop usage. + +2010-03-04 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/configure.in: Don't use -fvisibility=hidden + * unix/tcl.m4: for cygwin. + * win/tkWinTest.c: Make tkTestWinProcs const 2010-03-04 Donal K. Fellows <dkf@users.sf.net> * doc/clipboard.n: Added note about STRING vs. UTF8_STRING types. +2010-03-02 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: [Tcl FRQ 2959069]: Support for -fvisibility=hidden + * unix/configure: (regenerated with autoconf-2.59) + +2010-02-23 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/configure.in: Use @EXEEXT@ in stead of @EXT_SUFFIX@ + * unix/tcl.m4: + * unix/Makefile.in: Use -DBUILD_tk + * unix/configure: (regenerated) + * generic/tkConfig.c: Make internal Tk_ObjCustomOption const + * generic/tkPanedWindow.c: + * generic/tkTest.c: + * generic/tkText.c: + 2010-02-21 Donal K. Fellows <dkf@users.sf.net> * generic/tkText.c (TextEditCmd): [Bug 1799782]: Refix this, so that - <<Modified>> events are issued when things change. + <<Modified>> events are issued when things change. + +2010-02-20 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTreeview.c: Cache the result of the last call to + EndPosition() to avoid quadratic-time behavior in the common cases + where the treeview is populated in depth-first or breadth-first + order. + +2010-02-19 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinColor.c: remove unused "dataKey" variable 2010-02-19 Donal K. Fellows <dkf@users.sf.net> + * unix/configure.in, unix/Makefile.in: [Bug 2415437]: Corrections to + allow installation of Tcl and Tk to different directories, especially + when neither is a system standard location. Also [Tcl Bug 2307398]. + * unix/installManPage: [Tcl Bug 2954638]: Correct behaviour of manual page installer. Also added armouring to check that assumptions about the initial state are actually valid (e.g., look for existing input @@ -1176,62 +1767,280 @@ a better first place to look now. OpenBSD. * configure: (regenerated). +2010-02-18 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkButton.h: Put all Tk_OptionSpec for buttons and labels + * generic/tkButton.c: in const memory. With some changes to win32 + * win/tkWinButton.c: and macosx, preventing direct writes to + * unix/tkUnixPort.h: read-only memory. + * carbon/tkMacOSXPort.h: + * macosx/tkMacOSXButton.c: + 2010-02-17 Joe English <jenglish@users.sourceforge.net> * generic/tkMenu.c: [Bug 2952745]: Defer TkMenuOptionTables cleanup to CallWhenDeleted() time, to ensure that the record doesn't get freed until after all widget instance commands have been deleted. +2010-02-17 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tk.decls: CONSTify everything related to Tk_ConfigSpec + * generic/tk.h: + * generic/tkCanvArc.c: Many tables can now be put in const memory + * generic/tkCanvas.c: + * generic/tkCanvBmap.c: + * generic/tkCanvImg.c: + * generic/tkCanvLine.c: + * generic/tkCanvPoly.c: + * generic/tkCanvPs.c: + * generic/tkCanvText.c: + * generic/tkCanvWind.c: + * generic/tkImgBmap.c: + * generic/tkImgPhoto.c: + * generic/tkOldConfig.c: + * generic/tkRectOval.c: + * generic/tkScrollbar.c: + * generic/tkScrollbar.h: + * generic/tkDecls.h: (regenerated) + * doc/CanvTkwin.3: + * doc/ConfigWidg.3: + * doc/CrtItemType.3: + * win/tkWinScrlbr.c: + * carbon/tkMacOSXScrlbr.c: + * macosx/tkMacOSXScrlbr.c: + 2010-02-16 Jan Nijtmans <nijtmans@users.sf.net> - * unix/tkUnixWm.c: Make TkSetTransientFor static + * generic/tkWindow.c: Reverted rename from tkStubs to tkConstStubs + * generic/tkStubInit.c: (regenerated) + * generic/tkArgv.c: make defaultTable const + * generic/tkScrollbar.c:Store default for "-with" in static non-const + space + * win/tkWinInt.h: Make tkWinProcs const, and 5 procs + * win/tkWinX.c: MODULE_SCOPE. + * win/tkWinColor.c: Make sysColors const. + * win/tkWinKey.c: Make keymap const. + * win/tkWinScrlbr.c: Simplify copying of "-with" default value. + * unix/tkUnixWm.c: Make TkSetTransientFor static. + * tests/textImage.test: textImage-1.13 depends on hash-order + +2010-02-12 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tcl.m4: Use -pipe for gcc on win32 + * win/configure: (mingw/cygwin) (regenerated) + * unix/tkUnixColor.c: Make sure that TkpCmapStressed is exported + * generic/tkImgPhoto.c: Clean up unused Tk_CreatePhotoOption + * generic/tkBind.c: Make more internal arrays "const" + * generic/tkBusy.c: + * generic/tkButton.c: + * generic/tkEvent.c: + * generic/tkGrab.c: + * generic/tkImgBmap.c: + * generic/tkObj.c: + * generic/tkOption.c: + * generic/tkPanedWindow.c: + * generic/tkPointer.c: + * generic/tkWindow.c: + * generic/tkImgPhoto.c: Eliminate never used Tk_CreatePhotoOption() -2010-02-07 Jan Nijtmans <nijtmans@users.sf.net> +2010-02-05 Jan Nijtmans <nijtmans@users.sf.net> - * generic/ttk/ttkGenStubs.tcl: Backport various formatting (spacing) - * generic/ttk/ttk.decls: changes from HEAD, so diffing - * generic/ttk/ttkDecls.h: between 8.5.x and 8.6 shows the - * generic/tk*.decls: real structural differences again. - * generic/tk*Decls.h: (any signature change not backported!) + * carbon/tkMacOSXDialog.c: Make more internal tables "const" + * macosx/tkMacOSXDialog.c: + * unix/tkUnixButton.c: + * unix/tkUnixWm.c: + * win/tkWinDialog.c: + * generic/tkWindow.c: + * generic/tk*Decls.h: (regenerated with new + * generic/tkStubInit.c: genStubs.tcl from Tcl) + +2010-02-05 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/*.[ch]: Revert contravariant const qualifiers added by + the previous commit to keep codebase in sync with the Tile extension, + which must remain 8.4 compatible. + +2010-02-05 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/ttk/ttkGenStubs.tcl: Follow-up to [2010-01-29] commit: + prevent space within stub table function parameters if the + parameter type is a pointer. Make the various stub tables and + hook pointers const, just as Tcl and Tk. + * generic/ttk/ttkDecls.h: (regenerated) + * generic/ttk/ttkStubInit.c: (regenerated) + * generic/ttk/ttk.decls: Minor formatting + * generic/ttk/ttkButton.c: Make more internal tables "const" + * generic/ttk/ttkDefaultTheme.c: + * generic/ttk/ttkEntry.c: + * generic/ttk/ttkImage.c: + * generic/ttk/ttkInit.c: + * generic/ttk/ttkLayout.c: + * generic/ttk/ttkNotebook.c: + * generic/ttk/ttkPanedWindow.c: + * generic/ttk/ttkProgress.c: + * generic/ttk/ttkStubLib.c: + * generic/ttk/ttkTheme.c: + * generic/ttk/ttkTreeview.c: + * generic/ttk/ttkWidget.c: + * generic/ttk/ttkWidget.h: + +2010-01-31 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTheme.h, generic/ttk/ttkWidget.h, generic/ttk/*.c: + Change signature of widget subcommand procedures to match + Tcl_ObjCmdProc. Merge now-redundant ensemble dispatch code. 2010-01-29 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkBind.c: Fix various gcc-4.4 warnings, all - * generic/tkListbox.c: backported from HEAD. - * generic/tkText.c: + * generic/ttk/ttkGenStubs.tcl: No longer generate a space after "*" + and immediately after a function name, so the + format of function definitions in *Decls.h + match all other *.h header files. + * generic/ttk/ttkDecls.h: (re-generated) + * generic/tk.decls: Formatting + * generic/tkDecls.h: (re-generated) + * generic/tkIntDecls.h: + * generic/tkIntPlatDecls.h: + * generic/tkIntXlibDecls.h: + * generic/tkPlatDecls.h: + * generic/tkBind.c: Little simplification + +2010-01-19 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkInt.h: Don't depend on <stdio.h> from tcl.h any + * generic/tkOldConfig.c: more. + * generic/ttk/ttkClamTheme.c: Fix more gcc warnings: missing + * generic/ttk/ttkClassicTheme.c: initializer. + * generic/ttk/ttkDefaultTheme.c: + * generic/ttk/ttkElements.c: + * generic/ttk/ttkEntry.c: * generic/ttk/ttkInit.c: + * generic/ttk/ttkLabel.c: + * generic/ttk/ttkNotebook.c: + * generic/ttk/ttkPanedwindow.c: + * generic/ttk/ttkSquare.c: + * generic/ttk/ttkTreeview.c: + * win/ttkWinTheme.c: + * win/tkWinMenu.c: Add missing #include <string.h> + * win/tkWinPort.h: Fix include files for CYGWIN + * win/tkWinSend.c: + * win/tkWinSendCom.c: + * win/tkWinTest.c: Fix gcc warning + * win/winMain.c: Eliminate use of __argc and __argv for CYGWIN + * win/tcl.m4: Make cygwin configuration error into + * win/configure.in: a warning: CYGWIN compilation works + * win/configure: although there still are test failures. + +2010-01-19 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkCanvas.c (TagSearchScanExpr): [Bug 2931374]: Stop overflow + of working buffer during construction of long tag expressions. -2010-01-20 Pat Thoyts <patthoyts@users.sourceforge.net> +2010-01-19 Pat Thoyts <patthoyts@users.sourceforge.net> - * library/bgerror.tcl: [TIP 359]: Extended Window Manager Hints - * library/clrpick.tcl: following the freedesktop.org specification - * library/demos/widget: are now supported on X11 using a new - * library/dialog.tcl: wm attribute called '-type' - * library/msgbox.tcl: This feature is now used in the Tk library - * library/tkfbox.tcl: functions where appropriate. + TIP #359 IMPLEMENTATION + + * library/bgerror.tcl: Extended Window Manager Hints following the + * library/clrpick.tcl: freedesktop.org specification are now + * library/demos/widget: supported on X11 using a new [wm attribute] + * library/dialog.tcl: called '-type'. This feature is now used in + * library/msgbox.tcl: the Tk library functions where appropriate. + * library/tkfbox.tcl: * library/ttk/combobox.tcl: * tests/unixWm.test: * tests/wm.test: * unix/tkUnixWm.c: -2010-01-19 Donal K. Fellows <dkf@users.sf.net> +2010-01-18 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkCanvas.c (TagSearchScanExpr): [Bug 2931374]: Stop overflow - of working buffer during construction of long tag expressions. + * generic/tkCanvArc.c: Fix more gcc warnings: missing initializer + * generic/tkCanvBmap.c: + * generic/tkCanvImg.c: + * generic/tkCanvLine.c: + * generic/tkCanvPoly.c: + * generic/tkCanvPs.c: + * generic/tkCanvText.c: + * generic/tkCanvWind.c: + * generic/tkCmds.c: + * generic/tkImgBmap.c: + * generic/tkImgGIF.c: + * generic/tkImgPhoto.c: + * generic/tkImgPNG.c: + * generic/tkImgPPM.c: + * generic/tkMenu.c: + * generic/tkMenubutton.c: + * generic/tkMessage.c: + * generic/tkOldTest.c: + * generic/tkPanedWindow.c: + * generic/tkRectOval.c: + * generic/tkScrollbar.c: + * generic/tkSquare.c: + * generic/tkTest.c: + * generic/tkText.c: + * generic/tkTextImage.c: + * generic/tkTextTag.c: + * generic/tkTextWind.c: + * generic/tkTrig.c: + * generic/tkCanvas.c: [Patch 2932808]: Canvas items not updating + on widget state change. + +2010-01-13 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkMenubutton.h: Eliminate tkpMenubuttonClass + * generic/tkButton.h make tkpButtonProcs CONST + * generic/tkBusy.c: fix gcc warning: missing initializer + * generic/tkButton.c + * generic/tkCanvas.c + * generic/tkConsole.c + * generic/tkEntry.c + * generic/tkFrame.c + * generic/tkListbox.c + * generic/tkMenu.c + * generic/tkMenubutton.c + * generic/tkMessage.c + * generic/tkScale.c + * generic/tkScrollbar.h + * generic/tkText.c + * generic/ttk/ttkWidget.c + * carbon/tkMacOSXButton.c + * carbon/tkMacOSXMenubutton.c + * carbon/tkMacOSXScrlbr.c + * macosx/tkMacOSXButton.c + * macosx/tkMacOSXMenubutton.c + * macosx/tkMacOSXScrlbr.c + * unix/tkUnixButton.c + * unix/tkUnixMenubu.c + * unix/tkUnixScrolbr.c + * win/tkWinButton.c + * win/tkWinDialog.c + * win/tkWinEmbed.c + * win/tkWinFont.c + * win/tkWinInit.c + * win/tkWinKey.c + * win/tkWinScrlbr.c + * win/tkWinInt.h Add SPI_SETKEYBOARDCUES definition, needed for + original VC++ 6.0. -2010-01-18 Jan Nijtmans <nijtmans@users.sf.net> +2010-01-10 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkCanvas.c: [Patch 2932808]: Canvas items not - updating on widget state change. + * doc/SetClassProcs.3: CONSTify Tk_SetClassProcs + * generic/tk.decls + * generic/tkInt.h + * generic/tkWindow.c + * generic/tkDecls.h: (regenerated) + * unix/tcl.m4 Sync with Tcl version + * unix/configure (regenerated) 2010-01-09 Pat Thoyts <patthoyts@users.sourceforge.net> - * doc/menu.n: [TIP 360]: Remove special handling of - * library/obsolete.tcl: the .help menu on X11. + TIP #360 IMPLEMENTATION + + * doc/menu.n: Remove special handling of the .help menu on + * library/obsolete.tcl: X11. * unix/tkUnixMenu.c: - * library/menu.tcl: [TIP 360]: Make Tk menu activation - * library/obsolete.tcl: follow mouse movements. + * library/menu.tcl: Make Tk menu activation follow mouse + * library/obsolete.tcl: movements. 2010-01-08 Pat Thoyts <patthoyts@users.sourceforge.net> @@ -1245,26 +2054,32 @@ a better first place to look now. odd text widget update problem that had scrollbars being unable to cover the whole widget. Fix is to reify the range to update sooner. -2010-01-06 Jan Nijtmans <nijtmans@users.sf.net> - - * unix/tcl.m4: Sync with Tcl version - * unix/configure: (regenerated) - * unix/Makefile.in: - * unix/.cvsignore: - * generic/default.h: Trivial CYGWIN fixes - * generic/tkWindow.c: - * doc/.cvsignore: - 2010-01-06 Donal K. Fellows <dkf@users.sf.net> + * library/tk.tcl: Centralize the definition of keys that + * library/entry.tcl: do common movement in entry and text + * library/spinbox.tcl: widgets. This is because they are + * library/text.tcl: subtlely different on the different + * library/ttk/entry.tcl: platforms. Lets Tk code work more + * doc/event.n (PREDEFINED VIRTUAL EVENTS): correctly with platform + conventions "out of the box". + + * generic/tkBind.c (HandleEventGenerate, DoWarp): [Bug 2926819]: + * generic/tkInt.h (TkDisplay): Factor out the pointer + * generic/tkWindow.c (GetScreen): warping code a bit + * carbon/tkMacOSXMouseEvent.c (TkpWarpPointer): better and extend it + * macosx/tkMacOSXMouseEvent.c (TkpWarpPointer): to work on OSX too. + * unix/tkUnixEvent.c (TkpWarpPointer): + * win/tkWinPointer.c (TkpWarpPointer): + * unix/tkUnixWm.c (TkWmMapWindow): [Bug 1163496]: Allow windows to be * tests/wm.test (wm-transient-8.1): set to be transients for withdrawn masters correctly. 2010-01-05 Pat Thoyts <patthoyts@users.sourceforge.net> - * win/tkWinDialog.c: [Patch 2898255]: Enable unlimited multiple - file selection from the open files dialog (pawlak,fellows,thoyts) + * win/tkWinDialog.c: [Patch 2898255]: Enable unlimited multiple file + selection from the open files dialog. (pawlak,fellows,thoyts) 2010-01-05 Donal K. Fellows <dkf@users.sf.net> @@ -1272,25 +2087,53 @@ a better first place to look now. menu entries if the first index to delete is explicitly after the last index of existing entries. + * generic/tkFont.h (ROUND16): [Bug 2824916]: Use a correct rounding + * unix/tkUnixFont.c (TkpDrawAngledChars): macro for converting a + * unix/tkUnixRFont.c (TkpDrawAngledChars): double to a short. This + * win/tkWinFont.c (GetScreenFont): stops a number of small + visual artefacts from happening and reduces the effect of others. The + ROUND16 macro is now shared across all the font code (though some + platforms do not need it specially). + 2010-01-04 Pat Thoyts <patthoyts@users.sourceforge.net> - * library/dialog.tcl: Backported fix for tk_dialog <Return> binding - * library/console.tcl: Backported fix for console keyboard menu - activation and <<Cut>> handling from HEAD. + * doc/TkInitStubs.3: [Bug 2192104]: Mention USE_TK_STUBS macro. + * library/dialog.tcl: [Bug 2811266]: <Return> binding should invoke + the button with the focus. + * library/fontchooser.tcl: [Bug 2727476]: Fix default size of font + chooser dialog and assigned minimum sizes for the lists. + * library/console.tcl: [Bug 580361]: Fix console <<Cut>> binding. + * library/console.tcl: Fix keyboard access to console menu. + * library/demos/filebox.tcl: Make prettier using ttk. + * library/demos/fontchoose.tcl: Fix display of demo code. * library/tk.tcl: Correctly handle quoted ampersands in AmpMenuArgs +2010-01-03 Donal K. Fellows <dkf@users.sf.net> + + * unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 1636685]: Use the configuration + for modern FreeBSD suggested by the FreeBSD porter. + 2010-01-03 Pat Thoyts <patthoyts@users.sourceforge.net> - * generic/tkMenu.h: [Patch 2848897] Support the system keyboard + * generic/tkMenu.h: [Patch 2848897]: Support the system keyboard * win/tkWinMenu.c: cues option on Windows. This system parameter hides the underlines on menu items unless the keyboard is used to open the menu. (kovalenko, thoyts) +2010-01-03 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkFont.c (Tk_TextLayoutToPostscript): Simplified the code to + * generic/tkCanvPs.c (TkCanvPostscriptCmd): generate the preamble + * library/mkpsenc.tcl: for PS generation and + also simplify the code to output text following the observation that + it effectively only produces ASCII anyway, even when it might have the + option to do otherwise in theory. + 2010-01-03 Pat Thoyts <patthoyts@users.sourceforge.net> - * library/tearoff.tcl: tearoff menus should be transient and use the + * library/tearoff.tcl: Tearoff menus should be transient and use the toolwindow style on Windows. - * tests/menu.test: menu tests using 'tkwait visibility' are unix only + * tests/menu.test: Menu tests using 'tkwait visibility' are unix only. 2010-01-02 Donal K. Fellows <dkf@users.sf.net> @@ -1305,10 +2148,11 @@ a better first place to look now. * generic/tkEvent.c (CleanUpTkEvent): that we do not need to make it * doc/HandleEvent.3 (ARGUMENTS): fresh each time, which causes * doc/QWinEvent.3 (ARGUMENTS): trouble with some input - * macosx/tkMacOSXKeyEvent.c (InitKeyEvent): methods. Also includes the - * win/tkWinX.c (GenerateXEvent): factoring out of some code and - update of documentation to describe the slightly increased constraints - on how Tk_HandleEvent can be used. + * carbon/tkMacOSXKeyEvent.c (InitKeyEvent): methods. Also includes the + * macosx/tkMacOSXKeyEvent.c (tkProcessKeyEvent): factoring out of some + * win/tkWinX.c (GenerateXEvent): code and update of + documentation to describe the slightly increased constraints on + how Tk_HandleEvent can be used. 2010-01-01 Donal K. Fellows <dkf@users.sf.net> @@ -1336,31 +2180,65 @@ a better first place to look now. * win/tkWinMenu.c: [Bug 2879927]: Highlight for cascade items in torn-off menus is incorrect on Windows. +2009-12-25 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/utils.tcl, library/notebook.tcl: [Bugs 2917688,2546779]: + Reworked ActivateTab focus selection logic. + 2009-12-25 Donal K. Fellows <dkf@users.sf.net> * doc/option.n: [Bug 2914943]: Correct the first example. Also define what the format of option patterns is; that's a much less commonly known fact than it used to be. +2009-12-22 Jan Nijtmans <nijtmans@users.sf.net> + + * unix/tcl.m4: Sync with current Tcl version. + * unix/Makefile.in: Use EXE_SUFFIX for Cygwin, and install + libtk8.6.dll in bin directory. + * unix/configure: (regenerated) + 2009-12-22 Joe English <jenglish@users.sourceforge.net> * library/ttk/sizegrip.tcl: [Bug 2912356]: Patch to avoid bizarro behavior under compiz. -2009-12-22 Donal K. Fellows <dkf@users.sf.net> - - * library/tkfbox.tcl (ListInvoke): [Bug 2919205]: Correct ordering of - arguments to tk_messageBox. - 2009-12-20 Donal K. Fellows <dkf@users.sf.net> * unix/tkUnixSend.c (ServerSecure): [Patch 2917663]: Better support for server-interpreted access control addreses. -2009-12-16 Joe English <jenglish@users.sourceforge.net> +2009-12-16 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkListbox.c: Fix gcc warning: ignoring return value of + "strtol", declared with attribute + warn_unused_result. + * unix/tkUnixEvent.c: Fix gcc warning: dereferencing pointer + "xgePtr" does break strict-aliasing rules. + * generic/tkInt.decls: CONSTify return values of TkKeysymToString, + * generic/tkBind.c TkFindStateString, TkpGetString, TkpGetChar, + * generic/tkIntDecls.h which are all not supposed to be modified by + * generic/tkUtil.c the caller. In tkUtil.c this gets rid of a + * carbon/tkMacOSXKeyboard.c dangerous type cast. + * macosx/tkMacOSXKeyboard.c + * unix/tkUnixKey.c + * win/tkWinKey.c + +2009-12-15 Don Porter <dgp@users.sourceforge.net> + + * generic/tkConfig.c: Added another dimension of refCounting to the + * generic/tkInt.c: "option" Tcl_ObjType to improve memory troubles + * generic/tkObj.c: detailed in [Bug 2492179]. Also removed + registration of the "option" Tcl_ObjType. + *** POTENTIAL INCOMPATIBILITY *** for callers of + Tcl_GetObjType("option") which must now handle a NULL return. + +2009-12-15 Donal K. Fellows <dkf@users.sf.net> - * generic/ttk/ttkNotebook.c: Don't call Tk_DeleteOptionTable() - [Bug 2915709], backport fix for [Bug 2496162]. + * library/demos/unicodeout.tcl (usePresentationFormsFor): Split out + the code to decide whether to use presentation forms for clarity, and + add some more languages (though only in natural uncomposed form for + Devanagari script). 2009-12-14 Kevin B. Kenny <kennykb@acm.org> @@ -1373,58 +2251,73 @@ a better first place to look now. 2009-12-02 Jan Nijtmans <nijtmans@users.sf.net> - * win/tkInt.decls: [Bugs 220600, 220690]: Comment that - TkWinChildProc is exported through the stubs table since 8.5.9 + * win/tkInt.decls: [Bugs 220600, 220690]: Comment that TkWinChildProc + is exported through the stubs table since 8.5.9 + +2009-12-11 Jan Nijtmans <nijtmans@users.sf.net> + + * win/makefile.vc: Fix dependancies on ${TKSTUBLIB} when + TCL_USE_STATIC_PACKAGES is defined + * generic/tkWindow.c: Fix gcc warning, using gcc-4.3.4 on cygwin + warning: array subscript has type 'char' 2009-12-11 Donal K. Fellows <dkf@users.sf.net> - * library/tk.tcl (tk::ScreenChanged): [Bug 2912473]: Stop problems + * library/tk.tcl (::tk::ScreenChanged): [Bug 2912473]: Stop problems caused by display names with a double colon in. 2009-12-10 Donal K. Fellows <dkf@users.sf.net> * library/demos/ttkscale.tcl: Added demo of [ttk::scale] widget. -2009-12-09 Andreas Kupries <andreask@activestate.com> - - * library/safetk.tcl (::safe::loadTk): [Bug 2902573]: Fixed access to - the cleanupHook of the safe base. The code used the old internal - commands which have been removed since 2009-12-09. See Tcl's - ChangeLog. - 2009-12-09 Donal K. Fellows <dkf@users.sf.net> * generic/tkColor.c (Tk_GetColorByValue): [Bug 2911570]: Ensure that hash keys of color values are zeroed first, so that they hash properly on 64-bit systems (where X structures are not tightly packed). + * unix/tkUnixWm.c (TkpMakeMenuWindow): Improve the determining of what + * generic/tkMenu.c (ConfigureMenu): EWMH hint to use so that we + distinguish between dropdown menus (children of menubars) and what are + presumably popup menus. + 2009-12-08 Pat Thoyts <patthoyts@users.sourceforge.net> - * unix/tkUnixWm.c: [Bug 2864685]: Backported window manager hinting - update from HEAD + * unix/tkUnixWm.c: [Bug 2864685]: Apply suitable extended window + manager hints to the menus so that modern unix window managers can use + the correct animation modes. -2009-12-06 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> +2009-12-02 Jan Nijtmans <nijtmans@users.sf.net> - * macosx/tkMacOSXFont.c (GetFontFamilyName): [Bug 2548661]: Merge fix - from HEAD (1.44). + * win/configure: (regenerated) + * win/Makefile.in: Use tktest86.dll for all tests. + * win/tkWinInt.h: Mark various functions MODULE_SCOPE + * generic/tkInt.decls: [Bugs 220600, 220690]: Make TkWinChildProc + available in private stub table. + * generic/tkIntPlatDecls.h: (regenerated) + * generic/tkStubInit.c: (regenerated) -2009-12-03 Pat Thoyts <patthoyts@users.sourceforge.net> +2009-11-30 Jan Nijtmans <nijtmans@users.sf.net> - * library/ttk/xpTheme.tcl: Fix selection of treeview rows on - * library/ttk/vistaTheme.tcl: Windows XP and Vista. + * win/Makefile.in: Better dependancies in case of static build. + Generate tktest86.dll and tktest86.lib. -2009-12-02 Jan Nijtmans <nijtmans@users.sf.net> +2009-11-29 Jan Nijtmans <nijtmans@users.sf.net> - * doc/GetHINSTANCE.3: Correct mentioned header file - * win/tkWinInt.h: [Bugs 220600, 220690]: Make TkWinChildProc - * generic/tkInt.decls: available in private stub table. - * generic/tkIntPlatDecls.h: (regenerated) - * generic/tkStubInit.c: (regenerated) + * generic/tkInt.h: Make all internal initialization + * generic/tkTest.c: routines MODULE_SCOPE + * generic/tkOldTest.c: + * generic/tkSquare.c: + * carbon/tkMaxOSXTest.c: + * macosx/tkMaxOSXTest.c: + * win/tkWinTest.c: + * win/tcl.m4: (copied from Tcl 8.6) + * win/configure: (regenerated) -2009-11-25 Stuart Cassoff <stwo@users.sf.net> +2009-11-25 Stuart Cassoff <stwo@users.sf.net> * unix/tcl.m4: [Patch 2892871]: Remove unneeded - * AC_STRUCT_TIMEZONE. + AC_STRUCT_TIMEZONE. * unix/configure: Regenerated with autoconf-2.59. 2009-11-24 Donal K. Fellows <dkf@users.sf.net> @@ -1433,40 +2326,92 @@ a better first place to look now. type for the array of data passed into X. It's wrong, but "right" because of a mistake in the X11 specification. +2009-11-23 Andreas Kupries <andreask@activestate.com> + + * library/safetk.tcl (::safe::loadTk): [Bug 2902573]: Fixed access + to the cleanupHook of the safe base. The code used the old + internal commands which have been removed since 2009-11-05/06. See + Tcl's ChangeLog. + +2009-11-23 Donal K. Fellows <dkf@users.sf.net> + + * unix/Makefile.in: Added .PHONY lines to stop make from getting + confused when someone makes an error in a rule. + 2009-11-22 Pat Thoyts <patthoyts@users.sourceforge.net> * tests/winWm.test: [Bug 2899949]: Make sure the window is still - * win/tkWinWm.c: present when handling delayed activation + * win/tkWinWm.c: present when handling delayed activation. -2009-11-13 Pat Thoyts <patthoyts@users.sourceforge.net> + * win/Makefile.vc: Include tk stubs in the tktest link - * tests/winDialog.test: [Bug 2307837]: Backported fix for running - * win/tkWinTest.c: dialog tests on non-English locales +2009-11-21 Donal K. Fellows <dkf@users.sf.net> -2009-11-12 Don Porter <dgp@users.sourceforge.net> + * generic/tkUtil.c: Remove some anachronistic techniques (pointless + casts, mixed assignments and tests, etc.) - *** 8.5.8 TAGGED FOR RELEASE *** + * generic/tk3d.c, generic/tkBitmap.c, generic/tkColor.c: + * generic/tkCursor.c, generic/tkFont.c, generic/tkTextIndex.c: + [Tcl Bug 2857044]: Corrections following audit of Tcl_ObjType freeing + practises; the typePtr field is now cleared when an object ceases to + be of the type. - * changes: Updated for 8.5.8 release. +2009-11-19 Alexandre Ferrieux <ferrieux@users.sourceforge.net> -2009-11-03 Don Porter <dgp@users.sourceforge.net> + * generic/tkCanvas.c: [Bug 2899685]: Fix the redraw logic of [imove] - * generic/tk.h: Bump to 8.5.8 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - * README: +2009-11-19 Jan Nijtmans <nijtmans@users.sf.net> - * unix/configure: autoconf-2.59 - * win/configure: + * doc/GetHINSTANCE.3: Fix mentioned header file + * generic/tkTest.c: Compile with Stubs + * generic/tkOldTest.c + * generic/tkSquare.c + * win/tcl.m4: Should have been checked in together with the + 2009-08-09 check in of "win/configure" + * win/tkWinTest.c: Don't access tkWinProcs from Tk dll any more + * unix/tcl.m4: [Patch 2883533]: tcl.m4 support for Haiku OS + * unix/configure (regenerated) + * unix/Makefile.in: Fix library order in X11_LIB_SWITCHES + +2009-11-19 Donal K. Fellows <dkf@users.sf.net> - * changes: Updated for 8.5.8 release. + * generic/tkCanvLine.c (LineDeleteCoords): [Bug 2900121]: Get sense of + test for drawing optimization correct. + +2009-11-15 Donal K. Fellows <dkf@users.sf.net> + + * doc/ttk_treeview.n (detach): Added note that the 'move' operation + restores detached nodes. + +2009-11-12 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/button.tcl, library/ttk/combobox.tcl, + * library/ttk/notebook.tcl, library/ttk/treeview.tcl: + [update] hygiene. -2009-11-03 Pat Thoyts <patthoyts@users.sourceforge.net> + + Where possible, replace [a; update; b] with [a ; after 0 b]. + + Where not possible, use [update idletasks] instead of full [update]. + + Use [after 0] in favor of [after idle] for delayed work, to reduce + likelihood of reentrancy issues in [update idletasks]. - * win/tkWinWm.c: [Bug 2891541]: Permit normal behaviour on - Windows for a grabbed toplevel when it is the main window. +2009-11-11 Don Porter <dgp@users.sourceforge.net> + + * generic/tkPlatDecls.h: [Bug 2886635]: Restore C++ + friendliness to the tkPlatDecls.h header file, which we insist + extensions #include to gain access to the Tk_*HWND*() routines. + +2009-11-10 Andreas Kupries <andreask@activestate.com> + + * unix/Makefile.in: Partially reverted Don Porter's 2009-10-20 commit. + The OSX Cocoa code branch still needs tclInt.h and the internal + headers, thus the TCL_PLATFORM directory. See tclMacOSXNotify.c for + example. + +2009-11-09 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkFileFilter.c (TkFreeFileFilters): Simplify the code in + this file by consolidating the deletion code together into a single + function rather than scattering it over four. 2009-11-01 Joe Mistachkin <joe@mistachkin.com> @@ -1475,10 +2420,34 @@ a better first place to look now. allocates storage for the default width from the heap and frees it using an exit handler. +2009-11-01 Joe Mistachkin <joe@mistachkin.com> + + * doc/loadTk.n: Minor fix for htmlhelp target. + +2009-11-01 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkWidget.c, doc/ttk_widget.n: Uniform, extensible + syntax for [$w identify] methods: [$w identify $component $x $y]. All + ttk::* widgets support [$w identify element $x $y]; widgets with other + identifiable parts may have additional subcommands. + * generic/ttk/ttkNotebook.c, doc/ttk_notebook.n: Notebook widgets + support [$nb identify tab]. + * generic/ttk/ttkPanedwindow.c, doc/ttk_panedwindow.n: Panedwindow + widgets support [$w identify sash]. Older 2-argument form [$w + identify $x $y] still supported, though it does different things + depending on the widget. + 2009-10-29 Pat Thoyts <patthoyts@users.sourceforge.net> - * win/tkWinFont.c: [Bug 1825353]: Backported patch for tiny - fixed font on Russian Windows systems. + * win/tkWinFont.c: [Bug 1825353]: This patch reverts a previous + attempt to fix tiny fonts on Russian Windows. It fixes the issue by + requesting a suitable fixed font instead of decoding the system stock + font. + +2009-10-26 Don Porter <dgp@users.sourceforge.net> + + * unix/Makefile.in: Remove $(PACKAGE).* and prototype from the + `make distclean` target. Completes 2009-10-20 commit. 2009-10-25 Donal K. Fellows <dkf@users.sf.net> @@ -1492,10 +2461,6 @@ a better first place to look now. 2009-10-24 Donal K. Fellows <dkf@users.sf.net> - * macosx/ttkMacOSXTheme.c (RangeToFactor, TrackElementDraw) - (PbarElementDraw): [Bug 2883712]: Corrected scaling of progress bars - and scales, and backported the fix for 64-bitness. - * library/button.tcl, unix/tkUnixButton.c (TkpDisplayButton): [Patch 1530276]: Make -selectcolor handling work better for both checkbuttons and radiobuttons when they don't have indicators. @@ -1507,35 +2472,61 @@ a better first place to look now. * generic/tkText.h: [Patch 1469210]: Corrected handling of marking as dirty when inserting after an undo from a non-dirty state. + * win/tkWinDialog.c (GetFileNameA): Make the handling of the filter + index the same as in GetFileNameW. + + * library/tkfbox.tcl (::tk::dialog::file::, Done): * library/xmfbox.tcl (MotifFDialog_FileTypes) (MotifFDialog_ActivateSEnt): - * library/tkfbox.tcl (Done, ::tk::dialog::file::): * macosx/tkMacOSXDialog.c (Tk_GetOpenFileObjCmd): * win/tkWinDialog.c (GetFileNameW, GetFileNameA): * doc/getOpenFile.n: [Patch 2168768]: Corrected handling of the -typevariable option to be consistently global; it's the only way it can work even close to the same on all platforms. -2009-10-15 Don Porter <dgp@users.sourceforge.net> + * macosx/ttkMacOSXTheme.c (RangeToFactor): [Bug 2883712]: Factor out + some common code and make sure that it is 64-bit correct. - * generic/tkConsole.c: Relax the runtime version requirements on Tcl - * generic/tkMain.c: so that Tk 8.5.8 can [load] into Tcl 8.6 (and - * generic/tkWindow.c: later 8.*) interps. [Feature Request 2794032] - * library/tk.tcl - * unix/Makefile.in: - * win/Makefile.in: - * win/makefile.vc: +2009-10-21 Jan Nijtmans <nijtmans@users.sf.net> + + * win/Makefile.in: [Bug 2875562]: Make sure that winMain.c and + * win/winMain.c: tkAppInit.c are never compiled with stubs. + * unix/tkAppInit.c: + +2009-10-20 Don Porter <dgp@users.sourceforge.net> + + * unix/Makefile.in: Compiling Tk no longer requires header files + * win/Makefile.in: from the TCL_PLATFORM DIR. Baby step in + pursuit of [Bug 1712098]. Also removed the long outdated and broken + targets package-* that were for building Solaris packages. Appears + that the pieces needed for these targets to function have never been + present in the current era of Tcl development and belong completely + to Tcl pre-history. + +2009-10-20 Andreas Kupries <andreask@activestate.com> + + * library/msgs/pl.msg: Applied patch to Polish message catalog created + and submitted by Pawel Pawlak <morris@elysium.pl> (via JeffH). + +2009-10-18 Donal K. Fellows <dkf@users.sf.net> + + * doc/menu.n: Reorganized for readability, and added a note describing + some subtleties of the -variable entry configuration option following + some discussion with Joe Mistachkin. 2009-10-10 Donal K. Fellows <dkf@users.sf.net> - * unix/tkUnixRFont.c (InitFont,TkpGetFontFromAttributes,Tk_DrawChars): - [Bug 1961455]: Draw underlines and overstrikes when using Xft for font - rendering. + * unix/tkUnixRFont.c (InitFont, TkpGetFontFromAttributes) + (Tk_DrawChars, TkpDrawAngledChars): [Bug 1961455]: Draw underlines and + overstrikes when using Xft for font rendering. + + * generic/tkFont.c (TkDrawAngledTextLayout): Optimize the zero-angle + case better. 2009-10-08 Donal K. Fellows <dkf@users.sf.net> - * library/tkfbox.tcl (::tk::IconList_Create): [Patch 2870648]: - Corrected cursor used in file/directory dialogs. + * library/iconlist.tcl (Create): [Patch 2870648]: Corrected cursor + used in file/directory dialogs. 2009-10-07 Pat Thoyts <patthoyts@users.sourceforge.net> @@ -1547,20 +2538,29 @@ a better first place to look now. * unix/tkUnixScrlbr.c (TkpComputeScrollbarGeometry): [Patch 2088597]: Stop scrollbars from getting too small at the end. -2009-10-05 Don Porter <dgp@users.sourceforge.net> +2009-10-05 Pat Thoyts <patthoyts@users.sourceforge.net> - * changes: Updated for 8.5.8 release. + * win/tkWinButton.c: [Bug 2860827]: Avoid 3D effects with + user-specified backgrounds. The default disabled text is embossed on + Windows. But this looks poor when a non-default background color is in + use. This patch disables the embossed effect for buttons and labels + when the background is non- standard. -2009-10-05 Pat Thoyts <patthoyts@users.sourceforge.net> +2009-09-30 Pat Thoyts <patthoyts@users.sourceforge.net> - * win/tkWinButton.c: [Bug 2860827]: Backported patch avoiding 3D - effects with user-specified background. + * tests/winWm.test: [Bug 2799589]: Grab on deleted window. 2009-09-25 Donal K. Fellows <dkf@users.sf.net> * generic/tkImgPhoto.c (ImgGetPhoto): Correct generation of grayscale data from an image. Reported by Keith Vetter on comp.lang.tcl. +2009-09-19 Peter Spjuth <peter.spjuth@gmail.com> + + * generic/tkGrid.c: [Bug 2859912]: Bug fix in grid/pack collision + * generic/tkPack.c: detect. Faulty slave was not properly blocked + * tests/packgrid.test: from slave list. + 2009-09-14 Jeff Hobbs <jeffh@ActiveState.com> * generic/tkMenuDraw.c (TkPostSubmenu): [Bug 873613]: Fix reposting of @@ -1569,7 +2569,7 @@ a better first place to look now. (DrawMenuEntryArrow): [Bug 873608]: Draw Win menu arrow after being torn off. -2009-09-10 Donal K. Fellows <dkf@users.sf.net> +2009-09-09 Donal K. Fellows <dkf@users.sf.net> * unix/tkUnixRFont.c (InitFont): Move pattern disposal in error case to callers so they have more options when they come to recovering from @@ -1582,6 +2582,27 @@ a better first place to look now. error beats a crash! (Issue reported on comp.lang.tcl by Denis Berezhnoy.) +2009-09-07 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkFocus.c: Fix potential null dereference flagged by clang + * generic/tkMenu.c: static analyzer. + * generic/tkTextBTree.c: + * generic/tkTextDisp.c: + * generic/tkTextIndex.c: + + * generic/tkConsole.c: Silence false positives from clang static + * generic/tkTest.c: analyzer about potential null dereference. + * generic/tkText.c: + * generic/tkTextBTree.c: + * generic/tkTextTag.c: + * generic/tkVisual.c: + +2009-09-04 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkInt.h (TkDisplay): Remove fields that are never read from. + * generic/tkWindow.c (Tk_DestroyWindow): Remove code to write to + write-only fields of TkDisplay. This follows on from [Bug 2039720]. + 2009-08-25 Donal K. Fellows <dkf@users.sf.net> * unix/tkUnixSend.c (ServerSecure): [Bug 1909931]: Added some support @@ -1594,10 +2615,76 @@ a better first place to look now. 2009-08-24 Daniel Steffen <das@users.sourceforge.net> - * macosx/tkMacOSXHLEvents.c (ScriptHandler): Fix "do script" apple - event handler issues on recent Mac OS X releases by using AE coercion - to 'utf8' for text data and to 'fsrf' for alias data. (Reported by - Youness Alaoui on tcl-mac) + * generic/tkInt.h: Annotate Tcl_Panic as noreturn for clang static + analyzer in PURIFY builds, replacing preprocessor/assert technique. + + * generic/tkBind.c (HandleEventGenerate): Don't generate events for + windows that don't exist yet (fixes TkAqua testsuite crash). + + * macosx/tkMacOSXWindowEvent.c: [Bug 2821084]: Allow WM_DELETE_WINDOW + handlers to prevent window closure by generating WM destroy event + earlier (from window delegate's -windowShouldClose:). + + * macosx/tkMacOSXDraw.c (TkMacOSX{Setup,Restore}DrawingContext): + Disable window flushing during Tk drawing to avoid immediate flush of + NSView-based native widgets on draw. (fixes drawing performance issue + reported by Youness Alaoui on tcl-mac) + + * macosx/tkMacOSXHLEvents.c (ScriptHandler): Fix "do script" apple + * carbon/tkMacOSXHLEvents.c (ScriptHandler): event handler issues + on recent OS X releases by using AE coercion to 'utf8' for text data + and to 'fsrf' for alias data. (reported by Youness Alaoui on tcl-mac) + + * macosx/Wish.sdef (new file): Install and enable sdef file + * macosx/Wish-Info.plist.in: into Wish application bundle, + * macosx/Tk.xcode/project.pbxproj: describing TkAqua apple event + * macosx/Tk.xcodeproj/project.pbxproj: support for use by AppleScript. + * unix/Makefile.in: (replaces functionality of + * unix/configure.in: 'aete' resource removed with + Cocoa port & fixes AppleScript + issues reported on tcl-mac) + * unix/configure: autoconf-2.59 + + * carbon/Wish.xcode/project.pbxproj: Remove references to obsolete + * carbon/Wish.xcodeproj/project.pbxproj: prolog.ps file. + +2009-08-19 Peter Spjuth <peter.spjuth@gmail.com> + + * generic/tk.h + * generic/tkGeometry.c + * generic/tkGrid.c + * generic/tkInt.h + * generic/tkPack.c + * generic/tkWindow.c + * tests/grid.test + * tests/packgrid.test + * tests/textIndex.test: [Patch 2475855]: Give an error if grid and + pack are used in the same master. + +2009-08-14 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDraw.c: Avoid exception in XCopyArea() when copying + from toplevel that has never been mapped. (Reported by Youness Alaoui + on tcl-mac) + + * macosx/tkMacOSXWm.c: Workaround for textured windows being draggable + from opaque content areas. [Bug 2824538] (walzer) + +2009-08-10 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinPixmap.c: Eliminate more gcc warnings + * win/tkWinWm.c: + * win/tkWinTest.c + +2009-08-09 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/ttk/ttkInit.c: Eliminate gcc warning + * generic/tkBind.c + * generic/tkText.c + * generic/tkUtil.c + * win/ttkWinXPTheme.c: Include <vssym32.h> only when available + * win/configure.in: check for vssym32.h, available in newer SDK's + * win/configure: (regenerated) 2009-08-08 Donal K. Fellows <dkf@users.sf.net> @@ -1611,17 +2698,61 @@ a better first place to look now. spaces by restricting what we break on to ASCII spaces, which is good enough for most purposes. +2009-08-02 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tkWinClipboard.c Correct check for winNT + * win/tkWinDialog.c Eliminate many gcc warnings + * win/tkWinImage.c: + * win/tkWinMenu.c: + * win/tkWinWm.c: + * win/tkWinX.c: + * win/ttkWinXPTheme.c: Eliminate msvc warnings + * win/tcl.m4: + * win/configure + * win/.cvsignore: Prevent files from being checked in by accident + 2009-08-01 Donal K. Fellows <dkf@users.sf.net> * unix/tkUnixWm.c (WmIconphotoCmd): [Bug 2830420]: Assemble the image for the window manager in a way that doesn't assume we're on a little- endian system. +2009-07-27 Donal K. Fellows <dkf@users.sf.net> + + * doc/GetScroll.3: Reworded and reordered so as to indicate that the + Tcl_Obj forms are preferred. + +2009-07-26 Donal K. Fellows <dkf@users.sf.net> + + * doc/canvas.n: Corrected description of acceptable join styles. + Spotted by Emiliano Gavilán. + +2009-07-23 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkSelect.c (HandleTclCommand): [Bug 2441988]: Stop losing + reports of errors in selection handlers; that's what the background + error handling code is for. + *** POTENTIAL INCOMPATIBILITY *** if your code was relying on erroring + selection scripts being silent. + (LostSelection, Tk_SelectionObjCmd): Stop using the vastly inefficient + TkCopyAndGlobalEval; better to use Tcl_Obj refcount management. + 2009-07-22 Donal K. Fellows <dkf@users.sf.net> * generic/tkFocus.c (TkFocusDeadWindow): [Bug 2496114]: Ensure that focus desynchronization doesn't cause a crash. +2009-07-21 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkFont.c (TkUnderlineAngledTextLayout): [Bug 2356057]: + Corrected drawing of rotated underlines. + +2009-07-21 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + + * generic/tkFont.c: [Bug 2328657]: Explicitly exclude hacky zero-char + chunks from intersection computation. Might deserve generalization to + other tests. + 2009-07-20 Donal K. Fellows <dkf@users.sf.net> * tests/clipboard.test (clipboard-6.2): [Bug 2824378]: Corrected @@ -1633,6 +2764,25 @@ a better first place to look now. incremental transfer of binary selections work get deserialized correctly. Thanks to Emiliano Gavilán for detecting. +2009-07-18 Daniel Steffen <das@users.sourceforge.net> + + * unix/Makefile.in: Define NDEBUG in optimized (non- + symbols) build to disable assert()s. + + * macosx/tkMacOSXBitmap.c: [Bug 2821318]: Fix tk::mac::iconBitmap + crash due to off-by-one ckalloc error. + +2009-07-15 Daniel Steffen <das@users.sourceforge.net> + + * macosx/ttkMacOSXTheme.c: [Patch 2819620]: Update notebook tab + * library/ttk/aquaTheme.tcl: appearance to modern L&F; adjust tab & + notebook padding and tabmargins; + correct appearance of selected tree + header; add support for native tree + header sort arrows via user1 state. + + * library/demos/mclist.tcl: Use native sort arrows with aqua theme + 2009-07-15 Donal K. Fellows <dkf@users.sf.net> * unix/tkUnixSelect.c (TkSelEventProc, SelRcvIncrProc, SelCvtFromX8): @@ -1651,819 +2801,769 @@ a better first place to look now. * doc/grid.n: [Bug 2818455]: Corrected example. -2009-06-27 Jan Nijtmans <nijtmans@users.sf.net> - - * generic/tkInt.decls (Tk(Orient|Smooth)(Parse|Print)Proc): - Backport [Bug 2804935]: Expose these functions through the internal - stub table as they are useful to existing third-party code. - -2009-06-23 Jan Nijtmans <nijtmans@users.sf.net> - - * generic/tkCanvUtil.c: [Bug 220935]: canvas dash update problem +2009-07-02 Pat Thoyts <patthoyts@users.sourceforge.net> -2009-06-02 Pat Thoyts <patthoyts@users.sourceforge.net> + * generic/tkInt.h: Avoid using C++ reserved word in header. - * win/tkWinWm.c: [Bug 2799589]: Backported fix for crash on - * tests/winWm.test: delayed window activation. +2009-06-30 Daniel Steffen <das@users.sourceforge.net> -2009-05-21 Pat Thoyts <patthoyts@users.sourceforge.net> + * generic/tkInt.h: Add assert macros for clang static + analyzer and redefine Tcl_Panic to + assert after panic in clang PURIFY + builds. - * win/tkWinMenu.c: [Bug 2794778]: Backported fix for keyboard - traversal of the menus on Windows. + * generic/tkImgPhInstance.c: Small fixes to make clang static + * generic/tkTextDisp.c: analyzer happier. -2009-05-14 Pat Thoyts <patthoyts@users.sourceforge.net> + * generic/tkConfig.c: Add clang assert for false positives + * generic/tkUndo.c: from static analyzer. - * generic/tkButton.c: [Bug 1923684]: Backported checkbutton fix - for confused state when -offvalue equals -tristatevalue +2009-06-29 Daniel Steffen <das@users.sourceforge.net> -2009-05-14 Pat Thoyts <patthoyts@users.sourceforge.net> + Merge of TkAqua Cocoa port <http://github.com/das/tcltk/tree/de-carbon> + *** POTENTIAL INCOMPATIBILITY *** - * doc/ttk_image.n: Backported support for the Vista theme. - * doc/ttk_style.n: This requires the vsapi element engine, - * doc/ttk_vsapi.n: the hover state and the theme script - * doc/ttk_widget.n: definition. - * generic/ttk/ttkState.c: - * generic/ttk/ttkTheme.h: - * generic/ttk/ttkWidget.c: - * library/ttk/ttk.tcl: - * library/ttk/vistaTheme.tcl: - * library/ttk/xpTheme.tcl: - * tests/ttk/vsapi.test: - * win/ttkWinXPTheme.c: - -2009-05-13 Pat Thoyts <patthoyts@users.sourceforge.net> - - * generic/tkFont.c: [Bug 2791352]: Backported fix and tests for - * tests/font.test: mis-parsing of certain font descriptions. - -2009-05-03 Donal K. Fellows <dkf@users.sf.net> - - * win/tkWinWm.c (UpdateWrapper): [Bug 2785744]: Manipulate flag bit - correctly so that menubar updates can't smash other attributes. - -2009-04-30 Pat Thoyts <patthoyts@users.sourceforge.net> + * macosx/tkMacOSX.h: Large-scale rewrite of TkAqua migrating + * macosx/tkMacOSXBitmap.c: all use of deprecated Carbon API to + * macosx/tkMacOSXButton.c: Cocoa API; now supports 64bit + * macosx/tkMacOSXClipboard.c: architecture and requires Mac OS X 10.5 + * macosx/tkMacOSXColor.c: or later; with TkAqua enabled, all Tk + * macosx/tkMacOSXConfig.c: sources are now built with the + * macosx/tkMacOSXCursor.c: Objective-C compiler and running in + * macosx/tkMacOSXDebug.c: Objective-C garbage collection mode as + * macosx/tkMacOSXDebug.h: well as in retain-release mode is + * macosx/tkMacOSXDefault.h: supported; detailed development history + * macosx/tkMacOSXDialog.c: is available in github repository. + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXEmbed.c: There should be no script-visible + * macosx/tkMacOSXEntry.c: changes to existing Tk functionality, + * macosx/tkMacOSXEvent.c: but there are a few aqua-specific + * macosx/tkMacOSXEvent.h: additions, see macosx/README for + * macosx/tkMacOSXFont.c: details; extensions using only public + * macosx/tkMacOSXFont.h: Tk API should continue to work + * macosx/tkMacOSXHLEvents.c: unchanged but extensions that rely on + * macosx/tkMacOSXInit.c: platform-specific internal Tk API or + * macosx/tkMacOSXInt.h: make assumptions about the inner + * macosx/tkMacOSXKeyEvent.c: workings of TkAqua (in particular + * macosx/tkMacOSXKeyboard.c: presence of QuickDraw) will require + * macosx/tkMacOSXMenu.c: porting. + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXMenus.c: Configure Tk with --enable-aqua=carbon + * macosx/tkMacOSXMouseEvent.c: to fallback to now-deprecated previous + * macosx/tkMacOSXNotify.c: TkAqua implementation in tk/carbon. + * macosx/tkMacOSXPort.h: + * macosx/tkMacOSXPrivate.h: + * macosx/tkMacOSXRegion.c: + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXScrlbr.c: + * macosx/tkMacOSXSend.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXTest.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXWm.h: + * macosx/tkMacOSXXStubs.c: + * macosx/ttkMacOSXTheme.c: + * macosx/tkMacOSXCarbonEvents.c (removed): - * win/tkWinWm.c: [Patch 2504402]: Backported change to create - wm icons as device independent bitmaps. (cjmcdonald) + * macosx/tkMacOSXCursors.h (new): Move cursor data from resources + * macosx/tkMacOSXXCursors.h (new): to compiled-in const array; + * macosx/tkMacOSXCursors.r (removed): remove obsolete Rez source + * macosx/tkMacOSXXCursors.r (removed): files for resource data. + * macosx/tkAboutDlg.r (removed): + * macosx/tkMacOSXAETE.r (removed): -2009-04-30 Donal K. Fellows <dkf@users.sf.net> + * macosx/Tk.tiff (new): Rename and update icon to blue feather; + * macosx/Tk.icns (new): add tiff version for about dialog. + * macosx/Wish.icns (removed): - * win/tkWinPixmap.c (Tk_GetPixmap): [Bug 2080533]: Added patch that - allows Tk to keep working even when the graphics card is stressed. + * macosx/Tk-Info.plist.in: Update copyright; adjust minimum system + * macosx/Wish-Info.plist.in: version requirement. + * generic/tkEntry.h: -2009-04-28 Jeff Hobbs <jeffh@ActiveState.com> + * license.terms: Sync list of entities with those in the + tcl license.terms, add Apple Inc. - * unix/tcl.m4, unix/configure (SC_CONFIG_CFLAGS): Harden the check - to add _r to CC on AIX with threads. + * generic/tk.h: Update comment with list of source + files containing tk version numbers. -2009-04-27 Donal K. Fellows <dkf@users.sf.net> + * generic/tkButton.c: On aqua, recompute button geometry on + secondary image change to enable cache + of native img format in geom compute. - * generic/tkInt.decls: [Bug 2768945]: Expose (as "private") a set of - functions needed for easily building canvas items that work like - existing standard ones. + * generic/tkGrab.c: On aqua, make all grabs global, the + Mac OS X windowserver forces all grabs + to be application-local only anyway. -2009-04-24 Jeff Hobbs <jeffh@ActiveState.com> + * generic/tkSelect.c: Enable utf8 atom on aqua. - * win/tkWinDialog.c (ChooseDirectoryValidateProc): No need to set - cwd on selchange. Prevents delete of selected folder in dialog. + * generic/tk.decls: Replace carbon types in public and + * generic/tkInt.decls: internal platform stubs interfaces with + void* resp. generic Tk types. -2009-04-24 Stuart Cassoff <stwo@users.sf.net> + * xlib/xgc.c: Add support for managing a platform- + specific cache appended to a GC. - * unix/Makefile.in: [Bug 2764263]: Removed stray @ from - Makefile.in test target. [Bug 1945073]: Don't chmod+x square demo. - [Patch 2764272]: Adjustable demo install location. + * tests/dialog.test: Change name of undefined bit to avoid + match with OSType native bitmap name. -2009-04-24 Stuart Cassoff <stwo@users.sf.net> + * doc/cursors.n: Update list of cursors mapped to native + cursors and add new native cursors. - * unix/Makefile.in: [Patch 2769530]: Don't chmod/exec installManPage. + * doc/menu.n: Add documentation of new aqua-specific + .window menu, document new constraints + on .apple menu. -2009-04-23 Jeff Hobbs <jeffh@ActiveState.com> + * library/console.tcl: Add aqua window and help menus. - * win/tkWinDialog.c (Tk_ChooseDirectoryObjCmd): [Bug 2779910]: Enable - the new style choosedir that has a "New Folder" button, with - ::tk::winChooseDirFlags override for new behavior. + * unix/Makefile.in: Add support for TkAqua-implementation- + specific sources determined at + configure-time. Update dist target for + new/removed files. -2009-04-15 Don Porter <dgp@users.sourceforge.net> + * unix/configure.in: Add libraries & compiler flags for + Cocoa and Objective-C; update build + support for new/removed files; add + support for configure-time choice of + TkAqua implementation. - *** 8.5.7 TAGGED FOR RELEASE *** + * macosx/Tk-Common.xcconfig (new): Rename Xcode projects and + * macosx/Tk-Debug.xcconfig (new): related files; update for Xcode + * macosx/Tk-Release.xcconfig (new): 3.1 and 3.2; update for Cocoa, + * macosx/Tk.xcode/* (new): Objective-C & GC; update with + * macosx/Tk.xcodeproj/* (new): new/removed source files; + * macosx/Wish.xcode/* (removed): standardize on gcc 4.2; remove + * macosx/Wish.xcodeproj/* (removed): obsolete configurations and + * macosx/Wish-Debug.xcconfig (removed): pre-Xcode project. + * macosx/Wish-Common.xcconfig (removed): + * macosx/Wish-Release.xcconfig (removed): + * macosx/Wish.pbproj/* (removed): - * changes: Updated for 8.5.7 release. + * macosx/README: Document new Cocoa-port features and + constraints; update project docs; + cleanup. -2009-04-14 Stuart Cassoff <stwo@users.sourceforge.net> + * carbon/tkMacOSXInt.h: Add dummy defines for empty GC cache. - * unix/tcl.m4: Removed -Wno-implicit-int from CFLAGS_WARNING. + * carbon/tkMacOSXColor.c: Update for type changes in platform + * carbon/tkMacOSXDraw.c: stubs interfaces. + * carbon/tkMacOSXHLEvents.c: + * carbon/tkMacOSXMouseEvent.c: + * carbon/tkMacOSXSubwindows.c: + * carbon/tkMacOSXWm.c: -2009-04-10 Don Porter <dgp@users.sourceforge.net> + * carbon/tkMacOSXButton.c: Fix warning. - * changes: Updated for 8.5.7 release. + * generic/tkPlatDecls.h: regen. + * generic/tkIntPlatDecls.h: + * unix/configure: autoconf-2.59 - * generic/tk.h: Bump to 8.5.7 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - * README: +2009-06-27 Jan Nijtmans <nijtmans@users.sf.net> - * unix/configure: autoconf-2.59 - * win/configure: + * generic/tkInt.decls (added TkSmooth(Parse|Print)Proc, + removed TkTile(Parse|Print)Proc which don't exist): + Follow-up to [Bug 2804935]: Expose these functions through the + internal stub table as they are useful to existing third-party code. -2009-04-10 Joe English <jenglish@users.sourceforge.net +2009-06-26 Daniel Steffen <das@users.sourceforge.net> - * library/palette.tcl(tk_setPalette): Don't set - *selectColor: #b03060; this makes radio- and checkbuttons - look wrong post-TIP#109. + * carbon/ (new directory): Copy of current state of 'macosx' + source directory, to preserve legacy TkAqua implementation based on + Carbon API (with support for Mac OS X releases older than 10.5). -2009-04-10 Daniel Steffen <das@users.sourceforge.net> + * unix/Makefile.in: Add support for --enable-aqua=carbon + * unix/configure.in: configure option (legacy fallback for + pre-Mac OS X 10.5 releases). - * unix/configure.in (Darwin): use Darwin SUSv3 extensions if - available. * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in: autoheader-2.59 - * library/msgbox.tcl: don't set msgbox bitmap background on TkAqua. +2009-06-22 Jan Nijtmans <nijtmans@users.sf.net> - * library/demos/filebox.tcl: only show "Motif Style Dialog" checkbutton - on X11 windowingsystem. + * generic/tkCanvUtil.c: [Bug 220935]: canvas dash update problem - * library/demos/widget: GOOBE: use ttk::cursor +2009-06-12 Donal K. Fellows <dkf@users.sf.net> - * library/ttk/cursors.tcl: backport ttk::cursor from HEAD + * generic/tkInt.decls (TkOrientParseProc, TkOrientPrintProc): + [Bug 2804935]: Expose these functions through the internal stub table + as they are useful to existing third-party code. - * library/demos/knightstour.tcl: fix knightstour demo not running from - interactive wish. - - * library/console.tcl (::tk::ConsoleInit): remove redundant TkAqua - Quit menu item. +2009-06-02 Pat Thoyts <patthoyts@users.sourceforge.net> - * generic/tkPointer.c (Tk_UpdatePointer): use all 5 buttons. + * win/tkWinWm.c: [Bug 2799589]: Avoid setting the focus on a + * tests/winWm.test: deleted window during delayed activation. - * generic/tkMenu.c (PostProcessEntry): delay call to - TkpConfigureMenuEntry() until all menu entry attributes are setup. +2009-05-21 Pat Thoyts <patthoyts@users.sourceforge.net> - * library/menu.tcl (::tk::MbPost): fix error thrown in y position - computation with indicatoron. + * win/tkWinMenu.c: [Bug 2794778]: Calls to CallWindowProc can lead to + other functions overwriting the event strucure. Therefore preserve a + local copy of the XKeyEvent while looping over the key events. - * generic/tkMenubutton.c: s/DEF_BUTTON_JUSTIFY/DEF_MENUBUTTON_JUSTIFY/ +2009-05-17 Joe English <jenglish@users.sourceforge.net> - * generic/tkTextBTree.c (TkBTreeDeleteIndexRange): add bounds check - to startEnd array access (fixes testsuite crash). + * generic/ttkNotebook.c: [Bug 1470246]: More flexible tab placement. - * tests/unixFont.test: only use xlsfonts with X11 windowingsystem. - -2009-04-10 Donal K. Fellows <dkf@users.sf.net> +2009-05-14 Pat Thoyts <patthoyts@users.sourceforge.net> - * generic/tkCanvPs.c (TkPostscriptInfo): [Bug 1466509]: Eliminate old - and misleading comments mentioning prolog.ps. - * generic/prolog.ps, library/prolog.ps: Remove unused files. - * unix/Makefile.in, win/Makefile.in: Stop building distributions that - include the removed files or trying to install them. + * generic/tkButton.c: [Bug 1923684]: If a checkbutton offvalue is the + same as the tristate value we should use the off state in + preference. (andrey gusev) - * library/tk.tcl: [Bug 2116837]: Add event definitions to handle the - standard virtual events when Caps Lock is on. +2009-05-13 Pat Thoyts <patthoyts@users.sourceforge.net> -2009-04-03 Joe English <jenglish@users.sourceforge.net> + * win/tkWinSend.c: FormatMessage should always use the ignore-inserts + * win/tkWinTest.c: flag when processing system errors. - * unix/tkUnixWm.c: [Bug 1789819]: Don't Panic. + * generic/tkFont.c: [Bug 2791352]: Handle parsing of type 5 font + * tests/font.test: descriptions with hyphenated family name. -2009-03-25 Donal K. Fellows <dkf@users.sf.net> +2009-05-06 Pat Thoyts <patthoyts@users.sourceforge.net> - * generic/ttk/ttkTheme.c (BuildOptionMap, NewElementImpl): - [Bug 2178820]: Ensure that zero-size allocations don't happen; some - malloc implementations don't like it at all. + * library/images/lamp.svg: Added an SVG version of the Tk lamp and + * library/images/lamp.png: a pre-rendered PNG version. + * win/rc/wish.ico: Wish gets a new icon using the SVG lamp and the tk + * win/rc/tk.ico: dll gets the tcl rendered feather. This provides + improved icons for Vista/Windows 7. - * win/wish.exe.manifest.in: [Bug 1871101]: Add magic to make Tk not be - blurred on Vista with large fonts. +2009-05-05 Donal K. Fellows <dkf@users.sf.net> -2009-03-03 Pat Thoyts <patthoyts@users.sourceforge.net> + * doc/MainWin.3 (Tk_GetNumMainWindows): [Bug 487220]: Clarified that + this function works per-thread, not per-process. - * generic/tkFileFilter.c: Backported some fixes for uninitialized - * generic/tkFont.c: variables identified by das using clang - * generic/tkListbox.c: analysis. + * doc/canvas.n (scale): [Bug 1832015]: Clarified that [$c scale] only + affects item coordinates. -2009-02-27 Pat Thoyts <patthoyts@users.sourceforge.net> +2009-05-04 Donal K. Fellows <dkf@users.sf.net> - * generic/tkWindow.c: [Bug 2645457] check for dead windows after - calling Tk_MakeWindowExist to avoid a crash when mapping dead windows. + * doc/3DBorder.3, doc/BindTable.3, doc/CanvPsY.3, doc/Clipboard.3: + * doc/ConfigWidg.3, doc/CrtWindow.3, doc/GetBitmap.3: + * doc/GetCapStyl.3, doc/GetImage.3, doc/GetJoinStl.3, doc/GetScroll.3: + * doc/GetSelect.3, doc/GetVisual.3, doc/MainWin.3, doc/Name.3: + * doc/ParseArgv.3, doc/TextLayout.3, doc/Tk_Init.3: [Bug 2431507]: + Purge all mention of the now-obsolete 'interp->result'. -2009-02-23 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/tkWinCursor.c: [Patch 2542828] use stock Win32 help arrow - cursor when question_arrow requested (danckaert) +2009-05-03 Donal K. Fellows <dkf@users.sf.net> - * win/rc/*.cur: [Patch 2513104] fix cursor hotspots (cjmcdonald) + * win/tkWinWm.c (UpdateWrapper): [Bug 2785744]: Manipulate flag bit + correctly so that menubar updates can't smash other attributes. - * win/tkWinMenu.c: Applied patch for menu image display bug - [Bug 1329198, 456299] [Patch 2507419] (cjmcdonald) +2009-05-01 Donal K. Fellows <dkf@users.sf.net> -2009-02-17 Jeff Hobbs <jeffh@ActiveState.com> + * library/mkpsenc.tcl (DrawText): [Bug 2777019]: Corrected point of + application of rotation transform so rotation is about the anchor + point of the text. - * win/tcl.m4, win/configure: Check if cl groks _WIN64 already to - avoid CC manipulation that can screw up later configure checks. - Use 'd'ebug runtime in 64-bit builds. + * generic/tkCanvPs.c (Tk_PostscriptPhoto): + * library/mkpsenc.tcl: Factor out the postscript code for converting + images into postscript so that the code bits are in the prolog and not + emitted at runtime if a non-thread-safe static says to... -2009-02-16 Jeff Hobbs <jeffh@ActiveState.com> +2009-04-30 Pat Thoyts <patthoyts@users.sourceforge.net> - * win/configure.in, win/configure: align better with tcl - version. Ensures finding correct CPP for Win64. + * win/tkWinWm.c: [Patch 2504402]: Create icon bitmaps as device + independent bitmaps. This ensures the icon can be drawn properly on + various colour depth surfaces - in particular it fixes a problem with + remote desktop and looks better in the vista task switching overlay. + (cjmcdonald) -2008-02-06 Daniel Steffen <das@users.sourceforge.net> +2009-04-30 Donal K. Fellows <dkf@users.sf.net> - * generic/tkImgPhoto.c: fix numerous leaks discovered with the - * generic/tkMenu.c: Mac OS X Instruments.app Leaks tool. - * generic/tkText.c: - * generic/tkTextImage.c: - * generic/tkTextIndex.c: - * generic/tkUndo.c: - * generic/ttk/ttkFrame.c: - * macosx/tkMacOSXWm.c: + * win/tkWinPixmap.c (Tk_GetPixmap): [Bug 2080533]: Added patch that + allows Tk to keep working even when the graphics card is stressed. -2009-01-22 Kevin B. Kenny <kennykb@acm.org> +2009-04-28 Jeff Hobbs <jeffh@ActiveState.com> - * unix/tcl.m4: Corrected a typo ($(SHLIB_VERSION) should be - ${SHLIB_VERSION}). - * unix/configure: Autoconf 2.59 + * unix/tcl.m4, unix/configure (SC_CONFIG_CFLAGS): Harden the check + to add _r to CC on AIX with threads. -2009-01-19 Kevin B. Kenny <kennykb@acm.org> +2009-04-27 Donal K. Fellows <dkf@users.sf.net> - * unix/Makefile.in: Added a CONFIG_INSTALL_DIR parameter so that - * unix/tcl.m4: distributors can control where tclConfig.sh goes. - Made the installation of 'ldAix' conditional - upon actually being on an AIX system. Allowed for downstream - packagers to customize SHLIB_VERSION on BSD-derived systems. - Thanks to Stuart Cassoff for [Patch 907924]. - * unix/configure: Autoconf 2.59 + * generic/tkInt.decls: [Bug 2768945]: Expose (as "private") a set of + functions needed for easily building canvas items that work like + existing standard ones. -2009-01-14 Jan Nijtmans <nijtmans@users.sf.net> +2009-04-24 Jeff Hobbs <jeffh@ActiveState.com> - * generic/tkImgPhoto.c: fix for aMSN compatibility [tcl-Bug 2507326] + * win/tkWinDialog.c (ChooseDirectoryValidateProc): No need to set cwd + on selchange. Prevents delete of selected folder in dialog. -2009-01-11 George Peter Staplin <georgeps@users.sourceforge.net> +2009-04-24 Stuart Cassoff <stwo@users.sf.net> - * generic/tkEvent.c: Backport a fix from 8.6 for a NULL pointer - dereference in CreateXIC. + * unix/Makefile.in: Assorted issues: + [Bug 2764263]: Removed stray @ from Makefile.in test target. + [Bug 1945073]: Don't chmod+x square demo. + [Patch 2764272]: Adjustable demo install location. -2009-01-07 Pat Thoyts <patthoyts@users.sourceforge.net> +2009-04-24 Stuart Cassoff <stwo@users.sf.net> - * win/tkWinWm.c: Backported fix for [Bug 1847002] to prevent the - bypassing of grab restrictions via the taskbar on Windows. + * unix/Makefile.in: [Patch 2769530]: Don't chmod/exec installManPage. -2008-12-22 Don Porter <dgp@users.sourceforge.net> +2009-04-23 Jeff Hobbs <jeffh@ActiveState.com> - *** 8.5.6 TAGGED FOR RELEASE *** + * win/tkWinDialog.c (Tk_ChooseDirectoryObjCmd): [Bug 2779910]: Enable + the new style choosedir that has a "New Folder" button, with + ::tk::winChooseDirFlags override for new behavior. - * tests/embed.test: Eliminate duplicate test names. +2009-04-14 Donal K. Fellows <dkf@users.sf.net> - * changes: Updates for 8.5.6 release. + * library/xmfbox.tcl (MotifFDialog_ActivateSEnt): Ensure that the + * library/tkfbox.tcl (Done): dialogs have the + correct levels for [upvar] for accessing the -typevariable var. -2008-12-22 Joe English <jenglish@users.sourceforge.net> +2009-04-13 Donal K. Fellows <dkf@users.sf.net> - * generic/ttk/ttkWidget.c: Don't crash when - application uses nondefault visual [Bug 2264732] - (Backport from trunk change 2008-11-11) - * Workaround for [Bug 2207435] - (Backport from trunk change 2008-10-31). + * library/tk.tcl: Corrected another problem; can't determine the exact + type of OS - needed for figuring out how to guess the correct binding + in some circumstances - in a safe interpreter. -2008-12-22 Donal K. Fellows <dkf@users.sf.net> + * library/tkfbox.tcl: [Bug 2759119]: Corrected level handling for the + * library/xmfbox.tcl: -typevariable option following updates to tk.tcl + [Patch 2739360]: Use more modern images from Tango set for the non- + Motif file dialog. Thanks to Emiliano for bring this to my attention. - * generic/tkCanvPs.c (Tk_PostscriptFont,TkCanvPostscriptCmd): Backport - of font size and reflection fix. [Bug 2107938] +2008-04-10 Joe English <jenglish@users.sourceforge.net -2008-12-22 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + * library/palette.tcl (tk_setPalette): Don't set *selectColor: + #b03060; this makes radio- and checkbuttons look wrong post-TIP#109. - * generic/tkCanvUtil.c: Backport of the Millipeter patch [1813597, - * generic/tkInt.h: 2218964] - * generic/tkObj.c: - * generic/tkText.c: +2009-04-10 Daniel Steffen <das@users.sourceforge.net> -2008-12-21 Don Porter <dgp@users.sourceforge.net> + * unix/configure.in (Darwin): Use Darwin SUSv3 extensions if + available. + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in: autoheader-2.59 - * generic/tk.h: Bump to 8.5.6 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - * README: + * library/demos/filebox.tcl: Only show "Motif Style Dialog" + checkbutton on X11 windowingsystem. - * unix/configure: autoconf-2.59 - * win/configure: + * library/demos/widget: GOOBE: use ttk::cursor - * changes: Updates for 8.5.6 release. + * library/demos/knightstour.tcl: Fix knightstour demo not running from + interactive wish. -2008-11-22 Pat Thoyts <patthoyts@users.sourceforge.net> + * library/console.tcl (::tk::ConsoleInit): Remove redundant TkAqua + Quit menu item. - * library/ttk/combobox.tcl: [Bug 1939129,1991930] combobox dropdown - was drawn behind topmost toplevels. + * generic/tkPointer.c (Tk_UpdatePointer): Use all 5 buttons. -2008-11-19 Jan Nijtmans <nijtmans@users.sf.net> + * generic/tkMenu.c (PostProcessEntry): Delay call to + TkpConfigureMenuEntry() until all menu entry attributes are setup. - * generic/tkImage.c Relax the constraint that every Tk_ImageType - * generic/tkImgPhoto.c can only be passed to this function once. - This allows tkImg to be loaded in multiple - interpreters in a thread-enabled build of Tk. - [Bug 2312027] + * library/menu.tcl (::tk::MbPost): Fix error thrown in y position + computation with indicatoron. -2008-11-15 Pat Thoyts <patthoyts@users.sourceforge.net> + * generic/tkMenubutton.c: s/DEF_BUTTON_JUSTIFY/DEF_MENUBUTTON_JUSTIFY/ - * generic/tk.h: The tip 125 implementation permits the - * generic/tkFrame.c: wm manage command to manage any widget but - * macosx/tkMacOSXWm.c: only those with Frame instance data should - * unix/tkUnixWm.c: be permitted. We now check for the suitability - * win/tkWinWm.c: and raise an error for non-frame widgets. - * test/wm.test: Updated the tests and documentation. - * doc/wm.n: See also [Bug 2239034] + * generic/tkUtil.c (TkBackgroundEvalObjv): Use Tcl_BackgroundException -2008-11-12 Pat Thoyts <patthoyts@users.sourceforge.net> + * generic/tkTextBTree.c (TkBTreeDeleteIndexRange): Add bounds check + to startEnd array access (fixes testsuite crash). - * tests/constraints.tcl: backported listbox test fix from head - * tests/listbox.test: the default on windows is 'underline' - * tests/winDialog.test: backported some fixes from head - * library/text.tcl: Backported fix for bug #1777362 to have events - * test/text.test: work with window paths that include hyphens. + * tests/unixFont.test: Only use xlsfonts with X11 windowingsystem. -2008-10-23 Don Porter <dgp@users.sourceforge.net> +2009-04-10 Donal K. Fellows <dkf@users.sf.net> - * generic/tk.h: Bump version number to 8.5.6b1 to distinguish - * library/tk.tcl: CVS development snapshots from the 8.5.5 and - * unix/configure.in: 8.5.6 releases. - * unix/tk.spec: - * win/configure.in: - * README: + * library/tk.tcl: [Bug 2116837]: Add event definitions to handle the + standard virtual events when Caps Lock is on. - * unix/configure: autoconf (2.59) - * win/configure: +2009-04-08 Donal K. Fellows <dkf@users.sf.net> -2008-10-17 Pat Thoyts <patthoyts@users.sourceforge.net> + * library/demos/widget (addFormattedText): Stop marking demonstrations + as new for 8.6; that label is for wholly new demos. - * library/ttk/scale.tcl: Backported keyboard bindings for ttk::scale +2009-04-04 Donal K. Fellows <dkf@users.sf.net> -2008-10-11 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * doc/messageBox.n: [Bug 1881896]: Reworded to be clearer on what the + platform restrictions really are. - *** 8.5.5 TAGGED FOR RELEASE *** +2009-04-03 Joe English <jenglish@users.sourceforge.net> - * generic/tkCanvas.c (CanvasWidgetCmd): Corrected result generation. + * unix/tkUnixWm.c: [Bug 1789819]: Don't panic when the window manager + does something unexpected with the stacking order. -2008-10-10 Don Porter <dgp@users.sourceforge.net> +2009-04-03 Donal K. Fellows <dkf@users.sf.net> - * generic/tk.h: Bump to 8.5.5 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: + * doc/TextLayout.3: [Bug 974421]: Clarified description of how result + of lookup of a point after end of layout relates to the underlying + string's length. - * unix/configure: autoconf-2.59 - * win/configure: +2009-04-02 Pat Thoyts <patthoyts@users.sourceforge.net> - * changes: Updates for 8.5.5 release. + * tests/textTag.test: Ensure the pointer begins outside the window for + all the tests checking Enter/Leave motion events. - * unix/Makefile.in: Relax constraints in index script so that - * win/Makefile.in: each Tk 8.5.* release may be [package require]d - * win/makefile.vc: into any Tcl 8.5.* interp. [Bug 1890438]. + * library/demos/pendulum.tcl: Use unicode labels + * library/demos/knightstour.tcl: Use polygon knight on x11. -2008-10-09 Don Porter <dgp@users.sourceforge.net> +2009-03-31 Donal K. Fellows <dkf@users.sf.net> - * generic/tkListbox.c: Make literal return values consistent with - those generated by Tcl_PrintDouble(). + * library/demos/mclist.tcl: Added support for arrow indicators to show + which way a column is being sorted. Corrected determination of which + fonts to use for measurements. - * tests/canvText.test: Backport test updates in light of the - * tests/entry.test: 2008-10-05 commit. - * tests/listbox.test: - * tests/scrollbar.test: - * tests/spinbox.test: - * tests/textDisp.test: +2009-03-25 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkEntry.c: Fix missing space constructing the scroll - command. + * doc/wish.1: Bring doc and demos in line with + * library/demos/hello: http://wiki.tcl.tk/812 + * library/demos/rmt + * library/demos/square + * library/demos/tcolor + * library/demos/timer + * library/demos/widget + * win/tkWinMenu.c: Eliminate a few compiler warnings on mingw + * win/ttkWinXPTheme.c: Spacing -2008-10-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> +2009-03-25 Donal K. Fellows <dkf@users.sf.net> - * win/tkWinScrlbr.c: Convert 'sprintf(..."%g"...)' to the - * macosx/tkMacOSXScrlbr.c: locale-insensitive Tcl_PrintDouble. - * generic/tkScrollbar.c: [Bug 2112563] NOTE: Tcl_PrintDouble - * generic/tkListbox.c: is sensitive to the value of - * generic/tkEntry.c: ::tcl_precision. - * generic/tkCanvText.c: *** POTENTIAL INCOMPATIBILITY *** - * generic/tkArgv.c: + * generic/ttk/ttkTheme.c (BuildOptionMap, NewElementClass): + [Bug 2178820]: Ensure that zero-size allocations don't happen; some + malloc implementations don't like it at all. -2008-08-25 Todd M. Helfter <tmh@users.sourceforge.net> + * win/wish.exe.manifest.in: [Bug 1871101]: Add magic to make Tk not be + blurred on Vista with large fonts. - * library/menu.tcl: additional fix for [Bug 1023955] +2009-03-14 Donal K. Fellows <dkf@users.sf.net> -2008-09-08 Todd M. Helfter <tmh@users.sourceforge.net> + * unix/tk.pc.in (new file): [Patch 2243962] (hat0) + * unix/configure.in, unix/Makefile.in: Added support for reporting + Tk's public build configuration via the pkg-config system. TEA is + still the official mechanism though, in part because pkg-config is not + universally supported across all Tk's supported platforms. - * doc/menu.n: fix typo in docs [Bug 2098425] +2009-03-10 Donal K. Fellows <dkf@users.sf.net> -2008-08-28 Don Porter <dgp@users.sourceforge.net> + * doc/event.n: Tidy up and improve examples. - * unix/tkConfig.sh.in: Added @XFT_LIBS@ to the definition of TK_LIBS - to avoid link failures when a "big wish" program links against a - --disable-shared build of libtk. (Discovered building expectTk). +2009-03-09 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> - * generic/tk.h: Bump version number to 8.5.5b1 to distinguish - * library/tk.tcl: CVS development snapshots from the 8.5.4 and - * unix/configure.in: 8.5.5 releases. - * unix/tk.spec: - * win/configure.in: - * README: + * tkMacOSXFont.c (GetFontFamilyName): [Bug 2548661]: Handle NULL + return from CFStringCreate. - * unix/configure: autoconf (2.59) - * win/configure: +2009-02-27 Jan Nijtmans <nijtmans@users.sf.net> -2008-08-25 Todd M. Helfter <tmh@users.sourceforge.net> + * doc/GetBitmap.3: [FRQ 2636558]: Tk_DefineBitmap and + * generic/tk.decls: Tk_GetBitmapFromData signature problem + * generic/tkInt.decls: + * generic/tkBitmap.c: + * generic/tkInt.h: + * generic/tkStubInit.c: + * generic/tkDecls.h: (regenerated) + * generic/tkIntDecls.h: (regenerated) + * macosx/tkMacOSXBitmap.c: - * library/menu.tcl: fix typo from [Bug 1023955] +2009-02-27 Pat Thoyts <patthoyts@users.sourceforge.net> -2008-08-25 Todd M. Helfter <tmh@users.sourceforge.net> + * generic/tkWindow.c: [Bug 2645457]: Check for dead windows after + calling Tk_MakeWindowExist to avoid a crash when mapping dead windows. - * library/menu.tcl : Do not flip to the arrow cursor on menus. - This was a Motif convention. Current behavior is maintained if - tk_strictMotif is enabled. [Bug 1023955] +2009-02-23 Pat Thoyts <patthoyts@users.sourceforge.net> -2008-08-25 Todd M. Helfter <tmh@users.sourceforge.net> + * win/rc/*.cur: [Patch 2513104]: Fix cursor hotspots (cjmcdonald) - The patch is associated with the bug tracker id: 1936220 - library/tkfbox.tcl : fix the multiple selection error for - tk_getOpenFile -multiple 1 which fails on all unix platforms since - the adoption of ttk widgets. + * win/tkWinMenu.c: Applied patch for menu image display bug. + [Bug 1329198, 456299] [Patch 2507419] (cjmcdonald) -2008-08-19 Joe English <jenglish@users.sourceforge.net> +2009-02-22 Pat Thoyts <patthoyts@users.sourceforge.net> - * generic/ttk/ttkScroll.c: Don't use sprintf "%g" to - format floating point numbers in -[xy]scrollcommand callbacks - or [xy]view methods. Minor incompatibility: 0 and 1 now - formatted as "0.0" resp "1.0". - * tests/ttk/entry.test, tests/ttk/treeview.test: Updated - to account for above change. + * win/tkWinCursor.c: Applied patch to support stock Win32 help arrow + cursor when question_arrow requested [Patch 2542828] (danckaert) -2008-08-19 Daniel Steffen <das@users.sourceforge.net> +2009-02-21 Pat Thoyts <patthoyts@users.sourceforge.net> - * macosx/tkMacOSXFont.c (SetFontFeatures): Disable antialiasing of - fixed-width fonts with - size <= 10. + * library/ttk/vistaTheme.tcl: Correct the ttk::treeview border on + * win/ttkWinXpTheme.c: XP and vista. -2008-08-14 Daniel Steffen <das@users.sourceforge.net> + * library/console.tcl: [Bug 2546087]: In 2004 a fix to Tcl channels + prevented the exposure of the internal UTF-8 representation of the + ASCII NUL character (\uc080). Since then strings in the console have + been truncated at NUL. This restores the older behaviour. - *** 8.5.4 TAGGED FOR RELEASE *** +2009-02-17 Jeff Hobbs <jeffh@ActiveState.com> - * unix/tcl.m4 (SC_PATH_X): check for libX11.dylib in addition to - libX11.so et al. + * win/tcl.m4, win/configure: Check if cl groks _WIN64 already to avoid + CC manipulation that can screw up later configure checks. Use 'd'ebug + runtime in 64-bit builds. - * unix/configure: autoconf-2.59 +2009-02-16 Jeff Hobbs <jeffh@ActiveState.com> -2008-08-08 Don Porter <dgp@users.sourceforge.net> + * win/configure.in, win/configure: Align better with tcl version. + Ensures finding correct CPP for Win64. - * generic/tk.h: Bump to 8.5.4 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - * README: +2009-02-16 Donal K. Fellows <dkf@users.sf.net> - * unix/configure: autoconf-2.59 - * win/configure: + * doc/ttk_intro.n: [Bug 2604420]: Improve wording so that this page + feels less obviously incomplete. - * changes: Updates for 8.5.4 release. +2009-02-12 Donal K. Fellows <dkf@users.sf.net> -2008-08-05 Joe English <jenglish@users.sourceforge.net> + * library/iconlist.tcl: Split out the IconList megawidget from + tkfbox.tcl into its own file so as to make it easier to maintain. Also + cleans up the API for the megawidget, making it more like a + conventional Tk widget. - * generic/tk.h, generic/tkEvent.c: Fix for [Bug 2010422] - "no event type or button # or keysym while executing - "bind Listbox <MouseWheel> [...]". +2009-02-11 Donal K. Fellows <dkf@users.sf.net> -2008-08-01 Pat Thoyts <patthoyts@users.sourceforge.net> + * library/demos/items.tcl, .../label.tcl, .../twind.tcl: + * library/demos/images/ouster.png: [Bug 2588919]: Demo GOOBE. Added + new image of John Ousterhout that does not look quite so massively out + of date, and also showed off a bit of how we can adjust PNG images + when loading them. Also labeled JO as the creator; it's the TCT who + are the proprietors now. - * win/tkWinWm.c: Backported fixes for handling unmapped parent - * test/wm.test: toplevels. [Bug 2009788, 2028703] +2009-02-10 Jan Nijtmans <nijtmans@users.sf.net> -2008-07-31 Don Porter <dgp@users.sourceforge.net> + * unix/tcl.m4: [Bug 2502365]: Building of head on HPUX was broken when + using the native CC. + * unix/configure (autoconf-2.59) - * generic/tk.h: Added missing EXTERN for the Tcl_PkgInitStubsCheck - declaration to fix inability to embed non-stub-enabled Tk on Windows. +2009-02-08 Joe English <jenglish@users.sourceforge.net> -2008-07-26 Pat Thoyts <patthoyts@users.sourceforge.net> + * generic/ttk/*.[ch]: Renamed several internal data structures and + functions: ElementImpl -> ElementClass, LayoutNode -> Element. Remove + more unnecessary casts. Add function Ttk_ClientRegion, common factor + of entry, scale, progress, and treeview widgets. + * generic/ttk/ttkTrack.c: Fix [Bug 2431428]. - * doc/options.n: Direct to the font manual for -font [Bug 1686012] +2009-02-06 Daniel Steffen <das@users.sourceforge.net> - * win/tkWinWindow.c: Check for 0x prefix in sprintf %p. Bug [2026405] + * generic/tkImgPhInstance.c: Fix numerous leaks discovered with the + * generic/tkMenu.c: Mac OS X Instruments.app Leaks tool. + * generic/tkText.c: + * generic/tkTextImage.c: + * generic/tkTextIndex.c: + * generic/tkUndo.c: + * generic/tkUtil.c: + * generic/ttk/ttkFrame.c: + * macosx/tkMacOSXWm.c: -2008-07-22 Daniel Steffen <das@users.sourceforge.net> +2009-01-29 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkCanvArc.c - eliminate some unnessary type casts + * generic/tkCanvBmap.c - some internal const decorations + * generic/tkCanvImg.c - spacing + * generic/tkCanvWind.c + * generic/tkCmds.c + * generic/tkConfig.c + * generic/tkEntry.c + * generic/tkFocus.c + * generic/tkFont.c + * generic/tkFrame.c + * generic/tkGrab.c + * generic/tkGrid.c + * generic/tkImage.c + * generic/tkListbox.c + * generic/tkObj.c + * generic/tkOption.c + * generic/tkPack.c + * generic/tkPanedWindow.c + * generic/tkRectOval.c + * generic/tkSelect.c + * generic/tkText.c + * generic/tkTextMark.c + * generic/tkTextTag.c - * library/ttk/aquaTheme.tcl: Use system color names and TIP145 named - font instead of hardcoded color values and deprecated native font name. +2009-01-28 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/ttk/ttkCache.c: - eliminate some unnessary type casts + * generic/ttk/ttkLayout.c - some internal const decorations + * generic/ttk/ttkState.c - spacing + * generic/ttk/ttkTheme.c + * macosx/tkMacOSXMenu.c + * macosx/tkMacOSXPrivate.h + * unix/tkUnixFont.c + * unix/tkUnixMenu.c + * unix/tkUnixWm.c + * win/tkWinColor.c + * win/tkWinDialog.c + * win/tkWinFont.c + * win/tkWinMenu.c + * win/tkWinSend.c + * win/tkWinWindow.c + * win/tkWinWM.c - * macosx/tkMacOSXHLEvents.c: sync with HEAD. +2009-01-22 Kevin B. Kenny <kennykb@acm.org> -2008-07-04 Joe English <jenglish@users.sourceforge.net> + * unix/tcl.m4: Corrected a typo ($(SHLIB_VERSION) should be + ${SHLIB_VERSION}). + * unix/configure: Autoconf 2.59 - * generic/ttk/ttkDefaultTheme.c, generic/ttk/ttkClamTheme.c, - generic/ttk/ttkClassicTheme.c, generic/ttk/ttkElements.c: - Backport [Bug 2009213]. +2009-01-19 Kevin B. Kenny <kennykb@acm.org> -2008-06-29 Don Porter <dgp@users.sourceforge.net> + * unix/Makefile.in: Added a CONFIG_INSTALL_DIR parameter so that + * unix/tcl.m4: distributors can control where tclConfig.sh goes. + Made the installation of 'ldAix' conditional upon actually being on an + AIX system. Allowed for downstream packagers to customize + SHLIB_VERSION on BSD-derived systems. + Thanks to Stuart Cassoff for [Patch 907924]. + * unix/configure: Autoconf 2.59 - *** 8.5.3 TAGGED FOR RELEASE *** +2009-01-16 Don Porter <dgp@users.sourceforge.net> - * generic/tk.h: Bump to 8.5.3 for release. - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: + * generic/tk.h: Bump patchlevel to 8.6b1.1 to distinguish + * library/tk.tcl: CVS snapshots from the 8.6b1 and 8.6b2 + * unix/configure.in: releases. * win/configure.in: - * README: * unix/configure: autoconf-2.59 * win/configure: - * changes: Updates for 8.5.3 release. - -2008-06-26 Don Porter <dgp@users.sourceforge.net> - - * generic/tkPanedWindow.c (PanedWindowProxyCommand) - (DisplayPanedWindow): Ensure that a zero width never gets fed to the - underlying window system. [Bug 1639824] (Backport fix from dkf). - -2008-06-20 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/treeview.tcl: Backport fix for [Bug 1951733] - -2008-06-19 Don Porter <dgp@users.sourceforge.net> - - * changes: Updates for 8.5.3 release. - -2008-06-18 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXCarbonEvents.c: fix debug carbon event tracing; - (InstallStandardApplicationEventHandler): replace needless use of - TkMacOSXInitNamedDebugSymbol() by standard TkMacOSXInitNamedSymbol(). - - * macosx/tkMacOSXDebug.c: revert 2007-11-09 commit making - * macosx/tkMacOSXDebug.h: TkMacOSXInitNamedDebugSymbol() - available outside of debug builds. - - * macosx/tkMacOSXEmbed.c (TkpMakeWindow): fix bug with missing - * macosx/tkMacOSXSubwindows.c (XMapWindow): focus on first map by - only sending VisibilityNotify events once windows are mapped (rather - than when they are created). - - * macosx/tkMacOSXWindowEvent.c (TkMacOSXProcessWindowEvent): fix - return value. - - * macosx/tkMacOSXInit.c: add helper to efficiently convert from - * macosx/tkMacOSXPrivate.h: CFString to Tcl_Obj. - - * macosx/tkMacOSXFont.c (TkpGetFontFromAttributes, InitFont): fix - incorrect conversion to points of font sizes already in points; factor - out retrieval of font family name from font family ID. - -2008-06-13 Jeff Hobbs <jeffh@ActiveState.com> - - * win/configure, win/configure.in (TK_WIN_VERSION): fix handling - of interim a/b versioning for manifest usage. - -2008-06-12 Daniel Steffen <das@users.sourceforge.net> - - * generic/tkPointer.c (Tk_UpdatePointer): fix failure to restore a - global grab capture and to release the restrict window capture when - releasing a button grab. Fixes segfault due to dangling reference to - restrict window inside TkpSetCapture() implementation. [Bug 1991932] - - * unix/tcl.m4 (SunOS-5.11): fix 64bit amd64 support with gcc & Sun cc. - * unix/configure: autoconf-2.59 - - * macosx/tkMacOSXXStubs.c (Tk_ResetUserInactiveTime): use UsrActivity - instead of OverallAct (which may be ignored in some circumstances). - - * macosx/Wish.xcodeproj/project.pbxproj: add debug configs for 64bit, - * macosx/Wish.xcodeproj/default.pbxuser: with gcov, and with - corefoundation disabled; updates & cleanup for Xcode 3.1 and for - Leopard; sync with Tcl.xcodeproj. - * macosx/Wish.xcode/project.pbxproj: sync Wish.xcodeproj changes. - * macosx/Wish.xcode/default.pbxuser: - * macosx/README: document new build configs. - -2008-06-10 Joe English <jenglish@users.sourceforge.net> - - * unix/tkUnixKey.c: tkUnixKey.c: Use Xutf8LookupString if available - [Patch #1986818]. This should fix problems (like #1908443) where - Xlib's idea of the system encoding does not match Tcl's. - -2008-05-23 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkLabel.c: Avoid passing width or height <= 0 to - Tk_RedrawImage, as this leads to a panic on Windows [Bug 1967576] - -2008-05-11 Pat Thoyts <patthoyts@users.sourceforge.net> - - * library/tk.tcl: Support for ttk widgets in AmpWidget - - * doc/button.n: Note negative widths for button [Patch #1883418] - * doc/ttk_*: 'identify' widget command is on all ttk widgets. - -2008-05-04 Joe English <jenglish@users.sourceforge.net> - - * macosx/ttkMacOSAquaTheme.c: "default" and "focus" adornments - should not be disjoint [Bug 1942785] - -2008-04-17 Don Porter <dgp@users.sourceforge.net> - - * generic/tkCanvas.c: Fix logic that determines when canvas item - <Enter> event should fire. Thanks to Sebastian Wangnick. [Bug 1327482] - -2008-04-14 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/tkWinDialog.c: backport tk_chooseColor -title fix from head - * win/tkWinTest.c: Added parent to testgetwininfo - * tests/winDialog.test: Created some tk_chooseColor win tests. - -2008-04-11 Don Porter <dgp@users.sourceforge.net> - - * generic/tk.h: Bump version number to 8.5.3b1 to distinguish - * library/tk.tcl: CVS development snapshots from the 8.5.2 and - * unix/configure.in: 8.5.3 releases. - * unix/tk.spec: - * win/configure.in: +2009-01-14 Jan Nijtmans <nijtmans@users.sf.net> - * unix/configure: autoconf (2.59) - * win/configure: + * generic/tkImgPhoto.c: [Bug 2507326]: Fix for aMSN compatibility + * generic/tkMenu.h: CONSTify Tk(Create|Find)MenuReferences + * generic/tkMenu.c: various internal "const" decorations. -2008-04-07 Jeff Hobbs <jeffh@ActiveState.com> +2009-01-13 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkWindow.c (Initialize): fix double-free on Tk_ParseArgv - * tests/main.test (main-3.*): error. [Bug 1937135] + * unix/tcl.m4: [Bug 2502365]: Building of head on HPUX was broken when + using the native CC + * unix/configure (autoconf-2.59) - * generic/tkArgv.c: fix -help mem explosion. [Bug 1936238] (kenny) +2009-01-13 Pat Thoyts <patthoyts@users.sourceforge.net> -2008-04-03 Pat Thoyts <patthoyts@users.sourceforge.net> + * tests/constraints.tcl: Made the tests more independent of the + * tests/*.test: presence of images in the interpreter. - * library/ttk/xpTheme.tcl: fix the colour of labelframe in xp +2009-01-11 Pat Thoyts <patthoyts@users.sourceforge.net> -2008-04-01 Don Porter <dgp@users.sourceforge.net> + * tests/bind.test: Fixed keysym bind tests for unix [Bug 2336454] - * generic/tkStubLib.c (Tk_InitStubs): Added missing error message. - * generic/tkWindow.c (Tk_PkgInitStubsCheck): +2009-01-11 George Peter Staplin <georgeps@users.sourceforge.net> -2008-03-28 Don Porter <dgp@users.sourceforge.net> + * generic/tkEvent.c: Fix a possible segv due to a NULL pointer + dereference that occurs when XCreateIC fails. - *** 8.5.2 TAGGED FOR RELEASE *** +2009-01-11 Pat Thoyts <patthoyts@users.sourceforge.net> - * README: Bump to 8.5.2 for release. - * generic/tk.h: + * library/bgerror.tcl: Pretty up the unix tk_messageBox icons with PNG + * library/icons.tcl: images and grouped all the stock icons in one + * library/msgbox.tcl: file. * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - - * unix/configure: autoconf-2.59 - * win/configure: - * changes: Updates for 8.5.2 release. +2009-01-11 Joe English <jenglish@users.sourceforge.net> -2008-03-27 Jeff Hobbs <jeffh@ActiveState.com> + * generic/ttk/ttkNotebook.c (NotebookCleanup): [Bug 2496162]: Don't + call Tk_DeleteOptionTable(), it's unnecessary and quite possibly + harmful. - * library/safetk.tcl (::safe::tkInterpInit): make sure tk_library - and its subdirs (eg, ttk) are on the "safe" access path. +2009-01-08 Jan Nijtmans <nijtmans@users.sf.net> -2008-03-27 Daniel Steffen <das@users.sourceforge.net> + * generic/tk3d.c: CONSTify TkDebugBorder + * generic/tkBind.c: CONSTify TkStringToKeysym + * generic/tkBitmap.c: CONSTify TkDebugBitmap + * generic/tkColor.c: CONSTify TkDebugColor + * generic/tkCursor.c: CONSTify TkDebugCursor + * generic/tkFont.c: CONSTify TkDebugFont + * generic/tkInt.decls All those mods TIP #27 complient, + no incompatibility risks. + * generic/tkIntDecls.h (regenerated) - * unix/tcl.m4 (SunOS-5.1x): fix 64bit support for Sun cc. [Bug 1921166] +2009-01-08 Pat Thoyts <patthoyts@users.sourceforge.net> - * unix/configure: autoconf-2.59 - -2008-03-27 Daniel Steffen <das@users.sourceforge.net> - - * generic/ttk/ttkStubLib.c: ensure tcl stubs are used in libtkstub - even in a static build of Tk. - * generic/ttk/ttkDecls.h: fix incorrect number of arguments in - Ttk_InitStubs macro definition. - -2008-03-26 Don Porter <dgp@users.sourceforge.net> - - * changes: Updates for 8.5.2 release. - - * unix/tkUnixCursor.c: Stop crash in [. configure -cursor] on X11. - Thanks to Emiliano Gavilán. [Bug 1922466] - -2008-03-26 Joe English <jenglish@users.sourceforge.net> - - * generic/tkInt.h, generic/tkEvent.c, unix/tkUnixEvent.c, - unix/tkUnixKey.c: XIM reorganization and cleanup; see - [Patch 1919791] for details. - -2008-03-21 Joe English <jenglish@users.sourceforge.net> - - * generic/tk.decls, generic/ttk/ttkStubLib.c, unix/Makefile.in: - Keep ttkStubLib.o in libtkstub instead of libtk. [Bug 1920030] - -2008-03-20 Donal K. Fellows <dkf@users.sf.net> - - * tests/wm.test: Rewrote so that tests clean up after themselves - rather than leaving that to the following test. Makes it easier to - catch problems where they originate. Inspired by [Bug 1852338] - -2008-03-19 Donal K. Fellows <dkf@users.sf.net> - - * doc/GetClrmap.3: Documented Tk_PreserveColormap. [Bug 220809] - -2008-03-17 Joe English <jenglish@users.sourceforge.net> - - * unix/Makefile.in, win/Makefile.in, win/makefile.vc: Put ttkStubLib.o - in libtkstub instead of libtk. [Bug 1863007] - -2008-03-16 Donal K. Fellows <dkf@users.sf.net> - - * library/demos/goldberg.tcl: Made work when run twice in the same - session. [Bug 1899664] Also made the control panel use Ttk widgets. - -2008-03-13 Daniel Steffen <das@users.sourceforge.net> - - * unix/configure.in: Use backslash-quoting instead of double-quoting - * unix/tcl.m4: for lib paths in tkConfig.sh. [Bug 1913622] - * unix/configure: autoconf-2.59 - -2008-03-13 Don Porter <dgp@users.sourceforge.net> - - * changes: Updates for 8.5.2 release. + * library/bgerror.tcl: Theme the bgerror dialog and make use of our + PNG support to improve the icon. -2008-03-12 Daniel Steffen <das@users.sourceforge.net> +2009-01-07 Pat Thoyts <patthoyts@users.sourceforge.net> - * macosx/Wish.xcodeproj/project.pbxproj: Add support for Xcode 3.1 - * macosx/Wish.xcodeproj/default.pbxuser: CODE_SIGN_IDENTITY and - * macosx/Wish-Common.xcconfig: 'xcodebuild install'. + * library/tkfbox.tcl: [Bug 2473120]: Mis-ordered messagebox args. -2008-03-12 Joe English <jenglish@users.sourceforge.net> + * win/tkWinWm.c: [Bug 1847002]: Prevent grabs being bypassed on + Windows. - * unix/tkUnixRFont.c: Try a fallback font if XftFontOpenPattern() - fails in GetFont (workaround for [Bug 1090382]). +2009-01-06 Jan Nijtmans <nijtmans@users.sf.net> -2008-03-11 Daniel Steffen <das@users.sourceforge.net> + * generic/tk.h: A few const -> CONST86 modifications, + * generic/tkCanvas.c: improving backwards compatibility. Change + * generic/tkCanvLine.c: Tk_ItemIndexProc and Tk_ItemInsertProc + * generic/tkCanvPoly.c: signature to have a Tcl_Obj parameter instead + * generic/tkCanvText.c: of a string parameter. This is binary and + * doc/CrtItemType.3: source compatible with previous API, it just + * doc/Clipboard.3: prevents the need for a type cast in the + * doc/ConfigWidg.3: Tk_ItemType table construction. Bring doc in + * doc/ParseArgv.3: line with API. - * library/demos/knightstour.tcl: Aqua GOOBE. - * library/demos/widget: +2009-01-06 Donal K. Fellows <dkf@users.sf.net> - * macosx/Wish.xcodeproj/project.pbxproj: Add support for Xcode 3.1 and - * macosx/Wish.xcodeproj/default.pbxuser: configs for building with - * macosx/Wish-Common.xcconfig: gcc-4.2 and llvm-gcc-4.2. + * generic/tkImgPhoto.c (Tk_PhotoPutBlock): Optimize a common case for + photo image building. [Patch 1539990] (jepler) - * generic/tkCanvUtil.c: Fix gcc-4.2 warnings. +2009-01-06 Pat Thoyts <patthoyts@users.sourceforge.net> - * macosx/GNUmakefile: Fix quoting to allow paths to - * macosx/Wish-Common.xcconfig: ${builddir}, ${INSTALL_ROOT} - * unix/Makefile.in: and ${TCL_BIN_DIR} to contain - * unix/configure.in: spaces. - * unix/install-sh: - * unix/tcl.m4: + * win/tkWinDialog.c: Use task modal for messagebox instead of system + modal. [Bug 2484771] (ferrieux,thoyts,mjanssen) - * unix/configure: autoconf-2.59 +2009-01-03 Donal K. Fellows <dkf@users.sf.net> - * unix/Makefile.in (install-strip): Strip non-global symbols from - dynamic library. + * doc/canvas.n: [Bug 1836621]: Improve the documentation of the + -offset and -outlineoffset item options. -2008-03-10 Don Porter <dgp@users.sourceforge.net> +2009-01-03 Jan Nijtmans <nijtmans@users.sf.net> - * changes: Updates for 8.5.2 release. + * generic/tk.decls: CONSTify Tk_ClipboardAppend + * generic/tkClipboard.c: + * generic/tkDecls.h: (regenerated) -2008-03-07 Donal K. Fellows <donal.k.fellows@man.ac.uk> +2008-12-31 David Gravereaux <davygrvy@pobox.com> - * doc/colors.n: Reworked to produce nicer HTML output. + * win/rules.vc: Small bug not setting SYMBOLS macro fixed. -2008-03-06 Joe English <jenglish@users.sourceforge.net> +2008-12-31 Joe English <jenglish@users.sourceforge.net> - * doc/ttk_notebook.n: Move "TAB IDENTIFIERS" section above "WIDGET - COMMAND" section. [Bug 1882011] + * generic/ttk/ttkDefaultTheme.c: Fix color palette for radiobutton and + checkbutton indicators. Fixes [Bug 2003310]; also makes "alt" theme + check/radiobuttons look like Windows 98, as intended. + * library/ttk/altTheme.tcl: Specify dark gray -bordercolor to soften + edges. + * tests/ttk/{checkbutton,radiobutton}.test: Split out of ttk.test. -2008-02-29 Pat Thoyts <patthoyts@users.sourceforge.net> +2008-12-28 Donal K. Fellows <dkf@users.sf.net> - * library/demos/widget: Added a Knight's tour canvas demo. - * library/demos/knightstour.tcl: + TIP #171 IMPLEMENTATION -2008-02-27 Daniel Steffen <das@users.sourceforge.net> + * library/listbox.tcl, library/scrlbar.tcl, library/text.tcl: Adjust + users of the <MouseWheel> event to do the right thing horizontally as + well as vertically. + * win/tkWinX.c (GenerateXEvent): Redirect <MouseWheel> to the window + that contains the mouse. + * generic/tkEvent.c (InvokeFocusHandlers): Do not direct <MouseWheel> + through the focus mechanism. + *** POTENTIAL INCOMPATIBILITY *** for anyone counting on shift-wheel + to do something else (or nothing at all) or for the wheel events to be + following the keyboard on Win. - * macosx/tkMacOSXDraw.c: workaround leak in Carbon SetPortPenPixPat() - API [Bug 1863346]; avoid repeated PixPat allocation/deallocation. + * generic/tkImgPNG.c (ReadIDAT): Corrected code to transfer blocks of + compressed data into the Tcl_ZlibStream. Allows the reading of all + images from PngSuite set. Thanks to Michael Kirkham for fix/testing. -2008-02-23 Joe English <jenglish@users.sourceforge.net> + TIP #244 IMPLEMENTATION - * library/ttk/combobox.tcl, doc/ttk_combobox.n, - * tests/ttk/combobox.test: Arrange to deliver <<ComboboxSelected>> - event after listbox is unposted, as intended [Bug 1890211]. Clarified - documentation. + * generic/tkImgPNG.c, tests/imgPNG.test, doc/photo.n: Adaptation of + tkpng to the Tk core, proving support for PNG image reading and + writing, based on Tcl's zlib support. -2008-02-23 Joe English <jenglish@users.sourceforge.net> +2008-12-27 Joe English <jenglish@users.sourceforge.net> - * generic/ttk/ttkPanedWindow.c: Don't enforce minimum sash thickness - of 5 pixels, just use 5 as a default. [FR 1898288] + * generic/ttk/ttkTreeview.c: [Bug 2381555]: Fix inconsistent use of + treeArea / headingArea. ([$tv identify] didn't work when horizontally + scrolled). -2008-02-14 Donal K. Fellows <donal.k.fellows@man.ac.uk> +2008-12-21 Donal K. Fellows <dkf@users.sf.net> - * unix/README: Documented missing configure flags. + * doc/canvas.n (postscript): Regularized documentation of -channel + option. -2008-02-06 Donal K. Fellows <donal.k.fellows@man.ac.uk> +2008-12-19 Don Porter <dgp@users.sourceforge.net> - * doc/ttk_scale.n (new file): Added basic documentation. [Bug 1881925] + *** 8.6b1 TAGGED FOR RELEASE *** -2008-02-04 Don Porter <dgp@users.sourceforge.net> + * changes: Updates for 8.6b1 release. - *** 8.5.1 TAGGED FOR RELEASE *** + * tests/clrpick.test: Eliminate duplicate test names. + * tests/embed.test: + * tests/text.test: + * tests/textMark.test: - * generic/tk.h: Bump to 8.5.1 for release. + * README: Bump version number to 8.6b1 + * generic/tk.h: * library/tk.tcl: * unix/configure.in: * unix/tk.spec: @@ -2472,364 +3572,544 @@ a better first place to look now. * unix/configure: autoconf-2.59 * win/configure: -2008-02-04 Donal K. Fellows <donal.k.fellows@man.ac.uk> - - * doc/MeasureChar.3, doc/FontId.3: Minor improvements (formatting, - keywords). - -2008-02-02 Daniel Steffen <das@users.sourceforge.net> +2008-12-18 Don Porter <dgp@users.sourceforge.net> - * macosx/Wish-Info.plist.in: add CFBundleLocalizations key, listing - * unix/configure.in (Darwin): all library/msgs locales. + * library/msgs/de.msg: [Patch 2442309]: Updated German messages. + Thanks to Ruediger Haertel. - * unix/configure.in (Darwin): correct Info.plist year substitution in - non-framework builds. - - * unix/configure: autoconf-2.59 - -2008-02-01 Don Porter <dgp@users.sourceforge.net> - - * changes: Updates for 8.5.1 release. - -2008-02-01 Reinhard Max <max@suse.de> - - * generic/tkImgGIF.c: Fixed a buffer overflow (CVE-2008-0553). - * tests/imgPhoto.test: Added a test for the above. +2008-12-17 Jan Nijtmans <nijtmans@users.sf.net> -2008-01-31 Jeff Hobbs <jeffh@ActiveState.com> + * generic/tk.h: VOID --> void + * unix/tkUnixPort.h: + * macosx/tkMacOSXPort.h: - * library/msgbox.tcl (::tk::MessageBox): don't use ttk::label in - low depth/aqua fallback, as it doesn't support -bitmap. +2008-12-17 Donal K. Fellows <dkf@users.sf.net> - * win/tkWinDialog.c (Tk_MessageBoxObjCmd): pass "" instead of NULL - when -title isn't set. [Bug 1881892] + * doc/selection.n: [Bugs 2441817,2441884]: Assorted small fixes. -2008-01-31 Donal K. Fellows <donal.k.fellows@man.ac.uk> +2008-12-16 Jan Nijtmans <nijtmans@users.sf.net> - * doc/panedwindow.n: Added proper description of -height and -width - options, which aren't "standard". Last of fallout from [Bug 1882495]. + * win/tkWinDialog.c: Remove unused variables -2008-01-30 Donal K. Fellows <donal.k.fellows@man.ac.uk> +2008-12-15 Don Porter <dgp@users.sourceforge.net> - * doc/canvas.n, doc/listbox.n, doc/message.n: Fix erroneous listing of - "standard" options. [Bug 1882495] + TIP #338 IMPLEMENTATION -2008-01-29 Joe English <jenglish@users.sourceforge.net> + * doc/Tk_Main.c: Removed the last two '#include "tclInt.h"'. + * generic/tkMain.c: Tk is now limited to Tcl's public interface. + * macosx/tkMacOSXInit.c: - * library/treeview.tcl: Fix bug in Shift-ButtonPress-1 binding (error - if no current focus item; reported on c.l.t.) +2008-12-12 Pat Thoyts <patthoyts@users.sourceforge.net> -2008-01-29 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * library/demos/fontchoose.tcl: Simple fontchooser demo. + * library/demos/widget: - * doc/ttk_*.n: Adjusted handling of the standard options part of the - Ttk manual pages so that they are documented in the correct location. - [Bug 1876493] +2008-12-11 Jan Nijtmans <nijtmans@users.sf.net> -2008-01-28 Joe English <jenglish@users.sourceforge.net> + * generic/tk3d.c: Make error message from Tk_GetRelief the same + as for Tk_GetReliefFromObj. + * tests/canvas.test: Adapt test cases for changed error message. + * tests/scrollbar.test + * tests/textTag.test - * unix/tkUnixRFont.c: Re-fix strict-aliasing warnings reintroduced by - last patch. +2008-12-11 Joe English <jenglish@users.sourceforge.net> -2008-01-27 Joe English <jenglish@users.sourceforge.net> + * library/demos/*.tcl: Omit contraindicated [package require Ttk]. + Remove logic that switches [ttk::scrollbar]s to [tk::scrollbar]s + based on [tk windowingsystem]; this is already handled in + library/ttk/scrollbar.tcl. - * generic/ttk/ttkNotebook.c: Make sure to schedule a redisplay when - adding and/or hiding tabs. [Bug 1878298] +2008-12-10 Daniel Steffen <das@users.sourceforge.net> -2008-01-27 Joe English <jenglish@users.sourceforge.net> + TIP #324 IMPLEMENTATION - * unix/tkUnixRFont.c: Merged common code from InitFont() and - TkpGetFontAttrsForChar(), factored into GetTkFontAttributes() and - GetTkFontMetrics(). Removed write-only struct UnixFtFont member - 'drawable'. Removed unneeded double-pointer indirections. Ensure that - TkFontAttributes.family member is a Tk_Uid, as specified. Use - FcTypeDouble for XFT_SIZE attribute. Finally: fix [Bug 1835848] + * generic/tkCmds.c: Implementation of [tk fontchooser] as + * generic/tkInt.h: a Ttk dialog for X11 and as a native + * win/tkWinDialog.c: platform dialog on Mac OS X & Windows. + * win/tkWinInt.h: (thoyts, vetter, robert, steffen) + * win/tkWinTest.c: [Patch 1477426] + * win/tkWinX.c: + * macosx/tkMacOSXCarbonEvents.c: + * macosx/tkMacOSXDialog.c: + * macosx/tkMacOSXEvent.c: + * macosx/tkMacOSXEvent.h: + * macosx/tkMacOSXFont.c: + * macosx/tkMacOSXFont.h: + * macosx/Wish.xcodeproj/project.pbxproj: + * library/fontchooser.tcl (new): + * library/tclIndex: + * library/msgs/de.msg: + * library/msgs/en.msg: + * tests/fontchooser.test (new): + * tests/winDialog.test: + * doc/fontchooser.n (new): + * doc/tk.n: -2008-01-25 Don Porter <dgp@users.sourceforge.net> + * library/console.tcl: Let user select console font via + [tk fontchooser]. + * library/demos/text.tcl: Add [tk fontchooser] demo. - * changes: Updates for 8.5.1 release. + * generic/tkUtil.c: Add TkBackgroundEvalObjv() and + TkSendVirtualEvent() utility functions + (used by TIP #324 code). -2008-01-08 Joe English <jenglish@users.sourceforge.net> + * generic/tkInt.h: Turn [tk] into an ensemble. + * generic/tkBusy.c: (thoyts, steffen) + * generic/tkCmds.c: + * generic/tkWindow.c: - * generic/ttk/ttkFrame.c: BUGFIX: fix crash in [ttk::labelframe] when - -style option specified. [Bug 1867122] + * macosx/tkMacOSXInit.c (TkpInit): Unconditionally show Tk console if + TK_CONSOLE env var is set. -2008-01-08 Joe English <jenglish@users.sourceforge.net> +2008-12-09 Don Porter <dgp@users.sourceforge.net> - * win/ttkWinTheme.c: Add tristate support to checkbuttons and - radiobuttons. [Bug 1865898] - Fix check and radio indicator size. [Bug 1679067] + TIP #337 IMPLEMENTATION -2008-01-06 Joe English <jenglish@users.sourceforge.net> + * generic/tkBind.c: Updated callers of Tcl_BackgroundError() to + * generic/tkCanvas.c: use the new routine + * generic/tkEntry.c: Tcl_BackgroundException() as appropriate. + * generic/tkImgBmap.c: + * generic/tkListbox.c: + * generic/tkSelect.c: + * generic/tkTextDisp.c: + * generic/tkTextWind.c: + * macosx/tkMacOSXHLEvents.c: + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenus.c: + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXWindowEvent.c: + * unix/tkUnixScale.c: + * unix/tkUnixWm.c: + * win/tkWinButton.c: + * win/tkWinMenu.c: + * win/tkWinScrlbr.c: + * win/tkWinWm.c: - * generic/ttk/ttkWidget.c, generic/ttk/ttkWidget.h: Call - Tk_MakeWindowExist() in widget constructor. Removed now-unnecessary - initial ConfigureNotify processing. +2008-12-07 Joe English <jenglish@users.sourceforge.net> -2008-01-06 Joe English <jenglish@users.sourceforge.net> + * macosx/ttkMacOSXTheme.c: [Bug 2219588]: Add native aqua elements for + ttk::spinbox + * generic/ttk/ttkEntry.c, library/ttk/spinbox.tcl, + * tests/ttk/spinbox.test: Moved most spinbox "business logic" out of + ttkEntry.c into Tcl bindings. + * library/ttk/clamTheme.tcl: Minor spinbox appearance improvements. + * library/ttk/combobox.tcl, library/ttk/utils.tcl: + Factor out ttk::bindMouseWheel procedure. + * library/ttk/spinbox.tcl: Add cross-platform MouseWheel bindings. - * library/ttk/treeview.tcl, library/ttk/utils.tcl: Fix MouseWheel - bindings for ttk::treeview widget. [Bugs 1442006, 1821939, 1862692] +2008-12-06 Donal K. Fellows <dkf@users.sf.net> -2008-01-02 Don Porter <dgp@users.sourceforge.net> + TIP #197 IMPLEMENTATION - * generic/tk.h: Bump version number to 8.5.1b1 to distinguish - * library/tk.tcl: CVS development snapshots from the 8.5.0 and - * unix/configure.in: 8.5.1 releases. - * unix/tk.spec: - * win/configure.in: + * generic/tkText.c (insertUnfocussedStrings, optionSpecs): + * generic/tkText.h (TkText, TkTextInsertUnfocussed): + * doc/text.n, tests/text.test: + Added definitions/tests/docs for "-insertunfocussed" field. + * generic/tkTextMark.c (TkTextInsertDisplayProc): + * generic/tkText.c (TextBlinkProc): + Added user-controlledrendering of insertion cursor when focus is not + in the text widget. - * unix/configure: autoconf (2.59) - * win/configure: +2008-12-05 Pat Thoyts <patthoyts@users.sourceforge.net> -2007-12-30 Donal K. Fellows <dkf@users.sf.net> + * library/ttk/ttk.tcl: Added vista theme to iron out the visual + * library/ttk/vistaTheme.tcl: differences between vista and XP. + * library/ttk/xpTheme.tcl: + * win/ttkWinXPTheme.c: - * doc/canvas.n: Documented exact behaviour of items with respect to - when they are the current item. [Bug 1774593] Also documented the - clipping behaviour of window items. +2008-12-05 Donal K. Fellows <dkf@users.sf.net> - * library/demos/nl.msg: Corrected following testing "in the field" by - Arjen Markus. [Bug 1860802] + * generic/tkCanvPs.c (Tk_PostscriptFont): [Bug 2107938]: Ensure that + font sizes can ever be negative; it triggers a really strange case + that is definitely not what is wanted. + * library/mkpsenc.tcl: Corrected and improved generation of postscript + * library/prolog.ps: prolog. Removed prolog.ps, which wasn't used and + was misleading. -2007-12-17 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-12-04 Jan Nijtmans <nijtmans@users.sf.net> - *** 8.5.0 TAGGED FOR RELEASE *** + * generic/tkInt.decls: [FRQ 220906]: Move 10 functions from tkText.h + * generic/tkText.h: to stub table. + * generic/tkStubInit.c (regenerated) + * generic/tkIntDecls.h (regenerated) - * doc/canvas.n: Documented -outlineoffset item option. [Bug 1836621] +2008-12-04 Donal K. Fellows <dkf@users.sf.net> -2007-12-14 Don Porter <dgp@users.sourceforge.net> + * doc/ttk_button.n, doc/ttk_checkbutton.n, doc/ttk_menubutton.n: + * doc/ttk_radiobutton.n: Added mention of the Toolbutton style to all + widgets that can sensibly make use of it. - * changes: More updates for 8.5.0 release. +2008-12-03 Joe English <jenglish@users.sourceforge.net> -2007-12-14 Joe English <jenglish@users.sourceforge.net> + * generic/ttk/ttkState.c, generic/ttk/ttkTheme.h, + * generic/ttk/ttkWidget.c, doc/ttk_widget.n: + Add new "hover" state (patch from Pat Thoyts; needed to support proper + visual feedback on Vista). - * doc/ttk_treeview.n: Fix typo. [Bug 1850713] +2008-11-29 Pat Thoyts <patthoyts@users.sourceforge.net> -2007-12-14 Pat Thoyts <patthoyts@users.sourceforge.net> + * library/ttk/altTheme.tcl: Use a styled frame around the popdown + * library/ttk/clamTheme.tcl: listbox so we can adjust the border + * library/ttk/classicTheme.tcl: for each theme as needed. + * library/ttk/combobox.tcl: + * library/ttk/defaults.tcl: + * library/ttk/winTheme.tcl: + * library/ttk/xpTheme.tcl: + * tests/ttk/combobox.test: - * win/tkWinInt.h: Add in missing function definitions - * win/tkWinButton.c: to support plain MSVC6 and use INT_PTR - * win/tkWinScrlBar.c: rather than LONG_PTR which isn'tr defined - * win/tkWinWm.c: in the msvc6 headers. +2008-11-28 Alexandre Ferrieux <ferrieux@users.sourceforge.net> -2007-12-14 Pat Thoyts <patthoyts@users.sourceforge.net> + * generic/tkCanvUtil.c: [Bug 1813597,2218964]: Millimeter patch. + * generic/tkInt.h: Eliminates the functional redundancy and + * generic/tkObj.c: unnecessary loss of precision of the + * generic/tkText.c: {pixel,mm}ObjType tandem. - * win/nmakehlp.c: Support compilation with MSVC9 for AMD64. - * win/makefile.vc: +2008-11-27 Jan Nijtmans <nijtmans@users.sf.net> -2007-12-13 Jeff Hobbs <jeffh@ActiveState.com> + * generic/tkCanvLine.c: Replace Tcl_SetResult(interp, NULL, ....) + * generic/tkEntry.c: calls with Tcl_ResetResult(interp) + * generic/tkMenu.c + * generic/tkOldConfig.c + * win/tkWinTest.c: Eliminate warning: unused variable 'tkwin' - * generic/tkMenubutton.c (ConfigureMenuButton): trace the - -textvariable even if an image exists as it may use -compound. +2008-11-23 Pat Thoyts <patthoyts@users.sourceforge.net> -2007-12-12 Jeff Hobbs <jeffh@ActiveState.com> + * generic/tkBind.c: [Bug 1389270]: event generate silently ignored + * generic/tkFocus.c: focus events. These can now be generated. + * generic/tkGrab.c: + * generic/tkInt.h: + * tests/bind.test: Fixed some locale dependencies in various + tests to reduce the noise on non-English windows systems. - * generic/tkText.c (DeleteIndexRange, TextEditCmd, UpdateDirtyFlag): - * tests/text.test (text-25.10.1,25.11.[12]): - Don't require [update idle] to trigger Modified event [Bug 1809538] - Modified virtual event should only fire on state change [Bug 1799782] - Make sure we delete chars before triggering <<Modified>> [Bug 1737288] +2008-11-22 Donal K. Fellows <dkf@users.sf.net> -2007-12-12 Daniel Steffen <das@users.sourceforge.net> + * library/demos/ctext.tcl: Extended to show off what you can do with + angled text; there is now a pie selector to change the orientation. - * macosx/tkMacOSXWm.c (ApplyMasterOverrideChanges): Revert 2007-10-26 - change to window class of transient toplevels that are not also - overrideredirect. [Bug 1845899] +2008-11-22 Pat Thoyts <patthoyts@users.sourceforge.net> - * macosx/tkMacOSXWm.c (ApplyMasterOverrideChanges): Implement more - * macosx/tkMacOSXMouseEvent.c (BringWindowForward): X11-like transient - * macosx/tkMacOSXSubwindows.c (XDestroyWindow): behaviour by adding - transient windows to a window group owned by the master window, this - ensures transients always remain in front of and are collapsed with the - master; bring master to front when selecting transient windows; restore - default window group of transients if master destroyed. [Bug 1845899] + * library/ttk/combobox.tcl: [Bug 1939129,1991930]: combobox dropdown + was drawn behind topmost toplevels. + * generic/tkCanvText.c: Fixed up complaints from MSVC engendered + * generic/tkFont.c: by the last commit. In particular replaced + * win/tkWinDraw.c: round() which is a C99 function. + * win/tkWinFont.c: -2007-12-12 Joe English <jenglish@users.sourceforge.net> +2008-11-22 Donal K. Fellows <dkf@users.sf.net> - * doc/ttk_intro.n, doc/ttk_style.n, doc/ttk_widget.n: - Various minor updates. + TIP #119 IMPLEMENTATION -2007-12-12 Don Porter <dgp@users.sourceforge.net> + * generic/tkCanvText.c: Added -angle configuration option to canvas + * generic/tkFont.c: text items. This required reengineering the + * library/prolog.ps: whole text rendering engine to be able to + * macosx/tkMacOSXFont.c: handle an angle! No change to any external + * unix/tkUnixFont.c: API. Note, this feature was originally + * unix/tkUnixRFont.c: approved for Tk 8.5, but it has proved much + * win/tkWinFont.c: harder to implement than originally + * generic/tkInt.h: estimated. [Patch 1611359] + * tests/canvText.test: - * changes: Updated for 8.5.0 release. +2008-11-22 Pat Thoyts <patthoyts@users.sourceforge.net> -2007-12-11 Joe English <jenglish@users.sourceforge.net> + * test/winDialog.test: [Bug 2307837]: Avoid some locale-dependent + * win/tkWinTest.c: failures by using id's or an english constraint - * generic/ttk/ttkTheme.c(StyleElementOptionsCmd): - Use Ttk_GetElement() to find element instead of direct - hash table access. +2008-11-19 Joe English <jenglish@users.sourceforge.net> -2007-12-11 Donal K. Fellows <dkf@users.sf.net> + * doc/ttk_panedwindow.n: [Bug 1824996]: Remove inoperative text + stating that slave windows must be direct children of the master. - * generic/tkText.c (TextReplaceCmd): Added code to rebuild the from - index after the deletion phase so that the linePtr field is valid for - the insertion phase. [Bug 1602537] +2008-11-19 Jan Nijtmans <nijtmans@users.sf.net> -2007-12-10 Donal K. Fellows <dkf@users.sf.net> + * generic/tkImgPhoto.c Minor simplification in fix for [Bug 2312027] + no need to malloc and copy photo type name + because it is a constant to begin with. + * generic/tkOldConfig.c Convert Tcl_SetResult(......, TCL_DYNAMIC) to + * mac/tkMacOSXWm.c Tcl_SetResult(......, TCL_VOLATILE), in + * unix/tkUnixWm.c preparation for TIP #340 + * unix/tkUnixSend.c + * win/tkWinWm.c - * doc/event.n: Clarify the fact that [event info] only returns the - names of virtual events that are bound to physical event sequences. - This follows on from comments on comp.lang.tcl. - http://groups.google.com/group/comp.lang.tcl/msg/935d2d226ae8a770 +2008-11-16 Joe English <jenglish@users.sourceforge.net> -2007-12-10 Joe English <jenglish@users.sourceforge.net> + * generic/ttk/ttkWidget.c: [Bug 2298720]: Widget self-destruction is + not necessarily an error. - * doc/AddOption.3, doc/CrtImgType.3, doc/CrtPhImgFmt.3, - * doc/InternAtom.3, doc/TextLayout.3, doc/chooseColor.n, - * doc/chooseDirectory.n, doc/loadTk.n, doc/palette.n, - * doc/ttk_combobox.n: Various markup fixes (mostly: missing quotes on - .SH arguments, extraneous .PPs) +2008-11-16 Donal K. Fellows <dkf@users.sf.net> - * doc/ttk_entry.n, doc/ttk_scrollbar.n, doc/ttk_treeview.n: Remove - extra .BEs that got added by mistake somewhere. + * doc/wm.n: Added note about [wm overrideredirect] so that users will + avoid making unwarranted assumptions about how magical it is. + Triggered by [Bug 2282861] discussion. -2007-12-10 Daniel Steffen <das@users.sourceforge.net> +2008-11-14 Pat Thoyts <patthoyts@users.sourceforge.net> - * generic/tk.decls: use new genstubs 'export' command to - * generic/tkInt.decls: mark exported symbols not in stubs - table [FR 1716117]; cleanup formatting + * generic/tk.h: The TIP 125 implementation permits the + * generic/tkFrame.c: [wm manage] command to manage any widget but + * macosx/tkMacOSXWm.c: only those with Frame instance data should be + * unix/tkUnixWm.c: permitted. We now check for the suitability and + * win/tkWinWm.c: raise an error for non-frame widgets. Updated + * test/wm.test: the tests and documentation. See also [Bug + * doc/wm.n: 2239034] - * generic/tkIntDecls.h: regen with new genStubs.tcl. - * generic/tkIntPlatDecls.h: [Tcl Bug 1834288] - * generic/tkIntXlibDecls.h: - * generic/tkPlatDecls.h: - * generic/tkStubInit.c: +2008-11-12 Joe English <jenglish@users.sourceforge.net> -2007-12-10 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + * generic/ttk/ttkWidget.c: Reworked widget construction and + destruction sequence; fixes [Bug 2207435] and several other problems + discovered during investigation of same. + * generic/ttk/ttkButton.c (CheckbuttonInitialize): Account for + initializeProc being called earlier in the construction sequence now. + * tests/ttk/ttk.test: Updated test suite. - * tests/safe.test: Ensure list of hidden commands is correct. [Bug - 1847925] +2008-11-12 Pat Thoyts <patthoyts@users.sourceforge.net> -2007-12-10 Pat Thoyts <patthoyts@users.sourceforge.net> + * library/text.tcl: [Bug 1777362]: Handle windows with funky names by + * test/text.test: avoiding use of the window path for anchors. - * win/tkWin.h: We must specify the lowest Windows version we intend to - support. In particular the SystemParametersInfo API doesn't like to - receive structures that are larger than it expects which affects the - font assignements. Set to Win98 support. +2008-11-11 Jan Nijtmans <nijtmans@users.sf.net> - * win/tkWinFont.c: Handle failure to read the system parameters. This - causes ttk/fonts.tcl to set any missing named fonts. + * generic/tkImgPhoto.c Fix [Bug 2265860] new test failures - * win/ttkWinMonitor.c: Only tkWin.h should include windows.h unless - * win/ttkWinTheme.c: we have an explicit override of the WINVER - * tin/ttkWinXPTheme.c: macro. +2008-11-11 Joe English <jenglish@users.sourceforge.net> - * win/rules.vc: Handle MSVC 9 (aka: Visual Studio 2008) + * generic/ttk/ttkWidget.c (BeginDrawing): [Bug 2264732]: Don't crash + when application uses nondefault visual. - * tests/safe.test: Update for 'unload' as a safe command (tcl 8.5b3+) +2008-11-11 Jan Nijtmans <nijtmans@users.sf.net> -2007-12-09 Donal K. Fellows <dkf@users.sf.net> + * win/tcl.m4: Reverted change from 2008-11-06 (was under the + impression that "-Wno-implicit-int" added an extra + warning) + * win/configure (regenerated) + * unix/tcl.m4: Use -O2 as gcc optimization compiler flag, and get + rid of -Wno-implicit-int for UNIX + * unix/configure (regenerated) - * win/configure.in: Adjusted code so that running configure does not - generate an error message when the full current directory name - contains a space. + * generic/tk.decls Modify Tk_Create(Old)ImageType signature, + * generic/tk.h relaxing the constraint that every Tk_ImageType + * generic/tkImage.c can only be passed to this function once. This + * generic/tkImgBmap.c lets tkImg be loaded in multiple interpreters + * generic/tkImgPhoto.c in a thread-enabled build of Tk. [Bug 2312027] + * generic/tkTest.c This CONSTification complies with TIP #27. It + * doc/CrtImgType.3 is binary compatible with the old interface, + but not fully source compatible (although tkImg + does not suffer). + * generic/tkDecls.h (regenerated) - * win/tkWinWm.c: Added set of #defs to make this file build with my - version of the SDK (i.e. with the msys suite we distribute). + *** POTENTIAL INCOMPATIBILITY *** -2007-12-07 Joe English <jenglish@users.sourceforge.net> +2008-11-09 Joe English <jenglish@users.sourceforge.net> - * library/ttk/altTheme.tcl, library/ttk/classicTheme.tcl: - s/style/ttk::style/. + * generic/ttk/ttkWidget.c: Remove unnecessary casts. -2007-12-07 Don Porter <dgp@users.sourceforge.net> + * generic/ttk/ttkWidget.h, generic/ttk/ttkWidget.c: Ttk widget + initializeProc()s now return void instead of a status code, and are no + longer allowed to fail. (Fix for [Bug 2207435] in progress). - * unix/README: Mention the stub library created by `make` and warn - about the effect of embedded paths in the installed binaries. Thanks - to Larry Virden. [Tcl Bug 1794084] + * generic/ttk/ttkButton.c, generic/ttk/ttkEntry.c, + * generic/ttk/ttkFrame.c, generic/ttk/ttkNotebook.c, + * generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c, + * generic/ttk/ttkScale.c, generic/ttk/ttkScrollbar.c, + * generic/ttk/ttkTreeview.c: Adjustments for the above. + +2008-11-09 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkCanvas.c: Make all Tk_CustomOption tables const and + * generic/tkCanvBmap.c: remove unnecessary type cast. + * generic/tkCanvImg.c: + * generic/tkCanvPoly.c: + * generic/tkCanvText.c: + * generic/tkCanvWind.c: + * generic/tkRectOval.c: + * generic/tkScrollbar.c: + * generic/tk.decls: Two more (hopefully the last) signature + * generic/tkInt.h: changes in Tk_CreateSmoothMethod and + * generic/tkCanvLine.c: Tk_CreatePhotoImageFormat + * generic/tkCanvUtil.c: + * generic/tkImgPhoto.c: + * generic/tkDecls.h: (regenerated) + * doc/CrtImgType.3: doc updates + * doc/CrtPhImgFmt.3: -2007-12-05 Joe English <jenglish@users.sourceforge.net> +2008-11-06 Jan Nijtmans <nijtmans@users.sf.net> - * macosx/ttkMacOSXTheme.c: Fix TCombobox layout so as not to truncate - long text when combobox is wider than requested. [Bug 1845164] + * win/tcl.m4: Add "-Wno-implicit-int" flag for gcc, as on UNIX + * win/configure: (regenerated) + * generic/default.h: Use tkUnixDefault.h under CygWin. With this + change, at least the X11 version of Tk can be + built with cygwin. -2007-12-05 Jeff Hobbs <jeffh@ActiveState.com> +2008-11-06 Donal K. Fellows <dkf@users.sf.net> - * library/demos/widget: reduce start size to 70% of screenheight from - sh-200 for a more reasonable size. + * unix/configure.in: [Bug 2229999]: Work around the fact that the + HP-UX system compiler cannot handle 'inline'. - * win/tkWinButton.c, win/tkWinDialog.c: use SetWindowLongPtr and - * win/tkWinScrlbr.c, win/tkWinWm.c: GetWindowLongPtr only. - * win/ttkWinMonitor.c: +2008-11-05 Jan Nijtmans <nijtmans@users.sf.net> - * win/tkWinInt.h: remove CS_CLASSDC (not recommended for any apps now) - * win/tkWinX.c: and simplify WNDCLASS to one style. - * win/tkWinWm.c: Reduce wrapper update for exStyle to toolwindow - change only and set WS_EX_LAYERED as sticky (once set on a window, do - not remove it) to reduce alpha transition flicker. + * unix/tkUnixFont.c: [Bug 2226093]: Const changes not all correct + * unix/tkUnixButton.c: More internal -Wwrite-strings warning fixes + * unix/tkUnixCursor.c: + * unix/tkUnixSend.c: + * unix/tkUnixRFont.c: + * generic/tkInt.h: No need to use CONST in internal header files + * generic/tkFont.h + * generic/tkInt.decls: CONSTify string and fileName parameters of + * generic/tkImgBmap.c: TkGetBitmapData + * generic/tkBitmap.c: Remove unneccessary type cast + * generic/tkIntDecls.h: (regenerated) + * doc/GetCursor.3: Fix documentation about obsolete X10 bitmaps + * doc/GetBitmap.3: [Bug 1866774]: Remove X10 references from docs + +2008-11-03 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/ttk/ttkEntry.c: Fix warning: unused variable `currentValue' + * generic/tkOldTest.c: Fix warning: assignment discards qualifiers + * win/tkWinTest.c: from pointer target type + +2008-11-03 Pat Thoyts <patthoyts@users.sourceforge.net> + + * tests/winClipboard.test: testclipboard no longer returns strings + with embedded \r but now returns Tcl strings + * tests/winfo.test: Fixed embedding test broken during upgrade + * tests/busy.test: Default wait cursor on windows is 'wait' + * win/tkWinFont.c: const fixes for the windows code. + +2008-11-02 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkFont.h: More internal -Wwrite-strings warning fixes + * generic/tkFont.c + * generic/ttk/ttkTheme.h + * generic/ttk/ttkDefaultTheme.c + * generic/ttk/ttkState.c + * macosx/tkMacOSXFont.c + * unix/tkUnixFont.c + * win/tkWinFont.c - * win/configure, win/tcl.m4 (LIBS_GUI): mingw needs -lole32 -loleaut32 - but not msvc for Tk's [send]. [Bug 1844749] +2008-11-01 Donal K. Fellows <dkf@users.sf.net> -2007-12-04 Joe English <jenglish@users.sourceforge.net> + TIP #97 IMPLEMENTATION - * doc/ttk_style.n: Remove nonsense about "this manpage has not yet - been written"; everything supported is documented. + * generic/tkCanvas.c (CanvasWidgetCmd): Implementation of the 'imove' + and 'rchars' subcommands. + * generic/tk.h (TK_MOVABLE_POINTS): New flag to allow items to state + whether they support finding and moving individual coordinates. + * doc/canvas.n, tests/canvas.test: Docs 'n' tests. -2007-12-04 Donal K. Fellows <dkf@users.sf.net> +2008-11-01 Pat Thoyts <patthoyts@users.sourceforge.net> - * library/msgs/en.msg: Added missing messages. [Patch 1800744] + * generic/ttk/ttkEntry.c: Implemented the themed spinbox + * library/ttk/altTheme.tcl: widget. + * library/ttk/clamTheme.tcl: + * library/ttk/classicTheme.tcl: + * library/ttk/defaults.tcl: + * library/ttk/entry.tcl: + * library/ttk/ttk.tcl: + * library/ttk/winTheme.tcl: + * library/ttk/xpTheme.tcl: + * library/ttk/spinbox.tcl: + * win/ttkWinTheme.c: + * win/ttkWinXPTheme.c: + * doc/ttk_spinbox.n: + * tests/ttk/spinbox.test: + +2008-10-31 Joe English <jenglish@users.sourceforge.net> + + * generic/widget.c: Temporary workaround for [Bug 2207435] + +2008-10-30 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tkAtom.c: more internal -Wwrite-strings warning fixes + * generic/tkBusy.c + * generic/tkButton.c + * generic/tkCanvPoly.c + * generic/tkCanvText.c + * generic/tkCmds.c + * generic/tkListbox.c + * generic/tkMenu.c + * generic/tkOldConfig.c + * generic/tkOption.c + * generic/tkPanedWindow.c + * generic/tkPlace.c + * generic/tkScale.c + * generic/tkTest.c + * generic/tkText.c + * generic/tkTextImage.c - * library/msgs/da.msg: Added Danish messages. [Patch 1844143]. Many - thanks to Torsten Berg <treincke@users.sf.net>. +2008-10-30 Don Porter <dgp@users.sourceforge.net> -2007-12-03 Jeff Hobbs <jeffh@ActiveState.com> + * tests/unixSelect.test: Revise the unixSelect-1.* tests so that + they test the ability of Tk's selection mechanism to faithfully pass + valid Tcl values without corruption, and stop testing details of + Tcl's internal encoding scheme. With this change, the Tk test suite + no longer uses the identity encoding or [string bytelength]. - * win/configure, win/tcl.m4 (LIBS_GUI): remove ole32.lib oleaut32.lib - (LIBS): add ws2_32.lib for static builds with Tcl. +2008-10-30 Jan Nijtmans <nijtmans@users.sf.net> -2007-12-01 Joe English <jenglish@users.sourceforge.net> + * generic/tk.h: CONSTify return value of + * generic/tkInt.h Tk_OptionPrintProc, and customPtr + * generic/tk.decls field of Tk_ConfigSpec. + * generic/tkCanvArc.c See [Bug 2190619]: Warnings due to + * generic/tkCanvLine.c Tk_SmoothMethod name constness change + * generic/tkCanvUtil.c + * generic/tkUtil.c + * generic/tkDecls.h: (regenerated) - * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h, - * generic/ttk/ttkTheme.c, generic/ttk/ttkLayout.c, - * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c, - * generic/ttk/ttkTreeview.c, macosx/ttkMacOSXTheme.c, - * win/ttkWinTheme.c, win/ttkWinXPTheme.c: Improved macrology for - statically-initialized layout template tables. +2008-10-29 Joe English <jenglish@users.sourceforge.net> -2007-11-28 Don Porter <dgp@users.sourceforge.net> + * generic/tkAtom.c(Tk_GetAtomName): Remove incorrect 'const' qualifier. + Remove useless 'register' declarations too, while we're at it. - * unix/tkUnixPort.h: When unix/configure determines whether the - intptr_t type is available, it has the <inttypes.h> header present. - It's only fair that we let Tk have it too. +2008-10-28 Jan Nijtmans <nijtmans@users.sf.net> -2007-11-26 Kevin Kenny <kennykb@acm.org> + * generic/tk.h: Add "const" to a few struct member fields. + * generic/tkInt.h: CONSTify TkPrintPadAmount + * generic/tkSelect.h: Move TkSelGetSelection to tkInt.decls + * generic/tk.decls: CONSTify Tk_ParseArgv + * generic/tkInt.decls: CONSTify TkCreateFrame and TkCreateMainWindow + * generic/tkDecls.h: (regenerated) + * generic/tkIntDecls.h: (regenerated) + * generic/tkArgv.c: + * generic/tkAtom.c: + * generic/tkEntry.c: + * generic/tkFrame.c: + * generic/tkImgPhoto.c: + * generic/tkPack.c: + * generic/tkSelect.c: + * generic/tkVisual.c: + * generic/tkWindow.c: + * win/tkWinTest.c: Fix compilation under mingw32 - * generic/tkImgPPM.c (StringReadPPM): Corrected a comparison whose - sense was reversed that resulted in reading beyond the end of the - input buffer on malformed PPM data. [Bug 1822391] - * library/tkfbox.tcl (VerifyFileName): Corrected a couple of typos in - handling of bad file names. [Bug 1822076] Thanks to Christoph Bauer - (fridolin@users.sf.net) for the patch. - * tests/filebox.test (filebox-7.1, filebox-7.2): Added test cases that - exercise. [Bug 1822076] - * tests/imgPPM.test (imgPPM-4.1): Added test case that exercises. [Bug - 1822391] +2008-10-28 Joe English <jenglish@users.sourceforge.net> -2007-11-25 Joe English <jenglish@users.sourceforge.net> + * library/ttk/cursors.tcl, library/ttk/combobox.tcl, + library/ttk/entry.tcl, library/ttk/paned.tcl, library/ttk/sizegrip.tcl, + library/treeview.tcl: + [Bug 2054562]: Add correct platform-specific cursors for OSX + [Bug 1534835]: Expanded set of symbolic cursors. Use correct cursor + for ttk::entry and ttk::combobox widgets - * generic/ttk/ttkManager.h, generic/ttk/ttkManager.c, - * generic/ttk/ttkFrame.c, generic/ttk/ttkNotebook.c, - * generic/ttk/ttkPanedwindow.c: Internal Ttk_Manager API updates; - Fixed [Bug 1343984]; Added [$nb hide] method; [$nb add] on - already-managed windows no longer throws an error, can be used to - re-add a hidden tab. +2008-10-28 Don Porter <dgp@users.sourceforge.net> - * doc/ttk_notebook.n, tests/ttk/notebook.test, - * tests/ttk/panedwindow.test: Updated docs and test suite. + * win/tkWinTest.c: [Bug 2191960]: Revise [testclipboard] + * tests/winClipboard.test: to form that handles encodings. + * tests/constraints.tcl: [tcltest::bytestring] no longer used. -2007-11-23 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-10-24 Joe English <jenglish@users.sourceforge.net> - * unix/README: General improvements. + * tests/ttk/ttk.test: [Bug 2175411]: Disable test ttk-6.3, it's not + applicable. -2007-11-21 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + * generic/ttk/ttkTheme.c: Use different Tcl_AssocData key so the tile + extension can be loaded into an 8.6 interp, in the off-chance that + anyone wants to do this. - * library/tkfbox.tcl: Better theming in the file list area. +2008-10-24 Donal K. Fellows <dkf@users.sf.net> -2007-11-19 Don Porter <dgp@users.sourceforge.net> + * generic/tkCanvUtil.c (TkSmoothPrintProc): [Bug 2190619]: Corrected + 'const'ness to quell warning. - *** 8.5b3 TAGGED FOR RELEASE *** +2008-10-23 Don Porter <dgp@users.sourceforge.net> - * README: Bump version number to 8.5b3. + * README: Bump version number to 8.6a4 * generic/tk.h: * library/tk.tcl: * unix/configure.in: @@ -2839,396 +4119,273 @@ a better first place to look now. * unix/configure: autoconf-2.59 * win/configure: - * changes: Update changes for 8.5b3 release. - -2007-11-19 Pat Thoyts <patthoyts@users.sourceforge.net> - - * generic/ttk/ttkTheme.c: Fix crash when 'style element create' - * tests/ttk/ttk.test: called w/ insufficient args; add tests. - -2007-11-18 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkElements.c, macosx/ttkMacOSXTheme.c: Add "fill" - element: like "background" but only erases parcel. - - * generic/ttk/ttkFrame.c: Use fill element in Labelframe Label - sublayout. Also improved default labelmargins for -labelanchor w*, e*. - - * generic/ttk/ttkLabel.c: no longer need Labelframe hack. - - * library/ttk/aquaTheme.tcl: ImageTextElement no longer needed. - TextElement no longer needs '-background' option. - - * generic/ttk/ttkFrame.c: Use sublayout for ttk::labelframe labels - instead of single element. - - * generic/ttk/ttkLabel.c: Default -anchor for text and label elements - is now "w" instead of "center". [Bug 1614540] +2008-10-22 Jan Nijtmans <nijtmans@users.sf.net> - * library/ttk/defaults.tcl, library/ttk/*Theme.tcl: Button styles now - need explicit "-anchor center". - - * generic/ttk/ttkLayout.c (TTKInitPadding): BUGFIX: - Ttk_GetPaddingFromObj() and Ttk_GetBorderFromObj() returned garbage - when passed an empty list. - - * macosx/ttkMacOSXTheme.c: Resynchronize with Tile codebase so that - patches can flow back and forth. - - * library/ttk/aquaTheme.tcl: Extra TButton -padding no longer needed. - -2007-11-18 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/ttkWinXPTheme.c: Add support for size information flags for - scrollbar and combobox buttons. This handles Tile [Patches 1596647 and - 1596657] but a bit more generically. - -2007-11-17 Pat Thoyts <patthoyts@users.sourceforge.net> - - * generic/(tkArgv.c, tkBind.c, tkCipboard.c, tkEntry.c, tkOption.c, - tkScale.c, tkScrollbar.c, tkTextImage.c, tkVisual.c, tkWindow.c): Tidy - up some variable types. - - * generic/tkFont.c: Only check for -displayof if there are - * test/font.test: sufficient arguments. This permits checking - strings like -d. - -2007-11-17 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/scrollbar.tcl: Swap in core scrollbars for - [ttk::scrollbar]s on OSX. - -2007-11-16 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> - - * macosx/tkMacOSXFont.c (TkpMeasureCharsInContext): Correct an - oversight in the bug fix from 2007-11-11. [Bug 1824638] - -2007-11-15 Daniel Steffen <das@users.sourceforge.net> - - * macosx/Wish.xcodeproj/project.pbxproj: add new chanio.test. - * macosx/Wish.xcode/project.pbxproj: - -2007-11-14 Donal K. Fellows <dkf@users.sf.net> - - * library/msgs/sv.msg: Get the locale declared within the message - catalog correct! [Bug 1831803] - -2007-11-11 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> - - * macosx/tkMacOSXFont.c (TkpMeasureCharsInContext): Fix the case when - TK_WHOLE_WORDS and TK_AT_LEAST_ONE are both set and maxLength is small. - [Bug 1824638] - -2007-11-09 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXCarbonEvents.c - (InstallStandardApplicationEventHandler): on Mac OS X Leopard, replace - the 2005-11-27 approach of installing the standard application handler - by calling RAEL and immediately longjmping out of it from an event - handler, as that now leads to crashes in -[NSView unlockFocus] whenever - HIToolbox uses Cocoa in Leopard (Help menu, Nav Services, Color - Picker). Instead call InstallStandardEventHandler() on the application - and menubar event targets, as Leopard ISEH finally handles these - correctly. Unfortunately need a HIToolbox-internal SPI to retrieve the - menubar event target, no public API appears have that functionality. - - * macosx/tkMacOSXDebug.c: make TkMacOSXInitNamedDebugSymbol() - * macosx/tkMacOSXDebug.h: available outside of debug builds as - the new Leopard ISAEH needs it. - - * macosx/tkMacOSXButton.c: replace HiliteControl() by modern API - * macosx/tkMacOSXMenubutton.c: for activation and enabling; - distinguish inactive and disabled - look&feel; correct activation handling - to match that of container toplevel. - - * macosx/tkMacOSXMenubutton.c: correct size computation of bevelbutton - variant to match that of buttons; - fix crash with bitmap due to NULL GC; - delay picParams setup until needed; - formatting cleanup. [Bug 1824521] - - * library/menu.tcl: correct handling of menubutton "active" - state on Aqua to match that of buttons. - - * macosx/tkMacOSXDefault.h: correct button & menubutton active - foreground and background colors and - menubutton border width. - - * macosx/tkMacOSXWindowEvent.c: handle kEventWindowExpanding carbon - * macosx/tkMacOSXCarbonEvents.c: event instead of kEventWindowExpanded - to ensure activate event arrives after - window is remapped, also need to - process all Tk events generated by - remapping in the event handler to - ensure children are remapped before - activate event is processed. - - * macosx/tkMacOSXSubwindows.c: add pixmap size field to MacDrawable - * macosx/tkMacOSXInt.h: struct; add flag for B&W pixmaps. - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXEmbed.c: - * macosx/tkMacOSXMenu.c: - - * macosx/tkMacOSXPrivate.h: correct Leopard HIToolboxVersionNumber. - - * macosx/ttkMacOSXTheme.c: add error checking; cleanup formatting. - - * macosx/tkMacOSXFont.c (TkpGetFontAttrsForChar): panic on false return - from TkMacOSXSetupDrawingContext(). - - * macosx/tkMacOSXButton.c: sync formatting, whitespace, copyright - * macosx/tkMacOSXDialog.c: with core-8-4-branch. - * macosx/tkMacOSXMenus.c: - * macosx/tkMacOSXWm.c: - * xlib/xgc.c - * library/bgerror.tcl: - * library/console.tcl: - * library/menu.tcl: - -2007-11-07 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkTheme.c (Ttk_ElementSize): Fixed longstanding, - subtle bug that caused element padding to sometimes be counted - twice in size computations. - - * generic/ttk/ttkElements.c, generic/ttk/ttkClamTheme.c, - generic/ttk/ttkDefaultTheme.c, generic/ttk/ttkTreeview.c, - generic/ttk/ttkImage.c, macosx/ttkMacOSXTheme.c, - win/ttkWinTheme.c, win/ttkWinXPTheme.c: Fix ElementSizeProcs affected - by previous change. - -2007-11-06 Andreas Kupries <andreask@activestate.com> - - * doc/CrtConsoleChan.3: Fixed markup typo and extended see also - section per suggestions by Donal. - -2007-11-05 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/combobox.tcl: Set focus to listbox in <Map> binding - instead of in Post command (see [Bug 1349811] for info). - -2007-11-05 Andreas Kupries <andreask@activestate.com> - - * doc/CrtConsoleChan.3: New file providing minimal documentation - of 'Tk_InitConsoleChannels()'. [Bug 432435] - -2007-11-05 Joe English <jenglish@users.sourceforge.net> - - * macosx/ttkMacOSXTheme.c (TreeitemLayout): Remove focus ring - from treeview items on OSX (problem reported by Kevin Walzer). - -2007-11-04 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkTreeview.c: Use null "treearea" element for - treeview owner-draw area instead of "client", to avoid - nameclash with Notebook.client element (this was causing - sizing anomalies in XP theme, and introduced extraneous - padding). - * generic/ttk/ttkDefaultTheme.c: Treeitem.indicator element - needs left margin now. - -2007-11-04 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXMenus.c: add "Run Widget Demo" menu item to the - default Edit menu along with associated carbon event handler enabling - the item only if demo files are installed; cleanup handling of "About" - and "Source" menu items. - - * library/bgerror.tcl: fix background of detail text on Aqua. - - * library/console.tcl: add accelerators and fix Aqua bindings - of the new font size menu items. - - * library/demos/mclist.tcl: Aqua GOOBE. - * library/demos/tree.tcl: - * library/demos/ttknote.tcl: - * library/demos/widget: - - * doc/chooseDirectory.n: remove/correct obsolete Mac OS 9-era - * doc/getOpenFile.n: information. - * doc/menu.n: - - * macosx/tkMacOSXEvent.c (TkMacOSXProcessCommandEvent): fix boolean arg - - * macosx/Wish.xcodeproj/project.pbxproj: add new demo file. - * macosx/Wish.xcode/project.pbxproj: - -2007-11-03 Pat Thoyts <patthoyts@users.sourceforge.net> - - * library/console.tcl: Add menu item and key binding to adjust font. - -2007-11-02 Donal K. Fellows <dkf@users.sf.net> - - * library/demos/mclist.tcl: Added a demo of how to do a multi-column - sortable listbox. - - * library/msgbox.tcl: Made message dialog use Ttk widgets for better - L&F. - - * library/tkfbox.tcl (::tk::dialog::file::CompleteEnt): Added <Tab> - completion. [FR 805091] - * library/tkfbox.tcl: Made file dialog use Ttk widgets for better L&F. - - * library/demos/sayings.tcl: Better resizing. [Bug 1822410] - -2007-11-01 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * library/demos/textpeer.tcl: Better resizing. [Bug 1822601] - - * doc/colors.n: Added list of Windows system colors. [Bug 945409] - -2007-11-01 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXColor.c (GetThemeColor): improve translation of RGB - pixel values into RGBColor. - - * library/demos/widget: increase height of main window text widget to - use more of the available vertical space. - - * doc/bind.n: document the Option modifier, clarify meaning - and availability of Command & Option. - - * doc/console.n: clarify availability of [console] in TkAqua. - -2007-11-01 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * generic/tk.h: CONST -> const and white-spacing + * generic/tk.decls + * generic/tkInt.decls + * generic/tkDecls.h: (regenerated) + * generic/tkIntDecls.h: (regenerated) + * generic/tkIntPlatDecls.h: (regenerated) + * generic/tkIntXlibDecls.h: (regenerated) + * generic/tkPlatDecls.h: (regenerated) + * generic/ttk/tk.decls + * generic/ttk/ttkDecls.h (regenerated) + * generic/ttk/ttkGenStubs.tcl - * unix/installManPage, doc/*.n: Make documentation use the name that - scripts use as much as possible. [Bug 1640073] +2008-10-20 Donal K. Fellows <dkf@users.sf.net> - * doc/text.n: Fixed mistake in [$t tag remove] docs. [Bug 1792191] + * generic/tkBusy.c, macosx/tkMacOSXEmbed.c, unix/tkUnixEmbed.c: + * win/tkWinWindow.c: [Bug 2180919]: Factor out the platform-specific + parts into the platform directories. - * doc/bind.n: Documented the Command modifier. [Bug 1232908] +2008-10-18 Donal K. Fellows <dkf@users.sf.net> - * doc/console.n, doc/wish.1: Made it clearer when and why the console - command is present. [Bug 1386955] + TIP #321 IMPLEMENTATION -2007-10-31 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + * generic/tkBusy.c, doc/busy.n, tests/busy.test: [Patch 1997907]: + Implementation of the [tk busy] command. - * library/demos/entry3.tcl: Improved description/comments so that - people better understand what is being validated, following suggestion - from Don Porter. +2008-10-18 Pat Thoyts <patthoyts@users.sourceforge.net> - * library/demos/image2.tcl (loadImage): Mark non-loadable images - as such instead of throwing a nasty dialog, following suggestion - from Don Porter. + * win/tkWinFont.c: [Bug 1825353]: To fix a problem with tiny fonts on + Russian versions of Windows we will avoid removing the internal + leading for fixed width fonts. - * generic/tkImgPhoto.c (Tk_PhotoPutBlock): More optimization, derived - from [Patch 224066]. +2008-10-15 Jan Nijtmans <nijtmans@users.sf.net> -2007-10-30 Joe English <jenglish@users.sourceforge.net> + * generic/tk.h: Add "const" to many internal const tables, so + * generic/tkBind.c: those will be put by the C-compiler in the + * generic/tkButton.c: TEXT segment instead of the DATA segment. + * generic/tkCanvas.c: This makes those tables as being shareable in + * generic/tkClipboard.c: shared libraries. + * generic/tkCmds.c: + * generic/tkConsole.c: + * generic/tkEntry.c: + * generic/tkFocus.c: + * generic/tkFrame.c: + * generic/tkGet.c: + * generic/tkGrab.c: + * generic/tkGrid.c: + * generic/tkImage.c: + * generic/tkImgBmap.c: + * generic/tkImgGIF.c: + * generic/tkImgPhoto.c: + * generic/tkListbox.c: + * generic/tkMenu.c: + * generic/tkMenu.h: + * generic/tkMenubutton.c: + * generic/tkMessage.c: + * generic/tkOption.c: + * generic/tkPack.c: + * generic/tkPanedWindow.c: + * generic/tkPlace.c: + * generic/tkScale.c: + * generic/tkSelect.c: + * generic/tkSquare.c: + * generic/tkTest.c: + * generic/tkText.c: + * generic/tkTextDisp.c: + * generic/tkTextMark.c: + * generic/tkTextTag.c: + * generic/tkTextWind.c: + * macosx/tkMacOSXDialog.c: + * macosx/tkMacOSXSend.c: + * macosx/tkMacOSXWin.c: + * unix/tkUnixFont.c: + * unix/tkUnixWm.c: + * win/tkWinButton.c: + * win/tkWinColor.c: + * win/tkWinDialog.c: + * win/tkWinMenu.c: + * win/tkWinSend.c: + * win/tkWinWm.c: + * xlib/xcolors.c: - * library/ttk/combobox.tcl (Unpost): BUGFIX: Unpost can be called with - no preceding Post. +2008-10-17 Pat Thoyts <patthoyts@users.sourceforge.net> -2007-10-31 Pat Thoyts <patthoyts@users.sourceforge.net> + * library/ttk/scale.tcl: Implemented keyboard bindings for ttk::scale - * win/rules.vc: Use -fp:strict with msvc8 as -fp:precise fails on - * generic/tkObj.c: amd64 builds. Fix the two places in Tk that - * generic/tkTrig.c: generate errors with msvc8 when using this flag. +2008-10-15 Jan Nijtmans <nijtmans@users.sf.net> -2007-10-30 Jeff Hobbs <jeffh@ActiveState.com> + * generic/tkInt.h: Add "const" to many internal const tables, so + * generic/tk3d.c: those will be put by the C-compiler in the + * generic/tkBitmap.c: TEXT segment instead of the DATA segment. + * generic/tkColor.c: This makes those tables as being shareable in + * generic/tkConfig.c: shared libraries. + * generic/tkCursor.c: + * generic/tkFont.c: + * generic/tkObj.c: + * generic/tkStyle.c: + * generic/tkTextIndex.c: + * generic/tkUtil.c: - * library/choosedir.tcl: only enable OK button when valid in - conjunction with -mustexist. [Bug 1550528] +2008-10-14 Donal K. Fellows <dkf@users.sf.net> - * library/listbox.tcl (::tk::ListboxBeginSelect): ignore -takefocus - when considering focus on <1>, it is for tab focus. + * generic/tkObj.c (TkNewWindowObj): Added utility function for making + a Tcl_Obj from a Tk_Window reference. Candidate for future exposure to + third-party code I suppose, but useful internal to Tk for sure. -2007-10-30 Don Porter <dgp@users.sourceforge.net> +2008-10-11 Donal K. Fellows <donal.k.fellows@man.ac.uk> - * generic/tk.h: Bump version number to 8.5b2.1 to distinguish - * library/tk.tcl: CVS development snapshots from the 8.5b2 - * unix/configure.in: release. - * unix/tk.spec: - * win/configure.in: + * generic/tkCanvas.c (CanvasWidgetCmd): Corrected result generation. - * unix/configure: autoconf (2.59) - * win/configure: +2008-10-10 Don Porter <dgp@users.sourceforge.net> -2007-10-30 Jeff Hobbs <jeffh@ActiveState.com> + *** 8.6a3 TAGGED FOR RELEASE *** - * doc/text.n: fix spelling of -inactiveselectbackground [Bug 1626415] + * changes: Updates for 8.6a3 release. - * library/entry.tcl: don't error with Clear event. [Bug 1509288] +2008-10-09 Don Porter <dgp@users.sourceforge.net> - * library/ttk/fonts.tcl: use size -12 TkFixedFont (was -10) on X11 + * generic/tkListbox.c: Make literal return values consistent with + those generated by Tcl_PrintDouble(). -2007-10-30 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + * tests/entry.test: Restore test naming consistency with Tk 8.5. + * tests/listbox.test: Remove some more dependency on precision in + * tests/spinbox.test: test results. - * library/demos/unicodeout.tcl: Fixed Arabic and Hebrew rendering on - Windows. [Bug 1803723] +2008-10-08 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tkImgPhoto.c (ImgPhotoCmd): Rename enumeration for somewhat - simpler-to-read code. [Bug 1677613] + * unix/tcl.m4: [Bug 2073255]: fix + * unix/configure: regenerated -2007-10-30 Joe English <jenglish@users.sourceforge.net> +2008-10-08 Don Porter <dgp@users.sourceforge.net> - * generic/ttk/ttkWidget.c: Split up RedisplayWidget() to factor out - double-buffering related code. + * tests/textDisp.test (textDisp-16.34): Update test that tested string + equality of double values based on an assumption of tcl_precision==12. + Test now does its own formatting. - * macosx/ttkMacOSXAquaTheme.c: Use SetThemeBackGround/ - kThemeBrushModelessDialogBackground{Active|Inactive} instead of - ApplyThemeBackground/kThemeBackgroundWindowHeader (advice from DAS). + * tests/scrollbar.test: Revised testing of the cget subcommand so that + it tests consistency with the configure subcommand and not agreement + with a hardcoded value that will change as tastes in GUIs evolve. - * library/ttk/aquaTheme.tcl: Use darker shade for inactive and - disabled text, to match typical values of most - kThemeXXXTextColorInactive values. + * tests/canvText.test (canvText-17.1): Update expected result to match + revised PostScript output due to more predictable formatting of + floating point values. -2007-10-30 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * unix/tkUnixWm.c: [Bug 2021443]: Restored consistency of error + * macosx/tkMacOSXWm.c: messages from [wm iconphoto] with the test + * tests/unixWm.test: suite and across all platforms. - * doc/selection.n: Clarify UTF8_STRING handling. [Bug 1778563] +2008-10-07 Pat Thoyts <patthoyts@users.sourceforge.net> - * doc/text.n: Clarify search subccommand docs. [Bug 1622919] + * tests/canvImg.test: Removed dependency on precision in results + * tests/canvRect.test: + * tests/canvText.test: + * tests/entry.test: + * tests/listbox.test: + * tests/scrollbar.test: + * tests/spinbox.test: + * tests/winWm.test: Fixed incorrect error strings + * tests/wm.test: -2007-10-29 Jeff Hobbs <jeffh@ActiveState.com> +2008-10-06 Pat Thoyts <patthoyts@users.sourceforge.net> + + * tests/winDialog.test: Fixed tests for Vista+ + * win/tkWinWm.c: corrected some errors from the previous commit + +2008-10-05 Donal K. Fellows <dkf@users.sf.net> + + * win/tkWinWm.c (WmAttributesCmd, WmOverrideredirectCmd) + (WmStackorderCmd): + * win/tkWinSendCom.c (Async): + * win/tkWinSend.c (Tk_SendObjCmd): + * win/tkWinFont.c (TkpGetFontFamilies, TkpGetSubFonts): + * unix/tkUnixWm.c (WmOverrideredirectCmd, WmStackorderCmd): + * unix/tkUnixFont.c (TkpGetFontFamilies, TkpGetSubFonts): + * macosx/tkMacOSXWm.c (WmOverrideredirectCmd, WmStackorderCmd): + * generic/tkTextIndex.c (SetTextIndexFromAny): + * generic/tkTest.c (TrivialConfigObjCmd): + * generic/tkSelect.c (HandleTclCommand): + * generic/tkPanedWindow.c (Tk_PanedWindowObjCmd) + (PanedWindowSashCommand, PanedWindowProxyCommand): + * generic/tkMenubutton.c (Tk_MenubuttonObjCmd): + * generic/tkMenu.c (MenuWidgetObjCmd): + * generic/tkListbox.c (ListboxWidgetObjCmd): + * generic/tkImgPhoto.c (ImgPhotoCmd): (mostly) + * generic/tkImage.c (Tk_ImageObjCmd): + * generic/tkFont.c (Tk_FontObjCmd, GetAttributeInfoObj): + * generic/tkEntry.c (EntryWidgetObjCmd, SpinboxWidgetObjCmd): + * generic/tkConfig.c (SetOptionFromAny, Tk_SetOptions): + * generic/tkCmds.c (Tk_TkObjCmd, Tk_WinfoObjCmd, TkGetDisplayOf): + * generic/tkButton.c (ButtonCreate): Get rid of code that insists on + non-idiomatically writing to the object in the interpreter result. + +2008-10-03 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkArgv.c, generic/tkCanvText.c, generic/tkEntry.c: + * generic/tkListbox.c, generic/tkScrollbar.c, macosx/tkMacOSXScrlbr.c: + * win/tkWinScrlbr.c: [Bug 2112563]: Convert use of %g to + Tcl_PrintDouble to create string versions of floats so as to avoid + trouble with some locales. + +2008-10-02 Joe Mistachkin <joe@mistachkin.com> + + * doc/canvas.n: Fix unmatched font change. + * win/buildall.vc.bat: Prefer the HtmlHelp target over the WinHelp + target. + +2008-10-01 Donal K. Fellows <dkf@users.sf.net> + + TIP #236 IMPLEMENTATION + + * doc/canvas.n, generic/tkCanvas.c (CanvasWidgetCmd) + * tests/canvMoveto.test: Added 'moveto' subcommand to canvases to + allow items to be easily moved to a particular place. + +2008-09-23 Donal K. Fellows <dkf@users.sf.net> + + * doc/listbox.n (SEE ALSO): [Bug 2123813]: Redirected this to + ttk::treeview(n) which is far more useful (it does multicolumn listbox + duties). + + * doc/*.n: [Bug 2118116]: Make sure that the initial line of the + manpage includes nothing that chokes old versions of man. - * macosx/tkMacOSXFont.c (InitSystemFonts): - * library/ttk/fonts.tcl: use Monaco 11 (was 9) as Aqua TkFixedFont +2008-08-25 Todd M. Helfter <tmh@users.sourceforge.net> - * tests/listbox.test, tests/panedwindow.test, tests/scrollbar.test: - * library/bgerror.tcl, library/dialog.tcl, library/listbox.tcl: - * library/msgbox.tcl, library/optMenu.tcl, library/tclIndex: - * library/tkfbox.tcl, library/demos/floor.tcl, library/demos/rmt: - * library/demos/tcolor, library/demos/text.tcl: - * library/demos/twind.tcl, library/demos/widget: Buh-bye Motif look - * library/ttk/fonts.tcl: Update of Tk default look in 8.5 - * macosx/tkMacOSXDefault.h: Trims border sizes, cleaner X11 look - * unix/tkUnixDefault.h: with minor modifications for Win32/Aqua. - * win/tkWinDefault.h: Uses Tk*Font definitions throughout for - * win/tkWinFont.c: classic widgets. [Bug 1820344] - * library/obsolete.tcl (::tk::classic::restore): This restores - changes made to defaults in 8.5 using the 'option' command, - segmented into logical groups. + * library/menu.tcl: [Bug 1023955]: Additional fix. - * tests/winfo.test: winfo-4.5 raise .t to above . for Windows +2008-09-08 Todd M. Helfter <tmh@users.sourceforge.net> - * tests/unixWm.test: note TIP#142 results and remove unnecessary - catches. + * doc/menu.n: [Bug 2098425]: Fix typo in docs. -2007-10-29 Donal K. Fellows <donal.k.fellows@man.ac.uk> +2008-09-03 Don Porter <dgp@users.sourceforge.net> - * doc/*.1, doc/*.n, doc/*.3: Lots more GOOBE work. + * generic/tk.h: Dropped use of _ANSI_ARGS_ macro to preserve + * generic/tkSelect.h: Tk's TCL_NO_DEPRECATED build. -2007-10-28 Joe English <jenglish@users.sourceforge.net> +2008-08-30 Ania Pawelczyk <aniap@users.sourceforge.net> - * library/ttk/combobox.tcl: Make popdown window [wm resizable 0 0] on - OSX, to prevent TkAqua from shrinking the scrollbar to make room for a - grow box that isn't there. - * macosx/ttkMacOSXTheme.c, library/ttk/aquaTheme.tcl: Reworked - combobox layout. + * tests/textWind.test: Update to tcltest2 + * tests/unixSelect.test: + * tests/visual_bb.test: + * tests/visual.test: + * tests/window.test: + * tests/winfo.test: + * tests/xmfbox.test: + * tests/winButton.test: + * tests/winDialog.test: + * tests/winFont.test: + * tests/winMenu.test: + * tests/winMsbox.test: + * tests/winWm.test: -2007-10-26 Don Porter <dgp@users.sourceforge.net> +2008-08-28 Don Porter <dgp@users.sourceforge.net> - *** 8.5b2 TAGGED FOR RELEASE *** + * unix/tkConfig.sh.in: Added @XFT_LIBS@ to the definition of TK_LIBS + to avoid link failures when a "big wish" program links against a + --disable-shared build of libtk. (Discovered building expectTk.) - * changes: Update changes for 8.5b2 release. + * generic/tkImgPhoto.c: Changed TclStack* calls to ck* calls so that + we don't create new dependencies on Tcl internals. - * doc/*.1: Revert doc changes that broke - * doc/*.3: `make html` so we can get the release - * doc/*.n: out the door. + * unix/tkUnixPort.h: Removed #include of tclInt.h that has been + * win/tkWinPort.h: disabled for three years. If we needed this + we'd have noticed by now. - * README: Bump version number to 8.5b2. + * README: Bump version number to 8.6a3 * generic/tk.h: * library/tk.tcl: * unix/configure.in: @@ -3238,2620 +4395,614 @@ a better first place to look now. * unix/configure: autoconf-2.59 * win/configure: -2007-10-26 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWm.c (ApplyMasterOverrideChanges): fix window class - of transient toplevels that are not also overrideredirect. [Bug - 1816252] - - * macosx/tkMacOSXDialog.c: TIP#242 cleanup. - * library/demos/filebox.tcl: demo TIP#242 -typevariable. - -2007-10-25 Joe English <jenglish@users.sourceforge.net> +2008-08-28 Donal K. Fellows <dkf@users.sf.net> - * generic/ttk/ttkNotebook.c: [Bug 1817596] - -2007-10-25 Jeff Hobbs <jeffh@ActiveState.com> - - * doc/getOpenFile.n: TIP#242 implementation of -typevariable to - * library/tkfbox.tcl: return type of selected file in file dialogs. - * library/xmfbox.tcl: [Bug 1156388] - * macosx/tkMacOSXDialog.c: - * tests/filebox.test: - * tests/winDialog.test: - * win/tkWinDialog.c: + * tests/imgPhoto.test: [Bug 2080587]: Fix failures. -2007-10-25 Don Porter <dgp@users.sourceforge.net> +2008-08-28 Ania Pawelczyk <aniap@users.sourceforge.net> - * generic/tkPlace.c: Prevent segfault in place geometry manager. - Thanks to Colin McDonald. [Bug 1818491] - -2007-10-24 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/*.c, win/{ttkWinMonitor,ttkWinTheme,ttkWinXPTheme}.c, - * macosx/ttkMacOSXTheme.c: Move widget layout registration - from TtkElements_Init() to widget *_Init() routines. - Renaming/consistency: s/...ElementGeometry()/...ElementSize()/ - -2007-10-24 Donal K. Fellows <donal.k.fellows@man.ac.uk> - - * doc/*.n, doc/*.3, doc/*.1: Lots of changes to take advantage of the - new macros. - -2007-10-24 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/tkWinDraw.c: Applied [Patch 1723362] for transparent bitmaps. - - * generic/tkWindow.c: permit wm manage of any widget (esp: ttk::frame) - -2007-10-23 Jeff Hobbs <jeffh@ActiveState.com> - - * library/ttk/combobox.tcl (ttk::combobox::PopdownWindow): redo wm - transient on each drop to handle reparent-able frames. [Bug 1818441] - -2007-10-23 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/combobox.tcl: [namespace import ::ttk::scrollbar] - doesn't work, since ttk::scrollbar isn't [namespace export]ed. - -2007-10-23 Don Porter <dgp@users.sourceforge.net> - - * tests/cursor.test: Make tests robust against changes in Tcl's - rules for accepting integers in octal format. - -2007-10-23 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * doc/font.n: Added section on the TIP#145 fonts. - -2007-10-23 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/tkWinFont.c: Fixed leak in CreateNamedFont spotted by das. - -2007-10-23 Daniel Steffen <das@users.sourceforge.net> - - * library/demos/combo.tcl: Aqua GOOBE. - * library/demos/toolbar.tcl: - * library/demos/tree.tcl: - * library/demos/ttknote.tcl: - * library/demos/ttkprogress.tcl: - * library/demos/widget: - - * macosx/Wish.xcodeproj/project.pbxproj: add new demo files. - * macosx/Wish.xcode/project.pbxproj: - -2007-10-22 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * library/demos/widget: Added more demos, reorganized to make Tk and - Ttk demos seem to be more coherent whole. Made localization a bit - easier by reducing the amount of duplication. - * library/demos/{combo,toolbar,tree,ttknote,ttkprogress}.tcl: New - demos of new (mostly) Ttk widgets. - * library/demos/ttkbut.tcl: Improvements. - -2007-10-22 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/combobox.tcl: ttk::combobox overhaul; fixes [Bugs - 1814778, 1780286, 1609168, 1349586] - * library/ttk/aquaTheme.tcl: Factored out aqua-specific combobox - -postposition adjustments. - * generic/ttk/ttkTrack.c: Detect [grab]s and unpress pressed - element; combobox workaround no longer - needed. - -2007-10-22 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXFont.c: register named fonts for TIP #145 fonts - and all theme font IDs. - - * generic/tkFont.c (Tk{Create,Delete}NamedFont): allow NULL interp. - - * library/ttk/fonts.tcl: check for TIP #145 fonts on all - platforms; correct aqua font sizes. - - * library/demos/ttkmenu.tcl: Aqua GOOBE. - * library/demos/ttkpane.tcl: - * library/demos/widget: - - * macosx/Wish.xcodeproj/project.pbxproj: add new demo files. - * macosx/Wish.xcode/project.pbxproj: - -2007-10-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * library/demos/ttkmenu.tcl: Added more demos of Ttk widgets. These - * library/demos/ttkpane.tcl: ones are of menubuttons, panedwindows and - a progress bar (indirectly). + * tests/option.test: Update to tcltest2 + * tests/place.test: + * tests/scale.test: + * tests/select.test: + * tests/textBTree.test: + * tests/textImage.test: + * tests/textMark.test: + * tests/textTag.test: + * tests/unixMenu.test: -2007-10-18 Pat Thoyts <patthoyts@users.sourceforge.net> +2008-08-25 Todd M. Helfter <tmh@users.sourceforge.net> - * library/ttk/fonts.tcl: Create all the TIP #145 font names on all - platforms (mac and unix get handled in script, windows in C) + * library/menu.tcl: [Bug 1023955]: Fix typo. -2007-10-17 David Gravereaux <davygrvy@pobox.com> +2008-08-27 Peter Spjuth <peter.spjuth@gmail.com> - * bitmaps/*.xbm: Changed CVS storage mode from -kb to -kkv as these - are really text files, not binaries. - * win/makefile.vc: Added $(BITMAPDIR) to the search path for the - depend target. + * tests/grid.test: [Bug 2075285]: Added a "knownBug"-marked test to + show a problem identified in the grid implementation. -2007-10-18 Daniel Steffen <das@users.sourceforge.net> +2008-08-26 Donal K. Fellows <dkf@users.sf.net> - * library/demos/widget: Aqua GOOBE, cleanup icons. - * library/demos/ttkbut.tcl: - * library/demos/entry3.tcl: - * library/demos/msgbox.tcl: + * tests/imgPhoto.test: More style improvements. - * library/demos/button.tcl: restore setting of button - highlightbackground on Aqua. +2008-08-25 Todd M. Helfter <tmh@users.sourceforge.net> - * macosx/ttkMacOSXTheme.c: adjust button and separator geometry. + * library/menu.tcl: [Bug 1023955]: Do not flip to the arrow cursor on + menus. This was a Motif convention. Current behavior is maintained iff + tk_strictMotif is enabled. - * macosx/tkMacOSXWm.c: fix warnings. +2008-08-25 Donal K. Fellows <dkf@users.sf.net> - * macosx/Wish.xcodeproj/project.pbxproj: add new demo files. - * macosx/Wish.xcode/project.pbxproj: + * generic/tkImgPhoto.c (ImgPhotoConfigureMaster): Ensure that uses of + TclStackAlloc and TclStackFree balance. -2007-10-17 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-08-25 Todd M. Helfter <tmh@users.sourceforge.net> - * library/demos/ttkbut.tcl: Added demo of the basic Ttk widgets. + * library/tkfbox.tcl: [Bug 1936220]: Fix the multiple selection error + for tk_getOpenFile -multiple 1 which fails on all unix platforms since + the adoption of ttk widgets. -2007-10-16 David Gravereaux <davygrvy@pobox.com> +2008-08-25 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgPhoto.c: Split the implementation of the core of + * generic/tkImgPhoto.h: photo images into two pieces, the photo + * generic/tkImgPhInstance.c: master (which manages the data model and + the interaction with the script level) and the photo instances (which + handle display). + +2008-08-22 Don Porter <dgp@users.sourceforge.net> + + *** 8.6a2 TAGGED FOR RELEASE *** + + * changes: Updates for 8.6a2 release. + +2008-08-21 Ania Pawelczyk <aniap@users.sourceforge.net> + + * tests/menuDraw.test: Update to tcltest2 + * tests/msgbox.test: + * tests/oldpack.test: + * tests/pack.test: + * tests/panedwindow.test: + +2008-08-21 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkOption.c (ExtendArray): Rework so that the code uses + ckrealloc (idiomatically) rather than its home-brewed version. + +2008-08-19 George Peter Staplin <georgeps@users.sourceforge.net> + + [Bug 2039720]: After some discussion with Joe English and subsequently + the X.org developers (Keith Packard in particular), it was discovered + that Tk is doing management of XIDs that it shouldn't need to do. The + very common XC-MISC extension which has come with every version of X + for the last 15 years is used with Xlib now, to retrieve the + information about the used/unused XIDs. The public Tk_FreeXId is now a + no-op. + + * generic/tkError.c: Remove the usage of TkpWindowWasRecentlyDeleted. + * generic/tkInt.decls: Update the declarations for the now unused + internal stubs. + * generic/tkIntDecls.h: Regenerated based on tkInt.decls. + * generic/tkIntPlatDecls.h: Regenerated based on tkInt.decls. + * generic/tkStubInit.c + * generic/tkWindow.c: Remove the calls to TkInitXId, and + TkFreeWindowId. + * macosx/tkMaxOSXPort.h: Remove TkFreeWindowId and TkInitXId macro + definitions. + * macosx/tkMacOSXXStubs.c: Remove the no-op + TkpWindowWasRecentlyDeleted. + * unix/tkUnixEvent.c: Remove call to TkFreeXId. + * unix/tkUnixXId.c: Remove a lot of unnecessary code (see above). + * win/tkWinPort.h: Remove TkFreeWindowId and TkInitXId. + * win/tkWinWindow.c: Remove TkpWindowWasRecentlyDeleted. + * tests/id.test: Remove this unnecessary test. - * win/makefile.vc: depend target now works and builds a generated - dependency list with $(TCLTOOLSDIR)/mkdepend.tcl +2008-08-19 Joe English <jenglish@users.sourceforge.net> -2007-10-16 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + * generic/ttk/ttkScroll.c: Don't use sprintf "%g" to format floating + point numbers in -[xy]scrollcommand callbacks or [xy]view methods. + Minor incompatibility: 0 and 1 now formatted as "0.0" resp "1.0". + * tests/ttk/entry.test, tests/ttk/treeview.test: Updated to account + for above change. - * library/demos/widget: Made the code for generating the contents of - the main widget more informative. Added 'new' flagging for wholly new - demos. +2008-08-19 Daniel Steffen <das@users.sourceforge.net> - * doc/text.n: Made it clearer what things are text widget invokations - and what are not. Also some other clarity improvements. + * macosx/tkMacOSXFont.c (SetFontFeatures): Disable antialiasing of + fixed-width fonts with + size <= 10. -2007-10-15 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-08-18 Ania Pawelczyk <aniap@users.sourceforge.net> - * library/demos/widget: Use Ttk widgets for the widget demo core, for - vastly improved look-and-feel on at least one platform (Windows). - * library/demos/{button,check,style,twind}.tcl: Various tweaks for - GOOBE... - * library/demos/textpeer.tcl: New demo script to show off peering as a - specific feature. + * tests/canvWind.test: Update to tcltest2 + * tests/menubut.test: + * tests/raise.test: + * tests/unixButton.test: + * tests/unixEmbed.test: + * tests/winClipboard.test: -2007-10-15 Jeff Hobbs <jeffh@ActiveState.com> +2008-08-17 Ania Pawelczyk <aniap@users.sourceforge.net> - * generic/tkFocus.c, generic/tkFrame.c, generic/tkInt.h: - * macosx/tkMacOSXButton.c, macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXWm.c, unix/tkUnixWm.c, win/tkWinWm.c: - * doc/wm.n, tests/wm.test: TIP #125 implementation [Bug 998125] - Adds [wm manage|forget] for dockable frames. - Finished X11 and Windows code, needs OS X completion. + * tests/focus.test: Update to tcltest2 + * tests/focusTcl.test: + * tests/geometry.test: + * tests/grab.test: + * tests/grid.test: + * tests/imgBmap.test: + * tests/imgPhoto.test: + * tests/imgPPM.test: + * tests/listbox.test: + * tests/safe.test: + * tests/tk.test: + * tests/util.test: -2007-10-15 Joe English <jenglish@users.sourceforge.net> +2008-08-15 Ania Pawelczyk <aniap@users.sourceforge.net> - * generic/ttk/ttkTreeview.c: Store pointer to column table entry - instead of column index in columnNames hash table. This avoids the - need for the evil PTR2INT and INT2PTR macros, and simplifies things a - bit. + * tests/clrpick.test: Update to tcltest2 + * tests/frame.test: + * tests/font.test: + * tests/image.test: -2007-10-15 Daniel Steffen <das@users.sourceforge.net> +2008-08-14 Ania Pawelczyk <aniap@users.sourceforge.net> - * generic/tkArgv.c: Fix gcc warnings about 'cast to/from - * generic/tkCanvUtil.c: pointer from/to integer of different - * generic/tkCanvas.c: size' on 64-bit platforms by casting - * generic/tkCursor.c: to intermediate types - * generic/tkInt.h: intptr_t/uintptr_t via new PTR2INT(), - * generic/tkListbox.c: INT2PTR(), PTR2UINT() and UINT2PTR() - * generic/tkObj.c: macros. - * generic/tkStyle.c: - * generic/tkTextIndex.c: - * generic/tkUtil.c: - * generic/ttk/ttkTheme.h: - * generic/ttk/ttkTreeview.c: - * unix/tkUnixMenu.c: - * unix/configure.in: + * tests/event.test: Update to tcltest2 + * tests/id.test: + * tests/menu.test: - * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in: autoheader-2.59 +2008-08-14 Daniel Steffen <das@users.sourceforge.net> - * macosx/Wish-Common.xcconfig: add 'tktest-X11' target. - * macosx/Wish.xcode/project.pbxproj: - * macosx/Wish.xcode/default.pbxuser: - * macosx/Wish.xcodeproj/default.pbxuser: - * macosx/Wish.xcodeproj/project.pbxproj: + * unix/tcl.m4 (SC_PATH_X): Check for libX11.dylib in addition to + libX11.so et al. - * unix/configure.in (Darwin): add support for 64-bit X11. * unix/configure: autoconf-2.59 -2007-10-14 Jeff Hobbs <jeffh@ActiveState.com> - - * win/configure, win/configure.in (TK_WIN_VERSION): Make sure the - patchlevel doesn't contain extra dotted pairs (eg. interim release) +2008-08-12 Ania Pawelczyk <aniap@users.sourceforge.net> -2007-10-12 Pat Thoyts <patthoyts@users.sourceforge.net> + * tests/choosedir.test: Update to tcltest2 + * tests/clipboard.test: + * tests/embed.test: + * tests/main.test: - * win/makefile.vc: Mine all version information from headers. - * win/rules.vc: Sync tcl and tk and bring extension versions - * win/nmakehlp.c: closer together. Try and avoid using tclsh - to do substitutions as we may cross compile. - - * library/console.tcl: Use TkFixedFont and ttk widgets - -2007-10-12 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXDraw.c: replace all (internal) use of QD region - * macosx/tkMacOSXSubwindows.c: API by HIShape API, with conversion to - * macosx/tkMacOSXWindowEvent.c: QD regions only when required by legacy - * macosx/tkMacOSXPrivate.h: Carbon or Tk API. - * macosx/tkMacOSXRegion.c: - * macosx/tkMacOSXDebug.c: - * macosx/tkMacOSXDebug.h: - - * macosx/tkMacOSXInt.h: replace MacDrawable's QD RgnHandles - * macosx/tkMacOSXEmbed.c: clipRgn, aboveClipRgn & drawRgn by - * macosx/tkMacOSXMenu.c: HIShapeRefs visRgn & aboveVisRgn and - * macosx/tkMacOSXSubwindows.c: CGRect drawRect. - - * macosx/tkMacOSXWindowEvent.c: remove use of QD port vis rgn in window - * macosx/tkMacOSXSubwindows.c: update rgn calculation, manually excise - * macosx/tkMacOSXWm.c: growbox from toplevel clip rgn instead. - - * macosx/tkMacOSXDraw.c: replace use of QD port clip rgn by new - * macosx/tkMacOSXPrivate.h: clipRgn fld in TkMacOSXDrawingContext; - handle QD/CG drawing mismatches in - XCopyArea, XCopyPlane and TkPutImage; - cleanup/speedup CGContext setup in - TkMacOSXSetupDrawingContext(). - - * macosx/tkMacOSXDraw.c: change TkMacOSXSetupDrawingContext() to - * macosx/tkMacOSXEntry.c: return boolean indicating whether - * macosx/tkMacOSXFont.c: drawing is allowed (and was setup) or - * macosx/tkMacOSXMenu.c: not (e.g. when clipRgn is empty). - * macosx/ttkMacOSXTheme.c: +2008-08-12 Don Porter <dgp@users.sourceforge.net> - * macosx/tkMacOSXSubwindows.c: signal that drawable is a pixmap via - * macosx/tkMacOSXInt.h: new explicit TK_IS_PIXMAP flag instead - of a NULL cligRgn field. - - * macosx/tkMacOSXRegion.c: add wrappers for missing/buggy HIShape - * macosx/tkMacOSXPrivate.h: API, and private helpers to operate on - HIShapeRefs & convert to/from TkRegion. - - * macosx/tkMacOSXRegion.c: add Tkp{Retain,Release}Region() API for - * macosx/tkMacOSXInt.h: TkRegion. - - * xlib/xgc.c: factor out alloc/free of GC clip_mask; - * macosx/tkMacOSXXStubs.c: manage clip rgn lifetime with new - Tkp{Retain,Release}Region(). - - * macosx/tkMacOSXButton.c: delay picParams setup until needed. - - * generic/tkTextDisp.c (CharUndisplayProc): fix textDisp.test crash. - -2007-10-11 David Gravereaux <davygrvy@pobox.com> - - * win/winMain.c: Replaced incorrect comments in main() to descibe - why the console widget does not need to be created for this - application entry point (if used). Must have been a bad copy/paste - of WinMain() from 10 years back. - -2007-10-11 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWm.c (TkMacOSXGrowToplevel): manually constrain resize - limitBounds to maxBounds, works around SectRect() mis-feature (return - zero rect if input rect has zero height/width). [Bug 1810818] - -2007-10-09 Pat Thoyts <patthoyts@users.sourceforge.net> - - * generic/tkImage.c: Make Ttk_GetImage safe if called with NULL - * tests/ttk/image.test: interp. Added some tests that crash - on Windows without this fix. - -2007-10-02 Don Porter <dgp@users.sourceforge.net> - - [core-stabilizer-branch] - - * README: Bump version number to 8.5.0 + * README: Bump version number to 8.6a2 * generic/tk.h: * library/tk.tcl: - * unix/configure.in: Updated LOCALES. + * unix/configure.in: * unix/tk.spec: * win/configure.in: - * unix/configure: autoconf (2.59) + * unix/configure: autoconf-2.59 * win/configure: -2007-09-30 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/entry.tcl (WordBack, WordForward): - Fix private routines accidentally defined in global namespace - [Bug 1803836] - -2007-09-26 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * library/msgs/hu.msg: Added Hungarian message set, from Pader Reszo. - [Patch 1800742] - -2007-09-20 Donal K. Fellows <dkf@users.sf.net> - - *** 8.5b1 TAGGED FOR RELEASE *** - - * generic/tkTextDisp.c (LayoutDLine): Only call callbacks that are - * tests/textDisp.test (textDisp-32.3): not NULL. [Bug 1791052] - -2007-09-20 Don Porter <dgp@users.sourceforge.net> - - * changes: updates for 8.5b1 release. - -2007-09-19 Don Porter <dgp@users.sourceforge.net> - - * README: Bump version number to 8.5b1. - * generic/tk.h: Merge from core-stabilizer-branch. - * library/tk.tcl: Stabilizing toward 8.5b1 release now done - * unix/configure.in: on the HEAD. core-stabilizer-branch is - * unix/tk.spec: now suspended. - * win/configure.in: - -2007-09-19 Pat Thoyts <patthoyts@users.sourceforge.net> - - * generic/tkStubLib.: Replaced isdigit with internal implementation. - -2007-09-18 Don Porter <dgp@users.sourceforge.net> - - * generic/tkStubLib.c: Remove C library calls from Tk_InitStubs() - * win/makefile.vc: so that we don't need the C library linked - in to libtkStub. - -2007-09-18 Donal K. Fellows <donal.k.fellows@man.ac.uk> - - * generic/tkImgGIF.c (FileReadGIF, StringReadGIF): Rewrite for greater - clarity (more comments, saner code arrangement, etc.) - -2007-09-18 Pat Thoyts <patthoyts@users.sourceforge.net> - - * tests/all.tcl: Made ttk/all.tcl be the same as tk's all.tcl and - * tests/ttk/all.tcl: make use of file normalize (bugs noted by - mjanssen and GPS with msys) - -2007-09-17 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/makefile.vc: Add crt flags for tkStubLib now it uses C-library - functions. - -2007-09-17 Joe English <jenglish@users.sourceforge.net> - - * unix/tcl.m4: use '${CC} -shared' instead of 'ld -Bshareable' to - build shared libraries on current NetBSDs. [Bug 1749251] - * unix/configure: regenerated (autoconf-2.59). - -2007-09-17 Don Porter <dgp@users.sourceforge.net> - - * generic/tkConsole.c: Revised callers of Tcl_InitStubs() to account - * generic/tkMain.c: for restored compatible support for the call - * generic/tkWindow.c: Tcl_InitStubs(interp, TCL_VERSION, 1). Also - revised Tcl_PkgRequire() call for Tcl so that, for example, a Tk - library built against Tcl 8.5.1 headers will not refuse to [load] into - a Tcl 8.5.0 interpreter. [Tcl Bug 1578344] - - * generic/tk.h: Revised Tk_InitStubs() to restore Tk 8.4 - * generic/tkStubLib.c: source compatibility with callers of - * generic/tkWindow.c: Tk_InitStubs(interp, TK_VERSION, 1). - -2007-09-17 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/combobox.tcl: Try to improve combobox appearance on - OSX + Tk 8.5. [Bug 1780286] - -2007-09-15 Daniel Steffen <das@users.sourceforge.net> - - * unix/tcl.m4: replace all direct references to compiler by ${CC} to - enable CC overriding at configure & make time; run - check for visibility "hidden" with all compilers; - quoting fixes from TEA tcl.m4. - (SunOS-5.1x): replace direct use of '/usr/ccs/bin/ld' in SHLIB_LD by - 'cc' compiler driver. - * unix/configure: autoconf-2.59 - -2007-09-14 Daniel Steffen <das@users.sourceforge.net> - - * macosx/Wish-Common.xcconfig: enable Tcl DTrace support. - * macosx/Wish.xcodeproj/project.pbxproj: - -2007-09-12 Andreas Kupries <andreask@activestate.com> - - * win/Makefile.in (install-binaries): Fixed missing brace in the - * win/makefile.vc (install-binaries): generated package index file. - Note: unix/Makefile.in is good. - -2007-09-11 Reinhard Max <max@suse.de> - - * generic/tkImgGIF.c: Fixed a buffer overrun that got triggered by - multi-frame interlaced GIFs that contain subsequent frames that are - smaller than the first one. - - * tests/imgPhoto.test: Added a test for the above. - -2007-09-11 Don Porter <dgp@users.sourceforge.net> - - * generic/tkConsole.c: Revised calls to Tcl_InitStubs() and - * generic/tkMain.c: [package require Tcl] so that Tk Says What It - * generic/tkWindow.c: Means using the new facilties of [package] in - * library/tk.tcl: Tcl 8.5 about what version(s) of Tcl it is - * unix/Makefile.in: willing to work with. [Bug 1578344] - * win/Makefile.in: - * win/makefile.vc: - -2007-09-10 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/README: typo corrections [Bug 1788682] - -2007-09-10 Don Porter <dgp@users.sourceforge.net> - - * generic/tkConsole.c: Revise all Tcl_InitStubs() calls to restore - * generic/tkMain.c: the traditional practice that a Tk shared - * generic/tkWindow.c: library may [load] into a Tcl 8.5 interp at - any patchlevel. This practice also matches the compile time checks of - TCL_MAJOR_VERSION and TCL_MINOR_VERSION in tk.h. [Bug 1723622] - -2007-09-06 Don Porter <dgp@users.sourceforge.net> - - * generic/tkWindow.c (Initialize): Moved common Tk initialization - * generic/tkInitScript.h (removed): script out of tkInitScript.h - * macosx/tkMacOSXInit.c: and multiple TkpInit() routines and - * unix/Makefile.in: into the common Initialize() routine in - * unix/tkUnixInit.c: generic code. Also removed constraint on - * win/tkWinInit.c: ability to define a custom [tkInit] before - calling Tk_Init(). Until now the custom [tkInit] had to be a proc. Now - it can be any command. Removal of tkInitScript.h also fixes [Bug - 1656283]. - -2007-09-06 Daniel Steffen <das@users.sourceforge.net> - - * macosx/Wish.xcode/project.pbxproj: discontinue unmaintained support - * macosx/Wish.xcode/default.pbxuser: for Xcode 1.5; replace by Xcode2 - project for use on Tiger (with Wish.xcodeproj to be used on Leopard). - - * macosx/Wish.xcodeproj/project.pbxproj: updates for Xcode 2.5 and 3.0. - * macosx/Wish.xcodeproj/default.pbxuser: - * macosx/Wish.xcode/project.pbxproj: - * macosx/Wish.xcode/default.pbxuser: - * macosx/Wish-Common.xcconfig: - - * macosx/README: document project changes. - -2007-09-04 Joe English <jenglish@users.sourceforge.net> - - * generic/tkTest.c: Fix for [Bug 1788019] "tkTest.c compiler warning". - -2007-09-04 Don Porter <dgp@users.sourceforge.net> - - * unix/Makefile.in: It's unreliable to count on the release - manager to remember to `make genstubs` before `make dist`. Let the - Makefile remember the dependency for us. - - * unix/Makefile.in: Corrections to `make dist` dependencies to be - sure that macosx/configure gets generated whenever it does not exist. - -2007-09-03 Daniel Steffen <das@users.sourceforge.net> - - * generic/ttk/ttkInit.c (Ttk_Init): register ttk in package database - to enable extension access to the ttkStubs table. - - * generic/ttk/ttkDecls.h: correct capitalization of ttk package name. - -2007-08-28 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - Assorted documentation improvements. - * doc/button.n: Added examples. - * doc/checkbutton.n: Added example. - * doc/console.n: Standardized section ordering. - * doc/tk.n: Added "See also". - * doc/ttk_combobox.n: Added keywords. - -2007-08-27 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXDialog.c (Tk_ChooseColorObjCmd): correct setting of - interp result [Bug 1782105]; fix -initialcolor overwriting last color - selection; style cleanup. - -2007-08-21 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/rules.vc: Synchronize with tcl rules.vc - * tests/all.tcl: Fix the line-endings. - -2007-08-07 Daniel Steffen <das@users.sourceforge.net> - - * unix/Makefile.in: Add support for compile flags specific to - object files linked directly into executables. - - * unix/configure.in (Darwin): Only use -seg1addr flag when prebinding; - use -mdynamic-no-pic flag for object files linked directly into exes. - - * unix/configure: autoconf-2.59 - -2007-08-01 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/tkWinDialog.c: Fix [Bug 1692927] (buffer length problems) - * win/tkWinTest.c: Added 'testfindwindow' and 'testgetwindowinfo' - and extended 'testwinevent' for WM_COMMAND support to enable testing - native messagebox dialogs. - * tests/winMsgbox.test: New Windows native messagebox tests. - -2007-07-25 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXDialog.c (NavServicesGetFile): Reset interp result on - nav dialog cancel. [Bug 1743786] - -2007-07-09 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/Makefile.in: clarify what the headers installed are, and - add ttkTheme.h and ttkDecls.h to private headers (later public). - -2007-07-09 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWindowEvent.c (Tk_MacOSXIsAppInFront): Use process mgr - * macosx/tkMacOSXMouseEvent.c: to determine if - app is in front instead of relying on activate/deactivate events (which - may arrive after this info is needed, e.g. during window drag/click - activation); replace other process mgr use to get this info with calls - to Tk_MacOSXIsAppInFront(). - - * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): Correct - window click activation, titlebar click handling and background window - dragging/growing in the presence of grabs or window-/app-modal windows; - fix window click activation bringing all other app windows to front. - - * macosx/tkMacOSXDraw.c (TkPutImage): Handle non-native XImage byte and - bit orders; reverse bits via xBitReverseTable instead of InvertByte(). - -2007-07-06 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/aquaTheme.tcl: Set -anchor w for TMenubuttons. - [Bug 1614540] - -2007-07-04 Andreas Kupries <andreask@activestate.com> - - * macosx/tkMacOSXXStubs.c (DestroyImage): Fixed seg.fault in release - of image data for images coming from XGetImage. Change committed by me - for Daniel Steffen. See 2007-06-23 for the change which introduced the - problem. - -2007-07-02 Daniel Steffen <das@users.sourceforge.net> - - * xlib/xgc.c (XCreateGC): Correct black and white pixel values used to - initialize GC foregrund and background fields. - - * macosx/tkMacOSXColor.c: Add debug messages for unknown pixel values. - - * macosx/tkMacOSXDraw.c (TkMacOSXRestoreDrawingContext): Don't restore - port state if it wasn't altered by TkMacOSXSetupDrawingContext(). - -2007-06-29 Daniel Steffen <das@users.sourceforge.net> - - * xlib/ximage.c: Bitmaps created from the static .xbm - arrays always have LSBFirst bit order. - - * unix/configure.in: Fix flag used to weak-link libXss. - * unix/configure: autoconf-2.59 - - * macosx/tkMacOSXScrlbr.c: Correct int <-> dobule conversion issues - that could lead to Carbon getting confused about scrollbar thumb size. - - * macosx/tkMacOSXDraw.c (XCopyArea, XCopyPlane, TkPutImage): Use - TkMacOSX{Setup,Restore}DrawingContext() to setup/restore clip & colors. - (TkMacOSXSetupDrawingContext, TkMacOSXRestoreDrawingContext): Add save - and restore of QD port clip region; factor out clip region code common - to CG and QD branches; check for port and context validity; handle - tkPictureIsOpen flag during QD port setup. - (TkScrollWindow): Remove unnecessary scroll region manipulation - - * macosx/tkMacOSXDraw.c: Remove second global QD temp region - * macosx/tkMacOSXInt.h: (no longer necessary) and rename - * macosx/tkMacOSXRegion.c: remaining global QD temp region. - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWindowEvent.c: - - * macosx/tkMacOSXDraw.c: Make useCGDrawing variable MODULE_SCOPE - * macosx/tkMacOSXFont.c: and respect it for ATSUI font drawing. - - * macosx/tkMacOSXButton.c: Reduce reliance on current QD port - * macosx/tkMacOSXColor.c: setting and remove unnecessary - * macosx/tkMacOSXDebug.c: references to a drawable's QD port, - * macosx/tkMacOSXDebug.h: notably replace GetWindowFromPort( - * macosx/tkMacOSXDialog.c: TkMacOSXGetDrawablePort()) idiom by new - * macosx/tkMacOSXDraw.c: TkMacOSXDrawableWindow() and change - * macosx/tkMacOSXKeyEvent.c: TkMacOSXSetColorInPort() to take a port - * macosx/tkMacOSXMenu.c: argument. - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXScale.c: - * macosx/tkMacOSXScrlbr.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: - - * macosx/tkMacOSXInt.h: Factor out macros, declarations - * macosx/tkMacOSXPrivate.h (new): and prototypes that are purely - internal and private to the 'macosx' sources into a new internal header - file that does _not_ get installed into Tk.framework/PrivateHeaders. - - * macosx/tkMacOSXButton.c: #include new tkMacOSXPrivate.h - * macosx/tkMacOSXCarbonEvents.c: instead of tkMacOSXInt.h. - * macosx/tkMacOSXClipboard.c: - * macosx/tkMacOSXColor.c: - * macosx/tkMacOSXCursor.c: - * macosx/tkMacOSXDebug.c: - * macosx/tkMacOSXDialog.c: - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXEntry.c: - * macosx/tkMacOSXEvent.c: - * macosx/tkMacOSXFont.c: - * macosx/tkMacOSXHLEvents.c: - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXKeyEvent.c: - * macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXMenus.c: - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXNotify.c: - * macosx/tkMacOSXRegion.c: - * macosx/tkMacOSXScale.c: - * macosx/tkMacOSXScrlbr.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXXStubs.c: - * macosx/ttkMacOSXTheme.c: - - * macosx/Wish.xcodeproj/project.pbxproj: Improve support for renamed - * macosx/Wish.xcodeproj/default.pbxuser: tcl and tk source dirs; add - * macosx/Wish-Common.xcconfig: 10.5 SDK build config; remove - tclMathOp.c. - - * macosx/README: Document Wish.xcodeproj changes. - -2007-06-23 Daniel Steffen <das@users.sourceforge.net> + * changes: Updates for 8.6a2 release. - * generic/tkImgPhoto.c (ImgPhotoConfigureInstance, DisposeInstance): - Use XDestroyImage instead of XFree to destroy XImage; replace runtime - endianness determination by compile-time check for WORDS_BIGENDIAN. +2008-08-11 Ania Pawelczyk <aniap@users.sourceforge.net> - * xlib/ximage.c (XCreateBitmapFromData): Use XCreateImage and - XDestroyImage instead of creating XImage structure manually. + * tests/canvImg.test: Update to tcltest2 + * tests/canvRect.test: + * tests/canvText.test: + * tests/obj.test: - * macosx/tkMacOSXXStubs.c (XCreateImage, DestroyImage): Correct XImage - bytes_per_line/bitmap_pad calculations and endianness setting; free - image data and XImage structure at destruction; formatting cleanup. +2008-08-07 Ania Pawelczyk <aniap@users.sourceforge.net> - * macosx/tkMacOSXDialog.c (NavServicesGetFile): Disable app-modal - sheet variant of nav dialog on OS versions where it causes problems. + * tests/canvPs.test: Update to tcltest2 + * tests/config.test: + * tests/canvas.test: -2007-06-20 Jeff Hobbs <jeffh@ActiveState.com> - - * library/ttk/ttk.tcl: Should require Tk before pseudo-providing - tile 0.8.0. - -2007-06-09 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkPanedwindow.c, doc/ttk_panedwindow.n, - * tests/ttk/panedwindow.test: Added -width and -height options. Added - 'panes' method, return list of managed windows. 'sashpos' method is - now documented as part of the public interface, and details clarified. - Should be easier to set initial sash positions now. Alleviates [Bug - 1659067]. - -2007-06-09 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tkWinWm.c (WmIconphotoCmd): fix wm iconphoto RGBA issues. - [Bug 1467997] (janssen) - - * win/tkWinMenu.c (TkWinHandleMenuEvent): Improve handling to allow - for unicode char menu indices and not use CharUpper on Tcl utf - strings. [Bug 1734223] - -2007-06-09 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkManager.h, generic/ttk/ttkManager.c, - * generic/ttk/ttkNotebook.c, generic/ttk/ttkPanedwindow.c, - * generic/ttk/ttkFrame.c: Ttk_Manager API overhaul: - + Ttk_Manager no longer responsible for managing slave records - + Ttk_Manager structure now opaque - + Ttk_Slave structure now private - + Pass Ttk_Manager* to Tk_GeomMgr hooks instead of Ttk_Slave* - - * generic/ttk/ttkFrame.c: Simplified -labelwidget management. - - * doc/ttk_panedwindow.n, library/ttk/panedwindow.tcl: Changed - documentation of ttk::panedwindow 'identify' command to match - implementation. - - * generic/ttk/ttkNotebook.c, tests/ttk/notebook.test: - BUGFIX: ttk::noteboook 'insert' command didn't correctly maintain - current tab. - -2007-06-09 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXColor.c: Fix issues with TK_{IF,ELSE,ENDIF} macros; - * macosx/tkMacOSXDraw.c: implement Jaguar equivalent of unavailable - * macosx/tkMacOSXEntry.c: kHIToolboxVersion global; panic at startup - * macosx/tkMacOSXEvent.c: if MAC_OS_X_VERSION_MIN_REQUIRED constraint - * macosx/tkMacOSXInit.c: is not satisfied. - * macosx/tkMacOSXInt.h: - * macosx/tkMacOSXWm.c: - - * macosx/tkMacOSXDraw.c (XCopyArea, XCopyPlane, TkPutImage) - (TkMacOSXSetupDrawingContext): Factor out common code and standardize - setup/restore of port, context and clipping; formatting cleanup. - - * macosx/tkMacOSXWindowEvent.c: Add error checking. - * macosx/tkMacOSXMenu.c: Fix gcc3 warning. - * macosx/tkMacOSXScrlbr.c: Fix testsuite crash. - * macosx/tkMacOSXSubwindows.c: Formatting cleanup. - * macosx/tkMacOSXRegion.c: Fix typos. - * macosx/tkMacOSXScale.c: - - * macosx/tkMacOSXXStubs.c (Tk_GetUserInactiveTime): Remove superfluous - CFRetain/CFRelease. - - * macosx/Wish-Release.xcconfig: Disable tktest release build stripping. - - * macosx/Wish.xcodeproj/project.pbxproj: Add new Tclsh-Info.plist.in. - -2007-06-06 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXInt.h: Use native debug message API when available. - * macosx/Wish-Debug.xcconfig: - - * macosx/tkMacOSXMouseEvent.c (GenerateMouseWheelEvent): Enable - processing of mousewheel events in background windows. +2008-08-05 Joe English <jenglish@users.sourceforge.net> - * macosx/tkMacOSXScrlbr.c: Modernize checks for active/front window. - * macosx/tkMacOSXScale.c: - * macosx/tkMacOSXWm.c: + * generic/tk.h, generic/tkEvent.c: Fix for [Bug 2010422] "no event + type or button # or keysym while executing "bind Listbox + <MouseWheel> [...]". - * macosx/tkMacOSXColor.c: Factor out verbose #ifdef checks of - * macosx/tkMacOSXDraw.c: MAC_OS_X_VERSION_{MAX_ALLOWED,MIN_REQUIRED} - * macosx/tkMacOSXEntry.c: and runtime checks of kHIToolboxVersion into - * macosx/tkMacOSXEvent.c: new TK_{IF,ELSE,ENDIF}_MAC_OS_X macros. - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXInt.h: - * macosx/tkMacOSXWm.c: +2008-08-03 Ania Pawelczyk <aniap@users.sourceforge.net> - * macosx/tkMacOSXDraw.c: Factor out clip clearing in QD ports; - * macosx/tkMacOSXEntry.c: Formatting cleanup. + * tests/cmds.test: Update to tcltest2 + * tests/dialog.test: + * tests/get.test: + * tests/text.test: Update to tcltest2; report: 33.11 fails - * macosx/Wish.xcodeproj/project.pbxproj: Add settings for Fix&Continue. - - * unix/configure.in (Darwin): Link the Tk and Wish plists into their - binaries in all cases; fix 64bit arch removal in fat 32&64bit builds. +2008-08-01 Pat Thoyts <patthoyts@users.sourceforge.net> - * unix/tcl.m4 (Darwin): Fix CF checks in fat 32&64bit builds. - * unix/configure: autoconf-2.59 + * win/tkWinWm.c: [Bug 2028703]: Check wmPtr is valid in + * tests/wm.test: TopLevelReqProc. -2007-06-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> +2008-07-31 Don Porter <dgp@users.sourceforge.net> - * doc/photo.n: Clarified the fact that base64 support for the -data - option is not universal. [Bug 1731348] (matzek) + * generic/tk.h: Added missing EXTERN for the Tcl_PkgInitStubsCheck + declaration to fix inability to embed non-stub-enabled Tk on Windows. -2007-06-03 Daniel Steffen <das@users.sourceforge.net> +2008-07-29 Ania Pawelczyk <aniap@users.sourceforge.net> - * unix/Makefile.in: Add datarootdir to silence autoconf-2.6x warning. + * tests/constraints.tcl: -highlightthickness entry's option (fonts + constraint) - * macosx/Wish.xcodeproj/default.pbxuser: Add ttk tests. +2008-07-28 Ania Pawelczyk <aniap@users.sourceforge.net> - * macosx/tkMacOSXMenu.c: Add error checking; whitespace cleanup. + * tests/cursor.test: Update to tcltest2 + * tests/message.test: - * macosx/tkMacOSXDraw.c: Comment formatting fixes for Xcode 3.0 - * macosx/tkMacOSXEmbed.c: - * macosx/tkMacOSXEntry.c: - * macosx/tkMacOSXFont.c: - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXKeyEvent.c: - * macosx/tkMacOSXKeyboard.c: - * macosx/tkMacOSXMenus.c: - * macosx/tkMacOSXSend.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXXStubs.c: +2008-07-26 Pat Thoyts <patthoyts@users.sourceforge.net> -2007-06-02 Daniel Steffen <das@users.sourceforge.net> + * doc/options.n: [Bug 1686012]: Direct to the font manual for -font. - * macosx/tkMacOSXMenu.c (TkpPostMenu): Ensure cascade menus display in - posted menus that are not part of the menubar or attached to a - menubutton (fixes bug reported on tcl-mac by Linus Nyberg). + * tests/constraints.tcl: Add a nonwin contraint. + * tests/listbox.test: [Bug 2024753]: Conform to testing policy. -2007-05-31 Daniel Steffen <das@users.sourceforge.net> + * win/tkWinWm.c: [Bug 2009788]: Check that the parent has been mapped + * tests/wm.test: before calling RemapWindows. - * macosx/tkMacOSXWindowEvent.c (GenerateUpdateEvent): Complete all - pending idle-time redraws before newly posted Expose events are - processed; add bounds of redrawn windows to update region to ensure - all child windows overdrawn by parents are redrawn. + * win/tkWinWindow.c: [Bug 2026405]: Check for 0x prefix in sprintf %p. - * macosx/tkMacOSXWindowEvent.c: Centralize clip and window invalidation - * macosx/tkMacOSXSubwindows.c: after location/size changes in the - * macosx/tkMacOSXWm.c: BoundsChanged carbon event handler; - correct/add window invalidation after window attribute changes. +2008-07-25 Ania Pawelczyk <aniap@users.sourceforge.net> - * macosx/tkMacOSXSubwindows.c (XResizeWindow, XMoveResizeWindow) - (XMoveWindow): Factor out common code dealing with embedded and - non-toplevel windows; remove unnecessary clip and window invalidation. + * tests/bind.test: Update to tcltest2 - * macosx/tkMacOSXButton.c (TkpDisplayButton): Move clip setup closer - to native button drawing calls. +2008-07-24 Jan Nijtmans <nijtmans@users.sf.net> - * macosx/tkMacOSXWm.c (TkMacOSXIsWindowZoomed, TkMacOSXZoomToplevel): - Correct handling of gridded windows in max size calculations. + * generic/*.c: [Bug 2021443]: Fix inconsistant "wrong # args" messages + * macosx/tkMacOSXSend.c + * macosx/tkMacOSXWm.c + * unix/tkUnixSend.c + * unix/tkUnixWm.c + * tests/*.test - * macosx/tkMacOSXEvent.c (TkMacOSXFlushWindows): Use HIWindowFlush API - when available. +2008-07-22 Ania Pawelczyk <aniap@users.sourceforge.net> - * macosx/tkMacOSXColor.c: Cleanup whitespace and formatting. - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWm.c: + * tests/bell.test: Update to tcltest2 + * tests/bgerror.test: + * tests/bitmap.test: + * tests/border.test: + * tests/button.test: + * tests/entry.test: + * tests/spinbox.test: - * generic/tkFont.c: #ifdef out debug msg printing to stderr. - * generic/tkTextDisp.c: +2008-07-22 Daniel Steffen <das@users.sourceforge.net> -2007-05-30 Don Porter <dgp@users.sourceforge.net> + * library/ttk/aquaTheme.tcl: Use system color names and TIP145 named + font instead of hardcoded color values and deprecated native font name - * generic/tk.h: Correct placement of #include <tcl.h>. [Bug 1723812] + * macosx/tkMacOSXHLEvents.c: Factor out common code; formatting. -2007-05-30 Daniel Steffen <das@users.sourceforge.net> +2008-07-08 Pat Thoyts <patthoyts@users.sourceforge.net> - * library/bgerror.tcl: Standardize dialog option & button size - * library/dialog.tcl: modifications done when running on on Aqua. - * library/msgbox.tcl: + * doc/*.n: Fixed broken line endings from last doc commit. - * library/demos/button.tcl: Set button highlightbackground on Aqua. +2008-07-04 Joe English <jenglish@users.sourceforge.net> - * macosx/tkMacOSXMenu.c (DrawMenuSeparator): Use DrawingContext API. + * generic/ttk/ttkDefaultTheme.c, generic/ttk/ttkClamTheme.c, + * generic/ttk/ttkClassicTheme.c, generic/ttk/ttkElements.c: + [Bug 2009213]: Audit: ensure that output arguments to Tk_Get*FromObj() + are initialized, in case of erroneous style specifications. - * macosx/tkMacOSXWindowEvent.c (ClearPort): Clip to updateRgn. +2008-07-02 Donal K. Fellows <dkf@users.sf.net> - * macosx/tkMacOSXDebug.c: Factor out debug region flashing. - * macosx/tkMacOSXDebug.h: - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXHLEvents.c: Some tidying up of this file. Make sure + that failing handling callbacks get reported as background errors. - * macosx/tkMacOSXEvent.c: Cleanup whitespace and formatting. - * macosx/tkMacOSXFont.c: - * macosx/tkMacOSXRegion.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXXStubs.c: - * xlib/xgc.c: - - * macosx/Wish.xcodeproj/project.pbxproj: Delete references to removed - * macosx/Wish.xcodeproj/default.pbxuser: ttk files. +2008-06-30 Donal K. Fellows <dkf@users.sf.net> -2007-05-28 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> + * doc/*.1, doc/*.3, doc/*.n: Remove out of date changebars, make + formatting of typedefs consistent, other small changes. - * macosx/tkMacOSXFont.c (TkpMeasureCharsInContext): Fix short measures - with flags=TK_WHOLE_WORDS|TK_AT_LEAST_ONE [Bug 1716141]. Make some - casts unnecessary by changing variable types. +2008-06-25 Don Porter <dgp@users.sourceforge.net> -2007-05-25 Joe English <jenglish@users.sourceforge.net> + *** 8.6a1 TAGGED FOR RELEASE *** - * library/ttk/ttk.tcl: Omit ttk::dialog and dependencies. - * library/ttk/dialog.tcl, library/ttk/icons.tcl, - * library/ttk/keynav.tcl: Removed. - * tests/ttk/misc.test: Removed. - * doc/ttk_dialog.tcl: Removed. + * changes: Updates for 8.6a1 release. -2007-05-25 Donal K. Fellows <dkf@users.sf.net> +2008-06-24 Pat Thoyts <patthoyts@users.sourceforge.net> - * doc/canvas.n: Fixed documentation of default -joinstyle option - values for line and polygon items. [Bug 1725782] + * library/demos/ttkpane.tcl: Work around missing timezones + * doc/text.n: [Bug 1997293]: Fix documentation of text tag options. -2007-05-22 Don Porter <dgp@users.sourceforge.net> +2008-06-19 Don Porter <dgp@users.sourceforge.net> - [core-stabilizer-branch] + * changes: Updates for 8.6a1 release. - * unix/configure: autoconf-2.59 (FC6 fork) - * win/configure: + * generic/tk.h: TIP 285 additions make Tk 8.6 call the new + * library/tk.tcl: Tcl_Canceled() routine, available only in Tcl + 8.6, so bump our Tcl dependencies to version 8.6. Tk 8.6a1 will no + longer [load] into a Tcl 8.5 interp. - * README: Bump version number to 8.5b1 + * README: Bump version number to 8.6a1 * generic/tk.h: * library/tk.tcl: * unix/configure.in: * unix/tk.spec: * win/configure.in: -2007-05-18 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkEntry.c(EntrySetValue): Ensure that widget is in a - consistent state before setting the linked -textvariable. Previously, - it was possible for [$e index insert] to point past the end of the - string, leading to heap corruption. [Bug 1721532] - * tests/ttk/entry.test(entry-9.1): Add test case for the above. - -2007-05-18 Don Porter <dgp@users.sourceforge.net> - - * unix/configure: autoconf-2.59 (FC6 fork) + * unix/configure: autoconf-2.59 * win/configure: - * README: Bump version number to 8.5a7 - * generic/tk.h: - * library/tk.tcl: - * unix/configure.in: - * unix/tk.spec: - * win/configure.in: - - * tests/ttk/treetags.test: Another bit of test suite - SCIM-tolerance. [Bug 1609316] - -2007-05-17 Daniel Steffen <das@users.sourceforge.net> - - * generic/tk.decls: Workaround 'make checkstubs' failures from - tkStubLib.c MODULE_SCOPE revert. [Bug 1716117] - - * macosx/Wish.xcodeproj/project.pbxproj: Add tkOldTest.c and remove - tkStubImg.c. - -2007-05-16 Joe English <jenglish@users.sourceforge.net> - - * generic/tkStubLib.c: Change Tk_InitStubs(), tkStubsPtr, and the - auxilliary stubs table pointers back to public visibility. See [Bug - 1716117] for details. - - Removed TCL_STORAGE_CLASS monkey business, as it had no effect. - -2007-05-16 Don Porter <dgp@users.sourceforge.net> - - * library/choosedir.tcl: Removed uses of obsolete {expand} - * library/comdlg.tcl: syntax; replaced with the now - * library/tk.tcl: approved {*}. [Bug 1710633] - * tests/canvImg.test: - * tests/imgPhoto.test: - - * tests/bind.test: Make test suite more SCIM-tolerant. [Bug 1609316] - -2007-05-16 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/makefile.vc: Test ttk widgets. - -2007-05-15 Joe English <jenglish@users.sourceforge.net> - - * unix/tkUnixRFont.c: Fix crash introduced by previous fix exposed - under newer fontconfig libraries [Bug 1717830] again. - -2007-05-15 Don Porter <dgp@users.sourceforge.net> - - * generic/tkGrid.c: Stop crash due to list intrep shimmer [Bug 1677608] - -2007-05-15 Joe English <jenglish@users.sourceforge.net> - - * unix/tkUnixRFont.c: Fix various memory leaks. [Bug 1717830], [Bug - 800149] - -2007-05-14 Don Porter <dgp@users.sourceforge.net> - - [Tk Bug 1712081] - - * unix/Makefile.in: Updates to account for new and deleted files - * win/Makefile.in: tkStubImg.c and tkOldTest.c. - * win/makefile.bc: - * win/makefile.vc: - - * generic/tkOldTest.c (new): New file used to create testing - * generic/tkTest.c: commands for testing various Tk - * tests/constraints.tcl: legacy interfaces where a separate - * tests/image.test: compilation unit is needed in order to - #define suitable macros during compilation. Only the effect of - USE_OLD_IMAGE on Tk_CreateImageType() is currently tested, but more - similar testing commands can be added to this same file. New - constraint defined to detect presence of the image type provided by - the new testing code, and a few tests added to exercise it. Having - USE_OLD_IMAGE support tested by the default test suite should reduce - chance of a recurrence of this bug. - - * doc/CrtImgType.3: Revised docs to better indicate the legacy - * doc/CrtPhImgFmt.3: nature of the interfaces supported by - USE_OLD_IMAGE. - - * generic/tkDecls.h: make genstubs - * generic/tkStubInit.c: - - * generic/tk.decls: Reworked USE_OLD_IMAGE support to use - * generic/tk.h: the same support mechanisms both with - * generic/tkStubImg.c (deleted):and without a stub-enabled build. In - each case, route the legacy calls to Tk_CreateImageType and - Tk_CreatePhotoImageFormat through the Tk_CreateOldImageType and - Tk_CreateOldPhotoImageFormat routines. Add those routines to the - public stub table so they're available to a stub-enabled extension. - Remove the definition of Tk_InitImageArgs() and use a macro to convert - any calls to it in source code into a comment. - - * generic/tkImage.c: Removed the MODULE_SCOPE declarations that - * generic/tkImgPhoto.c: broke USE_OLD_IMAGE support. - -2007-05-11 Pat Thoyts <patthoyts@users.sourceforge.net> - - * tests/winButton.test: Avoid font dependencies in results. - - * generic/tkFont.c: propagate error from TkDeleteNamedFont. [Bug - 1716613] - -2007-05-09 Daniel Steffen <das@users.sourceforge.net> - - * generic/tkFileFilter.c (AddClause): OSType endianness fixes. - - * library/palette.tcl (tk::RecolorTree): Handle color options with - empty value, fixes error due to emtpy -selectforeground (reported on - tcl-mac by Russel E. Owen). - - * macosx/tkMacOSXWindowEvent.c: Ensure window is brought to the front - * macosx/tkMacOSXMouseEvent.c: at the start of a window drag (except - * macosx/tkMacOSXInt.h: when cmd key is down); formatting and - whitespace fixes. - - * macosx/tkMacOSXDialog.c (Tk_GetSaveFileObjCmd): Add -filetypes option - processing (fixes fileDialog-0.1, fileDialog-0.2 failures). - - * macosx/tkMacOSXEmbed.c (TkpMakeWindow, TkpUseWindow): Fix sending of - Visibility event for embedded windows (fixes frame-3.9 hang). - - * macosx/tkMacOSXScrlbr.c (ScrollbarBindProc): Fix testsuite - * macosx/tkMacOSXSubwindows.c (TkMacOSXUpdateClipRgn): crashes by - adding sanity checks. - - * macosx/Wish.xcodeproj/project.pbxproj: Add 'DebugUnthreaded' & - * macosx/Wish.xcodeproj/default.pbxuser: 'DebugLeaks' targets and env - var settings needed to run the 'leaks' tool. - - * macosx/tkMacOSXButton.c: Fix debug msg typo. - - * tests/constraints.tcl: Ensure 'nonUnixUserInteraction' constraint is - set for aqua. - - * tests/choosedir.test: Add 'notAqua' constraints to X11-only tests; - * tests/clrpick.test: add 'nonUnixUserInteraction' to 'unix' tests - * tests/menuDraw.test: requiring interaction on aqua. - * tests/unixMenu.test: - * tests/unixWm.test: - * tests/winMenu.test: - -2007-05-07 Joe English <jenglish@users.sourceforge.net> - - * unix/tkUnixRFont.c: Properly cast sentinel arguments to variadic - function (fixes "warning: missing sentinel in function call", [Bug - 1712001]) - -2007-05-04 Pat Thoyts <patthoyts@users.sourceforge.net> - - * generic/tkFont.c: TIP #145 implementation - - * generic/tkFont.h: Enhanced font handling. - * win/tkWinDefault.h: - * win/tkWinFont.c: - * win/tkWinInt.h: - * win/tkWinWm.c: - * library/demos/widget: - * library/ttk/fonts.tcl: - -2007-05-04 Donal K. Fellows <donal.k.fellows@man.ac.uk> - - * doc/ttk_treeview.n, doc/ttk_panedwindow.n, doc/ttk_dialog.n: - * doc/ttk_checkbutton.n, doc/tk.n, doc/menu.n, doc/font.n: - * doc/canvas.n: Spelling fixes. [Bug 1686210] - -2007-05-03 Donal K. Fellows <donal.k.fellows@man.ac.uk> - - * generic/tkStubLib.c (Tk_InitStubs): - * generic/ttk/ttkLabel.c (LabelSetup): - * unix/tkUnixSelect.c (ConvertSelection): - * unix/tkUnixEvent.c (TkUnixDoOneXEvent): - * generic/tkConfig.c (Tk_RestoreSavedOptions): - * generic/tkCanvPs.c (TkCanvPostscriptCmd): - * generic/tkOption.c (GetDefaultOptions): - * unix/tkUnixRFont.c (TkpGetFontAttrsForChar, InitFont) - (TkpGetFontFamilies, TkpGetSubFonts): - * unix/tkUnixSend.c (TkpTestsendCmd, RegOpen): Squelch warnings from - GCC type aliasing. [Bug 1711985 and others] - -2007-04-29 Daniel Steffen <das@users.sourceforge.net> - - * unix/configure.in: Fix for default case in tk debug build detection. - * unix/configure: autoconf-2.59 - -2007-04-27 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkTreeview.c(TagOptionSpecs): Use TK_OPTION_STRING - instead of TK_OPTION_FONT to avoid resource leak in tag management. - -2007-04-26 Joe English <jenglish@users.sourceforge.net> - - * macosx/ttkMacOSXTheme.c: Merged OFFSET_RECT processing into - BoxToRect(); factored out PatternOrigin; resynchronized with Tile - codebase. - -2007-04-26 Jeff Hobbs <jeffh@ActiveState.com> - - *** 8.5a6 TAGGED FOR RELEASE *** - - * unix/Makefile.in (dist): Correct tests/ttk glob inclusion - -2007-04-25 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/Makefile.in (dist): Add tests/ttk dir to src dist - - * unix/tkUnixMenubu.c (TkpDisplayMenuButton): Init width/height to 0 - -2007-04-25 Daniel Steffen <das@users.sourceforge.net> - - * unix/Makefile.in (dist): Add macosx/*.xcconfig files to src dist; - copy license.terms to dist macosx dir; fix autoheader bits. - -2007-04-24 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/Makefile.in (dist): Add ttk bits to src dist - - * tests/font.test (font-46.[12]): Correct listification of result - -2007-04-23 Daniel Steffen <das@users.sourceforge.net> - - * generic/tkCanvas.c: Allow -selectforeground option to be None; add - * generic/tkCanvText.c: fallback to fgColor when selFgColor is None - * generic/tkEntry.c: (new default on aqua to match native L&F). - * generic/tkListbox.c: - * generic/tkText.c: - - * generic/tkCanvas.c: Add support for bypassing all of Tk's double - * generic/tkEntry.c: buffered drawing into intermediate pixmaps - * generic/tkFrame.c: (via TK_NO_DOUBLE_BUFFERING #define), it is - * generic/tkListbox.c: unnecessary & wasteful on aqua where all - * generic/tkPanedWindow.c: drawing is already double-buffered by the - * generic/tkTextDisp.c: window server. (Use of this on other - * generic/ttk/ttkWidget.c: platforms would only require implementation - * unix/tkUnixScale.c: of TkpClipDrawableToRect()). - * macosx/tkMacOSXPort.h: - - * library/bgerror.tcl: On aqua, use moveable alert resp. modal dialog - * library/dialog.tcl: window class and corresponding system - background pattern; fix button padding. - - * library/tearoff.tcl: Correct aqua menu bar height; vertically offset - * library/tk.tcl: aqua tearoff floating window to match menu. - - * library/demos/goldberg.tcl: Fix overwriting of widget demo global. - - * library/demos/menu.tcl: On aqua, use custom MDEF and tearoffs; - * library/demos/menubu.tcl: correct menubutton toplevel name. - - * library/demos/puzzle.tcl: Fix button size & padding for aqua. - * library/demos/radio.tcl: - - * macosx/tkMacOSXCarbonEvents.c: Add window event target carbon event - * macosx/tkMacOSXEvent.c: handler for all kEventClassWindow and - * macosx/tkMacOSXEvent.h: kEventClassMouse events; move all - * macosx/tkMacOSXNotify.c: remaining events except for - * macosx/tkMacOSXWindowEvent.c: kEventClassKeyboard from dispatcher to - application event handler; pass event handler callRef downstream; fix - debug event tracing; process all tcl event types in carbon event timer; - delay carbon event timer first fire; add TkMacOSXTrackingLoop() to mark - enter/exit of event tracking loop during which all tcl events but only - carbon update events should be processed by the timer (replaces various - calls to Tcl_SetServiceMode()); rename TkMacOSXReceiveAndProcessEvent() - to TkMacOSXReceiveAndDispatchEvent(), move it from tkMacOSXEvent.c to - tkMacOSXCarbonEvents.c and modify it to dequeue only update events - during a tracking loop; add TkMacOSXRunTclEventLoop() to standardize - the various ways in use to run the tcl event loop; add handling of - kEventClassAppearance events (for ScrollBarVariantChanged event). - - * macosx/tkMacOSXDialog.c: Use new TkMacOSXTrackingLoop() around - * macosx/tkMacOSXEvent.c: blocking API that puts up modal dialogs - * macosx/tkMacOSXMenu.c: or when entering/exiting menu/control - * macosx/tkMacOSXMouseEvent.c: tracking, window dragging and other - * macosx/tkMacOSXScale.c: mouse tracking loops. - * macosx/tkMacOSXScrlbr.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: - - * macosx/tkMacOSXDialog.c: Use new TkMacOSXRunTclEventLoop() - * macosx/tkMacOSXScale.c: instead of Tcl_DoOneEvent(), - * macosx/tkMacOSXScrlbr.c: Tcl_ServiceAll(), TclServiceIdle() - * macosx/tkMacOSXWindowEvent.c: and Tcl_GlobalEval("update idletasks"). - - * macosx/tkMacOSXColor.c: Make available as Tk system colors all - * macosx/tkMacOSXPort.h: appearance manager brushes, text colors and - backgrounds with new and legacy names, as well as the fully transparent - color "systemTransparent"; add TkMacOSXSetColorIn{Port,Context}() to - directly set an X pixel color value in the current QD port resp. the - given CG context without requiring passage through rgb representation - (lossy for most system colors); modernize/remove Classic-era code; - replace crufty strcmp() elseifs by Tcl_GetIndexFromObjStruct(). - - * macosx/tkMacOSXButton.c: Use new TkMacOSXSetColorInPort() - * macosx/tkMacOSXDraw.c: instead of setting rgb color directly - * macosx/tkMacOSXMenubutton.c: to allow for non-rgb system colors. - - * macosx/tkMacOSXCursor.c: Implement "none" cursor as on other - platforms [Patch 1615427]; add all missing appearance manager cursors. - - * macosx/tkMacOSXDefault.h: Set SELECT_FG_COLORs to None to match aqua - L&F; use standard system color names; use new 'menu' system font; - correct default scrollbar width. - - * macosx/tkMacOSXDraw.c: Standardize initialization, use and - * macosx/tkMacOSXInt.h: emptying of various static temp rgns - * macosx/tkMacOSXRegion.c: onto two global RgnHandles; in debug - * macosx/tkMacOSXSubwindows.c: builds, verify emptiness of these temp - * macosx/tkMacOSXWindowEvent.c: rgns before use. - - * macosx/tkMacOSXDraw.c: Add TkMacOSX{Setup,Restore}DrawingContext() to - * macosx/tkMacOSXInt.h: abstract common setup & teardown of drawing - environment (for both CG and QD); save/restore QD theme drawing state; - handle GC clip region; add TkpClipDrawableToRect() to allow clipped - drawing into drawable regardless of GC used; use new system color - "systemWindowHeaderBackground" to setup background in themed toplevels; - correct implementation of TkMacOSXMakeStippleMap(). - - * macosx/tkMacOSXEntry.c: Use new TkMacOSXSetupDrawingContext() and - * macosx/tkMacOSXFont.c: TkMacOSXRestoreDrawingContext() instead of - * macosx/ttkMacOSXTheme.c: various setup/teardown procs like - TkMacOSX{SetUp,Release}CGContext(), TkMacOSXQuarz{Start,End}Draw(), - TkMacOSXSetUpGraphicsPort() etc. - - * macosx/tkMacOSXEmbed.c: Add CG context and drawable clip rgn fields - * macosx/tkMacOSXInt.h: to MacDrawable struct. - * macosx/tkMacOSXSubwindows.c: - - * macosx/tkMacOSXDialog.c: Make -parent option of tk_getOpenFile et al. - use the sheet version of NavServices dialogs; ensure native parent win - exists before using StandardSheet API for tk_messageBox [Bug 1677611]; - force sheets to behave like app-modal dialogs via WindowModality() API; - use more modern ColorPicker API. - - * macosx/tkAboutDlg.r: Use themed movable modal dialog, fix (c) year. - - * macosx/tkMacOSXEntry.c: Take xOff/yOff of MacDrawable into account - * macosx/ttkMacOSXTheme.c: when computing locations/bounds to ensure - correct posititioning when not drawing into intermediate pixmap. - - * macosx/tkMacOSXFont.c: Use appearance manager API to map system font - * macosx/tkMacOSXFont.h: names to TkFonts; add "menu" system font for - menu item text drawing from MDEF; always draw with CG; remove QD - dependent stippling algorithm; move most header declarations into the - source file (as they were not used anywhere else). - - * macosx/tkMacOSXMenu.c: Large-scale rewrite of custom - * macosx/tkMacOSXMenu.r (removed): MDEF and related code that - * macosx/Wish.xcode/project.pbxproj: restores many longtime-MIA - * macosx/Wish.xcodeproj/project.pbxproj: features to working order - * unix/Makefile.in: (e.g. images, custom colors & - fonts in menus etc); implement compound menu items; use Appearance Mgr - and ThemeText APIs to mimic native MDEF as closely as possible when - default "menu" system font is used; remove now obsolete SICN drawing - code and resources. - - * macosx/tkMacOSXCarbonEvents.c: Handle additional menu carbon events - * macosx/tkMacOSXEvent.c: in order to support <<MenuSelect>> in - * macosx/tkMacOSXMenu.c: the menubar and in menus that are not - * macosx/tkMacOSXMenus.c: using the custom MDEF [Bug 1620826]; - fix early and missing clearing of current Tk active menu entry; fix - extraneous sending of <<MenuSelect>> during active menu entry clearing. - - * macosx/tkMacOSXMouseEvent.c: Add support for async window dragging by - the window server; set the corresponding window attribute by default. - - * macosx/tkMacOSXMouseEvent.c: Rationalized handling order of - non-mousedown events; add TkMacOSXModifierState() to retrieve the - current key modifiers in carbon format. - - * macosx/tkMacOSXScrlbr.c: Use appearance manager API to retrieve - scrollbar component metrics; add awareness of multiple possibilites for - scrollbar arrow position in aqua and handle user changes to arrow - position pref; handle difference in metrics of small & large scrollbar - variants; handle aqua "jump to here" scrollbar behaviour; correct - computation of scroll view size and position; enforce min scrollbar - height to avoid scrollbar component overlap; erase scrollbar area - outside of standard width; remove broken auto-adjust code; account for - window class when leaving space for grow box; remove code to manually - draw grow box; use modern API for thumb scroll proc; replace - HiliteControl() by modern API; replace control mgr constants with - appearance mgr equivalents. - - * macosx/tkMacOSXSubwindows.c: Use SetWindowBounds() API instead of - SizeWindow(); invalidate clip regions after X{Map,Unmap}Window as fix - for [Bug 940117] made them dependent on mapping state; remove unneeded - calls to TkMacOSXInvalClipRgns() and unnecessary setting of QD port; - use native-endian pixmap on intel; remove obsolete pixmap pix locking. - - * macosx/tkMacOSXWindowEvent.c: Handle only the first of a batch of - kEventAppAvailableWindowBoundsChanged events sent per transaction; - handle kEventWindowBoundsChanged event to support live window resizing - and centralized sending of location/size changed ConfigureNotify - events; ensure HIGrowBox is redrawn after bounds change; constrain - window after dragging to ensure titlebar is not inacessible - offscreen or under dock/menubar; handle kEventWindowGetRegion and - kEventWindowDrawContent for transparent windows to mark resp. paint - content region as transparent; handle kEventWindowConstrain for - fullscreen windows to ensure bounds match new screen size; enter/exit - fullscreen UIMode upon activation/deactivation of fullscreen window. - - * macosx/tkMacOSXWm.c: Use live-resize and async-drag carbon window - * macosx/tkMacOSXWm.h: attributes for toplevels by default; implement - new [wm attributes] -topmost, -transparent and -fullscreen; refactor - WmAttributesCmd() parallelling the tkUnixWm.c implementation, use thus - factored proc to set proxy icon from [wm iconbitmap]; dynamically - determine default values for toplevel min and max sizes (similar to - tkWinWm.c impl): min sizes depend on window class & attributes to - ensure visibility of all titlebar widgets and grow box, max sizes - depend on maximal window bounds for all active displays; factor out - code that puts into effect changes to master or override_redirect; use - RepositionWindow() API to determine staggered initial window bounds; - correct resize limit calculations, handle gridding and use modern - resize API in TkMacOSXGrowToplevel(); remove sending of ConfigureNotify - after resize or zoom (now handled by BoundsChanged handler); correct - composite carbon window attribute handling, remove currently unusable - attributes and add new attributes in [tk::unsupported::MacWindowStyle]; - ensure validity of window class and attributes before use; apply - changes to window class when handling carbon window attribute changes - (if HIWindowChangeClass() API available); add debug build warning - message when deprecated window style is used instead of window class; - use transparent HIGrowBox for resizable windows; avoid unnecessary - calls to window structure width API; use tcl time API in TkpGetMS(); - add TkMacOSXEnterExitFullscreen() to enter/exit UIMode with dock and - menubar hidden; restrict wmTracing output to debug builds; remove - unneeded calls to TkMacOSXInvalClipRgns() and unnecessary setting of QD - port; workaround GetWindowStructureWidths() Carbon bug (bogus results - for never-mapped floating windows). - - * macosx/tkMacOSXXStubs.c (TkMacOSXDisplayChanged): Add maximal window - bounds field to Screen record (in ext_data), computed as the union of - available window positioning bounds of all graphics devices (displays). - - * macosx/tkMacOSXBitmap.c: Fix macRoman encoding leak. - * macosx/tkMacOSXCursor.c: - - * macosx/tkMacOSXDebug.c (TkMacOSXCarbonEventToAscii): Use static - * macosx/tkMacOSXDebug.h: buffer to simplify callers; const fixes. - - * macosx/tkMacOSXBitmap.c: Use more efficient QDSwapPort() instead of - * macosx/tkMacOSXButton.c: GetPort()/SetPort()/GetGWorld()/SetGWorld(). - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXScale.c: - * macosx/tkMacOSXScrlbr.c: - * macosx/tkMacOSXXStubs.c: - - * macosx/tkMacOSXColor.c: Use kHIToolboxVersionNumber for runtime OS - * macosx/tkMacOSXEntry.c: version check rather than Gestalt() etc. - * macosx/tkMacOSXInt.h: - * macosx/tkMacOSXWm.c: - - * macosx/tkMacOSXDraw.c: Remove obsolete and now incorrect - * macosx/tkMacOSXInt.h: tkMenuCascadeRgn clipping code. - * macosx/tkMacOSXMenu.c: - - * macosx/tkMacOSXHLEvents.c: Replace Tcl_GlobalEval() resp. Tcl_Eval() - * macosx/tkMacOSXScrlbr.c: by Tcl_EvalEx(). - * macosx/tkMacOSXInit.c: - - * macosx/tkMacOSXInit.c (TkpInit): Reorder initialization steps. - - * macosx/tkMacOSXKeyEvent.c: Remove pre-10.2 support. - - * macosx/tkMacOSXMenus.c: Remove now useless call to - TkMacOSXHandleTearoffMenu(); use \x.. quoting for non-latin1 macroman - literar chars to allow file to be edited as utf-8. - - * macosx/tkMacOSXScale.c: Replace TrackControl() by modern - * macosx/tkMacOSXScrlbr.c: HandleControlClick() API (using new - TkMacOSXModifierState()). - - * macosx/tkMacOSXInt.h: Move all constant #defines needed to - * macosx/tkMacOSXColor.c: support building on older OS X releases - * macosx/tkMacOSXEvent.h: to a central location in tkMacOSXInt.h. - * macosx/tkMacOSXFont.c: - * macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXMenus.c: - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXWm.c: - * macosx/ttkMacOSXTheme.c: - - * macosx/tkMacOSXInt.h: Add ChkErr() macro to factor out - * macosx/tkMacOSXButton.c: Carbon OSStatus return value checking - * macosx/tkMacOSXCarbonEvents.c: and TkMacOSXDbgMsg() macro to factour - * macosx/tkMacOSXClipboard.c: out debug message output; use these - * macosx/tkMacOSXColor.c: macros to replace #ifdef TK_MAC_DEBUG - * macosx/tkMacOSXCursor.c: blocks & direct printing to stderr, - * macosx/tkMacOSXDebug.c: and to do additional OSStatus return - * macosx/tkMacOSXDialog.c: checking, and to standardize OSStatus - * macosx/tkMacOSXDraw.c: usage. - * macosx/tkMacOSXEntry.c: - * macosx/tkMacOSXEvent.c: - * macosx/tkMacOSXFont.c: - * macosx/tkMacOSXHLEvents.c: - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXKeyEvent.c: - * macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXMenus.c: - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXScrlbr.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXXStubs.c: - - * macosx/tkMacOSXSend.c: Remove duplicate/unused declarations. - * macosx/tkMacOSXXStubs.c: - - * macosx/tkMacOSXDebug.c: Const fixes. - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXTest.c: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXXStubs.c: - - * macosx/Wish-Info.plist.in: Add tcl document extensions/mime types and - LSMinimumSystemVersion, LSRequiresCarbon & NSAppleScriptEnabled keys. - - * macosx/Wish-Common.xcconfig: Add Wish's Info.plist as __info_plist - section to tktest; enable more warnings. - - * macosx/Wish.xcodeproj/project.pbxproj: Add 'DebugMemCompile' build - configuration that calls configure with --enable-symbols=all; disable - configure check for __attribute__((__visibility__("hidden"))) in Debug - configuration to restore availability of ZeroLink. - - * macosx/Wish-Common.xcconfig: Fix whitespace. - * macosx/Wish-Debug.xcconfig: - * macosx/Wish-Release.xcconfig: - * macosx/tkMacOSXAETE.r: - * macosx/tkMacOSXConfig.c: - * macosx/tkMacOSXCursors.r: - * macosx/tkMacOSXKeyboard.c: - * macosx/tkMacOSXSend.c: - * macosx/ttkMacOSXTheme.c: - * macosx/tkMacOSXXCursors.r: - * macosx/README: - - * macosx/GNUmakefile: Fix/add copyright and license refs. - * macosx/Tk-Info.plist.in: - * macosx/Wish-Info.plist.in: - * macosx/Wish.xcode/project.pbxproj: - * macosx/Wish.xcodeproj/project.pbxproj: - * macosx/tkMacOSX.h: - - * unix/configure.in: Install license.terms into Tk.framework; fix tk - debug build detection. - * unix/configure: autoconf-2.59 - - * doc/colors.n: Document new Mac OS X system colors. - * doc/cursors.n: Document new Mac OS X native cursors. - * doc/font.n: Document new Mac OS X 'menu' system font. - * doc/wm.n: Document new Mac OS X [wm attributes]. - * doc/ttk_image.n: Fix 'make html' warning. - * doc/canvas.n: Fix nroff typo. - -2007-04-21 Jeff Hobbs <jeffh@ActiveState.com> - - * macosx/tkMacOSXBitmap.c, macosx/tkMacOSXButton.c: - * macosx/tkMacOSXCarbonEvents.c, macosx/tkMacOSXClipboard.c: - * macosx/tkMacOSXCursor.c, macosx/tkMacOSXDialog.c: - * macosx/tkMacOSXDraw.c, macosx/tkMacOSXEvent.c: - * macosx/tkMacOSXFont.c, macosx/tkMacOSXInit.c, macosx/tkMacOSXInt.h: - * macosx/tkMacOSXKeyEvent.c, macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXMenubutton.c, macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXScale.c, macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: Revert of commits from 2007-04-13 which broke - the OS X build. - -2007-04-17 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * generic/tkFont.c, generic/tkListbox.c, unix/tkUnixSelect.c: - * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: Make - the format of declarations much more standardized (removing K&R-isms - and other things like that). - -2007-04-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * macosx/tkMacOSXInt.h (LOG_MSG, LOG_ON_ERROR): Added macros to make - the OSX code much less #ifdef-full. - -2007-04-12 Jeff Hobbs <jeffh@ActiveState.com> - - * library/ttk/panedwindow.tcl (ttk::panedwindow::Press): handle Press - triggering outside sash element boundaries. - -2007-04-10 Joe English <jenglish@users.sourceforge.net> - - * win/ttkWinMonitor.c, win/ttkWinXPTheme.c: Re-sync with Tile codebase - so patches can flow back and forth. - - * win/ttkWinXPTheme.c: Skip OS version test, should work on Vista/Aero - now as well as XP. Fixes [Bug 1687299], thanks to George Petasis for - tracking this down. - -2007-03-21 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkLayout.c(Ttk_BuildLayoutTemplate): BUGFIX: Nested - TTK_GROUP nodes did not work unless they appeared at the end of the - layout (and only by accident then). - -2007-03-08 Joe English <jenglish@users.sourceforge.net> - - * tests/grid.test(grid-21.7): Reset wm geometry . and pack propagate . - at end of test. 'pack propagate . 0' was causing cascading failures in - subsequent tests. [Bug 1676770] - -2007-03-07 Daniel Steffen <das@users.sourceforge.net> - - * generic/tkMain.c (Tk_MainEx): Replicate macosx-specific code from - TkpInit() that ensures the console window appears when wish is started - from the OS X Finder (i.e. with stdin == /dev/null), jeffh's 2006-11-24 - change rendered the corresponding code in TkpInit() ineffective in wish - because Tk_MainEx() sets tcl_interactive before calling TkpInit(). - - * generic/ttk/ttkGenStubs.tcl (new): Add ttk-specific genstubs.tcl from - * unix/Makefile.in (genstubs): tile and run it from 'genstubs' - target, restores ability to generate all of Tk's stub sources. - - * generic/ttk/ttkTreeview.c: #ifdef out unused declaration. - - * macosx/tkMacOSXDebug.c (TkMacOSXGetNamedDebugSymbol): Add fix for - libraries loaded with a DYLD_IMAGE_SUFFIX. - - * macosx/Wish.xcodeproj/project.pbxproj: Ensure gcc version used by - * macosx/Wish.xcodeproj/default.pbxuser: Xcode and configure/make are - * macosx/Wish-Common.xcconfig: consistent and independent of - gcc_select default and CC env var; fixes for Xcode 3.0. - - * unix/tcl.m4 (Darwin): s/CFLAGS/CPPFLAGS/ in macosx-version-min check. - * unix/configure: autoconf-2.59 - -2007-02-25 Peter Spjuth <peter.spjuth@space.se> - - * generic/tkUtil.c: Fixed grid anchor center problem in labelframes. - * tests/grid.test: [Bug 1545765] - -2007-02-23 Jeff Hobbs <jeffh@ActiveState.com> - - * library/ttk/notebook.tcl (ttk::notebook::enableTraversal): OS X - needs Option instead of Alt binding - -2007-02-19 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/tcl.m4: use SHLIB_SUFFIX=".so" on HP-UX ia64 arch. - * unix/configure: autoconf-2.59 - - * library/tkfbox.tcl (::tk::IconList_Goto): avoid goto issues in empty - dirs. [Bug 1662959] - -2007-02-09 Joe Mistachkin <joe@mistachkin.com> - - * win/nmakehlp.c: Properly cleanup after nmakehlp, including the - * win/makefile.vc: vcX0.pch file. Sync up fixed nmakehlp usage from - Tcl. - -2007-02-06 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/ttk.tcl: Add no-op [package ifneeded] script for tile - 0.8.0, so that existing applications that use "package require tile" - won't fail when run under Tk 8.5. - -2007-02-04 Daniel Steffen <das@users.sourceforge.net> - - * unix/tcl.m4: Use gcc4's __attribute__((__visibility__("hidden"))) if - available to define MODULE_SCOPE effective on all platforms. - * unix/configure.in: add caching to -pipe check. - * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in: autoheader-2.59 - -2007-02-03 Joe Mistachkin <joe@mistachkin.com> - - * win/rules.vc: Fix platform specific file copy macros for downlevel - Windows. - * win/ttkWinMonitor.c: Windows portability support. Fix "noxp" build - * win/ttkWinXPTheme.c: option handling and use GetWindowLongPtr and - SetWindowLongPtr only when needed. - -2007-02-02 Pat Thoyts <patthoyts@users.sourceforge.net> +2008-06-18 Daniel Steffen <das@users.sourceforge.net> - * win/ttkWinXPTheme.c: Support IsAppThemed() call. This is what is - used when theming is turned off just for an individual application. + * macosx/tkMacOSXCarbonEvents.c: Fix debug carbon event tracing. + (InstallStandardApplicationEventHandler): Replace needless use of + TkMacOSXInitNamedDebugSymbol() by standard TkMacOSXInitNamedSymbol(). -2007-01-28 Daniel Steffen <das@users.sourceforge.net> + * macosx/tkMacOSXDebug.c: Revert 2007-11-09 commit making + * macosx/tkMacOSXDebug.h: TkMacOSXInitNamedDebugSymbol() + available outside of debug builds. - * macosx/Wish.xcodeproj/project.pbxproj: Extract build settings that - * macosx/Wish.xcodeproj/default.pbxuser: were common to multiple - * macosx/Wish-Common.xcconfig (new file): configurations into external - * macosx/Wish-Debug.xcconfig (new file): xcconfig files; add extra - * macosx/Wish-Release.xcconfig (new file): configurations for building - with SDKs; convert legacy jam-based 'Tk' target to native target with - single script phase; correct syntax of build setting references to use - $() throughout; remove unused tcltest sources from 'tktest' target. + * macosx/tkMacOSXEmbed.c (TkpMakeWindow): Fix bug with missing + * macosx/tkMacOSXSubwindows.c (XMapWindow): focus on first map by + only sending VisibilityNotify events once windows are mapped (rather + than when they are created). - * macosx/README: Document new Wish.xcodeproj configurations; other - minor updates/corrections. + * macosx/tkMacOSXWindowEvent.c (TkMacOSXProcessWindowEvent): Fix + return value. - * generic/tk.h: Update location of version numbers in macosx files. + * macosx/tkMacOSXInit.c: Add helper to efficiently convert from + * macosx/tkMacOSXPrivate.h: CFString to Tcl_Obj. - * macosx/Wish.xcode/project.pbxproj: Restore 'tktest' target to working - * macosx/Wish.xcode/default.pbxuser: order by replicating applicable - changes to Wish.xcodeproj since 2006-07-20. + * macosx/tkMacOSXFont.c (TkpGetFontFromAttributes, InitFont): Fix + incorrect conversion to points of font sizes already in points; factor + out retrieval of font family name from font family ID. -2007-01-25 Daniel Steffen <das@users.sourceforge.net> +2008-06-13 Jeff Hobbs <jeffh@ActiveState.com> - * unix/tcl.m4: Integrate CPPFLAGS into CFLAGS as late as possible and - move (rather than duplicate) -isysroot flags from CFLAGS to CPPFLAGS to - avoid errors about multiple -isysroot flags from some older gcc builds. + * win/configure, win/configure.in (TK_WIN_VERSION): Fix handling of + interim a/b versioning for manifest usage. - * unix/configure: autoconf-2.59 +2008-06-13 Joe Mistachkin <joe@mistachkin.com> -2007-01-19 Joe Mistachkin <joe@mistachkin.com> + TIP #285 IMPLEMENTATION - * win/makefile.vc: Properly build man2tcl.c for MSVC8. + * generic/tkCmds.c: During [tkwait] and [update], always cooperatively + check for script cancellation. + * win/makefile.vc: Added 'pdbs' option for Windows build rules to + * win/rules.vc: allow for non-debug builds with full symbols. -2007-01-19 Daniel Steffen <das@users.sourceforge.net> +2008-06-12 Daniel Steffen <das@users.sourceforge.net> - * macosx/Wish.xcodeproj/project.pbxproj: Remove libtommath defines. + * generic/tkPointer.c (Tk_UpdatePointer): [Bug 1991932]: Fix failure + to restore a global grab capture and to release the restrict window + capture when releasing a button grab. Fixes segfault due to dangling + reference to restrict window inside TkpSetCapture() implementation. - * unix/tcl.m4: Ensure CPPFLAGS env var is used when set. [Bug 1586861] - (Darwin): add -isysroot and -mmacosx-version-min flags to CPPFLAGS when - present in CFLAGS to avoid discrepancies between what headers configure - sees during preprocessing tests and compiling tests. + * generic/ttk/ttkTreeview.c: Fix warning. + * unix/tcl.m4 (SunOS-5.11): Fix 64bit amd64 support with gcc & Sun cc. * unix/configure: autoconf-2.59 -2007-01-11 Jeff Hobbs <jeffh@activestate.com> - - * unix/tkUnixEvent.c, library/msgs/es.msg: s/CRLF/LF/g - -2007-01-11 Joe English <jenglish@users.sourceforge.net> - - * win/tcl.m4 (CFLAGS_WARNING): Remove "-Wconversion". This was removed - from unix/tcl.m4 2004-07-16 but not from here. - * win/configure: Regenerated. - -2007-01-11 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkManager.h, generic/ttk/ttk*.c: Revert addition of - contravariant 'const' qualifiers, to keep in sync with Tile codebase - (which must remain compatible with Tk 8.4). - -2007-01-03 Jan Nijtmans <nijtmans@users.sf.net> - - * doc/ManageGeom.3, - * generic/tk.decls, - * generic/tk.h: Add const to 2nd parameter of Tk_ManageGeometry - * generic/tkDecls.h: regenerated - * generic/tkInt.h, - * generic/tk*.c, - * generic/ttk/ttk*.c: Added many "const" specifiers in implementation. - -2007-01-02 Donal K. Fellows <dkf@users.sf.net> - - * xlib/*: Made the generic fake-X11 glue layer abide by the formatting - rules of the core. - -2006-12-31 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> - - * macosx/tkMacOSXFont.c: Fill-in TkpGetFontAttrsForChar (TIP #300). - * macosx/ttkMacOSXTheme.c: Define a constant to make it compile on Mac - OS X 10.3. - -2006-12-28 Mo DeJong <mdejong@users.sourceforge.net> - - * tests/wm.test: Update wm attributes output so that tests pass after - addition of -transparentcolor for Win32. + * macosx/tkMacOSXXStubs.c (Tk_ResetUserInactiveTime): Use UsrActivity + instead of OverallAct (which may be ignored in some circumstances). -2006-12-26 Joe English <jenglish@users.sourceforge.net> + * macosx/Wish.xcodeproj/project.pbxproj: Add tclIORTrans.c; add tclOO + * macosx/Wish.xcodeproj/default.pbxuser: files to tktest-X11 target; + add debug configs for 64bit and with corefoundation disabled; updates + and cleanup for Xcode 3.1 and for Leopard; sync with Tcl.xcodeproj. + * macosx/Wish.xcode/project.pbxproj: Sync Wish.xcodeproj changes. + * macosx/Wish.xcode/default.pbxuser: + * macosx/README: Document new build configs. - * generic/ttk/ttkLabel.c: ImageElement clientData no longer needed. +2008-06-10 Joe English <jenglish@users.sourceforge.net> -2006-12-22 Donal K. Fellows <dkf@users.sf.net> + * unix/tkUnixKey.c: [Patch 1986818]: Use Xutf8LookupString if + available. This should fix problems (like [Bug 1908443]) where Xlib's + idea of the system encoding does not match Tcl's. - * unix/tkUnixEvent.c (TkUnixDoOneXEvent): Made correct on AMD64 and - other similar 64-bit systems where fd_mask is not 'unsigned int' in - effect. [Bug 1522467] +2008-06-01 Daniel Steffen <das@users.sourceforge.net> - * library/msgs/es_ES.msg (removed): - * library/msgs/es.msg: Fixed translation fault that was present in all - Spanish-speaking locales. [Bug 1111213] + * macosx/Wish.xcodeproj/project.pbxproj: Add new tclOO files; add + * macosx/README: debug configs with gcov; + update to Xcode 3.1. -2006-12-19 Jeff Hobbs <jeffh@ActiveState.com> +2008-05-27 Pat Thoyts <patthoyts@users.sourceforge.net> - * win/tkWinButton.c (TkpDisplayButton): lint init. [Bug 1618604] + * generic/ttk/ttkTheme.c: [ttk::style theme use] without an argument + * doc/ttk_style.n: now returns the current theme. -2006-12-19 Daniel Steffen <das@users.sourceforge.net> +2008-05-23 Joe English <jenglish@users.sourceforge.net> - * unix/tcl.m4 (Darwin): --enable-64bit: verify linking with 64bit -arch - flag succeeds before enabling 64bit build. - * unix/configure: autoconf-2.59 + * doc/ttk_treeview.n, generic/ttk/ttkTreeview.c, + * generic/ttk/ttkTagSet.c, generic/ttk/ttkLayout.c, + * generic/ttk/ttkTheme.c, generic/ttk/ttkTheme.h, + * generic/ttk/ttkThemeInt.h, generic/ttk/ttkWidget.h: + Added [$tv identify region], [$tv identify element], and [$tv identify + item] subcommands. Simplified bindings. Added [$tv tag has] + subcommand. Tag-related display improvements; setting a tag + -background or -foreground no longer overrides selection feedback. -2006-12-18 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkTreeview.c, library/ttk/treeview.tcl, doc/treeview.n: - Added column '-stretch' and '-minwidth' options. Improved column drag - and resize behavior. Added horizontal scrolling [Bug 1518650]. Row - height and child indent specifiable on Treeview style. Decreased - default row height, no default -padding. Use correct heading height - [Bug 1163349]. Apply tag settings to tree item as well as to data - columns [NOTE: 'tag configure' still buggy]. Fix off-by-one condition - when moving nodes forward [Bug 1618142] - * generic/ttk/ttkScroll.c (TtkScrollTo): Prevent overscroll [Bug - 1173434] * library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl, * library/ttk/clamTheme.tcl, library/ttk/classicTheme.tcl, - * library/ttk/defaults.tcl, library/ttk/winTheme.tcl, - * library/ttk/xpTheme.tcl: Per-theme treeview settings. - * macosx/ttkMacOSXTheme.c: Added disclosure triangle element. - -2006-12-17 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/combobox.tcl, generic/ttk/ttkEntry.c, - * doc/ttk_combobox.n: Add combobox -height option; only show scrollbar - if the listbox needs to scroll. [Bug 1032869] - -2006-12-16 Mo DeJong <mdejong@users.sourceforge.net> - - * doc/cursors.n: Mention "none" in supported cursor list. Fix comment - that incorrectly claims that the Win32 "no" cursor hides the cursor. - * tests/cursor.test: Test "none" cursor. - * unix/tkUnixCursor.c (CreateCursorFromTableOrFile) - (TkGetCursorByName): Define a table of Tk cursors that is searched in - addition to the X cursor table. A Tk cursor is loaded from a data - string and works with the same options as the built in X cursors. This - code makes it possible to use "none" as a cursor name under Unix. - * win/rc/cursor9a.cur: Added none Win32 cursor. - * win/rc/tk_base.rc: Define a built-in Win32 cursor named "none". - [Patch 1615427] - -2006-12-14 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkButton.c, generic/ttk/ttkElements.c, - * generic/ttk/ttkEntry.c, generic/ttk/ttkFrame.c, - * generic/ttk/ttkImage.c, generic/ttk/ttkInit.c, - * generic/ttk/ttkLabel.c, generic/ttk/ttkNotebook.c, - * generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c, - * generic/ttk/ttkScale.c, generic/ttk/ttkScrollbar.c, - * generic/ttk/ttkSeparator.c, generic/ttk/ttkTheme.h, - * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.h: - Global reduction: use per-file *_Init() routines to reduce the number - of globally-visible initialization records. - -2006-12-13 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/Makefile.in (install-doc): intentionally skip ttk_dialog.n - installation (not for public consumption) - - * doc/scrollbar.n, doc/button.n, doc/checkbutton.n: - * doc/entry.n, doc/frame.n, doc/label.n, doc/labelframe.n: - * doc/menu.n, doc/menubutton.n, doc/panedwindow.n: - * doc/radiobutton.n, doc/scrollbar.n, doc/ttk_*: revamp ttk docs to - use consist nroff format (not 100% consistent with classic widget - docs). Add more man page cross-linking "SEE ALSO". - - * generic/ttk/ttkInit.c: - * generic/ttk/ttkTreeview.c: make treeview exist by default - * generic/ttk/ttkPanedwindow.c: s/TtkPaned_Init/TtkPanedwindow_Init/ - - * win/Makefile.in, unix/Makefile.in (demo): add 'demo' target - -2006-12-13 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/ttk.tcl: Try to straighten out theme loading and - selection logic. - * generic/ttk/ttkElements.c, library/ttk/defaults.tcl, - * generic/ttk/ttkClamTheme.c, library/ttk/clamTheme.tcl: - Provide package in C part instead of Tcl part. + * library/ttk/defaults.tcl, library/ttk/treeview.tcl, + * library/ttk/winTheme.tcl, library/ttk/xpTheme.tcl: + Don't need separate 'Item', 'Cell', and 'Row' style settings anymore, + only the base "Treeview" style is used. -2006-12-12 Joe English <jenglish@users.sourceforge.net> - - * library/ttk/ttk.tcl, generic/ttkTheme.c: Remove nonfunctional code. - -2006-12-12 Mo DeJong <mdejong@users.sourceforge.net> - - * win/tkWinButton.c (InitBoxes): Call Tcl_Panic() if loading of bitmap - resources fails. This change generates an error if Tk is unable to - find button widget resources instead of silently failing and then - drawing widgets incorrectly. - * win/rc/tk_base.rc: If the user defines BASE_NO_TK_ICON then compile - the base resources file without a "tk" icon. This change makes it - easier to replace the default tk icon with a custom icon. [Patch - 1614362] - -2006-12-11 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * unix/tkUnixWm.c (TkWmMapWindow, WmClientCmd): Added support for - _NET_WM_PID property from the EWMH spec. This is only installed when - the client machine is set. - (WmProtocolCmd, UpdateWmProtocols, TkWmProtocolEventProc): Added - support for the _NET_WM_PING protocol from the EWMH spec. Note that - the support for this is not exposed to the script level as that would - prevent correct handling. +2008-05-23 Joe English <jenglish@users.sourceforge.net> -2006-12-10 Joe English <jenglish@users.sourceforge.net> + * generic/ttk/ttkLabel.c: [Bug 1967576]: Avoid passing width or height + <= 0 to Tk_RedrawImage, as this leads to a panic on Windows. - * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h, - * generic/ttk/ttk.decls, generic/ttk/ttkTheme.c, - * generic/ttk/ttkLayout.c, generic/ttk/ttkDecls.h: - Rename typedef Ttk_Element => Ttk_ElementImpl. +2008-05-16 Pat Thoyts <patthoyts@users.sourceforge.net> -2006-12-09 Joe English <jenglish@users.sourceforge.net> + * library/ttk/xpTheme.tcl: Add correct border to combobox on Vista - * generic/ttk/ttkButton.c, generic/ttk/ttkImage.c, - * generic/ttk/ttkLabel.c, generic/ttk/ttkWidget.h, - * generic/ttk/ttkTheme.h, generic/ttk/ttkNotebook.c, - * generic/ttk/ttkTreeview.c, doc/ttk_image.n: - Merged duplicate functionality between image element factory, image - element, and -image option processing. Image element factory now takes - an imageSpec argument instead of a separate image name and -map option - * tests/ttk/image.test(image-1.1): Can catch this error earlier now. +2008-05-15 Pat Thoyts <patthoyts@users.sourceforge.net> -2006-12-06 Kevin Kenny <kennykb@acm.org> + * win/makefile.vc: We should use the thread allocator for threaded + * win/rules.vc: builds. Added 'tclalloc' option to disable. - * unix/configure.in: Further changes to avoid attempting to link - * unix/configure: against Xft libraries in a non-Xft build - [Bug 1609616] (dgp) +2008-05-14 Donal K. Fellows <dkf@users.sf.net> -2006-12-04 Jeff Hobbs <jeffh@ActiveState.com> + * generic/tkPanedWindow.c (PanedWindowProxyCommand) + (DisplayPanedWindow): [Bug 1639824]: Ensure that a zero width never + gets fed to the underlying window system. - * generic/tkListbox.c (ConfigureListboxItem): ListboxWorldChanged not - needed - just call EventuallyRedrawRange. [Bug 1608046] (rezic) +2008-05-13 Pat Thoyts <patthoyts@users.sourceforge.net> -2006-12-04 Donal K. Fellows <dkf@users.sf.net> + * library/console.tcl: Support pixel sized font in +/- keybinding. + * tests/listbox.test: -activestyle default is underline on windows. + * tests/winDialog.test: Fixed hanging tk_chooseColor tests. - TIP #286 IMPLEMENTATION +2008-05-11 Pat Thoyts <patthoyts@users.sourceforge.net> - * generic/tkMenu.c (MenuWidgetObjCmd, MenuDoXPosition): - * doc/menu.n, tests/menu.test: Added an [$menu xposition] subcommand - which is useful in menubars and when menus use multiple columns. Many - thanks to Schelte Bron for the implementation. + * library/tk.tcl: Support for ttk widgets in AmpWidget + * doc/button.n: [Patch 1883418]: Note negative widths for button. -2006-12-01 Kevin Kenny <kennykb@acm.org> +2008-05-09 Pat Thoyts <patthoyts@users.sourceforge.net> - TIP #300 IMPLEMENTATION + * doc/ttk_*: 'identify' widget command is on all ttk widgets. - * doc/font.n: Added a [font actual $font $char] - * generic/tkFont.c: variant that introspects the font that - * generic/tkFont.h: is chosen to render a given character - * macosx/tkMacOSXFont.c: in a given nominal font. Added - * tests/font.test: documentation and test cases for the - * unix/tkUnixFont.c: new command syntax. - * unix/tkUnixRFont.c: - * win/tkWinFont.c: +2008-05-04 Joe English <jenglish@users.sourceforge.net> -2006-12-01 Jeff Hobbs <jeffh@ActiveState.com> + * macosx/ttkMacOSAquaTheme.c: [Bug 1942785]: "default" and "focus" + adornments should not be disjoint. - * doc/wm.n, tests/winWm.test: - * win/tkWinWm.c: add -transparentcolor attribute for Windows. +2008-04-27 Donal K. Fellows <dkf@users.sf.net> -2006-12-01 Joe English <jenglish@users.sourceforge.net> + * */*.c: A large tranche of getting rid of pre-C89-isms; if your + compiler doesn't support things like proper function declarations, + 'void' and 'const', borrow a proper one when building Tcl. (The header + files allow building things that link against Tcl with really ancient + compilers still; the requirement is just when building Tcl itself.) - * generic/ttk/ttkTheme.h, generic/ttk/ttkLayout.c: Dead code removal. +2008-04-25 Joe English <jenglish@users.sourceforge.net> -2006-11-30 Daniel Steffen <das@users.sourceforge.net> + * library/ttk/treeview.tcl: [Bug 1951733]: [$tv selection] takes a + list of items, not a single item. - * macosx/tkMacOSXDialog.c (Tk_MessageBoxObjCmd): fix inability to use - buttons with standard Escape key binding as -default button (reported - on tcl-mac by Hans-Christoph Steiner). +2008-04-20 Pat Thoyts <patthoyts@users.sourceforge.net> - * macosx/tkMacOSXWm.c (WmAttributesCmd): fix getting [wm attr -alpha]. - [Bug 1581932] + * win/makefile.vc: [Bug 1900872]: Include ws2_32 in the link list. + * doc/menu.n: [Bug 1887169]: Minor change regarding the system menu. + * doc/button.n: [Bug 1926223]: Minor clarification of button flash. -2006-11-28 Joe English <jenglish@users.sourceforge.net> +2008-04-17 Donal K. Fellows <dkf@cspool38.cs.man.ac.uk> - * library/ttk/fonts.tcl: Clean up temporary variables. + * doc/text.n: Correct description of when -relief option is ignored on + a tag. Thanks to emiliano for spotting. -2006-11-27 Kevin Kenny <kennykb@acm.org> +2008-04-17 Don Porter <dgp@users.sourceforge.net> - * unix/configure.in: Corrected Xft configuration so that Xft actually - does get turned on when available. - * unix/configure: autoconf + * generic/tkCanvas.c: [Bug 1327482]: Fix logic that determines when + canvas item <Enter> event should fire. Thanks to Sebastian Wangnick. -2006-11-26 Joe English <jenglish@users.sourceforge.net> +2008-04-16 Daniel Steffen <das@users.sourceforge.net> - * generic/ttk/ttkWidget.c, generic/ttk/ttkPaned.c: Fix [Bug 1603506] - * library/ttk/button.tcl, library/ttk/combobox.tcl, - * library/ttk/utils.tcl: Rename ttk::CopyBindings to ttk::copyBindings - * generic/ttk/ttkTreeview.c, doc/ttk_treeview.n: - -displaycolumns {} now means "no columns" instead of "all columns". - Use -displaycolumns #all for "all columns". [Bug 1547622] + * generic/tkStubInit.c: [Patch 1938497]: Make stubs + * generic/tkWindow.c (Initialize): tables static const and export + only a module-scope pointer to to the main stubs table (for package + init). -2006-11-26 Daniel Steffen <das@users.sourceforge.net> +2008-04-14 Pat Thoyts <patthoyts@users.sourceforge.net> - * unix/tcl.m4 (Linux): --enable-64bit support. [Patch 1597389] - * unix/configure: autoconf-2.59 [Bug 1230558] + * win/tkWinDialog.c: [Bug 1941740]: Fix [tk_chooseColor -title]. + * win/tkWinTest.c: Added parent to testgetwininfo + * tests/winDialog.test: Created some tk_chooseColor win tests. -2006-11-24 Jeff Hobbs <jeffh@ActiveState.com> +2008-04-09 Jan Nijtmans <nijtmans@users.sourceforge.net> - * macosx/tkMacOSXInit.c (TkpInit): only set tcl_interactive 1 if it - isn't already defined. Allows embedders to set it to 0 to prevent the - console appearing on OS X. [Bug 1487701] + * generic/tkImgGIF.c: Let the GIF writer use a real LZW compressor. - * unix/tkUnixMenu.c (DrawMenuUnderline): bound Tcl_UtfAtIndex usage - * tests/menu.test (menu-36.1): [Bug 1599877] +2008-04-08 Pat Thoyts <patthoyts@users.sourceforge.net> -2006-11-24 Joe English <jenglish@users.sourceforge.net> + * win/ttkWinXpTheme.c: Provide a visual-styles API element engine + * tests/ttk/vsapi.test: to permit scripts to create any available + * doc/ttk_vsapi.n: windows xp/vista element. Plus basic tests. - * library/ttk/altTheme.tcl, library/ttk/clamTheme.tcl, - * library/ttk/defaults.tcl, library/ttk/winTheme.tcl, - * library/ttk/xpTheme.tcl: explicitly specify -anchor w on TMenubutton - * tests/ttk/entry.test: Fixed font dependency; test entry-3.2 should - work on all platforms now. - * library/classicTheme.tcl: Don't define or use TkClassicDefaultFont. - * generic/ttk/ttkTreeview.c, generic/ttk/ttkPanedwindow.c: Handle - missing layouts. +2008-04-08 Daniel Steffen <das@users.sourceforge.net> -2006-11-23 Jeff Hobbs <jeffh@ActiveState.com> + * generic/tkDecls.h: make genstubs (genStubs.tcl changes). + * generic/tkIntDecls.h: + * generic/tkIntPlatDecls.h: + * generic/tkIntXlibDecls.h: + * generic/tkPlatDecls.h: - * win/tkWinMenu.c (TkWinHandleMenuEvent, DrawMenuUnderline): Handle - unichar underlining correctly and safely. [Bug 1599877] +2008-04-08 Kevin Kenny <kennykb@acm.org> -2006-11-20 Joe English <jenglish@users.sourceforge.net> + * tkWinEmbed.c: Removed #if 0 code. Trust the revision control + system, if you need it again, you can find it. - * win/ttkWinXPTheme.c: Add support for alternate/indeterminate - checkbutton state. Fix various spacing parameters [Bug 1596020, patch - from Tim Baker]. Remove unused uxtheme hooks. + * tkWinSend.c: Added conditional compilation to silence several + compiler warnings. -2006-11-16 Donal K. Fellows <dkf@users.sf.net> +2008-04-07 Jeff Hobbs <jeffh@ActiveState.com> - * doc/colors.n, doc/wm.n: Minor fixes, added See Also. + * generic/tkWindow.c (Initialize): [Bug 1937135]: Fix double-free on + * tests/main.test (main-3.*): Tk_ParseArgv error. - * doc/labelframe.n: Added an example. + * generic/tkArgv.c: Fix -help mem explosion. [Bug 1936238] (kenny) -2006-11-15 Donal K. Fellows <dkf@users.sf.net> +2008-04-04 Pat Thoyts <patthoyts@users.sourceforge.net> - * doc/label.n: Added an example and some See Also refs. + * library/ttk/sizegrip.tcl: Don't resize if the toplevel is not + resizable or the sizegrip has been disabled. - * doc/ConfigWidg.3, doc/bind.n, doc/grid.n, doc/panedwindow.n: - * doc/text.n, doc/ttk_Geometry.3, doc/ttk_button.n: - * doc/ttk_checkbutton.n, doc/ttk_combobox.n, doc/ttk_dialog.n: - * doc/ttk_entry.n, doc/ttk_frame.n, doc/ttk_image.n, doc/ttk_intro.n: - * doc/ttk_label.n, doc/ttk_labelframe.n, doc/ttk_menubutton.n: - * doc/ttk_notebook.n, doc/ttk_panedwindow.n, doc/ttk_progressbar.n: - * doc/ttk_radiobutton.n, doc/ttk_scrollbar.n, doc/ttk_separator.n: - * doc/ttk_sizegrip.n, doc/ttk_style.n, doc/ttk_widget.n, doc/wm.n: - Convert \fP to \fR so that man-page scrapers have an easier time. +2008-04-03 Pat Thoyts <patthoyts@users.sourceforge.net> -2006-11-14 Joe English <jenglish@users.sourceforge.net> + * win/makefile.vc: Fixed stubs usage + * library/ttk/xpTheme.tcl: fix the colour of labelframe in xp - * generic/ttk/ttkDefaultTheme.c: Fix off-by-one bug in tree indicator - size computation [Bug 1596021, patch from Tim Baker]. Increased - default size from 7 to 9 pixels. +2008-04-02 Daniel Steffen <das@users.sourceforge.net> -2006-11-12 Joe English <jenglish@users.sourceforge.net> + * generic/tk.decls: Remove 'export' declarations of symbols now + only in libtkstub and no longer in libtk. - * generic/ttkScroll.c: *correct* fix for [Bug 1588251]. + * generic/tkStubLib.c: [Bug 1819422]: Make symbols in libtkstub.a + MODULE_SCOPE to avoid exporting them from + libraries that link with -ltkstub; constify + tk*StubsPtr and stub table hook pointers. -2006-11-12 Joe English <jenglish@users.sourceforge.net> + * generic/tkStubLib.c: Undef USE_TCL_STUBS before defining it + * generic/ttk/ttkStubLib.c: unconditionally; remove needless #ifdef - * tests/ttk/ttk.test(ttk-6.9): Workaround for [Bug 1583038] + * generic/tkDecls.h: make genstubs + * generic/tkIntDecls.h: + * generic/tkIntPlatDecls.h: + * generic/tkIntXlibDecls.h: + * generic/tkPlatDecls.h: + * generic/tkStubInit.c: -2006-11-12 Joe English <jenglish@users.sourceforge.net> + * unix/configure.in (Darwin): Remove now unnecessary unexporting of + libtclstub symbols from libtk. - * generic/ttkScroll.c: Reworked cleanup procedure; "self-cancelling" - idle call is not robust, call Tcl_CancelIdleCall() in - TtkFreeScrollHandle instead. Fixes [Bug 1588251] + * unix/configure: autoconf-2.59 -2006-11-10 Daniel Steffen <das@users.sourceforge.net> +2008-04-01 Don Porter <dgp@users.sourceforge.net> - * macosx/Wish.xcodeproj/project.pbxproj: remove tclParseExpr.c and - bwidget.test. + * generic/tkStubLib.c (Tk_InitStubs): Added missing error + * generic/tkWindow.c (Tk_PkgInitStubsCheck): message and removed + needless #ifdef complexity. - * unix/tcl.m4 (Darwin): suppress linker arch warnings when building - universal for both 32 & 64 bit and no 64bit CoreFoundation is - available; sync with tcl tcl.m4 change. - * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in: autoheader-2.59 - -2006-11-08 Kevin Kenny <kennykb@acm.org> - - * unix/configure.in: Silenced warnings about missing Xft configuration - unless --enable-xft is requested explicitly. Also added a few basic - checks that we can actually compile and link against Xft headers and - libraries. [Bug 1592667] - * unix/configure: Regen. - -2006-11-07 Kevin Kenny <kennykb@acm.org> - - * unix/configure.in: Made --enable-xft the default. - * unix/configure: Regen. - -2006-11-06 Joe English <jenglish@users.sourceforge.net> - - * generic/ttk/ttkClassicTheme.c, generic/ttk/ttkPanedwindow.c, - * generic/ttk/ttkTheme.c, generic/ttk/ttkTreeview.c, - * win/ttkWinXPTheme.c, library/ttk/entry.tcl, - * library/ttk/notebook.tcl, library/ttk/panedwindow.tcl, - * library/ttk/utils.tcl, tests/ttk/entry.test, tests/ttk/bwidget.test: - Miscellaneous minor changes to re-sync Ttk codebase with Tile CVS: fix - comments damaged by overzealous search-and-destroy; removed obsolete - [style default] synonym for [ttk::style configure]; removed other dead - code. - -2006-11-03 Pat Thoyts <patthoyts@users.sourceforge.net> - - * library/safetk.tcl (::safe::tkTopLevel): Theme it. - - * generic/ttk/ttkLayout.c: We do not want to require tkInt in all - * generic/ttk/ttkMananager.h: the ttk files so added the definition - * generic/ttk/ttkTheme.h: of MODULE_SCOPE to ttkTheme.h. Ensures - * generic/ttk/ttkWinMonitor.c: everyone gets to see the definition - from someplace. - - * library/ttk/fonts.tcl: In a safe interp there is no osVersion field - in tcl_platform so work around it. - -2006-11-02 Daniel Steffen <das@users.sourceforge.net> - - * generic/ttk/ttkBlink.c, generic/ttk/ttkButton.c: - * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c: - * generic/ttk/ttkDecls.h, generic/ttk/ttkDefaultTheme.c: - * generic/ttk/ttkElements.c, generic/ttk/ttkEntry.c: - * generic/ttk/ttkFrame.c, generic/ttk/ttkImage.c: - * generic/ttk/ttkInit.c, generic/ttk/ttkLabel.c: - * generic/ttk/ttkLayout.c, generic/ttk/ttkManager.h: - * generic/ttk/ttkNotebook.c, generic/ttk/ttkPanedwindow.c: - * generic/ttk/ttkProgress.c, generic/ttk/ttkScale.c: - * generic/ttk/ttkScroll.c, generic/ttk/ttkScrollbar.c: - * generic/ttk/ttkSeparator.c, generic/ttk/ttkSquare.c: - * generic/ttk/ttkStubInit.c, generic/ttk/ttkStubLib.c: - * generic/ttk/ttkTheme.c, generic/ttk/ttkTheme.h: - * generic/ttk/ttkThemeInt.h, generic/ttk/ttkTrack.c: - * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.c: - * generic/ttk/ttkWidget.h, macosx/ttkMacOSXTheme.c: - * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: ensure - all global Ttk symbols have Ttk or ttk prefix; declare all externally - visible Ttk symbols not contained in stubs table as MODULE_SCOPE (or as - static when possible); so that 'make check{exports,stubs}' once again - complete without errors. - - * macosx/tkMacOSXColor.c (TkMacOSXCompareColors): ifdef out when unused - - * macosx/Wish.xcodeproj/project.pbxproj: check autoconf/autoheader exit - status and stop build if they fail. - - * macosx/tkMacOSXWindowEvent.c (GenerateUpdateEvent): fix handling of - Carbon Update events: the QuickDraw window update region was being - ignored and all child TkWindows were sent an Expose XEvent even when - they did not need to be redrawn. [Patch 1589226] - -2006-11-01 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXDebug.c: add TkMacOSX prefix to leftover - * macosx/tkMacOSXDebug.h: macosx-private global symbols without Tk - * macosx/tkMacOSXEmbed.c: prefix; ifdef out currently unused debug - * macosx/tkMacOSXEvent.c: procs. - * macosx/tkMacOSXInt.h: - * macosx/tkMacOSXCarbonEvents.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWm.c: + * generic/tkWindow.c: [Tcl Bug 1819422]: Revised package init so + * unix/Makefile.in: that "tkStubsPtr" is not present in libtk.so, + * win/Makefile.in: but is present only in libtkstub.a. This + * win/makefile.bc: tightens up the rules for users of the stubs + * win/makefile.vc: interfaces. -2006-10-31 Pat Thoyts <patthoyts@users.sourceforge.net> - - * win/makefile.vc: Added ttk files to msvc build and add manifest - * win/rules.vc: files to binaries with MSVC8. - -2006-10-31 Daniel Steffen <das@users.sourceforge.net> - - * macosx/Wish.xcodeproj/project.pbxproj: add new Ttk files. - - * macosx/ttkMacOSXTheme.c: standardize header #includes. - - * unix/Makefile (checkstubs, checkexports): check ttk.decls, allow - export of Ttk prefixed symbols. - - * generic/ttk/tkDefaultTheme.c: fix warnings. - -2006-10-30 Jeff Hobbs <jeffh@ActiveState.com> - - * doc/ttk_Geometry.3, doc/ttk_Theme.3, doc/ttk_button.n: - * doc/ttk_checkbutton.n, doc/ttk_combobox.n, doc/ttk_dialog.n: - * doc/ttk_entry.n, doc/ttk_frame.n, doc/ttk_image.n: - * doc/ttk_intro.n, doc/ttk_label.n, doc/ttk_labelframe.n: - * doc/ttk_menubutton.n, doc/ttk_notebook.n, doc/ttk_panedwindow.n: - * doc/ttk_progressbar.n, doc/ttk_radiobutton.n, doc/ttk_scrollbar.n: - * doc/ttk_separator.n, doc/ttk_sizegrip.n, doc/ttk_style.n: - * doc/ttk_treeview.n, doc/ttk_widget.n,: - * generic/ttk/ttk.decls, generic/ttk/ttkBlink.c: - * generic/ttk/ttkButton.c, generic/ttk/ttkCache.c: - * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c: - * generic/ttk/ttkDecls.h, generic/ttk/ttkDefaultTheme.c: - * generic/ttk/ttkElements.c, generic/ttk/ttkEntry.c: - * generic/ttk/ttkFrame.c, generic/ttk/ttkImage.c: - * generic/ttk/ttkInit.c, generic/ttk/ttkLabel.c: - * generic/ttk/ttkLayout.c, generic/ttk/ttkManager.c: - * generic/ttk/ttkManager.h, generic/ttk/ttkNotebook.c: - * generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c: - * generic/ttk/ttkScale.c, generic/ttk/ttkScroll.c: - * generic/ttk/ttkScrollbar.c, generic/ttk/ttkSeparator.c: - * generic/ttk/ttkSquare.c, generic/ttk/ttkState.c: - * generic/ttk/ttkStubInit.c, generic/ttk/ttkStubLib.c: - * generic/ttk/ttkTagSet.c, generic/ttk/ttkTheme.c: - * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h: - * generic/ttk/ttkTrace.c, generic/ttk/ttkTrack.c: - * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.c: - * generic/ttk/ttkWidget.h: - * library/demos/ttk_demo.tcl, library/demos/ttk_iconlib.tcl: - * library/demos/ttk_repeater.tcl: - * library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl: - * library/ttk/button.tcl, library/ttk/clamTheme.tcl: - * library/ttk/classicTheme.tcl, library/ttk/combobox.tcl: - * library/ttk/cursors.tcl, library/ttk/defaults.tcl: - * library/ttk/dialog.tcl, library/ttk/entry.tcl: - * library/ttk/fonts.tcl, library/ttk/icons.tcl: - * library/ttk/keynav.tcl, library/ttk/menubutton.tcl: - * library/ttk/notebook.tcl, library/ttk/panedwindow.tcl: - * library/ttk/progress.tcl, library/ttk/scale.tcl: - * library/ttk/scrollbar.tcl, library/ttk/sizegrip.tcl: - * library/ttk/treeview.tcl, library/ttk/ttk.tcl: - * library/ttk/utils.tcl, library/ttk/winTheme.tcl: - * library/ttk/xpTheme.tcl: - * macosx/ttkMacOSXTheme.c: - * tests/ttk/all.tcl, tests/ttk/bwidget.test, tests/ttk/combobox.test: - * tests/ttk/entry.test, tests/ttk/image.test: - * tests/ttk/labelframe.test, tests/ttk/layout.test: - * tests/ttk/misc.test, tests/ttk/notebook.test: - * tests/ttk/panedwindow.test, tests/ttk/progressbar.test: - * tests/ttk/scrollbar.test, tests/ttk/treetags.test: - * tests/ttk/treeview.test, tests/ttk/ttk.test, tests/ttk/validate.test: - * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: - First import of Ttk themed Tk widgets as branched from tile 0.7.8 - - * generic/tkInt.h, generic/tkWindow.c: add Ttk_Init call, copy tk - classic widgets to ::tk namespace. - * library/tk.tcl: add source of ttk/ttk.tcl, define $::ttk::library. - * unix/Makefile.in, win/Makefile.in: add Ttk build bits - * win/configure, win/configure.in: check for uxtheme.h (XP theme). - -2006-10-23 Don Porter <dgp@users.sourceforge.net> - - * README: Bump version number to 8.5a6 + * README: Bump version number to 8.6a0 * generic/tk.h: * library/tk.tcl: + * macosx/Wish-Common.xcconfig: * unix/configure.in: * unix/tk.spec: + * win/README: * win/configure.in: + * win/tcl.m4: * unix/configure: autoconf-2.59 * win/configure: -2006-10-19 Pat Thoyts <patthoyts@users.sourceforge.net> - - *** 8.5a5 TAGGED FOR RELEASE *** - - * generic/tkImgBmap.c: Fixed line endings. - * win/makefile.vc: Patched up build system to manage - * win/rules.vc: AMD64 with MSVC8 - * win/nmakehlp.c: Ensure operation without Platform SDK. - -2006-10-18 Don Porter <dgp@users.sourceforge.net> - - * changes: 8.5a5 release date set. - -2006-10-17 Jeff Hobbs <jeffh@ActiveState.com> - - * doc/text.n: fix docs to not correct -tabs usage case. - - * generic/tkTextDisp.c (SizeOfTab): fix -tabstyle wordprocessor tab - alignment to correct tab edge case. [Bug 1578858] - -2006-10-17 Pat Thoyts <patthoyts@users.sourceforge.net> - - * generic/tkText.c: Applied suggested patch from [Bug 1536735] - * tests/text.test: Update test for above patch. - * tests/textWind.test: Corrected test to catch all messages - * tests/safe.test: Silence spurious win32 failure awaiting TIP150 - * tests/winDialog.test: Updated test for file name length check. - * test/winWm.test: Corrected test expectation for menu wrapping. - -2006-10-16 Andreas Kupries <andreask@activestate.com> - - * doc/WindowId.3: Pat's commit on 2006-10-08 broke the .SH NAME - information across several lines, breaking the cross-linking of - manpages during installation for this one. Put everything back on a - single line, unbreaking it. - -2006-10-16 Daniel Steffen <das@users.sourceforge.net> - - * changes: updates for 8.5a5 release. - - * macosx/tkMacOSXDraw.c: fix numerous issues in CG and QD drawing - procs so that they now match X11 drawing much more closely [Bug - 1558051]; use Tiger ellipse drawing API when available; fix comments & - whitespace. - - * macosx/tkMacOSXInit.c: set default linewidth limit for CG - antialiasing to 0 as thin horizontal/vertical lines look good now. - * macosx/README: document CG antialiasing limit changes. - - * generic/tkCanvLine.c (ConfigureLine): on TkAqua, pass outline - * generic/tkCanvPoly.c (ConfigurePolygon): linewidth in gc even for - * generic/tkRectOval.c (ConfigureRectOval): fills (as it controls AA). - - * macosx/GNUmakefile: don't redo prebinding of non-prebound binaires. - - * library/demos/pendulum.tcl: fix incorrect setting of toplevel title. - -2006-10-10 Don Porter <dgp@users.sourceforge.net> - - * changes: Updates for 8.5a5 release - -2006-10-08 Pat Thoyts <patthoyts@users.sourceforge.net> - - * generic/tkWindow.c: Implemented TIP #264 - Tk_Interp function. - * doc/WindowId.3: Documented Tk_Interp. - * generic/tk.decls: Added to the stubs interface and - * generic/tkDecls.h: regenerated. - * generic/tkStubsInit.c: - -2006-10-05 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/tkUnixFont.c (Ucs2beToUtfProc, UtfToUcs2beProc): - (TkpFontPkgInit, encodingAliases): Correct alignment issues in - encoding conversion. Call ucs-2be "unicode" on big-endian systems. - [Bug 1122671] - -2006-09-27 Andreas Kupries <andreask@activestate.com> - - * unix/Makefile.in (install-binaries): Added a second guard to the - * win/Makefile.in: package index file to prevent older versions of Tcl - * win/makefile.vc: from seeing version numbers which may contain a/b - information, and then balking on them. This could otherwise happen - when Tcl/Tk 8.4 and 8.5 are installed in the same directory, seeing - each other. [Bug 1566418] - -2006-09-22 Andreas Kupries <andreask@activestate.com> - - * generic/tkConsole.c: TIP #268 update regarding registered package - * generic/tkMain.c: version, now using full patchlevel instead of - * generic/tkWindow.c: major.minor - * library/tk.tcl: - * unix/configure: - * unix/Makefile.in: - * unix/tcl.m4: - * win/configure: - * win/Makefile.in: - * win/makefile.vc: - * win/rules.vc: - * win/tcl.m4: - -2006-09-20 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tkWinMenu.c (TkpPostMenu): disable menu animation in menus with - images to avoid clipping bug. [Bug 1329198] - -2006-09-21 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkImgBmap.c (ImgBmapPostscript): Change 0 to NULL, since - they are not interchangable on all platforms in all circumstances. - [Tcl Bug 1562528] - -2006-09-11 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWm.c (TkMacOSXMakeRealWindowExist): revert part of - 2006-05-16 change that had set overrideredirect windows to not become - activated by the window manager, as this prevented interaction with - native widgets in such windows [Bug 1472624]; apply changes to carbon - window attributes even if native window has already been created. - - * macosx/tkMacOSXKeyEvent.c (TkMacOSXProcessKeyboardEvent): fix app - * macosx/tkMacOSXMenu.c (DrawMenuBarWhenIdle): menu item key shortcuts - * macosx/tkMacOSXInt.h: when custom ".apple" menu is installed. - - * library/demos/widget: on TkAqua, don't install file menu with single - quit menu item, as the application menu already has a quit item. - - * macosx/tkMacOSXColor.c: fix building on Mac OS X 10.2. - -2006-09-10 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXColor.c (TkSetMacColor,TkpGetColor): use AppearanceMgr - * macosx/tkMacOSXDefault.h: to retrieve platform std colors for text - * macosx/tkMacOSXPort.h: selections, add "systemHighlightSecondary" - color name for standard color of inactive selections, use this color as - default for text widget -inactiveselectbackground to implement platform - standard look for inactive text selections. - - * library/text.tcl (aqua): remove focus bindings to set selection color - - * generic/tkTextBTree.c (TkTextIsElided): on TkAqua, don't show - * generic/tkTextDisp.c (GetStyle): inactive text selection when - text widget is disabled. - - * generic/tkEntry.c (DisplayEntry): change default TkAqua selection - * macosx/tkMacOSXDefault.h: relief to "flat" (platform std). - - * generic/tkText.c (CreateWidget): fix bug leading to default text - selection relief string DEF_TEXT_SELECT_RELIEF being ignored. - - * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): allow mouse - event delivery to background windows with kWindowNoActivatesAttribute - (e.g. overrideredirect windows), as these never come to the foreground - they would never receive any mouse events otherwise. [Bug 1472624] - - * macosx/tkMacOSXWindowEvent.c (TkMacOSXGenerateFocusEvent): do not - send focus events to any windows with kWindowNoActivatesAttribute. - - * macosx/tkMacOSXXStubs.c (XQueryColor, XQueryColors): implement basic - XColor computation from pixel values, enough to make tkImg's window.c - happy, fixes img::window failures reported on tcl-mac. - - * macosx/tkMacOSXMenu.c (DrawMenuEntryLabel): fix leak. [Bug 1554672] - - * macosx/GNUmakefile: workaround bug in 'cp -pRH' on Darwin 6 and - earlier, fixes 'make embedded' failure reported on tcl-mac; fix error - from 'make deploy' with same build tree as previous 'make embedded'. - - * macosx/Wish.xcodeproj/project.pbxproj: add new tclUnixCompat.c file. - - * macosx/tkMacOSXEntry.c (TkpDrawEntryBorderAndFocus): fix typo. - - * unix/tcl.m4: sync with tcl/unix/tcl.m4. - * unix/configure: autoconf-2.59 - -2006-09-06 Jeff Hobbs <jeffh@ActiveState.com> - - * generic/tkEntry.c: move hard-coded ALWAYS_SHOW_SELECTION control - * generic/tkInt.h: of entry/text selection display based on focus - * generic/tkText.c: to the Tcl level, controlled by - * generic/tkWindow.c: ::tk::AlwaysShowSelection (boolean, private). - * library/tk.tcl: [Bug 1553691] - * macosx/tkMacOSXDefault.h: - * unix/tkUnixDefault.h: - * unix/tkUnixPort.h: - * win/tkWinDefault.h: - -2006-08-30 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tkWinKey.c: Add WM_UNICHAR window message support (used by - * win/tkWinX.c: virtual keyboard apps). [Bug 1518677] (petasis) - -2006-08-24 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXScrlbr.c (UpdateControlValues): set native scrollbar - control bounds only once all size adjustments have been computed. - Fixes issue with grow icon obscuring scrollbar reported on tcl-mac. - -2006-08-21 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXCarbonEvents.c (CarbonTimerProc): avoid starving main - event loop: limit the number of tcl events processed per invocation. - Fixes bug reported on tcl-mac by Kevan Hashemi. - -2006-08-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * tests/text.test (text-25.15): Added test suggested by Sam - <baudinm@yahoo.com> on comp.lang.tcl - - * generic/tk.h, generic/tkInt.h: Stylistic improvements. No API change. - -2006-08-18 Daniel Steffen <das@users.sourceforge.net> - - * unix/tcl.m4 (Darwin): add support for --enable-64bit on x86_64, for - universal builds including x86_64, for 64-bit CoreFoundation on Leopard - and for use of -mmacosx-version-min instead of MACOSX_DEPLOYMENT_TARGET - * unix/configure.in (Darwin): remove 64-bit arch flags from CFLAGS for - combined 32-bit and 64-bit universal builds, as neither TkAqua nor - TkX11 can be built for 64-bit at present. - * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in: autoheader-2.59 - - * macosx/Wish.xcodeproj/project.pbxproj: switch native release targets - to use DWARF with dSYM, Xcode 3.0 changes. - * macosx/README: updates for x86_64 support in Tcl. - - * macosx/tkMacOSXInit.c (TkpInit): when available, use public - TransformProcessType() API instead of CPSEnableForegroundOperation() - SPI to notify the window server that we are a GUI application. - - * macosx/tkMacOSXWm.c (WmAttrGetTitlePath): use HIWindow API on >=Tiger - - * macosx/tkMacOSXMouseEvent.c (GenerateToolbarButtonEvent): - * macosx/tkMacOSXMenus.c (GenerateEditEvent): - * macosx/tkMacOSXMenu.c (MenuSelectEvent): bzero() the XVirtualEvent - structure before use to ensure all fields are initialized. [Bug - 1542205] - -2006-08-16 Jeff Hobbs <jeffh@ActiveState.com> - - * macosx/tkMacOSXWm.c (WmAttributesCmd): correct OS X result for [wm - attributes $top]. - -2006-07-25 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXKeyEvent.c (TkMacOSXProcessKeyboardEvent): handle key - shortcut for kHICommandQuit in the same way as other application menu - item key shortcuts. [Bug 1516950] - -2006-07-24 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWm.c (TkWmMapWindow): fix incorrect values of wmInfo - parentWidth/Height for toplevels by recalculating them once the window - is mapped (i.e once the window&structure sizes are known). [Bug - 1358663] - (ParseGeometry): sync with ParseGeometry in tkUnixWm.c/tkWinWm.c. - -2006-07-21 Daniel Steffen <das@users.sourceforge.net> - - * generic/tkBind.c (TkBindInit): for REDO_KEYSYM_LOOKUP, change - keysym-to-string mapping hash to use first name in ks_names.h instead - of last (if there are multiple possibilities), e.g. "F11" instead of - "L1". - - * macosx/tkMacOSXKeyboard.c (TkpGetKeySym): correct keysyms for pure - modifier key presses [Bugs 700311, 1525905]; correct keysym for Enter - key; add keysyms for new NumLock and Fn modifiers (added 2005-08-09). - -2006-07-20 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWm.c (WmAttributesCmd, WmIconbitmapCmd): add support - * unix/tkUnixSend.c (Tk_GetUserInactiveTime): for weakly - importing symbols not available on OSX 10.2 or 10.3, enables binaires - built on later OSX versions to run on earlier ones. - * macosx/Wish.xcodeproj/project.pbxproj: enable weak-linking; turn on - extra warnings. - * macosx/README: document how to enable weak-linking; cleanup. - * unix/configure.in: add check on Darwin-X11 for ld support of -weak-l - * unix/tcl.m4: flag and weak-link libXss if possible as it is not - available before OSX 10.4; enforce requirement of OSX 10.2 for TkAqua; - move Darwin specific checks & defines that are only relevant to the tcl - build out of tcl.m4; restrict framework option to Darwin; clean up - quoting and help messages. - * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in: autoheader-2.59 - - * macosx/GNUmakefile: enable xft for TkX11 build. - * macosx/tkMacOSXFont.c (TkMacOSXQuarzStartDraw, TkMacOSXQuarzEndDraw): - verify validity of context returned from QDBeginCGContext() before use. - * macosx/tkMacOSXKeyEvent.c: ifdef out diagnostic messages to stderr. - - * macosx/tkMacOSXEvent.h: standardize MAC_OS_X_VERSION_MAX_ALLOWED - * macosx/tkMacOSXMenu.c: checks per QA1316, ensure define can be - * macosx/tkMacOSXMenubutton.c: overridden on command line (from default - * macosx/tkMacOSXMenus.c: of current OS version). - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXWm.c: - - * generic/tkImgGIF.c (ReadImage): - * macosx/tkMacOSXCursor.c (TkMacOSXCursor): - * macosx/tkMacOSXDebug.c (TkMacOSXGetNamedDebugSymbol): - * macosx/tkMacOSXFont.c (TkpMeasureCharsInContext): - * macosx/tkMacOSXInit.c (Map): - * xlib/xgc.c (XCreateGC): fix signed-with-unsigned comparison and other - warnings from gcc4 -Wextra. - -2006-07-14 Andreas Kupries <andreask@activestate.com> - - * generic/tkWindow.c (Initialize): Modify change of 2006-05-25 (jeffh). - Release mutex a bit earlier, to prevent lock when OS X creates its - console windows (recursively enters Tk_Init). Patch by JeffH. - -2006-07-06 Jeff Hobbs <jeffh@ActiveState.com> - - * library/tkfbox.tcl: catch scrollbar use of highlightthickness - -2006-06-21 Jeff Hobbs <jeffh@ActiveState.com> - - * library/bgerror.tcl (::tk::dialog::error::bgerror): remove a couple - of unnecessary hardcoded options - -2006-06-14 Don Porter <dgp@users.sourceforge.net> - - * generic/tkScale.c: Revised variable writing logic to account for - [scale]'s design that it deals with its value as a formatted string, - and not as a double. [Bug 891141] - -2006-06-14 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXSubwindows.c (TkMacOSXInvalidateWindow): ensure - invalid clip regions are recreated via TkMacOSXUpdateClipRgn() before - they are used; correct call order of TkMacOSXInvalidateWindow() and - TkMacOSXInvalClipRgns() throughout. [Bug 1501922] - - * macosx/tkMacOSXDraw.c (TkPutImage): implement drawing of very wide - images in slices of less than 4096 pixels to workaround CopyBits - limitation. [Bug 950121] - -2006-06-09 Don Porter <dgp@users.sourceforge.net> - - * generic/tkMain.c: Added Tcl_Preserve() call on the master interp - as crash protection against any Tcl_DeleteInterp() call that might - happen. - -2006-06-01 Don Porter <dgp@users.sourceforge.net> - - * generic/tkConsole.c: Added Tcl_RegisterChannel() calls to bump the - refcount of channels passed to Tcl_SetStdChannel(). This prevents early - free-ing of the channels that leads to crashes. [Bug 912571] - -2006-05-29 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tkWinEmbed.c (TkpGetOtherWindow): Do not panic if no window is - * unix/tkUnixEmbed.c (TkpGetOtherWindow): found; caller handles. [Bug - * unix/tkUnixWm.c (Tk_CoordsToWindow, UpdateGeometryInfo): 1212056] - - * tests/entry.test (entry-22.1): - * tests/listbox.test (listbox-6.15): - * generic/tkListbox.c (ListboxInsertSubCmd, ListboxDeleteSubCmd): - Ignore Tcl_SetVar2Ex failure of listVarName, similar to entry widget - handling. [Bug 1424513] - -2006-05-26 Jeff Hobbs <jeffh@ActiveState.com> - - * macosx/tkMacOSXButton.c (TkMacOSXDrawControl): correct redraw for - direct transition from disabled to active state. [Bug 706446] - -2006-05-25 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tkWinMenu.c (TkWinMenuKeyObjCmd): get eventPtr after we know the - window is still alive. [AS bug 45987] [Bug 1236306] - - * generic/tkMenu.c (DeleteMenuCloneEntries): Modify entry index - changes to work around VC6 optimization bug. [Bug 1224330] - - * generic/tkMessage.c (MessageWidgetObjCmd): Correct msgPtr - preserve/release pairing. [Bug 1485750] (afredd) - - * generic/tkWindow.c (Initialize): Correct mutex (un)lock pairing. - [Bug 1479587] (loewis) - - * generic/tkBind.c (Tk_BindEvent, TkCopyAndGlobalEval): use Tcl_EvalEx - instead of Tcl_GlobalEval. - -2006-05-16 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWindowEvent.c (TkMacOSXGenerateFocusEvent): don't send - focus events to windows of class help or to overrideredirect windows. - [Bug 1472624] - - * macosx/tkMacOSXWm.c: set overrideredirect windows to not become - activated by the window manager and to not receive OS activate events - (should make them behave more like on other platforms); use modern - window class API for overrideredirect and transient windows; set the - default class of overrideredirect windows to 'simple' rather than - 'plain' (i.e. no window frame); add missing Panther and Tiger window - attributes to [::tk::unsupported::MacWindowStyle]. - -2006-05-12 Jeff Hobbs <jeffh@ActiveState.com> - - * generic/tkImgPhoto.c (Tk_PhotoPutBlock, Tk_PhotoPutZoomedBlock): Fix - opt added 2006-03 that caused slowdown for some common cases. [Bug - 1409140] - -2006-05-13 Daniel Steffen <das@users.sourceforge.net> - - * generic/tkCanvWind.c (DisplayWinItem, WinItemRequestProc): ensure - canvas window items are unmapped when canvas is unmapped. [Bug 940117] - - * macosx/tkMacOSXSubwindows.c (TkMacOSXUpdateClipRgn): empty clip - region of unmapped windows to prevent any drawing into them or into - their children from becoming visible. [Bug 940117] - - * macosx/tkMacOSXInt.h: revert Jim's attempt of 2005-03-14 to - * macosx/tkMacOSXSubwindows.c: fix Bug 940117 as it disables Map/Unmap - event propagation to children. [Bug 1480105] - - * macosx/tkMacOSXDraw.c (TkPutImage): handle tkPictureIsOpen flag, - fixes incorrect positioning of images with complex alpha on native - buttons; actual alpha blending is still broken in this situation. [Bug - 1155596] - - * macosx/tkMacOSXEvent.c (TkMacOSXProcessCommandEvent): - * macosx/tkMacOSXMenus.c (TkMacOSXInitMenus): workaround carbon bug - with key shortcut for 'Preferences' app menu item. [Bug 1481503] - - * macosx/tkMacOSXKeyEvent.c (TkMacOSXProcessKeyboardEvent): only check - for HICommand menu item shortcuts in the application menu. + * generic/tkConsole.c: Relax Tcl_InitStubs() calls so that a Tk 8.6 + * generic/tkMain.c: might [load] into a Tcl 8.5 interp. + * generic/tkWindow.c: - * macosx/tkMacOSXInt.h: initialize keyboard layout setup in - * macosx/tkMacOSXInit.c: TkpInit() rather than during handling of - * macosx/tkMacOSXKeyEvent.c: first key down event. + * generic/tkDecls.h: make genstubs + * generic/tkIntDecls.h: + * generic/tkIntPlatDecls.h: + * generic/tkIntXlibDecls.h: + * generic/tkPlatDecls.h: - * macosx/tkMacOSXDraw.c: add optional debug code to flash clip - * macosx/tkMacOSXSubwindows.c: regions during update or draw. +2008-03-28 Don Porter <dgp@users.sourceforge.net> -2006-05-04 Don Porter <dgp@users.sourceforge.net> + *** 8.5.2 TAGGED FOR RELEASE *** - * README: Bump version number to 8.5a5 + * README: Bump to 8.5.2 for release. * generic/tk.h: + * library/tk.tcl: * unix/configure.in: * unix/tk.spec: * win/configure.in: @@ -5859,2007 +5010,277 @@ a better first place to look now. * unix/configure: autoconf-2.59 * win/configure: -2006-04-28 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWm.c (TkWmMapWindow, InitialWindowBounds): fix use of - potentially stale window position in initial configure event on first - map of a window. [Bug 1476443] - (TkMacOSXWindowOffset): use modern GetWindowStructureWidths API. - - * macosx/tkMacOSXInt.h: - * macosx/tkMacOSXMouseEvent.c (TkGenerateButtonEventForXPointer): new - internal function to generate button events for current pointer - directly, without requiring prior call to XQueryPointer(). - - * macosx/tkMacOSXMouseEvent.c (XQueryPointer): implement return of - window-local pointer position. - - * macosx/tkMacOSXInt.h: use improvements above to avoid calls to - * macosx/tkMacOSXKeyEvent.c: GlobalToLocal() when the current port - * macosx/tkMacOSXMenu.c: might not be set correctly. May fix [Bug - * macosx/tkMacOSXMenus.c: 1243318] - * macosx/tkMacOSXScale.c: - * macosx/tkMacOSXScrlbr.c: - - * tkAboutDlg.r: update copyright. - - * macosx/tkMacOSXDebug.h: sync #includes with core-8-4-branch. - * macosx/tkMacOSXEvent.h: - * macosx/tkMacOSXFont.h: - -2006-04-26 Don Porter <dgp@users.sourceforge.net> - - *** 8.5a4 TAGGED FOR RELEASE *** - - * changes: Updates for next RC - -2006-04-25 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * unix/tkUnixFont.c (TkpGetFontFamilies): Fix crash caused when the - XServer returns invalid font names. [Bug 1475865] - -2006-04-23 Vince Darley <vincentdarley@users.sourceforge.net> - - * tests/scrollbar.test: fix to tkAqua test failures - -2006-04-18 Vince Darley <vincentdarley@users.sourceforge.net> - - * macosx/tkMacOSXEmbed.c: fix to [Bug 1088814] test failures in - embed.test - - * macosx/tkMacOSXWm.c: - * tests/constraints.tcl: - * tests/wm.test: fix to 'wm attributes' test for TkAqua - -2006-04-11 Peter Spjuth <peter.spjuth@space.se> - - * generic/tkWindow.c (Tk_NameToWindow): Allow NULL interp to - Tk_NameToWindow. This fixes TkGetWindowFromObj which promises to handle - NULL but didn't. - - * generic/tkGrid.c: Fixed handling of out of bounds row or column. - * tests/grid.test: [Bug 1432666] - -2006-04-11 Don Porter <dgp@users.sourceforge.net> - - * unix/Makefile.in: Updated `make dist` target to be sure the - message catalogs for the widget demo get packaged into the source code - distribution. [Bug 1466509] - -2006-04-11 Daniel Steffen <das@users.sourceforge.net> - - * changes: added latest aqua bug fixes. - - * macosx/tkMacOSXDialog.c (Tk_MessageBoxObjCmd): added standard Escape - key binding for msgbox cancel buttons [Patch 1193614], whitespace. - - * macosx/tkMacOSXCarbonEvents.c: handle kEventCommandUpdateStatus - * macosx/tkMacOSXEvent.c: carbon event to dynamically enable - the 'Preferences' app menu item when proc [::tk::mac::ShowPreferences] - is defined. [Bug 700316] - - * macosx/tkMacOSXHLEvents.c: call ::tk::mac::* procs for all - * macosx/tkMacOSXWindowEvent.c: registered appleevents [FR 1105284], - implement print applevent handling, style/whitespace cleanup. - - * macosx/tkMacOSXDraw.c (TkMacOSXInitCGDrawing): prevent multiple init. - - * macosx/tkMacOSXFont.c: remove #ifdef'd text measuring codepaths now - * macosx/tkMacOSXInit.c: known to be incorrect, cleanup obsolete text - * macosx/README: antialiasing control code, document ATSUI text - antialiasing changes. - - * macosx/tkMacOSXInt.h: Implemented 'zoomed' window state - * macosx/tkMacOSXWindowEvent.c: handling for TkAqua, via titlebar - * macosx/tkMacOSXWm.c: widget clicks as well as [wm state]. - * doc/wm.n: [Bug 1073456] - -2006-04-10 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * library/tkfbox.tcl (::tk::IconList_Goto): Fix prefix searching so - that the start location is reasonable, and the prefix matching is using - the correct Tcl command for this. [Bug 1467938] - -2006-04-10 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> - - * macosx/tkMacOSXFont.c (MeasureStringWidth): Use implementation based - on ATSUGetGlyphBounds (TK_MAC_USE_GETGLYPHBOUNDS), so we can use - kATSUseFractionalOrigins. This in turn corrects [Bug 1461650]. - (InitFont): Use "." and "W" instead of "i" and "w" to determine the - "-fixed" attribute. This prevents "Apple Chancery" from being - classified as fixed. - (InitFontFamilies): Only get the font families once. - -2006-04-09 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWm.c (WmResizableCmd): propagate window attribute - changes to Carbon window manager. [FR 1467004] - (TkSetWMName, TkMacOSXMakeRealWindowExist): allow empty name for - toplevels, remove bogus initial window name. [Bug 1450800] - -2006-04-07 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): fix return - values, implement window dragging & growing in background (with Command - key down) and by fronting clicks [Bug 934524], use correct button & - modifier state API when application is in background (also in - TkMacOSXButtonKeyState). - - * macosx/tkMacOSXWm.c (TkMacOSXGrowToplevel): ensure QD port is set - correctly before using API relying on it. - -2006-04-06 Vince Darley <vincentdarley@users.sourceforge.net> - - * macosx/tkMacOSXMouseEvent.c: Now that [wm attributes -titlepath] - works correctly, add OS support for dragging proxy icons and using the - titlepath menu. - -2006-04-06 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXWm.c (WmAttributesCmd, WmIconbitmapCmd): fix errors in - setting/removing window proxy icons via [wm attributes -titlepath] and - [wm iconbitmap], use HIWindow API on Tiger or later. [Bug 1455241] - - * unix/tcl.m4: remove TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING - define on Darwin. [Tcl Bug 1457515] - * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in: autoheader-2.59 - -2006-04-05 Jeff Hobbs <jeffh@ActiveState.com> - - * generic/tkWindow.c (Initialize): remove impotent use of - DeleteWindowsExitProc as a global exit handler. - - * generic/tkMenu.c (TkSetWindowMenuBar): remove extra TkMenuInit call - that caused finalization panic. [Bug 1456851] - * win/tkWinMenu.c (FreeID, TkpNewMenu, MenuExitHandler) - (MenuThreadExitHandler, TkpMenuInit, TkpMenuThreadInit): rework Windows - menu init/finalization to better respect per-process and per-thread - boundaries. [Bug 1456851] - (TkWinMenuKeyObjCmd): Do not error when unknown window is passed in. - [Bug 1236306] - - * win/tkWinX.c (TkWinXInit): init default keyboard charset correctly. - [Bug 1374119] (pajas) - - * win/tkWinWm.c (WmProc): pass WM_QUERYENDSESSION message to Tk as - WM_SAVE_YOURSELF wm protocol callback. - - * tests/textWind.test (textWind-10.6.1): prevent infinite update loop - in case of test failure. - - * tests/wm.test (wm-attributes-1.2.4): correct expected result. - - * tests/grid.test: fix segfault on empty or "all" index list - * generic/tkGrid.c (GridRowColumnConfigureCommand): [Bug 1422430] - -2006-04-05 Vince Darley <vincentdarley@users.sourceforge.net> - - * generic/tkText.c: fix to crash caused on some platforms by new tests - introduced to check for [Bug 1414171], which destroy the text widget in - the dump callback script. - -2006-03-29 Jeff Hobbs <jeffh@ActiveState.com> - - * generic/tkOption.c (TkOptionDeadWindow): handle OptionThreadExitProc - being called before DeleteWindowsExitProc. - - * win/Makefile.in: convert _NATIVE paths to use / to avoid ".\" - path-as-escape issue. - -2006-03-29 Don Porter <dgp@users.sourceforge.net> - - * changes: Updates for next RC - - * unix/tkUnixDefault.h: Changed "Black" to "#000000" and "White" to - "#ffffff" to work around the (broken?) X servers that do not accept - those color names. [Bug 917433] - -2006-03-28 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/tcl.m4, win/tcl.m4: []-quote AC_DEFUN functions. - -2006-03-26 Vince Darley <vincentdarley@users.sourceforge.net> - - * generic/tkText.c: - * tests/text.test: Fix for elaborations of [Bug 1414171] for '$text - dump -command <script>' where script deletes large portions of the - text widget, or even destroys the widget. - -2006-03-28 Daniel Steffen <das@users.sourceforge.net> - - * macosx/Wish.xcode/default.pbxuser: add '-singleproc 1' cli arg to - * macosx/Wish.xcodeproj/default.pbxuser: tktest to ease test debugging. - - * macosx/Wish.xcode/project.pbxproj: removed $prefix/share from - * macosx/Wish.xcodeproj/project.pbxproj: TCL_PACKAGE_PATH as per change - to tcl/unix/configure.in of 2006-03-13. - - * macosx/tkMacOSXDraw.c: sync whitespace & minor changes with - * macosx/tkMacOSXEvent.h: core-8-4-branch. - * macosx/tkMacOSXFont.h: - * macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXNotify.c: - -2006-03-27 Don Porter <dgp@users.sourceforge.net> - - * changes: Updates for next RC - -2006-03-27 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> - - * generic/tkTextDisp.c (MeasureChars): Fix calculations of start and - end of string. [Bugs 1325998, 1456157] - -2006-03-27 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkImgGIF.c (FileReadGIF): Stop crashes when the first GIF - frame does not define the overall size of the image. [Bug 1458234] - -2006-03-26 Vince Darley <vincentdarley@users.sourceforge.net> - - * generic/tkText.c: - * generic/tkText.h: - * generic/tkTextBTree.c: - * tests/text.test: Fix for [Bug 1414171] for '$text dump -command - <script>' where 'script' actually modifies the widget during the - process. - -2006-03-25 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXDraw.c (TkMacOSXSetUpCGContext): - * macosx/tkMacOSXFont.c (TkMacOSXQuarzStartDraw, TkMacOSXQuarzEndDraw): - performance improvements, sync similar code, formatting & whitespace. - -2006-03-24 Daniel Steffen <das@users.sourceforge.net> - - * generic/tkTextDisp.c: Moved #ifdef MAC_OSX_TK code added by - * macosx/tkMacOSXColor.c: [Patch 638966] into platform specific files. - * macosx/tkMacOSXInt.h: - - * macosx/tkMacOSX.h: Cleaned up & rationalized order of - * macosx/tkMacOSXBitmap.c: #includes of tk and carbon headers. - * macosx/tkMacOSXButton.c: - * macosx/tkMacOSXCarbonEvents.c: - * macosx/tkMacOSXClipboard.c: - * macosx/tkMacOSXColor.c: - * macosx/tkMacOSXConfig.c: - * macosx/tkMacOSXCursor.c: - * macosx/tkMacOSXDialog.c: - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXEmbed.c: - * macosx/tkMacOSXEntry.c: - * macosx/tkMacOSXEvent.c: - * macosx/tkMacOSXEvent.h: - * macosx/tkMacOSXFont.h: - * macosx/tkMacOSXHLEvents.c: - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXInt.h: - * macosx/tkMacOSXKeyEvent.c: - * macosx/tkMacOSXKeyboard.c: - * macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXMenus.c: - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXRegion.c: - * macosx/tkMacOSXScale.c: - * macosx/tkMacOSXScrlbr.c: - * macosx/tkMacOSXSend.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXWm.h: - * macosx/tkMacOSXXStubs.c: - -2006-03-23 Reinhard Max <max@tclers.tk> - - * unix/tkUnixRFont.c (TkpMeasureCharsInContext): Copied over from - tkUnixFont.c to fix compiling with --enable-xft . - - * unix/tk.spec: Cleaned up and completed. An RPM can now be built from - the tk source distribution with "rpmbuild -tb <tarball>". - -2006-03-23 Don Porter <dgp@users.sourceforge.net> - - * tests/textDisp.test: Updated expected error messages to match the - standardized formats established on 2005-11-17. [Bug 1370296] - -2006-03-22 Don Porter <dgp@users.sourceforge.net> - - * changes: Updates for next RC - -2006-03-21 Daniel Steffen <das@users.sourceforge.net> + * changes: Updates for 8.5.2 release. - * generic/tkFont.c: implementation of ATSUI text rendering - * generic/tkInt.h: in TkAqua provided by Benjamin - * generic/tkTextDisp.c: Riefenstahl. [Patch 638966] - * library/demos/unicodeout.tcl: - * macosx/tkMacOSXFont.h (new file): - * macosx/tkMacOSXFont.c: - * tests/font.test: - * unix/tkUnixFont.c: - * win/tkWinFont.c: +2008-03-27 Jeff Hobbs <jeffh@ActiveState.com> - * generic/tkFont.c: moved MODULE_SCOPE declarations of font - * generic/tkFont.h: helper procs into header files. - * macosx/tkMacOSXButton.c: - * macosx/tkMacOSXFont.h: - * macosx/tkMacOSXMenubutton.c: + * library/safetk.tcl (::safe::tkInterpInit): Make sure tk_library and + its subdirs (eg, ttk) are on the "safe" access path. - * macosx/Wish.xcode/project.pbxproj: add new tkMacOSXFont.h file, - * macosx/Wish.xcodeproj/project.pbxproj: turn off dead code stripping - as it interferes with -sectcreate (rdar://4486223). +2008-03-27 Daniel Steffen <das@users.sourceforge.net> - * macosx/Wish.xcode/default.pbxuser: add TCLLIBPATH=/Library/Tcl - * macosx/Wish.xcodeproj/default.pbxuser: env var setting to tktest. + * unix/tcl.m4 (SunOS-5.1x): [Bug 1921166]: Fix 64bit support for Sun + cc. - * unix/configure.in: fix detection of symbols build when enabling - TkAqua debug code; filter nm output of libtclstub better to avoid - error on intel macs. [Bug 1415789] * unix/configure: autoconf-2.59 -2006-03-20 Don Porter <dgp@users.sourceforge.net> - - * generic/tkConsole.c: Added exit handler to clean up the interp where - the console window lives. Also added code to handle multiple calls to - Tk_CreateConsoleWindow so that the console channels connect to the last - console window opened, in compatibility with the previous - implementation. - -2006-03-18 Vince Darley <vincentdarley@users.sourceforge.net> - - * generic/tkText.c: Fix for undo/modified status of text widgets when - empty strings are inserted and undone. - -2006-03-17 Pat Thoyts <patthoyts@users.sourceforge.net> - - * library/clrpick.tcl: Avoid using abbreviated sub-commands in core - * library/palette.tcl: scripts as this can cause problems with - * library/scale.tcl: mega-widget libraries like snit. - * library/scrlbar.tcl: [Bug 1451587] - * library/tkfbox.tcl: - * library/xmfbox.tcl: - -2006-03-16 Don Porter <dgp@users.sourceforge.net> - - * generic/tkConsole.c: Substantial rewrite of [console] support. - * generic/tkInt.h: Included Obj-ification of the [console] and - [consoleinterp] commands, and reworking of all the supporting data - structures for cleaner sharing and lifetime management especially in - multi-threaded configurations. - -2006-03-16 Donal K. Fellows <dkf@users.sf.net> - - * library/msgs/pt.msg: Messages for Portuguese (strictly just for - Brazilian Portuguese, but they'll do until we get other Portuguese - speakers localize) from Ricardo Jorge <ricardoj@users.sf.net> and Silas - Justiano <silasj@users.sf.net>. Many thanks! [Bug 1405069] - - * generic/tkImgPhoto.c (ImgPhotoCmd, Tk_PhotoPutBlock) - (Tk_PhotoPutZoomedBlock): Added hack to detect copying of a photo with - a simple alpha channel and skip calling ToggleComplexAlphaIfNeeded. - This should speed up many photo-to-photo copies, keeping the cost of - the alpha channel down. - -2006-03-15 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkImgPhoto.c (Tk_PhotoPutBlock, Tk_PhotoPutZoomedBlock): Try - to squelch performance issue with code that writes to large images by - single pixels. Masses of thanks to George Staplin for helping to trace - this down to the COMPLEX_ALPHA flag handling code. [Bug 1409140] - -2006-03-13 Don Porter <dgp@users.sourceforge.net> - - * tests/scrollbar.test: Corrected several broken calls to [testmetrics] - that were crashing the test suite. - - * tests/constraints.tcl: Added notAqua constraint to canvPs-3.1 - * tests/canvPs.test: to stop test suite crash on Mac OSX. - [Bug 1088807] - - * generic/tkCmds.c: Purged remaining references to errno, - * macosx/tkMacOSXPort.h: and errno.h. Standardized the logic - * macosx/tkMacOSXWm.c: for using header files from the compat - * macosx/tkMacOSXWm.h: directory. Thanks Joe English for the - * unix/tkUnixPort.h: patch. [Patch 1445404] - -2006-03-08 Don Porter <dgp@users.sourceforge.net> - - * unix/Makefile.in: Update `make dist` to copy the image files needed - by the test suite into the source distro. This was overlooked in the - 2005-10-12 commit. - - * changes: Update in prep. for 8.5a4 release. - -2006-03-07 Joe English <jenglish@users.sourceforge.net> - - * unix/tcl.m4: Set SHLIB_LD_FLAGS='${LIBS}' on NetBSD, as per the other - *BSD variants. [Bug 1334613] - * unix/configure: Regenerated. - -2006-03-07 Donal K. Fellows <dkf@users.sf.net> - - * doc/canvas.n: Added note that stipples are not well-supported on - non-X11 platforms. [Bug 220787] It's not a great solution, but it does - indicate the state of affairs that has existed for years anyway; not - much modern software uses stipples anyway. - -2006-03-02 Jeff Hobbs <jeffh@ActiveState.com> - - * macosx/tkMacOSXDraw.c (TkPutImage): Fix endian issue on OS X x86 - displaying images. Bitmap images still have a black/white reversal - issue, appears to be a general OS X issue (as seen in frogger demo). - -2006-02-27 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * generic/tkBitmap.c (Tk_GetBitmapFromData): Improve thread-safety. - [Bug 470322] - - * generic/tkImgBmap.c (ImgBmapConfigureInstance): Force creation of new - Pixmaps before deletion of old ones to prevent stupid caching problems. - [Bug 480862] - -2006-02-09 Daniel Steffen <das@users.sourceforge.net> - - * generic/tk.decls: fix signature of TkMacOSXInvalClipRgns - * generic/tkPlatDecls.h: to use Tk_Window instead of internal - * macosx/tkMacOSXSubwindows.c: type TkWindow (which led to any include - * macosx/tkMacOSXWindowEvent.c: of public header tkMacOSX.h requiring - * macosx/tkMacOSXWm.c: prior include of tkInt.h). - - * generic/tk.h: move TkAqua specific REDO_KEYSYM_LOOKUP define - * macosx/tkMacOSXPort.h: out of tk.h into platform header. - -2006-01-31 Donal K. Fellows <dkf@users.sf.net> - - * library/bgerror.tcl (::tk::dialog::error::bgerror): Finish the - internationalization of the error dialog. [Bug 1409264] - -2006-01-25 Don Porter <dgp@users.sourceforge.net> - - * library/bgerror.tcl: Updates to use Tcl 8.4 features. [Patch 1237759] - * library/choosedir.tcl: - * library/comdlg.tcl: - * library/console.tcl: - * library/dialog.tcl: - * library/focus.tcl: - * library/msgbox.tcl: - * library/palette.tcl: - * library/tk.tcl: - * library/tkfbox.tcl: - * library/xmfbox.tcl: - -2006-01-23 Daniel Steffen <das@users.sourceforge.net> - - * unix/configure: minor fix to Darwin specific code removing - * unix/configure.in: 64bit flags from CFLAGS for Tk build. - -2006-01-20 Joe English <jenglish@users.sourceforge.net> - - * generic/tkEvent.c, unix/tkUnixEvent.c: XIM fixes [See 905830, patch - tk84-xim-fixes.patch], and revert 2005-12-05 patch disabling XIM when - SCIM in use, and make sure all X events get passed to XFilterEvent, - including those without a corresponding Tk window. - -2006-01-13 Anton Kovalenko <a_kovalenko@users.sourceforge.net> - - * generic/tkUndo.c (TkUndoSetDepth): Don't free TkUndoSubAtoms for - separator entries that are deleted: there is some unpredictable garbage - instead of subatoms. - - Free both 'apply' and 'revert' action chains for non-separator entries. - -2006-01-12 Donal K. Fellows <dkf@users.sf.net> - - TIP #260 IMPLEMENTATION - - * generic/tkCanvText.c (TextItem, CreateText, DisplayCanvText): - * doc/canvas.n: Code, docs and tests to implement an -underline - * tests/canvText.test: option for canvases' text items. - -2006-01-11 Peter Spjuth <peter.spjuth@space.se> - - * generic/tkGrid.c: Removed a lingering error message from TIP#147 - implementation. - -2006-01-10 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXDebug.c: add TkMacOSXGetNamedDebugSymbol() function - * macosx/tkMacOSXDebug.h: that finds unexported symbols in loaded - libraries by manually walking their symbol table; only to be used for - debugging purposes, may break unexpectedly in the future. Needed to get - access to private_extern internal debugging functions in HIToolbox. - - * macosx/tkMacOSXCarbonEvents.c: fix debug event tracing on Tiger. - * macosx/tkMacOSXMenu.c: add debug menu printing during reconfigure. - * macosx/tkMacOSXInit.c: conditionalize 64bit-unsafe dyld code. - * macosx/GNUmakefile: add 'wish8.x' symlink to SYMROOT. - - * macosx/Wish.xcode/project.pbxproj: fix copy to tktest resource - * macosx/Wish.xcodeproj/project.pbxproj: fork when zerolinked. - - * macosx/Wish.xcode/default.pbxuser: add widget demo as argument to - * macosx/Wish.xcodeproj/default.pbxuser: executables (on by default). - - * unix/configure: add caching, use AC_CACHE_CHECK instead of - * unix/configure.in: AC_CACHE_VAL where possible, consistent message - * unix/tcl.m4: quoting, sync relevant tclconfig/tcl.m4 changes - and gratuitous formatting differences, fix SC_CONFIG_MANPAGES with - default argument, Darwin improvements to SC_LOAD_*CONFIG. - -2005-12-28 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkUndo.c (TkUndoSetDepth): Apply [Patch 1391939] from Ludwig - Callewaert to fix [Bug 1380427]. - -2005-12-14 Daniel Steffen <das@users.sourceforge.net> - - * macosx/Wish.xcode/project.pbxproj: - * macosx/Wish.xcodeproj/project.pbxproj: add new tclTomMath* files. - -2005-12-13 Daniel Steffen <das@users.sourceforge.net> - - * library/demos/cscroll.tcl: add MouseWheel bindings for aqua. - - * macosx/tkMacOSXCarbonEvents.c (TkMacOSXInitCarbonEvents): - * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent) - (GenerateMouseWheelEvent): add support for kEventMouseScroll events - (smooth mouse wheel scrolling from mighty mouse or scrolling trackpad) - by handling kEventMouseWheelMoved on application target as well as on - dispatcher, in order to pick up synthesized MouseWheel events from - HIObject handler (c.f. QA1453); add support for horizontal scrolling - events by generating MouseWheel XEvent with Shift modifier. - -2005-12-12 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/tcl.m4, unix/configure: Fix sh quoting error reported in - bash-3.1+ [Bug 1377619] (schafer) - -2005-12-09 Mo DeJong <mdejong@users.sourceforge.net> - - * win/tkWinWm.c (WinSetIcon): Don't check result of SetClassLong() or - SetClassLongPtr() since it was generating an incorrect error and the - MSDN docs indicate that the result need not be checked. - -2005-12-09 Mo DeJong <mdejong@users.sourceforge.net> - - * win/configure: Regen. - * win/tcl.m4 (SC_CONFIG_CFLAGS): Define MACHINE for gcc builds. The - lack of a definition of this variable in the manifest file was causing - a runtime error in wish built with gcc. - -2005-12-09 Daniel Steffen <das@users.sourceforge.net> - - * generic/tkInt.decls: Move all platform test sources from tk lib into - * generic/tkTest.c: tktest directly, removes requirement to export - * macosx/tkMacOSXTest.c:TkplatformtestInit from internal stubs table. - * unix/Makefile.in: - * win/Makefile.in: - * win/makefile.vc: - * win/tkWinTest.c: - - * generic/tkIntPlatDecls.h: - * generic/tkStubInit.c: regen. - -2005-12-08 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tcl.m4: Add build support for Windows-x64 builds. - * win/configure: --enable-64bit now accepts =amd64|ia64 for - * win/Makefile.in: Windows 64-bit build variants (default: amd64) - * win/makefile.vc: [Bug 1369597] - (TKOBJS): add tkWinTest.obj to regular Tk obj for TkplatformtestInit - - * win/configure.in: Add CE build support (some C code fixes needed) - * win/wish.exe.manifest.in (new): manifest must map in MACHINE and - * win/rc/wish.exe.manifest (removed): VERSION to be correct. - * unix/Makefile.in: fix dist target for manifest dir change - - * generic/tkTextTag.c (TkTextTagCmd): use correct arraySize for peered - text widgets in [$text tag names]. [Bugs 1375069, 1374935] - -2005-12-08 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXDraw.c: Remove inclusion of tclInt.h and use of tcl - * macosx/tkMacOSXFont.c: internals wherever possible in tk/macosx, the - * macosx/tkMacOSXInit.c: only remaining tcl internals in TkAqua are - * macosx/tkMacOSXNotify.c:TclServiceIdle() in tkMacOSXScrlbr.c and - * macosx/tkMacOSXScrlbr.c:Tcl_Get/SetStartupScript() in tkMacOSXInit.c - [RFE 1336531] - - * macosx/tkMacOSXInt.h: sync comments with core-8-4-branch. - -2005-12-07 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/tkUnixEvent.c (OpenIM): remove extraneous const - -2005-12-06 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * doc/ConfigWidg.3 (TK_CONFIG_OPTION_SPECIFIED): Mentioned that the - flag is deprecated because it is not thread-safe. - -2005-12-05 Reinhard Max <max@suse.de> - - * unix/tkUnixEvent.c (OpenIM): Added a workaround to allow at least - ASCII and the Compose key when typing into text and entry widgets on a - system that uses SCIM. This has to be taken out again once the SCIM - problems have been fixed. - -2005-12-01 Daniel Steffen <das@users.sourceforge.net> - - * unix/tcl.m4 (Darwin): fixed error when MACOSX_DEPLOYMENT_TARGET unset - * unix/configure: regen. - -2005-11-30 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tkWinWm.c (WmAttributesCmd): set (no)topmost window aspect before - rewrapping. [Bug 1086049] - - * macosx/tkMacOSXXStubs.c (TkpOpenDisplay, TkMacOSXDisplayChanged): - * macosx/tkMacOSXWindowEvent.c (TkMacOSXProcessApplicationEvent): - * macosx/tkMacOSXCarbonEvents.c (TkMacOSXInitCarbonEvents): - * macosx/tkMacOSXEvent.h: Trap kEventAppAvailableWindowBoundsChanged - * macosx/tkMacOSXInt.h: event to watch for change in display size and - adjust internal state appropriately. - - * doc/checkbutton.n: fix -selectcolor docs. [Bug 1083838] - - * generic/tkImgGIF.c: cast calls to blockOut - - * win/Makefile.in: place TCL_BIN_DIR first in PATH for targets to get - Tcl built dll first. - Add tkWinTest.obj to tk84.dll to handle some needed test functions - being defined in stubs (TkplatformtestInit). - - * tests/scrollbar.test (6.22): fix rounding-error sensitive test - -2005-11-29 Jeff Hobbs <jeffh@ActiveState.com> - - * library/console.tcl (::tk::ConsoleInit): improve work-around to avoid - '% ' from tclMain.c. [Bug 1252259] - -2005-11-27 Daniel Steffen <das@users.sourceforge.net> - - * unix/tcl.m4 (Darwin): add 64bit support, check for Tiger copyfile(), - add CFLAGS to SHLIB_LD to support passing -isysroot in env(CFLAGS) to - configure (flag can't be present twice, so can't be in both CFLAGS and - LDFLAGS during configure), don't use -prebind when deploying on 10.4, - define TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING (rdar://3171542). - (SC_ENABLE_LANGINFO, SC_TIME_HANDLER): add/fix caching, fix obsolete - autoconf macros. Sync with tcl/unix/tcl.m4. - - * unix/configure.in: fix obsolete autoconf macros, sync gratuitous - formatting/ordering differences with tcl/unix/configure.in. - - * unix/Makefile.in: add CFLAGS to wish/tktest link to make executable - linking the same as during configure (needed to avoid loosing any - linker relevant flags in CFLAGS, in particular flags that can't be in - LDFLAGS). Avoid concurrent linking of wish and compiling of - tkTestInit.o during parallel make, fix dependencies and flags for - building tkMacOSXInit.o - (checkstubs, checkexports): dependency and Darwin fixes - (dist): add new macosx files. - - * macosx/tkMacOSXEvent.c (TkMacOSXProcessEvent): - * macosx/tkMacOSXEvent.h: - * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): - * macosx/tkMacOSXCarbonEvents.c: install standard application event - handler, add & call functions to start and stop carbon even timer that - runs the tcl event loop periodically during a nested carbon event loop - in the toolbox (e.g. during menutracking) to ensure tcl timers etc. - continue to fire, register app event handler for menu tracking and HI - command carbon events, move menu event handling to new handlers for - those carbon events, no longer register for/handle appleevent carbon - event (now dealt with by standard application event handler), event - debugging code dynamically acquires carbon event debugging functions to - allow use on Tiger where they are no longer exported from HIToolbox. - - * macosx/tkMacOSXFont.c (TkMacOSXUseAntialiasedText): - * macosx/tkMacOSXKeyEvent.c (GetKeyboardLayout): - * macosx/tkMacOSXCarbonEvents.c (TkMacOSXInitCarbonEvents): - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXInt.h: abstract common code to dynamically acquire - address of a named symbol (from a loaded dynamic library) into new - function TkMacOSXGetNamedSymbol() and macro TkMacOSXInitNamedSymbol. - - * macosx/tkMacOSXMenu.c (TkpNewMenu): - * macosx/tkMacOSXMenubutton.c (MenuButtonInitControl): - * macosx/tkMacOSXMenus.c (TkMacOSXHandleMenuSelect): switch to modern - utf-8 aware menu manager API, remove obsolete code, add error handling. - - * macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXMenus.c: - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXMouseEvent.c: define OSX 10.3 or later only constants - if necessary to allow compilation on OSX 10.2 - - * macosx/tkMacOSXWm.c (UpdateSizeHints): remove code that is never - executed. - - * xlib/xgc.c (XCreateGC): sync with core-8-4-branch change. - - * generic/tk.h: add/correct location of version numbers in macosx files - - * generic/tkInt.h: clarify fat compile comment. - - * macosx/Wish.pbproj/default.pbxuser (new): - * macosx/Wish.pbproj/jingham.pbxuser: - * macosx/Wish.pbproj/project.pbxproj: - * macosx/Wish.xcode/default.pbxuser: - * macosx/Wish.xcode/project.pbxproj: - * macosx/Wish.xcodeproj/default.pbxuser (new): - * macosx/Wish.xcodeproj/project.pbxproj (new): new/updated projects for - Xcode 2.2 on 10.4, Xcode 1.5 on 10.3 & ProjectBuilder on 10.2, with - native tktest targets and support for universal (fat) compiles. - - * macosx/Tk-Info.plist (removed): - * macosx/Wish-Info.plist (removed): - * macosx/buildTkConfig.tcl (removed): remove obsolete build files. - - * macosx/README: clarification/cleanup, document new Xcode projects and - universal (fat) builds via CFLAGS (i.e. ppc and i386 at the same time). - - * unix/Makefile.in: - * unix/aclocal.m4: - * unix/configure.in: - * macosx/configure.ac (new): add support for inclusion of - unix/configure.in by macosx/configure.ac, allows generation of a - config headers enabled configure script in macosx (required by Xcode - projects). - - * macosx/GNUmakefile: rename from Makefile to avoid overwriting by - configure run in tk/macosx, add support for reusing configure cache, - build target fixes. - - * generic/tk3d.h: - * generic/tkButton.h: - * generic/tkCanvas.c: - * generic/tkCanvas.h: - * generic/tkColor.h: - * generic/tkEntry.h: - * generic/tkFileFilter.h: - * generic/tkFont.c: - * generic/tkFont.h: - * generic/tkImage.c: - * generic/tkImgPhoto.c: - * generic/tkInt.h: - * generic/tkMenu.c: - * generic/tkMenu.h: - * generic/tkMenubutton.h: - * generic/tkScale.h: - * generic/tkScrollbar.h: - * generic/tkSelect.h: - * generic/tkStubInit.c: - * generic/tkStubLib.c: - * generic/tkText.h: - * generic/tkUndo.h: - * macosx/tkMacOSXButton.c: - * macosx/tkMacOSXDebug.c: - * macosx/tkMacOSXDebug.h: - * macosx/tkMacOSXDialog.c: - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXEntry.c: - * macosx/tkMacOSXFont.c: - * macosx/tkMacOSXInt.h: - * macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXSend.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXXStubs.c: - * unix/tkUnixButton.c: - * unix/tkUnixMenu.c: - * xlib/xgc.c: ensure externally visible symbols not contained in stubs - table are declared as MODULE_SCOPE (or as static if not used outside of - own source file), #ifdef out a few Xlib and aqua functions that are - never called. These changes allow 'make checkstubs' to complete without - error on Darwin with gcc 4. - - * macosx/tkMacOSXTest.c: - * macosx/tkMacOSXPort.h: - * win/tkWinTest.c: - * generic/tkInt.decls: add functions needed by tktest to internal stubs - table, correct signature of TkMacOSXHandleMenuSelect, add XSync to aqua - Xlib stubs. +2008-03-27 Daniel Steffen <das@users.sourceforge.net> - * unix/tkUnixSend.c: - * generic/tkText.c: - * generic/tkTest.c: #ifdef unix only declarations. - (TestmetricsCmd): unify win and mac implementation. - (TestsendCmd): move to tkUnixSend.c to avoid access to global var. - (TesttextCmd): move to tkText.c to avoid having to put all the internal - text functions it uses into the stubs table. + * generic/ttk/ttkStubLib.c: Ensure tcl stubs are used in libtkstub + even in a static build of Tk. + * generic/ttk/ttkDecls.h: Fix incorrect number of arguments in + Ttk_InitStubs macro definition. - * generic/tkTextDisp.c: - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXKeyEvent.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXXStubs.c: fix gcc 4 warnings. +2008-03-26 Don Porter <dgp@users.sourceforge.net> - * macosx/tkMacOSXNotify.c: - * macosx/tkMacOSXScrlbr.c: sync with core-8-4-branch. + * changes: Updates for 8.5.2 release. - * generic/tkIntDecls.h: - * generic/tkIntPlatDecls.h: - * generic/tkIntXlibDecls.h: - * generic/tkStubInit.c: - * unix/configure: - * unix/tkConfig.h.in: regen. + * unix/tkUnixCursor.c: [Bug 1922466]: Stop crash in [. configure + -cursor] on X11. Thanks to Emiliano Gavilán. -2005-11-22 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-03-26 Joe English <jenglish@users.sourceforge.net> - * library/tkfbox.tcl: Remove all references to data(curItem), as it is - no longer used. [Bug 600313] - (::tk::IconList_CurSelection): Renamed for clarity. + * generic/tkInt.h, generic/tkEvent.c, unix/tkUnixEvent.c, + * unix/tkUnixKey.c: XIM reorganization and cleanup; see + [Patch 1919791] for details. - * doc/GetFont.3: Revert previous fix; a NULL interp is now legal. - * generic/tkFont.c (ParseFontNameObj, GetAttributeInfoObj): Allow these - functions to work with a NULL interp by making them check when - generating error messages. [Bug 1151523] +2008-03-21 Joe English <jenglish@users.sourceforge.net> - * library/tkfbox.tcl (::tk::dialog::file::): Correct the quoting of the - script used in variable traces so that widget names with spaces in will - work. [Bug 1335485] + * generic/tk.decls, generic/ttk/ttkStubLib.c, unix/Makefile.in: + [Bug 1920030]: Keep ttkStubLib.o in libtkstub instead of libtk. -2005-11-16 Vince Darley <vincentdarley@users.sourceforge.net> +2008-03-20 Donal K. Fellows <dkf@users.sf.net> - * doc/text.n: clarify left to right interpretation of index modifiers, - including the fact that validation occurs after each step. [Bug - 1357575] + * tests/wm.test: Rewrote so that tests clean up after themselves + rather than leaving that to the following test. Makes it easier to + catch problems where they originate. Inspired by [Bug 1852338] -2005-11-15 Joe English <jenglish@users.sourceforge.net> +2008-03-19 Donal K. Fellows <dkf@users.sf.net> - * unix/tkUnixWm.c, tests/unixWm.test, doc/wm.n: Support for [wm - attributes] on X11. [TIP#231, Patch 1062022] + * doc/GetClrmap.3: [Bug 220809]: Documented Tk_PreserveColormap. -2005-11-14 Joe English <jenglish@users.sourceforge.net> +2008-03-17 Joe English <jenglish@users.sourceforge.net> - * library/bgerror.tcl: Truncate error messages at 45 characters - instead of 30. [Bug 1224235] + * unix/Makefile.in, win/Makefile.in, win/makefile.vc: [Bug 1863007]: + Put ttkStubLib.o in libtkstub instead of libtk. -2005-11-14 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-03-16 Donal K. Fellows <dkf@users.sf.net> - * generic/tkSelect.c (TkSelDefaultSelection): Test select-9.5 - highlighted further brokenness in this function. + * library/demos/goldberg.tcl: [Bug 1899664]: Made work when run twice + in the same session. Also made the control panel use Ttk widgets. -2005-11-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-03-13 Daniel Steffen <das@users.sourceforge.net> - * unix/tkUnixSelect.c (SelCvtToX): Arrange for the parsing code to use - Tcl's list parsing code, another simplification that enables testing - of the [Bug 1353414] fix. + * unix/configure.in: [Bug 1913622]: Use backslash-quoting instead of + * unix/tcl.m4: double-quoting for lib paths in tkConfig.sh. + * unix/configure: autoconf-2.59 - * unix/tkUnixSelect.c (SelCvtFromX): Generate string forms of the - advanced selection types in a Tcl_DString. This makes fixing [Bug - 1353414] trivial, and simplifies the code at the same time. - * tests/select.test (select-9.5): Added test for [Bug 1353414] +2008-03-13 Don Porter <dgp@users.sourceforge.net> -2005-11-10 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + * changes: Updates for 8.5.2 release. - * generic/tkBind.c (ChangeScreen): More DString fixes from - * generic/tkTextWind.c (EmbWinLayoutProc): [Bug 1353022] - * win/tkWinMenu.c (SetDefaults): +2008-03-12 Daniel Steffen <das@users.sourceforge.net> - * win/tkWinDialog.c (ConvertExternalFilename): Factored out the - encoding conversion and de-backslash-ing code that is used in many - places in this file. - (GetFileNameW, GetFileNameA, ChooseDirectoryValidateProc): Make sure - that data is freed correctly and that certain (hopefully impossible) - failure modes won't cause crashes. [Bug 1353022] + * macosx/Wish.xcodeproj/project.pbxproj: Add support for Xcode 3.1 + * macosx/Wish.xcodeproj/default.pbxuser: CODE_SIGN_IDENTITY and + * macosx/Wish-Common.xcconfig: 'xcodebuild install'. -2005-11-06 Pat Thoyts <pat@zsplat.freeserve.co.uk> +2008-03-12 Joe English <jenglish@users.sourceforge.net> - * unix/tcl.m4: Fix SHLIB_LD_LIBS for building tclkit on OpenBSD. - * unix/configure: regenerated + * unix/tkUnixRFont.c: Try a fallback font if XftFontOpenPattern() + fails in GetFont (workaround for [Bug 1090382]). -2005-10-31 Vince Darley <vincentdarley@users.sourceforge.net> +2008-03-11 Daniel Steffen <das@users.sourceforge.net> - * generic/tkText.c - * tests/textDisp.test: fix and test for [Bug 1333951] in '.text count - -displaylines'. + * library/demos/knightstour.tcl: Aqua GOOBE. + * library/demos/widget: -2005-10-18 Don Porter <dgp@users.sourceforge.net> + * macosx/Wish.xcodeproj/project.pbxproj: Add support for Xcode 3.1 and + * macosx/Wish.xcodeproj/default.pbxuser: configs for building with + * macosx/Wish-Common.xcconfig: gcc-4.2 and llvm-gcc-4.2. - * generic/tkMain.c: Rewrote code that sets the ::argv value to be sure - conversion from the system encoding is complete before any processing - sensitive to list-special characters is done. [Bug 1328926] + * generic/tkCanvUtil.c: Fix gcc-4.2 warnings. -2005-10-17 Jeff Hobbs <jeffh@ActiveState.com> + * macosx/GNUmakefile: Fix quoting to allow paths to + * macosx/Wish-Common.xcconfig: ${builddir}, ${INSTALL_ROOT} + * unix/Makefile.in: and ${TCL_BIN_DIR} to contain + * unix/configure.in: spaces. + * unix/install-sh: + * unix/tcl.m4: - * macosx/tkMacOSXScrlbr.c (UpdateControlValues): check geomMgrPtr is - valid before checking type + * unix/configure: autoconf-2.59 -2005-10-15 Jeff Hobbs <jeffh@ActiveState.com> + * unix/Makefile.in (install-strip): Strip non-global symbols from + dynamic library. - * library/menu.tcl (::tk::MenuUnpost): remove leftover ] from string - equal mods of 2005-07-25. (sowadsky) +2008-03-10 Don Porter <dgp@users.sourceforge.net> -2005-10-14 Pat Thoyts <patthoyts@users.sourceforge.net> + * changes: Updates for 8.5.2 release. - * win/tkWinSend.c: Avoid using tcl internal headers and fix to - * win/tkWinSendCom.h: correctly link on all types of build (was - * win/tkWinSendCom.c: broken in static,msvcrt builds). +2008-03-07 Donal K. Fellows <donal.k.fellows@man.ac.uk> -2005-10-12 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * doc/colors.n: Reworked to produce nicer HTML output. - * tests/canvPs.test, tests/canvPsBmap.tcl, tests/canvPsImg.tcl: - * tests/imgPhoto.test, tests/menu.test: Arrange for the test suite to - only ever refer to images in the same directory as the tests. This - makes it possible to package the test suite itself as a starkit. Thanks - to David Zolli for suggesting this. +2008-03-06 Joe English <jenglish@users.sourceforge.net> -2005-10-10 Jeff Hobbs <jeffh@ActiveState.com> + * doc/ttk_notebook.n: [Bug 1882011]: Move "TAB IDENTIFIERS" section + above "WIDGET COMMAND" section. - * generic/tkConfig.c (Tk_DeleteOptionTable, Tk_CreateOptionTable): - properly alloc/delete one more option. [Bug 1319720] (melbardis) +2008-02-29 Pat Thoyts <patthoyts@users.sourceforge.net> - * macosx/tkMacOSXInt.h: Move MODULE_SCOPE defn to tkInt.h and add - * generic/tkInt.h: WORDS_BIGENDIAN checks that will work with OS X - universal binary compiles. (steffen) + * library/demos/widget: Added a Knight's tour canvas demo. + * library/demos/knightstour.tcl: - * generic/tkMenu.c (TkSetWindowMenuBar): do not call TkMenuInit if the - winPtr indicates TK_ALREADY_DEAD. This prevents reinit that creates a - Tk exit handler after all exit handlers should be called. [Bug 749908, - 1322294] +2008-02-27 Daniel Steffen <das@users.sourceforge.net> -2005-10-10 Vince Darley <vincentdarley@users.sourceforge.net> + * macosx/tkMacOSXDraw.c: Workaround leak in Carbon SetPortPenPixPat() + API [Bug 1863346]; avoid repeated PixPat allocation/deallocation. - TIP #256 IMPLEMENTATION +2008-02-23 Joe English <jenglish@users.sourceforge.net> - * doc/text.n - * generic/tkText.c - * generic/tkText.h - * generic/tkTextBTree.c - * generic/tkTextDisp.c - * generic/tkTextImage.c - * generic/tkTextIndex.c - * generic/tkTextMark.c - * generic/tkTextTag.c - * generic/tkTextWind.c - * macosx/tkMacOSXDefault.h - * tests/text.test - * tests/textDisp.test - * unix/tkUnixDefault.h - * win/tkWinDefault.h: Implementation of TIP#256, adding a new text - widget configuration option '-tabstyle', with new tests and + * library/ttk/combobox.tcl, doc/ttk_combobox.n, + * tests/ttk/combobox.test: Arrange to deliver <<ComboboxSelected>> + event after listbox is unposted, as intended [Bug 1890211]. Clarified documentation. - Also a fix for [Bug 1281228] (documentation and full implementation of - -strictlimits), and [Bug 1288677] (corrected elide behaviour), again - with more tests. - -2005-10-04 Jeff Hobbs <jeffh@ActiveState.com> - - * library/dialog.tcl (::tk_dialog): add tkwait visibility before grab. - [Bug 1216775] - - * win/tkWinDialog.c (ChooseDirectoryValidateProc): reset stored path to - "" if it doesn't exist and -mustexist is true. [Bug 1309218] Remove - old-style dir chooser (no longer used). - - * macosx/tkMacOSXInt.h: add MODULE_SCOPE definition check for extension - writers that access private headers on OS X and don't define it in - configure. - -2005-09-28 Don Porter <dgp@users.sourceforge.net> - - * unix/tkUnixPort.h: Disabled inclusion of the private Tcl header - * win/tkWinPort.h: file tclInt.h. Tk ought to have a tiny and - shrinking number of calls of private Tcl routines. Each Tk source file - doing this should follow the convention in the macosx port and have its - own #include "tclInt.h". - - * generic/tkEvent.c: Disabled calls to private Tcl routine - TclInExit(). See comment in TkCreateExitHandler() for full rationale. - -2005-09-21 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * generic/tkEvent.c (TkCreateThreadExitHandler, TkFinalizeThread) - (TkDeleteThreadExitHandler): New internal API (from Joe Mistachkin) to - allow Tk to finalize itself correctly in a multi-threaded - environment. [Bug 749908] - -2005-09-14 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkOldConfig.c (GetCachedSpecs): Split out the code to - manipulate the cached writable specs so that it can be reused from all - the public Tk_Configure* functions. - (Tk_ConfigureInfo, Tk_ConfigureWidget, Tk_ConfigureValue): Use the - factored out code everywhere, so we always manipulate the cache - correctly. [Bug 1288128] - -2005-09-13 Don Porter <dgp@users.sourceforge.net> - - * win/winMain.c (WishPanic): Replaced TCL_VARARGS* macros with direct - use of stdarg.h conventions. - -2005-09-11 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): check if - process is in front on MouseDown, otherwise request process activation - from BringWindowForward() via new isFrontProcess param. - - * macosx/tkMacOSXCarbonEvents.c (TkMacOSXInitCarbonEvents): register - our event handler on the dispatcher target for all carbon events of - interest to TkAqua; this replaces event processing directly from the - event queue and thus allows to capture events that are syntesized by - Carbon and sent directly to the dispatcher and not to the event queue. - - * macosx/tkMacOSXEvent.c: remove TkMacOSXCountAndProcessMacEvents(), - rename ReceiveAndProcessEvent() to TkMacOSXReceiveAndProcessEvent(). - (TkMacOSXReceiveAndProcessEvent): remove tk event processing before - sending events to the dispatcher, all events of interest are now - processed in our dispatcher target event handler. - - * macosx/tkMacOSXNotify.c (CarbonEventsCheckProc): dispatch events - directly via TkMacOSXReceiveAndProcessEvent(), but dispatch no more - than four carbon events at one time to avoid starving other event - sources. - - * macosx/tkMacOSXEvent.c: formatting cleanup, move XSync() to XStubs, - * macosx/tkMacOSXEvent.h: removed obsolete kEventClassWish handling. - * macosx/tkMacOSXXStubs.c - - * macosx/tkMacOSXEvent.h: declare macosx internal procs as MODULE_SCOPE - * macosx/tkMacOSXEvent.c: - * macosx/tkMacOSXKeyEvent.c: - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXWindowEvent.c: - - * macosx/tkMacOSXButton.c: conditionalize all debug message printing to - * macosx/tkMacOSXCursor.c: stderr via TK_MAC_DEBUG define. - * macosx/tkMacOSXDebug.c: - * macosx/tkMacOSXDebug.h: - * macosx/tkMacOSXDialog.c: - * macosx/tkMacOSXEvent.c: - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXKeyEvent.c: - * macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXScale.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.c: - - * unix/configure.in: define TK_MAC_DEBUG on aqua when symbols enabled. - * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in: autoheader-2.59 - - * library/listbox.tcl: synced aqua MouseWheel bindings with - * library/scrlbar.tcl: core-8-4-branch. - * library/text.tcl: - - * xlib/xcolors.c: fixed warning - -2005-08-25 Daniel Steffen <das@users.sourceforge.net> - - * unix/Makefile.in (html): reverted/amended changes of 2005-08-23 that - broke TkAqua 'make install'; added BUILD_HTML_FLAGS optional var like - in tcl/unix/Makefile.in. - -2005-08-24 Donal K. Fellows <dkf@users.sf.net> - - * tests/text.test (text-8.18): Fix punctuation of error message to - match good practice (actual message already fixed). [Bug 1267484] - -2005-08-23 Jeff Hobbs <jeffh@ActiveState.com> - - * macosx/tkMacOSXDialog.c: make dialogs ignore -initialfile "" and - -initialdir "" instead of error. - -2005-08-23 Mo DeJong <mdejong@users.sourceforge.net> - - * win/tkWin32Dll.c (DllMain): Replace old asm SEH approach with Kenny's - new SEH implementation. [Tcl Bug 1235544] - -2005-08-23 Mo DeJong <mdejong@users.sourceforge.net> - - * unix/Makefile.in: Subst BUILD_TCLSH and TCL_EXE. - * unix/configure: Regen. - * unix/configure.in: Update minimum autoconf version to 2.59. Invoke - SC_PROG_TCLSH and SC_BUILD_TCLSH. - * unix/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): - * win/Makefile.in: Subst BUILD_TCLSH and TCL_EXE. - * win/configure: Regen. - * win/configure.in: Update minimum autoconf version to 2.59. Invoke - SC_BUILD_TCLSH. - * win/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): Split confused search - for tclsh on PATH and build and install locations into two macros. - SC_PROG_TCLSH searches just the PATH. SC_BUILD_TCLSH determines the - name of the tclsh executable in the Tcl build directory. [Tcl Bug - 1160114] [Tcl Patch 1244153] - -2005-08-22 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXButton.c: - * macosx/tkMacOSXDialog.c: fix warnings. - -2005-08-20 Joe Mistachkin <joe@mistachkin.com> - - * win/tkWinX.c: Fixed bad cast. [Bug 1216006] - -2005-08-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * doc/GetFont.3: Reworded to reflect the truth. [Bug 1151523] - -2005-08-16 George Peter Staplin <GeorgePS@XMission.com> - - * doc/CrtItemType.3 prototypes were lacking [] after objv. Thus the man - page was wrong about the actual prototypes. This was verified by - studying tkCanvBmap.c. - -2005-08-13 Chengye Mao <chengye.geo@yahoo.com> - - * generic/tkOldConfig.c: Fixed [Bug 1258604]. This bug was introduced - into the modfied Tk_ConfigureWidget. It failed to properly handle the - specFlags' bit TK_CONFIG_OPTION_SPECIFIED. - -2005-08-12 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * generic/tkOldConfig.c (Tk_ConfigureWidget): Stop storing per-thread - data in global data structures. Store it in per-interpreter data (i.e. - per-thread data) instead. [Bug 749908] - -2005-08-10 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkFrame.c (CreateFrame) and others: Don't use size_t when - working with Tcl_GetStringFromObj because it is not 64-bit clean. [Bug - 1252702] - -2005-08-04 Vince Darley <vincentdarley@users.sourceforge.net> - - * doc/text.n: Clarify behaviour of tab stops (as per [Bug 1247835]) - -2005-08-09 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXCarbonEvents.c (AppEventHandlerProc): handle carbon - events sent directly to application event target via the general - TkMacOSXProcessEvent() in the same way as events posted to the event - loop. Moved existing app event handlers to tkMacOSXWindowEvent.c. - (TkMacOSXInitCarbonEvents): register our application event handler for - kEventWindowExpanded events to deal with uncollapsing from the dock. - - * macosx/tkMacOSXEvent.h: made TkMacOSXProcessEvent() non-static, added - * macosx/tkMacOSXEvent.c: new interp field to TkMacOSXEvent struct for - use by app event handler. - - * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): retrieve - current window, partCode, modifiers and local cursor position from - carbon mouse event if possible. Use new static GenerateButtonEvent() - taking a MouseEventData struct instead of TkGenerateButtonEvent() to - avoid recomputing already known values. Move process activation on - MouseDown into BringWindowForward() to allow clicking on window - titlebar widgets without activating process. Move code dealing with - clicks in window titelbar into separate function - HandleWindowTitlebarMouseDown() to avoid code duplication. Avoid - repeated calls to TkMacOSXGetXWindow() by storing result in - MouseEventData struct. - (TkMacOSXButtonKeyState, XQueryPointer): try to get button and modifier - state from currently processed carbon event (to avoid unnecessary IPC - with the window server), otherwise use modern carbon API to get this - info instead of Button() and GetKeys(); only retrieve info caller asks - for (via non-NULL ptr passed to XQueryPointer). - (ButtonModifiers2State): new static function converting carbon button - and modifier state into tk state, allows detection of more than 3 mouse - buttons (tk supports up to 5) and of NumLock and Fn modifier keys - (NumLock is mapped to Mod3 and Fn to Mod4). - - * macosx/tkMacOSXWindowEvent.c (TkMacOSXProcessApplicationEvent): - handle kEventWindowExpanded event to deal with window uncollapsing from - the dock by generating tk Map event, handle kEventAppHidden and - kEventAppShown events (moved here from tkMacOSXCarbonEvents.c). - - * macosx/tkMacOSXSubwindows.c (XUnmapWindow): only hide window when it - is not iconified to avoid window flashing on collapse. - - * macosx/tkMacOSXWm.c: replaced Tk_DoWhenIdle() by Tcl_DoWhenIdle(). - (TkMacOSXZoomToplevel): remove call to TrackBox(), now done in - HandleWindowTitlebarMouseDown() in tkMacOSXMouseEvent.c. - (TkpWmSetState): avoid window flashing on collapse by unmapping after - calling CollapseWindow(); only uncollapse window if it is collapsed. - - * generic/tkInt.decls: changed TkMacOSXZoomToplevel() signature. - * generic/tkIntPlatDecls.h: - - * macosx/tkMacOSXKeyEvent.c (TkMacOSXProcessKeyboardEvent): only call - GetMenuItemCommandID() on KeyDown or KeyRepeat events. - - * macosx/tkMacOSXMenu.c (ReconfigureMacintoshMenu): remove call to - obsolete AppendResMenu() API. - - * macosx/tkMacOSXKeyEvent.c: replaced all direct uses of expensive - * macosx/tkMacOSXMenu.c: GetMouse() and TkMacOSXButtonKeyState() - * macosx/tkMacOSXMenus.c: APIs by calls to XQueryPointer() - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXScale.c: - * macosx/tkMacOSXScrlbr.c: - * macosx/tkMacOSXWm.c: - - * macosx/tkMacOSXDialog.c: replaced use of FrontNonFloatingWindow() - * macosx/tkMacOSXKeyEvent.c: by ActiveNonFloatingWindow() as - * macosx/tkMacOSXMenu.c: recommended by Carbon docs. - * macosx/tkMacOSXMenus.c: - * macosx/tkMacOSXSubwindows.c: - * macosx/tkMacOSXWm.c: - - * macosx/tkMacOSXDialog.c: fixed warnings - * macosx/tkMacOSXTest.c: - - * macosx/tkMacOSXCarbonEvents.c: added CVS Id line to file header. - * macosx/tkMacOSXDebug.c: - * macosx/tkMacOSXDebug.h: - * macosx/tkMacOSXEntry.c: - * macosx/tkMacOSXEvent.h: - * macosx/tkMacOSXKeyEvent.c: - * macosx/tkMacOSXMouseEvent.c: - * macosx/tkMacOSXWindowEvent.c: - * macosx/tkMacOSXWm.h: - - * macosx/tkMacOSXInt.h: declare macosx internal procs as MODULE_SCOPE. - * macosx/tkMacOSXCarbonEvents.c: - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXFont.c: - * macosx/tkMacOSXHLEvents.c: - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXWindowEvent.c - - * library/bgerror.tcl: sync with core-8-4-branch changes of 2005-07-28. - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXMouseEvent.c: - - * generic/tkFrame.c: sync with core-8-4-branch changes of 2005-07-27. - * generic/tkIntDecls.h: - * generic/tkStubInit.c: - * generic/tkFrame.c: - * win/tkWinDraw.c: - * unix/tkUnixDraw.c: - * macosx/tkMacOSXDraw.c: - * macosx/tkMacOSXInt.h: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXSubwindows.c: - - * macosx/tkMacOSXButton.c: sync with core-8-4-branch. - * macosx/tkMacOSXEntry.c: - * macosx/tkMacOSXScale.c: - - * library/demos/menu.tcl: removed errant '}'. - -2005-08-04 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * doc/clipboard.n: Add example demonstrating custom types of clipboard - data. - -2005-07-25 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * library/*.tcl: Updated to use more 8.4 and 8.5 features as part of - resolving [Patch 1237759]. - -2005-07-22 Mo DeJong <mdejong@users.sourceforge.net> - - * win/tkWinX.c: Define _WIN32_WINNT with NT SP 3 data to fix compiler - error because SendInput was not defined. The new msys_mingw7 release is - now needed to compile the HEAD with mingw gcc. [Bug 1210712] - -2005-07-21 Jeff Hobbs <jeffh@ActiveState.com> - - * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): corrected if - expression error (use of = instead of ==). - -2005-07-18 Vince Darley <vincentdarley@users.sourceforge.net> - - * generic/tkTextMark.c: fix to segfault in "mark prev" - * tests/textIndex.test: [Bug 1240221] - - * tests/textWind.test: make test more robust to avoid infinite loop - -2005-07-06 Jeff Hobbs <jeffh@ActiveState.com> - - * doc/getOpenFile.n: correct -multiple docs (takes boolean) - -2005-07-05 Don Porter <dgp@users.sourceforge.net> - - * unix/Makefile.in: Purged use of TCLTESTARGS. [RFE 1161550] - -2005-06-23 Daniel Steffen <das@users.sourceforge.net> - - * generic/tkConsole.c (TkConsolePrint): prevent potential NULL deref. - - * macosx/tkMacOSXDefault.h: change ENTRY_BORDER defaults to from 5 to 2 - to make default entry widgets in TkAqua look like in other aqua apps - (and have same border dimensions as other platforms). [Bug 1176610] - -2005-06-21 Donal K. Fellows <dkf@users.sf.net> - - * doc/GetBitmap.3: Fix silly error in SYNOPSIS. [Bug 1224983] - -2005-06-19 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkImgGIF.c: Cleanse all static (i.e. non-thread-safe) data - at a miniscule performance hit. - -2005-06-18 Daniel Steffen <das@users.sourceforge.net> - - * macosx/Makefile: for X11 build, add -X11 suffix to unversioned wish - symbolic link. - - * unix/tcl.m4 (Darwin): add -headerpad_max_install_names to LDFLAGS to - ensure we can always relocate binaries with install_name_tool. - - * unix/configure: autoconf-2.59 - -2005-06-07 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - Bump patchlevel to a4 to distinguish from a3 release. - -2005-06-04 Jeff Hobbs <jeffh@ActiveState.com> - - *** 8.5a3 TAGGED FOR RELEASE *** - -2005-06-02 Jim Ingham <jingham@apple.com> - - * generic/tkEvent.c (InvokeFocusHandlers): On Mac OS X the scrollwheel - events are sent to the window under the mouse, not to the focus window - - Another patch from M. Kirkham. - - * macosx/tkMacOSXScrlbr.c (ThumbActionProc, ScrollBarBindProc): Record - the first mouse down point, and compute differences from that, rather - than getting the mouse down each time through the loop. The old method - would get fooled if you moved the mouse less than a text line height in - the text widget. [Bug 1083728] - -2005-06-03 Daniel Steffen <das@users.sourceforge.net> - - * macosx/Makefile: fixed 'embedded' target. - -2005-06-02 Reinhard Max <max@suse.de> - - * unix/tkUnix.c (Tk_GetUserInactiveTime): Improvements to get it - working on Solaris, and panic if we run out of memory. - * unix/configure.in: Rework the searching for Xss, to make it work on - Solaris and provide more useful output. Use AC_HELP_STRING where - appropriate. - * unix/tcl.m4: synced from Tcl. - * unix/configure: regenerated with autoconf 2.59. - -2005-06-01 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tkWinInt.h: added private decls of Tk_GetEmbeddedMenuHWND, - Tk_GetMenuHWND, TkWinCleanupContainerList, and TkpWmGetState to that - are used across source files. - - * win/tkWinX.c (Tk_ResetUserInactiveTime): cast to squelch compiler - warning. - -2005-05-31 Reinhard Max <max@suse.de> - - * doc/Inactive.3 (new file): C level API documentationn for - TIP#245 (Tk_GetUserInactiveTime, Tk_ResetUserInactiveTime). - * tests/tk.test: Added tests for the TIP#245 implementation. - -2005-05-30 Jeff Hobbs <jeffh@ActiveState.com> - - * generic/tkPanedWindow.c, tests/panedwindow.test: batch of fixes to - panedwindow from Daniel South. Improved auto-size to fit internal - windows, fixed sash placement at edge of pane, fixed calculation of - stretch amount for internal windows. [Bug 1124198, 1161543, 1054117, - 1010941, 795869, 690169, 1192323] - - * generic/tkMenu.c (MenuCmd): create event handler earlier to ensure - proper destruction of menu through DestroyNotify. [Bug 1159367] - - * library/console.tcl (::tk::ConsoleInit): print out first prompt and - swallow the extra "% " that comes once from Tcl on Windows. - -2005-05-29 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXFont.c: use Tcl_Panic instead of panic. - - * unix/configure.in: added description of HAVE_XSS for autoheader. - * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in: autoheader-2.59 - - * macosx/Wish.pbproj/project.pbxproj: - * macosx/Wish.xcode/project.pbxproj: added missing FRAMEWORK defines - introduced with configure/make based build. - - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXNotify.c: fixed warnings. - - * generic/tkDecls.h: - * generic/tkIntPlatDecls.h: - * generic/tkPlatDecls.h: - * generic/tkStubInit.c: ran missing 'make genstubs' for TIP245 changes - to tk.decls - - * macosx/tkMacOSXXStubs.c (Tk_ResetUserInactiveTime): use symbolic - constant argument in call to UpdateSystemActivity(); - - * macosx/Wish.pbproj/project.pbxproj: - * macosx/Wish.xcode/project.pbxproj: - * unix/configure.in: added/corrected linking to IOKit.framework for - TIP245. - - * unix/configure.in: skip X11 configure checks when building tk_aqua. - * unix/configure: autoconf-2.59 - -2005-05-28 Donal K. Fellows <dkf@users.sf.net> - - TIP #245 IMPLEMENTATION from Reinhard Max <max@suse.de> - - * doc/tk.n: Documentation of [tk inactivity]. - * win/tkWinX.c (Tk_GetUserInactiveTime, Tk_ResetUserInactiveTime): - * unix/tkUnix.c (Tk_GetUserInactiveTime, Tk_ResetUserInactiveTime): - * macosx/tkMacOSXXStubs.c: Implementations of the core API for - (Tk_GetUserInactiveTime): determining how long as user's left - (Tk_ResetUserInactiveTime): her machine alone. - * unix/configure.in: Test for XScreenSaver support. - * generic/tkCmds.c (Tk_TkObjCmd): Implementation of [tk inactivity]. - -2005-05-27 Todd Helfter <tmh@users.sourceforge.net> - - * library/menu.tcl: correct the sticky behavior of menus posted by - tk_popup so that they "stick" after the initial <ButtonRelease> - following the post, that is not over an active menu entry. - -2005-05-26 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXInit.c (TkpInit): fixed resource file extraction from - __tk_rsrc section to work with non-prebound .dylib and .bundle. +2008-02-23 Joe English <jenglish@users.sourceforge.net> - * macosx/Makefile: corrected EMBEDDED_BUILD check, use separate Tcl and - Tk version vars to properly support tk/x11 framework version - overriding, rewrite tkConfig.sh when overriding tk version, corrected - Wish.app symlink in tk build dir. + * generic/ttk/ttkPanedWindow.c: [FRQ 1898288]: Don't enforce minimum + sash thickness of 5 pixels, just use 5 as a default. - * unix/configure.in: corrected framework finalization to softlink stub - library to Versions/8.x subdir instead of Versions/Current. - * unix/configure: autoconf-2.59 - -2005-05-25 Jeff Hobbs <jeffh@ActiveState.com> +2008-02-14 Donal K. Fellows <donal.k.fellows@man.ac.uk> - * unix/Makefile.in (install-libraries): protect possible empty list in - for with list= trick for older shells. + * unix/README: Documented missing configure flags. -2005-05-23 Jeff Hobbs <jeffh@ActiveState.com> +2008-02-06 Donal K. Fellows <donal.k.fellows@man.ac.uk> - * generic/tkFileFilter.c (FreeGlobPatterns): s/null/NULL/ + * doc/ttk_scale.n (new file): [Bug 1881925]: Added basic documentation -2005-05-24 Daniel Steffen <das@users.sourceforge.net> +2008-02-04 Don Porter <dgp@users.sourceforge.net> - * generic/tkTest.c: disable commands not available on TkAqua. + *** 8.5.1 TAGGED FOR RELEASE *** - * macosx/Makefile: - * macosx/README: - * macosx/Tk-Info.plist.in (new file): - * macosx/Wish-Info.plist.in (new file): - * unix/Makefile.in: + * generic/tk.h: Bump to 8.5.1 for release. + * library/tk.tcl: * unix/configure.in: - * unix/tcl.m4: - * unix/tkUnixInit.c: moved all Darwin framework and TkAqua build - support from macosx/Wish.pbproj and macosx/Makefile into the standard - unix configure/make buildsystem, the project and macosx/Makefile are no - longer required to build Tk.framework and/or TkAqua. TkAqua is now - enabled by the --enable-aqua configure option, and static and - non-framework builds of TkAqua are now available via the standard - configure switches. Tk/X11 can also be built as a framework. The - macosx/Makefile now wraps the unix buildsystem and no longer uses the - projects, embedded builds are still only available via this Makefile, - but for other builds it is not longer required (but its current - functionality is still available for backwards compatibility). The - projects currently do not call through to the Makefile to build (unlike - Tcl.pbproj) so project builds may differ from makefile builds. Due to - issues with spaces in pathnames, 'Wish Shell.app' has been renamed to - 'Wish.app', the macosx/Makefile installs backwards compatibility - symlinks for the old name. - * macosx/tkMacOSXInit.c (TkpInit): added support for Tk resource file - in non-framework and static builds: the resource file is copied into a - __tk_rsrc MachO section of the library or executable at link time and - extracted into a temporary location at initialization. - * unix/configure: autoconf-2.59 - * unix/tkConfig.h.in (new file): autoheader-2.59 - - * macosx/Wish.pbproj/project.pbxproj: - * macosx/Tk-Info.plist: - * macosx/Wish-Info.plist: - * macosx/tkAboutDlg.r: updated copyright years to 2005. - -2005-05-22 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkFileFilter.c (TkGetFileFilters): Add all filters, not just - the first one. [Bug 1206133] - -2005-05-15 Jim Ingham <jingham@apple.com> - - Fixes from Michael Kirkham: - - * macosx/tkMacOSXMenu.c (TkpConfigureMenuEntry): Thinko in clearing the - ENTRY_ACCEL_MASK before re-parsing it. [Bug 1012852] - - * macosx/tkMacOSXScrlbr.c (UpdateControlValues): Don't set the control - value BEFORE setting the min and max or the control manager will reset - it for you. [Bug 1202181] - - * macosx/tkMacOSXXStubs.c (TkMacOSXXGetPixel, TkMacOSXXPutPixel): - Restore the port to what it was before putting we were called. [Bug - 1202223] - -2005-05-14 Jim Ingham <jingham@apple.com> - - * macosx/tkMacOSXScrlbr.c (ThumbActionProc): Missing Tcl_Release. - -2005-05-14 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXNotify.c: introduction of new tcl notifier based on - CFRunLoop allows replacement of the custom TkAqua notifier by a - standard tcl event source. Removes requirement of threaded tcl core - for TkAqua, allows to stub-link TkAqua against Tcl by removing use of - the unstubbed TclInitNotifier & TclFinalizeNotifier. [Tcl Patch - 1202052] - - * macosx/Wish.xcode/project.pbxproj: - * macosx/Wish.pbproj/project.pbxproj: stub-link TkAqua: build with - USE_TCL_STUBS and link against libtclstub instead of Tcl.framework, - unexport libtclstub symbols from Tk to avoid duplicate symbol warnings - when linking with both Tcl and Tk, fixes for gcc4.0 warnings. - - * macosx/Wish.xcode/project.pbxproj: sync with Wish.pbproj changes - since 2004-11-19. - NOTE: to use this project, need to uncomment the tclConfig.h settings - at the top of tcl/unix/configure.in, autoconf and rebuild tcl ! - - * macosx/tkMacOSXBitmap.c: - * macosx/tkMacOSXButton.c: - * macosx/tkMacOSXDialog.c: - * macosx/tkMacOSXFont.c: - * macosx/tkMacOSXHLEvents.c: - * macosx/tkMacOSXInit.c: - * macosx/tkMacOSXKeyboard.c: - * macosx/tkMacOSXMenu.c: - * macosx/tkMacOSXMenubutton.c: - * macosx/tkMacOSXWm.c: - * macosx/tkMacOSXXStubs.c: fixed gcc 4.0 warnings. - - * unix/tcl.m4: sync with tcl - * unix/configure: autoconf-2.59 - -2005-05-10 Vince Darley <vincentdarley@users.sourceforge.net> - - * library/text.tcl: test and fix to TextPrevPara to avoid infinite loop - * tests/textIndex.test: at start of widget. [Bug 1191895] - - * generic/tkTextDisp.c: better synchronisation between explicit and - implicit pixel line-height calculations. [Bug 1186558] - -2005-05-10 Don Porter <dgp@users.sourceforge.net> - - * generic/tkTextDisp.c (GetXView): Improved numerical precision of - calculation of [.t xview] return values. - * tests/textDisp.test: Match greater precisions of [.t xview] and - [.t yview] values in tests. - -2005-05-06 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/configure: regen - * unix/configure.in: Add AC_C_BIGENDIAN check and pkg-config xft checks - to extend xft search. - * unix/tcl.m4: Correct Solaris 10 (5.10) check and add support for - x86_64 Solaris cc builds. - -2005-04-28 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * macosx/tkMacOSXNotify.c (TkMacOSXWaitForEvent): Fix for typo in - waitTime computation. [Bug 1191097] - (AlertNotifier): Factor out the core of the notifier alerting code. - -2005-04-25 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXNotify.c: sync with tclUnixNotfy.c changes since - 2004-06-22, added compile time check for threaded tcl core, removed - unthreaded code paths as they are never used anyway, fixed - TkMacOSXAlertNotifier() implementation. - - * unix/Makefile.in: added TCL_STUB_LIB_FILE, needed for unexporting of - symbols from libtclstub to avoid duplicate symbol warnings. - - * unix/tcl.m4 (Darwin): added configure checks for recently added - linker flags -single_module and -search_paths_first to allow building - with older tools (and on Mac OS X 10.1), use -single_module in SHLIB_LD - and not just T{CL,K}_SHLIB_LD_EXTRAS, added unexporting from Tk of - symbols from libtclstub to avoid duplicate symbol warnings, added - PLAT_SRCS definition for Mac OS X, defined MODULE_SCOPE to - __private_extern__. - (SC_MISSING_POSIX_HEADERS): added caching of dirent.h check. - - * unix/configure: autoconf-2.59 - -2005-04-22 George Peter Staplin <GeorgePS@XMission.com> - - * doc/FontId.3: I fixed a typo. "linespace" was used instead of - "ascent". I also added a .PP before the paragraph to make the - formatting look better for the ascent paragraph. - -2003-04-18 Joe English <jenglish@users.sourceforge.net> - - * unix/tkUnixRFont.c(Tk_MeasureChars): Use Tcl_UtfToUnichar() for lax - UTF-8 parsing instead of strict parsing with FcUtf8ToUcs4() - [fix/workaround for Bug 1185640] - -2003-04-18 Vince Darley <vincentdarley@users.sourceforge.net> - - * library/text.tcl - * doc/text.n: corrected 'Home' and 'End' and Control-a/e handling to - work with display lines. This was an ommission of the previous tip155 - patch. Clarified the documentation on this point. - -2005-04-14 Jeff Hobbs <jeffh@ActiveState.com> - - * unix/tkUnixFont.c (FontMapLoadPage): reorder char[] decls to avoid - possible segv. Minimal fix for [Bug 1122671] - -2005-04-12 Jeff Hobbs <jeffh@ActiveState.com> - - * library/tkfbox.tcl (::tk::dialog::file::): fix typeMenuLab ref. Add - undoc'd ::tk::dialog::file::showHiddenBtn var (default 0) that will add - a "Show Hidden" checkbutton to tk_get*File and tk_chooseDirectory if - set to true. - * library/choosedir.tcl (::tk::dialog::file::chooseDir::): fix - cancelBtn ref, add hiddenBtn ref for "Show Hidden" button. - -2005-04-09 Daniel Steffen <das@users.sourceforge.net> - - * macosx/README: updated requirements for OS & developer tool versions - + other small fixes/cleanup. - - * macosx/tkMacOSXEntry.c (ComputeIncDecParameters): manually define - constants present only in 10.3 headers so that we can build on 10.2. - - * macosx/Wish.pbproj/project.pbxproj: fixed absolute path to tkEntry.h - that confused 10.2 PBX. - - * unix/tcl.m4 (Darwin): added -single_module linker flag to - TCL_SHLIB_LD_EXTRAS and TK_SHLIB_LD_EXTRAS. - * unix/configure: autoconf-2.59 - -2005-04-07 Mo DeJong <mdejong@users.sourceforge.net> - - * macosx/tkMacOSXWm.c (TkWmStackorderToplevelWrapperMap, - (TkWmStackorderToplevel): - * unix/tkUnixWm.c (TkWmStackorderToplevelWrapperMap, - (TkWmStackorderToplevel): - * win/tkWinWm.c (TkWmStackorderToplevelWrapperMap, - (TkWmStackorderToplevel): - Fix panic in wm stackorder when a toplevel is created on another - display. The code now ignores toplevels that have a display that does - not match the display of the parent window. [Bug 1152809] - -2005-04-06 Donal K. Fellows <dkf@users.sf.net> - - * doc/wm.n, doc/winfo.n, doc/tk.n, doc/send.n, doc/selection.n: - * doc/radiobutton.n, doc/photo.n, doc/options.n, doc/menu.n: - * doc/listbox.n, doc/getOpenFile.n, doc/font.n, doc/event.n: - * doc/entry.n, doc/clipboard.n, doc/checkbutton.n, doc/canvas.n: - * doc/button.n, doc/bind.n, doc/TextLayout.3, doc/MeasureChar.3: - * doc/GetRelief.3, doc/GetPixels.3, doc/GetJustify.3, doc/GetFont.3: - * doc/GetCursor.3, doc/GetColor.3, doc/GetBitmap.3, doc/GetAnchor.3: - * doc/FontId.3, doc/CrtWindow.3, doc/CrtImgType.3, doc/ConfigWidg.3: - * doc/3DBorder.3: Purge old .VS/.VE macro instances. - -2005-04-04 Don Porter <dgp@users.sourceforge.net> - - * library/comdlg.tcl: Added Macintosh file type validation to - [::tk::FDGetFileTypes]. [Bug 1083878] (Thanks, Vince Darley) - -2005-04-04 Vince Darley <vincentdarley@users.sourceforge.net> - - * generic/tkText.c: - * tests/text.test: fix to elide searching problems [Bug 1174269] and - disappearing cursor with insertofftime 0. [Bug 1169429] - -2005-04-03 Peter Spjuth <peter.spjuth@space.se> - - * tests/grid.test: - * generic/tkGrid.c: Fixed bug in geometry calculations for widgets that - span multiple columns/row. Bug was introduced in 8.5a1 when fixing - 792387. [Bug 1175092] - -2005-03-29 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tcl.m4, win/configure: do not require cygpath in macros to allow - msys alone as an alternative. - -2005-03-27 Vince Darley <vincentdarley@users.sourceforge.net> - - * tests/textDisp.test: added test for fix of 2005-03-15. - -2005-03-24 Jim Ingham <jingham@apple.com> - - * macosx/tkMacOSXEntry.c (TkpDrawEntryBorderAndFocus): Dopey bug - do - not reset the width for entry widgets - we didn't change it for them. - -2005-03-23 Jim Ingham <jingham@apple.com> - - These changes allow us to draw the Entry and Spinbox widget with a - native look and feel on Mac OS X. - - * generic/tkEntry.h: New file, extracting the definitions of Entry and - Spinbox. - * generic/tkEntry.c (DisplayEntry): Call out to TkpDrawSpinboxButtons - and TkpDrawEntryBorderAndFocus. Also provide default implementations - for X11 & Win. - * macosx/tkMacOSXEntry.c: New file, implements the entry & focus and - spinbox button drawing. - * tkMacOSXDefaults.h: Change the Mac OS X defaults so they fit the - native widget shapes. - - This is cleanup thanks to Neil Madden <nem@cs.nott.ac.uk>. - - * macosx/tkMacOSXWm.c (TkMacOSXWinStyle) New function. - (TkUnsupported1ObjCmd): New function, replaces the un-objectified - version of the command. - * generic/tkInt.h: Swap TkUnsupported1Cmd for TkUnsupported1ObjCmd. - * generic/tkWindow.c (): Ditto. - - This adds a "-notify" flag to "wm attributes" that will bounce the - dock icon on Mac OS X. This is from Revar Desmera <revarbat@gmail.com> - - * macosx/tkMacOSXWm.c (WmAttrGetNotifyStatus, WmAttrSetNotifyStatus): - New functions. - (WmAttributesCmd): Add the -notify. - * doc/wm.n: Document -notify. - -2005-03-19 Donal K. Fellows <dkf@users.sf.net> - - * generic/tkConsole.c (Tk_CreateConsoleWindow,TkConsolePrint): Rewrite - so that TkConsolePrint cannot become detached from the console when the - [console] command is renamed. [Bug 1016385] - -2005-03-15 Vince Darley <vincentdarley@users.sourceforge.net> - - * generic/tkTextDisp.c: fix for [Bug 1143776] in adjusting displayed - lines when running into the bottom of the window. - -2005-03-14 Jim Ingham <jingham@apple.com> - - * macosx/tkMacOSXScrlbr.c (ThumbActionProc): No need to use "update - idletasks" here, TclServiceIdle will do as well and it is simpler. - - These changes implement a change on the Mac OS X side. When we unmap a - window we mark all its children as unmapped (not following toplevels. - But we preserve whether they had been mapped before, and when the - parent is remapped, we remap the children as well. [Bug 940117] - - * macosx/tkMacOSXInt.h: Added TK_MAPPED_IN_PARENT - * macosx/tkMacOSXSubwindows.c (FixMappingFlags): New function. - (XMapWindow): Call FixMappingFlags. - (XUnMapWindow): Ditto. - - * macosx/tkMacOSXSubwindows.c (XMoveResizeWindow): Update the xOff & - yOff data in the Macdrawable even if the native window hasn't been - created yet. [Bug 700305] - (XMoveWindow): Ditto. - (XResizeWindow): Ditto. - -2005-03-15 Pat Thoyts <patthoyts@users.sourceforge.net> - - * unix/tcl.m4: Updated the OpenBSD configuration and regenerated the - * unix/configure: configure script. - -2005-03-14 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> - - * generic/tkEvent.c (InvokeClientMessageHandlers): Ensure that client - messages are handled correctly. Thanks to George Petasis for tracking - this down. [Bug 1162356] - -2005-03-11 Jim Ingham <jingham@apple.com> - - * macosx/tkMacOSXButton.c (TkpDisplayButton): Set the port to the - Button window's port BEFORE you set the clip, otherwise you are setting - the clip on the wrong window! - Also, a little cleanup - move x & y into the branches where they are - used, and don't compute the TextAnchor if we are using the native - button text, since we aren't going to use it. - (TkMacOSXDrawControl): Call ShowControl & SetControlVisibility in a - more logical order. - - * tkMacOSXInt.h: Add TkMacOSXGenerateFocusEvent. - * tkMacOSXSubwindows.c (XDestroyWindow): We don't get Activate events - for the remaining windows when a Floating window is destroyed. This can - cause the focus to disappear. So catch this case when the window is - being destroyed and move the focus here. - - * tkMacOSXWindowEvent.c (TkMacOSXGenerateFocusEvent): Make this public - (used to be GenerateFocusEvent) since we need it here and in - tkMacOSXSubwindows.c. Then change the name everywhere it is used. [Bug - 1124237] - -2005-03-10 Jim Ingham <jingham@apple.com> - - * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): In the - inDrag section, set the GrafPort to the drag window's GrafPort before - doing LocalToGlobal. [Bug 1160025] - -2005-03-09 Jim Ingham <jingham@apple.com> - - * macosx/tkMacOSXInit.c (TkpInit): Check to see if the environment - variable XCNOSTDIN is set, and if so, close stdin & stdout. This is - necessary to make remote debugging under Xcode work properly. - -2005-03-08 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tkWinWm.c (WinSetIcon): fix GCLP_ICONSM -> GCLP_HICONSM. - - * win/makefile.vc: clarify necessary defined vars that can come from - MSVC or the Platform SDK. - -2005-02-28 Jeff Hobbs <jeffh@ActiveState.com> - - * win/tkWinX.c (GenerateXEvent): correct %A translation on MouseWheel. - [Bug 1118340] - -2005-02-24 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSX.h: fixed incorrect inclusion of internal header. - * macosx/tkMacOSXNotify.c: corrected included headers. - -2005-02-22 Daniel Steffen <das@users.sourceforge.net> - - * macosx/tkMacOSXDialog.c (Tk_GetSaveFileObjCmd, NavServicesGetFile): - fixed encoding problems with -initialfile & -filetypes and corrected - potential buffer overrun with -initialdir/-initialfile. [Bug 1146057] - -2005-02-16 Mo DeJong <mdejong@users.sourceforge.net> - - TIP#223 IMPLEMENTATION - - * doc/wm.n: Add documentation for -fullscreen attribute. - * tests/winWm.test: Add -fullscreen to wm attribute usage message. - * tests/wm.test: Add -fullscreen to wm attribute usage message. Add - -fullscreen attribute test cases for Windows. - * win/tkWinWm.c (WmInfo, UpdateWrapper, TkpWmSetFullScreen) - (WmAttributesCmd, UpdateGeometryInfo): - Implement TIP 223 [wm attributes -fullscreen]. - -2005-02-14 Vince Darley <vincentdarley@users.sourceforge.net> - - * generic/tkText.c: - * generic/tkText.h: - * generic/tkTextDisp.c: - * generic/tkTextIndex.c: - * generic/tkTextBTree.c: - * doc/text.n: - * tests/textDisp.test: - * tests/textIndex.test: fix of longstanding elide problem when eliding - a newline without eliding the entire logical line. [Bug 443848] - -2005-02-14 Jeff Hobbs <jeffh@ActiveState.com> - - * doc/options.n: note -cursor {} behavior. [Bug 965618] - -2005-02-14 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * unix/tk.spec: + * win/configure.in: - * tests/all.tcl: Add a [package require Tk] so that a missing display - causes an early failure and keeps the error trace short. Issue observed - in [FRQ 11122147], even though that's unrelated. + * unix/configure: autoconf-2.59 + * win/configure: -2005-02-11 Jeff Hobbs <jeffh@ActiveState.com> +2008-02-04 Donal K. Fellows <donal.k.fellows@man.ac.uk> - * library/panedwindow.tcl (::tk::panedwindow::Cursor): check window - existence on delayed call. [Bug 949792] + * doc/MeasureChar.3, doc/FontId.3: Minor improvements (formatting, + keywords). - * doc/text.n: note 'image' key in 'dump' command. [Bug 1115907] +2008-02-02 Daniel Steffen <das@users.sourceforge.net> - * win/tkWinWm.c (TkWinGetIcon): fix toplevel retrieval for determining - icon ref (potential crash). [Bug 1105738] + * macosx/Wish-Info.plist.in: Add CFBundleLocalizations key, listing + * unix/configure.in (Darwin): all library/msgs locales. - * generic/tkCanvBmap.c (ConfigureBitmap, ComputeBitmapBbox): Fixed - possible crash with disabled bmap and bbox handling [Bug 1119460] - (BitmapToPostscript): made aware of various bitmap types + * unix/configure.in (Darwin): Correct Info.plist year substitution + in non-framework builds. - * unix/Makefile.in: remove SHLIB_LD_FLAGS (only for AIX, inlined into - * unix/tcl.m4: SHLIB_LD). Combine AIX-* and AIX-5 branches in - * unix/configure: SC_CONFIG_CFLAGS. Correct gcc builds for AIX-4+ and - HP-UX-11. autoconf-2.59 gen'd. + * unix/configure: autoconf-2.59 -2005-02-09 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-02-01 Don Porter <dgp@users.sourceforge.net> - * tests/wm.test: Convert to use more tcltest2 features. + * changes: Updates for 8.5.1 release. -2005-02-07 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-02-01 Reinhard Max <max@suse.de> - * generic/tkCanvas.c (CanvasWidgetCmd): Fix stupid mistake in variable - names, reported by Andreas Leitgeb. + * generic/tkImgGIF.c: Fixed a buffer overflow (CVE-2008-0553). + * tests/imgPhoto.test: Added a test for the above. -2005-02-03 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> +2008-01-31 Jeff Hobbs <jeffh@ActiveState.com> - * generic/tkCanvas.c (GetStaticUids): New function to manage the - thread-specific data detailing the list of all uids in a thread. - (typeList): Protect this (the other piece of global data) with a mutex. - [Bug 1114977] + * library/msgbox.tcl (::tk::MessageBox): Don't use ttk::label in low + depth/aqua fallback, as it doesn't support -bitmap. -2005-01-31 Jeff Hobbs <jeffh@ActiveState.com> + * win/tkWinDialog.c (Tk_MessageBoxObjCmd): [Bug 1881892]: Pass "" + instead of NULL when -title isn't set. - * unix/tcl.m4, unix/configure: add solaris-64 gcc build support. [Bug - 1021871] +2008-01-31 Donal K. Fellows <donal.k.fellows@man.ac.uk> -2005-01-31 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + * doc/panedwindow.n: Added proper description of -height and -width + options, which aren't "standard". Last of fallout from [Bug 1882495]. - * generic/tkImgPhoto.c (PhotoFormatThreadExitProc): Made the comments - in the code more relevant to the function they were documenting! [Bug - 1110553] +2008-01-30 Donal K. Fellows <donal.k.fellows@man.ac.uk> - * library/msgs/es_ES.msg: Added more localization for Spanish Spanish. - [Bug 1111213] + * doc/canvas.n, doc/listbox.n, doc/message.n: [Bug 1882495]: Fix + erroneous listing of "standard" options. -2005-01-25 Daniel Steffen <das@users.sourceforge.net> +2008-01-29 Joe English <jenglish@users.sourceforge.net> - * macosx/tkMacOSXInit.c (TkpInit): set tcl_interactive to 1 to show - console at startup instead of directly calling [console show]. + * library/treeview.tcl: Fix bug in Shift-ButtonPress-1 binding (error + if no current focus item; reported on c.l.t.) - * unix/tcl.m4 (Darwin): fixed bug with static build linking to dynamic - library in /usr/lib etc instead of linking to static library earlier in - search path. [Tcl Bug 956908] - Removed obsolete references to Rhapsody. - * unix/configure: autoconf-2.57 +2008-01-29 Donal K. Fellows <donal.k.fellows@man.ac.uk> -2005-01-18 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * doc/ttk_*.n: [Bug 1876493]: Adjusted handling of the standard + options part of the Ttk manual pages so that they are documented in + the correct location. - * library/demos/menu.tcl: Reworked to make dialogs children of the - demo widget so that they are properly visible. Issue reported by Keith - Nash <k.j.nash@usa.net> +2008-01-28 Joe English <jenglish@users.sourceforge.net> -2005-01-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * unix/tkUnixRFont.c: Re-fix strict-aliasing warnings reintroduced by + last patch. - * library/tkfbox.tcl (IconList_Selection, IconList_Create): - (IconList_Arrange): Assorted tk_getOpenFile fixes. [part of Bug 600313] - (IconList_ShiftMotion1): Also fix shift-drag. +2008-01-27 Joe English <jenglish@users.sourceforge.net> -2005-01-12 Don Porter <dgp@users.sourceforge.net> + * generic/ttk/ttkNotebook.c: [Bug 1878298]: Make sure to schedule a + redisplay when adding and/or hiding tabs. - * unix/tcl.m4: Sync'ed to Tcl's copy. - * unix/configure: autoconf-2.57 +2008-01-27 Joe English <jenglish@users.sourceforge.net> -2005-01-12 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * unix/tkUnixRFont.c: Merged common code from InitFont() and + TkpGetFontAttrsForChar(), factored into GetTkFontAttributes() and + GetTkFontMetrics(). Removed write-only struct UnixFtFont member + 'drawable'. Removed unneeded double-pointer indirections. Ensure that + TkFontAttributes.family member is a Tk_Uid, as specified. Use + FcTypeDouble for XFT_SIZE attribute. Finally: fix [Bug 1835848] - * doc/event.n: Added section on predefined virtual events. [Bug 608115] +2008-01-25 Don Porter <dgp@users.sourceforge.net> -2005-01-11 Vince Darley <vincentdarley@users.sourceforge.net> + * changes: Updates for 8.5.1 release. - * generic/tkTextDisp.c: fix to scrollbar height calculations of text - widgets containing a single very long (wrapped) line. This fixes at - least part of [Bug 1093631]. +2008-01-08 Joe English <jenglish@users.sourceforge.net> -2005-01-11 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * generic/ttk/ttkFrame.c: [Bug 1867122]: fix crash in + [ttk::labelframe] when -style option specified. - * generic/tkObj.c (TkParsePadAmount): - * generic/tkPack.c: Moved function to tkObj.c and rewrote so that it - takes advantage of Tcl_Objs properly and cannot leave objects in an - inconsistent state. [Bug 1098779] +2008-01-08 Joe English <jenglish@users.sourceforge.net> -2005-01-10 Joe English <jenglish@users.sourceforge.net> + * win/ttkWinTheme.c: [Bug 1865898]: Add tristate support to + checkbuttons and radiobuttons. + [Bug 1679067]: Fix check and radio indicator size. - * unix/Makefile.in, unix/configure.in, unix/tkConfig.sh.in: - Remove ${DBGX}, ${TK_DBGX} from Tk build system. [Patch 1081595] - * unix/tcl.m4: re-synced with tcl/unix/tcl.m4 - * unix/configure: Regenerated. +2008-01-06 Joe English <jenglish@users.sourceforge.net> -2005-01-07 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * generic/ttk/ttkWidget.c, generic/ttk/ttkWidget.h: Call + Tk_MakeWindowExist() in widget constructor. Removed now-unnecessary + initial ConfigureNotify processing. - * generic/tkWindow.c (GetScreen): Make sure the result is reset on all - error paths to stop strange errors. [Bug 697915] +2008-01-06 Joe English <jenglish@users.sourceforge.net> -2005-01-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> + * library/ttk/treeview.tcl, library/ttk/utils.tcl: + [Bugs 1442006, 1821939, 1862692]: Fix MouseWheel bindings for + ttk::treeview widget. - * doc/loadTk.n, doc/toplevel.n: Convert to other form of emacs mode - control comment to prevent problems with old versions of man. [Bug - 1085127] +2008-01-02 Don Porter <dgp@users.sourceforge.net> -2005-01-03 Jeff Hobbs <jeffh@ActiveState.com> + * generic/tk.h: Bump version number to 8.5.1b1 to distinguish + * library/tk.tcl: CVS development snapshots from the 8.5.0 and + * unix/configure.in: 8.5.1 releases. + * unix/tk.spec: + * win/configure.in: - * win/tkWinWm.c (TkWinWmCleanup): clean up layered window class. This - caused crash in reinit of Tk (as seen in plugin). + * unix/configure: autoconf (2.59) + * win/configure: ****************************************************************** + *** CHANGELOG ENTRIES FOR 2005 TO 2007 IN "ChangeLog.2007" *** *** CHANGELOG ENTRIES FOR 2004 AND 2003 IN "ChangeLog.2004" *** *** CHANGELOG ENTRIES FOR 2002 AND EARLIER IN "ChangeLog.2002" *** ****************************************************************** diff --git a/ChangeLog.2007 b/ChangeLog.2007 new file mode 100644 index 0000000..8c458be --- /dev/null +++ b/ChangeLog.2007 @@ -0,0 +1,5283 @@ +2007-12-30 Donal K. Fellows <dkf@users.sf.net> + + * doc/canvas.n: Documented exact behaviour of items with respect to + when they are the current item. [Bug 1774593] Also documented the + clipping behaviour of window items. + + * library/demos/nl.msg: Corrected following testing "in the field" by + Arjen Markus. [Bug 1860802] + +2007-12-17 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + *** 8.5.0 TAGGED FOR RELEASE *** + + * doc/canvas.n: Documented -outlineoffset item option. [Bug 1836621] + +2007-12-14 Don Porter <dgp@users.sourceforge.net> + + * changes: More updates for 8.5.0 release. + +2007-12-14 Joe English <jenglish@users.sourceforge.net> + + * doc/ttk_treeview.n: Fix typo. [Bug 1850713] + +2007-12-14 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/tkWinInt.h: Add in missing function definitions + * win/tkWinButton.c: to support plain MSVC6 and use INT_PTR + * win/tkWinScrlBar.c: rather than LONG_PTR which isn'tr defined + * win/tkWinWm.c: in the msvc6 headers. + +2007-12-14 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/nmakehlp.c: Support compilation with MSVC9 for AMD64. + * win/makefile.vc: + +2007-12-13 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkMenubutton.c (ConfigureMenuButton): trace the + -textvariable even if an image exists as it may use -compound. + +2007-12-12 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkText.c (DeleteIndexRange, TextEditCmd, UpdateDirtyFlag): + * tests/text.test (text-25.10.1,25.11.[12]): + Don't require [update idle] to trigger Modified event [Bug 1809538] + Modified virtual event should only fire on state change [Bug 1799782] + Make sure we delete chars before triggering <<Modified>> [Bug 1737288] + +2007-12-12 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (ApplyMasterOverrideChanges): Revert 2007-10-26 + change to window class of transient toplevels that are not also + overrideredirect. [Bug 1845899] + + * macosx/tkMacOSXWm.c (ApplyMasterOverrideChanges): Implement more + * macosx/tkMacOSXMouseEvent.c (BringWindowForward): X11-like transient + * macosx/tkMacOSXSubwindows.c (XDestroyWindow): behaviour by + adding transient windows to a window group owned by the master window, + this ensures transients always remain in front of and are collapsed + with the master; bring master to front when selecting transient + windows; restore default window group of transients if master + destroyed. [Bug 1845899] + +2007-12-12 Joe English <jenglish@users.sourceforge.net> + + * doc/ttk_intro.n, doc/ttk_style.n, doc/ttk_widget.n: + Various minor updates. + +2007-12-12 Don Porter <dgp@users.sourceforge.net> + + * changes: Updated for 8.5.0 release. + +2007-12-11 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTheme.c (StyleElementOptionsCmd): Use + Ttk_GetElement() to find element instead of direct hash table access. + +2007-12-11 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkText.c (TextReplaceCmd): Added code to rebuild the from + index after the deletion phase so that the linePtr field is valid for + the insertion phase. [Bug 1602537] + +2007-12-10 Donal K. Fellows <dkf@users.sf.net> + + * doc/event.n: Clarify the fact that [event info] only returns the + names of virtual events that are bound to physical event sequences. + This follows on from comments on comp.lang.tcl. + http://groups.google.com/group/comp.lang.tcl/msg/935d2d226ae8a770 + +2007-12-10 Joe English <jenglish@users.sourceforge.net> + + * doc/AddOption.3, doc/CrtImgType.3, doc/CrtPhImgFmt.3, + * doc/InternAtom.3, doc/TextLayout.3, doc/chooseColor.n, + * doc/chooseDirectory.n, doc/loadTk.n, doc/palette.n, + * doc/ttk_combobox.n: Various markup fixes (mostly: missing quotes on + .SH arguments, extraneous .PPs) + + * doc/ttk_entry.n, doc/ttk_scrollbar.n, doc/ttk_treeview.n: Remove + extra .BEs that got added by mistake somewhere. + +2007-12-10 Daniel Steffen <das@users.sourceforge.net> + + * generic/tk.decls: use new genstubs 'export' command to + * generic/tkInt.decls: mark exported symbols not in stubs + table [FR 1716117]; cleanup formatting + + * generic/tkIntDecls.h: regen with new genStubs.tcl. + * generic/tkIntPlatDecls.h: [Tcl Bug 1834288] + * generic/tkIntXlibDecls.h: + * generic/tkPlatDecls.h: + * generic/tkStubInit.c: + +2007-12-10 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * tests/safe.test: Ensure list of hidden commands is correct. [Bug + 1847925] + +2007-12-10 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/tkWin.h: We must specify the lowest Windows version we intend to + support. In particular the SystemParametersInfo API doesn't like to + receive structures that are larger than it expects which affects the + font assignements. Set to Win98 support. + + * win/tkWinFont.c: Handle failure to read the system parameters. This + causes ttk/fonts.tcl to set any missing named fonts. + + * win/ttkWinMonitor.c: Only tkWin.h should include windows.h unless + * win/ttkWinTheme.c: we have an explicit override of the WINVER + * tin/ttkWinXPTheme.c: macro. + + * win/rules.vc: Handle MSVC 9 (aka: Visual Studio 2008) + + * tests/safe.test: Update for 'unload' as a safe command (tcl 8.5b3+) + +2007-12-09 Donal K. Fellows <dkf@users.sf.net> + + * win/configure.in: Adjusted code so that running configure does not + generate an error message when the full current directory name + contains a space. + + * win/tkWinWm.c: Added set of #defs to make this file build with my + version of the SDK (i.e. with the msys suite we distribute). + +2007-12-07 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/altTheme.tcl, library/ttk/classicTheme.tcl: + s/style/ttk::style/. + +2007-12-07 Don Porter <dgp@users.sourceforge.net> + + * unix/README: Mention the stub library created by `make` and warn + about the effect of embedded paths in the installed binaries. Thanks + to Larry Virden. [Tcl Bug 1794084] + +2007-12-05 Joe English <jenglish@users.sourceforge.net> + + * macosx/ttkMacOSXTheme.c: Fix TCombobox layout so as not to truncate + long text when combobox is wider than requested. [Bug 1845164] + +2007-12-05 Jeff Hobbs <jeffh@ActiveState.com> + + * library/demos/widget: reduce start size to 70% of screenheight from + sh-200 for a more reasonable size. + + * win/tkWinButton.c, win/tkWinDialog.c: use SetWindowLongPtr and + * win/tkWinScrlbr.c, win/tkWinWm.c: GetWindowLongPtr only. + * win/ttkWinMonitor.c: + + * win/tkWinInt.h: remove CS_CLASSDC (not recommended for any apps now) + * win/tkWinX.c: and simplify WNDCLASS to one style. + * win/tkWinWm.c: Reduce wrapper update for exStyle to toolwindow + change only and set WS_EX_LAYERED as sticky (once set on a window, do + not remove it) to reduce alpha transition flicker. + + * win/configure, win/tcl.m4 (LIBS_GUI): mingw needs -lole32 -loleaut32 + but not msvc for Tk's [send]. [Bug 1844749] + +2007-12-04 Joe English <jenglish@users.sourceforge.net> + + * doc/ttk_style.n: Remove nonsense about "this manpage has not yet + been written"; everything supported is documented. + +2007-12-04 Donal K. Fellows <dkf@users.sf.net> + + * library/msgs/en.msg: Added missing messages. [Patch 1800744] + + * library/msgs/da.msg: Added Danish messages. [Patch 1844143]. Many + thanks to Torsten Berg <treincke@users.sf.net>. + +2007-12-03 Jeff Hobbs <jeffh@ActiveState.com> + + * win/configure, win/tcl.m4 (LIBS_GUI): remove ole32.lib oleaut32.lib + (LIBS): add ws2_32.lib for static builds with Tcl. + +2007-12-01 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h, + * generic/ttk/ttkTheme.c, generic/ttk/ttkLayout.c, + * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c, + * generic/ttk/ttkTreeview.c, macosx/ttkMacOSXTheme.c, + * win/ttkWinTheme.c, win/ttkWinXPTheme.c: Improved macrology for + statically-initialized layout template tables. + +2007-11-28 Don Porter <dgp@users.sourceforge.net> + + * unix/tkUnixPort.h: When unix/configure determines whether the + intptr_t type is available, it has the <inttypes.h> header present. + It's only fair that we let Tk have it too. + +2007-11-26 Kevin Kenny <kennykb@acm.org> + + * generic/tkImgPPM.c (StringReadPPM): Corrected a comparison whose + sense was reversed that resulted in reading beyond the end of the + input buffer on malformed PPM data. [Bug 1822391] + * library/tkfbox.tcl (VerifyFileName): Corrected a couple of typos in + handling of bad file names. [Bug 1822076] Thanks to Christoph Bauer + (fridolin@users.sf.net) for the patch. + * tests/filebox.test (filebox-7.1, filebox-7.2): Added test cases that + exercise. [Bug 1822076] + * tests/imgPPM.test (imgPPM-4.1): Added test case that exercises. [Bug + 1822391] + +2007-11-25 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkManager.h, generic/ttk/ttkManager.c, + * generic/ttk/ttkFrame.c, generic/ttk/ttkNotebook.c, + * generic/ttk/ttkPanedwindow.c: Internal Ttk_Manager API updates; + Fixed [Bug 1343984]; Added [$nb hide] method; [$nb add] on + already-managed windows no longer throws an error, can be used to + re-add a hidden tab. + + * doc/ttk_notebook.n, tests/ttk/notebook.test, + * tests/ttk/panedwindow.test: Updated docs and test suite. + +2007-11-23 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * unix/README: General improvements. + +2007-11-21 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/tkfbox.tcl: Better theming in the file list area. + +2007-11-19 Don Porter <dgp@users.sourceforge.net> + + *** 8.5b3 TAGGED FOR RELEASE *** + + * README: Bump version number to 8.5b3. + * generic/tk.h: + * library/tk.tcl: + * unix/configure.in: + * unix/tk.spec: + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: + + * changes: Update changes for 8.5b3 release. + +2007-11-19 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/ttk/ttkTheme.c: Fix crash when 'style element create' + * tests/ttk/ttk.test: called w/ insufficient args; add tests. + +2007-11-18 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkElements.c, macosx/ttkMacOSXTheme.c: Add "fill" + element: like "background" but only erases parcel. + + * generic/ttk/ttkFrame.c: Use fill element in Labelframe Label + sublayout. Also improved default labelmargins for -labelanchor w*, e*. + + * generic/ttk/ttkLabel.c: no longer need Labelframe hack. + + * library/ttk/aquaTheme.tcl: ImageTextElement no longer needed. + TextElement no longer needs '-background' option. + + * generic/ttk/ttkFrame.c: Use sublayout for ttk::labelframe labels + instead of single element. + + * generic/ttk/ttkLabel.c: Default -anchor for text and label elements + is now "w" instead of "center". [Bug 1614540] + + * library/ttk/defaults.tcl, library/ttk/*Theme.tcl: Button styles now + need explicit "-anchor center". + + * generic/ttk/ttkLayout.c (TTKInitPadding): BUGFIX: + Ttk_GetPaddingFromObj() and Ttk_GetBorderFromObj() returned garbage + when passed an empty list. + + * macosx/ttkMacOSXTheme.c: Resynchronize with Tile codebase so that + patches can flow back and forth. + + * library/ttk/aquaTheme.tcl: Extra TButton -padding no longer needed. + +2007-11-18 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/ttkWinXPTheme.c: Add support for size information flags for + scrollbar and combobox buttons. This handles Tile [Patches 1596647 and + 1596657] but a bit more generically. + +2007-11-17 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/(tkArgv.c, tkBind.c, tkCipboard.c, tkEntry.c, tkOption.c, + tkScale.c, tkScrollbar.c, tkTextImage.c, tkVisual.c, tkWindow.c): Tidy + up some variable types. + + * generic/tkFont.c: Only check for -displayof if there are + * test/font.test: sufficient arguments. This permits checking + strings like -d. + +2007-11-17 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/scrollbar.tcl: Swap in core scrollbars for + [ttk::scrollbar]s on OSX. + +2007-11-16 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> + + * macosx/tkMacOSXFont.c (TkpMeasureCharsInContext): Correct an + oversight in the bug fix from 2007-11-11. [Bug 1824638] + +2007-11-15 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Wish.xcodeproj/project.pbxproj: add new chanio.test. + * macosx/Wish.xcode/project.pbxproj: + +2007-11-14 Donal K. Fellows <dkf@users.sf.net> + + * library/msgs/sv.msg: Get the locale declared within the message + catalog correct! [Bug 1831803] + +2007-11-11 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> + + * macosx/tkMacOSXFont.c (TkpMeasureCharsInContext): Fix the case when + TK_WHOLE_WORDS and TK_AT_LEAST_ONE are both set and maxLength is small. + [Bug 1824638] + +2007-11-09 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXCarbonEvents.c + (InstallStandardApplicationEventHandler): on Mac OS X Leopard, replace + the 2005-11-27 approach of installing the standard application handler + by calling RAEL and immediately longjmping out of it from an event + handler, as that now leads to crashes in -[NSView unlockFocus] whenever + HIToolbox uses Cocoa in Leopard (Help menu, Nav Services, Color + Picker). Instead call InstallStandardEventHandler() on the application + and menubar event targets, as Leopard ISEH finally handles these + correctly. Unfortunately need a HIToolbox-internal SPI to retrieve the + menubar event target, no public API appears have that functionality. + + * macosx/tkMacOSXDebug.c: make TkMacOSXInitNamedDebugSymbol() + * macosx/tkMacOSXDebug.h: available outside of debug builds as + the new Leopard ISAEH needs it. + + * macosx/tkMacOSXButton.c: replace HiliteControl() by modern API + * macosx/tkMacOSXMenubutton.c: for activation and enabling; + distinguish inactive and disabled + look&feel; correct activation handling + to match that of container toplevel. + + * macosx/tkMacOSXMenubutton.c: correct size computation of bevelbutton + variant to match that of buttons; + fix crash with bitmap due to NULL GC; + delay picParams setup until needed; + formatting cleanup. [Bug 1824521] + + * library/menu.tcl: correct handling of menubutton "active" + state on Aqua to match that of buttons. + + * macosx/tkMacOSXDefault.h: correct button & menubutton active + foreground and background colors and + menubutton border width. + + * macosx/tkMacOSXWindowEvent.c: handle kEventWindowExpanding carbon + * macosx/tkMacOSXCarbonEvents.c: event instead of kEventWindowExpanded + to ensure activate event arrives after + window is remapped, also need to + process all Tk events generated by + remapping in the event handler to + ensure children are remapped before + activate event is processed. + + * macosx/tkMacOSXSubwindows.c: add pixmap size field to MacDrawable + * macosx/tkMacOSXInt.h: struct; add flag for B&W pixmaps. + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXEmbed.c: + * macosx/tkMacOSXMenu.c: + + * macosx/tkMacOSXPrivate.h: correct Leopard HIToolboxVersionNumber. + + * macosx/ttkMacOSXTheme.c: add error checking; cleanup formatting. + + * macosx/tkMacOSXFont.c (TkpGetFontAttrsForChar): panic on false return + from TkMacOSXSetupDrawingContext(). + + * macosx/tkMacOSXButton.c: sync formatting, whitespace, copyright + * macosx/tkMacOSXDialog.c: with core-8-4-branch. + * macosx/tkMacOSXMenus.c: + * macosx/tkMacOSXWm.c: + * xlib/xgc.c + * library/bgerror.tcl: + * library/console.tcl: + * library/menu.tcl: + +2007-11-07 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTheme.c (Ttk_ElementSize): Fixed longstanding, subtle + bug that caused element padding to sometimes be counted twice in size + computations. + + * generic/ttk/ttkElements.c, generic/ttk/ttkClamTheme.c, + * generic/ttk/ttkDefaultTheme.c, generic/ttk/ttkTreeview.c, + * generic/ttk/ttkImage.c, macosx/ttkMacOSXTheme.c, + * win/ttkWinTheme.c, win/ttkWinXPTheme.c: + Fix ElementSizeProcs affected by previous change. + +2007-11-06 Andreas Kupries <andreask@activestate.com> + + * doc/CrtConsoleChan.3: Fixed markup typo and extended see also + section per suggestions by Donal. + +2007-11-05 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/combobox.tcl: Set focus to listbox in <Map> binding + instead of in Post command (see [Bug 1349811] for info). + +2007-11-05 Andreas Kupries <andreask@activestate.com> + + * doc/CrtConsoleChan.3: New file providing minimal documentation of + 'Tk_InitConsoleChannels()'. [Bug 432435] + +2007-11-05 Joe English <jenglish@users.sourceforge.net> + + * macosx/ttkMacOSXTheme.c (TreeitemLayout): Remove focus ring + from treeview items on OSX (problem reported by Kevin Walzer). + +2007-11-04 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTreeview.c: Use null "treearea" element for treeview + owner-draw area instead of "client", to avoid nameclash with + Notebook.client element (this was causing sizing anomalies in XP + theme, and introduced extraneous padding). + * generic/ttk/ttkDefaultTheme.c: Treeitem.indicator element needs left + margin now. + +2007-11-04 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXMenus.c: add "Run Widget Demo" menu item to the + default Edit menu along with associated carbon event handler enabling + the item only if demo files are installed; cleanup handling of "About" + and "Source" menu items. + + * library/bgerror.tcl: fix background of detail text on Aqua. + + * library/console.tcl: add accelerators and fix Aqua bindings + of the new font size menu items. + + * library/demos/mclist.tcl: Aqua GOOBE. + * library/demos/tree.tcl: + * library/demos/ttknote.tcl: + * library/demos/widget: + + * doc/chooseDirectory.n: remove/correct obsolete Mac OS 9-era + * doc/getOpenFile.n: information. + * doc/menu.n: + + * macosx/tkMacOSXEvent.c (TkMacOSXProcessCommandEvent): fix boolean + arg + + * macosx/Wish.xcodeproj/project.pbxproj: add new demo file. + * macosx/Wish.xcode/project.pbxproj: + +2007-11-03 Pat Thoyts <patthoyts@users.sourceforge.net> + + * library/console.tcl: Add menu item and key binding to adjust font. + +2007-11-02 Donal K. Fellows <dkf@users.sf.net> + + * library/demos/mclist.tcl: Added a demo of how to do a multi-column + sortable listbox. + + * library/msgbox.tcl: Made message dialog use Ttk widgets for better + L&F. + + * library/tkfbox.tcl (::tk::dialog::file::CompleteEnt): Added <Tab> + completion. [FR 805091] + * library/tkfbox.tcl: Made file dialog use Ttk widgets for better L&F. + + * library/demos/sayings.tcl: Better resizing. [Bug 1822410] + +2007-11-01 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/textpeer.tcl: Better resizing. [Bug 1822601] + + * doc/colors.n: Added list of Windows system colors. [Bug 945409] + +2007-11-01 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXColor.c (GetThemeColor): improve translation of RGB + pixel values into RGBColor. + + * library/demos/widget: increase height of main window text widget to + use more of the available vertical space. + + * doc/bind.n: document the Option modifier, clarify meaning + and availability of Command & Option. + + * doc/console.n: clarify availability of [console] in TkAqua. + +2007-11-01 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * unix/installManPage, doc/*.n: Make documentation use the name that + scripts use as much as possible. [Bug 1640073] + + * doc/text.n: Fixed mistake in [$t tag remove] docs. [Bug 1792191] + + * doc/bind.n: Documented the Command modifier. [Bug 1232908] + + * doc/console.n, doc/wish.1: Made it clearer when and why the console + command is present. [Bug 1386955] + +2007-10-31 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/entry3.tcl: Improved description/comments so that + people better understand what is being validated, following suggestion + from Don Porter. + + * library/demos/image2.tcl (loadImage): Mark non-loadable images as + such instead of throwing a nasty dialog, following suggestion from Don + Porter. + + * generic/tkImgPhoto.c (Tk_PhotoPutBlock): More optimization, derived + from [Patch 224066]. + +2007-10-30 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/combobox.tcl (Unpost): BUGFIX: Unpost can be called with + no preceding Post. + +2007-10-31 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/rules.vc: Use -fp:strict with msvc8 as -fp:precise fails on + * generic/tkObj.c: amd64 builds. Fix the two places in Tk that + * generic/tkTrig.c: generate errors with msvc8 when using this flag. + +2007-10-30 Jeff Hobbs <jeffh@ActiveState.com> + + * library/choosedir.tcl: only enable OK button when valid in + conjunction with -mustexist. [Bug 1550528] + + * library/listbox.tcl (::tk::ListboxBeginSelect): ignore -takefocus + when considering focus on <1>, it is for tab focus. + +2007-10-30 Don Porter <dgp@users.sourceforge.net> + + * generic/tk.h: Bump version number to 8.5b2.1 to distinguish + * library/tk.tcl: CVS development snapshots from the 8.5b2 + * unix/configure.in: release. + * unix/tk.spec: + * win/configure.in: + + * unix/configure: autoconf (2.59) + * win/configure: + +2007-10-30 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/text.n: fix spelling of -inactiveselectbackground [Bug 1626415] + + * library/entry.tcl: don't error with Clear event. [Bug 1509288] + + * library/ttk/fonts.tcl: use size -12 TkFixedFont (was -10) on X11 + +2007-10-30 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/unicodeout.tcl: Fixed Arabic and Hebrew rendering on + Windows. [Bug 1803723] + + * generic/tkImgPhoto.c (ImgPhotoCmd): Rename enumeration for somewhat + simpler-to-read code. [Bug 1677613] + +2007-10-30 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkWidget.c: Split up RedisplayWidget() to factor out + double-buffering related code. + + * macosx/ttkMacOSXAquaTheme.c: Use SetThemeBackGround/ + kThemeBrushModelessDialogBackground{Active|Inactive} instead of + ApplyThemeBackground/kThemeBackgroundWindowHeader (advice from DAS). + + * library/ttk/aquaTheme.tcl: Use darker shade for inactive and + disabled text, to match typical values of most + kThemeXXXTextColorInactive values. + +2007-10-30 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * doc/selection.n: Clarify UTF8_STRING handling. [Bug 1778563] + + * doc/text.n: Clarify search subccommand docs. [Bug 1622919] + +2007-10-29 Jeff Hobbs <jeffh@ActiveState.com> + + * macosx/tkMacOSXFont.c (InitSystemFonts): + * library/ttk/fonts.tcl: use Monaco 11 (was 9) as Aqua TkFixedFont + + * tests/listbox.test, tests/panedwindow.test, tests/scrollbar.test: + * library/bgerror.tcl, library/dialog.tcl, library/listbox.tcl: + * library/msgbox.tcl, library/optMenu.tcl, library/tclIndex: + * library/tkfbox.tcl, library/demos/floor.tcl, library/demos/rmt: + * library/demos/tcolor, library/demos/text.tcl: + * library/demos/twind.tcl, library/demos/widget: Buh-bye Motif look + * library/ttk/fonts.tcl: Update of Tk default look in 8.5 + * macosx/tkMacOSXDefault.h: Trims border sizes, cleaner X11 look + * unix/tkUnixDefault.h: with minor modifications for Win32/Aqua. + * win/tkWinDefault.h: Uses Tk*Font definitions throughout for + * win/tkWinFont.c: classic widgets. [Bug 1820344] + * library/obsolete.tcl (::tk::classic::restore): This restores + changes made to defaults in 8.5 using the 'option' command, + segmented into logical groups. + + * tests/winfo.test: winfo-4.5 raise .t to above . for Windows + + * tests/unixWm.test: note TIP#142 results and remove unnecessary + catches. + +2007-10-29 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * doc/*.1, doc/*.n, doc/*.3: Lots more GOOBE work. + +2007-10-28 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/combobox.tcl: Make popdown window [wm resizable 0 0] on + OSX, to prevent TkAqua from shrinking the scrollbar to make room for a + grow box that isn't there. + * macosx/ttkMacOSXTheme.c, library/ttk/aquaTheme.tcl: Reworked + combobox layout. + +2007-10-26 Don Porter <dgp@users.sourceforge.net> + + *** 8.5b2 TAGGED FOR RELEASE *** + + * changes: Update changes for 8.5b2 release. + + * doc/*.1: Revert doc changes that broke + * doc/*.3: `make html` so we can get the release + * doc/*.n: out the door. + + * README: Bump version number to 8.5b2. + * generic/tk.h: + * library/tk.tcl: + * unix/configure.in: + * unix/tk.spec: + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: + +2007-10-26 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (ApplyMasterOverrideChanges): fix window class + of transient toplevels that are not also overrideredirect. [Bug + 1816252] + + * macosx/tkMacOSXDialog.c: TIP#242 cleanup. + * library/demos/filebox.tcl: demo TIP#242 -typevariable. + +2007-10-25 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkNotebook.c: [Bug 1817596] + +2007-10-25 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/getOpenFile.n: TIP#242 implementation of -typevariable to + * library/tkfbox.tcl: return type of selected file in file dialogs. + * library/xmfbox.tcl: [Bug 1156388] + * macosx/tkMacOSXDialog.c: + * tests/filebox.test: + * tests/winDialog.test: + * win/tkWinDialog.c: + +2007-10-25 Don Porter <dgp@users.sourceforge.net> + + * generic/tkPlace.c: Prevent segfault in place geometry manager. + Thanks to Colin McDonald. [Bug 1818491] + +2007-10-24 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/*.c, win/{ttkWinMonitor,ttkWinTheme,ttkWinXPTheme}.c, + * macosx/ttkMacOSXTheme.c: Move widget layout registration from + TtkElements_Init() to widget *_Init() routines. Renaming/consistency: + s/...ElementGeometry()/...ElementSize()/ + +2007-10-24 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * doc/*.n, doc/*.3, doc/*.1: Lots of changes to take advantage of the + new macros. + +2007-10-24 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/tkWinDraw.c: Applied [Patch 1723362] for transparent bitmaps. + + * generic/tkWindow.c: permit wm manage of any widget (esp: ttk::frame) + +2007-10-23 Jeff Hobbs <jeffh@ActiveState.com> + + * library/ttk/combobox.tcl (ttk::combobox::PopdownWindow): redo wm + transient on each drop to handle reparent-able frames. [Bug 1818441] + +2007-10-23 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/combobox.tcl: [namespace import ::ttk::scrollbar] + doesn't work, since ttk::scrollbar isn't [namespace export]ed. + +2007-10-23 Don Porter <dgp@users.sourceforge.net> + + * tests/cursor.test: Make tests robust against changes in Tcl's + rules for accepting integers in octal format. + +2007-10-23 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * doc/font.n: Added section on the TIP#145 fonts. + +2007-10-23 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/tkWinFont.c: Fixed leak in CreateNamedFont spotted by das. + +2007-10-23 Daniel Steffen <das@users.sourceforge.net> + + * library/demos/combo.tcl: Aqua GOOBE. + * library/demos/toolbar.tcl: + * library/demos/tree.tcl: + * library/demos/ttknote.tcl: + * library/demos/ttkprogress.tcl: + * library/demos/widget: + + * macosx/Wish.xcodeproj/project.pbxproj: add new demo files. + * macosx/Wish.xcode/project.pbxproj: + +2007-10-22 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/widget: Added more demos, reorganized to make Tk and + Ttk demos seem to be more coherent whole. Made localization a bit + easier by reducing the amount of duplication. + * library/demos/{combo,toolbar,tree,ttknote,ttkprogress}.tcl: New + demos of new (mostly) Ttk widgets. + * library/demos/ttkbut.tcl: Improvements. + +2007-10-22 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/combobox.tcl: ttk::combobox overhaul; fixes [Bugs + 1814778, 1780286, 1609168, 1349586] + * library/ttk/aquaTheme.tcl: Factored out aqua-specific combobox + -postposition adjustments. + * generic/ttk/ttkTrack.c: Detect [grab]s and unpress pressed + element; combobox workaround no longer + needed. + +2007-10-22 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXFont.c: register named fonts for TIP #145 fonts + and all theme font IDs. + + * generic/tkFont.c (Tk{Create,Delete}NamedFont): allow NULL interp. + + * library/ttk/fonts.tcl: check for TIP #145 fonts on all + platforms; correct aqua font sizes. + + * library/demos/ttkmenu.tcl: Aqua GOOBE. + * library/demos/ttkpane.tcl: + * library/demos/widget: + + * macosx/Wish.xcodeproj/project.pbxproj: add new demo files. + * macosx/Wish.xcode/project.pbxproj: + +2007-10-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/ttkmenu.tcl: Added more demos of Ttk widgets. These + * library/demos/ttkpane.tcl: ones are of menubuttons, panedwindows and + a progress bar (indirectly). + +2007-10-18 Pat Thoyts <patthoyts@users.sourceforge.net> + + * library/ttk/fonts.tcl: Create all the TIP #145 font names on all + platforms (mac and unix get handled in script, windows in C) + +2007-10-17 David Gravereaux <davygrvy@pobox.com> + + * bitmaps/*.xbm: Changed CVS storage mode from -kb to -kkv as these + are really text files, not binaries. + * win/makefile.vc: Added $(BITMAPDIR) to the search path for the + depend target. + +2007-10-18 Daniel Steffen <das@users.sourceforge.net> + + * library/demos/widget: Aqua GOOBE, cleanup icons. + * library/demos/ttkbut.tcl: + * library/demos/entry3.tcl: + * library/demos/msgbox.tcl: + + * library/demos/button.tcl: restore setting of button + highlightbackground on Aqua. + + * macosx/ttkMacOSXTheme.c: adjust button and separator geometry. + + * macosx/tkMacOSXWm.c: fix warnings. + + * macosx/Wish.xcodeproj/project.pbxproj: add new demo files. + * macosx/Wish.xcode/project.pbxproj: + +2007-10-17 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/ttkbut.tcl: Added demo of the basic Ttk widgets. + +2007-10-16 David Gravereaux <davygrvy@pobox.com> + + * win/makefile.vc: depend target now works and builds a generated + dependency list with $(TCLTOOLSDIR)/mkdepend.tcl + +2007-10-16 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/widget: Made the code for generating the contents of + the main widget more informative. Added 'new' flagging for wholly new + demos. + + * doc/text.n: Made it clearer what things are text widget invokations + and what are not. Also some other clarity improvements. + +2007-10-15 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/widget: Use Ttk widgets for the widget demo core, for + vastly improved look-and-feel on at least one platform (Windows). + * library/demos/{button,check,style,twind}.tcl: Various tweaks for + GOOBE... + * library/demos/textpeer.tcl: New demo script to show off peering as a + specific feature. + +2007-10-15 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkFocus.c, generic/tkFrame.c, generic/tkInt.h: + * macosx/tkMacOSXButton.c, macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXWm.c, unix/tkUnixWm.c, win/tkWinWm.c: + * doc/wm.n, tests/wm.test: TIP #125 implementation. [Bug 998125] + Adds [wm manage|forget] for dockable frames. + Finished X11 and Windows code, needs OS X completion. + +2007-10-15 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTreeview.c: Store pointer to column table entry + instead of column index in columnNames hash table. This avoids the + need for the evil PTR2INT and INT2PTR macros, and simplifies things a + bit. + +2007-10-15 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkArgv.c: Fix gcc warnings about 'cast to/from + * generic/tkCanvUtil.c: pointer from/to integer of different + * generic/tkCanvas.c: size' on 64-bit platforms by casting + * generic/tkCursor.c: to intermediate types + * generic/tkInt.h: intptr_t/uintptr_t via new PTR2INT(), + * generic/tkListbox.c: INT2PTR(), PTR2UINT() and UINT2PTR() + * generic/tkObj.c: macros. + * generic/tkStyle.c: + * generic/tkTextIndex.c: + * generic/tkUtil.c: + * generic/ttk/ttkTheme.h: + * generic/ttk/ttkTreeview.c: + * unix/tkUnixMenu.c: + * unix/configure.in: + + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in: autoheader-2.59 + + * macosx/Wish-Common.xcconfig: add 'tktest-X11' target. + * macosx/Wish.xcode/project.pbxproj: + * macosx/Wish.xcode/default.pbxuser: + * macosx/Wish.xcodeproj/default.pbxuser: + * macosx/Wish.xcodeproj/project.pbxproj: + + * unix/configure.in (Darwin): add support for 64-bit X11. + * unix/configure: autoconf-2.59 + +2007-10-14 Jeff Hobbs <jeffh@ActiveState.com> + + * win/configure, win/configure.in (TK_WIN_VERSION): Make sure the + patchlevel doesn't contain extra dotted pairs (eg. interim release) + +2007-10-12 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/makefile.vc: Mine all version information from headers. + * win/rules.vc: Sync tcl and tk and bring extension versions + * win/nmakehlp.c: closer together. Try and avoid using tclsh + to do substitutions as we may cross compile. + + * library/console.tcl: Use TkFixedFont and ttk widgets + +2007-10-12 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDraw.c: replace all (internal) use of QD region + * macosx/tkMacOSXSubwindows.c: API by HIShape API, with conversion to + * macosx/tkMacOSXWindowEvent.c: QD regions only when required by legacy + * macosx/tkMacOSXPrivate.h: Carbon or Tk API. + * macosx/tkMacOSXRegion.c: + * macosx/tkMacOSXDebug.c: + * macosx/tkMacOSXDebug.h: + + * macosx/tkMacOSXInt.h: replace MacDrawable's QD RgnHandles + * macosx/tkMacOSXEmbed.c: clipRgn, aboveClipRgn & drawRgn by + * macosx/tkMacOSXMenu.c: HIShapeRefs visRgn & aboveVisRgn and + * macosx/tkMacOSXSubwindows.c: CGRect drawRect. + + * macosx/tkMacOSXWindowEvent.c: remove use of QD port vis rgn in + * macosx/tkMacOSXSubwindows.c: window update rgn calculation, + * macosx/tkMacOSXWm.c: manually excise growbox from toplevel + clip rgn instead. + + * macosx/tkMacOSXDraw.c: replace use of QD port clip rgn by new + * macosx/tkMacOSXPrivate.h: clipRgn fld in TkMacOSXDrawingContext; + handle QD/CG drawing mismatches in + XCopyArea, XCopyPlane and TkPutImage; + cleanup/speedup CGContext setup in + TkMacOSXSetupDrawingContext(). + + * macosx/tkMacOSXDraw.c: change TkMacOSXSetupDrawingContext() + * macosx/tkMacOSXEntry.c: to return boolean indicating whether + * macosx/tkMacOSXFont.c: drawing is allowed (and was setup) or + * macosx/tkMacOSXMenu.c: not (e.g. when clipRgn is empty). + * macosx/ttkMacOSXTheme.c: + + * macosx/tkMacOSXSubwindows.c: signal that drawable is a pixmap via + * macosx/tkMacOSXInt.h: new explicit TK_IS_PIXMAP flag instead + of a NULL cligRgn field. + + * macosx/tkMacOSXRegion.c: add wrappers for missing/buggy HIShape + * macosx/tkMacOSXPrivate.h: API, and private helpers to operate on + HIShapeRefs & convert to/from TkRegion + + * macosx/tkMacOSXRegion.c: add Tkp{Retain,Release}Region() API + * macosx/tkMacOSXInt.h: for TkRegion. + + * xlib/xgc.c: factor out alloc/free of GC clip_mask; + * macosx/tkMacOSXXStubs.c: manage clip rgn lifetime with new + Tkp{Retain,Release}Region(). + + * macosx/tkMacOSXButton.c: delay picParams setup until needed. + + * generic/tkTextDisp.c (CharUndisplayProc): fix textDisp.test crash. + +2007-10-11 David Gravereaux <davygrvy@pobox.com> + + * win/winMain.c: Replaced incorrect comments in main() to descibe why + the console widget does not need to be created for this application + entry point (if used). Must have been a bad copy/paste of WinMain() + from 10 years back. + +2007-10-11 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (TkMacOSXGrowToplevel): manually constrain resize + limitBounds to maxBounds, works around SectRect() mis-feature (return + zero rect if input rect has zero height/width). [Bug 1810818] + +2007-10-09 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/tkImage.c: Make Ttk_GetImage safe if called with NULL + * tests/ttk/image.test: interp. Added some tests that crash on Windows + without this fix. + +2007-10-02 Don Porter <dgp@users.sourceforge.net> + + [core-stabilizer-branch] + + * README: Bump version number to 8.5.0 + * generic/tk.h: + * library/tk.tcl: + * unix/configure.in: Updated LOCALES. + * unix/tk.spec: + * win/configure.in: + + * unix/configure: autoconf (2.59) + * win/configure: + +2007-09-30 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/entry.tcl (WordBack, WordForward): + Fix private routines accidentally defined in global namespace + [Bug 1803836] + +2007-09-26 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/msgs/hu.msg: Added Hungarian message set, from Pader Reszo. + [Patch 1800742] + +2007-09-20 Donal K. Fellows <dkf@users.sf.net> + + *** 8.5b1 TAGGED FOR RELEASE *** + + * generic/tkTextDisp.c (LayoutDLine): Only call callbacks that are + * tests/textDisp.test (textDisp-32.3): not NULL. [Bug 1791052] + +2007-09-20 Don Porter <dgp@users.sourceforge.net> + + * changes: updates for 8.5b1 release. + +2007-09-19 Don Porter <dgp@users.sourceforge.net> + + * README: Bump version number to 8.5b1. + * generic/tk.h: Merge from core-stabilizer-branch. + * library/tk.tcl: Stabilizing toward 8.5b1 release now done + * unix/configure.in: on the HEAD. core-stabilizer-branch is + * unix/tk.spec: now suspended. + * win/configure.in: + +2007-09-19 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/tkStubLib.: Replaced isdigit with internal implementation. + +2007-09-18 Don Porter <dgp@users.sourceforge.net> + + * generic/tkStubLib.c: Remove C library calls from Tk_InitStubs() + * win/makefile.vc: so that we don't need the C library linked + in to libtkStub. + +2007-09-18 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tkImgGIF.c (FileReadGIF, StringReadGIF): Rewrite for greater + clarity (more comments, saner code arrangement, etc.) + +2007-09-18 Pat Thoyts <patthoyts@users.sourceforge.net> + + * tests/all.tcl: Made ttk/all.tcl be the same as tk's all.tcl and + * tests/ttk/all.tcl: make use of file normalize (bugs noted by + mjanssen and GPS with msys) + +2007-09-17 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/makefile.vc: Add crt flags for tkStubLib now it uses C-library + functions. + +2007-09-17 Joe English <jenglish@users.sourceforge.net> + + * unix/tcl.m4: use '${CC} -shared' instead of 'ld -Bshareable' to + build shared libraries on current NetBSDs. [Bug 1749251] + * unix/configure: regenerated (autoconf-2.59). + +2007-09-17 Don Porter <dgp@users.sourceforge.net> + + * generic/tkConsole.c: Revised callers of Tcl_InitStubs() to account + * generic/tkMain.c: for restored compatible support for the call + * generic/tkWindow.c: Tcl_InitStubs(interp, TCL_VERSION, 1). Also + revised Tcl_PkgRequire() call for Tcl so that, for example, a Tk + library built against Tcl 8.5.1 headers will not refuse to [load] into + a Tcl 8.5.0 interpreter. [Tcl Bug 1578344] + + * generic/tk.h: Revised Tk_InitStubs() to restore Tk 8.4 + * generic/tkStubLib.c: source compatibility with callers of + * generic/tkWindow.c: Tk_InitStubs(interp, TK_VERSION, 1). + +2007-09-17 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/combobox.tcl: Try to improve combobox appearance on + OSX + Tk 8.5. [Bug 1780286] + +2007-09-15 Daniel Steffen <das@users.sourceforge.net> + + * unix/tcl.m4: replace all direct references to compiler by ${CC} to + enable CC overriding at configure & make time; run + check for visibility "hidden" with all compilers; + quoting fixes from TEA tcl.m4. + (SunOS-5.1x): replace direct use of '/usr/ccs/bin/ld' in SHLIB_LD by + 'cc' compiler driver. + * unix/configure: autoconf-2.59 + +2007-09-14 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Wish-Common.xcconfig: enable Tcl DTrace support. + * macosx/Wish.xcodeproj/project.pbxproj: + +2007-09-12 Andreas Kupries <andreask@activestate.com> + + * win/Makefile.in (install-binaries): Fixed missing brace in the + * win/makefile.vc (install-binaries): generated package index file. + Note: unix/Makefile.in is good. + +2007-09-11 Reinhard Max <max@suse.de> + + * generic/tkImgGIF.c: Fixed a buffer overrun that got triggered by + multi-frame interlaced GIFs that contain subsequent frames that are + smaller than the first one. + + * tests/imgPhoto.test: Added a test for the above. + +2007-09-11 Don Porter <dgp@users.sourceforge.net> + + * generic/tkConsole.c: Revised calls to Tcl_InitStubs() and + * generic/tkMain.c: [package require Tcl] so that Tk Says What It + * generic/tkWindow.c: Means using the new facilties of [package] in + * library/tk.tcl: Tcl 8.5 about what version(s) of Tcl it is + * unix/Makefile.in: willing to work with. [Bug 1578344] + * win/Makefile.in: + * win/makefile.vc: + +2007-09-10 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/README: typo corrections [Bug 1788682] + +2007-09-10 Don Porter <dgp@users.sourceforge.net> + + * generic/tkConsole.c: Revise all Tcl_InitStubs() calls to restore + * generic/tkMain.c: the traditional practice that a Tk shared + * generic/tkWindow.c: library may [load] into a Tcl 8.5 interp at + any patchlevel. This practice also matches the compile time checks of + TCL_MAJOR_VERSION and TCL_MINOR_VERSION in tk.h. [Bug 1723622] + +2007-09-06 Don Porter <dgp@users.sourceforge.net> + + * generic/tkWindow.c (Initialize): Moved common Tk initialization + * generic/tkInitScript.h (removed): script out of tkInitScript.h + * macosx/tkMacOSXInit.c: and multiple TkpInit() routines and + * unix/Makefile.in: into the common Initialize() routine in + * unix/tkUnixInit.c: generic code. Also removed constraint on + * win/tkWinInit.c: ability to define a custom [tkInit] before + calling Tk_Init(). Until now the custom [tkInit] had to be a proc. Now + it can be any command. Removal of tkInitScript.h also fixes [Bug + 1656283]. + +2007-09-06 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Wish.xcode/project.pbxproj: discontinue unmaintained support + * macosx/Wish.xcode/default.pbxuser: for Xcode 1.5; replace by Xcode2 + project for use on Tiger (with Wish.xcodeproj to be used on Leopard). + + * macosx/Wish.xcodeproj/project.pbxproj: updates for Xcode 2.5 and 3.0. + * macosx/Wish.xcodeproj/default.pbxuser: + * macosx/Wish.xcode/project.pbxproj: + * macosx/Wish.xcode/default.pbxuser: + * macosx/Wish-Common.xcconfig: + + * macosx/README: document project changes. + +2007-09-04 Joe English <jenglish@users.sourceforge.net> + + * generic/tkTest.c: Fix for [Bug 1788019] "tkTest.c compiler warning". + +2007-09-04 Don Porter <dgp@users.sourceforge.net> + + * unix/Makefile.in: It's unreliable to count on the release + manager to remember to `make genstubs` before `make dist`. Let the + Makefile remember the dependency for us. + + * unix/Makefile.in: Corrections to `make dist` dependencies to be + sure that macosx/configure gets generated whenever it does not exist. + +2007-09-03 Daniel Steffen <das@users.sourceforge.net> + + * generic/ttk/ttkInit.c (Ttk_Init): register ttk in package database + to enable extension access to the ttkStubs table. + + * generic/ttk/ttkDecls.h: correct capitalization of ttk package name. + +2007-08-28 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + Assorted documentation improvements. + * doc/button.n: Added examples. + * doc/checkbutton.n: Added example. + * doc/console.n: Standardized section ordering. + * doc/tk.n: Added "See also". + * doc/ttk_combobox.n: Added keywords. + +2007-08-27 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDialog.c (Tk_ChooseColorObjCmd): correct setting of + interp result [Bug 1782105]; fix -initialcolor overwriting last color + selection; style cleanup. + +2007-08-21 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/rules.vc: Synchronize with tcl rules.vc + * tests/all.tcl: Fix the line-endings. + +2007-08-07 Daniel Steffen <das@users.sourceforge.net> + + * unix/Makefile.in: Add support for compile flags specific to + object files linked directly into executables. + + * unix/configure.in (Darwin): Only use -seg1addr flag when prebinding; + use -mdynamic-no-pic flag for object files linked directly into exes. + + * unix/configure: autoconf-2.59 + +2007-08-01 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/tkWinDialog.c: Fix [Bug 1692927] (buffer length problems) + * win/tkWinTest.c: Added 'testfindwindow' and 'testgetwindowinfo' + and extended 'testwinevent' for WM_COMMAND support to enable testing + native messagebox dialogs. + * tests/winMsgbox.test: New Windows native messagebox tests. + +2007-07-25 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDialog.c (NavServicesGetFile): Reset interp result on + nav dialog cancel. [Bug 1743786] + +2007-07-09 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/Makefile.in: clarify what the headers installed are, and + add ttkTheme.h and ttkDecls.h to private headers (later public). + +2007-07-09 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWindowEvent.c (Tk_MacOSXIsAppInFront): Use process mgr + * macosx/tkMacOSXMouseEvent.c: to determine if + app is in front instead of relying on activate/deactivate events (which + may arrive after this info is needed, e.g. during window drag/click + activation); replace other process mgr use to get this info with calls + to Tk_MacOSXIsAppInFront(). + + * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): Correct + window click activation, titlebar click handling and background window + dragging/growing in the presence of grabs or window-/app-modal windows; + fix window click activation bringing all other app windows to front. + + * macosx/tkMacOSXDraw.c (TkPutImage): Handle non-native XImage byte and + bit orders; reverse bits via xBitReverseTable instead of InvertByte(). + +2007-07-06 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/aquaTheme.tcl: Set -anchor w for TMenubuttons. + [Bug 1614540] + +2007-07-04 Andreas Kupries <andreask@activestate.com> + + * macosx/tkMacOSXXStubs.c (DestroyImage): Fixed seg.fault in release + of image data for images coming from XGetImage. Change committed by me + for Daniel Steffen. See 2007-06-23 for the change which introduced the + problem. + +2007-07-02 Daniel Steffen <das@users.sourceforge.net> + + * xlib/xgc.c (XCreateGC): Correct black and white pixel values used to + initialize GC foregrund and background fields. + + * macosx/tkMacOSXColor.c: Add debug messages for unknown pixel values. + + * macosx/tkMacOSXDraw.c (TkMacOSXRestoreDrawingContext): Don't restore + port state if it wasn't altered by TkMacOSXSetupDrawingContext(). + +2007-06-29 Daniel Steffen <das@users.sourceforge.net> + + * xlib/ximage.c: Bitmaps created from the static .xbm + arrays always have LSBFirst bit order. + + * unix/configure.in: Fix flag used to weak-link libXss. + * unix/configure: autoconf-2.59 + + * macosx/tkMacOSXScrlbr.c: Correct int <-> dobule conversion issues + that could lead to Carbon getting confused about scrollbar thumb size. + + * macosx/tkMacOSXDraw.c (XCopyArea, XCopyPlane, TkPutImage): Use + TkMacOSX{Setup,Restore}DrawingContext() to setup/restore clip & colors. + (TkMacOSXSetupDrawingContext, TkMacOSXRestoreDrawingContext): Add save + and restore of QD port clip region; factor out clip region code common + to CG and QD branches; check for port and context validity; handle + tkPictureIsOpen flag during QD port setup. + (TkScrollWindow): Remove unnecessary scroll region manipulation + + * macosx/tkMacOSXDraw.c: Remove second global QD temp region + * macosx/tkMacOSXInt.h: (no longer necessary) and rename + * macosx/tkMacOSXRegion.c: remaining global QD temp region. + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWindowEvent.c: + + * macosx/tkMacOSXDraw.c: Make useCGDrawing variable MODULE_SCOPE + * macosx/tkMacOSXFont.c: and respect it for ATSUI font drawing. + + * macosx/tkMacOSXButton.c: Reduce reliance on current QD port + * macosx/tkMacOSXColor.c: setting and remove unnecessary + * macosx/tkMacOSXDebug.c: references to a drawable's QD port, + * macosx/tkMacOSXDebug.h: notably replace GetWindowFromPort( + * macosx/tkMacOSXDialog.c: TkMacOSXGetDrawablePort()) idiom by new + * macosx/tkMacOSXDraw.c: TkMacOSXDrawableWindow() and change + * macosx/tkMacOSXKeyEvent.c: TkMacOSXSetColorInPort() to take a port + * macosx/tkMacOSXMenu.c: argument. + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXScrlbr.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + + * macosx/tkMacOSXInt.h: Factor out macros, declarations + * macosx/tkMacOSXPrivate.h (new): and prototypes that are purely + internal and private to the 'macosx' sources into a new internal header + file that does _not_ get installed into Tk.framework/PrivateHeaders. + + * macosx/tkMacOSXButton.c: #include new tkMacOSXPrivate.h + * macosx/tkMacOSXCarbonEvents.c: instead of tkMacOSXInt.h. + * macosx/tkMacOSXClipboard.c: + * macosx/tkMacOSXColor.c: + * macosx/tkMacOSXCursor.c: + * macosx/tkMacOSXDebug.c: + * macosx/tkMacOSXDialog.c: + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXEntry.c: + * macosx/tkMacOSXEvent.c: + * macosx/tkMacOSXFont.c: + * macosx/tkMacOSXHLEvents.c: + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXKeyEvent.c: + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXMenus.c: + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXNotify.c: + * macosx/tkMacOSXRegion.c: + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXScrlbr.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXXStubs.c: + * macosx/ttkMacOSXTheme.c: + + * macosx/Wish.xcodeproj/project.pbxproj: Improve support for renamed + * macosx/Wish.xcodeproj/default.pbxuser: tcl and tk source dirs; add + * macosx/Wish-Common.xcconfig: 10.5 SDK build config; remove + tclMathOp.c. + + * macosx/README: Document Wish.xcodeproj changes. + +2007-06-23 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkImgPhoto.c (ImgPhotoConfigureInstance, DisposeInstance): + Use XDestroyImage instead of XFree to destroy XImage; replace runtime + endianness determination by compile-time check for WORDS_BIGENDIAN. + + * xlib/ximage.c (XCreateBitmapFromData): Use XCreateImage and + XDestroyImage instead of creating XImage structure manually. + + * macosx/tkMacOSXXStubs.c (XCreateImage, DestroyImage): Correct XImage + bytes_per_line/bitmap_pad calculations and endianness setting; free + image data and XImage structure at destruction; formatting cleanup. + + * macosx/tkMacOSXDialog.c (NavServicesGetFile): Disable app-modal + sheet variant of nav dialog on OS versions where it causes problems. + +2007-06-20 Jeff Hobbs <jeffh@ActiveState.com> + + * library/ttk/ttk.tcl: Should require Tk before pseudo-providing + tile 0.8.0. + +2007-06-09 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkPanedwindow.c, doc/ttk_panedwindow.n, + * tests/ttk/panedwindow.test: Added -width and -height options. Added + 'panes' method, return list of managed windows. 'sashpos' method is + now documented as part of the public interface, and details clarified. + Should be easier to set initial sash positions now. Alleviates [Bug + 1659067]. + +2007-06-09 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinWm.c (WmIconphotoCmd): fix wm iconphoto RGBA issues. + [Bug 1467997] (janssen) + + * win/tkWinMenu.c (TkWinHandleMenuEvent): Improve handling to allow + for unicode char menu indices and not use CharUpper on Tcl utf + strings. [Bug 1734223] + +2007-06-09 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkManager.h, generic/ttk/ttkManager.c, + * generic/ttk/ttkNotebook.c, generic/ttk/ttkPanedwindow.c, + * generic/ttk/ttkFrame.c: Ttk_Manager API overhaul: + + Ttk_Manager no longer responsible for managing slave records + + Ttk_Manager structure now opaque + + Ttk_Slave structure now private + + Pass Ttk_Manager* to Tk_GeomMgr hooks instead of Ttk_Slave* + + * generic/ttk/ttkFrame.c: Simplified -labelwidget management. + + * doc/ttk_panedwindow.n, library/ttk/panedwindow.tcl: Changed + documentation of ttk::panedwindow 'identify' command to match + implementation. + + * generic/ttk/ttkNotebook.c, tests/ttk/notebook.test: + BUGFIX: ttk::noteboook 'insert' command didn't correctly maintain + current tab. + +2007-06-09 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXColor.c: Fix issues with TK_{IF,ELSE,ENDIF} macros; + * macosx/tkMacOSXDraw.c: implement Jaguar equivalent of unavailable + * macosx/tkMacOSXEntry.c: kHIToolboxVersion global; panic at startup + * macosx/tkMacOSXEvent.c: if MAC_OS_X_VERSION_MIN_REQUIRED constraint + * macosx/tkMacOSXInit.c: is not satisfied. + * macosx/tkMacOSXInt.h: + * macosx/tkMacOSXWm.c: + + * macosx/tkMacOSXDraw.c (XCopyArea, XCopyPlane, TkPutImage) + (TkMacOSXSetupDrawingContext): Factor out common code and standardize + setup/restore of port, context and clipping; formatting cleanup. + + * macosx/tkMacOSXWindowEvent.c: Add error checking. + * macosx/tkMacOSXMenu.c: Fix gcc3 warning. + * macosx/tkMacOSXScrlbr.c: Fix testsuite crash. + * macosx/tkMacOSXSubwindows.c: Formatting cleanup. + * macosx/tkMacOSXRegion.c: Fix typos. + * macosx/tkMacOSXScale.c: + + * macosx/tkMacOSXXStubs.c (Tk_GetUserInactiveTime): Remove superfluous + CFRetain/CFRelease. + + * macosx/Wish-Release.xcconfig: Disable tktest release build stripping. + + * macosx/Wish.xcodeproj/project.pbxproj: Add new Tclsh-Info.plist.in. + +2007-06-06 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXInt.h: Use native debug message API when available. + * macosx/Wish-Debug.xcconfig: + + * macosx/tkMacOSXMouseEvent.c (GenerateMouseWheelEvent): Enable + processing of mousewheel events in background windows. + + * macosx/tkMacOSXScrlbr.c: Modernize checks for active/front window. + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXWm.c: + + * macosx/tkMacOSXColor.c: Factor out verbose #ifdef checks of + * macosx/tkMacOSXDraw.c: MAC_OS_X_VERSION_{MAX_ALLOWED,MIN_REQUIRED} + * macosx/tkMacOSXEntry.c: and runtime checks of kHIToolboxVersion into + * macosx/tkMacOSXEvent.c: new TK_{IF,ELSE,ENDIF}_MAC_OS_X macros. + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXInt.h: + * macosx/tkMacOSXWm.c: + + * macosx/tkMacOSXDraw.c: Factor out clip clearing in QD ports; + * macosx/tkMacOSXEntry.c: Formatting cleanup. + + * macosx/Wish.xcodeproj/project.pbxproj: Add settings for Fix&Continue. + + * unix/configure.in (Darwin): Link the Tk and Wish plists into their + binaries in all cases; fix 64bit arch removal in fat 32&64bit builds. + + * unix/tcl.m4 (Darwin): Fix CF checks in fat 32&64bit builds. + * unix/configure: autoconf-2.59 + +2007-06-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * doc/photo.n: Clarified the fact that base64 support for the -data + option is not universal. [Bug 1731348] (matzek) + +2007-06-03 Daniel Steffen <das@users.sourceforge.net> + + * unix/Makefile.in: Add datarootdir to silence autoconf-2.6x warning. + + * macosx/Wish.xcodeproj/default.pbxuser: Add ttk tests. + + * macosx/tkMacOSXMenu.c: Add error checking; whitespace cleanup. + + * macosx/tkMacOSXDraw.c: Comment formatting fixes for Xcode 3.0 + * macosx/tkMacOSXEmbed.c: + * macosx/tkMacOSXEntry.c: + * macosx/tkMacOSXFont.c: + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXKeyEvent.c: + * macosx/tkMacOSXKeyboard.c: + * macosx/tkMacOSXMenus.c: + * macosx/tkMacOSXSend.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXXStubs.c: + +2007-06-02 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXMenu.c (TkpPostMenu): Ensure cascade menus display in + posted menus that are not part of the menubar or attached to a + menubutton (fixes bug reported on tcl-mac by Linus Nyberg). + +2007-05-31 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWindowEvent.c (GenerateUpdateEvent): Complete all + pending idle-time redraws before newly posted Expose events are + processed; add bounds of redrawn windows to update region to ensure + all child windows overdrawn by parents are redrawn. + + * macosx/tkMacOSXWindowEvent.c: Centralize clip and window invalidation + * macosx/tkMacOSXSubwindows.c: after location/size changes in the + * macosx/tkMacOSXWm.c: BoundsChanged carbon event handler; + correct/add window invalidation after window attribute changes. + + * macosx/tkMacOSXSubwindows.c (XResizeWindow, XMoveResizeWindow) + (XMoveWindow): Factor out common code dealing with embedded and + non-toplevel windows; remove unnecessary clip and window invalidation. + + * macosx/tkMacOSXButton.c (TkpDisplayButton): Move clip setup closer + to native button drawing calls. + + * macosx/tkMacOSXWm.c (TkMacOSXIsWindowZoomed, TkMacOSXZoomToplevel): + Correct handling of gridded windows in max size calculations. + + * macosx/tkMacOSXEvent.c (TkMacOSXFlushWindows): Use HIWindowFlush API + when available. + + * macosx/tkMacOSXColor.c: Cleanup whitespace and formatting. + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWm.c: + + * generic/tkFont.c: #ifdef out debug msg printing to stderr. + * generic/tkTextDisp.c: + +2007-05-30 Don Porter <dgp@users.sourceforge.net> + + * generic/tk.h: Correct placement of #include <tcl.h>. [Bug 1723812] + +2007-05-30 Daniel Steffen <das@users.sourceforge.net> + + * library/bgerror.tcl: Standardize dialog option & button size + * library/dialog.tcl: modifications done when running on on Aqua. + * library/msgbox.tcl: + + * library/demos/button.tcl: Set button highlightbackground on Aqua. + + * macosx/tkMacOSXMenu.c (DrawMenuSeparator): Use DrawingContext API. + + * macosx/tkMacOSXWindowEvent.c (ClearPort): Clip to updateRgn. + + * macosx/tkMacOSXDebug.c: Factor out debug region flashing. + * macosx/tkMacOSXDebug.h: + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWindowEvent.c: + + * macosx/tkMacOSXEvent.c: Cleanup whitespace and formatting. + * macosx/tkMacOSXFont.c: + * macosx/tkMacOSXRegion.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXXStubs.c: + * xlib/xgc.c: + + * macosx/Wish.xcodeproj/project.pbxproj: Delete references to removed + * macosx/Wish.xcodeproj/default.pbxuser: ttk files. + +2007-05-28 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> + + * macosx/tkMacOSXFont.c (TkpMeasureCharsInContext): Fix short measures + with flags=TK_WHOLE_WORDS|TK_AT_LEAST_ONE [Bug 1716141]. Make some + casts unnecessary by changing variable types. + +2007-05-25 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/ttk.tcl: Omit ttk::dialog and dependencies. + * library/ttk/dialog.tcl, library/ttk/icons.tcl, + * library/ttk/keynav.tcl: Removed. + * tests/ttk/misc.test: Removed. + * doc/ttk_dialog.tcl: Removed. + +2007-05-25 Donal K. Fellows <dkf@users.sf.net> + + * doc/canvas.n: Fixed documentation of default -joinstyle option + values for line and polygon items. [Bug 1725782] + +2007-05-22 Don Porter <dgp@users.sourceforge.net> + + [core-stabilizer-branch] + + * unix/configure: autoconf-2.59 (FC6 fork) + * win/configure: + + * README: Bump version number to 8.5b1 + * generic/tk.h: + * library/tk.tcl: + * unix/configure.in: + * unix/tk.spec: + * win/configure.in: + +2007-05-18 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkEntry.c(EntrySetValue): Ensure that widget is in a + consistent state before setting the linked -textvariable. Previously, + it was possible for [$e index insert] to point past the end of the + string, leading to heap corruption. [Bug 1721532] + * tests/ttk/entry.test(entry-9.1): Add test case for the above. + +2007-05-18 Don Porter <dgp@users.sourceforge.net> + + * unix/configure: autoconf-2.59 (FC6 fork) + * win/configure: + + * README: Bump version number to 8.5a7 + * generic/tk.h: + * library/tk.tcl: + * unix/configure.in: + * unix/tk.spec: + * win/configure.in: + + * tests/ttk/treetags.test: Another bit of test suite + SCIM-tolerance. [Bug 1609316] + +2007-05-17 Daniel Steffen <das@users.sourceforge.net> + + * generic/tk.decls: Workaround 'make checkstubs' failures from + tkStubLib.c MODULE_SCOPE revert. [Bug 1716117] + + * macosx/Wish.xcodeproj/project.pbxproj: Add tkOldTest.c and remove + tkStubImg.c. + +2007-05-16 Joe English <jenglish@users.sourceforge.net> + + * generic/tkStubLib.c: Change Tk_InitStubs(), tkStubsPtr, and the + auxilliary stubs table pointers back to public visibility. See [Bug + 1716117] for details. + + Removed TCL_STORAGE_CLASS monkey business, as it had no effect. + +2007-05-16 Don Porter <dgp@users.sourceforge.net> + + * library/choosedir.tcl: Removed uses of obsolete {expand} + * library/comdlg.tcl: syntax; replaced with the now + * library/tk.tcl: approved {*}. [Bug 1710633] + * tests/canvImg.test: + * tests/imgPhoto.test: + + * tests/bind.test: Make test suite more SCIM-tolerant. [Bug 1609316] + +2007-05-16 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/makefile.vc: Test ttk widgets. + +2007-05-15 Joe English <jenglish@users.sourceforge.net> + + * unix/tkUnixRFont.c: Fix crash introduced by previous fix exposed + under newer fontconfig libraries [Bug 1717830] again. + +2007-05-15 Don Porter <dgp@users.sourceforge.net> + + * generic/tkGrid.c: Stop crash due to list intrep shimmer [Bug 1677608] + +2007-05-15 Joe English <jenglish@users.sourceforge.net> + + * unix/tkUnixRFont.c: Fix various memory leaks. [Bug 1717830], [Bug + 800149] + +2007-05-14 Don Porter <dgp@users.sourceforge.net> + + [Tk Bug 1712081] + + * unix/Makefile.in: Updates to account for new and deleted files + * win/Makefile.in: tkStubImg.c and tkOldTest.c. + * win/makefile.bc: + * win/makefile.vc: + + * generic/tkOldTest.c (new): New file used to create testing + * generic/tkTest.c: commands for testing various Tk + * tests/constraints.tcl: legacy interfaces where a separate + * tests/image.test: compilation unit is needed in order to + #define suitable macros during compilation. Only the effect of + USE_OLD_IMAGE on Tk_CreateImageType() is currently tested, but more + similar testing commands can be added to this same file. New + constraint defined to detect presence of the image type provided by + the new testing code, and a few tests added to exercise it. Having + USE_OLD_IMAGE support tested by the default test suite should reduce + chance of a recurrence of this bug. + + * doc/CrtImgType.3: Revised docs to better indicate the legacy + * doc/CrtPhImgFmt.3: nature of the interfaces supported by + USE_OLD_IMAGE. + + * generic/tkDecls.h: make genstubs + * generic/tkStubInit.c: + + * generic/tk.decls: Reworked USE_OLD_IMAGE support to use + * generic/tk.h: the same support mechanisms both with + * generic/tkStubImg.c (deleted):and without a stub-enabled build. In + each case, route the legacy calls to Tk_CreateImageType and + Tk_CreatePhotoImageFormat through the Tk_CreateOldImageType and + Tk_CreateOldPhotoImageFormat routines. Add those routines to the + public stub table so they're available to a stub-enabled extension. + Remove the definition of Tk_InitImageArgs() and use a macro to convert + any calls to it in source code into a comment. + + * generic/tkImage.c: Removed the MODULE_SCOPE declarations that + * generic/tkImgPhoto.c: broke USE_OLD_IMAGE support. + +2007-05-11 Pat Thoyts <patthoyts@users.sourceforge.net> + + * tests/winButton.test: Avoid font dependencies in results. + + * generic/tkFont.c: propagate error from TkDeleteNamedFont. [Bug + 1716613] + +2007-05-09 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkFileFilter.c (AddClause): OSType endianness fixes. + + * library/palette.tcl (tk::RecolorTree): Handle color options with + empty value, fixes error due to emtpy -selectforeground (reported on + tcl-mac by Russel E. Owen). + + * macosx/tkMacOSXWindowEvent.c: Ensure window is brought to the front + * macosx/tkMacOSXMouseEvent.c: at the start of a window drag (except + * macosx/tkMacOSXInt.h: when cmd key is down); formatting and + whitespace fixes. + + * macosx/tkMacOSXDialog.c (Tk_GetSaveFileObjCmd): Add -filetypes option + processing (fixes fileDialog-0.1, fileDialog-0.2 failures). + + * macosx/tkMacOSXEmbed.c (TkpMakeWindow, TkpUseWindow): Fix sending of + Visibility event for embedded windows (fixes frame-3.9 hang). + + * macosx/tkMacOSXScrlbr.c (ScrollbarBindProc): Fix testsuite + * macosx/tkMacOSXSubwindows.c (TkMacOSXUpdateClipRgn): crashes by + adding sanity checks. + + * macosx/Wish.xcodeproj/project.pbxproj: Add 'DebugUnthreaded' & + * macosx/Wish.xcodeproj/default.pbxuser: 'DebugLeaks' targets and env + var settings needed to run the 'leaks' tool. + + * macosx/tkMacOSXButton.c: Fix debug msg typo. + + * tests/constraints.tcl: Ensure 'nonUnixUserInteraction' constraint is + set for aqua. + + * tests/choosedir.test: Add 'notAqua' constraints to X11-only tests; + * tests/clrpick.test: add 'nonUnixUserInteraction' to 'unix' tests + * tests/menuDraw.test: requiring interaction on aqua. + * tests/unixMenu.test: + * tests/unixWm.test: + * tests/winMenu.test: + +2007-05-07 Joe English <jenglish@users.sourceforge.net> + + * unix/tkUnixRFont.c: Properly cast sentinel arguments to variadic + function (fixes "warning: missing sentinel in function call", [Bug + 1712001]) + +2007-05-04 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/tkFont.c: TIP #145 implementation - + * generic/tkFont.h: Enhanced font handling. + * win/tkWinDefault.h: + * win/tkWinFont.c: + * win/tkWinInt.h: + * win/tkWinWm.c: + * library/demos/widget: + * library/ttk/fonts.tcl: + +2007-05-04 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * doc/ttk_treeview.n, doc/ttk_panedwindow.n, doc/ttk_dialog.n: + * doc/ttk_checkbutton.n, doc/tk.n, doc/menu.n, doc/font.n: + * doc/canvas.n: Spelling fixes. [Bug 1686210] + +2007-05-03 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tkStubLib.c (Tk_InitStubs): + * generic/ttk/ttkLabel.c (LabelSetup): + * unix/tkUnixSelect.c (ConvertSelection): + * unix/tkUnixEvent.c (TkUnixDoOneXEvent): + * generic/tkConfig.c (Tk_RestoreSavedOptions): + * generic/tkCanvPs.c (TkCanvPostscriptCmd): + * generic/tkOption.c (GetDefaultOptions): + * unix/tkUnixRFont.c (TkpGetFontAttrsForChar, InitFont) + (TkpGetFontFamilies, TkpGetSubFonts): + * unix/tkUnixSend.c (TkpTestsendCmd, RegOpen): Squelch warnings from + GCC type aliasing. [Bug 1711985 and others] + +2007-04-29 Daniel Steffen <das@users.sourceforge.net> + + * unix/configure.in: Fix for default case in tk debug build detection. + * unix/configure: autoconf-2.59 + +2007-04-27 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTreeview.c(TagOptionSpecs): Use TK_OPTION_STRING + instead of TK_OPTION_FONT to avoid resource leak in tag management. + +2007-04-26 Joe English <jenglish@users.sourceforge.net> + + * macosx/ttkMacOSXTheme.c: Merged OFFSET_RECT processing into + BoxToRect(); factored out PatternOrigin; resynchronized with Tile + codebase. + +2007-04-26 Jeff Hobbs <jeffh@ActiveState.com> + + *** 8.5a6 TAGGED FOR RELEASE *** + + * unix/Makefile.in (dist): Correct tests/ttk glob inclusion + +2007-04-25 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/Makefile.in (dist): Add tests/ttk dir to src dist + + * unix/tkUnixMenubu.c (TkpDisplayMenuButton): Init width/height to 0 + +2007-04-25 Daniel Steffen <das@users.sourceforge.net> + + * unix/Makefile.in (dist): Add macosx/*.xcconfig files to src dist; + copy license.terms to dist macosx dir; fix autoheader bits. + +2007-04-24 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/Makefile.in (dist): Add ttk bits to src dist + + * tests/font.test (font-46.[12]): Correct listification of result + +2007-04-23 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkCanvas.c: Allow -selectforeground option to be None; add + * generic/tkCanvText.c: fallback to fgColor when selFgColor is None + * generic/tkEntry.c: (new default on aqua to match native L&F). + * generic/tkListbox.c: + * generic/tkText.c: + + * generic/tkCanvas.c: Add support for bypassing all of Tk's double + * generic/tkEntry.c: buffered drawing into intermediate pixmaps + * generic/tkFrame.c: (via TK_NO_DOUBLE_BUFFERING #define), it is + * generic/tkListbox.c: unnecessary & wasteful on aqua where all + * generic/tkPanedWindow.c: drawing is already double-buffered by the + * generic/tkTextDisp.c: window server. (Use of this on other + * generic/ttk/ttkWidget.c: platforms would only require implementation + * unix/tkUnixScale.c: of TkpClipDrawableToRect()). + * macosx/tkMacOSXPort.h: + + * library/bgerror.tcl: On aqua, use moveable alert resp. modal dialog + * library/dialog.tcl: window class and corresponding system + background pattern; fix button padding. + + * library/tearoff.tcl: Correct aqua menu bar height; vertically offset + * library/tk.tcl: aqua tearoff floating window to match menu. + + * library/demos/goldberg.tcl: Fix overwriting of widget demo global. + + * library/demos/menu.tcl: On aqua, use custom MDEF and tearoffs; + * library/demos/menubu.tcl: correct menubutton toplevel name. + + * library/demos/puzzle.tcl: Fix button size & padding for aqua. + * library/demos/radio.tcl: + + * macosx/tkMacOSXCarbonEvents.c: Add window event target carbon event + * macosx/tkMacOSXEvent.c: handler for all kEventClassWindow and + * macosx/tkMacOSXEvent.h: kEventClassMouse events; move all + * macosx/tkMacOSXNotify.c: remaining events except for + * macosx/tkMacOSXWindowEvent.c: kEventClassKeyboard from dispatcher to + application event handler; pass event handler callRef downstream; fix + debug event tracing; process all tcl event types in carbon event timer; + delay carbon event timer first fire; add TkMacOSXTrackingLoop() to mark + enter/exit of event tracking loop during which all tcl events but only + carbon update events should be processed by the timer (replaces various + calls to Tcl_SetServiceMode()); rename TkMacOSXReceiveAndProcessEvent() + to TkMacOSXReceiveAndDispatchEvent(), move it from tkMacOSXEvent.c to + tkMacOSXCarbonEvents.c and modify it to dequeue only update events + during a tracking loop; add TkMacOSXRunTclEventLoop() to standardize + the various ways in use to run the tcl event loop; add handling of + kEventClassAppearance events (for ScrollBarVariantChanged event). + + * macosx/tkMacOSXDialog.c: Use new TkMacOSXTrackingLoop() around + * macosx/tkMacOSXEvent.c: blocking API that puts up modal dialogs + * macosx/tkMacOSXMenu.c: or when entering/exiting menu/control + * macosx/tkMacOSXMouseEvent.c: tracking, window dragging and other + * macosx/tkMacOSXScale.c: mouse tracking loops. + * macosx/tkMacOSXScrlbr.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + + * macosx/tkMacOSXDialog.c: Use new TkMacOSXRunTclEventLoop() + * macosx/tkMacOSXScale.c: instead of Tcl_DoOneEvent(), + * macosx/tkMacOSXScrlbr.c: Tcl_ServiceAll(), TclServiceIdle() + * macosx/tkMacOSXWindowEvent.c: and Tcl_GlobalEval("update idletasks"). + + * macosx/tkMacOSXColor.c: Make available as Tk system colors all + * macosx/tkMacOSXPort.h: appearance manager brushes, text colors and + backgrounds with new and legacy names, as well as the fully transparent + color "systemTransparent"; add TkMacOSXSetColorIn{Port,Context}() to + directly set an X pixel color value in the current QD port resp. the + given CG context without requiring passage through rgb representation + (lossy for most system colors); modernize/remove Classic-era code; + replace crufty strcmp() elseifs by Tcl_GetIndexFromObjStruct(). + + * macosx/tkMacOSXButton.c: Use new TkMacOSXSetColorInPort() + * macosx/tkMacOSXDraw.c: instead of setting rgb color directly + * macosx/tkMacOSXMenubutton.c: to allow for non-rgb system colors. + + * macosx/tkMacOSXCursor.c: Implement "none" cursor as on other + platforms [Patch 1615427]; add all missing appearance manager cursors. + + * macosx/tkMacOSXDefault.h: Set SELECT_FG_COLORs to None to match aqua + L&F; use standard system color names; use new 'menu' system font; + correct default scrollbar width. + + * macosx/tkMacOSXDraw.c: Standardize initialization, use and + * macosx/tkMacOSXInt.h: emptying of various static temp rgns + * macosx/tkMacOSXRegion.c: onto two global RgnHandles; in debug + * macosx/tkMacOSXSubwindows.c: builds, verify emptiness of these temp + * macosx/tkMacOSXWindowEvent.c: rgns before use. + + * macosx/tkMacOSXDraw.c: Add TkMacOSX{Setup,Restore}DrawingContext() to + * macosx/tkMacOSXInt.h: abstract common setup & teardown of drawing + environment (for both CG and QD); save/restore QD theme drawing state; + handle GC clip region; add TkpClipDrawableToRect() to allow clipped + drawing into drawable regardless of GC used; use new system color + "systemWindowHeaderBackground" to setup background in themed toplevels; + correct implementation of TkMacOSXMakeStippleMap(). + + * macosx/tkMacOSXEntry.c: Use new TkMacOSXSetupDrawingContext() and + * macosx/tkMacOSXFont.c: TkMacOSXRestoreDrawingContext() instead of + * macosx/ttkMacOSXTheme.c: various setup/teardown procs like + TkMacOSX{SetUp,Release}CGContext(), TkMacOSXQuarz{Start,End}Draw(), + TkMacOSXSetUpGraphicsPort() etc. + + * macosx/tkMacOSXEmbed.c: Add CG context and drawable clip rgn fields + * macosx/tkMacOSXInt.h: to MacDrawable struct. + * macosx/tkMacOSXSubwindows.c: + + * macosx/tkMacOSXDialog.c: Make -parent option of tk_getOpenFile et al. + use the sheet version of NavServices dialogs; ensure native parent win + exists before using StandardSheet API for tk_messageBox [Bug 1677611]; + force sheets to behave like app-modal dialogs via WindowModality() API; + use more modern ColorPicker API. + + * macosx/tkAboutDlg.r: Use themed movable modal dialog, fix (c) year. + + * macosx/tkMacOSXEntry.c: Take xOff/yOff of MacDrawable into account + * macosx/ttkMacOSXTheme.c: when computing locations/bounds to ensure + correct posititioning when not drawing into intermediate pixmap. + + * macosx/tkMacOSXFont.c: Use appearance manager API to map system font + * macosx/tkMacOSXFont.h: names to TkFonts; add "menu" system font for + menu item text drawing from MDEF; always draw with CG; remove QD + dependent stippling algorithm; move most header declarations into the + source file (as they were not used anywhere else). + + * macosx/tkMacOSXMenu.c: Large-scale rewrite of custom + * macosx/tkMacOSXMenu.r (removed): MDEF and related code that + * macosx/Wish.xcode/project.pbxproj: restores many longtime-MIA + * macosx/Wish.xcodeproj/project.pbxproj: features to working order + * unix/Makefile.in: (e.g. images, custom colors & + fonts in menus etc); implement compound menu items; use Appearance Mgr + and ThemeText APIs to mimic native MDEF as closely as possible when + default "menu" system font is used; remove now obsolete SICN drawing + code and resources. + + * macosx/tkMacOSXCarbonEvents.c: Handle additional menu carbon events + * macosx/tkMacOSXEvent.c: in order to support <<MenuSelect>> in + * macosx/tkMacOSXMenu.c: the menubar and in menus that are not + * macosx/tkMacOSXMenus.c: using the custom MDEF [Bug 1620826]; + fix early and missing clearing of current Tk active menu entry; fix + extraneous sending of <<MenuSelect>> during active menu entry clearing. + + * macosx/tkMacOSXMouseEvent.c: Add support for async window dragging by + the window server; set the corresponding window attribute by default. + + * macosx/tkMacOSXMouseEvent.c: Rationalized handling order of + non-mousedown events; add TkMacOSXModifierState() to retrieve the + current key modifiers in carbon format. + + * macosx/tkMacOSXScrlbr.c: Use appearance manager API to retrieve + scrollbar component metrics; add awareness of multiple possibilites for + scrollbar arrow position in aqua and handle user changes to arrow + position pref; handle difference in metrics of small & large scrollbar + variants; handle aqua "jump to here" scrollbar behaviour; correct + computation of scroll view size and position; enforce min scrollbar + height to avoid scrollbar component overlap; erase scrollbar area + outside of standard width; remove broken auto-adjust code; account for + window class when leaving space for grow box; remove code to manually + draw grow box; use modern API for thumb scroll proc; replace + HiliteControl() by modern API; replace control mgr constants with + appearance mgr equivalents. + + * macosx/tkMacOSXSubwindows.c: Use SetWindowBounds() API instead of + SizeWindow(); invalidate clip regions after X{Map,Unmap}Window as fix + for [Bug 940117] made them dependent on mapping state; remove unneeded + calls to TkMacOSXInvalClipRgns() and unnecessary setting of QD port; + use native-endian pixmap on intel; remove obsolete pixmap pix locking. + + * macosx/tkMacOSXWindowEvent.c: Handle only the first of a batch of + kEventAppAvailableWindowBoundsChanged events sent per transaction; + handle kEventWindowBoundsChanged event to support live window resizing + and centralized sending of location/size changed ConfigureNotify + events; ensure HIGrowBox is redrawn after bounds change; constrain + window after dragging to ensure titlebar is not inacessible + offscreen or under dock/menubar; handle kEventWindowGetRegion and + kEventWindowDrawContent for transparent windows to mark resp. paint + content region as transparent; handle kEventWindowConstrain for + fullscreen windows to ensure bounds match new screen size; enter/exit + fullscreen UIMode upon activation/deactivation of fullscreen window. + + * macosx/tkMacOSXWm.c: Use live-resize and async-drag carbon window + * macosx/tkMacOSXWm.h: attributes for toplevels by default; implement + new [wm attributes] -topmost, -transparent and -fullscreen; refactor + WmAttributesCmd() parallelling the tkUnixWm.c implementation, use thus + factored proc to set proxy icon from [wm iconbitmap]; dynamically + determine default values for toplevel min and max sizes (similar to + tkWinWm.c impl): min sizes depend on window class & attributes to + ensure visibility of all titlebar widgets and grow box, max sizes + depend on maximal window bounds for all active displays; factor out + code that puts into effect changes to master or override_redirect; use + RepositionWindow() API to determine staggered initial window bounds; + correct resize limit calculations, handle gridding and use modern + resize API in TkMacOSXGrowToplevel(); remove sending of ConfigureNotify + after resize or zoom (now handled by BoundsChanged handler); correct + composite carbon window attribute handling, remove currently unusable + attributes and add new attributes in [tk::unsupported::MacWindowStyle]; + ensure validity of window class and attributes before use; apply + changes to window class when handling carbon window attribute changes + (if HIWindowChangeClass() API available); add debug build warning + message when deprecated window style is used instead of window class; + use transparent HIGrowBox for resizable windows; avoid unnecessary + calls to window structure width API; use tcl time API in TkpGetMS(); + add TkMacOSXEnterExitFullscreen() to enter/exit UIMode with dock and + menubar hidden; restrict wmTracing output to debug builds; remove + unneeded calls to TkMacOSXInvalClipRgns() and unnecessary setting of QD + port; workaround GetWindowStructureWidths() Carbon bug (bogus results + for never-mapped floating windows). + + * macosx/tkMacOSXXStubs.c (TkMacOSXDisplayChanged): Add maximal window + bounds field to Screen record (in ext_data), computed as the union of + available window positioning bounds of all graphics devices (displays). + + * macosx/tkMacOSXBitmap.c: Fix macRoman encoding leak. + * macosx/tkMacOSXCursor.c: + + * macosx/tkMacOSXDebug.c (TkMacOSXCarbonEventToAscii): Use static + * macosx/tkMacOSXDebug.h: buffer to simplify callers; const fixes. + + * macosx/tkMacOSXBitmap.c: Use more efficient QDSwapPort() instead of + * macosx/tkMacOSXButton.c: GetPort()/SetPort()/GetGWorld()/SetGWorld(). + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXScrlbr.c: + * macosx/tkMacOSXXStubs.c: + + * macosx/tkMacOSXColor.c: Use kHIToolboxVersionNumber for runtime OS + * macosx/tkMacOSXEntry.c: version check rather than Gestalt() etc. + * macosx/tkMacOSXInt.h: + * macosx/tkMacOSXWm.c: + + * macosx/tkMacOSXDraw.c: Remove obsolete and now incorrect + * macosx/tkMacOSXInt.h: tkMenuCascadeRgn clipping code. + * macosx/tkMacOSXMenu.c: + + * macosx/tkMacOSXHLEvents.c: Replace Tcl_GlobalEval() resp. Tcl_Eval() + * macosx/tkMacOSXScrlbr.c: by Tcl_EvalEx(). + * macosx/tkMacOSXInit.c: + + * macosx/tkMacOSXInit.c (TkpInit): Reorder initialization steps. + + * macosx/tkMacOSXKeyEvent.c: Remove pre-10.2 support. + + * macosx/tkMacOSXMenus.c: Remove now useless call to + TkMacOSXHandleTearoffMenu(); use \x.. quoting for non-latin1 macroman + literar chars to allow file to be edited as utf-8. + + * macosx/tkMacOSXScale.c: Replace TrackControl() by modern + * macosx/tkMacOSXScrlbr.c: HandleControlClick() API (using new + TkMacOSXModifierState()). + + * macosx/tkMacOSXInt.h: Move all constant #defines needed to + * macosx/tkMacOSXColor.c: support building on older OS X releases + * macosx/tkMacOSXEvent.h: to a central location in tkMacOSXInt.h. + * macosx/tkMacOSXFont.c: + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXMenus.c: + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXWm.c: + * macosx/ttkMacOSXTheme.c: + + * macosx/tkMacOSXInt.h: Add ChkErr() macro to factor out + * macosx/tkMacOSXButton.c: Carbon OSStatus return value checking + * macosx/tkMacOSXCarbonEvents.c: and TkMacOSXDbgMsg() macro to factour + * macosx/tkMacOSXClipboard.c: out debug message output; use these + * macosx/tkMacOSXColor.c: macros to replace #ifdef TK_MAC_DEBUG + * macosx/tkMacOSXCursor.c: blocks & direct printing to stderr, + * macosx/tkMacOSXDebug.c: and to do additional OSStatus return + * macosx/tkMacOSXDialog.c: checking, and to standardize OSStatus + * macosx/tkMacOSXDraw.c: usage. + * macosx/tkMacOSXEntry.c: + * macosx/tkMacOSXEvent.c: + * macosx/tkMacOSXFont.c: + * macosx/tkMacOSXHLEvents.c: + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXKeyEvent.c: + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXMenus.c: + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXScrlbr.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXXStubs.c: + + * macosx/tkMacOSXSend.c: Remove duplicate/unused declarations. + * macosx/tkMacOSXXStubs.c: + + * macosx/tkMacOSXDebug.c: Const fixes. + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXTest.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXXStubs.c: + + * macosx/Wish-Info.plist.in: Add tcl document extensions/mime types and + LSMinimumSystemVersion, LSRequiresCarbon & NSAppleScriptEnabled keys. + + * macosx/Wish-Common.xcconfig: Add Wish's Info.plist as __info_plist + section to tktest; enable more warnings. + + * macosx/Wish.xcodeproj/project.pbxproj: Add 'DebugMemCompile' build + configuration that calls configure with --enable-symbols=all; disable + configure check for __attribute__((__visibility__("hidden"))) in Debug + configuration to restore availability of ZeroLink. + + * macosx/Wish-Common.xcconfig: Fix whitespace. + * macosx/Wish-Debug.xcconfig: + * macosx/Wish-Release.xcconfig: + * macosx/tkMacOSXAETE.r: + * macosx/tkMacOSXConfig.c: + * macosx/tkMacOSXCursors.r: + * macosx/tkMacOSXKeyboard.c: + * macosx/tkMacOSXSend.c: + * macosx/ttkMacOSXTheme.c: + * macosx/tkMacOSXXCursors.r: + * macosx/README: + + * macosx/GNUmakefile: Fix/add copyright and license refs. + * macosx/Tk-Info.plist.in: + * macosx/Wish-Info.plist.in: + * macosx/Wish.xcode/project.pbxproj: + * macosx/Wish.xcodeproj/project.pbxproj: + * macosx/tkMacOSX.h: + + * unix/configure.in: Install license.terms into Tk.framework; fix tk + debug build detection. + * unix/configure: autoconf-2.59 + + * doc/colors.n: Document new Mac OS X system colors. + * doc/cursors.n: Document new Mac OS X native cursors. + * doc/font.n: Document new Mac OS X 'menu' system font. + * doc/wm.n: Document new Mac OS X [wm attributes]. + * doc/ttk_image.n: Fix 'make html' warning. + * doc/canvas.n: Fix nroff typo. + +2007-04-21 Jeff Hobbs <jeffh@ActiveState.com> + + * macosx/tkMacOSXBitmap.c, macosx/tkMacOSXButton.c: + * macosx/tkMacOSXCarbonEvents.c, macosx/tkMacOSXClipboard.c: + * macosx/tkMacOSXCursor.c, macosx/tkMacOSXDialog.c: + * macosx/tkMacOSXDraw.c, macosx/tkMacOSXEvent.c: + * macosx/tkMacOSXFont.c, macosx/tkMacOSXInit.c, macosx/tkMacOSXInt.h: + * macosx/tkMacOSXKeyEvent.c, macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenubutton.c, macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXScale.c, macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: Revert of commits from 2007-04-13 which broke + the OS X build. + +2007-04-17 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkFont.c, generic/tkListbox.c, unix/tkUnixSelect.c: + * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: Make + the format of declarations much more standardized (removing K&R-isms + and other things like that). + +2007-04-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * macosx/tkMacOSXInt.h (LOG_MSG, LOG_ON_ERROR): Added macros to make + the OSX code much less #ifdef-full. + +2007-04-12 Jeff Hobbs <jeffh@ActiveState.com> + + * library/ttk/panedwindow.tcl (ttk::panedwindow::Press): handle Press + triggering outside sash element boundaries. + +2007-04-10 Joe English <jenglish@users.sourceforge.net> + + * win/ttkWinMonitor.c, win/ttkWinXPTheme.c: Re-sync with Tile codebase + so patches can flow back and forth. + + * win/ttkWinXPTheme.c: Skip OS version test, should work on Vista/Aero + now as well as XP. Fixes [Bug 1687299], thanks to George Petasis for + tracking this down. + +2007-03-21 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkLayout.c(Ttk_BuildLayoutTemplate): BUGFIX: Nested + TTK_GROUP nodes did not work unless they appeared at the end of the + layout (and only by accident then). + +2007-03-08 Joe English <jenglish@users.sourceforge.net> + + * tests/grid.test(grid-21.7): Reset wm geometry . and pack propagate . + at end of test. 'pack propagate . 0' was causing cascading failures in + subsequent tests. [Bug 1676770] + +2007-03-07 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkMain.c (Tk_MainEx): Replicate macosx-specific code from + TkpInit() that ensures the console window appears when wish is started + from the OS X Finder (i.e. with stdin == /dev/null), jeffh's 2006-11-24 + change rendered the corresponding code in TkpInit() ineffective in wish + because Tk_MainEx() sets tcl_interactive before calling TkpInit(). + + * generic/ttk/ttkGenStubs.tcl (new): Add ttk-specific genstubs.tcl from + * unix/Makefile.in (genstubs): tile and run it from 'genstubs' + target, restores ability to generate all of Tk's stub sources. + + * generic/ttk/ttkTreeview.c: #ifdef out unused declaration. + + * macosx/tkMacOSXDebug.c (TkMacOSXGetNamedDebugSymbol): Add fix for + libraries loaded with a DYLD_IMAGE_SUFFIX. + + * macosx/Wish.xcodeproj/project.pbxproj: Ensure gcc version used by + * macosx/Wish.xcodeproj/default.pbxuser: Xcode and configure/make are + * macosx/Wish-Common.xcconfig: consistent and independent of + gcc_select default and CC env var; fixes for Xcode 3.0. + + * unix/tcl.m4 (Darwin): s/CFLAGS/CPPFLAGS/ in macosx-version-min check. + * unix/configure: autoconf-2.59 + +2007-02-25 Peter Spjuth <peter.spjuth@space.se> + + * generic/tkUtil.c: Fixed grid anchor center problem in labelframes. + * tests/grid.test: [Bug 1545765] + +2007-02-23 Jeff Hobbs <jeffh@ActiveState.com> + + * library/ttk/notebook.tcl (ttk::notebook::enableTraversal): OS X + needs Option instead of Alt binding + +2007-02-19 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/tcl.m4: use SHLIB_SUFFIX=".so" on HP-UX ia64 arch. + * unix/configure: autoconf-2.59 + + * library/tkfbox.tcl (::tk::IconList_Goto): avoid goto issues in empty + dirs. [Bug 1662959] + +2007-02-09 Joe Mistachkin <joe@mistachkin.com> + + * win/nmakehlp.c: Properly cleanup after nmakehlp, including the + * win/makefile.vc: vcX0.pch file. Sync up fixed nmakehlp usage from + Tcl. + +2007-02-06 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/ttk.tcl: Add no-op [package ifneeded] script for tile + 0.8.0, so that existing applications that use "package require tile" + won't fail when run under Tk 8.5. + +2007-02-04 Daniel Steffen <das@users.sourceforge.net> + + * unix/tcl.m4: Use gcc4's __attribute__((__visibility__("hidden"))) if + available to define MODULE_SCOPE effective on all platforms. + * unix/configure.in: add caching to -pipe check. + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in: autoheader-2.59 + +2007-02-03 Joe Mistachkin <joe@mistachkin.com> + + * win/rules.vc: Fix platform specific file copy macros for downlevel + Windows. + * win/ttkWinMonitor.c: Windows portability support. Fix "noxp" build + * win/ttkWinXPTheme.c: option handling and use GetWindowLongPtr and + SetWindowLongPtr only when needed. + +2007-02-02 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/ttkWinXPTheme.c: Support IsAppThemed() call. This is what is + used when theming is turned off just for an individual application. + +2007-01-28 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Wish.xcodeproj/project.pbxproj: Extract build settings that + * macosx/Wish.xcodeproj/default.pbxuser: were common to multiple + * macosx/Wish-Common.xcconfig (new file): configurations into external + * macosx/Wish-Debug.xcconfig (new file): xcconfig files; add extra + * macosx/Wish-Release.xcconfig (new file): configurations for building + with SDKs; convert legacy jam-based 'Tk' target to native target with + single script phase; correct syntax of build setting references to use + $() throughout; remove unused tcltest sources from 'tktest' target. + + * macosx/README: Document new Wish.xcodeproj configurations; other + minor updates/corrections. + + * generic/tk.h: Update location of version numbers in macosx files. + + * macosx/Wish.xcode/project.pbxproj: Restore 'tktest' target to working + * macosx/Wish.xcode/default.pbxuser: order by replicating applicable + changes to Wish.xcodeproj since 2006-07-20. + +2007-01-25 Daniel Steffen <das@users.sourceforge.net> + + * unix/tcl.m4: Integrate CPPFLAGS into CFLAGS as late as possible and + move (rather than duplicate) -isysroot flags from CFLAGS to CPPFLAGS to + avoid errors about multiple -isysroot flags from some older gcc builds. + + * unix/configure: autoconf-2.59 + +2007-01-19 Joe Mistachkin <joe@mistachkin.com> + + * win/makefile.vc: Properly build man2tcl.c for MSVC8. + +2007-01-19 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Wish.xcodeproj/project.pbxproj: Remove libtommath defines. + + * unix/tcl.m4: Ensure CPPFLAGS env var is used when set. [Bug 1586861] + (Darwin): add -isysroot and -mmacosx-version-min flags to CPPFLAGS when + present in CFLAGS to avoid discrepancies between what headers configure + sees during preprocessing tests and compiling tests. + + * unix/configure: autoconf-2.59 + +2007-01-11 Jeff Hobbs <jeffh@activestate.com> + + * unix/tkUnixEvent.c, library/msgs/es.msg: s/CRLF/LF/g + +2007-01-11 Joe English <jenglish@users.sourceforge.net> + + * win/tcl.m4 (CFLAGS_WARNING): Remove "-Wconversion". This was removed + from unix/tcl.m4 2004-07-16 but not from here. + * win/configure: Regenerated. + +2007-01-11 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkManager.h, generic/ttk/ttk*.c: Revert addition of + contravariant 'const' qualifiers, to keep in sync with Tile codebase + (which must remain compatible with Tk 8.4). + +2007-01-03 Jan Nijtmans <nijtmans@users.sf.net> + + * doc/ManageGeom.3, + * generic/tk.decls, + * generic/tk.h: Add const to 2nd parameter of Tk_ManageGeometry + * generic/tkDecls.h: regenerated + * generic/tkInt.h, + * generic/tk*.c, + * generic/ttk/ttk*.c: Added many "const" specifiers in implementation. + +2007-01-02 Donal K. Fellows <dkf@users.sf.net> + + * xlib/*: Made the generic fake-X11 glue layer abide by the formatting + rules of the core. + +2006-12-31 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> + + * macosx/tkMacOSXFont.c: Fill-in TkpGetFontAttrsForChar (TIP #300). + * macosx/ttkMacOSXTheme.c: Define a constant to make it compile on Mac + OS X 10.3. + +2006-12-28 Mo DeJong <mdejong@users.sourceforge.net> + + * tests/wm.test: Update wm attributes output so that tests pass after + addition of -transparentcolor for Win32. + +2006-12-26 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkLabel.c: ImageElement clientData no longer needed. + +2006-12-22 Donal K. Fellows <dkf@users.sf.net> + + * unix/tkUnixEvent.c (TkUnixDoOneXEvent): Made correct on AMD64 and + other similar 64-bit systems where fd_mask is not 'unsigned int' in + effect. [Bug 1522467] + + * library/msgs/es_ES.msg (removed): + * library/msgs/es.msg: Fixed translation fault that was present in all + Spanish-speaking locales. [Bug 1111213] + +2006-12-19 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinButton.c (TkpDisplayButton): lint init. [Bug 1618604] + +2006-12-19 Daniel Steffen <das@users.sourceforge.net> + + * unix/tcl.m4 (Darwin): --enable-64bit: verify linking with 64bit -arch + flag succeeds before enabling 64bit build. + * unix/configure: autoconf-2.59 + +2006-12-18 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTreeview.c, library/ttk/treeview.tcl, doc/treeview.n: + Added column '-stretch' and '-minwidth' options. Improved column drag + and resize behavior. Added horizontal scrolling [Bug 1518650]. Row + height and child indent specifiable on Treeview style. Decreased + default row height, no default -padding. Use correct heading height + [Bug 1163349]. Apply tag settings to tree item as well as to data + columns [NOTE: 'tag configure' still buggy]. Fix off-by-one condition + when moving nodes forward [Bug 1618142] + * generic/ttk/ttkScroll.c (TtkScrollTo): Prevent overscroll [Bug + 1173434] + * library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl, + * library/ttk/clamTheme.tcl, library/ttk/classicTheme.tcl, + * library/ttk/defaults.tcl, library/ttk/winTheme.tcl, + * library/ttk/xpTheme.tcl: Per-theme treeview settings. + * macosx/ttkMacOSXTheme.c: Added disclosure triangle element. + +2006-12-17 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/combobox.tcl, generic/ttk/ttkEntry.c, + * doc/ttk_combobox.n: Add combobox -height option; only show scrollbar + if the listbox needs to scroll. [Bug 1032869] + +2006-12-16 Mo DeJong <mdejong@users.sourceforge.net> + + * doc/cursors.n: Mention "none" in supported cursor list. Fix comment + that incorrectly claims that the Win32 "no" cursor hides the cursor. + * tests/cursor.test: Test "none" cursor. + * unix/tkUnixCursor.c (CreateCursorFromTableOrFile) + (TkGetCursorByName): Define a table of Tk cursors that is searched in + addition to the X cursor table. A Tk cursor is loaded from a data + string and works with the same options as the built in X cursors. This + code makes it possible to use "none" as a cursor name under Unix. + * win/rc/cursor9a.cur: Added none Win32 cursor. + * win/rc/tk_base.rc: Define a built-in Win32 cursor named "none". + [Patch 1615427] + +2006-12-14 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkButton.c, generic/ttk/ttkElements.c, + * generic/ttk/ttkEntry.c, generic/ttk/ttkFrame.c, + * generic/ttk/ttkImage.c, generic/ttk/ttkInit.c, + * generic/ttk/ttkLabel.c, generic/ttk/ttkNotebook.c, + * generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c, + * generic/ttk/ttkScale.c, generic/ttk/ttkScrollbar.c, + * generic/ttk/ttkSeparator.c, generic/ttk/ttkTheme.h, + * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.h: + Global reduction: use per-file *_Init() routines to reduce the number + of globally-visible initialization records. + +2006-12-13 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/Makefile.in (install-doc): intentionally skip ttk_dialog.n + installation (not for public consumption) + + * doc/scrollbar.n, doc/button.n, doc/checkbutton.n: + * doc/entry.n, doc/frame.n, doc/label.n, doc/labelframe.n: + * doc/menu.n, doc/menubutton.n, doc/panedwindow.n: + * doc/radiobutton.n, doc/scrollbar.n, doc/ttk_*: revamp ttk docs to + use consist nroff format (not 100% consistent with classic widget + docs). Add more man page cross-linking "SEE ALSO". + + * generic/ttk/ttkInit.c: + * generic/ttk/ttkTreeview.c: make treeview exist by default + * generic/ttk/ttkPanedwindow.c: s/TtkPaned_Init/TtkPanedwindow_Init/ + + * win/Makefile.in, unix/Makefile.in (demo): add 'demo' target + +2006-12-13 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/ttk.tcl: Try to straighten out theme loading and + selection logic. + * generic/ttk/ttkElements.c, library/ttk/defaults.tcl, + * generic/ttk/ttkClamTheme.c, library/ttk/clamTheme.tcl: + Provide package in C part instead of Tcl part. + +2006-12-12 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/ttk.tcl, generic/ttkTheme.c: Remove nonfunctional code. + +2006-12-12 Mo DeJong <mdejong@users.sourceforge.net> + + * win/tkWinButton.c (InitBoxes): Call Tcl_Panic() if loading of bitmap + resources fails. This change generates an error if Tk is unable to + find button widget resources instead of silently failing and then + drawing widgets incorrectly. + * win/rc/tk_base.rc: If the user defines BASE_NO_TK_ICON then compile + the base resources file without a "tk" icon. This change makes it + easier to replace the default tk icon with a custom icon. [Patch + 1614362] + +2006-12-11 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * unix/tkUnixWm.c (TkWmMapWindow, WmClientCmd): Added support for + _NET_WM_PID property from the EWMH spec. This is only installed when + the client machine is set. + (WmProtocolCmd, UpdateWmProtocols, TkWmProtocolEventProc): Added + support for the _NET_WM_PING protocol from the EWMH spec. Note that + the support for this is not exposed to the script level as that would + prevent correct handling. + +2006-12-10 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h, + * generic/ttk/ttk.decls, generic/ttk/ttkTheme.c, + * generic/ttk/ttkLayout.c, generic/ttk/ttkDecls.h: + Rename typedef Ttk_Element => Ttk_ElementImpl. + +2006-12-09 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkButton.c, generic/ttk/ttkImage.c, + * generic/ttk/ttkLabel.c, generic/ttk/ttkWidget.h, + * generic/ttk/ttkTheme.h, generic/ttk/ttkNotebook.c, + * generic/ttk/ttkTreeview.c, doc/ttk_image.n: + Merged duplicate functionality between image element factory, image + element, and -image option processing. Image element factory now takes + an imageSpec argument instead of a separate image name and -map option + * tests/ttk/image.test(image-1.1): Can catch this error earlier now. + +2006-12-06 Kevin Kenny <kennykb@acm.org> + + * unix/configure.in: Further changes to avoid attempting to link + * unix/configure: against Xft libraries in a non-Xft build + [Bug 1609616] (dgp) + +2006-12-04 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkListbox.c (ConfigureListboxItem): ListboxWorldChanged not + needed - just call EventuallyRedrawRange. [Bug 1608046] (rezic) + +2006-12-04 Donal K. Fellows <dkf@users.sf.net> + + TIP #286 IMPLEMENTATION + + * generic/tkMenu.c (MenuWidgetObjCmd, MenuDoXPosition): + * doc/menu.n, tests/menu.test: Added an [$menu xposition] subcommand + which is useful in menubars and when menus use multiple columns. Many + thanks to Schelte Bron for the implementation. + +2006-12-01 Kevin Kenny <kennykb@acm.org> + + TIP #300 IMPLEMENTATION + + * doc/font.n: Added a [font actual $font $char] + * generic/tkFont.c: variant that introspects the font that + * generic/tkFont.h: is chosen to render a given character + * macosx/tkMacOSXFont.c: in a given nominal font. Added + * tests/font.test: documentation and test cases for the + * unix/tkUnixFont.c: new command syntax. + * unix/tkUnixRFont.c: + * win/tkWinFont.c: + +2006-12-01 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/wm.n, tests/winWm.test: + * win/tkWinWm.c: add -transparentcolor attribute for Windows. + +2006-12-01 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkTheme.h, generic/ttk/ttkLayout.c: Dead code removal. + +2006-11-30 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDialog.c (Tk_MessageBoxObjCmd): fix inability to use + buttons with standard Escape key binding as -default button (reported + on tcl-mac by Hans-Christoph Steiner). + + * macosx/tkMacOSXWm.c (WmAttributesCmd): fix getting [wm attr -alpha]. + [Bug 1581932] + +2006-11-28 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/fonts.tcl: Clean up temporary variables. + +2006-11-27 Kevin Kenny <kennykb@acm.org> + + * unix/configure.in: Corrected Xft configuration so that Xft actually + does get turned on when available. + * unix/configure: autoconf + +2006-11-26 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkWidget.c, generic/ttk/ttkPaned.c: Fix [Bug 1603506] + * library/ttk/button.tcl, library/ttk/combobox.tcl, + * library/ttk/utils.tcl: Rename ttk::CopyBindings to ttk::copyBindings + * generic/ttk/ttkTreeview.c, doc/ttk_treeview.n: + -displaycolumns {} now means "no columns" instead of "all columns". + Use -displaycolumns #all for "all columns". [Bug 1547622] + +2006-11-26 Daniel Steffen <das@users.sourceforge.net> + + * unix/tcl.m4 (Linux): --enable-64bit support. [Patch 1597389] + * unix/configure: autoconf-2.59 [Bug 1230558] + +2006-11-24 Jeff Hobbs <jeffh@ActiveState.com> + + * macosx/tkMacOSXInit.c (TkpInit): only set tcl_interactive 1 if it + isn't already defined. Allows embedders to set it to 0 to prevent the + console appearing on OS X. [Bug 1487701] + + * unix/tkUnixMenu.c (DrawMenuUnderline): bound Tcl_UtfAtIndex usage + * tests/menu.test (menu-36.1): [Bug 1599877] + +2006-11-24 Joe English <jenglish@users.sourceforge.net> + + * library/ttk/altTheme.tcl, library/ttk/clamTheme.tcl, + * library/ttk/defaults.tcl, library/ttk/winTheme.tcl, + * library/ttk/xpTheme.tcl: explicitly specify -anchor w on TMenubutton + * tests/ttk/entry.test: Fixed font dependency; test entry-3.2 should + work on all platforms now. + * library/classicTheme.tcl: Don't define or use TkClassicDefaultFont. + * generic/ttk/ttkTreeview.c, generic/ttk/ttkPanedwindow.c: Handle + missing layouts. + +2006-11-23 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinMenu.c (TkWinHandleMenuEvent, DrawMenuUnderline): Handle + unichar underlining correctly and safely. [Bug 1599877] + +2006-11-20 Joe English <jenglish@users.sourceforge.net> + + * win/ttkWinXPTheme.c: Add support for alternate/indeterminate + checkbutton state. Fix various spacing parameters [Bug 1596020, patch + from Tim Baker]. Remove unused uxtheme hooks. + +2006-11-16 Donal K. Fellows <dkf@users.sf.net> + + * doc/colors.n, doc/wm.n: Minor fixes, added See Also. + + * doc/labelframe.n: Added an example. + +2006-11-15 Donal K. Fellows <dkf@users.sf.net> + + * doc/label.n: Added an example and some See Also refs. + + * doc/ConfigWidg.3, doc/bind.n, doc/grid.n, doc/panedwindow.n: + * doc/text.n, doc/ttk_Geometry.3, doc/ttk_button.n: + * doc/ttk_checkbutton.n, doc/ttk_combobox.n, doc/ttk_dialog.n: + * doc/ttk_entry.n, doc/ttk_frame.n, doc/ttk_image.n, doc/ttk_intro.n: + * doc/ttk_label.n, doc/ttk_labelframe.n, doc/ttk_menubutton.n: + * doc/ttk_notebook.n, doc/ttk_panedwindow.n, doc/ttk_progressbar.n: + * doc/ttk_radiobutton.n, doc/ttk_scrollbar.n, doc/ttk_separator.n: + * doc/ttk_sizegrip.n, doc/ttk_style.n, doc/ttk_widget.n, doc/wm.n: + Convert \fP to \fR so that man-page scrapers have an easier time. + +2006-11-14 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkDefaultTheme.c: Fix off-by-one bug in tree indicator + size computation [Bug 1596021, patch from Tim Baker]. Increased + default size from 7 to 9 pixels. + +2006-11-12 Joe English <jenglish@users.sourceforge.net> + + * generic/ttkScroll.c: *correct* fix for [Bug 1588251]. + +2006-11-12 Joe English <jenglish@users.sourceforge.net> + + * tests/ttk/ttk.test(ttk-6.9): Workaround for [Bug 1583038] + +2006-11-12 Joe English <jenglish@users.sourceforge.net> + + * generic/ttkScroll.c: Reworked cleanup procedure; "self-cancelling" + idle call is not robust, call Tcl_CancelIdleCall() in + TtkFreeScrollHandle instead. Fixes [Bug 1588251] + +2006-11-10 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Wish.xcodeproj/project.pbxproj: remove tclParseExpr.c and + bwidget.test. + + * unix/tcl.m4 (Darwin): suppress linker arch warnings when building + universal for both 32 & 64 bit and no 64bit CoreFoundation is + available; sync with tcl tcl.m4 change. + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in: autoheader-2.59 + +2006-11-08 Kevin Kenny <kennykb@acm.org> + + * unix/configure.in: Silenced warnings about missing Xft configuration + unless --enable-xft is requested explicitly. Also added a few basic + checks that we can actually compile and link against Xft headers and + libraries. [Bug 1592667] + * unix/configure: Regen. + +2006-11-07 Kevin Kenny <kennykb@acm.org> + + * unix/configure.in: Made --enable-xft the default. + * unix/configure: Regen. + +2006-11-06 Joe English <jenglish@users.sourceforge.net> + + * generic/ttk/ttkClassicTheme.c, generic/ttk/ttkPanedwindow.c, + * generic/ttk/ttkTheme.c, generic/ttk/ttkTreeview.c, + * win/ttkWinXPTheme.c, library/ttk/entry.tcl, + * library/ttk/notebook.tcl, library/ttk/panedwindow.tcl, + * library/ttk/utils.tcl, tests/ttk/entry.test, tests/ttk/bwidget.test: + Miscellaneous minor changes to re-sync Ttk codebase with Tile CVS: fix + comments damaged by overzealous search-and-destroy; removed obsolete + [style default] synonym for [ttk::style configure]; removed other dead + code. + +2006-11-03 Pat Thoyts <patthoyts@users.sourceforge.net> + + * library/safetk.tcl (::safe::tkTopLevel): Theme it. + + * generic/ttk/ttkLayout.c: We do not want to require tkInt in all + * generic/ttk/ttkMananager.h: the ttk files so added the definition + * generic/ttk/ttkTheme.h: of MODULE_SCOPE to ttkTheme.h. Ensures + * generic/ttk/ttkWinMonitor.c: everyone gets to see the definition + from someplace. + + * library/ttk/fonts.tcl: In a safe interp there is no osVersion field + in tcl_platform so work around it. + +2006-11-02 Daniel Steffen <das@users.sourceforge.net> + + * generic/ttk/ttkBlink.c, generic/ttk/ttkButton.c: + * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c: + * generic/ttk/ttkDecls.h, generic/ttk/ttkDefaultTheme.c: + * generic/ttk/ttkElements.c, generic/ttk/ttkEntry.c: + * generic/ttk/ttkFrame.c, generic/ttk/ttkImage.c: + * generic/ttk/ttkInit.c, generic/ttk/ttkLabel.c: + * generic/ttk/ttkLayout.c, generic/ttk/ttkManager.h: + * generic/ttk/ttkNotebook.c, generic/ttk/ttkPanedwindow.c: + * generic/ttk/ttkProgress.c, generic/ttk/ttkScale.c: + * generic/ttk/ttkScroll.c, generic/ttk/ttkScrollbar.c: + * generic/ttk/ttkSeparator.c, generic/ttk/ttkSquare.c: + * generic/ttk/ttkStubInit.c, generic/ttk/ttkStubLib.c: + * generic/ttk/ttkTheme.c, generic/ttk/ttkTheme.h: + * generic/ttk/ttkThemeInt.h, generic/ttk/ttkTrack.c: + * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.c: + * generic/ttk/ttkWidget.h, macosx/ttkMacOSXTheme.c: + * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: ensure + all global Ttk symbols have Ttk or ttk prefix; declare all externally + visible Ttk symbols not contained in stubs table as MODULE_SCOPE (or as + static when possible); so that 'make check{exports,stubs}' once again + complete without errors. + + * macosx/tkMacOSXColor.c (TkMacOSXCompareColors): ifdef out when unused + + * macosx/Wish.xcodeproj/project.pbxproj: check autoconf/autoheader exit + status and stop build if they fail. + + * macosx/tkMacOSXWindowEvent.c (GenerateUpdateEvent): fix handling of + Carbon Update events: the QuickDraw window update region was being + ignored and all child TkWindows were sent an Expose XEvent even when + they did not need to be redrawn. [Patch 1589226] + +2006-11-01 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDebug.c: add TkMacOSX prefix to leftover + * macosx/tkMacOSXDebug.h: macosx-private global symbols without Tk + * macosx/tkMacOSXEmbed.c: prefix; ifdef out currently unused debug + * macosx/tkMacOSXEvent.c: procs. + * macosx/tkMacOSXInt.h: + * macosx/tkMacOSXCarbonEvents.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWm.c: + +2006-10-31 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/makefile.vc: Added ttk files to msvc build and add manifest + * win/rules.vc: files to binaries with MSVC8. + +2006-10-31 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Wish.xcodeproj/project.pbxproj: add new Ttk files. + + * macosx/ttkMacOSXTheme.c: standardize header #includes. + + * unix/Makefile (checkstubs, checkexports): check ttk.decls, allow + export of Ttk prefixed symbols. + + * generic/ttk/tkDefaultTheme.c: fix warnings. + +2006-10-30 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/ttk_Geometry.3, doc/ttk_Theme.3, doc/ttk_button.n: + * doc/ttk_checkbutton.n, doc/ttk_combobox.n, doc/ttk_dialog.n: + * doc/ttk_entry.n, doc/ttk_frame.n, doc/ttk_image.n: + * doc/ttk_intro.n, doc/ttk_label.n, doc/ttk_labelframe.n: + * doc/ttk_menubutton.n, doc/ttk_notebook.n, doc/ttk_panedwindow.n: + * doc/ttk_progressbar.n, doc/ttk_radiobutton.n, doc/ttk_scrollbar.n: + * doc/ttk_separator.n, doc/ttk_sizegrip.n, doc/ttk_style.n: + * doc/ttk_treeview.n, doc/ttk_widget.n,: + * generic/ttk/ttk.decls, generic/ttk/ttkBlink.c: + * generic/ttk/ttkButton.c, generic/ttk/ttkCache.c: + * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c: + * generic/ttk/ttkDecls.h, generic/ttk/ttkDefaultTheme.c: + * generic/ttk/ttkElements.c, generic/ttk/ttkEntry.c: + * generic/ttk/ttkFrame.c, generic/ttk/ttkImage.c: + * generic/ttk/ttkInit.c, generic/ttk/ttkLabel.c: + * generic/ttk/ttkLayout.c, generic/ttk/ttkManager.c: + * generic/ttk/ttkManager.h, generic/ttk/ttkNotebook.c: + * generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c: + * generic/ttk/ttkScale.c, generic/ttk/ttkScroll.c: + * generic/ttk/ttkScrollbar.c, generic/ttk/ttkSeparator.c: + * generic/ttk/ttkSquare.c, generic/ttk/ttkState.c: + * generic/ttk/ttkStubInit.c, generic/ttk/ttkStubLib.c: + * generic/ttk/ttkTagSet.c, generic/ttk/ttkTheme.c: + * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h: + * generic/ttk/ttkTrace.c, generic/ttk/ttkTrack.c: + * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.c: + * generic/ttk/ttkWidget.h: + * library/demos/ttk_demo.tcl, library/demos/ttk_iconlib.tcl: + * library/demos/ttk_repeater.tcl: + * library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl: + * library/ttk/button.tcl, library/ttk/clamTheme.tcl: + * library/ttk/classicTheme.tcl, library/ttk/combobox.tcl: + * library/ttk/cursors.tcl, library/ttk/defaults.tcl: + * library/ttk/dialog.tcl, library/ttk/entry.tcl: + * library/ttk/fonts.tcl, library/ttk/icons.tcl: + * library/ttk/keynav.tcl, library/ttk/menubutton.tcl: + * library/ttk/notebook.tcl, library/ttk/panedwindow.tcl: + * library/ttk/progress.tcl, library/ttk/scale.tcl: + * library/ttk/scrollbar.tcl, library/ttk/sizegrip.tcl: + * library/ttk/treeview.tcl, library/ttk/ttk.tcl: + * library/ttk/utils.tcl, library/ttk/winTheme.tcl: + * library/ttk/xpTheme.tcl: + * macosx/ttkMacOSXTheme.c: + * tests/ttk/all.tcl, tests/ttk/bwidget.test, tests/ttk/combobox.test: + * tests/ttk/entry.test, tests/ttk/image.test: + * tests/ttk/labelframe.test, tests/ttk/layout.test: + * tests/ttk/misc.test, tests/ttk/notebook.test: + * tests/ttk/panedwindow.test, tests/ttk/progressbar.test: + * tests/ttk/scrollbar.test, tests/ttk/treetags.test: + * tests/ttk/treeview.test, tests/ttk/ttk.test, tests/ttk/validate.test: + * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: + First import of Ttk themed Tk widgets as branched from tile 0.7.8 + + * generic/tkInt.h, generic/tkWindow.c: add Ttk_Init call, copy tk + classic widgets to ::tk namespace. + * library/tk.tcl: add source of ttk/ttk.tcl, define $::ttk::library. + * unix/Makefile.in, win/Makefile.in: add Ttk build bits + * win/configure, win/configure.in: check for uxtheme.h (XP theme). + +2006-10-23 Don Porter <dgp@users.sourceforge.net> + + * README: Bump version number to 8.5a6 + * generic/tk.h: + * library/tk.tcl: + * unix/configure.in: + * unix/tk.spec: + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: + +2006-10-19 Pat Thoyts <patthoyts@users.sourceforge.net> + + *** 8.5a5 TAGGED FOR RELEASE *** + + * generic/tkImgBmap.c: Fixed line endings. + * win/makefile.vc: Patched up build system to manage + * win/rules.vc: AMD64 with MSVC8 + * win/nmakehlp.c: Ensure operation without Platform SDK. + +2006-10-18 Don Porter <dgp@users.sourceforge.net> + + * changes: 8.5a5 release date set. + +2006-10-17 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/text.n: fix docs to not correct -tabs usage case. + + * generic/tkTextDisp.c (SizeOfTab): fix -tabstyle wordprocessor tab + alignment to correct tab edge case. [Bug 1578858] + +2006-10-17 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/tkText.c: Applied suggested patch from [Bug 1536735] + * tests/text.test: Update test for above patch. + * tests/textWind.test: Corrected test to catch all messages + * tests/safe.test: Silence spurious win32 failure awaiting TIP150 + * tests/winDialog.test: Updated test for file name length check. + * test/winWm.test: Corrected test expectation for menu wrapping. + +2006-10-16 Andreas Kupries <andreask@activestate.com> + + * doc/WindowId.3: Pat's commit on 2006-10-08 broke the .SH NAME + information across several lines, breaking the cross-linking of + manpages during installation for this one. Put everything back on a + single line, unbreaking it. + +2006-10-16 Daniel Steffen <das@users.sourceforge.net> + + * changes: updates for 8.5a5 release. + + * macosx/tkMacOSXDraw.c: fix numerous issues in CG and QD drawing + procs so that they now match X11 drawing much more closely [Bug + 1558051]; use Tiger ellipse drawing API when available; fix comments & + whitespace. + + * macosx/tkMacOSXInit.c: set default linewidth limit for CG + antialiasing to 0 as thin horizontal/vertical lines look good now. + * macosx/README: document CG antialiasing limit changes. + + * generic/tkCanvLine.c (ConfigureLine): on TkAqua, pass outline + * generic/tkCanvPoly.c (ConfigurePolygon): linewidth in gc even for + * generic/tkRectOval.c (ConfigureRectOval): fills (as it controls AA). + + * macosx/GNUmakefile: don't redo prebinding of non-prebound binaires. + + * library/demos/pendulum.tcl: fix incorrect setting of toplevel title. + +2006-10-10 Don Porter <dgp@users.sourceforge.net> + + * changes: Updates for 8.5a5 release + +2006-10-08 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/tkWindow.c: Implemented TIP #264 - Tk_Interp function. + * doc/WindowId.3: Documented Tk_Interp. + * generic/tk.decls: Added to the stubs interface and + * generic/tkDecls.h: regenerated. + * generic/tkStubsInit.c: + +2006-10-05 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/tkUnixFont.c (Ucs2beToUtfProc, UtfToUcs2beProc): + (TkpFontPkgInit, encodingAliases): Correct alignment issues in + encoding conversion. Call ucs-2be "unicode" on big-endian systems. + [Bug 1122671] + +2006-09-27 Andreas Kupries <andreask@activestate.com> + + * unix/Makefile.in (install-binaries): Added a second guard to the + * win/Makefile.in: package index file to prevent older versions of Tcl + * win/makefile.vc: from seeing version numbers which may contain a/b + information, and then balking on them. This could otherwise happen + when Tcl/Tk 8.4 and 8.5 are installed in the same directory, seeing + each other. [Bug 1566418] + +2006-09-22 Andreas Kupries <andreask@activestate.com> + + * generic/tkConsole.c: TIP #268 update regarding registered package + * generic/tkMain.c: version, now using full patchlevel instead of + * generic/tkWindow.c: major.minor + * library/tk.tcl: + * unix/configure: + * unix/Makefile.in: + * unix/tcl.m4: + * win/configure: + * win/Makefile.in: + * win/makefile.vc: + * win/rules.vc: + * win/tcl.m4: + +2006-09-20 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinMenu.c (TkpPostMenu): disable menu animation in menus with + images to avoid clipping bug. [Bug 1329198] + +2006-09-21 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgBmap.c (ImgBmapPostscript): Change 0 to NULL, since + they are not interchangable on all platforms in all circumstances. + [Tcl Bug 1562528] + +2006-09-11 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (TkMacOSXMakeRealWindowExist): revert part of + 2006-05-16 change that had set overrideredirect windows to not become + activated by the window manager, as this prevented interaction with + native widgets in such windows [Bug 1472624]; apply changes to carbon + window attributes even if native window has already been created. + + * macosx/tkMacOSXKeyEvent.c (TkMacOSXProcessKeyboardEvent): fix app + * macosx/tkMacOSXMenu.c (DrawMenuBarWhenIdle): menu item key shortcuts + * macosx/tkMacOSXInt.h: when custom ".apple" menu is installed. + + * library/demos/widget: on TkAqua, don't install file menu with single + quit menu item, as the application menu already has a quit item. + + * macosx/tkMacOSXColor.c: fix building on Mac OS X 10.2. + +2006-09-10 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXColor.c (TkSetMacColor,TkpGetColor): use AppearanceMgr + * macosx/tkMacOSXDefault.h: to retrieve platform std colors for text + * macosx/tkMacOSXPort.h: selections, add "systemHighlightSecondary" + color name for standard color of inactive selections, use this color as + default for text widget -inactiveselectbackground to implement platform + standard look for inactive text selections. + + * library/text.tcl (aqua): remove focus bindings to set selection color + + * generic/tkTextBTree.c (TkTextIsElided): on TkAqua, don't show + * generic/tkTextDisp.c (GetStyle): inactive text selection when + text widget is disabled. + + * generic/tkEntry.c (DisplayEntry): change default TkAqua selection + * macosx/tkMacOSXDefault.h: relief to "flat" (platform std). + + * generic/tkText.c (CreateWidget): fix bug leading to default text + selection relief string DEF_TEXT_SELECT_RELIEF being ignored. + + * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): allow mouse + event delivery to background windows with kWindowNoActivatesAttribute + (e.g. overrideredirect windows), as these never come to the foreground + they would never receive any mouse events otherwise. [Bug 1472624] + + * macosx/tkMacOSXWindowEvent.c (TkMacOSXGenerateFocusEvent): do not + send focus events to any windows with kWindowNoActivatesAttribute. + + * macosx/tkMacOSXXStubs.c (XQueryColor, XQueryColors): implement basic + XColor computation from pixel values, enough to make tkImg's window.c + happy, fixes img::window failures reported on tcl-mac. + + * macosx/tkMacOSXMenu.c (DrawMenuEntryLabel): fix leak. [Bug 1554672] + + * macosx/GNUmakefile: workaround bug in 'cp -pRH' on Darwin 6 and + earlier, fixes 'make embedded' failure reported on tcl-mac; fix error + from 'make deploy' with same build tree as previous 'make embedded'. + + * macosx/Wish.xcodeproj/project.pbxproj: add new tclUnixCompat.c file. + + * macosx/tkMacOSXEntry.c (TkpDrawEntryBorderAndFocus): fix typo. + + * unix/tcl.m4: sync with tcl/unix/tcl.m4. + * unix/configure: autoconf-2.59 + +2006-09-06 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkEntry.c: move hard-coded ALWAYS_SHOW_SELECTION control + * generic/tkInt.h: of entry/text selection display based on focus + * generic/tkText.c: to the Tcl level, controlled by + * generic/tkWindow.c: ::tk::AlwaysShowSelection (boolean, private). + * library/tk.tcl: [Bug 1553691] + * macosx/tkMacOSXDefault.h: + * unix/tkUnixDefault.h: + * unix/tkUnixPort.h: + * win/tkWinDefault.h: + +2006-08-30 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinKey.c: Add WM_UNICHAR window message support (used by + * win/tkWinX.c: virtual keyboard apps). [Bug 1518677] (petasis) + +2006-08-24 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXScrlbr.c (UpdateControlValues): set native scrollbar + control bounds only once all size adjustments have been computed. + Fixes issue with grow icon obscuring scrollbar reported on tcl-mac. + +2006-08-21 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXCarbonEvents.c (CarbonTimerProc): avoid starving main + event loop: limit the number of tcl events processed per invocation. + Fixes bug reported on tcl-mac by Kevan Hashemi. + +2006-08-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * tests/text.test (text-25.15): Added test suggested by Sam + <baudinm@yahoo.com> on comp.lang.tcl + + * generic/tk.h, generic/tkInt.h: Stylistic improvements. No API change. + +2006-08-18 Daniel Steffen <das@users.sourceforge.net> + + * unix/tcl.m4 (Darwin): add support for --enable-64bit on x86_64, for + universal builds including x86_64, for 64-bit CoreFoundation on Leopard + and for use of -mmacosx-version-min instead of MACOSX_DEPLOYMENT_TARGET + * unix/configure.in (Darwin): remove 64-bit arch flags from CFLAGS for + combined 32-bit and 64-bit universal builds, as neither TkAqua nor + TkX11 can be built for 64-bit at present. + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in: autoheader-2.59 + + * macosx/Wish.xcodeproj/project.pbxproj: switch native release targets + to use DWARF with dSYM, Xcode 3.0 changes. + * macosx/README: updates for x86_64 support in Tcl. + + * macosx/tkMacOSXInit.c (TkpInit): when available, use public + TransformProcessType() API instead of CPSEnableForegroundOperation() + SPI to notify the window server that we are a GUI application. + + * macosx/tkMacOSXWm.c (WmAttrGetTitlePath): use HIWindow API on >=Tiger + + * macosx/tkMacOSXMouseEvent.c (GenerateToolbarButtonEvent): + * macosx/tkMacOSXMenus.c (GenerateEditEvent): + * macosx/tkMacOSXMenu.c (MenuSelectEvent): bzero() the XVirtualEvent + structure before use to ensure all fields are initialized. [Bug + 1542205] + +2006-08-16 Jeff Hobbs <jeffh@ActiveState.com> + + * macosx/tkMacOSXWm.c (WmAttributesCmd): correct OS X result for [wm + attributes $top]. + +2006-07-25 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXKeyEvent.c (TkMacOSXProcessKeyboardEvent): handle key + shortcut for kHICommandQuit in the same way as other application menu + item key shortcuts. [Bug 1516950] + +2006-07-24 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (TkWmMapWindow): fix incorrect values of wmInfo + parentWidth/Height for toplevels by recalculating them once the window + is mapped (i.e once the window&structure sizes are known). [Bug + 1358663] + (ParseGeometry): sync with ParseGeometry in tkUnixWm.c/tkWinWm.c. + +2006-07-21 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkBind.c (TkBindInit): for REDO_KEYSYM_LOOKUP, change + keysym-to-string mapping hash to use first name in ks_names.h instead + of last (if there are multiple possibilities), e.g. "F11" instead of + "L1". + + * macosx/tkMacOSXKeyboard.c (TkpGetKeySym): correct keysyms for pure + modifier key presses [Bugs 700311, 1525905]; correct keysym for Enter + key; add keysyms for new NumLock and Fn modifiers (added 2005-08-09). + +2006-07-20 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (WmAttributesCmd, WmIconbitmapCmd): add support + * unix/tkUnixSend.c (Tk_GetUserInactiveTime): for weakly + importing symbols not available on OSX 10.2 or 10.3, enables binaires + built on later OSX versions to run on earlier ones. + * macosx/Wish.xcodeproj/project.pbxproj: enable weak-linking; turn on + extra warnings. + * macosx/README: document how to enable weak-linking; cleanup. + * unix/configure.in: add check on Darwin-X11 for ld support of -weak-l + * unix/tcl.m4: flag and weak-link libXss if possible as it is not + available before OSX 10.4; enforce requirement of OSX 10.2 for TkAqua; + move Darwin specific checks & defines that are only relevant to the tcl + build out of tcl.m4; restrict framework option to Darwin; clean up + quoting and help messages. + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in: autoheader-2.59 + + * macosx/GNUmakefile: enable xft for TkX11 build. + * macosx/tkMacOSXFont.c (TkMacOSXQuarzStartDraw, TkMacOSXQuarzEndDraw): + verify validity of context returned from QDBeginCGContext() before use. + * macosx/tkMacOSXKeyEvent.c: ifdef out diagnostic messages to stderr. + + * macosx/tkMacOSXEvent.h: standardize MAC_OS_X_VERSION_MAX_ALLOWED + * macosx/tkMacOSXMenu.c: checks per QA1316, ensure define can be + * macosx/tkMacOSXMenubutton.c: overridden on command line (from default + * macosx/tkMacOSXMenus.c: of current OS version). + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXWm.c: + + * generic/tkImgGIF.c (ReadImage): + * macosx/tkMacOSXCursor.c (TkMacOSXCursor): + * macosx/tkMacOSXDebug.c (TkMacOSXGetNamedDebugSymbol): + * macosx/tkMacOSXFont.c (TkpMeasureCharsInContext): + * macosx/tkMacOSXInit.c (Map): + * xlib/xgc.c (XCreateGC): fix signed-with-unsigned comparison and other + warnings from gcc4 -Wextra. + +2006-07-14 Andreas Kupries <andreask@activestate.com> + + * generic/tkWindow.c (Initialize): Modify change of 2006-05-25 (jeffh). + Release mutex a bit earlier, to prevent lock when OS X creates its + console windows (recursively enters Tk_Init). Patch by JeffH. + +2006-07-06 Jeff Hobbs <jeffh@ActiveState.com> + + * library/tkfbox.tcl: catch scrollbar use of highlightthickness + +2006-06-21 Jeff Hobbs <jeffh@ActiveState.com> + + * library/bgerror.tcl (::tk::dialog::error::bgerror): remove a couple + of unnecessary hardcoded options + +2006-06-14 Don Porter <dgp@users.sourceforge.net> + + * generic/tkScale.c: Revised variable writing logic to account for + [scale]'s design that it deals with its value as a formatted string, + and not as a double. [Bug 891141] + +2006-06-14 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXSubwindows.c (TkMacOSXInvalidateWindow): ensure + invalid clip regions are recreated via TkMacOSXUpdateClipRgn() before + they are used; correct call order of TkMacOSXInvalidateWindow() and + TkMacOSXInvalClipRgns() throughout. [Bug 1501922] + + * macosx/tkMacOSXDraw.c (TkPutImage): implement drawing of very wide + images in slices of less than 4096 pixels to workaround CopyBits + limitation. [Bug 950121] + +2006-06-09 Don Porter <dgp@users.sourceforge.net> + + * generic/tkMain.c: Added Tcl_Preserve() call on the master interp + as crash protection against any Tcl_DeleteInterp() call that might + happen. + +2006-06-01 Don Porter <dgp@users.sourceforge.net> + + * generic/tkConsole.c: Added Tcl_RegisterChannel() calls to bump the + refcount of channels passed to Tcl_SetStdChannel(). This prevents early + free-ing of the channels that leads to crashes. [Bug 912571] + +2006-05-29 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinEmbed.c (TkpGetOtherWindow): Do not panic if no window is + * unix/tkUnixEmbed.c (TkpGetOtherWindow): found; caller handles. [Bug + * unix/tkUnixWm.c (Tk_CoordsToWindow, UpdateGeometryInfo): 1212056] + + * tests/entry.test (entry-22.1): + * tests/listbox.test (listbox-6.15): + * generic/tkListbox.c (ListboxInsertSubCmd, ListboxDeleteSubCmd): + Ignore Tcl_SetVar2Ex failure of listVarName, similar to entry widget + handling. [Bug 1424513] + +2006-05-26 Jeff Hobbs <jeffh@ActiveState.com> + + * macosx/tkMacOSXButton.c (TkMacOSXDrawControl): correct redraw for + direct transition from disabled to active state. [Bug 706446] + +2006-05-25 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinMenu.c (TkWinMenuKeyObjCmd): get eventPtr after we know the + window is still alive. [AS bug 45987] [Bug 1236306] + + * generic/tkMenu.c (DeleteMenuCloneEntries): Modify entry index + changes to work around VC6 optimization bug. [Bug 1224330] + + * generic/tkMessage.c (MessageWidgetObjCmd): Correct msgPtr + preserve/release pairing. [Bug 1485750] (afredd) + + * generic/tkWindow.c (Initialize): Correct mutex (un)lock pairing. + [Bug 1479587] (loewis) + + * generic/tkBind.c (Tk_BindEvent, TkCopyAndGlobalEval): use Tcl_EvalEx + instead of Tcl_GlobalEval. + +2006-05-16 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWindowEvent.c (TkMacOSXGenerateFocusEvent): don't send + focus events to windows of class help or to overrideredirect windows. + [Bug 1472624] + + * macosx/tkMacOSXWm.c: set overrideredirect windows to not become + activated by the window manager and to not receive OS activate events + (should make them behave more like on other platforms); use modern + window class API for overrideredirect and transient windows; set the + default class of overrideredirect windows to 'simple' rather than + 'plain' (i.e. no window frame); add missing Panther and Tiger window + attributes to [::tk::unsupported::MacWindowStyle]. + +2006-05-12 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkImgPhoto.c (Tk_PhotoPutBlock, Tk_PhotoPutZoomedBlock): Fix + opt added 2006-03 that caused slowdown for some common cases. [Bug + 1409140] + +2006-05-13 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkCanvWind.c (DisplayWinItem, WinItemRequestProc): ensure + canvas window items are unmapped when canvas is unmapped. [Bug 940117] + + * macosx/tkMacOSXSubwindows.c (TkMacOSXUpdateClipRgn): empty clip + region of unmapped windows to prevent any drawing into them or into + their children from becoming visible. [Bug 940117] + + * macosx/tkMacOSXInt.h: revert Jim's attempt of 2005-03-14 to + * macosx/tkMacOSXSubwindows.c: fix Bug 940117 as it disables Map/Unmap + event propagation to children. [Bug 1480105] + + * macosx/tkMacOSXDraw.c (TkPutImage): handle tkPictureIsOpen flag, + fixes incorrect positioning of images with complex alpha on native + buttons; actual alpha blending is still broken in this situation. [Bug + 1155596] + + * macosx/tkMacOSXEvent.c (TkMacOSXProcessCommandEvent): + * macosx/tkMacOSXMenus.c (TkMacOSXInitMenus): workaround carbon bug + with key shortcut for 'Preferences' app menu item. [Bug 1481503] + + * macosx/tkMacOSXKeyEvent.c (TkMacOSXProcessKeyboardEvent): only check + for HICommand menu item shortcuts in the application menu. + + * macosx/tkMacOSXInt.h: initialize keyboard layout setup in + * macosx/tkMacOSXInit.c: TkpInit() rather than during handling of + * macosx/tkMacOSXKeyEvent.c: first key down event. + + * macosx/tkMacOSXDraw.c: add optional debug code to flash clip + * macosx/tkMacOSXSubwindows.c: regions during update or draw. + +2006-05-04 Don Porter <dgp@users.sourceforge.net> + + * README: Bump version number to 8.5a5 + * generic/tk.h: + * unix/configure.in: + * unix/tk.spec: + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: + +2006-04-28 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (TkWmMapWindow, InitialWindowBounds): fix use of + potentially stale window position in initial configure event on first + map of a window. [Bug 1476443] + (TkMacOSXWindowOffset): use modern GetWindowStructureWidths API. + + * macosx/tkMacOSXInt.h: + * macosx/tkMacOSXMouseEvent.c (TkGenerateButtonEventForXPointer): new + internal function to generate button events for current pointer + directly, without requiring prior call to XQueryPointer(). + + * macosx/tkMacOSXMouseEvent.c (XQueryPointer): implement return of + window-local pointer position. + + * macosx/tkMacOSXInt.h: use improvements above to avoid calls to + * macosx/tkMacOSXKeyEvent.c: GlobalToLocal() when the current port + * macosx/tkMacOSXMenu.c: might not be set correctly. May fix [Bug + * macosx/tkMacOSXMenus.c: 1243318] + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXScrlbr.c: + + * tkAboutDlg.r: update copyright. + + * macosx/tkMacOSXDebug.h: sync #includes with core-8-4-branch. + * macosx/tkMacOSXEvent.h: + * macosx/tkMacOSXFont.h: + +2006-04-26 Don Porter <dgp@users.sourceforge.net> + + *** 8.5a4 TAGGED FOR RELEASE *** + + * changes: Updates for next RC + +2006-04-25 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * unix/tkUnixFont.c (TkpGetFontFamilies): Fix crash caused when the + XServer returns invalid font names. [Bug 1475865] + +2006-04-23 Vince Darley <vincentdarley@users.sourceforge.net> + + * tests/scrollbar.test: fix to tkAqua test failures + +2006-04-18 Vince Darley <vincentdarley@users.sourceforge.net> + + * macosx/tkMacOSXEmbed.c: fix to [Bug 1088814] test failures in + embed.test + + * macosx/tkMacOSXWm.c: + * tests/constraints.tcl: + * tests/wm.test: fix to 'wm attributes' test for TkAqua + +2006-04-11 Peter Spjuth <peter.spjuth@space.se> + + * generic/tkWindow.c (Tk_NameToWindow): Allow NULL interp to + Tk_NameToWindow. This fixes TkGetWindowFromObj which promises to handle + NULL but didn't. + + * generic/tkGrid.c: Fixed handling of out of bounds row or column. + * tests/grid.test: [Bug 1432666] + +2006-04-11 Don Porter <dgp@users.sourceforge.net> + + * unix/Makefile.in: Updated `make dist` target to be sure the + message catalogs for the widget demo get packaged into the source code + distribution. [Bug 1466509] + +2006-04-11 Daniel Steffen <das@users.sourceforge.net> + + * changes: added latest aqua bug fixes. + + * macosx/tkMacOSXDialog.c (Tk_MessageBoxObjCmd): added standard Escape + key binding for msgbox cancel buttons [Patch 1193614], whitespace. + + * macosx/tkMacOSXCarbonEvents.c: handle kEventCommandUpdateStatus + * macosx/tkMacOSXEvent.c: carbon event to dynamically enable + the 'Preferences' app menu item when proc [::tk::mac::ShowPreferences] + is defined. [Bug 700316] + + * macosx/tkMacOSXHLEvents.c: call ::tk::mac::* procs for all + * macosx/tkMacOSXWindowEvent.c: registered appleevents [FR 1105284], + implement print applevent handling, style/whitespace cleanup. + + * macosx/tkMacOSXDraw.c (TkMacOSXInitCGDrawing): prevent multiple init + + * macosx/tkMacOSXFont.c: remove #ifdef'd text measuring codepaths now + * macosx/tkMacOSXInit.c: known to be incorrect, cleanup obsolete text + * macosx/README: antialiasing control code, document ATSUI + text antialiasing changes. + + * macosx/tkMacOSXInt.h: Implemented 'zoomed' window state + * macosx/tkMacOSXWindowEvent.c: handling for TkAqua, via titlebar + * macosx/tkMacOSXWm.c: widget clicks as well as [wm state]. + * doc/wm.n: [Bug 1073456] + +2006-04-10 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/tkfbox.tcl (::tk::IconList_Goto): Fix prefix searching so + that the start location is reasonable, and the prefix matching is + using the correct Tcl command for this. [Bug 1467938] + +2006-04-10 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> + + * macosx/tkMacOSXFont.c (MeasureStringWidth): Use implementation based + on ATSUGetGlyphBounds (TK_MAC_USE_GETGLYPHBOUNDS), so we can use + kATSUseFractionalOrigins. This in turn corrects [Bug 1461650]. + (InitFont): Use "." and "W" instead of "i" and "w" to determine the + "-fixed" attribute. This prevents "Apple Chancery" from being + classified as fixed. + (InitFontFamilies): Only get the font families once. + +2006-04-09 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (WmResizableCmd): propagate window attribute + changes to Carbon window manager. [FR 1467004] + (TkSetWMName, TkMacOSXMakeRealWindowExist): allow empty name for + toplevels, remove bogus initial window name. [Bug 1450800] + +2006-04-07 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): fix return + values, implement window dragging & growing in background (with Command + key down) and by fronting clicks [Bug 934524], use correct button & + modifier state API when application is in background (also in + TkMacOSXButtonKeyState). + + * macosx/tkMacOSXWm.c (TkMacOSXGrowToplevel): ensure QD port is set + correctly before using API relying on it. + +2006-04-06 Vince Darley <vincentdarley@users.sourceforge.net> + + * macosx/tkMacOSXMouseEvent.c: Now that [wm attributes -titlepath] + works correctly, add OS support for dragging proxy icons and using the + titlepath menu. + +2006-04-06 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (WmAttributesCmd, WmIconbitmapCmd): fix errors in + setting/removing window proxy icons via [wm attributes -titlepath] and + [wm iconbitmap], use HIWindow API on Tiger or later. [Bug 1455241] + + * unix/tcl.m4: remove TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING + define on Darwin. [Tcl Bug 1457515] + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in: autoheader-2.59 + +2006-04-05 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkWindow.c (Initialize): remove impotent use of + DeleteWindowsExitProc as a global exit handler. + + * generic/tkMenu.c (TkSetWindowMenuBar): remove extra TkMenuInit call + that caused finalization panic. [Bug 1456851] + * win/tkWinMenu.c (FreeID, TkpNewMenu, MenuExitHandler) + (MenuThreadExitHandler, TkpMenuInit, TkpMenuThreadInit): rework Windows + menu init/finalization to better respect per-process and per-thread + boundaries. [Bug 1456851] + (TkWinMenuKeyObjCmd): Do not error when unknown window is passed in. + [Bug 1236306] + + * win/tkWinX.c (TkWinXInit): init default keyboard charset correctly. + [Bug 1374119] (pajas) + + * win/tkWinWm.c (WmProc): pass WM_QUERYENDSESSION message to Tk as + WM_SAVE_YOURSELF wm protocol callback. + + * tests/textWind.test (textWind-10.6.1): prevent infinite update loop + in case of test failure. + + * tests/wm.test (wm-attributes-1.2.4): correct expected result. + + * tests/grid.test: fix segfault on empty or "all" index list + * generic/tkGrid.c (GridRowColumnConfigureCommand): [Bug 1422430] + +2006-04-05 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkText.c: fix to crash caused on some platforms by new tests + introduced to check for [Bug 1414171], which destroy the text widget in + the dump callback script. + +2006-03-29 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkOption.c (TkOptionDeadWindow): handle OptionThreadExitProc + being called before DeleteWindowsExitProc. + + * win/Makefile.in: convert _NATIVE paths to use / to avoid ".\" + path-as-escape issue. + +2006-03-29 Don Porter <dgp@users.sourceforge.net> + + * changes: Updates for next RC + + * unix/tkUnixDefault.h: Changed "Black" to "#000000" and "White" to + "#ffffff" to work around the (broken?) X servers that do not accept + those color names. [Bug 917433] + +2006-03-28 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/tcl.m4, win/tcl.m4: []-quote AC_DEFUN functions. + +2006-03-26 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkText.c: + * tests/text.test: Fix for elaborations of [Bug 1414171] for '$text + dump -command <script>' where script deletes large portions of the + text widget, or even destroys the widget. + +2006-03-28 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Wish.xcode/default.pbxuser: add '-singleproc 1' cli arg to + * macosx/Wish.xcodeproj/default.pbxuser: tktest to ease test debugging. + + * macosx/Wish.xcode/project.pbxproj: removed $prefix/share from + * macosx/Wish.xcodeproj/project.pbxproj: TCL_PACKAGE_PATH as per change + to tcl/unix/configure.in of 2006-03-13. + + * macosx/tkMacOSXDraw.c: sync whitespace & minor changes with + * macosx/tkMacOSXEvent.h: core-8-4-branch. + * macosx/tkMacOSXFont.h: + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXNotify.c: + +2006-03-27 Don Porter <dgp@users.sourceforge.net> + + * changes: Updates for next RC + +2006-03-27 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> + + * generic/tkTextDisp.c (MeasureChars): Fix calculations of start and + end of string. [Bugs 1325998, 1456157] + +2006-03-27 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgGIF.c (FileReadGIF): Stop crashes when the first GIF + frame does not define the overall size of the image. [Bug 1458234] + +2006-03-26 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkText.c: + * generic/tkText.h: + * generic/tkTextBTree.c: + * tests/text.test: Fix for [Bug 1414171] for '$text dump -command + <script>' where 'script' actually modifies the widget during the + process. + +2006-03-25 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDraw.c (TkMacOSXSetUpCGContext): + * macosx/tkMacOSXFont.c (TkMacOSXQuarzStartDraw, TkMacOSXQuarzEndDraw): + performance improvements, sync similar code, formatting & whitespace. + +2006-03-24 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkTextDisp.c: Moved #ifdef MAC_OSX_TK code added by + * macosx/tkMacOSXColor.c: [Patch 638966] into platform specific files. + * macosx/tkMacOSXInt.h: + + * macosx/tkMacOSX.h: Cleaned up & rationalized order of + * macosx/tkMacOSXBitmap.c: #includes of tk and carbon headers. + * macosx/tkMacOSXButton.c: + * macosx/tkMacOSXCarbonEvents.c: + * macosx/tkMacOSXClipboard.c: + * macosx/tkMacOSXColor.c: + * macosx/tkMacOSXConfig.c: + * macosx/tkMacOSXCursor.c: + * macosx/tkMacOSXDialog.c: + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXEmbed.c: + * macosx/tkMacOSXEntry.c: + * macosx/tkMacOSXEvent.c: + * macosx/tkMacOSXEvent.h: + * macosx/tkMacOSXFont.h: + * macosx/tkMacOSXHLEvents.c: + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXInt.h: + * macosx/tkMacOSXKeyEvent.c: + * macosx/tkMacOSXKeyboard.c: + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXMenus.c: + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXRegion.c: + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXScrlbr.c: + * macosx/tkMacOSXSend.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXWm.h: + * macosx/tkMacOSXXStubs.c: + +2006-03-23 Reinhard Max <max@tclers.tk> + + * unix/tkUnixRFont.c (TkpMeasureCharsInContext): Copied over from + tkUnixFont.c to fix compiling with --enable-xft . + + * unix/tk.spec: Cleaned up and completed. An RPM can now be built from + the tk source distribution with "rpmbuild -tb <tarball>". + +2006-03-23 Don Porter <dgp@users.sourceforge.net> + + * tests/textDisp.test: Updated expected error messages to match the + standardized formats established on 2005-11-17. [Bug 1370296] + +2006-03-22 Don Porter <dgp@users.sourceforge.net> + + * changes: Updates for next RC + +2006-03-21 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkFont.c: implementation of ATSUI text rendering + * generic/tkInt.h: in TkAqua provided by Benjamin + * generic/tkTextDisp.c: Riefenstahl. [Patch 638966] + * library/demos/unicodeout.tcl: + * macosx/tkMacOSXFont.h (new file): + * macosx/tkMacOSXFont.c: + * tests/font.test: + * unix/tkUnixFont.c: + * win/tkWinFont.c: + + * generic/tkFont.c: moved MODULE_SCOPE declarations of font + * generic/tkFont.h: helper procs into header files. + * macosx/tkMacOSXButton.c: + * macosx/tkMacOSXFont.h: + * macosx/tkMacOSXMenubutton.c: + + * macosx/Wish.xcode/project.pbxproj: add new tkMacOSXFont.h file, + * macosx/Wish.xcodeproj/project.pbxproj: turn off dead code stripping + as it interferes with -sectcreate (rdar://4486223). + + * macosx/Wish.xcode/default.pbxuser: add TCLLIBPATH=/Library/Tcl + * macosx/Wish.xcodeproj/default.pbxuser: env var setting to tktest. + + * unix/configure.in: fix detection of symbols build when enabling + TkAqua debug code; filter nm output of libtclstub better to avoid + error on intel macs. [Bug 1415789] + * unix/configure: autoconf-2.59 + +2006-03-20 Don Porter <dgp@users.sourceforge.net> + + * generic/tkConsole.c: Added exit handler to clean up the interp where + the console window lives. Also added code to handle multiple calls to + Tk_CreateConsoleWindow so that the console channels connect to the last + console window opened, in compatibility with the previous + implementation. + +2006-03-18 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkText.c: Fix for undo/modified status of text widgets when + empty strings are inserted and undone. + +2006-03-17 Pat Thoyts <patthoyts@users.sourceforge.net> + + * library/clrpick.tcl: Avoid using abbreviated sub-commands in core + * library/palette.tcl: scripts as this can cause problems with + * library/scale.tcl: mega-widget libraries like snit. + * library/scrlbar.tcl: [Bug 1451587] + * library/tkfbox.tcl: + * library/xmfbox.tcl: + +2006-03-16 Don Porter <dgp@users.sourceforge.net> + + * generic/tkConsole.c: Substantial rewrite of [console] support. + * generic/tkInt.h: Included Obj-ification of the [console] and + [consoleinterp] commands, and reworking of all the supporting data + structures for cleaner sharing and lifetime management especially in + multi-threaded configurations. + +2006-03-16 Donal K. Fellows <dkf@users.sf.net> + + * library/msgs/pt.msg: Messages for Portuguese (strictly just for + Brazilian Portuguese, but they'll do until we get other Portuguese + speakers localize) from Ricardo Jorge <ricardoj@users.sf.net> and Silas + Justiano <silasj@users.sf.net>. Many thanks! [Bug 1405069] + + * generic/tkImgPhoto.c (ImgPhotoCmd, Tk_PhotoPutBlock) + (Tk_PhotoPutZoomedBlock): Added hack to detect copying of a photo with + a simple alpha channel and skip calling ToggleComplexAlphaIfNeeded. + This should speed up many photo-to-photo copies, keeping the cost of + the alpha channel down. + +2006-03-15 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgPhoto.c (Tk_PhotoPutBlock, Tk_PhotoPutZoomedBlock): Try + to squelch performance issue with code that writes to large images by + single pixels. Masses of thanks to George Staplin for helping to trace + this down to the COMPLEX_ALPHA flag handling code. [Bug 1409140] + +2006-03-13 Don Porter <dgp@users.sourceforge.net> + + * tests/scrollbar.test: Corrected several broken calls to [testmetrics] + that were crashing the test suite. + + * tests/constraints.tcl: Added notAqua constraint to canvPs-3.1 + * tests/canvPs.test: to stop test suite crash on Mac OSX. + [Bug 1088807] + + * generic/tkCmds.c: Purged remaining references to errno, + * macosx/tkMacOSXPort.h: and errno.h. Standardized the logic + * macosx/tkMacOSXWm.c: for using header files from the compat + * macosx/tkMacOSXWm.h: directory. Thanks Joe English for the + * unix/tkUnixPort.h: patch. [Patch 1445404] + +2006-03-08 Don Porter <dgp@users.sourceforge.net> + + * unix/Makefile.in: Update `make dist` to copy the image files needed + by the test suite into the source distro. This was overlooked in the + 2005-10-12 commit. + + * changes: Update in prep. for 8.5a4 release. + +2006-03-07 Joe English <jenglish@users.sourceforge.net> + + * unix/tcl.m4: Set SHLIB_LD_FLAGS='${LIBS}' on NetBSD, as per the other + *BSD variants. [Bug 1334613] + * unix/configure: Regenerated. + +2006-03-07 Donal K. Fellows <dkf@users.sf.net> + + * doc/canvas.n: Added note that stipples are not well-supported on + non-X11 platforms. [Bug 220787] It's not a great solution, but it does + indicate the state of affairs that has existed for years anyway; not + much modern software uses stipples anyway. + +2006-03-02 Jeff Hobbs <jeffh@ActiveState.com> + + * macosx/tkMacOSXDraw.c (TkPutImage): Fix endian issue on OS X x86 + displaying images. Bitmap images still have a black/white reversal + issue, appears to be a general OS X issue (as seen in frogger demo). + +2006-02-27 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkBitmap.c (Tk_GetBitmapFromData): Improve thread-safety. + [Bug 470322] + + * generic/tkImgBmap.c (ImgBmapConfigureInstance): Force creation of new + Pixmaps before deletion of old ones to prevent stupid caching problems. + [Bug 480862] + +2006-02-09 Daniel Steffen <das@users.sourceforge.net> + + * generic/tk.decls: fix signature of TkMacOSXInvalClipRgns + * generic/tkPlatDecls.h: to use Tk_Window instead of internal + * macosx/tkMacOSXSubwindows.c: type TkWindow (which led to any include + * macosx/tkMacOSXWindowEvent.c: of public header tkMacOSX.h requiring + * macosx/tkMacOSXWm.c: prior include of tkInt.h). + + * generic/tk.h: move TkAqua specific REDO_KEYSYM_LOOKUP define + * macosx/tkMacOSXPort.h: out of tk.h into platform header. + +2006-01-31 Donal K. Fellows <dkf@users.sf.net> + + * library/bgerror.tcl (::tk::dialog::error::bgerror): Finish the + internationalization of the error dialog. [Bug 1409264] + +2006-01-25 Don Porter <dgp@users.sourceforge.net> + + * library/bgerror.tcl: Updates to use Tcl 8.4 features. [Patch 1237759] + * library/choosedir.tcl: + * library/comdlg.tcl: + * library/console.tcl: + * library/dialog.tcl: + * library/focus.tcl: + * library/msgbox.tcl: + * library/palette.tcl: + * library/tk.tcl: + * library/tkfbox.tcl: + * library/xmfbox.tcl: + +2006-01-23 Daniel Steffen <das@users.sourceforge.net> + + * unix/configure: minor fix to Darwin specific code removing + * unix/configure.in: 64bit flags from CFLAGS for Tk build. + +2006-01-20 Joe English <jenglish@users.sourceforge.net> + + * generic/tkEvent.c, unix/tkUnixEvent.c: XIM fixes [See 905830, patch + tk84-xim-fixes.patch], and revert 2005-12-05 patch disabling XIM when + SCIM in use, and make sure all X events get passed to XFilterEvent, + including those without a corresponding Tk window. + +2006-01-13 Anton Kovalenko <a_kovalenko@users.sourceforge.net> + + * generic/tkUndo.c (TkUndoSetDepth): Don't free TkUndoSubAtoms for + separator entries that are deleted: there is some unpredictable garbage + instead of subatoms. + + Free both 'apply' and 'revert' action chains for non-separator entries. + +2006-01-12 Donal K. Fellows <dkf@users.sf.net> + + TIP #260 IMPLEMENTATION + + * generic/tkCanvText.c (TextItem, CreateText, DisplayCanvText): + * doc/canvas.n: Code, docs and tests to implement an -underline + * tests/canvText.test: option for canvases' text items. + +2006-01-11 Peter Spjuth <peter.spjuth@space.se> + + * generic/tkGrid.c: Removed a lingering error message from TIP#147 + implementation. + +2006-01-10 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDebug.c: add TkMacOSXGetNamedDebugSymbol() function + * macosx/tkMacOSXDebug.h: that finds unexported symbols in loaded + libraries by manually walking their symbol table; only to be used for + debugging purposes, may break unexpectedly in the future. Needed to get + access to private_extern internal debugging functions in HIToolbox. + + * macosx/tkMacOSXCarbonEvents.c: fix debug event tracing on Tiger. + * macosx/tkMacOSXMenu.c: add debug menu printing during reconfigure. + * macosx/tkMacOSXInit.c: conditionalize 64bit-unsafe dyld code. + * macosx/GNUmakefile: add 'wish8.x' symlink to SYMROOT. + + * macosx/Wish.xcode/project.pbxproj: fix copy to tktest resource + * macosx/Wish.xcodeproj/project.pbxproj: fork when zerolinked. + + * macosx/Wish.xcode/default.pbxuser: add widget demo as argument to + * macosx/Wish.xcodeproj/default.pbxuser: executables (on by default). + + * unix/configure: add caching, use AC_CACHE_CHECK instead of + * unix/configure.in: AC_CACHE_VAL where possible, consistent message + * unix/tcl.m4: quoting, sync relevant tclconfig/tcl.m4 changes + and gratuitous formatting differences, fix SC_CONFIG_MANPAGES with + default argument, Darwin improvements to SC_LOAD_*CONFIG. + +2005-12-28 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkUndo.c (TkUndoSetDepth): Apply [Patch 1391939] from Ludwig + Callewaert to fix [Bug 1380427]. + +2005-12-14 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Wish.xcode/project.pbxproj: + * macosx/Wish.xcodeproj/project.pbxproj: add new tclTomMath* files. + +2005-12-13 Daniel Steffen <das@users.sourceforge.net> + + * library/demos/cscroll.tcl: add MouseWheel bindings for aqua. + + * macosx/tkMacOSXCarbonEvents.c (TkMacOSXInitCarbonEvents): + * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent) + (GenerateMouseWheelEvent): add support for kEventMouseScroll events + (smooth mouse wheel scrolling from mighty mouse or scrolling trackpad) + by handling kEventMouseWheelMoved on application target as well as on + dispatcher, in order to pick up synthesized MouseWheel events from + HIObject handler (c.f. QA1453); add support for horizontal scrolling + events by generating MouseWheel XEvent with Shift modifier. + +2005-12-12 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/tcl.m4, unix/configure: Fix sh quoting error reported in + bash-3.1+ [Bug 1377619] (schafer) + +2005-12-09 Mo DeJong <mdejong@users.sourceforge.net> + + * win/tkWinWm.c (WinSetIcon): Don't check result of SetClassLong() or + SetClassLongPtr() since it was generating an incorrect error and the + MSDN docs indicate that the result need not be checked. + +2005-12-09 Mo DeJong <mdejong@users.sourceforge.net> + + * win/configure: Regen. + * win/tcl.m4 (SC_CONFIG_CFLAGS): Define MACHINE for gcc builds. The + lack of a definition of this variable in the manifest file was causing + a runtime error in wish built with gcc. + +2005-12-09 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkInt.decls: Move all platform test sources from tk lib into + * generic/tkTest.c: tktest directly, removes requirement to export + * macosx/tkMacOSXTest.c:TkplatformtestInit from internal stubs table. + * unix/Makefile.in: + * win/Makefile.in: + * win/makefile.vc: + * win/tkWinTest.c: + + * generic/tkIntPlatDecls.h: + * generic/tkStubInit.c: regen. + +2005-12-08 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tcl.m4: Add build support for Windows-x64 builds. + * win/configure: --enable-64bit now accepts =amd64|ia64 for + * win/Makefile.in: Windows 64-bit build variants (default: amd64) + * win/makefile.vc: [Bug 1369597] + (TKOBJS): add tkWinTest.obj to regular Tk obj for TkplatformtestInit + + * win/configure.in: Add CE build support (some C code fixes needed) + * win/wish.exe.manifest.in (new): manifest must map in MACHINE and + * win/rc/wish.exe.manifest (removed): VERSION to be correct. + * unix/Makefile.in: fix dist target for manifest dir change + + * generic/tkTextTag.c (TkTextTagCmd): use correct arraySize for peered + text widgets in [$text tag names]. [Bugs 1375069, 1374935] + +2005-12-08 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDraw.c: Remove inclusion of tclInt.h and use of tcl + * macosx/tkMacOSXFont.c: internals wherever possible in tk/macosx, the + * macosx/tkMacOSXInit.c: only remaining tcl internals in TkAqua are + * macosx/tkMacOSXNotify.c:TclServiceIdle() in tkMacOSXScrlbr.c and + * macosx/tkMacOSXScrlbr.c:Tcl_Get/SetStartupScript() in tkMacOSXInit.c + [RFE 1336531] + + * macosx/tkMacOSXInt.h: sync comments with core-8-4-branch. + +2005-12-07 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/tkUnixEvent.c (OpenIM): remove extraneous const + +2005-12-06 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * doc/ConfigWidg.3 (TK_CONFIG_OPTION_SPECIFIED): Mentioned that the + flag is deprecated because it is not thread-safe. + +2005-12-05 Reinhard Max <max@suse.de> + + * unix/tkUnixEvent.c (OpenIM): Added a workaround to allow at least + ASCII and the Compose key when typing into text and entry widgets on a + system that uses SCIM. This has to be taken out again once the SCIM + problems have been fixed. + +2005-12-01 Daniel Steffen <das@users.sourceforge.net> + + * unix/tcl.m4 (Darwin): fixed error when MACOSX_DEPLOYMENT_TARGET unset + * unix/configure: regen. + +2005-11-30 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinWm.c (WmAttributesCmd): set (no)topmost window aspect before + rewrapping. [Bug 1086049] + + * macosx/tkMacOSXXStubs.c (TkpOpenDisplay, TkMacOSXDisplayChanged): + * macosx/tkMacOSXWindowEvent.c (TkMacOSXProcessApplicationEvent): + * macosx/tkMacOSXCarbonEvents.c (TkMacOSXInitCarbonEvents): + * macosx/tkMacOSXEvent.h: Trap kEventAppAvailableWindowBoundsChanged + * macosx/tkMacOSXInt.h: event to watch for change in display size and + adjust internal state appropriately. + + * doc/checkbutton.n: fix -selectcolor docs. [Bug 1083838] + + * generic/tkImgGIF.c: cast calls to blockOut + + * win/Makefile.in: place TCL_BIN_DIR first in PATH for targets to get + Tcl built dll first. + Add tkWinTest.obj to tk84.dll to handle some needed test functions + being defined in stubs (TkplatformtestInit). + + * tests/scrollbar.test (6.22): fix rounding-error sensitive test + +2005-11-29 Jeff Hobbs <jeffh@ActiveState.com> + + * library/console.tcl (::tk::ConsoleInit): improve work-around to avoid + '% ' from tclMain.c. [Bug 1252259] + +2005-11-27 Daniel Steffen <das@users.sourceforge.net> + + * unix/tcl.m4 (Darwin): add 64bit support, check for Tiger copyfile(), + add CFLAGS to SHLIB_LD to support passing -isysroot in env(CFLAGS) to + configure (flag can't be present twice, so can't be in both CFLAGS and + LDFLAGS during configure), don't use -prebind when deploying on 10.4, + define TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING (rdar://3171542). + (SC_ENABLE_LANGINFO, SC_TIME_HANDLER): add/fix caching, fix obsolete + autoconf macros. Sync with tcl/unix/tcl.m4. + + * unix/configure.in: fix obsolete autoconf macros, sync gratuitous + formatting/ordering differences with tcl/unix/configure.in. + + * unix/Makefile.in: add CFLAGS to wish/tktest link to make executable + linking the same as during configure (needed to avoid loosing any + linker relevant flags in CFLAGS, in particular flags that can't be in + LDFLAGS). Avoid concurrent linking of wish and compiling of + tkTestInit.o during parallel make, fix dependencies and flags for + building tkMacOSXInit.o + (checkstubs, checkexports): dependency and Darwin fixes + (dist): add new macosx files. + + * macosx/tkMacOSXEvent.c (TkMacOSXProcessEvent): + * macosx/tkMacOSXEvent.h: + * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): + * macosx/tkMacOSXCarbonEvents.c: install standard application event + handler, add & call functions to start and stop carbon even timer that + runs the tcl event loop periodically during a nested carbon event loop + in the toolbox (e.g. during menutracking) to ensure tcl timers etc. + continue to fire, register app event handler for menu tracking and HI + command carbon events, move menu event handling to new handlers for + those carbon events, no longer register for/handle appleevent carbon + event (now dealt with by standard application event handler), event + debugging code dynamically acquires carbon event debugging functions to + allow use on Tiger where they are no longer exported from HIToolbox. + + * macosx/tkMacOSXFont.c (TkMacOSXUseAntialiasedText): + * macosx/tkMacOSXKeyEvent.c (GetKeyboardLayout): + * macosx/tkMacOSXCarbonEvents.c (TkMacOSXInitCarbonEvents): + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXInt.h: abstract common code to dynamically acquire + address of a named symbol (from a loaded dynamic library) into new + function TkMacOSXGetNamedSymbol() and macro TkMacOSXInitNamedSymbol. + + * macosx/tkMacOSXMenu.c (TkpNewMenu): + * macosx/tkMacOSXMenubutton.c (MenuButtonInitControl): + * macosx/tkMacOSXMenus.c (TkMacOSXHandleMenuSelect): switch to modern + utf-8 aware menu manager API, remove obsolete code, add error handling. + + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenus.c: + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXMouseEvent.c: define OSX 10.3 or later only constants + if necessary to allow compilation on OSX 10.2 + + * macosx/tkMacOSXWm.c (UpdateSizeHints): remove code that is never + executed. + + * xlib/xgc.c (XCreateGC): sync with core-8-4-branch change. + + * generic/tk.h: add/correct location of version numbers in macosx files + + * generic/tkInt.h: clarify fat compile comment. + + * macosx/Wish.pbproj/default.pbxuser (new): + * macosx/Wish.pbproj/jingham.pbxuser: + * macosx/Wish.pbproj/project.pbxproj: + * macosx/Wish.xcode/default.pbxuser: + * macosx/Wish.xcode/project.pbxproj: + * macosx/Wish.xcodeproj/default.pbxuser (new): + * macosx/Wish.xcodeproj/project.pbxproj (new): new/updated projects for + Xcode 2.2 on 10.4, Xcode 1.5 on 10.3 & ProjectBuilder on 10.2, with + native tktest targets and support for universal (fat) compiles. + + * macosx/Tk-Info.plist (removed): + * macosx/Wish-Info.plist (removed): + * macosx/buildTkConfig.tcl (removed): remove obsolete build files. + + * macosx/README: clarification/cleanup, document new Xcode projects and + universal (fat) builds via CFLAGS (i.e. ppc and i386 at the same time). + + * unix/Makefile.in: + * unix/aclocal.m4: + * unix/configure.in: + * macosx/configure.ac (new): add support for inclusion of + unix/configure.in by macosx/configure.ac, allows generation of a + config headers enabled configure script in macosx (required by Xcode + projects). + + * macosx/GNUmakefile: rename from Makefile to avoid overwriting by + configure run in tk/macosx, add support for reusing configure cache, + build target fixes. + + * generic/tk3d.h: + * generic/tkButton.h: + * generic/tkCanvas.c: + * generic/tkCanvas.h: + * generic/tkColor.h: + * generic/tkEntry.h: + * generic/tkFileFilter.h: + * generic/tkFont.c: + * generic/tkFont.h: + * generic/tkImage.c: + * generic/tkImgPhoto.c: + * generic/tkInt.h: + * generic/tkMenu.c: + * generic/tkMenu.h: + * generic/tkMenubutton.h: + * generic/tkScale.h: + * generic/tkScrollbar.h: + * generic/tkSelect.h: + * generic/tkStubInit.c: + * generic/tkStubLib.c: + * generic/tkText.h: + * generic/tkUndo.h: + * macosx/tkMacOSXButton.c: + * macosx/tkMacOSXDebug.c: + * macosx/tkMacOSXDebug.h: + * macosx/tkMacOSXDialog.c: + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXEntry.c: + * macosx/tkMacOSXFont.c: + * macosx/tkMacOSXInt.h: + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXSend.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXXStubs.c: + * unix/tkUnixButton.c: + * unix/tkUnixMenu.c: + * xlib/xgc.c: ensure externally visible symbols not contained in stubs + table are declared as MODULE_SCOPE (or as static if not used outside of + own source file), #ifdef out a few Xlib and aqua functions that are + never called. These changes allow 'make checkstubs' to complete without + error on Darwin with gcc 4. + + * macosx/tkMacOSXTest.c: + * macosx/tkMacOSXPort.h: + * win/tkWinTest.c: + * generic/tkInt.decls: add functions needed by tktest to internal stubs + table, correct signature of TkMacOSXHandleMenuSelect, add XSync to aqua + Xlib stubs. + + * unix/tkUnixSend.c: + * generic/tkText.c: + * generic/tkTest.c: #ifdef unix only declarations. + (TestmetricsCmd): unify win and mac implementation. + (TestsendCmd): move to tkUnixSend.c to avoid access to global var. + (TesttextCmd): move to tkText.c to avoid having to put all the internal + text functions it uses into the stubs table. + + * generic/tkTextDisp.c: + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXKeyEvent.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXXStubs.c: fix gcc 4 warnings. + + * macosx/tkMacOSXNotify.c: + * macosx/tkMacOSXScrlbr.c: sync with core-8-4-branch. + + * generic/tkIntDecls.h: + * generic/tkIntPlatDecls.h: + * generic/tkIntXlibDecls.h: + * generic/tkStubInit.c: + * unix/configure: + * unix/tkConfig.h.in: regen. + +2005-11-22 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/tkfbox.tcl: Remove all references to data(curItem), as it is + no longer used. [Bug 600313] + (::tk::IconList_CurSelection): Renamed for clarity. + + * doc/GetFont.3: Revert previous fix; a NULL interp is now legal. + * generic/tkFont.c (ParseFontNameObj, GetAttributeInfoObj): Allow these + functions to work with a NULL interp by making them check when + generating error messages. [Bug 1151523] + + * library/tkfbox.tcl (::tk::dialog::file::): Correct the quoting of the + script used in variable traces so that widget names with spaces in will + work. [Bug 1335485] + +2005-11-16 Vince Darley <vincentdarley@users.sourceforge.net> + + * doc/text.n: clarify left to right interpretation of index modifiers, + including the fact that validation occurs after each step. [Bug + 1357575] + +2005-11-15 Joe English <jenglish@users.sourceforge.net> + + * unix/tkUnixWm.c, tests/unixWm.test, doc/wm.n: Support for [wm + attributes] on X11. [TIP#231, Patch 1062022] + +2005-11-14 Joe English <jenglish@users.sourceforge.net> + + * library/bgerror.tcl: Truncate error messages at 45 characters + instead of 30. [Bug 1224235] + +2005-11-14 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkSelect.c (TkSelDefaultSelection): Test select-9.5 + highlighted further brokenness in this function. + +2005-11-13 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * unix/tkUnixSelect.c (SelCvtToX): Arrange for the parsing code to use + Tcl's list parsing code, another simplification that enables testing + of the [Bug 1353414] fix. + + * unix/tkUnixSelect.c (SelCvtFromX): Generate string forms of the + advanced selection types in a Tcl_DString. This makes fixing [Bug + 1353414] trivial, and simplifies the code at the same time. + * tests/select.test (select-9.5): Added test for [Bug 1353414] + +2005-11-10 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkBind.c (ChangeScreen): More DString fixes from + * generic/tkTextWind.c (EmbWinLayoutProc): [Bug 1353022] + * win/tkWinMenu.c (SetDefaults): + + * win/tkWinDialog.c (ConvertExternalFilename): Factored out the + encoding conversion and de-backslash-ing code that is used in many + places in this file. + (GetFileNameW, GetFileNameA, ChooseDirectoryValidateProc): Make sure + that data is freed correctly and that certain (hopefully impossible) + failure modes won't cause crashes. [Bug 1353022] + +2005-11-06 Pat Thoyts <pat@zsplat.freeserve.co.uk> + + * unix/tcl.m4: Fix SHLIB_LD_LIBS for building tclkit on OpenBSD. + * unix/configure: regenerated + +2005-10-31 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkText.c + * tests/textDisp.test: fix and test for [Bug 1333951] in '.text count + -displaylines'. + +2005-10-18 Don Porter <dgp@users.sourceforge.net> + + * generic/tkMain.c: Rewrote code that sets the ::argv value to be sure + conversion from the system encoding is complete before any processing + sensitive to list-special characters is done. [Bug 1328926] + +2005-10-17 Jeff Hobbs <jeffh@ActiveState.com> + + * macosx/tkMacOSXScrlbr.c (UpdateControlValues): check geomMgrPtr is + valid before checking type + +2005-10-15 Jeff Hobbs <jeffh@ActiveState.com> + + * library/menu.tcl (::tk::MenuUnpost): remove leftover ] from string + equal mods of 2005-07-25. (sowadsky) + +2005-10-14 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/tkWinSend.c: Avoid using tcl internal headers and fix to + * win/tkWinSendCom.h: correctly link on all types of build (was + * win/tkWinSendCom.c: broken in static,msvcrt builds). + +2005-10-12 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * tests/canvPs.test, tests/canvPsBmap.tcl, tests/canvPsImg.tcl: + * tests/imgPhoto.test, tests/menu.test: Arrange for the test suite to + only ever refer to images in the same directory as the tests. This + makes it possible to package the test suite itself as a starkit. Thanks + to David Zolli for suggesting this. + +2005-10-10 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkConfig.c (Tk_DeleteOptionTable, Tk_CreateOptionTable): + properly alloc/delete one more option. [Bug 1319720] (melbardis) + + * macosx/tkMacOSXInt.h: Move MODULE_SCOPE defn to tkInt.h and add + * generic/tkInt.h: WORDS_BIGENDIAN checks that will work with OS X + universal binary compiles. (steffen) + + * generic/tkMenu.c (TkSetWindowMenuBar): do not call TkMenuInit if the + winPtr indicates TK_ALREADY_DEAD. This prevents reinit that creates a + Tk exit handler after all exit handlers should be called. [Bug 749908, + 1322294] + +2005-10-10 Vince Darley <vincentdarley@users.sourceforge.net> + + TIP #256 IMPLEMENTATION + + * doc/text.n + * generic/tkText.c + * generic/tkText.h + * generic/tkTextBTree.c + * generic/tkTextDisp.c + * generic/tkTextImage.c + * generic/tkTextIndex.c + * generic/tkTextMark.c + * generic/tkTextTag.c + * generic/tkTextWind.c + * macosx/tkMacOSXDefault.h + * tests/text.test + * tests/textDisp.test + * unix/tkUnixDefault.h + * win/tkWinDefault.h: Implementation of TIP#256, adding a new text + widget configuration option '-tabstyle', with new tests and + documentation. + + Also a fix for [Bug 1281228] (documentation and full implementation of + -strictlimits), and [Bug 1288677] (corrected elide behaviour), again + with more tests. + +2005-10-04 Jeff Hobbs <jeffh@ActiveState.com> + + * library/dialog.tcl (::tk_dialog): add tkwait visibility before grab. + [Bug 1216775] + + * win/tkWinDialog.c (ChooseDirectoryValidateProc): reset stored path to + "" if it doesn't exist and -mustexist is true. [Bug 1309218] Remove + old-style dir chooser (no longer used). + + * macosx/tkMacOSXInt.h: add MODULE_SCOPE definition check for extension + writers that access private headers on OS X and don't define it in + configure. + +2005-09-28 Don Porter <dgp@users.sourceforge.net> + + * unix/tkUnixPort.h: Disabled inclusion of the private Tcl header + * win/tkWinPort.h: file tclInt.h. Tk ought to have a tiny and + shrinking number of calls of private Tcl routines. Each Tk source file + doing this should follow the convention in the macosx port and have its + own #include "tclInt.h". + + * generic/tkEvent.c: Disabled calls to private Tcl routine + TclInExit(). See comment in TkCreateExitHandler() for full rationale. + +2005-09-21 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkEvent.c (TkCreateThreadExitHandler, TkFinalizeThread) + (TkDeleteThreadExitHandler): New internal API (from Joe Mistachkin) to + allow Tk to finalize itself correctly in a multi-threaded + environment. [Bug 749908] + +2005-09-14 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkOldConfig.c (GetCachedSpecs): Split out the code to + manipulate the cached writable specs so that it can be reused from all + the public Tk_Configure* functions. + (Tk_ConfigureInfo, Tk_ConfigureWidget, Tk_ConfigureValue): Use the + factored out code everywhere, so we always manipulate the cache + correctly. [Bug 1288128] + +2005-09-13 Don Porter <dgp@users.sourceforge.net> + + * win/winMain.c (WishPanic): Replaced TCL_VARARGS* macros with direct + use of stdarg.h conventions. + +2005-09-11 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): check if + process is in front on MouseDown, otherwise request process activation + from BringWindowForward() via new isFrontProcess param. + + * macosx/tkMacOSXCarbonEvents.c (TkMacOSXInitCarbonEvents): register + our event handler on the dispatcher target for all carbon events of + interest to TkAqua; this replaces event processing directly from the + event queue and thus allows to capture events that are syntesized by + Carbon and sent directly to the dispatcher and not to the event queue. + + * macosx/tkMacOSXEvent.c: remove TkMacOSXCountAndProcessMacEvents(), + rename ReceiveAndProcessEvent() to TkMacOSXReceiveAndProcessEvent(). + (TkMacOSXReceiveAndProcessEvent): remove tk event processing before + sending events to the dispatcher, all events of interest are now + processed in our dispatcher target event handler. + + * macosx/tkMacOSXNotify.c (CarbonEventsCheckProc): dispatch events + directly via TkMacOSXReceiveAndProcessEvent(), but dispatch no more + than four carbon events at one time to avoid starving other event + sources. + + * macosx/tkMacOSXEvent.c: formatting cleanup, move XSync() to XStubs, + * macosx/tkMacOSXEvent.h: removed obsolete kEventClassWish handling. + * macosx/tkMacOSXXStubs.c + + * macosx/tkMacOSXEvent.h: declare macosx internal procs as MODULE_SCOPE + * macosx/tkMacOSXEvent.c: + * macosx/tkMacOSXKeyEvent.c: + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXWindowEvent.c: + + * macosx/tkMacOSXButton.c: conditionalize all debug message printing to + * macosx/tkMacOSXCursor.c: stderr via TK_MAC_DEBUG define. + * macosx/tkMacOSXDebug.c: + * macosx/tkMacOSXDebug.h: + * macosx/tkMacOSXDialog.c: + * macosx/tkMacOSXEvent.c: + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXKeyEvent.c: + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.c: + + * unix/configure.in: define TK_MAC_DEBUG on aqua when symbols enabled. + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in: autoheader-2.59 + + * library/listbox.tcl: synced aqua MouseWheel bindings with + * library/scrlbar.tcl: core-8-4-branch. + * library/text.tcl: + + * xlib/xcolors.c: fixed warning + +2005-08-25 Daniel Steffen <das@users.sourceforge.net> + + * unix/Makefile.in (html): reverted/amended changes of 2005-08-23 that + broke TkAqua 'make install'; added BUILD_HTML_FLAGS optional var like + in tcl/unix/Makefile.in. + +2005-08-24 Donal K. Fellows <dkf@users.sf.net> + + * tests/text.test (text-8.18): Fix punctuation of error message to + match good practice (actual message already fixed). [Bug 1267484] + +2005-08-23 Jeff Hobbs <jeffh@ActiveState.com> + + * macosx/tkMacOSXDialog.c: make dialogs ignore -initialfile "" and + -initialdir "" instead of error. + +2005-08-23 Mo DeJong <mdejong@users.sourceforge.net> + + * win/tkWin32Dll.c (DllMain): Replace old asm SEH approach with Kenny's + new SEH implementation. [Tcl Bug 1235544] + +2005-08-23 Mo DeJong <mdejong@users.sourceforge.net> + + * unix/Makefile.in: Subst BUILD_TCLSH and TCL_EXE. + * unix/configure: Regen. + * unix/configure.in: Update minimum autoconf version to 2.59. Invoke + SC_PROG_TCLSH and SC_BUILD_TCLSH. + * unix/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): + * win/Makefile.in: Subst BUILD_TCLSH and TCL_EXE. + * win/configure: Regen. + * win/configure.in: Update minimum autoconf version to 2.59. Invoke + SC_BUILD_TCLSH. + * win/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): Split confused search + for tclsh on PATH and build and install locations into two macros. + SC_PROG_TCLSH searches just the PATH. SC_BUILD_TCLSH determines the + name of the tclsh executable in the Tcl build directory. [Tcl Bug + 1160114] [Tcl Patch 1244153] + +2005-08-22 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXButton.c: + * macosx/tkMacOSXDialog.c: fix warnings. + +2005-08-20 Joe Mistachkin <joe@mistachkin.com> + + * win/tkWinX.c: Fixed bad cast. [Bug 1216006] + +2005-08-18 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * doc/GetFont.3: Reworded to reflect the truth. [Bug 1151523] + +2005-08-16 George Peter Staplin <GeorgePS@XMission.com> + + * doc/CrtItemType.3 prototypes were lacking [] after objv. Thus the man + page was wrong about the actual prototypes. This was verified by + studying tkCanvBmap.c. + +2005-08-13 Chengye Mao <chengye.geo@yahoo.com> + + * generic/tkOldConfig.c: Fixed [Bug 1258604]. This bug was introduced + into the modfied Tk_ConfigureWidget. It failed to properly handle the + specFlags' bit TK_CONFIG_OPTION_SPECIFIED. + +2005-08-12 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkOldConfig.c (Tk_ConfigureWidget): Stop storing per-thread + data in global data structures. Store it in per-interpreter data (i.e. + per-thread data) instead. [Bug 749908] + +2005-08-10 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkFrame.c (CreateFrame) and others: Don't use size_t when + working with Tcl_GetStringFromObj because it is not 64-bit clean. [Bug + 1252702] + +2005-08-04 Vince Darley <vincentdarley@users.sourceforge.net> + + * doc/text.n: Clarify behaviour of tab stops (as per [Bug 1247835]) + +2005-08-09 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXCarbonEvents.c (AppEventHandlerProc): handle carbon + events sent directly to application event target via the general + TkMacOSXProcessEvent() in the same way as events posted to the event + loop. Moved existing app event handlers to tkMacOSXWindowEvent.c. + (TkMacOSXInitCarbonEvents): register our application event handler for + kEventWindowExpanded events to deal with uncollapsing from the dock. + + * macosx/tkMacOSXEvent.h: made TkMacOSXProcessEvent() non-static, added + * macosx/tkMacOSXEvent.c: new interp field to TkMacOSXEvent struct for + use by app event handler. + + * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): retrieve + current window, partCode, modifiers and local cursor position from + carbon mouse event if possible. Use new static GenerateButtonEvent() + taking a MouseEventData struct instead of TkGenerateButtonEvent() to + avoid recomputing already known values. Move process activation on + MouseDown into BringWindowForward() to allow clicking on window + titlebar widgets without activating process. Move code dealing with + clicks in window titelbar into separate function + HandleWindowTitlebarMouseDown() to avoid code duplication. Avoid + repeated calls to TkMacOSXGetXWindow() by storing result in + MouseEventData struct. + (TkMacOSXButtonKeyState, XQueryPointer): try to get button and modifier + state from currently processed carbon event (to avoid unnecessary IPC + with the window server), otherwise use modern carbon API to get this + info instead of Button() and GetKeys(); only retrieve info caller asks + for (via non-NULL ptr passed to XQueryPointer). + (ButtonModifiers2State): new static function converting carbon button + and modifier state into tk state, allows detection of more than 3 mouse + buttons (tk supports up to 5) and of NumLock and Fn modifier keys + (NumLock is mapped to Mod3 and Fn to Mod4). + + * macosx/tkMacOSXWindowEvent.c (TkMacOSXProcessApplicationEvent): + handle kEventWindowExpanded event to deal with window uncollapsing from + the dock by generating tk Map event, handle kEventAppHidden and + kEventAppShown events (moved here from tkMacOSXCarbonEvents.c). + + * macosx/tkMacOSXSubwindows.c (XUnmapWindow): only hide window when it + is not iconified to avoid window flashing on collapse. + + * macosx/tkMacOSXWm.c: replaced Tk_DoWhenIdle() by Tcl_DoWhenIdle(). + (TkMacOSXZoomToplevel): remove call to TrackBox(), now done in + HandleWindowTitlebarMouseDown() in tkMacOSXMouseEvent.c. + (TkpWmSetState): avoid window flashing on collapse by unmapping after + calling CollapseWindow(); only uncollapse window if it is collapsed. + + * generic/tkInt.decls: changed TkMacOSXZoomToplevel() signature. + * generic/tkIntPlatDecls.h: + + * macosx/tkMacOSXKeyEvent.c (TkMacOSXProcessKeyboardEvent): only call + GetMenuItemCommandID() on KeyDown or KeyRepeat events. + + * macosx/tkMacOSXMenu.c (ReconfigureMacintoshMenu): remove call to + obsolete AppendResMenu() API. + + * macosx/tkMacOSXKeyEvent.c: replaced all direct uses of expensive + * macosx/tkMacOSXMenu.c: GetMouse() and TkMacOSXButtonKeyState() + * macosx/tkMacOSXMenus.c: APIs by calls to XQueryPointer() + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXScale.c: + * macosx/tkMacOSXScrlbr.c: + * macosx/tkMacOSXWm.c: + + * macosx/tkMacOSXDialog.c: replaced use of FrontNonFloatingWindow() + * macosx/tkMacOSXKeyEvent.c: by ActiveNonFloatingWindow() as + * macosx/tkMacOSXMenu.c: recommended by Carbon docs. + * macosx/tkMacOSXMenus.c: + * macosx/tkMacOSXSubwindows.c: + * macosx/tkMacOSXWm.c: + + * macosx/tkMacOSXDialog.c: fixed warnings + * macosx/tkMacOSXTest.c: + + * macosx/tkMacOSXCarbonEvents.c: added CVS Id line to file header. + * macosx/tkMacOSXDebug.c: + * macosx/tkMacOSXDebug.h: + * macosx/tkMacOSXEntry.c: + * macosx/tkMacOSXEvent.h: + * macosx/tkMacOSXKeyEvent.c: + * macosx/tkMacOSXMouseEvent.c: + * macosx/tkMacOSXWindowEvent.c: + * macosx/tkMacOSXWm.h: + + * macosx/tkMacOSXInt.h: declare macosx internal procs as MODULE_SCOPE. + * macosx/tkMacOSXCarbonEvents.c: + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXFont.c: + * macosx/tkMacOSXHLEvents.c: + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXWindowEvent.c + + * library/bgerror.tcl: sync with core-8-4-branch changes of 2005-07-28. + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXMouseEvent.c: + + * generic/tkFrame.c: sync with core-8-4-branch changes of 2005-07-27. + * generic/tkIntDecls.h: + * generic/tkStubInit.c: + * generic/tkFrame.c: + * win/tkWinDraw.c: + * unix/tkUnixDraw.c: + * macosx/tkMacOSXDraw.c: + * macosx/tkMacOSXInt.h: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXSubwindows.c: + + * macosx/tkMacOSXButton.c: sync with core-8-4-branch. + * macosx/tkMacOSXEntry.c: + * macosx/tkMacOSXScale.c: + + * library/demos/menu.tcl: removed errant '}'. + +2005-08-04 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * doc/clipboard.n: Add example demonstrating custom types of clipboard + data. + +2005-07-25 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/*.tcl: Updated to use more 8.4 and 8.5 features as part of + resolving [Patch 1237759]. + +2005-07-22 Mo DeJong <mdejong@users.sourceforge.net> + + * win/tkWinX.c: Define _WIN32_WINNT with NT SP 3 data to fix compiler + error because SendInput was not defined. The new msys_mingw7 release is + now needed to compile the HEAD with mingw gcc. [Bug 1210712] + +2005-07-21 Jeff Hobbs <jeffh@ActiveState.com> + + * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): corrected if + expression error (use of = instead of ==). + +2005-07-18 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkTextMark.c: fix to segfault in "mark prev" + * tests/textIndex.test: [Bug 1240221] + + * tests/textWind.test: make test more robust to avoid infinite loop + +2005-07-06 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/getOpenFile.n: correct -multiple docs (takes boolean) + +2005-07-05 Don Porter <dgp@users.sourceforge.net> + + * unix/Makefile.in: Purged use of TCLTESTARGS. [RFE 1161550] + +2005-06-23 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkConsole.c (TkConsolePrint): prevent potential NULL deref. + + * macosx/tkMacOSXDefault.h: change ENTRY_BORDER defaults to from 5 to 2 + to make default entry widgets in TkAqua look like in other aqua apps + (and have same border dimensions as other platforms). [Bug 1176610] + +2005-06-21 Donal K. Fellows <dkf@users.sf.net> + + * doc/GetBitmap.3: Fix silly error in SYNOPSIS. [Bug 1224983] + +2005-06-19 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkImgGIF.c: Cleanse all static (i.e. non-thread-safe) data + at a miniscule performance hit. + +2005-06-18 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Makefile: for X11 build, add -X11 suffix to unversioned wish + symbolic link. + + * unix/tcl.m4 (Darwin): add -headerpad_max_install_names to LDFLAGS to + ensure we can always relocate binaries with install_name_tool. + + * unix/configure: autoconf-2.59 + +2005-06-07 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + Bump patchlevel to a4 to distinguish from a3 release. + +2005-06-04 Jeff Hobbs <jeffh@ActiveState.com> + + *** 8.5a3 TAGGED FOR RELEASE *** + +2005-06-02 Jim Ingham <jingham@apple.com> + + * generic/tkEvent.c (InvokeFocusHandlers): On Mac OS X the scrollwheel + events are sent to the window under the mouse, not to the focus window + + Another patch from M. Kirkham. + + * macosx/tkMacOSXScrlbr.c (ThumbActionProc, ScrollBarBindProc): Record + the first mouse down point, and compute differences from that, rather + than getting the mouse down each time through the loop. The old method + would get fooled if you moved the mouse less than a text line height in + the text widget. [Bug 1083728] + +2005-06-03 Daniel Steffen <das@users.sourceforge.net> + + * macosx/Makefile: fixed 'embedded' target. + +2005-06-02 Reinhard Max <max@suse.de> + + * unix/tkUnix.c (Tk_GetUserInactiveTime): Improvements to get it + working on Solaris, and panic if we run out of memory. + * unix/configure.in: Rework the searching for Xss, to make it work on + Solaris and provide more useful output. Use AC_HELP_STRING where + appropriate. + * unix/tcl.m4: synced from Tcl. + * unix/configure: regenerated with autoconf 2.59. + +2005-06-01 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinInt.h: added private decls of Tk_GetEmbeddedMenuHWND, + Tk_GetMenuHWND, TkWinCleanupContainerList, and TkpWmGetState to that + are used across source files. + + * win/tkWinX.c (Tk_ResetUserInactiveTime): cast to squelch compiler + warning. + +2005-05-31 Reinhard Max <max@suse.de> + + * doc/Inactive.3 (new file): C level API documentationn for + TIP#245 (Tk_GetUserInactiveTime, Tk_ResetUserInactiveTime). + * tests/tk.test: Added tests for the TIP#245 implementation. + +2005-05-30 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkPanedWindow.c, tests/panedwindow.test: batch of fixes to + panedwindow from Daniel South. Improved auto-size to fit internal + windows, fixed sash placement at edge of pane, fixed calculation of + stretch amount for internal windows. [Bug 1124198, 1161543, 1054117, + 1010941, 795869, 690169, 1192323] + + * generic/tkMenu.c (MenuCmd): create event handler earlier to ensure + proper destruction of menu through DestroyNotify. [Bug 1159367] + + * library/console.tcl (::tk::ConsoleInit): print out first prompt and + swallow the extra "% " that comes once from Tcl on Windows. + +2005-05-29 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXFont.c: use Tcl_Panic instead of panic. + + * unix/configure.in: added description of HAVE_XSS for autoheader. + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in: autoheader-2.59 + + * macosx/Wish.pbproj/project.pbxproj: + * macosx/Wish.xcode/project.pbxproj: added missing FRAMEWORK defines + introduced with configure/make based build. + + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXNotify.c: fixed warnings. + + * generic/tkDecls.h: + * generic/tkIntPlatDecls.h: + * generic/tkPlatDecls.h: + * generic/tkStubInit.c: ran missing 'make genstubs' for TIP245 changes + to tk.decls + + * macosx/tkMacOSXXStubs.c (Tk_ResetUserInactiveTime): use symbolic + constant argument in call to UpdateSystemActivity(); + + * macosx/Wish.pbproj/project.pbxproj: + * macosx/Wish.xcode/project.pbxproj: + * unix/configure.in: added/corrected linking to IOKit.framework for + TIP245. + + * unix/configure.in: skip X11 configure checks when building tk_aqua. + * unix/configure: autoconf-2.59 + +2005-05-28 Donal K. Fellows <dkf@users.sf.net> + + TIP #245 IMPLEMENTATION from Reinhard Max <max@suse.de> + + * doc/tk.n: Documentation of [tk inactivity]. + * win/tkWinX.c (Tk_GetUserInactiveTime, Tk_ResetUserInactiveTime): + * unix/tkUnix.c (Tk_GetUserInactiveTime, Tk_ResetUserInactiveTime): + * macosx/tkMacOSXXStubs.c: Implementations of the core API for + (Tk_GetUserInactiveTime): determining how long as user's left + (Tk_ResetUserInactiveTime): her machine alone. + * unix/configure.in: Test for XScreenSaver support. + * generic/tkCmds.c (Tk_TkObjCmd): Implementation of [tk inactivity]. + +2005-05-27 Todd Helfter <tmh@users.sourceforge.net> + + * library/menu.tcl: correct the sticky behavior of menus posted by + tk_popup so that they "stick" after the initial <ButtonRelease> + following the post, that is not over an active menu entry. + +2005-05-26 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXInit.c (TkpInit): fixed resource file extraction from + __tk_rsrc section to work with non-prebound .dylib and .bundle. + + * macosx/Makefile: corrected EMBEDDED_BUILD check, use separate Tcl and + Tk version vars to properly support tk/x11 framework version + overriding, rewrite tkConfig.sh when overriding tk version, corrected + Wish.app symlink in tk build dir. + + * unix/configure.in: corrected framework finalization to softlink stub + library to Versions/8.x subdir instead of Versions/Current. + * unix/configure: autoconf-2.59 + +2005-05-25 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/Makefile.in (install-libraries): protect possible empty list in + for with list= trick for older shells. + +2005-05-23 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tkFileFilter.c (FreeGlobPatterns): s/null/NULL/ + +2005-05-24 Daniel Steffen <das@users.sourceforge.net> + + * generic/tkTest.c: disable commands not available on TkAqua. + + * macosx/Makefile: + * macosx/README: + * macosx/Tk-Info.plist.in (new file): + * macosx/Wish-Info.plist.in (new file): + * unix/Makefile.in: + * unix/configure.in: + * unix/tcl.m4: + * unix/tkUnixInit.c: moved all Darwin framework and TkAqua build + support from macosx/Wish.pbproj and macosx/Makefile into the standard + unix configure/make buildsystem, the project and macosx/Makefile are no + longer required to build Tk.framework and/or TkAqua. TkAqua is now + enabled by the --enable-aqua configure option, and static and + non-framework builds of TkAqua are now available via the standard + configure switches. Tk/X11 can also be built as a framework. The + macosx/Makefile now wraps the unix buildsystem and no longer uses the + projects, embedded builds are still only available via this Makefile, + but for other builds it is not longer required (but its current + functionality is still available for backwards compatibility). The + projects currently do not call through to the Makefile to build (unlike + Tcl.pbproj) so project builds may differ from makefile builds. Due to + issues with spaces in pathnames, 'Wish Shell.app' has been renamed to + 'Wish.app', the macosx/Makefile installs backwards compatibility + symlinks for the old name. + * macosx/tkMacOSXInit.c (TkpInit): added support for Tk resource file + in non-framework and static builds: the resource file is copied into a + __tk_rsrc MachO section of the library or executable at link time and + extracted into a temporary location at initialization. + * unix/configure: autoconf-2.59 + * unix/tkConfig.h.in (new file): autoheader-2.59 + + * macosx/Wish.pbproj/project.pbxproj: + * macosx/Tk-Info.plist: + * macosx/Wish-Info.plist: + * macosx/tkAboutDlg.r: updated copyright years to 2005. + +2005-05-22 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkFileFilter.c (TkGetFileFilters): Add all filters, not just + the first one. [Bug 1206133] + +2005-05-15 Jim Ingham <jingham@apple.com> + + Fixes from Michael Kirkham: + + * macosx/tkMacOSXMenu.c (TkpConfigureMenuEntry): Thinko in clearing the + ENTRY_ACCEL_MASK before re-parsing it. [Bug 1012852] + + * macosx/tkMacOSXScrlbr.c (UpdateControlValues): Don't set the control + value BEFORE setting the min and max or the control manager will reset + it for you. [Bug 1202181] + + * macosx/tkMacOSXXStubs.c (TkMacOSXXGetPixel, TkMacOSXXPutPixel): + Restore the port to what it was before putting we were called. [Bug + 1202223] + +2005-05-14 Jim Ingham <jingham@apple.com> + + * macosx/tkMacOSXScrlbr.c (ThumbActionProc): Missing Tcl_Release. + +2005-05-14 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXNotify.c: introduction of new tcl notifier based on + CFRunLoop allows replacement of the custom TkAqua notifier by a + standard tcl event source. Removes requirement of threaded tcl core + for TkAqua, allows to stub-link TkAqua against Tcl by removing use of + the unstubbed TclInitNotifier & TclFinalizeNotifier. [Tcl Patch + 1202052] + + * macosx/Wish.xcode/project.pbxproj: + * macosx/Wish.pbproj/project.pbxproj: stub-link TkAqua: build with + USE_TCL_STUBS and link against libtclstub instead of Tcl.framework, + unexport libtclstub symbols from Tk to avoid duplicate symbol warnings + when linking with both Tcl and Tk, fixes for gcc4.0 warnings. + + * macosx/Wish.xcode/project.pbxproj: sync with Wish.pbproj changes + since 2004-11-19. + NOTE: to use this project, need to uncomment the tclConfig.h settings + at the top of tcl/unix/configure.in, autoconf and rebuild tcl ! + + * macosx/tkMacOSXBitmap.c: + * macosx/tkMacOSXButton.c: + * macosx/tkMacOSXDialog.c: + * macosx/tkMacOSXFont.c: + * macosx/tkMacOSXHLEvents.c: + * macosx/tkMacOSXInit.c: + * macosx/tkMacOSXKeyboard.c: + * macosx/tkMacOSXMenu.c: + * macosx/tkMacOSXMenubutton.c: + * macosx/tkMacOSXWm.c: + * macosx/tkMacOSXXStubs.c: fixed gcc 4.0 warnings. + + * unix/tcl.m4: sync with tcl + * unix/configure: autoconf-2.59 + +2005-05-10 Vince Darley <vincentdarley@users.sourceforge.net> + + * library/text.tcl: test and fix to TextPrevPara to avoid infinite loop + * tests/textIndex.test: at start of widget. [Bug 1191895] + + * generic/tkTextDisp.c: better synchronisation between explicit and + implicit pixel line-height calculations. [Bug 1186558] + +2005-05-10 Don Porter <dgp@users.sourceforge.net> + + * generic/tkTextDisp.c (GetXView): Improved numerical precision of + calculation of [.t xview] return values. + * tests/textDisp.test: Match greater precisions of [.t xview] and + [.t yview] values in tests. + +2005-05-06 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/configure: regen + * unix/configure.in: Add AC_C_BIGENDIAN check and pkg-config xft checks + to extend xft search. + * unix/tcl.m4: Correct Solaris 10 (5.10) check and add support for + x86_64 Solaris cc builds. + +2005-04-28 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * macosx/tkMacOSXNotify.c (TkMacOSXWaitForEvent): Fix for typo in + waitTime computation. [Bug 1191097] + (AlertNotifier): Factor out the core of the notifier alerting code. + +2005-04-25 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXNotify.c: sync with tclUnixNotfy.c changes since + 2004-06-22, added compile time check for threaded tcl core, removed + unthreaded code paths as they are never used anyway, fixed + TkMacOSXAlertNotifier() implementation. + + * unix/Makefile.in: added TCL_STUB_LIB_FILE, needed for unexporting of + symbols from libtclstub to avoid duplicate symbol warnings. + + * unix/tcl.m4 (Darwin): added configure checks for recently added + linker flags -single_module and -search_paths_first to allow building + with older tools (and on Mac OS X 10.1), use -single_module in SHLIB_LD + and not just T{CL,K}_SHLIB_LD_EXTRAS, added unexporting from Tk of + symbols from libtclstub to avoid duplicate symbol warnings, added + PLAT_SRCS definition for Mac OS X, defined MODULE_SCOPE to + __private_extern__. + (SC_MISSING_POSIX_HEADERS): added caching of dirent.h check. + + * unix/configure: autoconf-2.59 + +2005-04-22 George Peter Staplin <GeorgePS@XMission.com> + + * doc/FontId.3: I fixed a typo. "linespace" was used instead of + "ascent". I also added a .PP before the paragraph to make the + formatting look better for the ascent paragraph. + +2003-04-18 Joe English <jenglish@users.sourceforge.net> + + * unix/tkUnixRFont.c(Tk_MeasureChars): Use Tcl_UtfToUnichar() for lax + UTF-8 parsing instead of strict parsing with FcUtf8ToUcs4() + [fix/workaround for Bug 1185640] + +2003-04-18 Vince Darley <vincentdarley@users.sourceforge.net> + + * library/text.tcl + * doc/text.n: corrected 'Home' and 'End' and Control-a/e handling to + work with display lines. This was an ommission of the previous tip155 + patch. Clarified the documentation on this point. + +2005-04-14 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/tkUnixFont.c (FontMapLoadPage): reorder char[] decls to avoid + possible segv. Minimal fix for [Bug 1122671] + +2005-04-12 Jeff Hobbs <jeffh@ActiveState.com> + + * library/tkfbox.tcl (::tk::dialog::file::): fix typeMenuLab ref. Add + undoc'd ::tk::dialog::file::showHiddenBtn var (default 0) that will add + a "Show Hidden" checkbutton to tk_get*File and tk_chooseDirectory if + set to true. + * library/choosedir.tcl (::tk::dialog::file::chooseDir::): fix + cancelBtn ref, add hiddenBtn ref for "Show Hidden" button. + +2005-04-09 Daniel Steffen <das@users.sourceforge.net> + + * macosx/README: updated requirements for OS & developer tool versions + + other small fixes/cleanup. + + * macosx/tkMacOSXEntry.c (ComputeIncDecParameters): manually define + constants present only in 10.3 headers so that we can build on 10.2. + + * macosx/Wish.pbproj/project.pbxproj: fixed absolute path to tkEntry.h + that confused 10.2 PBX. + + * unix/tcl.m4 (Darwin): added -single_module linker flag to + TCL_SHLIB_LD_EXTRAS and TK_SHLIB_LD_EXTRAS. + * unix/configure: autoconf-2.59 + +2005-04-07 Mo DeJong <mdejong@users.sourceforge.net> + + * macosx/tkMacOSXWm.c (TkWmStackorderToplevelWrapperMap, + (TkWmStackorderToplevel): + * unix/tkUnixWm.c (TkWmStackorderToplevelWrapperMap, + (TkWmStackorderToplevel): + * win/tkWinWm.c (TkWmStackorderToplevelWrapperMap, + (TkWmStackorderToplevel): + Fix panic in wm stackorder when a toplevel is created on another + display. The code now ignores toplevels that have a display that does + not match the display of the parent window. [Bug 1152809] + +2005-04-06 Donal K. Fellows <dkf@users.sf.net> + + * doc/wm.n, doc/winfo.n, doc/tk.n, doc/send.n, doc/selection.n: + * doc/radiobutton.n, doc/photo.n, doc/options.n, doc/menu.n: + * doc/listbox.n, doc/getOpenFile.n, doc/font.n, doc/event.n: + * doc/entry.n, doc/clipboard.n, doc/checkbutton.n, doc/canvas.n: + * doc/button.n, doc/bind.n, doc/TextLayout.3, doc/MeasureChar.3: + * doc/GetRelief.3, doc/GetPixels.3, doc/GetJustify.3, doc/GetFont.3: + * doc/GetCursor.3, doc/GetColor.3, doc/GetBitmap.3, doc/GetAnchor.3: + * doc/FontId.3, doc/CrtWindow.3, doc/CrtImgType.3, doc/ConfigWidg.3: + * doc/3DBorder.3: Purge old .VS/.VE macro instances. + +2005-04-04 Don Porter <dgp@users.sourceforge.net> + + * library/comdlg.tcl: Added Macintosh file type validation to + [::tk::FDGetFileTypes]. [Bug 1083878] (Thanks, Vince Darley) + +2005-04-04 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkText.c: + * tests/text.test: fix to elide searching problems [Bug 1174269] and + disappearing cursor with insertofftime 0. [Bug 1169429] + +2005-04-03 Peter Spjuth <peter.spjuth@space.se> + + * tests/grid.test: + * generic/tkGrid.c: Fixed bug in geometry calculations for widgets that + span multiple columns/row. Bug was introduced in 8.5a1 when fixing + 792387. [Bug 1175092] + +2005-03-29 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tcl.m4, win/configure: do not require cygpath in macros to allow + msys alone as an alternative. + +2005-03-27 Vince Darley <vincentdarley@users.sourceforge.net> + + * tests/textDisp.test: added test for fix of 2005-03-15. + +2005-03-24 Jim Ingham <jingham@apple.com> + + * macosx/tkMacOSXEntry.c (TkpDrawEntryBorderAndFocus): Dopey bug - do + not reset the width for entry widgets - we didn't change it for them. + +2005-03-23 Jim Ingham <jingham@apple.com> + + These changes allow us to draw the Entry and Spinbox widget with a + native look and feel on Mac OS X. + + * generic/tkEntry.h: New file, extracting the definitions of Entry and + Spinbox. + * generic/tkEntry.c (DisplayEntry): Call out to TkpDrawSpinboxButtons + and TkpDrawEntryBorderAndFocus. Also provide default implementations + for X11 & Win. + * macosx/tkMacOSXEntry.c: New file, implements the entry & focus and + spinbox button drawing. + * tkMacOSXDefaults.h: Change the Mac OS X defaults so they fit the + native widget shapes. + + This is cleanup thanks to Neil Madden <nem@cs.nott.ac.uk>. + + * macosx/tkMacOSXWm.c (TkMacOSXWinStyle) New function. + (TkUnsupported1ObjCmd): New function, replaces the un-objectified + version of the command. + * generic/tkInt.h: Swap TkUnsupported1Cmd for TkUnsupported1ObjCmd. + * generic/tkWindow.c (): Ditto. + + This adds a "-notify" flag to "wm attributes" that will bounce the + dock icon on Mac OS X. This is from Revar Desmera <revarbat@gmail.com> + + * macosx/tkMacOSXWm.c (WmAttrGetNotifyStatus, WmAttrSetNotifyStatus): + New functions. + (WmAttributesCmd): Add the -notify. + * doc/wm.n: Document -notify. + +2005-03-19 Donal K. Fellows <dkf@users.sf.net> + + * generic/tkConsole.c (Tk_CreateConsoleWindow,TkConsolePrint): Rewrite + so that TkConsolePrint cannot become detached from the console when the + [console] command is renamed. [Bug 1016385] + +2005-03-15 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkTextDisp.c: fix for [Bug 1143776] in adjusting displayed + lines when running into the bottom of the window. + +2005-03-14 Jim Ingham <jingham@apple.com> + + * macosx/tkMacOSXScrlbr.c (ThumbActionProc): No need to use "update + idletasks" here, TclServiceIdle will do as well and it is simpler. + + These changes implement a change on the Mac OS X side. When we unmap a + window we mark all its children as unmapped (not following toplevels. + But we preserve whether they had been mapped before, and when the + parent is remapped, we remap the children as well. [Bug 940117] + + * macosx/tkMacOSXInt.h: Added TK_MAPPED_IN_PARENT + * macosx/tkMacOSXSubwindows.c (FixMappingFlags): New function. + (XMapWindow): Call FixMappingFlags. + (XUnMapWindow): Ditto. + + * macosx/tkMacOSXSubwindows.c (XMoveResizeWindow): Update the xOff & + yOff data in the Macdrawable even if the native window hasn't been + created yet. [Bug 700305] + (XMoveWindow): Ditto. + (XResizeWindow): Ditto. + +2005-03-15 Pat Thoyts <patthoyts@users.sourceforge.net> + + * unix/tcl.m4: Updated the OpenBSD configuration and regenerated the + * unix/configure: configure script. + +2005-03-14 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkEvent.c (InvokeClientMessageHandlers): Ensure that client + messages are handled correctly. Thanks to George Petasis for tracking + this down. [Bug 1162356] + +2005-03-11 Jim Ingham <jingham@apple.com> + + * macosx/tkMacOSXButton.c (TkpDisplayButton): Set the port to the + Button window's port BEFORE you set the clip, otherwise you are setting + the clip on the wrong window! + Also, a little cleanup - move x & y into the branches where they are + used, and don't compute the TextAnchor if we are using the native + button text, since we aren't going to use it. + (TkMacOSXDrawControl): Call ShowControl & SetControlVisibility in a + more logical order. + + * tkMacOSXInt.h: Add TkMacOSXGenerateFocusEvent. + * tkMacOSXSubwindows.c (XDestroyWindow): We don't get Activate events + for the remaining windows when a Floating window is destroyed. This can + cause the focus to disappear. So catch this case when the window is + being destroyed and move the focus here. + + * tkMacOSXWindowEvent.c (TkMacOSXGenerateFocusEvent): Make this public + (used to be GenerateFocusEvent) since we need it here and in + tkMacOSXSubwindows.c. Then change the name everywhere it is used. [Bug + 1124237] + +2005-03-10 Jim Ingham <jingham@apple.com> + + * macosx/tkMacOSXMouseEvent.c (TkMacOSXProcessMouseEvent): In the + inDrag section, set the GrafPort to the drag window's GrafPort before + doing LocalToGlobal. [Bug 1160025] + +2005-03-09 Jim Ingham <jingham@apple.com> + + * macosx/tkMacOSXInit.c (TkpInit): Check to see if the environment + variable XCNOSTDIN is set, and if so, close stdin & stdout. This is + necessary to make remote debugging under Xcode work properly. + +2005-03-08 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinWm.c (WinSetIcon): fix GCLP_ICONSM -> GCLP_HICONSM. + + * win/makefile.vc: clarify necessary defined vars that can come from + MSVC or the Platform SDK. + +2005-02-28 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinX.c (GenerateXEvent): correct %A translation on MouseWheel. + [Bug 1118340] + +2005-02-24 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSX.h: fixed incorrect inclusion of internal header. + * macosx/tkMacOSXNotify.c: corrected included headers. + +2005-02-22 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXDialog.c (Tk_GetSaveFileObjCmd, NavServicesGetFile): + fixed encoding problems with -initialfile & -filetypes and corrected + potential buffer overrun with -initialdir/-initialfile. [Bug 1146057] + +2005-02-16 Mo DeJong <mdejong@users.sourceforge.net> + + TIP#223 IMPLEMENTATION + + * doc/wm.n: Add documentation for -fullscreen attribute. + * tests/winWm.test: Add -fullscreen to wm attribute usage message. + * tests/wm.test: Add -fullscreen to wm attribute usage message. Add + -fullscreen attribute test cases for Windows. + * win/tkWinWm.c (WmInfo, UpdateWrapper, TkpWmSetFullScreen) + (WmAttributesCmd, UpdateGeometryInfo): + Implement TIP 223 [wm attributes -fullscreen]. + +2005-02-14 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkText.c: + * generic/tkText.h: + * generic/tkTextDisp.c: + * generic/tkTextIndex.c: + * generic/tkTextBTree.c: + * doc/text.n: + * tests/textDisp.test: + * tests/textIndex.test: fix of longstanding elide problem when eliding + a newline without eliding the entire logical line. [Bug 443848] + +2005-02-14 Jeff Hobbs <jeffh@ActiveState.com> + + * doc/options.n: note -cursor {} behavior. [Bug 965618] + +2005-02-14 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * tests/all.tcl: Add a [package require Tk] so that a missing display + causes an early failure and keeps the error trace short. Issue observed + in [FRQ 11122147], even though that's unrelated. + +2005-02-11 Jeff Hobbs <jeffh@ActiveState.com> + + * library/panedwindow.tcl (::tk::panedwindow::Cursor): check window + existence on delayed call. [Bug 949792] + + * doc/text.n: note 'image' key in 'dump' command. [Bug 1115907] + + * win/tkWinWm.c (TkWinGetIcon): fix toplevel retrieval for determining + icon ref (potential crash). [Bug 1105738] + + * generic/tkCanvBmap.c (ConfigureBitmap, ComputeBitmapBbox): Fixed + possible crash with disabled bmap and bbox handling [Bug 1119460] + (BitmapToPostscript): made aware of various bitmap types + + * unix/Makefile.in: remove SHLIB_LD_FLAGS (only for AIX, inlined into + * unix/tcl.m4: SHLIB_LD). Combine AIX-* and AIX-5 branches in + * unix/configure: SC_CONFIG_CFLAGS. Correct gcc builds for AIX-4+ and + HP-UX-11. autoconf-2.59 gen'd. + +2005-02-09 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * tests/wm.test: Convert to use more tcltest2 features. + +2005-02-07 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkCanvas.c (CanvasWidgetCmd): Fix stupid mistake in variable + names, reported by Andreas Leitgeb. + +2005-02-03 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkCanvas.c (GetStaticUids): New function to manage the + thread-specific data detailing the list of all uids in a thread. + (typeList): Protect this (the other piece of global data) with a mutex. + [Bug 1114977] + +2005-01-31 Jeff Hobbs <jeffh@ActiveState.com> + + * unix/tcl.m4, unix/configure: add solaris-64 gcc build support. [Bug + 1021871] + +2005-01-31 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tkImgPhoto.c (PhotoFormatThreadExitProc): Made the comments + in the code more relevant to the function they were documenting! [Bug + 1110553] + + * library/msgs/es_ES.msg: Added more localization for Spanish Spanish. + [Bug 1111213] + +2005-01-25 Daniel Steffen <das@users.sourceforge.net> + + * macosx/tkMacOSXInit.c (TkpInit): set tcl_interactive to 1 to show + console at startup instead of directly calling [console show]. + + * unix/tcl.m4 (Darwin): fixed bug with static build linking to dynamic + library in /usr/lib etc instead of linking to static library earlier in + search path. [Tcl Bug 956908] + Removed obsolete references to Rhapsody. + * unix/configure: autoconf-2.57 + +2005-01-18 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * library/demos/menu.tcl: Reworked to make dialogs children of the + demo widget so that they are properly visible. Issue reported by Keith + Nash <k.j.nash@usa.net> + +2005-01-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * library/tkfbox.tcl (IconList_Selection, IconList_Create): + (IconList_Arrange): Assorted tk_getOpenFile fixes. [part of Bug 600313] + (IconList_ShiftMotion1): Also fix shift-drag. + +2005-01-12 Don Porter <dgp@users.sourceforge.net> + + * unix/tcl.m4: Sync'ed to Tcl's copy. + * unix/configure: autoconf-2.57 + +2005-01-12 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * doc/event.n: Added section on predefined virtual events. [Bug 608115] + +2005-01-11 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tkTextDisp.c: fix to scrollbar height calculations of text + widgets containing a single very long (wrapped) line. This fixes at + least part of [Bug 1093631]. + +2005-01-11 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tkObj.c (TkParsePadAmount): + * generic/tkPack.c: Moved function to tkObj.c and rewrote so that it + takes advantage of Tcl_Objs properly and cannot leave objects in an + inconsistent state. [Bug 1098779] + +2005-01-10 Joe English <jenglish@users.sourceforge.net> + + * unix/Makefile.in, unix/configure.in, unix/tkConfig.sh.in: + Remove ${DBGX}, ${TK_DBGX} from Tk build system. [Patch 1081595] + * unix/tcl.m4: re-synced with tcl/unix/tcl.m4 + * unix/configure: Regenerated. + +2005-01-07 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tkWindow.c (GetScreen): Make sure the result is reset on all + error paths to stop strange errors. [Bug 697915] + +2005-01-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * doc/loadTk.n, doc/toplevel.n: Convert to other form of emacs mode + control comment to prevent problems with old versions of man. [Bug + 1085127] + +2005-01-03 Jeff Hobbs <jeffh@ActiveState.com> + + * win/tkWinWm.c (TkWinWmCleanup): clean up layered window class. This + caused crash in reinit of Tk (as seen in plugin). + + ****************************************************************** + *** CHANGELOG ENTRIES FOR 2004 AND 2003 IN "ChangeLog.2004" *** + *** CHANGELOG ENTRIES FOR 2002 AND EARLIER IN "ChangeLog.2002" *** + ****************************************************************** @@ -1,18 +1,18 @@ README: Tk - This is the Tk 8.5.18 source distribution. + This is the Tk 8.6.4 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tk from the URL above. 1. Introduction --------------- -This directory contains the sources and documentation for Tk, a -cross-platform GUI toolkit implemented with the Tcl scripting language. +This directory contains the sources and documentation for Tk, an X11 +toolkit implemented with the Tcl scripting language. For details on features, incompatibilities, and potential problems with -this release, see the Tcl/Tk 8.5 Web page at +this release, see the Tcl/Tk 8.6 Web page at - http://www.tcl.tk/software/tcltk/8.5.html + http://www.tcl.tk/software/tcltk/8.6.html or refer to the "changes" file in this directory, which contains a historical record of all changes to Tk. @@ -6500,12 +6500,23 @@ Several documentation and release notes improvements --- Released 8.5.2, March 28, 2008 --- See ChangeLog for details --- +2008-04-01 (interface)[1819422] tkStubsPtr no longer in libtk (porter) + *** POTENTIAL INCOMPATIBILITY *** + +2008-04-02 (interface)[1819422] libtkstub symbols MODULE_SCOPE (steffen) + 2008-04-07 (bug fix)[1937135] Tk_ParseArgv() double free crash (hobbs) 2008-04-07 (bug fix)[1936238] wish -h mem explosion (bachmann,kenny) +2008-04-08 (new feature) Win: visual-styles API element engine (thoyts) + +2008-04-09 (enhancement) real LZW compression in GIF writer (nijtmans) + 2008-04-14 (bug fix)[1941740] [tk_chooseColor -title] (thoyts) +2008-04-16 (interface)[1938497] make stubs tables 'static const' (steffen) + 2008-04-17 (bug fix)[1327482] canvas item <Enter> events (wangnick) 2008-05-23 (bug fix)[1967576] ttk::label height or width 0 panic (lawlor) @@ -6516,12 +6527,17 @@ Several documentation and release notes improvements 2008-06-12 (platform support) Solaris/amd64 gcc 64bit support (steffen) +2008-06-13 (new feature)[TIP 285] [tkwait] and [update] are now +[interp cancel]able (mistachkin) + 2008-06-18 (bug fix) Aqua: missing focus on first map (steffen) ---- Released 8.5.3, June 30, 2008 --- See ChangeLog for details --- +--- Released 8.6a1, June 25, 2008 --- See ChangeLog for details --- 2008-07-04 (bug fix)[2009213] crash in [ttk::scale] (polo,english) +2008-07-24 (bug fix)[2021443] consistent "wrong # args" messages (nijtmans) + 2008-07-26 (bug fix)[2026405] portability of [winfo id] (uchida,thoyts) 2008-07-31 (bug fix) export Tk_PkgInitStubsCheck; fixes Tk embed on Windows @@ -6531,12 +6547,15 @@ Several documentation and release notes improvements 2008-08-05 (bug fix)[2010422] Tk header files revised to accommodate incompatible changes in recent X.org releases of X11 headers. (jenglish) ---- Released 8.5.4, August 15, 2008 --- See ChangeLog for details --- +2008-08-19 (bug fix) revised number format in -[xy]scrollcommand callbacks +and [xy]view methods (jenglish) + *** POTENTIAL INCOMPATIBILITY *** + +2008-08-19 (enhancement) removed obsolete XID management code (staplin) -2008-08-19 (behavior change) arguments passed to -[xy]scrollcommand -callbacks, and values returned by [xy]view methods are explicitly -formatted as doubles. (english) - *** POTENTIAL INCOMPATIBILITY *** +Test suite modernization by Ania Pawelczyk. + +--- Released 8.6a2, August 25, 2008 --- See ChangeLog for details --- 2008-08-25 (bug fix)[1936220] fix [tk_getOpenFile -multiple 1] on unix (helfter) @@ -6544,48 +6563,100 @@ formatted as doubles. (english) 2008-08-28 (bug fix) correct TK_LIBS value to include Xft (porter) +2008-09-03 (support) Dropped support for pre-ANSI compilers. (porter) + +2008-10-01 (new feature)[TIP 236] [$canvas moveto] (mckay,fellows) + 2008-10-05 (bug fix)[2112563] format double values explicitly in double format, avoiding sensitivity to locale setting. (fellows) - *** POTENTIAL INCOMPATIBILITY *** - -2008-10-10 (bug fix)[1894038] [package require] any Tk 8.5.* in any Tcl 8.5.* -(porter) + *** POTENTIAL INCOMPATIBILITY *** ---- Released 8.5.5, October 15, 2008 --- See ChangeLog for details --- +--- Released 8.6a3, October 10, 2008 --- See ChangeLog for details --- 2008-10-17 (enhancement) keyboard bindings for ttk::scale (thoyts) +2008-10-18 (bug fix)[1825353] Russian Windows tiny fonts problem (thoyts) + +2008-10-18 (new feature)[TIP 321] [tk busy] (decoster,fellows) + +2008-10-28 (bug fix)[1534835,2054562] use of more correct cursors (english) + +2008-11-01 (new feature) New [ttk::spinbox] widget (thoyts) + +2008-11-01 (new feature)[TIP 97] [$canvas imove] [$canvas rchars] (fellows) + +2008-11-09 (bug fix)[2207435] [ttk::entry .t -textvar ::noexist::x] (english) + +2008-11-11 (bug fix)[2312027] Tk_Create*ImageType() thread safety (nijtmans) + +2008-11-11 (bug fix)[2264732] crash using nondefault visual (english) + 2008-11-12 (bug fix)[1777362] permit [text] names containing "-" (thoyts) -2008-11-15 (bug fix)[2239034] limit [wm manage] to Frames (thoyts) +2008-11-14 (bug fix)[2239034] limit [wm manage] to Frames (thoyts) -2008-11-19 (bug fix)[2312027] Tk_Create*ImageType() thread safety (nijtmans) +2008-11-22 (new feature)[TIP 119] -angle option for canvas text items (fellows) 2008-11-22 (bug fix)[1939129,1991930] combobox behind other windows (thoyts) -2008-12-22 (bug fix)[1813597,2218964] eliminate unnecessary units conversion +2008-11-22 (new feature) Demo ctext.tcl now demos angled text (fellows) + +2008-11-23 (bug fix)[1389270] made [event generate <Focus*>] work (thoyts) + +2008-11-28 (bug fix)[1813597,2218964] eliminate unnecessary units conversion in screen distances, reducing precision loss (ferrieux) -2008-12-22 (bug fix)[2107938] no negative font size in PS (fellows) +2008-12-03 (enhancement) new "hover" state for proper Vista visuals (thoyts) + +2008-12-05 (bug fix)[2107938] no negative font size in PS (fellows) + +2008-12-05 (enhancement) new "vista" theme (thoyts) + +2008-12-06 (new feature)[TIP 197] [$text -insertunfocussed] (edwards,fellows) + +2008-12-06 (new feature)[TIP 337] handle non-error bg exceptions (porter) + +2008-12-10 (new feature)[TIP 324] [tk fontchooser](thoyts,vetter,robert,steffen) + +2008-12-12 (new feature) Demo fontchoose.tcl demos [tk fontchooser] (thoyts) + +2008-12-18 (enhancement)[24442309] Updated German messages (haertel) -2008-12-22 (bug fix)[2264732] crash using nondefault visual (english) +--- Released 8.6b1, December 19, 2008 --- See ChangeLog for details --- -2008-12-22 (bug fix)[2207435] [ttk::entry .t -textvar ::noexist::x] (english) +2008-12-27 (bug fix)[2381555] horiz. scroll [$treeview identify] (english) ---- Released 8.5.6, December 23, 2008 --- See ChangeLog for details --- +2008-12-28 (new feature)[TIP 244] PNG photo format support (fellows) + +2008-12-28 (new feature)[TIP 171] <MouseWheel> event handling (fellows) + *** POTENTIAL INCOMPATIBILITY *** + +2008-12-31 (bug fix)[2003310] radio|check button indicator color (english) + +2009-01-06 (bug fix)[2484771] messagebox: system to task modal (ferrieux,thoyts,mjanssen) + +2009-01-06 (enhancement)[1539990] optimize photo building (jepler) + +2009-01-07 (bug fix)[2473120] chooseDir syntax error (bron) 2009-01-07 (bug fix)[1847002] Win: prevent grab bypass (thoyts) +2009-01-11 (bug fix)[2496162] crash calling Tk_DeleteOptionTable() (english) + 2009-01-11 (bug fix) crash on XCreateIC failure (staplin) 2009-01-14 (bug fix)[2507326] Restore aMSN compat (nijtmans) -2009-01-19 (new feature) CONFIG_INSTALL_DIR - where tclConfig.sh goes (cassoff) +2009-01-19 (new feature) CONFIG_INSTALL_DIR - where tkConfig.sh goes (cassoff) 2009-01-19 (platform support) better tools for BSD ports (cassoff) +2009-02-08 (bug fix)[2431428] panic computing layout on active widget (english) + 2009-02-17 (platform support) MSVC and _WIN64 (hobbs) +2009-02-21 (bug fix)[2546087] [console] display of true UTF-8 \0 (thoyts) + 2009-02-23 (bug fix)[1329198,456299,2507419] menu image display (mcdonald) 2009-02-23 (bug fix)[2513104] fix cursor hotspots (mcdonald) @@ -6594,13 +6665,23 @@ in screen distances, reducing precision loss (ferrieux) 2009-02-27 (bug fix)[2645457] crash in Tk_MakeWindowExist() (thoyts) +2009-03-09 (bug fix)[2548661] crash in GetFontFamilyName (riefenstahl) + 2009-03-25 (bug fix)[2178820] stop zero-size allocs in ttk (fellows) 2009-03-25 (bug fix)[1871101] blurry large fonts on Vista (garvey,fellows) +2009-04-03 (bug fix)[1789819] stop panic on unexpected wm stack order (english) + 2009-04-10 (bug fix)[2116837] std virtual events with Caps Lock (fellows) ---- Released 8.5.7, April 15, 2009 --- See ChangeLog for details --- +2009-04-10 (platform) sse Darwin SUSv3 extensions if available (steffen) + +2009-04-10 (bug fix) Motif checkbutton on X11 only (steffen) + +2009-04-10 (bug fix) remove TkAqua Quit menu item on [console] (steffen) + +2009-04-10 (bug fix) crash deleting char range from [text] (steffen) 2009-04-23 (bug fix)[2779910] updated Win chooseDir (hobbs) @@ -6610,6 +6691,8 @@ in screen distances, reducing precision loss (ferrieux) 2009-04-30 (bug fix)[2504402] iconphoto on non-32-bit displays (mcdonald,thoyts) +2009-05-01 (bug fix)[2777019] anchor for text rotation (gavilán,fellows) + 2009-05-03 (bug fix)[2785744] broken flag twiddling (baker,fellows) 2009-05-13 (bug fix)[2791352] XLFD parsing error (thoyts) @@ -6618,20 +6701,42 @@ in screen distances, reducing precision loss (ferrieux) 2009-05-14 (bug fix)[1923684] confused checkbutton state (thoyts) +2009-05-17 (new feature)[1470246] notebook tab orientation control (english) + 2009-05-21 (bug fix)[2794778] Win menu keyboard traversal (thoyts) 2009-06-02 (bug fix)[2799589] crash on delayed window activation (thoyts) 2009-06-23 (bug fix)[220935] canvas dash update problem (nijtmans) +2009-06-23 (platform) new subdir 'carbon' preserved for OSX 10.4- +use --enable-aqua=carbon option to unix/configure to enable (steffen) + +2009-06-29 (new feature) source in `macosx` now built on Cocoa (steffen) + *** POTENTIAL INCOMPATIBILITY *** + +2009-06-30 (platform support) clang static analyzer macros (steffen) + 2009-07-15 (bug fix)[2821962] photo image copy/paste (rib,fellows) +2009-07-21 (bug fix)[2356057] rotated underlined text (fellows) + 2009-07-22 (bug fix)[2496114] focus in dead window crash (griffin,fellows) +2009-07-23 (bug fix)[2441988] report errors in selection handlers (fellows) + *** POTENTIAL INCOMPATIBILITY *** + 2009-08-01 (bug fix)[2830420] X iconphoto for big endian (misch,fellows) 2009-08-04 (bug fix) [text] word-wrap of non-breaking space (fellows) +2009-08-14 (bug fix) copy from unmapped toplevel crash (alaoui,steffen) + +2009-08-19 (bug fix)[2475855] prevent grid & pack on same master (spjuth) + +2009-08-24 (bug fix)[2821084] Cocoa: let WM_DELETE_WINDOW handler stop window +deletion (walzer,steffen) + 2009-08-24 (bug fix) tk::MessageBox bindings for ttk::buttons (steiner,fellows) 2009-08-25 (bug fix)[1909931] [send] update for Fedora 8 (fellows) @@ -6652,13 +6757,13 @@ in screen distances, reducing precision loss (ferrieux) 2009-10-10 (feature)[1961455] underline, overstrike Xft fonts (caffin,fellows) -2009-10-15 (feature)[2794032] permit [load] into Tcl 8.6+ interps (porter) +2009-10-20 (enhancement) Updates to Polish messages (pawlak) 2009-10-22 (bug fix)[2168768] file dialog -typevariable scope (danckaert) 2009-10-22 (bug fix)[1469210] [text] modified error (danckaert) -2009-10-24 (bug fix)[2883712] 64-bit Aqua progress bar (haffner) +2009-10-22 (bug fix)[2883712] 64-bit Aqua progress bar (haffner) 2009-10-24 (bug fix)[1530276] X checkbutton -selectcolor (danckaert) @@ -6668,36 +6773,39 @@ in screen distances, reducing precision loss (ferrieux) 2009-10-29 (bug fix)[1825353] Russian Windows tiny fonts problem (thoyts) -2009-11-03 (bug fix)[2891541] fix grab behaviour for main window (thoyts) +2009-11-01 (new feature) Ttk: [$w identify] now an ensemble (jenglish) ---- Released 8.5.8, November 16, 2009 --- See ChangeLog for details --- +2009-11-19 (bug fix)[2899685] fix [imove] redraw logic (schekin,ferrieux) 2009-11-22 (bug fix)[2899949] crash on widget destroy (meier,thoyts) -2009-11-24 (bug fix)[2902814] fix [wm iconphoto] on LP64 systems (fellows) - -2009-12-06 (bug fix)[2548661] crash in GetFontFamilyName (riefenstahl) +2009-11-23 (bug fix)[2902573] Update Safe Tk to new Safe Base (kurpies) -2009-12-06 (bug fix)[2864685] Compiz menu item animation (gavilán,thoyts) +2009-11-24 (bug fix)[2902814] fix [wm iconphoto] on LP64 systems (fellows) -2009-12-09 (bug fix)[2902573] Update Safe Tk to new Safe Base (kurpies) +2009-12-08 (bug fix)[2864685] Compiz menu item animation (gavilán,thoyts) 2009-12-11 (bug fix)[2912473] accept :: in DISPLAY name (fellows) -2009-12-16 (bug fix)[2496162] crash calling Tk_DeleteOptionTable() (english) +2009-12-15 (bug fix)[2492179] Tcl_ObjType "option" no longer registered (porter) + *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("option") *** 2009-12-20 (bug fix)[2917663] [send] accept SI:* on auth list (fellows) -2009-12-22 (bug fix)[2919205] syntax bug in [tk_messageBox] (zaroo) - 2009-12-22 (bug fix)[2912356] [ttk::sizegrip] accommodate Compiz (english) +2009-12-25 (bug fix)[2977688,2546779] tab selection focus (english) + 2009-12-27 (bug fix)[2879927] Win: cascade menu highlight (pawlak,thoyts) 2010-01-01 (bug fix)[1924761] stop [event generate] / XIM conflict (fellows) 2010-01-03 (bug fix)[2848897] ODS_NOACCEL flag support (kovalenko,thoyts) +2010-01-04 (bug fix)[2811266] <Return> binding in [tk_dialog] (thoyts) + +2010-01-04 (bug fix)[2727476] font dialog appearance (thoyts) + 2010-01-05 (bug fix)[220950] [$menu delete] bounds check (fellows) 2010-01-05 [2898255] unlimited multi-file select (pawlak,fellows,thoyts) @@ -6708,44 +6816,93 @@ in screen distances, reducing precision loss (ferrieux) 2010-01-18 (bug fix)[2932808] canvas update on state change (mcdonald,nijtmans) -2010-01-19 (bug fix)[2931374] overflow in complex tag search (schmitz) - 2010-01-19 (new feature)[TIP 359] Extended Window Manager Hint Support (thoyts) +2010-01-19 (bug fix)[2931374] overflow in complex tag search (schmitz) + 2010-02-17 (bug fix)[2952745] crash in menu deletion (english) +2010-02-20 (performance) treeview stop quadratic common case (english) + +2010-03-02 (enhancement) -fvisibility-hidden build support (nijtmans) + +2010-03-06 (bug fix)[2949774] cascade menu unpost (thoyts) + 2010-03-11 (bug fix)[2968379] crash in peer text dump (fellows) +2010-03-17 (bug fix)[2971663] Cocoa entry <Up>, <Down> (goddard,fellows) + +2010-03-28 (new feature) [$treeview tag names|add|remove] (english) + +2010-04-09 (new feature)[2983824] [$image write -file] use extension of file +name to select image format (fellows) + +2010-04-19 [2898255] unlimited multi-file select (pawlak,fellows,thoyts) + 2010-05-31 (bug fix)[3006842] crash on empty bind scripts (english) +2010-06-15 (bug fix)[2585265] text <Delete>,<Backspace> note selection (fellows) + +2010-06-15 (new package)[3016598] Tk now provides "tile 0.8.6" (english) + +2010-07-19 (new feature) [$photo data -format GIF] (fellows) + 2010-08-03 (bug fix) entry validation compat with Itcl scope (hobbs) -2010-08-12 (bug fix)[2585265] text <Delete>,<Backspace> note selection (fellows) +2010-08-11 (platform) Drop pre-aix 4.2 support, ldAix (hobbs) -2010-08-25 (feature)[3053320] update Ttk to tile 0.8.6 feature set (hobbs) +2010-08-21 (patch)[3034251] genStubs steal features of ttkGenStubs (nijtmans) ---- Released 8.5.9, September 6, 2010 --- See ChangeLog for details --- +2010-08-26 (bug fix)[1230554] configure, OSF-1 problems, windows manifest issues (hobbs) + +2010-08-31 fixed manifest handling on windows (hobbs, kupries) 2010-09-02 (bug fix)[3057573] specify combobox text fg color (english) +2010-09-05 (enhancement)[3046742,3046750] Improved error dialog UI (fellows) + 2010-09-08 (bug fix)[2829363] [$tv see] open item -> sched display (english) +2010-09-13 (platform) limit support to Win2000+ (nijtmans) + +2010-10-01 (bug fix)[3078902] no hang operating on zero-size subimages (fellows) + +2010-10-05 (bug fix)[3080953] corrupt multibyte char in %A subst (nijtmans) + 2010-10-11 (bug fix)[3085489] crash in [tag add/remove] (english) -2010-11-04 (enhancement) Updated German messages. (haertel,nijtmans) +2010-10-11 (enhancement)[491789] Unicode command line support on Win (nijtmans) + +2010-11-03 windows build with -UNICODE (nijtmans) + +2010-11-05 Message catalogs reworked to use unicode copyright char (nijtmans) + +2010-11-06 Message catalogs resorted, updates to NL (nijtmans) 2010-11-16 (platform) VS 2005 SP1 MSVC compiler (nijtmans) 2010-11-24 (bug fix)[3071836] crash in tk_getSaveFile (twylite) +2010-12-03 (enhancement)[3116490] mingw x-compile improvements (nijtmans) + 2010-12-12 (platform) OpenBSD build improvements (cassoff) 2010-12-17 (platform) Revisions to support rpm 4.4.2 (cassoff) +2011-01-06 (bug fix)[2857300] Cocoa: correct text width rounding (walzer) + +2011-01-06 (bug fix)[3086887] Cocoa: textured bg windows (walzer) + 2011-01-13 (bug fix)[3154705] tk_messageBox close button disabled (skylera) 2011-01-22 (enhancement) add [ttk::entry validate] (schelte,english) +2011-01-24 (bug fix)[2907388] OSX: composite character entry crash (berg,walzer) + +2011-03-02 (new doc) tk_mac.n: OS X specific functions (walzer) + +2011-03-03 (bug fix)[3175610] incomplete line item refresh (ferrieux) + 2011-03-10 (bug fix)[3205260] crash in [wm manage] (boudaillier, thoyts) 2011-03-16 (bug fix)[3181181] tearoff submenu fix (menez, thoyts) @@ -6767,24 +6924,20 @@ in screen distances, reducing precision loss (ferrieux) 2011-04-22 (bug fix)[3291543] mem corrupt when [$canvas dchars] removes all coords of a polygon (rogers,spjuth) -2011-04-30 (bug fix)[2949774] cascade menu unpost (thoyts) +2011-04-29 (platform support) [wm forget|manage] on OS X (walzer) 2011-06-06 (bug fix)[2546087] [console] treatment of '\0' (porter) 2011-06-07 (bug fix)[2358545] Restore "08" in spinbox configured with -from and -to (porter) -2011-06-07 (bug fix)[2484771] modal dialog settings (hoff, thoyts) - -2011-06-10 (bug fix)[3175610] incomplete line item refresh (ferrieux) +2011-06-10 (bug fix)[3315731] fix [$entry -invcmd] (porter) 2011-06-17 (bug fix)[3062331] crash in unset traces (macdonald,porter) ---- Released 8.5.10, June 23, 2011 --- See ChangeLog for details --- +2011-08-03 (bug fix)[2891541] fix grab behaviour for main window (thoyts) -2011-06-29 (bug fix)[3341056] new crash in unset traces (militaru,porter) - -2011-08-03 (bug fix)[3314770] restore file dialog resizeability (nijtmans) +--- Released 8.6b2, August 8, 2011 --- See ChangeLog for details --- 2011-09-22 (bug fix)[3404541] -takefocus option (dzach,english) @@ -6792,10 +6945,6 @@ and -to (porter) 2011-10-25 (bug fix)[3410609] AltGr keysyms on Swiss keyboard (tasser,kenny) -2011-11-02 (performance)[3431491] improved "pixels" shimmer logic (fellows) - ---- Released 8.5.11, November 4, 2011 --- See ChangeLog for details --- - 2011-11-17 (bug fix)[3437816] return code of [canvas lower] (hirner,ferrieux) 2011-12-22 (bug fix)[3235256] correct menu failure on Windows (mcdonald) @@ -6842,35 +6991,54 @@ and -to (porter) 2012-07-23 (bug fix)[3546073] DisplayString() -> DefaultDisplay() (english) -Many revisions to better support a Cygwin environment (nijtmans) +2012-08-11 (bug fix)[3554273] text elide and tags (vogel) ---- Released 8.5.12, July 27, 2012 --- See ChangeLog for details --- +2012-08-15 (enhancement)[3555324] Win:Ctrl-A now means Select-All (nijtmans) + *** POTENTIAL INCOMPATIBILITY *** -2012-07-31 (update)[3551802] XKeycodeToKeysym deprecation (fellows) +2012-08-22 (new feature)[TIP 403] Use Web color definitions (nijtmans) + *** POTENTIAL INCOMPATIBILITY *** -2012-08-11 (bug fix)[3554273] text elide and tags (vogel) +2012-08-23 (enhancement)[3555644] better use of virtual events (nijtmans) + *** POTENTIAL INCOMPATIBILITY *** 2012-08-24 (bug fix)[3558535] file dialog filtering (fellows) 2012-08-25 (bug fix)[3554026,3561016] crash with tearoff menus (gavilán) -2012-08-28 (bug fix)[3562426] Context menu goes off screen (nijtmans) - 2012-09-11 (bug fix)[3566594] stop clip region leaks (fellows) -2012-09-28 New colors: aqua crimson fuchsia indigo lime olive silver teal +2012-09-15 (bug fix)[3567778] stop hang in wrapped label (porter) + +2012-09-17 (bug fix)[3567786] stop segfault in [wm forget] (porter) + +Many revisions to better support a Cygwin environment (nijtmans) + +--- Released 8.6b3, September 18, 2012 --- See ChangeLog for details --- 2012-10-02 (bug fix)[3572016] menu enable after modal dialog (berg,walzer) +2012-10-08 Remove Carbon support + 2012-10-24 (bug fix)[3574893] crash in [wm forget] (porter) -2012-11-07 (bug fix)[3574708] TkSetFocusWin() crash on XP (mcdonald) +2012-11-07 (bug fix)[3574708] crash in focus handling (fellows) ---- Released 8.5.13, November 12, 2012 --- See ChangeLog for details --- +2012-11-14 (bug fix)[3500545] fix [tk_getOpenFile -multiple] (bruederlin) -2012-12-04 (bug fix)[3588824] text index of images with weird names (gavilan) +2012-12-04 (bug fix)[3588824] Support weird image names in [text] (vogel) -2012-12-06 (bug fix) avoid buggy syscall to parse hex color values (fellows) +2012-12-06 (bug fix)[3592736] stop pink greys from buggy mingw builds (fellows) + +--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details --- + +2013-01-04 (bug fix) Tk_InitStubs("8.6") rejected in 8.60 interp (nijtmans) + +2013-01-10 (bug fix)[3600251] Mac <Control-v> binding (kjnash,nijtmans) + +2013-01-10 (bug fix)[3600260] <<SelectNextPara>> binding (kjnash,nijtmans) + +2013-01-13 (bug fix)[3600290] restore $tk_strictMotif respect (kjnash,nijtmans) 2013-01-22 (bug fix)[3601782] Tcl_InitStubs failure message (nijtmans) @@ -6888,29 +7056,23 @@ Many revisions to better support a Cygwin environment (nijtmans) 2013-04-01 (bug fix)[3607830] Xkb runtime checks (griffin) ---- Released 8.5.14, April 3, 2013 --- See ChangeLog for details --- - 2013-05-19 (platform support) FreeBSD updates (cerutti) 2013-06-05 (bug fix)[3613759] [ttk::entry .e; .e xview end] (nijtmans) 2013-06-05 (bug fix)[2100430] [ttk::entry .e; .e xview insert] (nijtmans) -2013-06-07 (bug fix)[1913750,3500545,3416492,3095112] file dialogs (nijtmans) - 2013-06-28 (bug fix)[2501278] reverse ttk::scale key bindings {mcdonald) -2013-06-28 (bug fix)[3588364] crash loading Tk 64-bit windows (nijtmans) - 2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin) -2013-08-25 (bug fix)[3016181] Cocoa: [destroy $scrollbar] => crash (goddard) +2013-08-14 (bug fix)[069c9e] "option" value refcount crash (tim,nijtmans) -2013-08-26 (bug fix)[c597acd] [$pb step] work with traces (english) +2013-08-15 (bug fix)[c597acd] [$pb step] work with traces (english) -2013-09-15 (bug fix)[8eb5671] macosx Tk compile errors w/clang (deily) +2013-08-25 (bug fix)[3016181] Cocoa: [destroy $scrollbar] => crash (goddard) ---- Released 8.5.15, September 18, 2013 --- http://core.tcl.tk/tk/ for details +--- Released 8.6.1, September 19, 2013 --- http://core.tcl.tk/tk/ for details 2013-10-27 (bug fix) OSX drawing lags (deily,steffen,walzer) @@ -6918,12 +7080,16 @@ Many revisions to better support a Cygwin environment (nijtmans) 2013-10-31 (bug fix) C++ friendly stubs struct declarations (nijtmans) +2013-10-31 (bug fix)[c0cc9fd] PNG parser accept uppercase -format (nijtmans) + 2013-10-31 (bug fix) double free of a TkFont (nijtmans) 2013-11-03 (bug fix)[1632447] support PPM maxval up to 65535 (fellows) 2013-11-05 (bug fix)[426679e] OpenBSD man page rendering (nijtmans) +2013-11-11 (bug fix)[f214b8a] multi-interp font teardown double free (porter) + 2013-11-11 (bug fix)[0aa5e85] option file \n syntax support (nijtmans) 2013-11-20 (platforms) Support for Windows 8.1 (nijtmans) @@ -6934,6 +7100,8 @@ Many revisions to better support a Cygwin environment (nijtmans) 2014-02-06 (bug fix)[3279221] [menu] event race (danckaert,kupries) +2014-02-07 (bug fix)[6867cc1] creative writing in [tk fontchooser] (nijtmans) + 2014-02-11 (bug fix)[52ca3e7] XkbOpenDisplay macro correction (nijtmans) 2014-03-16 (bug fix) Xcode 5.1 update; Retina displays (walzer) @@ -6946,11 +7114,13 @@ Many revisions to better support a Cygwin environment (nijtmans) 2014-07-07 (bug fix) OSX alpha channel rendering (culler,walzer) +2014-07-08 (workaround)[4955f5d] Ocaml trouble with tailcall splice (nijtmans) + 2014-07-24 (bug fix) OSX [text] image display & scrolling (culler,walzer) 2014-08-01 (bug fix) OSX font config crash (rob@bitkeeper) ---- Released 8.5.16, August 25, 2014 --- http://core.tcl.tk/tk/ for details +--- Released 8.6.2, August 27, 2014 --- http://core.tcl.tk/tk/ for details 2014-08-27 (bug) Cocoa: Crash after [$button destroy] (walzer) @@ -6964,7 +7134,7 @@ Many revisions to better support a Cygwin environment (nijtmans) 2014-10-14 (bug)[fb35eb] fix PNG transparency appearance (walton,culler) ---- Released 8.5.17, October 25, 2014 --- http://core.tcl.tk/tk/ for details +2014-10-18 (feature)[TIP 432] Win: updated file dialogs (nadkarni) 2014-10-26 Support for Windows 10 (nijtmans) @@ -6972,18 +7142,28 @@ Many revisions to better support a Cygwin environment (nijtmans) 2014-10-30 (bug)[3417012] [scale -digits $bigValue] segfault (vogel) -2014-11-06 (bug)[9d72dc] memleak in Cocoa buttons (revol) - 2014-11-07 (bug)[3529885] [scale] handling of negative resolution (vogel) +--- Released 8.6.3, November 12, 2014 --- http://core.tcl.tk/tk/ for details + +2014-11-14 (bug)[d43a10] shimmer-related crash in [tk_getOpenFile] (nadkarni) + +2014-11-23 (bug)[1c0d6e] Win build trouble with SIGDN (keene) + +2014-12-03 (bug)[4a0451] [tk_getOpenFile] result (nadkarni) + +2014-12-13 fix header files installation on OS X (houben) + 2015-01-02 (bug) Stop bit loss in [winfo id] on 64-bit Cocoa (porter) 2015-02-06 (bug) several fixes to elided context in [text] (vogel) 2015-02-06 (new feature)[TIP 433] %M binding substitution (mistachkin) - *** POTENTIAL INCOMPATIBILITY *** + *** POTENTIAL INCOMPATIBILITY *** + +2015-02-22 (bug)[ab6dab] corrupt dashed lines in postscript (porter) Tk Cocoa 2.0: App Store enabled (walzer,culler,desmera,owen,nyberg,reincke) - *** POTENTIAL INCOMPATIBILITY *** + *** POTENTIAL INCOMPATIBILITY *** ---- Released 8.5.18, March 6, 2015 --- http://core.tcl.tk/tk/ for details +--- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tk/ for details diff --git a/compat/limits.h b/compat/limits.h deleted file mode 100644 index 2cb082b..0000000 --- a/compat/limits.h +++ /dev/null @@ -1,22 +0,0 @@ -/* - * limits.h -- - * - * This is a dummy header file to #include in Tcl when there - * is no limits.h in /usr/include. There are only a few - * definitions here; also see tclPort.h, which already - * #defines some of the things here if they're not arleady - * defined. - * - * Copyright (c) 1991 The Regents of the University of California. - * Copyright (c) 1994 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#define LONG_MIN 0x80000000 -#define LONG_MAX 0x7fffffff -#define INT_MIN 0x80000000 -#define INT_MAX 0x7fffffff -#define SHRT_MIN 0x8000 -#define SHRT_MAX 0x7fff diff --git a/compat/stdlib.h b/compat/stdlib.h index 4d1a386..2c64890 100644 --- a/compat/stdlib.h +++ b/compat/stdlib.h @@ -1,43 +1,40 @@ /* * stdlib.h -- * - * Declares facilities exported by the "stdlib" portion of - * the C library. This file isn't complete in the ANSI-C - * sense; it only declares things that are needed by Tcl. - * This file is needed even on many systems with their own - * stdlib.h (e.g. SunOS) because not all stdlib.h files - * declare all the procedures needed here (such as strtod). + * Declares facilities exported by the "stdlib" portion of the C library. + * This file isn't complete in the ANSI-C sense; it only declares things + * that are needed by Tk. This file is needed even on many systems with + * their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare + * all the procedures needed here (such as strtod). * * Copyright (c) 1991 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _STDLIB #define _STDLIB -#include <tcl.h> +#ifndef _TCL +# include <tcl.h> +#endif -extern void abort _ANSI_ARGS_((void)); -extern double atof _ANSI_ARGS_((CONST char *string)); -extern int atoi _ANSI_ARGS_((CONST char *string)); -extern long atol _ANSI_ARGS_((CONST char *string)); -extern char * calloc _ANSI_ARGS_((unsigned int numElements, - unsigned int size)); -extern void exit _ANSI_ARGS_((int status)); -extern int free _ANSI_ARGS_((char *blockPtr)); -extern char * getenv _ANSI_ARGS_((CONST char *name)); -extern char * malloc _ANSI_ARGS_((unsigned int numBytes)); -extern void qsort _ANSI_ARGS_((VOID *base, int n, int size, - int (*compar)(CONST VOID *element1, CONST VOID - *element2))); -extern char * realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes)); -extern double strtod _ANSI_ARGS_((CONST char *string, char **endPtr)); -extern long strtol _ANSI_ARGS_((CONST char *string, char **endPtr, - int base)); -extern unsigned long strtoul _ANSI_ARGS_((CONST char *string, - char **endPtr, int base)); +extern void abort(void); +extern double atof(const char *string); +extern int atoi(const char *string); +extern long atol(const char *string); +extern char * calloc(unsigned int numElements, unsigned int size); +extern void exit(int status); +extern int free(char *blockPtr); +extern char * getenv(const char *name); +extern char * malloc(unsigned int numBytes); +extern void qsort(void *base, int n, int size, int (*compar)( + const void *element1, const void *element2)); +extern char * realloc(char *ptr, unsigned int numBytes); +extern double strtod(const char *string, char **endPtr); +extern long strtol(const char *string, char **endPtr, int base); +extern unsigned long strtoul(const char *string, char **endPtr, int base); #endif /* _STDLIB */ diff --git a/compat/unistd.h b/compat/unistd.h index 9a1dcd7..be966cc 100644 --- a/compat/unistd.h +++ b/compat/unistd.h @@ -1,16 +1,14 @@ /* * unistd.h -- * - * Macros, CONSTants and prototypes for Posix conformance. + * Macros, constants and prototypes for Posix conformance. * - * Copyright 1989 Regents of the University of California - * Permission to use, copy, modify, and distribute this - * software and its documentation for any purpose and without - * fee is hereby granted, provided that the above copyright - * notice appear in all copies. The University of California - * makes no representations about the suitability of this - * software for any purpose. It is provided "as is" without - * express or implied warranty. + * Copyright 1989 Regents of the University of California Permission to use, + * copy, modify, and distribute this software and its documentation for any + * purpose and without fee is hereby granted, provided that the above + * copyright notice appear in all copies. The University of California makes + * no representations about the suitability of this software for any purpose. + * It is provided "as is" without express or implied warranty. */ #ifndef _UNISTD @@ -18,7 +16,7 @@ #include <sys/types.h> #ifndef _TCL -# include "tcl.h" +# include <tcl.h> #endif #ifndef NULL @@ -26,56 +24,56 @@ #endif /* - * Strict POSIX stuff goes here. Extensions go down below, in the - * ifndef _POSIX_SOURCE section. + * Strict POSIX stuff goes here. Extensions go down below, in the ifndef + * _POSIX_SOURCE section. */ -extern void _exit _ANSI_ARGS_((int status)); -extern int access _ANSI_ARGS_((CONST char *path, int mode)); -extern int chdir _ANSI_ARGS_((CONST char *path)); -extern int chown _ANSI_ARGS_((CONST char *path, uid_t owner, gid_t group)); -extern int close _ANSI_ARGS_((int fd)); -extern int dup _ANSI_ARGS_((int oldfd)); -extern int dup2 _ANSI_ARGS_((int oldfd, int newfd)); -extern int execl _ANSI_ARGS_((CONST char *path, ...)); -extern int execle _ANSI_ARGS_((CONST char *path, ...)); -extern int execlp _ANSI_ARGS_((CONST char *file, ...)); -extern int execv _ANSI_ARGS_((CONST char *path, char **argv)); -extern int execve _ANSI_ARGS_((CONST char *path, char **argv, char **envp)); -extern int execvp _ANSI_ARGS_((CONST char *file, char **argv)); -extern pid_t fork _ANSI_ARGS_((void)); -extern char *getcwd _ANSI_ARGS_((char *buf, size_t size)); -extern gid_t getegid _ANSI_ARGS_((void)); -extern uid_t geteuid _ANSI_ARGS_((void)); -extern gid_t getgid _ANSI_ARGS_((void)); -extern int getgroups _ANSI_ARGS_((int bufSize, int *buffer)); -extern pid_t getpid _ANSI_ARGS_((void)); -extern uid_t getuid _ANSI_ARGS_((void)); -extern int isatty _ANSI_ARGS_((int fd)); -extern long lseek _ANSI_ARGS_((int fd, long offset, int whence)); -extern int pipe _ANSI_ARGS_((int *fildes)); -extern int read _ANSI_ARGS_((int fd, char *buf, size_t size)); -extern int setgid _ANSI_ARGS_((gid_t group)); -extern int setuid _ANSI_ARGS_((uid_t user)); -extern unsigned sleep _ANSI_ARGS_ ((unsigned seconds)); -extern char *ttyname _ANSI_ARGS_((int fd)); -extern int unlink _ANSI_ARGS_((CONST char *path)); -extern int write _ANSI_ARGS_((int fd, CONST char *buf, size_t size)); +extern void _exit(int status); +extern int access(const char *path, int mode); +extern int chdir(const char *path); +extern int chown(const char *path, uid_t owner, gid_t group); +extern int close(int fd); +extern int dup(int oldfd); +extern int dup2(int oldfd, int newfd); +extern int execl(const char *path, ...); +extern int execle(const char *path, ...); +extern int execlp(const char *file, ...); +extern int execv(const char *path, char **argv); +extern int execve(const char *path, char **argv, char **envp); +extern int execvp(const char *file, char **argv); +extern pid_t fork(void); +extern char * getcwd(char *buf, size_t size); +extern gid_t getegid(void); +extern uid_t geteuid(void); +extern gid_t getgid(void); +extern int getgroups(int bufSize, int *buffer); +extern pid_t getpid(void); +extern uid_t getuid(void); +extern int isatty(int fd); +extern long lseek(int fd, long offset, int whence); +extern int pipe(int *fildes); +extern int read(int fd, char *buf, size_t size); +extern int setgid(gid_t group); +extern int setuid(uid_t user); +extern unsigned sleep(unsigned seconds); +extern char * ttyname(int fd); +extern int unlink(const char *path); +extern int write(int fd, const char *buf, size_t size); #ifndef _POSIX_SOURCE -extern char *crypt _ANSI_ARGS_((CONST char *, CONST char *)); -extern int fchown _ANSI_ARGS_((int fd, uid_t owner, gid_t group)); -extern int flock _ANSI_ARGS_((int fd, int operation)); -extern int ftruncate _ANSI_ARGS_((int fd, unsigned long length)); -extern int ioctl _ANSI_ARGS_((int fd, int request, ...)); -extern int readlink _ANSI_ARGS_((CONST char *path, char *buf, int bufsize)); -extern int setegid _ANSI_ARGS_((gid_t group)); -extern int seteuid _ANSI_ARGS_((uid_t user)); -extern int setreuid _ANSI_ARGS_((int ruid, int euid)); -extern int symlink _ANSI_ARGS_((CONST char *, CONST char *)); -extern int ttyslot _ANSI_ARGS_((void)); -extern int truncate _ANSI_ARGS_((CONST char *path, unsigned long length)); -extern int vfork _ANSI_ARGS_((void)); +extern char * crypt(const char *, const char *); +extern int fchown(int fd, uid_t owner, gid_t group); +extern int flock(int fd, int operation); +extern int ftruncate(int fd, unsigned long length); +extern int ioctl(int fd, int request, ...); +extern int readlink(const char *path, char *buf, int bufsize); +extern int setegid(gid_t group); +extern int seteuid(uid_t user); +extern int setreuid(int ruid, int euid); +extern int symlink(const char *, const char *); +extern int ttyslot(void); +extern int truncate(const char *path, unsigned long length); +extern int vfork(void); #endif /* _POSIX_SOURCE */ #endif /* _UNISTD */ diff --git a/doc/3DBorder.3 b/doc/3DBorder.3 index b41b84f..f2f0eb8 100644 --- a/doc/3DBorder.3 +++ b/doc/3DBorder.3 @@ -64,12 +64,12 @@ Interpreter to use for error reporting. Token for window (for all procedures except \fBTk_Get3DBorder\fR, must be the window for which the border was allocated). .AP Tcl_Obj *objPtr in -Pointer to object whose value describes color corresponding to +Pointer to value whose value describes color corresponding to background (flat areas). Illuminated edges will be brighter than this and shadowed edges will be darker than this. .AP char *colorName in Same as \fIobjPtr\fR except value is supplied as a string rather -than an object. +than a value. .AP Drawable drawable in X token for window or pixmap; indicates where graphics are to be drawn. Must either be the X window for \fItkwin\fR or a pixmap with the @@ -91,7 +91,7 @@ Width of border in pixels. Positive means border is inside rectangle given by \fIx\fR, \fIy\fR, \fIwidth\fR, \fIheight\fR, negative means border is outside rectangle. .AP int relief in -Indicates 3-D position of interior of object relative to exterior; +Indicates 3-D position of interior of value relative to exterior; should be \fBTK_RELIEF_RAISED\fR, \fBTK_RELIEF_SUNKEN\fR, \fBTK_RELIEF_GROOVE\fR, \fBTK_RELIEF_SOLID\fR, or \fBTK_RELIEF_RIDGE\fR (may also be \fBTK_RELIEF_FLAT\fR for \fBTk_Fill3DRectangle\fR). @@ -114,7 +114,7 @@ should appear higher; For \fBTk_Fill3DPolygon\fR, \fBTK_RELIEF_FLAT\fR may also be specified to indicate no difference in height. .AP int leftBevel in -Non-zero means this bevel forms the left side of the object; zero means +Non-zero means this bevel forms the left side of the value; zero means it forms the right side. .AP int leftIn in Non-zero means that the left edge of the horizontal bevel angles in, @@ -128,13 +128,12 @@ so that the bottom of the edge is farther to the left than the top. Zero means the edge angles out, so that the bottom is farther to the right than the top. .AP int topBevel in -Non-zero means this bevel forms the top side of the object; zero means +Non-zero means this bevel forms the top side of the value; zero means it forms the bottom side. .AP int which in Specifies which of the border's graphics contexts is desired. Must be \fBTK_3D_FLAT_GC\fR, \fBTK_3D_LIGHT_GC\fR, or \fBTK_3D_DARK_GC\fR. .BE - .SH DESCRIPTION .PP These procedures provide facilities for drawing window borders in a @@ -153,14 +152,15 @@ darker than \fIobjPtr\fR. \fBTk_Alloc3DBorderFromObj\fR returns a token that may be used in later calls to \fBTk_Draw3DRectangle\fR. If an error occurs in allocating information for the border (e.g. a bogus color name was given) -then NULL is returned and an error message is left in \fIinterp->result\fR. +then NULL is returned and an error message is left as the result of +interpreter \fIinterp\fR. If it returns successfully, \fBTk_Alloc3DBorderFromObj\fR caches information about the return value in \fIobjPtr\fR, which speeds up future calls to \fBTk_Alloc3DBorderFromObj\fR with the same \fIobjPtr\fR and \fItkwin\fR. .PP \fBTk_Get3DBorder\fR is identical to \fBTk_Alloc3DBorderFromObj\fR except -that the color is specified with a string instead of an object. This +that the color is specified with a string instead of a value. This prevents \fBTk_Get3DBorder\fR from caching the return value, so \fBTk_Get3DBorder\fR is less efficient than \fBTk_Alloc3DBorderFromObj\fR. .PP @@ -238,8 +238,8 @@ arguments that describe the rectangular area of the beveled edge The \fIleftBorder\fR and \fItopBorder\fR arguments indicate the position of the border relative to the .QW inside -of the object, and -\fIrelief\fR indicates the relief of the inside of the object relative +of the value, and +\fIrelief\fR indicates the relief of the inside of the value relative to the outside. \fBTk_3DVerticalBevel\fR just draws a rectangular region. \fBTk_3DHorizontalBevel\fR draws a trapezoidal region to generate @@ -290,6 +290,5 @@ with the Tk_3DBorder token for the border. There should be exactly one call to \fBTk_Free3DBorderFromObj\fR or \fBTk_Free3DBorder\fR for each call to \fBTk_Alloc3DBorderFromObj\fR or \fBTk_Get3DBorder\fR. - .SH KEYWORDS -3D, background, border, color, depressed, illumination, object, polygon, raised, shadow, three-dimensional effect +3D, background, border, color, depressed, illumination, value, polygon, raised, shadow, three-dimensional effect diff --git a/doc/AddOption.3 b/doc/AddOption.3 index 8b921e2..2368f09 100644 --- a/doc/AddOption.3 +++ b/doc/AddOption.3 @@ -23,7 +23,6 @@ Value of option. .AP int priority in Overall priority level to use for option. .BE - .SH DESCRIPTION .PP This procedure is invoked to add an option to the database @@ -47,6 +46,5 @@ user-specific startup files. .IP 80 Used for options specified interactively after the application starts running. - .SH KEYWORDS class, name, option, add diff --git a/doc/BindTable.3 b/doc/BindTable.3 index 34a2101..5130bfc 100644 --- a/doc/BindTable.3 +++ b/doc/BindTable.3 @@ -45,7 +45,7 @@ call to \fBTk_CreateBindingTable\fR. Identifies object with which binding is associated. .AP "const char" *eventString in String describing event sequence. -.AP char *script in +.AP "const char" *script in Tcl script to invoke when binding triggers. .AP int append in Non-zero means append \fIscript\fR to existing script for binding, @@ -61,7 +61,6 @@ Number of object identifiers pointed to by \fIobjectPtr\fR. Points to an array of object identifiers: bindings will be considered for each of these objects in order from first to last. .BE - .SH DESCRIPTION .PP These procedures provide a general-purpose mechanism for creating @@ -112,25 +111,25 @@ select relevant events, or to disallow the use of certain events in bindings. If an error occurred while creating the binding (e.g., \fIeventString\fR refers to a non-existent event), then 0 is returned and an error -message is left in \fIinterp->result\fR. +message is left as the result of interpreter \fIinterp\fR. .PP \fBTk_DeleteBinding\fR removes from \fIbindingTable\fR the binding given by \fIobject\fR and \fIeventString\fR, if such a binding exists. \fBTk_DeleteBinding\fR always returns \fBTCL_OK\fR. -In some cases it may reset \fIinterp->result\fR to the default +In some cases it may reset the interpreter result to the default empty value. .PP \fBTk_GetBinding\fR returns a pointer to the script associated with \fIeventString\fR and \fIobject\fR in \fIbindingTable\fR. If no such binding exists then NULL is returned and an error -message is left in \fIinterp->result\fR. +message is left as the result of interpreter \fIinterp\fR. .PP -\fBTk_GetAllBindings\fR returns in \fIinterp->result\fR a list +\fBTk_GetAllBindings\fR returns in \fIinterp\fR's result a list of all the event strings for which there are bindings in \fIbindingTable\fR associated with \fIobject\fR. -If there are no bindings for \fIobject\fR then an empty -string is returned in \fIinterp->result\fR. +If there are no bindings for \fIobject\fR, the result will be an empty +string. .PP \fBTk_DeleteAllBindings\fR deletes all of the bindings in \fIbindingTable\fR that are associated with \fIobject\fR. @@ -150,6 +149,5 @@ the object is skipped. \fBTk_BindEvent\fR continues through all of the objects, handling exceptions such as errors, \fBbreak\fR, and \fBcontinue\fR as described in the documentation for \fBbind\fR. - .SH KEYWORDS binding, event, object, script diff --git a/doc/CanvPsY.3 b/doc/CanvPsY.3 index 91109ea..5e104ce 100644 --- a/doc/CanvPsY.3 +++ b/doc/CanvPsY.3 @@ -61,7 +61,6 @@ and so on. .AP int numPoints in Number of points at \fIcoordPtr\fR. .BE - .SH DESCRIPTION .PP These procedures are called by canvas type managers to carry out @@ -83,38 +82,40 @@ transformation. of a bitmap. The Postscript is generated in proper image data format for Postscript, i.e., as data between angle brackets, one bit per pixel. -The Postscript is appended to \fIinterp->result\fR and \fBTCL_OK\fR is returned -unless an error occurs, in which case \fBTCL_ERROR\fR is returned and -\fIinterp->result\fR is overwritten with an error message. +The Postscript is appended to the result of interpreter \fIinterp\fR +and \fBTCL_OK\fR is returned unless an error occurs, in which case +\fBTCL_ERROR\fR is returned and the interpreter result is overwritten +with an error message. .PP \fBTk_CanvasPsColor\fR generates Postscript to set the current color to correspond to its \fIcolorPtr\fR argument, taking into account any color map specified in the \fBpostscript\fR command. -It appends the Postscript to \fIinterp->result\fR and returns -\fBTCL_OK\fR unless an error occurs, in which case \fBTCL_ERROR\fR is returned and -\fIinterp->result\fR is overwritten with an error message. +It appends the Postscript to the interpreter \fIinterp\fR's result and returns +\fBTCL_OK\fR unless an error occurs, in which case \fBTCL_ERROR\fR is +returned and the interpreter's result is overwritten with an error message. .PP \fBTk_CanvasPsFont\fR generates Postscript that sets the current font to match \fItkFont\fR as closely as possible. \fBTk_CanvasPsFont\fR takes into account any font map specified in the \fBpostscript\fR command, and it does the best it can at mapping X fonts to Postscript fonts. -It appends the Postscript to \fIinterp->result\fR and returns \fBTCL_OK\fR -unless an error occurs, in which case \fBTCL_ERROR\fR is returned and -\fIinterp->result\fR is overwritten with an error message. +It appends the Postscript to interpreter \fIinterp\fR's result and +returns \fBTCL_OK\fR unless an error occurs, in which case +\fBTCL_ERROR\fR is returned and the interpreter's result is +overwritten with an error message. .PP \fBTk_CanvasPsPath\fR generates Postscript to set the current path to the set of points given by \fIcoordPtr\fR and \fInumPoints\fR. -It appends the resulting Postscript to \fIinterp->result\fR. +It appends the resulting Postscript to the result of interpreter \fIinterp\fR. .PP \fBTk_CanvasPsStipple\fR generates Postscript that will fill the current path in stippled fashion. It uses \fIbitmap\fR as the stipple pattern and the current Postscript color; ones in the stipple bitmap are drawn in the current color, and zeroes are not drawn at all. -The Postscript is appended to \fIinterp->result\fR and \fBTCL_OK\fR is -returned, unless an error occurs, in which case \fBTCL_ERROR\fR is returned and -\fIinterp->result\fR is overwritten with an error message. - +The Postscript is appended to interpreter \fIinterp\fR's result and +\fBTCL_OK\fR is returned, unless an error occurs, in which case +\fBTCL_ERROR\fR is returned and the interpreter's result is +overwritten with an error message. .SH KEYWORDS bitmap, canvas, color, font, path, Postscript, stipple diff --git a/doc/CanvTkwin.3 b/doc/CanvTkwin.3 index 05ffca2..d53c5b1 100644 --- a/doc/CanvTkwin.3 +++ b/doc/CanvTkwin.3 @@ -71,7 +71,6 @@ the left of this coordinate need to be redisplayed. Bottom edge of the region that needs redisplay. Only pixels above this coordinate need to be redisplayed. .BE - .SH DESCRIPTION .PP These procedures are called by canvas type managers to perform various @@ -86,7 +85,7 @@ canvas coordinate. If \fIstring\fR is a valid coordinate description then \fBTk_CanvasGetCoord\fR stores the corresponding canvas coordinate at *\fIdoublePtr\fR and returns \fBTCL_OK\fR. -Otherwise it stores an error message in \fIinterp->result\fR and +Otherwise it stores an error message in the interpreter result and returns \fBTCL_ERROR\fR. .PP \fBTk_CanvasDrawableCoords\fR is called by type managers during @@ -142,18 +141,18 @@ The code of a canvas type manager will not call these procedures directly, but will use their addresses to create a \fBTk_CustomOption\fR structure for the \fB\-tags\fR option. The code typically looks like this: +.PP .CS -static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, +static const Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, (ClientData) NULL }; -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { ... - {TK_CONFIG_CUSTOM, "\-tags", (char *) NULL, (char *) NULL, - (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, + {TK_CONFIG_CUSTOM, "\-tags", NULL, NULL, + NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, ... }; .CE - .SH KEYWORDS canvas, focus, item type, redisplay, selection, type manager diff --git a/doc/CanvTxtInfo.3 b/doc/CanvTxtInfo.3 index a4c0d3b..92a2bc3 100644 --- a/doc/CanvTxtInfo.3 +++ b/doc/CanvTxtInfo.3 @@ -20,7 +20,6 @@ Tk_CanvasTextInfo * .AP Tk_Canvas canvas in A token that identifies a particular canvas widget. .BE - .SH DESCRIPTION .PP Textual canvas items are somewhat more complicated to manage than @@ -47,7 +46,7 @@ typedef struct Tk_CanvasTextInfo { Tk_Item *\fIfocusItemPtr\fR; int \fIgotFocus\fR; int \fIcursorOn\fR; -} Tk_CanvasTextInfo; +} \fBTk_CanvasTextInfo\fR; .CE The \fBselBorder\fR field identifies a Tk_3DBorder that should be used for drawing the background under selected text. @@ -97,6 +96,5 @@ anchor, as determined by \fIselItemPtr\fR or \fIanchorItemPtr\fR). If all of the selected text in the item is deleted, the item should set \fIselItemPtr\fR to NULL to indicate that there is no longer a selection. - .SH KEYWORDS canvas, focus, insertion cursor, selection, selection anchor, text diff --git a/doc/Clipboard.3 b/doc/Clipboard.3 index 769b63b..3087777 100644 --- a/doc/Clipboard.3 +++ b/doc/Clipboard.3 @@ -31,10 +31,9 @@ Conversion type for this clipboard item; has same meaning as .AP Atom format in Representation to use when data is retrieved; has same meaning as \fIformat\fR argument to \fBTk_CreateSelHandler\fR. -.AP char *buffer in +.AP "const char" *buffer in Null terminated string containing the data to be appended to the clipboard. .BE - .SH DESCRIPTION .PP These two procedures manage the clipboard for Tk. @@ -43,9 +42,10 @@ once, then calling \fBTk_ClipboardAppend\fR to add data for any number of targets. .PP \fBTk_ClipboardClear\fR claims the CLIPBOARD selection and frees any -data items previously stored on the clipboard in this application. +data items previously stored on the clipboard in this application. It normally returns \fBTCL_OK\fR, but if an error occurs it returns -\fBTCL_ERROR\fR and leaves an error message in \fIinterp->result\fR. +\fBTCL_ERROR\fR and leaves an error message in interpreter +\fIinterp\fR's result. \fBTk_ClipboardClear\fR must be called before a sequence of \fBTk_ClipboardAppend\fR calls can be issued. .PP @@ -60,8 +60,8 @@ currently owned by the application, either because \fBTk_ClipboardClear\fR has not been called or because ownership of the clipboard has changed since the last call to \fBTk_ClipboardClear\fR, -\fBTk_ClipboardAppend\fR returns \fBTCL_ERROR\fR and leaves an error message in -\fIinterp->result\fR. +\fBTk_ClipboardAppend\fR returns \fBTCL_ERROR\fR and leaves an error +message in the result of interpreter \fIinterp\fR. .PP In order to guarantee atomicity, no event handling should occur between \fBTk_ClipboardClear\fR and the following @@ -71,8 +71,7 @@ this application). .PP \fBTk_ClipboardClear\fR may invoke callbacks, including arbitrary Tcl scripts, as a result of losing the CLIPBOARD selection, so -any calling function should take care to be reentrant at the point +any calling function should take care to be re-entrant at the point \fBTk_ClipboardClear\fR is invoked. - .SH KEYWORDS append, clipboard, clear, format, type diff --git a/doc/ClrSelect.3 b/doc/ClrSelect.3 index 963260e..c56f63c 100644 --- a/doc/ClrSelect.3 +++ b/doc/ClrSelect.3 @@ -23,10 +23,9 @@ window. .AP Atom selection in The name of selection to be cleared. .BE - .SH DESCRIPTION .PP -\fBTk_ClearSelection\fR cancels the selection specified by the atom +\fBTk_ClearSelection\fR cancels the selection specified by the atom \fIselection\fR for the display containing \fItkwin\fR. The selection need not be in \fItkwin\fR itself or even in \fItkwin\fR's application. @@ -35,6 +34,5 @@ owns \fIselection\fR, the window will be notified and the selection will be cleared. If there is no owner for \fIselection\fR on the display, then the procedure has no effect. - .SH KEYWORDS clear, selection diff --git a/doc/ConfigWidg.3 b/doc/ConfigWidg.3 index 3abb4f5..ddc1030 100644 --- a/doc/ConfigWidg.3 +++ b/doc/ConfigWidg.3 @@ -25,12 +25,12 @@ int .sp \fBTk_FreeOptions(\fIspecs, widgRec, display, flags\fB)\fR .SH ARGUMENTS -.AS Tk_ConfigSpec *widgRec in/out +.AS char *widgRec in/out .AP Tcl_Interp *interp in Interpreter to use for returning error messages. .AP Tk_Window tkwin in Window used to represent widget (needed to set up X resources). -.AP Tk_ConfigSpec *specs in +.AP "const Tk_ConfigSpec" *specs in Pointer to table specifying legal configuration options for this widget. .AP int argc in @@ -61,7 +61,7 @@ Display containing widget whose record is being freed; needed in order to free up resources. .BE .SH DESCRIPTION -.PP +.PP Note: \fBTk_ConfigureWidget\fR should be replaced with the new \fBTcl_Obj\fR based API \fBTk_SetOptions\fR. The old interface is retained for backward compatibility. @@ -89,7 +89,7 @@ to fill in fields of \fIwidgRec\fR that are not specified in \fIargv\fR. case it does not modify \fIinterp\fR. If an error occurs then \fBTCL_ERROR\fR is returned and \fBTk_ConfigureWidget\fR will -leave an error message in \fIinterp->result\fR in the standard Tcl +leave an error message in interpreter \fIinterp\fR's result in the standard Tcl fashion. In the event of an error return, some of the fields of \fIwidgRec\fR could already have been set, if configuration information for them @@ -103,14 +103,14 @@ option and has the following structure: .CS typedef struct { int \fItype\fR; - char *\fIargvName\fR; - char *\fIdbName\fR; - char *\fIdbClass\fR; - char *\fIdefValue\fR; + const char *\fIargvName\fR; + const char *\fIdbName\fR; + const char *\fIdbClass\fR; + const char *\fIdefValue\fR; int \fIoffset\fR; int \fIspecFlags\fR; - Tk_CustomOption *\fIcustomPtr\fR; -} Tk_ConfigSpec; + const Tk_CustomOption *\fIcustomPtr\fR; +} \fBTk_ConfigSpec\fR; .CE The \fItype\fR field indicates what type of configuration option this is (e.g. \fBTK_CONFIG_COLOR\fR for a color value, or \fBTK_CONFIG_INT\fR for @@ -356,7 +356,6 @@ is an empty string then the target will be set to NULL. \fBTK_CONFIG_WINDOW\fR The value must be a window path name. It is translated to a \fBTk_Window\fR token and the token is stored in the target. - .SH "GROUPED ENTRIES" .PP In some cases it is useful to generate multiple resources from @@ -374,7 +373,6 @@ Each of the entries after the first must have a NULL value in its \fIargvName\fR field; this indicates that the entry is to be grouped with the entry that precedes it. Only the \fItype\fR and \fIoffset\fR fields are used from these follow-on entries. - .SH "FLAGS" .PP The \fIflags\fR argument passed to \fBTk_ConfigureWidget\fR is used @@ -434,13 +432,11 @@ once, save the value, and provide it before calling .TP \fBTK_CONFIG_OPTION_SPECIFIED\fR This bit is -.VS 8.5 deprecated. It used to be set and cleared by \fBTk_ConfigureWidget\fR so that callers could detect what entries were specified in \fIargv\fR, but it was removed because it was inherently thread-unsafe. Code that wishes to detect what options were specified should use \fBTk_SetOptions\fR instead. -.VE 8.5 .PP The \fBTK_CONFIG_MONO_ONLY\fR and \fBTK_CONFIG_COLOR_ONLY\fR flags are typically used to specify different default values for @@ -473,7 +469,6 @@ for which this entry is valid. When calling \fBTk_ConfigureWidget\fR, \fIflags\fR will have a single one of these bits set to select the entries for the desired widget type. For a working example of this feature, see the code in tkButton.c. - .SH TK_OFFSET .PP The \fBTk_Offset\fR macro is provided as a safe way of generating @@ -481,7 +476,6 @@ the \fIoffset\fR values for entries in Tk_ConfigSpec structures. It takes two arguments: the name of a type of record, and the name of a field in that record. It returns the byte offset of the named field in records of the given type. - .SH TK_CONFIGUREINFO .PP The \fBTk_ConfigureInfo\fR procedure may be used to obtain @@ -492,12 +486,12 @@ pointer to a widget record containing the current information for a widget (\fIwidgRec\fR), and a NULL \fIargvName\fR argument, \fBTk_ConfigureInfo\fR generates a string describing all of the configuration options for the window. The string is placed -in \fIinterp->result\fR. Under normal circumstances +in interpreter \fIinterp\fR's result. Under normal circumstances it returns \fBTCL_OK\fR; if an error occurs then it returns \fBTCL_ERROR\fR -and \fIinterp->result\fR contains an error message. +and the interpreter's result will contain an error message. .PP If \fIargvName\fR is NULL, then the value left in -\fIinterp->result\fR by \fBTk_ConfigureInfo\fR +the interpreter's result by \fBTk_ConfigureInfo\fR consists of a list of one or more entries, each of which describes one configuration option (i.e. one entry in \fIspecs\fR). Each entry in the list will contain either two or five values. If the @@ -510,27 +504,25 @@ field of \fIwidgRec\fR by calling procedures like \fBTk_NameOfColor\fR. .PP If the \fIargvName\fR argument to \fBTk_ConfigureInfo\fR is non-NULL, then it indicates a single option, and information is returned only -for that option. The string placed in \fIinterp->result\fR will be +for that option. The string placed in the interpreter's result will be a list containing two or five values as described above; this will be identical to the corresponding sublist that would have been returned if \fIargvName\fR had been NULL. .PP The \fIflags\fR argument to \fBTk_ConfigureInfo\fR is used to restrict the \fIspecs\fR entries to consider, just as for \fBTk_ConfigureWidget\fR. - .SH TK_CONFIGUREVALUE .PP \fBTk_ConfigureValue\fR takes arguments similar to \fBTk_ConfigureInfo\fR; instead of returning a list of values, it just returns the current value of the option given by \fIargvName\fR (\fIargvName\fR must not be NULL). -The value is returned in \fIinterp->result\fR and \fBTCL_OK\fR is +The value is returned in interpreter \fIinterp\fR's result and \fBTCL_OK\fR is normally returned as the procedure's result. If an error occurs in \fBTk_ConfigureValue\fR (e.g., \fIargvName\fR is not a valid option name), \fBTCL_ERROR\fR is returned and an error message -is left in \fIinterp->result\fR. +is left in the interpreter's result. This procedure is typically called to implement \fBcget\fR widget commands. - .SH TK_FREEOPTIONS .PP The \fBTk_FreeOptions\fR procedure may be invoked during widget cleanup @@ -543,7 +535,6 @@ it contains a null pointer) then no resource is freed for that entry. After freeing a resource, \fBTk_FreeOptions\fR sets the corresponding field of the widget record to null. - .SH "CUSTOM OPTION TYPES" .PP Applications can extend the built-in configuration types with additional @@ -554,22 +545,22 @@ typedef struct Tk_CustomOption { Tk_OptionParseProc *\fIparseProc\fR; Tk_OptionPrintProc *\fIprintProc\fR; ClientData \fIclientData\fR; -} Tk_CustomOption; +} \fBTk_CustomOption\fR; -typedef int Tk_OptionParseProc( - ClientData \fIclientData\fR, - Tcl_Interp *\fIinterp\fR, - Tk_Window \fItkwin\fR, - char *\fIvalue\fR, - char *\fIwidgRec\fR, - int \fIoffset\fR); +typedef int \fBTk_OptionParseProc\fR( + ClientData \fIclientData\fR, + Tcl_Interp *\fIinterp\fR, + Tk_Window \fItkwin\fR, + char *\fIvalue\fR, + char *\fIwidgRec\fR, + int \fIoffset\fR); -typedef char *Tk_OptionPrintProc( - ClientData \fIclientData\fR, - Tk_Window \fItkwin\fR, - char *\fIwidgRec\fR, - int \fIoffset\fR, - Tcl_FreeProc **\fIfreeProcPtr\fR); +typedef const char *\fBTk_OptionPrintProc\fR( + ClientData \fIclientData\fR, + Tk_Window \fItkwin\fR, + char *\fIwidgRec\fR, + int \fIoffset\fR, + Tcl_FreeProc **\fIfreeProcPtr\fR); .CE The Tk_CustomOption structure contains three fields, which are pointers to the two procedures and a \fIclientData\fR value to be passed to those @@ -599,7 +590,7 @@ be placed. The procedure should translate the string to whatever form is appropriate for the option and store the value in the widget record. It should normally return \fBTCL_OK\fR, but if an error occurs in translating the string to a value then it should return \fBTCL_ERROR\fR -and store an error message in \fIinterp->result\fR. +and store an error message in interpreter \fIinterp\fR's result. .PP The \fIprintProc\fR procedure is called by \fBTk_ConfigureInfo\fR to produce a string value describing an @@ -622,7 +613,6 @@ Tk_CustomOption structure has been created for them, options of this new type may be manipulated with Tk_ConfigSpec entries whose \fItype\fR fields are \fBTK_CONFIG_CUSTOM\fR and whose \fIcustomPtr\fR fields point to the Tk_CustomOption structure. - .SH EXAMPLES .PP Although the explanation of \fBTk_ConfigureWidget\fR is fairly @@ -633,10 +623,8 @@ The library implementation of frames (tkFrame.c) has a simple configuration table, and the library implementation of buttons (tkButton.c) has a much more complex table that uses many of the fancy \fIspecFlags\fR mechanisms. - .SH "SEE ALSO" Tk_SetOptions(3) - .SH KEYWORDS anchor, bitmap, boolean, border, cap style, color, configuration options, cursor, custom, double, font, integer, join style, justify, millimeters, diff --git a/doc/CoordToWin.3 b/doc/CoordToWin.3 index f0a9837..5fe96a6 100644 --- a/doc/CoordToWin.3 +++ b/doc/CoordToWin.3 @@ -25,7 +25,6 @@ Y-coordinate (in root window coordinates). .AP Tk_Window tkwin in Token for window that identifies application. .BE - .SH DESCRIPTION .PP \fBTk_CoordsToWindow\fR locates the window that contains a given point. @@ -44,6 +43,5 @@ which window contains the mouse cursor: if a parent and a child both contain the point then the child gets preference, and if two siblings both contain the point then the highest one in the stacking order (i.e. the one that's visible on the screen) gets preference. - .SH KEYWORDS containing, coordinates, root window diff --git a/doc/CrtCmHdlr.3 b/doc/CrtCmHdlr.3 index 54cee95..98b93f7 100644 --- a/doc/CrtCmHdlr.3 +++ b/doc/CrtCmHdlr.3 @@ -20,10 +20,8 @@ Tk_CreateClientMessageHandler, Tk_DeleteClientMessageHandler \- associate proced .AP Tk_ClientMessageProc *proc in Procedure to invoke whenever a ClientMessage X event occurs on any display. .BE - .SH DESCRIPTION .PP - \fBTk_CreateClientMessageHandler\fR arranges for \fIproc\fR to be invoked in the future whenever a ClientMessage X event occurs that is not handled by \fBWM_PROTOCOL\fR. \fBTk_CreateClientMessageHandler\fR is intended for use @@ -39,9 +37,9 @@ call \fBTk_HandleEvent\fR, such as \fBTk_DoOneEvent\fR or \fIProc\fR should have arguments and result that match the type \fBTk_ClientMessageProc\fR: .CS -typedef int Tk_ClientMessageProc( - Tk_Window \fItkwin\fR, - XEvent *\fIeventPtr\fR); +typedef int \fBTk_ClientMessageProc\fR( + Tk_Window \fItkwin\fR, + XEvent *\fIeventPtr\fR); .CE The \fItkwin\fR parameter to \fIproc\fR is the Tk window which is associated with this event. \fIEventPtr\fR is a pointer to the X event. @@ -62,6 +60,5 @@ finds that matches the \fIproc\fR argument. If no such handler exists, then \fBTk_DeleteClientMessageHandler\fR returns without doing anything. Although Tk supports it, it's probably a bad idea to have more than one callback with the same \fIproc\fR argument. - .SH KEYWORDS bind, callback, event, handler diff --git a/doc/CrtErrHdlr.3 b/doc/CrtErrHdlr.3 index f30ceb2..e506220 100644 --- a/doc/CrtErrHdlr.3 +++ b/doc/CrtErrHdlr.3 @@ -72,9 +72,9 @@ made when the handler was active (see below for more information). \fIProc\fR should have arguments and result that match the following type: .CS -typedef int Tk_ErrorProc( - ClientData \fIclientData\fR, - XErrorEvent *\fIerrEventPtr\fR); +typedef int \fBTk_ErrorProc\fR( + ClientData \fIclientData\fR, + XErrorEvent *\fIerrEventPtr\fR); .CE The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR argument given to \fBTcl_CreateErrorHandler\fR when the callback @@ -136,6 +136,5 @@ handlers deleted before the \fBXSync\fR call. For the Tk error handling mechanism to work properly, it is essential that application code never calls \fBXSetErrorHandler\fR directly; applications should use only \fBTk_CreateErrorHandler\fR. - .SH KEYWORDS callback, error, event, handler diff --git a/doc/CrtGenHdlr.3 b/doc/CrtGenHdlr.3 index 1e4f10c..c2161d1 100644 --- a/doc/CrtGenHdlr.3 +++ b/doc/CrtGenHdlr.3 @@ -24,7 +24,6 @@ Procedure to invoke whenever any X event occurs on any display. .AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE - .SH DESCRIPTION .PP \fBTk_CreateGenericHandler\fR arranges for \fIproc\fR to be @@ -45,9 +44,9 @@ call \fBTk_HandleEvent\fR, such as \fBTk_DoOneEvent\fR or \fIProc\fR should have arguments and result that match the type \fBTk_GenericProc\fR: .CS -typedef int Tk_GenericProc( - ClientData \fIclientData\fR, - XEvent *\fIeventPtr\fR); +typedef int \fBTk_GenericProc\fR( + ClientData \fIclientData\fR, + XEvent *\fIeventPtr\fR); .CE The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR argument given to \fBTk_CreateGenericHandler\fR when the callback diff --git a/doc/CrtImgType.3 b/doc/CrtImgType.3 index b7c3bb6..cbbc11e 100644 --- a/doc/CrtImgType.3 +++ b/doc/CrtImgType.3 @@ -21,11 +21,12 @@ ClientData .sp \fBTk_InitImageArgs\fR(\fIinterp, argc, argvPtr\fR) .SH ARGUMENTS -.AS Tk_ImageType *typePtrPtr -.AP Tk_ImageType *typePtr in +.AS "const Tk_ImageType" *typePtrPtr +.AP "const Tk_ImageType" *typePtr in Structure that defines the new type of image. -Must be static: a +For Tk 8.4 and earlier this must be static: a pointer to this structure is retained by the image code. +In Tk 8.5, this limitation was relaxed. .AP Tcl_Interp *interp in Interpreter in which image was created. .AP "const char" *name in @@ -38,7 +39,6 @@ Number of arguments .AP char ***argvPtr in/out Pointer to argument list .BE - .SH DESCRIPTION .PP \fBTk_CreateImageType\fR is invoked to define a new kind of image. @@ -59,13 +59,13 @@ the name of the image type and pointers to five procedures provided by the image manager to deal with images of this type: .CS typedef struct Tk_ImageType { - char *\fIname\fR; + const char *\fIname\fR; Tk_ImageCreateProc *\fIcreateProc\fR; Tk_ImageGetProc *\fIgetProc\fR; Tk_ImageDisplayProc *\fIdisplayProc\fR; Tk_ImageFreeProc *\fIfreeProc\fR; Tk_ImageDeleteProc *\fIdeleteProc\fR; -} Tk_ImageType; +} \fBTk_ImageType\fR; .CE The fields of this structure will be described in later subsections of this entry. @@ -92,7 +92,6 @@ option specified for a widget or canvas item. .PP The following subsections describe the fields of a Tk_ImageType in more detail. - .SS NAME .PP \fItypePtr->name\fR provides a name for the image type. @@ -101,21 +100,21 @@ in \fBimage create\fR commands to create images of the new type. If there already existed an image type by this name then the new image type replaces the old one. - .SS CREATEPROC +.PP \fItypePtr->createProc\fR provides the address of a procedure for Tk to call whenever \fBimage create\fR is invoked to create an image of the new type. \fItypePtr->createProc\fR must match the following prototype: .CS -typedef int Tk_ImageCreateProc( - Tcl_Interp *\fIinterp\fR, - char *\fIname\fR, - int \fIobjc\fR, - Tcl_Obj *const \fIobjv\fR[], - Tk_ImageType *\fItypePtr\fR, - Tk_ImageMaster \fImaster\fR, - ClientData *\fImasterDataPtr\fR); +typedef int \fBTk_ImageCreateProc\fR( + Tcl_Interp *\fIinterp\fR, + const char *\fIname\fR, + int \fIobjc\fR, + Tcl_Obj *const \fIobjv\fR[], + const Tk_ImageType *\fItypePtr\fR, + Tk_ImageMaster \fImaster\fR, + ClientData *\fImasterDataPtr\fR); .CE The \fIinterp\fR argument is the interpreter in which the \fBimage\fR command was invoked, and \fIname\fR is the name for the new image, @@ -141,16 +140,15 @@ it should return \fBTCL_OK\fR. .PP \fIcreateProc\fR should call \fBTk_ImageChanged\fR in order to set the size of the image and request an initial redisplay. - .SS GETPROC .PP \fItypePtr->getProc\fR is invoked by Tk whenever a widget calls \fBTk_GetImage\fR to use a particular image. This procedure must match the following prototype: .CS -typedef ClientData Tk_ImageGetProc( - Tk_Window \fItkwin\fR, - ClientData \fImasterData\fR); +typedef ClientData \fBTk_ImageGetProc\fR( + Tk_Window \fItkwin\fR, + ClientData \fImasterData\fR); .CE The \fItkwin\fR argument identifies the window in which the image will be used and \fImasterData\fR is the value @@ -162,23 +160,22 @@ display the image in the given window. is typically the address of the instance data structure. Tk will pass this value back to the image manager when invoking its \fIdisplayProc\fR and \fIfreeProc\fR procedures. - .SS DISPLAYPROC .PP \fItypePtr->displayProc\fR is invoked by Tk whenever an image needs to be displayed (i.e., whenever a widget calls \fBTk_RedrawImage\fR). \fIdisplayProc\fR must match the following prototype: .CS -typedef void Tk_ImageDisplayProc( - ClientData \fIinstanceData\fR, - Display *\fIdisplay\fR, - Drawable \fIdrawable\fR, - int \fIimageX\fR, - int \fIimageY\fR, - int \fIwidth\fR, - int \fIheight\fR, - int \fIdrawableX\fR, - int \fIdrawableY\fR); +typedef void \fBTk_ImageDisplayProc\fR( + ClientData \fIinstanceData\fR, + Display *\fIdisplay\fR, + Drawable \fIdrawable\fR, + int \fIimageX\fR, + int \fIimageY\fR, + int \fIwidth\fR, + int \fIheight\fR, + int \fIdrawableX\fR, + int \fIdrawableY\fR); .CE The \fIinstanceData\fR will be the same as the value returned by \fIgetProc\fR when the instance was created. @@ -195,7 +192,6 @@ as specified in the most recent call to \fBTk_ImageChanged\fR. the image should be displayed; \fIdisplayProc\fR should display the given region of the image so that point (\fIimageX\fR, \fIimageY\fR) in the image appears at (\fIdrawableX\fR, \fIdrawableY\fR) in \fIdrawable\fR. - .SS FREEPROC .PP \fItypePtr->freeProc\fR contains the address of a procedure that @@ -206,16 +202,15 @@ in a canvas is deleted, or when the image displayed in a widget or canvas item is changed. \fIfreeProc\fR must match the following prototype: .CS -typedef void Tk_ImageFreeProc( - ClientData \fIinstanceData\fR, - Display *\fIdisplay\fR); +typedef void \fBTk_ImageFreeProc\fR( + ClientData \fIinstanceData\fR, + Display *\fIdisplay\fR); .CE The \fIinstanceData\fR will be the same as the value returned by \fIgetProc\fR when the instance was created, and \fIdisplay\fR is the display containing the window for the instance. \fIfreeProc\fR should release any resources associated with the image instance, since the instance will never be used again. - .SS DELETEPROC .PP \fItypePtr->deleteProc\fR is a procedure that Tk invokes when an @@ -225,15 +220,14 @@ Before invoking \fIdeleteProc\fR Tk will invoke \fIfreeProc\fR for each of the image's instances. \fIdeleteProc\fR must match the following prototype: .CS -typedef void Tk_ImageDeleteProc( - ClientData \fImasterData\fR); +typedef void \fBTk_ImageDeleteProc\fR( + ClientData \fImasterData\fR); .CE The \fImasterData\fR argument will be the same as the value stored in \fI*masterDataPtr\fR by \fIcreateProc\fR when the image was created. \fIdeleteProc\fR should release any resources associated with the image. - .SH TK_GETIMAGEMASTERDATA .PP The procedure \fBTk_GetImageMasterData\fR may be invoked to retrieve @@ -247,19 +241,19 @@ and the return value is the ClientData value returned by the \fIcreateProc\fR when the image was created (this is typically a pointer to the image master data structure). If no such image exists then NULL is returned and NULL is stored at \fI*typePtrPtr\fR. - .SH "LEGACY INTERFACE SUPPORT" +.PP In Tk 8.2 and earlier, the definition of \fBTk_ImageCreateProc\fR was incompatibly different, with the following prototype: .CS -typedef int Tk_ImageCreateProc( - Tcl_Interp *\fIinterp\fR, - char *\fIname\fR, - int \fIargc\fR, - char **\fIargv\fR, - Tk_ImageType *\fItypePtr\fR, - Tk_ImageMaster \fImaster\fR, - ClientData *\fImasterDataPtr\fR); +typedef int \fBTk_ImageCreateProc\fR( + Tcl_Interp *\fIinterp\fR, + char *\fIname\fR, + int \fIargc\fR, + char **\fIargv\fR, + Tk_ImageType *\fItypePtr\fR, + Tk_ImageMaster \fImaster\fR, + ClientData *\fImasterDataPtr\fR); .CE Legacy programs and libraries dating from those days may still contain code that defines extended Tk image types using the old @@ -283,9 +277,7 @@ use Tk 8.4 headers and stub libraries to do so. .PP Any new code written today should not make use of the legacy interfaces. Expect their support to go away in Tk 9. - .SH "SEE ALSO" Tk_ImageChanged, Tk_GetImage, Tk_FreeImage, Tk_RedrawImage, Tk_SizeOfImage - .SH KEYWORDS image manager, image type, instance, master diff --git a/doc/CrtItemType.3 b/doc/CrtItemType.3 index 10b1cc0..005d2e2 100644 --- a/doc/CrtItemType.3 +++ b/doc/CrtItemType.3 @@ -44,7 +44,7 @@ NULL \fInextPtr\fR. .PP You may find it easier to understand the rest of this manual entry by looking at the code for an existing canvas item type such as -bitmap (file tkCanvBmap.c) or text (tkCanvText.c). +bitmap (in the file tkCanvBmap.c) or text (tkCanvText.c). The easiest way to create a new type manager is to copy the code for an existing type and modify it for the new type. .PP @@ -60,12 +60,13 @@ structures. The first data structure is a Tk_ItemType; it contains information such as the name of the type and pointers to the standard procedures implemented by the type manager: +.PP .CS typedef struct Tk_ItemType { - char *\fIname\fR; + const char *\fIname\fR; int \fIitemSize\fR; Tk_ItemCreateProc *\fIcreateProc\fR; - Tk_ConfigSpec *\fIconfigSpecs\fR; + const Tk_ConfigSpec *\fIconfigSpecs\fR; Tk_ItemConfigureProc *\fIconfigProc\fR; Tk_ItemCoordProc *\fIcoordProc\fR; Tk_ItemDeleteProc *\fIdeleteProc\fR; @@ -82,7 +83,7 @@ typedef struct Tk_ItemType { Tk_ItemInsertProc *\fIinsertProc\fR; Tk_ItemDCharsProc *\fIdCharsProc\fR; Tk_ItemType *\fInextPtr\fR; -} Tk_ItemType; +} \fBTk_ItemType\fR; .CE .PP The fields of a Tk_ItemType structure are described in more detail @@ -92,7 +93,7 @@ argument must point to a structure with all of the fields initialized except \fInextPtr\fR, which Tk sets to link all the types together into a list. The structure must be in permanent memory (either statically -allocated or dynamically allocated but never freed); Tk retains +allocated or dynamically allocated but never freed); Tk retains a pointer to this structure. .PP The second data structure manipulated by a type manager is an @@ -102,11 +103,12 @@ All of the items of a given type generally have item records with the same structure, but different types usually have different formats for their item records. The first part of each item record is a header with a standard structure -defined by Tk via the type Tk_Item; the rest of the item +defined by Tk via the type Tk_Item; the rest of the item record is defined by the type manager. A type manager must define its item records with a Tk_Item as the first field. For example, the item record for bitmap items is defined as follows: +.PP .CS typedef struct BitmapItem { Tk_Item \fIheader\fR; @@ -116,8 +118,9 @@ typedef struct BitmapItem { XColor *\fIfgColor\fR; XColor *\fIbgColor\fR; GC \fIgc\fR; -} BitmapItem; +} \fBBitmapItem\fR; .CE +.PP The \fIheader\fR substructure contains information used by Tk to manage the item, such as its identifier, its tags, its type, and its bounding box. @@ -127,7 +130,7 @@ The type manager should not need to read or write any of the fields in the header except for four fields whose names are \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR. These fields give a bounding box for the items using integer -canvas coordinates: the item should not cover any pixels +canvas coordinates: the item should not cover any pixels with x-coordinate lower than \fIx1\fR or y-coordinate lower than \fIy1\fR, nor should it cover any pixels with x-coordinate greater than or equal to \fIx2\fR or y-coordinate @@ -137,12 +140,12 @@ date as the item is moved and reconfigured. .PP Whenever Tk calls a procedure in a type manager it passes in a pointer to an item record. -The argument is always passed as a pointer to a Tk_Item; the type +The argument is always passed as a pointer to a Tk_Item; the type manager will typically cast this into a pointer to its own specific type, such as BitmapItem. .PP The third data structure used by type managers has type -Tk_Canvas; it serves as an opaque handle for the canvas widget +Tk_Canvas; it serves as an opaque handle for the canvas widget as a whole. Type managers need not know anything about the contents of this structure. @@ -150,6 +153,7 @@ A Tk_Canvas handle is typically passed in to the procedures of a type manager, and the type manager can pass the handle back to library procedures such as Tk_CanvasTkwin to fetch information about the canvas. +.SH "TK_ITEMTYPE FIELDS" .SS NAME .PP This section and the ones that follow describe each of the fields @@ -160,8 +164,37 @@ in \fBcreate\fR widget commands to create items of the new type. If there already existed an item type by this name then the new item type replaces the old one. +.SS "FLAGS (IN ALWAYSREDRAW)" +.PP +The \fItypePtr\->alwaysRedraw\fR field (so named for historic reasons) +contains a collection of flag bits that modify how the canvas core interacts +with the item. The following bits are defined: +.TP +\fB1\fR +. +Indicates that the item should always be redrawn when any part of the canvas +is redrawn, rather than only when the bounding box of the item overlaps the +area being redrawn. This is used by window items, for example, which need to +unmap subwindows that are not on the screen. +.TP +\fBTK_CONFIG_OBJS\fR +. +Indicates that operations which would otherwise take a string (or array of +strings) actually take a Tcl_Obj reference (or an array of such references). +The operations to which this applies are the \fIconfigProc\fR, the +\fIcoordProc\fR, the \fIcreateProc\fR, the \fIindexProc\fR and the +\fIinsertProc\fR. +.TP +\fBTK_MOVABLE_POINTS\fR +.VS 8.6 +Indicates that the item supports the \fIdCharsProc\fR, \fIindexProc\fR and +\fIinsertProc\fR with the same semantics as Tk's built-in line and polygon +types, and that hence individual coordinate points can be moved. Must not be +set if any of the above methods is NULL. +.VE 8.6 .SS ITEMSIZE -\fItypePtr->itemSize\fR gives the size in bytes of item records +.PP +\fItypePtr\->itemSize\fR gives the size in bytes of item records of this type, including the Tk_Item header. Tk uses this size to allocate memory space for items of the type. All of the item records for a given type must have the same size. @@ -170,31 +203,38 @@ of points for a polygon), the type manager can allocate a separate object of variable length and keep a pointer to it in the item record. .SS CREATEPROC .PP -\fItypePtr->createProc\fR points to a procedure for +\fItypePtr\->createProc\fR points to a procedure for Tk to call whenever a new item of this type is created. -\fItypePtr->createProc\fR must match the following prototype: +\fItypePtr\->createProc\fR must match the following prototype: +.PP .CS -typedef int Tk_ItemCreateProc( - Tcl_Interp *\fIinterp\fR, - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - int \fIobjc\fR, - Tcl_Obj* const \fIobjv\fR[]); +typedef int \fBTk_ItemCreateProc\fR( + Tcl_Interp *\fIinterp\fR, + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + int \fIobjc\fR, + Tcl_Obj *const \fIobjv\fR[]); .CE +.PP The \fIinterp\fR argument is the interpreter in which the canvas's \fBcreate\fR widget command was invoked, and \fIcanvas\fR is a handle for the canvas widget. \fIitemPtr\fR is a pointer to a newly-allocated item of -size \fItypePtr->itemSize\fR. +size \fItypePtr\->itemSize\fR. Tk has already initialized the item's header (the first \fBsizeof(Tk_ItemType)\fR bytes). The \fIobjc\fR and \fIobjv\fR arguments describe all of the arguments to the \fBcreate\fR command after the \fItype\fR argument. -For example, in the widget command +Note that if \fBTK_CONFIG_OBJS\fR is not set in the +\fItypePtr\->alwaysRedraw\fR field, the \fIobjv\fR parameter will actually +contain a pointer to an array of constant strings. +For example, in the widget command: +.PP .CS \fB\&.c create rectangle 10 20 50 50 \-fill black\fR .CE +.PP \fIobjc\fR will be \fB6\fR and \fIobjv\fR[0] will contain the integer object \fB10\fR. .PP @@ -202,7 +242,7 @@ integer object \fB10\fR. the type-specific parts of the item record and set an initial value for the bounding box in the item's header. It should return a standard Tcl completion code and leave an -error message in \fIinterp->result\fR if an error occurs. +error message in the interpreter result if an error occurs. If an error occurs Tk will free the item record, so \fIcreateProc\fR must be sure to leave the item record in a clean state if it returns an error (e.g., it must free any additional memory that it allocated for @@ -212,70 +252,84 @@ the item). Each type manager must provide a standard table describing its configuration options, in a form suitable for use with \fBTk_ConfigureWidget\fR. -This table will normally be used by \fItypePtr->createProc\fR -and \fItypePtr->configProc\fR, but Tk also uses it directly +This table will normally be used by \fItypePtr\->createProc\fR +and \fItypePtr\->configProc\fR, but Tk also uses it directly to retrieve option information in the \fBitemcget\fR and \fBitemconfigure\fR widget commands. -\fItypePtr->configSpecs\fR must point to the configuration table +\fItypePtr\->configSpecs\fR must point to the configuration table for this type. Note: Tk provides a custom option type \fBtk_CanvasTagsOption\fR -for implementing the \fB\-tags\fR option; see an existing type +for implementing the \fB\-tags\fR option; see an existing type manager for an example of how to use it in \fIconfigSpecs\fR. .SS CONFIGPROC .PP -\fItypePtr->configProc\fR is called by Tk whenever the +\fItypePtr\->configProc\fR is called by Tk whenever the \fBitemconfigure\fR widget command is invoked to change the configuration options for a canvas item. This procedure must match the following prototype: +.PP .CS -typedef int Tk_ItemConfigureProc( - Tcl_Interp *\fIinterp\fR, - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - int \fIobjc\fR, - Tcl_Obj* const \fIobjv\fR[], - int \fIflags\fR); +typedef int \fBTk_ItemConfigureProc\fR( + Tcl_Interp *\fIinterp\fR, + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + int \fIobjc\fR, + Tcl_Obj *const \fIobjv\fR[], + int \fIflags\fR); .CE -The \fIinterp\fR objument identifies the interpreter in which the -widget command was invoked, \fIcanvas\fR is a handle for the canvas +.PP +The \fIinterp\fR argument identifies the interpreter in which the +widget command was invoked, \fIcanvas\fR is a handle for the canvas widget, and \fIitemPtr\fR is a pointer to the item being configured. -\fIobjc\fR and \fIobjv\fR contain the configuration options. For -example, if the following command is invoked: +\fIobjc\fR and \fIobjv\fR contain the configuration options. +Note that if \fBTK_CONFIG_OBJS\fR is not set in the +\fItypePtr\->alwaysRedraw\fR field, the \fIobjv\fR parameter will actually +contain a pointer to an array of constant strings. +For example, if the following command is invoked: +.PP .CS \fB\&.c itemconfigure 2 \-fill red \-outline black\fR .CE +.PP \fIobjc\fR is \fB4\fR and \fIobjv\fR contains the string objects \fB\-fill\fR through \fBblack\fR. \fIobjc\fR will always be an even value. -The \fIflags\fR argument contains flags to pass to \fBTk_ConfigureWidget\fR; +The \fIflags\fR argument contains flags to pass to \fBTk_ConfigureWidget\fR; currently this value is always \fBTK_CONFIG_ARGV_ONLY\fR when Tk -invokes \fItypePtr->configProc\fR, but the type manager's \fIcreateProc\fR +invokes \fItypePtr\->configProc\fR, but the type manager's \fIcreateProc\fR procedure will usually invoke \fIconfigProc\fR with different flag values. .PP -\fItypePtr->configProc\fR returns a standard Tcl completion code and -leaves an error message in \fIinterp->result\fR if an error occurs. +\fItypePtr\->configProc\fR returns a standard Tcl completion code and +leaves an error message in the interpreter result if an error occurs. It must update the item's bounding box to reflect the new configuration options. .SS COORDPROC .PP -\fItypePtr->coordProc\fR is invoked by Tk to implement the \fBcoords\fR +\fItypePtr\->coordProc\fR is invoked by Tk to implement the \fBcoords\fR widget command for an item. It must match the following prototype: +.PP .CS -typedef int Tk_ItemCoordProc( - Tcl_Interp *\fIinterp\fR, - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - int \fIobjc\fR, - Tcl_Obj* const \fIobjv\fR[]); +typedef int \fBTk_ItemCoordProc\fR( + Tcl_Interp *\fIinterp\fR, + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + int \fIobjc\fR, + Tcl_Obj *const \fIobjv\fR[]); .CE +.PP The arguments \fIinterp\fR, \fIcanvas\fR, and \fIitemPtr\fR all have the standard meanings, and \fIobjc\fR and \fIobjv\fR describe the coordinate arguments. +Note that if \fBTK_CONFIG_OBJS\fR is not set in the +\fItypePtr\->alwaysRedraw\fR field, the \fIobjv\fR parameter will actually +contain a pointer to an array of constant strings. For example, if the following widget command is invoked: +.PP .CS \fB\&.c coords 2 30 90\fR .CE +.PP \fIobjc\fR will be \fB2\fR and \fBobjv\fR will contain the integer objects \fB30\fR and \fB90\fR. .PP @@ -284,41 +338,45 @@ update the item appropriately (e.g., it must reset the bounding box in the item's header), and return a standard Tcl completion code. If an error occurs, \fIcoordProc\fR must leave an error message in -\fIinterp->result\fR. +the interpreter result. .SS DELETEPROC .PP -\fItypePtr->deleteProc\fR is invoked by Tk to delete an item +\fItypePtr\->deleteProc\fR is invoked by Tk to delete an item and free any resources allocated to it. It must match the following prototype: +.PP .CS -typedef void Tk_ItemDeleteProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - Display *\fIdisplay\fR); +typedef void \fBTk_ItemDeleteProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + Display *\fIdisplay\fR); .CE +.PP The \fIcanvas\fR and \fIitemPtr\fR arguments have the usual interpretations, and \fIdisplay\fR identifies the X display containing the canvas. \fIdeleteProc\fR must free up any resources allocated for the item, so that Tk can free the item record. -\fIdeleteProc\fR should not actually free the item record; this will +\fIdeleteProc\fR should not actually free the item record; this will be done by Tk when \fIdeleteProc\fR returns. -.SS "DISPLAYPROC AND ALWAYSREDRAW" +.SS "DISPLAYPROC" .PP -\fItypePtr->displayProc\fR is invoked by Tk to redraw an item +\fItypePtr\->displayProc\fR is invoked by Tk to redraw an item on the screen. It must match the following prototype: +.PP .CS -typedef void Tk_ItemDisplayProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - Display *\fIdisplay\fR, - Drawable \fIdst\fR, - int \fIx\fR, - int \fIy\fR, - int \fIwidth\fR, - int \fIheight\fR); +typedef void \fBTk_ItemDisplayProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + Display *\fIdisplay\fR, + Drawable \fIdst\fR, + int \fIx\fR, + int \fIy\fR, + int \fIwidth\fR, + int \fIheight\fR); .CE +.PP The \fIcanvas\fR and \fIitemPtr\fR arguments have the usual meaning. \fIdisplay\fR identifies the display containing the canvas, and \fIdst\fR specifies a drawable in which the item should be rendered; @@ -340,25 +398,28 @@ of \fIdst\fR. .PP Normally an item's \fIdisplayProc\fR is only invoked if the item overlaps the area being displayed. -However, if \fItypePtr->alwaysRedraw\fR has a non-zero value, then -\fIdisplayProc\fR is invoked during every redisplay operation, -even if the item does not overlap the area of redisplay. -\fIalwaysRedraw\fR should normally be set to 0; it is only -set to 1 in special cases such as window items that need to be -unmapped when they are off-screen. +However, if bit zero of \fItypePtr\->alwaysRedraw\fR is 1, +(i.e.\| +.QW "\fItypePtr\->alwaysRedraw & 1 == 1\fR" ) +then \fIdisplayProc\fR is invoked during every redisplay operation, +even if the item does not overlap the area of redisplay; this is useful for +cases such as window items, where the subwindow needs to be unmapped when it +is off the screen. .SS POINTPROC .PP -\fItypePtr->pointProc\fR is invoked by Tk to find out how close +\fItypePtr\->pointProc\fR is invoked by Tk to find out how close a given point is to a canvas item. Tk uses this procedure for purposes such as locating the item under the mouse or finding the closest item to a given point. The procedure must match the following prototype: +.PP .CS -typedef double Tk_ItemPointProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - double *\fIpointPtr\fR); +typedef double \fBTk_ItemPointProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + double *\fIpointPtr\fR); .CE +.PP \fIcanvas\fR and \fIitemPtr\fR have the usual meaning. \fIpointPtr\fR points to an array of two numbers giving the x and y coordinates of a point. @@ -367,15 +428,17 @@ from the point to the item, or 0 if the point lies inside the item. .SS AREAPROC .PP -\fItypePtr->areaProc\fR is invoked by Tk to find out the relationship +\fItypePtr\->areaProc\fR is invoked by Tk to find out the relationship between an item and a rectangular area. It must match the following prototype: +.PP .CS -typedef int Tk_ItemAreaProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - double *\fIrectPtr\fR); +typedef int \fBTk_ItemAreaProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + double *\fIrectPtr\fR); .CE +.PP \fIcanvas\fR and \fIitemPtr\fR have the usual meaning. \fIrectPtr\fR points to an array of four real numbers; the first two give the x and y coordinates of the upper left @@ -386,26 +449,28 @@ the given area, 0 if it lies partially inside and partially outside the area, and 1 if it lies entirely inside the area. .SS POSTSCRIPTPROC .PP -\fItypePtr->postscriptProc\fR is invoked by Tk to generate +\fItypePtr\->postscriptProc\fR is invoked by Tk to generate Postscript for an item during the \fBpostscript\fR widget command. If the type manager is not capable of generating Postscript then -\fItypePtr->postscriptProc\fR should be NULL. +\fItypePtr\->postscriptProc\fR should be NULL. The procedure must match the following prototype: +.PP .CS -typedef int Tk_ItemPostscriptProc( - Tcl_Interp *\fIinterp\fR, - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - int \fIprepass\fR); +typedef int \fBTk_ItemPostscriptProc\fR( + Tcl_Interp *\fIinterp\fR, + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + int \fIprepass\fR); .CE +.PP The \fIinterp\fR, \fIcanvas\fR, and \fIitemPtr\fR arguments all have -standard meanings; \fIprepass\fR will be described below. +standard meanings; \fIprepass\fR will be described below. If \fIpostscriptProc\fR completes successfully, it should append -Postscript for the item to the information in \fIinterp->result\fR +Postscript for the item to the information in the interpreter result (e.g. by calling \fBTcl_AppendResult\fR, not \fBTcl_SetResult\fR) and return \fBTCL_OK\fR. If an error occurs, \fIpostscriptProc\fR should clear the result -and replace its contents with an error message; then it should +and replace its contents with an error message; then it should return \fBTCL_ERROR\fR. .PP Tk provides a collection of utility procedures to simplify @@ -427,26 +492,29 @@ In order to generate Postscript that complies with the Adobe Document Structuring Conventions, Tk actually generates Postscript in two passes. It calls each item's \fIpostscriptProc\fR in each pass. The only purpose of the first pass is to collect font information -(which is done by \fBTk_CanvasPsFont\fR); the actual Postscript is +(which is done by \fBTk_CanvasPsFont\fR); the actual Postscript is discarded. Tk sets the \fIprepass\fR argument to \fIpostscriptProc\fR to 1 -during the first pass; the type manager can use \fIprepass\fR to skip +during the first pass; the type manager can use \fIprepass\fR to skip all Postscript generation except for calls to \fBTk_CanvasPsFont\fR. During the second pass \fIprepass\fR will be 0, so the type manager must generate complete Postscript. .SS SCALEPROC -\fItypePtr->scaleProc\fR is invoked by Tk to rescale a canvas item +.PP +\fItypePtr\->scaleProc\fR is invoked by Tk to rescale a canvas item during the \fBscale\fR widget command. The procedure must match the following prototype: +.PP .CS -typedef void Tk_ItemScaleProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - double \fIoriginX\fR, - double \fIoriginY\fR, - double \fIscaleX\fR, - double \fIscaleY\fR); +typedef void \fBTk_ItemScaleProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + double \fIoriginX\fR, + double \fIoriginY\fR, + double \fIscaleX\fR, + double \fIscaleY\fR); .CE +.PP The \fIcanvas\fR and \fIitemPtr\fR arguments have the usual meaning. \fIoriginX\fR and \fIoriginY\fR specify an origin relative to which the item is to be scaled, and \fIscaleX\fR and \fIscaleY\fR give the @@ -454,146 +522,171 @@ x and y scale factors. The item should adjust its coordinates so that a point in the item that used to have coordinates \fIx\fR and \fIy\fR will have new coordinates \fIx\(fm\fR and \fIy\(fm\fR, where +.PP .CS -\fIx\(fm = originX + scaleX*(x-originX) -y\(fm = originY + scaleY*(y-originY)\fR +\fIx\(fm\fR = \fIoriginX\fR + \fIscaleX\fR \(mu (\fIx\fR \(mi \fIoriginX\fR) +\fIy\(fm\fR = \fIoriginY\fR + \fIscaleY\fR \(mu (\fIy\fR \(mi \fIoriginY\fR) .CE +.PP \fIscaleProc\fR must also update the bounding box in the item's header. .SS TRANSLATEPROC -\fItypePtr->translateProc\fR is invoked by Tk to translate a canvas item +.PP +\fItypePtr\->translateProc\fR is invoked by Tk to translate a canvas item during the \fBmove\fR widget command. The procedure must match the following prototype: +.PP .CS -typedef void Tk_ItemTranslateProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - double \fIdeltaX\fR, - double \fIdeltaY\fR); +typedef void \fBTk_ItemTranslateProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + double \fIdeltaX\fR, + double \fIdeltaY\fR); .CE +.PP The \fIcanvas\fR and \fIitemPtr\fR arguments have the usual meaning, and \fIdeltaX\fR and \fIdeltaY\fR give the amounts that should be added to each x and y coordinate within the item. The type manager should adjust the item's coordinates and update the bounding box in the item's header. .SS INDEXPROC -\fItypePtr->indexProc\fR is invoked by Tk to translate a string +.PP +\fItypePtr\->indexProc\fR is invoked by Tk to translate a string index specification into a numerical index, for example during the \fBindex\fR widget command. -It is only relevant for item types that support indexable text; -\fItypePtr->indexProc\fR may be specified as NULL for non-textual -item types. +It is only relevant for item types that support indexable text or coordinates; +\fItypePtr\->indexProc\fR may be specified as NULL for non-textual +item types if they do not support detailed coordinate addressing. The procedure must match the following prototype: +.PP .CS -typedef int Tk_ItemIndexProc( - Tcl_Interp *\fIinterp\fR, - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - char \fIindexString\fR, - int *\fIindexPtr\fR); +typedef int \fBTk_ItemIndexProc\fR( + Tcl_Interp *\fIinterp\fR, + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + Tcl_Obj *\fIindexObj\fR, + int *\fIindexPtr\fR); .CE +.PP The \fIinterp\fR, \fIcanvas\fR, and \fIitemPtr\fR arguments all have the usual meaning. -\fIindexString\fR contains a textual description of an index, +\fIindexObj\fR contains a textual description of an index, and \fIindexPtr\fR points to an integer value that should be filled in with a numerical index. +Note that if \fBTK_CONFIG_OBJS\fR is not set in the +\fItypePtr\->alwaysRedraw\fR field, the \fIindexObj\fR parameter will +actually contain a pointer to a constant string. It is up to the type manager to decide what forms of index -are supported (e.g., numbers, \fBinsert\fR, \fBsel.first\fR, +are supported (e.g., numbers, \fBinsert\fR, \fBsel.first\fR, \fBend\fR, etc.). \fIindexProc\fR should return a Tcl completion code and set -\fIinterp->result\fR in the event of an error. +the interpreter result in the event of an error. .SS ICURSORPROC .PP -\fItypePtr->icursorProc\fR is invoked by Tk during +\fItypePtr\->icursorProc\fR is invoked by Tk during the \fBicursor\fR widget command to set the position of the insertion cursor in a textual item. It is only relevant for item types that support an insertion cursor; -\fItypePtr->icursorProc\fR may be specified as NULL for item types +\fItypePtr\->icursorProc\fR may be specified as NULL for item types that do not support an insertion cursor. The procedure must match the following prototype: +.PP .CS -typedef void Tk_ItemCursorProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - int \fIindex\fR); +typedef void \fBTk_ItemCursorProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + int \fIindex\fR); .CE +.PP \fIcanvas\fR and \fIitemPtr\fR have the usual meanings, and \fIindex\fR is an index into the item's text, as returned by a -previous call to \fItypePtr->insertProc\fR. +previous call to \fItypePtr\->insertProc\fR. The type manager should position the insertion cursor in the item just before the character given by \fIindex\fR. Whether or not to actually display the insertion cursor is determined by other information provided by \fBTk_CanvasGetTextInfo\fR. .SS SELECTIONPROC .PP -\fItypePtr->selectionProc\fR is invoked by Tk during selection -retrievals; it must return part or all of the selected text in +\fItypePtr\->selectionProc\fR is invoked by Tk during selection +retrievals; it must return part or all of the selected text in the item (if any). It is only relevant for item types that support text; -\fItypePtr->selectionProc\fR may be specified as NULL for non-textual +\fItypePtr\->selectionProc\fR may be specified as NULL for non-textual item types. The procedure must match the following prototype: +.PP .CS -typedef int Tk_ItemSelectionProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - int \fIoffset\fR, - char *\fIbuffer\fR, - int \fImaxBytes\fR); +typedef int \fBTk_ItemSelectionProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + int \fIoffset\fR, + char *\fIbuffer\fR, + int \fImaxBytes\fR); .CE +.PP \fIcanvas\fR and \fIitemPtr\fR have the usual meanings. \fIoffset\fR is an offset in bytes into the selection where 0 refers -to the first byte of the selection; it identifies +to the first byte of the selection; it identifies the first character that is to be returned in this call. \fIbuffer\fR points to an area of memory in which to store the requested bytes, and \fImaxBytes\fR specifies the maximum number of bytes to return. \fIselectionProc\fR should extract up to \fImaxBytes\fR characters -from the selection and copy them to \fImaxBytes\fR; it should +from the selection and copy them to \fImaxBytes\fR; it should return a count of the number of bytes actually copied, which may be less than \fImaxBytes\fR if there are not \fIoffset+maxBytes\fR bytes in the selection. .SS INSERTPROC .PP -\fItypePtr->insertProc\fR is invoked by Tk during -the \fBinsert\fR widget command to insert new text into a +\fItypePtr\->insertProc\fR is invoked by Tk during +the \fBinsert\fR widget command to insert new text or coordinates into a canvas item. -It is only relevant for item types that support text; -\fItypePtr->insertProc\fR may be specified as NULL for non-textual +It is only relevant for item types that support the \fBinsert\fR method; +\fItypePtr\->insertProc\fR may be specified as NULL for other item types. The procedure must match the following prototype: +.PP .CS -typedef void Tk_ItemInsertProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - int \fIindex\fR, - char *\fIstring\fR); +typedef void \fBTk_ItemInsertProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + int \fIindex\fR, + Tcl_Obj *\fIobj\fR); .CE +.PP \fIcanvas\fR and \fIitemPtr\fR have the usual meanings. \fIindex\fR is an index into the item's text, as returned by a -previous call to \fItypePtr->insertProc\fR, and \fIstring\fR +previous call to \fItypePtr\->insertProc\fR, and \fIobj\fR contains new text to insert just before the character given by \fIindex\fR. +Note that if \fBTK_CONFIG_OBJS\fR is not set in the +\fItypePtr\->alwaysRedraw\fR field, the \fIobj\fR parameter will +actually contain a pointer to a constant string to be inserted. +If the item supports modification of the coordinates list by this +.PP The type manager should insert the text and recompute the bounding box in the item's header. .SS DCHARSPROC .PP -\fItypePtr->dCharsProc\fR is invoked by Tk during the \fBdchars\fR -widget command to delete a range of text from a canvas item. +\fItypePtr\->dCharsProc\fR is invoked by Tk during the \fBdchars\fR +widget command to delete a range of text from a canvas item or a range of +coordinates from a pathed item. It is only relevant for item types that support text; -\fItypePtr->dCharsProc\fR may be specified as NULL for non-textual -item types. +\fItypePtr\->dCharsProc\fR may be specified as NULL for non-textual +item types that do not want to support coordinate deletion. The procedure must match the following prototype: +.PP .CS -typedef void Tk_ItemDCharsProc( - Tk_Canvas \fIcanvas\fR, - Tk_Item *\fIitemPtr\fR, - int \fIfirst\fR, - int \fIlast\fR); +typedef void \fBTk_ItemDCharsProc\fR( + Tk_Canvas \fIcanvas\fR, + Tk_Item *\fIitemPtr\fR, + int \fIfirst\fR, + int \fIlast\fR); .CE +.PP \fIcanvas\fR and \fIitemPtr\fR have the usual meanings. \fIfirst\fR and \fIlast\fR give the indices of the first and last bytes -to be deleted, as returned by previous calls to \fItypePtr->indexProc\fR. +to be deleted, as returned by previous calls to \fItypePtr\->indexProc\fR. The type manager should delete the specified characters and update the bounding box in the item's header. .SH "SEE ALSO" diff --git a/doc/CrtPhImgFmt.3 b/doc/CrtPhImgFmt.3 index b5559c8..c7e792a 100644 --- a/doc/CrtPhImgFmt.3 +++ b/doc/CrtPhImgFmt.3 @@ -20,11 +20,10 @@ Tk_CreatePhotoImageFormat \- define new file format for photo images .sp \fBTk_CreatePhotoImageFormat\fR(\fIformatPtr\fR) .SH ARGUMENTS -.AS Tk_PhotoImageFormat *formatPtr -.AP Tk_PhotoImageFormat *formatPtr in +.AS "const Tk_PhotoImageFormat" *formatPtr +.AP "const Tk_PhotoImageFormat" *formatPtr in Structure that defines the new file format. .BE - .SH DESCRIPTION .PP \fBTk_CreatePhotoImageFormat\fR is invoked to define a new file format @@ -46,14 +45,14 @@ handler to deal with files and strings in this format. The Tk_PhotoImageFormat structure contains the following fields: .CS typedef struct Tk_PhotoImageFormat { - char *\fIname\fR; + const char *\fIname\fR; Tk_ImageFileMatchProc *\fIfileMatchProc\fR; Tk_ImageStringMatchProc *\fIstringMatchProc\fR; Tk_ImageFileReadProc *\fIfileReadProc\fR; Tk_ImageStringReadProc *\fIstringReadProc\fR; Tk_ImageFileWriteProc *\fIfileWriteProc\fR; Tk_ImageStringWriteProc *\fIstringWriteProc\fR; -} Tk_PhotoImageFormat; +} \fBTk_PhotoImageFormat\fR; .CE .PP The handler need not provide implementations of all six procedures. @@ -65,8 +64,7 @@ structure should be set to NULL. The handler must provide the \fIfileMatchProc\fR procedure if it provides the \fIfileReadProc\fR procedure, and the \fIstringMatchProc\fR procedure if it provides the \fIstringReadProc\fR procedure. - -.SH NAME +.SS NAME .PP \fIformatPtr->name\fR provides a name for the image type. Once \fBTk_CreatePhotoImageFormat\fR returns, this name may be used @@ -77,20 +75,20 @@ the \fB\-format\fR option. The first character of \fIformatPtr->name\fR must not be an uppercase character from the ASCII character set (that is, one of the characters \fBA\fR-\fBZ\fR). Such names are used only for legacy interface support (see below). - -.SH FILEMATCHPROC +.SS FILEMATCHPROC +.PP \fIformatPtr->fileMatchProc\fR provides the address of a procedure for Tk to call when it is searching for an image file format handler suitable for reading data in a given file. \fIformatPtr->fileMatchProc\fR must match the following prototype: .CS -typedef int Tk_ImageFileMatchProc( - Tcl_Channel \fIchan\fR, - const char *\fIfileName\fR, - Tcl_Obj *\fIformat\fR, - int *\fIwidthPtr\fR, - int *\fIheightPtr\fR, - Tcl_Interp *\fIinterp\fR); +typedef int \fBTk_ImageFileMatchProc\fR( + Tcl_Channel \fIchan\fR, + const char *\fIfileName\fR, + Tcl_Obj *\fIformat\fR, + int *\fIwidthPtr\fR, + int *\fIheightPtr\fR, + Tcl_Interp *\fIinterp\fR); .CE The \fIfileName\fR argument is the name of the file containing the image data, which is open for reading as \fIchan\fR. The @@ -100,19 +98,19 @@ If the data in the file appears to be in the format supported by this handler, the \fIformatPtr->fileMatchProc\fR procedure should store the width and height of the image in *\fIwidthPtr\fR and *\fIheightPtr\fR respectively, and return 1. Otherwise it should return 0. - -.SH STRINGMATCHPROC +.SS STRINGMATCHPROC +.PP \fIformatPtr->stringMatchProc\fR provides the address of a procedure for Tk to call when it is searching for an image file format handler for suitable for reading data from a given string. \fIformatPtr->stringMatchProc\fR must match the following prototype: .CS -typedef int Tk_ImageStringMatchProc( - Tcl_Obj *\fIdata\fR, - Tcl_Obj *\fIformat\fR, - int *\fIwidthPtr\fR, - int *\fIheightPtr\fR, - Tcl_Interp *\fIinterp\fR); +typedef int \fBTk_ImageStringMatchProc\fR( + Tcl_Obj *\fIdata\fR, + Tcl_Obj *\fIformat\fR, + int *\fIwidthPtr\fR, + int *\fIheightPtr\fR, + Tcl_Interp *\fIinterp\fR); .CE The \fIdata\fR argument points to the object containing the image data. The \fIformat\fR argument contains the value given for @@ -122,21 +120,21 @@ this handler, the \fIformatPtr->stringMatchProc\fR procedure should store the width and height of the image in *\fIwidthPtr\fR and *\fIheightPtr\fR respectively, and return 1. Otherwise it should return 0. - -.SH FILEREADPROC +.SS FILEREADPROC +.PP \fIformatPtr->fileReadProc\fR provides the address of a procedure for Tk to call to read data from an image file into a photo image. \fIformatPtr->fileReadProc\fR must match the following prototype: .CS -typedef int Tk_ImageFileReadProc( - Tcl_Interp *\fIinterp\fR, - Tcl_Channel \fIchan\fR, - const char *\fIfileName\fR, - Tcl_Obj *\fIformat\fR, - PhotoHandle \fIimageHandle\fR, - int \fIdestX\fR, int \fIdestY\fR, - int \fIwidth\fR, int \fIheight\fR, - int \fIsrcX\fR, int \fIsrcY\fR); +typedef int \fBTk_ImageFileReadProc\fR( + Tcl_Interp *\fIinterp\fR, + Tcl_Channel \fIchan\fR, + const char *\fIfileName\fR, + Tcl_Obj *\fIformat\fR, + PhotoHandle \fIimageHandle\fR, + int \fIdestX\fR, int \fIdestY\fR, + int \fIwidth\fR, int \fIheight\fR, + int \fIsrcX\fR, int \fIsrcY\fR); .CE The \fIinterp\fR argument is the interpreter in which the command was invoked to read the image; it should be used for reporting errors. @@ -151,20 +149,20 @@ coordinates (\fIsrcX\fR,\fIsrcY\fR). It is to be stored in the photo image with its top-left corner at coordinates (\fIdestX\fR,\fIdestY\fR) using the \fBTk_PhotoPutBlock\fR procedure. The return value is a standard Tcl return value. - -.SH STRINGREADPROC +.SS STRINGREADPROC +.PP \fIformatPtr->stringReadProc\fR provides the address of a procedure for Tk to call to read data from a string into a photo image. \fIformatPtr->stringReadProc\fR must match the following prototype: .CS -typedef int Tk_ImageStringReadProc( - Tcl_Interp *\fIinterp\fR, - Tcl_Obj *\fIdata\fR, - Tcl_Obj *\fIformat\fR, - PhotoHandle \fIimageHandle\fR, - int \fIdestX\fR, int \fIdestY\fR, - int \fIwidth\fR, int \fIheight\fR, - int \fIsrcX\fR, int \fIsrcY\fR); +typedef int \fBTk_ImageStringReadProc\fR( + Tcl_Interp *\fIinterp\fR, + Tcl_Obj *\fIdata\fR, + Tcl_Obj *\fIformat\fR, + PhotoHandle \fIimageHandle\fR, + int \fIdestX\fR, int \fIdestY\fR, + int \fIwidth\fR, int \fIheight\fR, + int \fIsrcX\fR, int \fIsrcY\fR); .CE The \fIinterp\fR argument is the interpreter in which the command was invoked to read the image; it should be used for reporting errors. @@ -179,17 +177,17 @@ coordinates (\fIsrcX\fR,\fIsrcY\fR). It is to be stored in the photo image with its top-left corner at coordinates (\fIdestX\fR,\fIdestY\fR) using the \fBTk_PhotoPutBlock\fR procedure. The return value is a standard Tcl return value. - -.SH FILEWRITEPROC +.SS FILEWRITEPROC +.PP \fIformatPtr->fileWriteProc\fR provides the address of a procedure for Tk to call to write data from a photo image to a file. \fIformatPtr->fileWriteProc\fR must match the following prototype: .CS -typedef int Tk_ImageFileWriteProc( - Tcl_Interp *\fIinterp\fR, - const char *\fIfileName\fR, - Tcl_Obj *\fIformat\fR, - Tk_PhotoImageBlock *\fIblockPtr\fR); +typedef int \fBTk_ImageFileWriteProc\fR( + Tcl_Interp *\fIinterp\fR, + const char *\fIfileName\fR, + Tcl_Obj *\fIformat\fR, + Tk_PhotoImageBlock *\fIblockPtr\fR); .CE The \fIinterp\fR argument is the interpreter in which the command was invoked to write the image; it should be used for reporting errors. @@ -204,16 +202,16 @@ after the name of the format. If appropriate, the \fIformatPtr->fileWriteProc\fR procedure may interpret these characters to specify further details about the image file. The return value is a standard Tcl return value. - -.SH STRINGWRITEPROC +.SS STRINGWRITEPROC +.PP \fIformatPtr->stringWriteProc\fR provides the address of a procedure for Tk to call to translate image data from a photo image into a string. \fIformatPtr->stringWriteProc\fR must match the following prototype: .CS -typedef int Tk_ImageStringWriteProc( - Tcl_Interp *\fIinterp\fR, - Tcl_Obj *\fIformat\fR, - Tk_PhotoImageBlock *\fIblockPtr\fR); +typedef int \fBTk_ImageStringWriteProc\fR( + Tcl_Interp *\fIinterp\fR, + Tcl_Obj *\fIformat\fR, + Tk_PhotoImageBlock *\fIblockPtr\fR); .CE The \fIinterp\fR argument is the interpreter in which the command was invoked to convert the image; it should be used for reporting errors. @@ -228,8 +226,8 @@ after the name of the format. If appropriate, the \fIformatPtr->stringWriteProc\fR procedure may interpret these characters to specify further details about the image file. The return value is a standard Tcl return value. - .SH "LEGACY INTERFACE SUPPORT" +.PP In Tk 8.2 and earlier, the definition of all the function pointer types stored in fields of a \fBTk_PhotoImageFormat\fR struct were incompatibly different. Legacy programs and libraries dating from @@ -266,9 +264,7 @@ use Tk 8.4 headers and stub libraries to do so. .PP Any new code written today should not make use of the legacy interfaces. Expect their support to go away in Tk 9. - .SH "SEE ALSO" Tk_FindPhoto, Tk_PhotoPutBlock - .SH KEYWORDS photo image, image file diff --git a/doc/CrtSelHdlr.3 b/doc/CrtSelHdlr.3 index b5eb841..2aeffa9 100644 --- a/doc/CrtSelHdlr.3 +++ b/doc/CrtSelHdlr.3 @@ -54,11 +54,11 @@ the selection. The most common form is STRING. \fIProc\fR should have arguments and result that match the type \fBTk_SelectionProc\fR: .CS -typedef int Tk_SelectionProc( - ClientData \fIclientData\fR, - int \fIoffset\fR, - char *\fIbuffer\fR, - int \fImaxBytes\fR); +typedef int \fBTk_SelectionProc\fR( + ClientData \fIclientData\fR, + int \fIoffset\fR, + char *\fIbuffer\fR, + int \fImaxBytes\fR); .CE The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR argument given to \fBTk_CreateSelHandler\fR. @@ -112,6 +112,5 @@ existing handler is replaced with a new one. \fBTk_DeleteSelHandler\fR removes the handler given by \fItkwin\fR, \fIselection\fR, and \fItarget\fR, if such a handler exists. If there is no such handler then it has no effect. - .SH KEYWORDS format, handler, selection, target diff --git a/doc/CrtWindow.3 b/doc/CrtWindow.3 index 82a5c80..8f44545 100644 --- a/doc/CrtWindow.3 +++ b/doc/CrtWindow.3 @@ -58,8 +58,8 @@ are used to create new windows for use in Tk-based applications. Each of the procedures returns a token that can be used to manipulate the window in other calls to the Tk library. If the window could not be created successfully, then NULL -is returned and \fIinterp->result\fR is modified to hold an error -message. +is returned and the result of interpreter \fIinterp\fR is modified to +hold an error message. .PP Tk supports two different kinds of windows: internal windows and top-level windows. @@ -86,7 +86,7 @@ which would in turn be a child of the menu bar window. A dialog box might have the application's main window as its parent. .PP \fBTk_CreateAnonymousWindow\fR differs from \fBTk_CreateWindow\fR in -that it creates an unnamed window. This window will be manipulable +that it creates an unnamed window. This window will be manipulatable only using C interfaces, and will not be visible to Tcl scripts. Both interior windows and top-level windows may be created with \fBTk_CreateAnonymousWindow\fR. @@ -141,7 +141,6 @@ but has not been mapped, so no X window exists, it is possible to force the creation of the X window by calling \fBTk_MakeWindowExist\fR. This procedure issues the X commands to instantiate the window given by \fItkwin\fR. - .SH KEYWORDS create, deferred creation, destroy, display, internal window, screen, top-level window, window diff --git a/doc/DeleteImg.3 b/doc/DeleteImg.3 index 2d3d83c..507be72 100644 --- a/doc/DeleteImg.3 +++ b/doc/DeleteImg.3 @@ -21,13 +21,11 @@ Interpreter for which the image was created. .AP "const char" *name in Name of the image. .BE - .SH DESCRIPTION .PP \fBTk_DeleteImage\fR deletes the image given by \fIinterp\fR and \fIname\fR, if there is one. All instances of that image will redisplay as empty regions. If the given image does not exist then the procedure has no effect. - .SH KEYWORDS delete image, image manager diff --git a/doc/DrawFocHlt.3 b/doc/DrawFocHlt.3 index ed29857..e2d1578 100644 --- a/doc/DrawFocHlt.3 +++ b/doc/DrawFocHlt.3 @@ -27,12 +27,10 @@ Width of the highlight ring, in pixels. Drawable in which to draw the highlight; usually an offscreen pixmap for double buffering. .BE - .SH DESCRIPTION .PP \fBTk_DrawFocusHighlight\fR is a utility procedure that draws the traversal highlight ring for a widget. It is typically invoked by widgets during redisplay. - .SH KEYWORDS focus, traversal highlight diff --git a/doc/EventHndlr.3 b/doc/EventHndlr.3 index 80003d8..97857fb 100644 --- a/doc/EventHndlr.3 +++ b/doc/EventHndlr.3 @@ -30,7 +30,6 @@ in the window given by \fItkwin\fR. .AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE - .SH DESCRIPTION .PP \fBTk_CreateEventHandler\fR arranges for \fIproc\fR to be @@ -45,9 +44,9 @@ call \fBTk_HandleEvent\fR, such as \fBTk_DoOneEvent\fR or \fIProc\fR should have arguments and result that match the type \fBTk_EventProc\fR: .CS -typedef void Tk_EventProc( - ClientData \fIclientData\fR, - XEvent *\fIeventPtr\fR); +typedef void \fBTk_EventProc\fR( + ClientData \fIclientData\fR, + XEvent *\fIeventPtr\fR); .CE The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR argument given to \fBTk_CreateEventHandler\fR when the callback @@ -72,6 +71,5 @@ automatically; in this case there is no need to call If multiple handlers are declared for the same type of X event on the same window, then the handlers will be invoked in the order they were created. - .SH KEYWORDS bind, callback, event, handler diff --git a/doc/FindPhoto.3 b/doc/FindPhoto.3 index 30df3a2..d6ccb5b 100644 --- a/doc/FindPhoto.3 +++ b/doc/FindPhoto.3 @@ -21,7 +21,6 @@ Tk_FindPhoto, Tk_PhotoPutBlock, Tk_PhotoPutZoomedBlock, Tk_PhotoGetImage, Tk_Pho Tk_PhotoHandle \fBTk_FindPhoto\fR(\fIinterp, imageName\fR) .sp -.VS 8.5 int \fBTk_PhotoPutBlock\fR(\fIinterp, handle, blockPtr, x, y, width, height,\ compRule\fR) @@ -29,7 +28,6 @@ compRule\fR) int \fBTk_PhotoPutZoomedBlock\fR(\fIinterp, handle, blockPtr, x, y, width, height,\ zoomX, zoomY, subsampleX, subsampleY, compRule\fR) -.VE 8.5 .sp int \fBTk_PhotoGetImage\fR(\fIhandle, blockPtr\fR) @@ -37,18 +35,14 @@ int void \fBTk_PhotoBlank\fR(\fIhandle\fR) .sp -.VS 8.5 int \fBTk_PhotoExpand\fR(\fIinterp, handle, width, height\fR) -.VE 8.5 .sp void \fBTk_PhotoGetSize\fR(\fIhandle, widthPtr, heightPtr\fR) .sp -.VS 8.5 int \fBTk_PhotoSetSize\fR(\fIinterp. handle, width, height\fR) -.VE 8.5 .SH ARGUMENTS .AS Tk_PhotoImageBlock window_path .AP Tcl_Interp *interp in @@ -99,7 +93,6 @@ being written to the photo image. Specifies the zoom factor to be applied in the Y direction to pixels being written to the photo image. .BE - .SH DESCRIPTION .PP \fBTk_FindPhoto\fR returns an opaque handle that is used to identify a @@ -128,8 +121,8 @@ typedef struct { int \fIheight\fR; int \fIpitch\fR; int \fIpixelSize\fR; - int \fIoffset[4]\fR; -} Tk_PhotoImageBlock; + int \fIoffset\fR[4]; +} \fBTk_PhotoImageBlock\fR; .CE The \fIpixelPtr\fR field points to the first pixel, that is, the top-left pixel in the block. @@ -161,12 +154,10 @@ given are replicated (in a tiled fashion) to fill the specified area. These rules operate independently in the horizontal and vertical directions. .PP -.VS 8.5 \fBTk_PhotoPutBlock\fR normally returns \fBTCL_OK\fR, though if it cannot allocate sufficient memory to hold the resulting image, \fBTCL_ERROR\fR is returned instead and, if the \fIinterp\fR argument is non-NULL, an error message is placed in the interpreter's result. -.VE 8.5 .PP \fBTk_PhotoPutZoomedBlock\fR works like \fBTk_PhotoPutBlock\fR except that the image can be reduced or enlarged for display. The @@ -207,12 +198,10 @@ are being supplied in many small blocks, it is more efficient to use allowing the image to expand in many small increments as image blocks are supplied. .PP -.VS 8.5 \fBTk_PhotoExpand\fR normally returns \fBTCL_OK\fR, though if it cannot allocate sufficient memory to hold the resulting image, \fBTCL_ERROR\fR is returned instead and, if the \fIinterp\fR argument is non-NULL, an error message is placed in the interpreter's result. -.VE 8.5 .PP \fBTk_PhotoSetSize\fR specifies the size of the image, as if the user had specified the given \fIwidth\fR and \fIheight\fR values to the @@ -222,16 +211,13 @@ or height, but allows the width or height to be changed by subsequent calls to \fBTk_PhotoPutBlock\fR, \fBTk_PhotoPutZoomedBlock\fR or \fBTk_PhotoExpand\fR. .PP -.VS 8.5 \fBTk_PhotoSetSize\fR normally returns \fBTCL_OK\fR, though if it cannot allocate sufficient memory to hold the resulting image, \fBTCL_ERROR\fR is returned instead and, if the \fIinterp\fR argument is non-NULL, an error message is placed in the interpreter's result. -.VE 8.5 .PP \fBTk_PhotoGetSize\fR returns the dimensions of the image in *\fIwidthPtr\fR and *\fIheightPtr\fR. - .SH PORTABILITY .PP In Tk 8.3 and earlier, \fBTk_PhotoPutBlock\fR and @@ -241,7 +227,6 @@ your code, compile it with the flag -DUSE_COMPOSITELESS_PHOTO_PUT_BLOCK. Code linked using Stubs against older versions of Tk will continue to work. .PP -.VS 8.5 In Tk 8.4, \fBTk_PhotoPutBlock\fR, \fBTk_PhotoPutZoomedBlock\fR, \fBTk_PhotoExpand\fR and \fBTk_PhotoSetSize\fR did not take an \fIinterp\fR argument or return any result code. If insufficient @@ -249,12 +234,9 @@ memory was available for an image, Tk would panic. This behaviour is still supported if you compile your extension with the additional flag -DUSE_PANIC_ON_PHOTO_ALLOC_FAILURE. Code linked using Stubs against older versions of Tk will continue to work. -.VE 8.5 - .SH CREDITS .PP The code for the photo image type was developed by Paul Mackerras, based on his earlier photo widget code. - .SH KEYWORDS photo, image diff --git a/doc/FontId.3 b/doc/FontId.3 index 4c0d8d4..c79b89f 100644 --- a/doc/FontId.3 +++ b/doc/FontId.3 @@ -65,6 +65,7 @@ following screen font families should print correctly: Any other font families may not print correctly because the computed Postscript font name may be incorrect or not exist on the printer. .SH "DATA STRUCTURES" +.PP The \fBTk_FontMetrics\fR data structure is used by \fBTk_GetFontMetrics\fR to return information about a font and is defined as follows: .CS @@ -72,7 +73,7 @@ typedef struct Tk_FontMetrics { int \fIascent\fR; int \fIdescent\fR; int \fIlinespace\fR; -} Tk_FontMetrics; +} \fBTk_FontMetrics\fR; .CE .PP The \fIascent\fR field is the amount in pixels that the tallest diff --git a/doc/GeomReq.3 b/doc/GeomReq.3 index 0296132..895f683 100644 --- a/doc/GeomReq.3 +++ b/doc/GeomReq.3 @@ -44,7 +44,6 @@ Space to leave for top side of internal border for \fItkwin\fR, in pixel units. .AP int bottom in Space to leave for bottom side of internal border for \fItkwin\fR, in pixel units. .BE - .SH DESCRIPTION .PP \fBTk_GeometryRequest\fR is called by widget code to indicate its @@ -89,6 +88,5 @@ The information specified in calls to \fBTk_GeometryRequest\fR, \fBTk_InternalBorderRight\fR, \fBTk_InternalBorderTop\fR and \fBTk_InternalBorderBottom\fR. See the \fBTk_WindowId\fR manual entry for details. - .SH KEYWORDS geometry, request diff --git a/doc/GetAnchor.3 b/doc/GetAnchor.3 index 032d838..6526772 100644 --- a/doc/GetAnchor.3 +++ b/doc/GetAnchor.3 @@ -28,17 +28,20 @@ const char * Interpreter to use for error reporting, or NULL. .AP Tcl_Obj *objPtr in/out String value contains name of anchor point: -.QW n , -.QW ne , -.QW e , -.QW se , -.QW s , -.QW sw , -.QW w , -.QW nw , +.QW \fBn\fR , +.QW \fBne\fR , +.QW \fBe\fR , +.QW \fBse\fR , +.QW \fBs\fR , +.QW \fBsw\fR , +.QW \fBw\fR , +.QW \fBnw\fR , or -.QW center ; -internal rep will be modified to cache corresponding Tk_Anchor. +.QW \fBcenter\fR ; +internal rep will be modified to cache corresponding Tk_Anchor. In the +case of +.QW \fBcenter\fR +on input, a non-empty abbreviation of it may also be used on input. .AP "const char" *string in Same as \fIobjPtr\fR except description of anchor point is passed as a string. diff --git a/doc/GetBitmap.3 b/doc/GetBitmap.3 index f1ab120..c4ac44e 100644 --- a/doc/GetBitmap.3 +++ b/doc/GetBitmap.3 @@ -49,7 +49,7 @@ Same as \fIobjPtr\fR except description of bitmap is passed as a string and resulting Pixmap is not cached. .AP "const char" *name in Name for new bitmap to be defined. -.AP "const char" *source in +.AP "const void" *source in Data for bitmap, in standard bitmap format. Must be stored in static memory whose value will never change. .AP "int" width in @@ -66,7 +66,6 @@ Display for which \fIbitmap\fR was allocated. Identifier for a bitmap allocated by \fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR. .BE - .SH DESCRIPTION .PP These procedures manage a collection of bitmaps (one-plane pixmaps) @@ -82,7 +81,7 @@ of the following forms: .TP 20 \fB@\fIfileName\fR \fIFileName\fR must be the name of a file containing a bitmap -description in the standard X11 or X10 format. +description in the standard X11 format. .TP 20 \fIname\fR \fIName\fR must be the name of a bitmap defined previously with @@ -210,7 +209,7 @@ describe the bitmap. \fBTk_DefineBitmap\fR normally returns \fBTCL_OK\fR; if an error occurs (e.g. a bitmap named \fInameId\fR has already been defined) then \fBTCL_ERROR\fR is returned and an error message is left in -\fIinterp->result\fR. +interpreter \fIinterp\fR's result. Note: \fBTk_DefineBitmap\fR expects the memory pointed to by \fIsource\fR to be static: \fBTk_DefineBitmap\fR does not make a private copy of this memory, but uses the bytes pointed to @@ -282,8 +281,8 @@ with its Pixmap token. There should be exactly one call to \fBTk_FreeBitmapFromObj\fR or \fBTk_FreeBitmap\fR for each call to \fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR. - .SH BUGS +.PP In determining whether an existing bitmap can be used to satisfy a new request, \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR consider only the immediate value of the string description. For @@ -293,6 +292,5 @@ bitmap created from the same file name: it will not check to see whether the file itself has changed, or whether the current directory has changed, thereby causing the name to refer to a different file. - .SH KEYWORDS bitmap, pixmap diff --git a/doc/GetCapStyl.3 b/doc/GetCapStyl.3 index e26ed31..28f1a1c 100644 --- a/doc/GetCapStyl.3 +++ b/doc/GetCapStyl.3 @@ -24,18 +24,18 @@ const char * .AP Tcl_Interp *interp in Interpreter to use for error reporting. .AP "const char" *string in -String containing name of cap style: one of -.QW butt , -.QW projecting , +String containing name of cap style \- one of +.QW \fBbutt\fR , +.QW \fBprojecting\fR , or -.QW round . +.QW \fBround\fR +\- or a unique abbreviation of one. .AP int *capPtr out Pointer to location in which to store X cap style corresponding to \fIstring\fR. .AP int cap in Cap style: one of \fBCapButt\fR, \fBCapProjecting\fR, or \fBCapRound\fR. .BE - .SH DESCRIPTION .PP \fBTk_GetCapStyle\fR places in \fI*capPtr\fR the X cap style @@ -51,7 +51,7 @@ Under normal circumstances the return value is \fBTCL_OK\fR and \fIinterp\fR is unused. If \fIstring\fR does not contain a valid cap style or an abbreviation of one of these names, then an error message is -stored in \fIinterp->result\fR, \fBTCL_ERROR\fR is returned, and +stored in interpreter \fIinterp\fR's result, \fBTCL_ERROR\fR is returned, and \fI*capPtr\fR is unmodified. .PP \fBTk_NameOfCapStyle\fR is the logical inverse of \fBTk_GetCapStyle\fR. @@ -60,6 +60,5 @@ statically-allocated string corresponding to \fIcap\fR. If \fIcap\fR is not a legal cap style, then .QW "unknown cap style" is returned. - .SH KEYWORDS butt, cap style, projecting, round diff --git a/doc/GetColor.3 b/doc/GetColor.3 index c1bd0dc..9d07d95 100644 --- a/doc/GetColor.3 +++ b/doc/GetColor.3 @@ -58,7 +58,6 @@ call to \fBTk_AllocColorFromObj\fR, \fBTk_GetColor\fR or Drawable in which the result graphics context will be used. Must have same screen and depth as the window for which the color was allocated. .BE - .SH DESCRIPTION .PP These procedures manage the colors being used by a Tk application. @@ -68,8 +67,8 @@ colormap space is exhausted. .PP Given a textual description of a color, \fBTk_AllocColorFromObj\fR locates a pixel value that may be used to render the color -in a particular window. The desired color is specified with an -object whose string value must have one of the following forms: +in a particular window. The desired color is specified with a +value whose string value must have one of the following forms: .TP 20 \fIcolorname\fR Any of the valid textual names for a color defined in the @@ -107,7 +106,7 @@ such as \fBTk_AllocColorFromObj\fR and \fBTk_GetColorFromObj\fR. .PP \fBTk_GetColor\fR is identical to \fBTk_AllocColorFromObj\fR except that the description of the color is specified with a string instead -of an object. This prevents \fBTk_GetColor\fR from caching the +of a value. This prevents \fBTk_GetColor\fR from caching the return value, so \fBTk_GetColor\fR is less efficient than \fBTk_AllocColorFromObj\fR. .PP @@ -174,4 +173,4 @@ There should be exactly one call to \fBTk_FreeColorFromObj\fR or \fBTk_FreeColor\fR for each call to \fBTk_AllocColorFromObj\fR, \fBTk_GetColor\fR, or \fBTk_GetColorByValue\fR. .SH KEYWORDS -color, intensity, object, pixel value +color, intensity, value, pixel value diff --git a/doc/GetCursor.3 b/doc/GetCursor.3 index 5784792..8526a47 100644 --- a/doc/GetCursor.3 +++ b/doc/GetCursor.3 @@ -67,7 +67,6 @@ Opaque Tk identifier for cursor. If passed to \fBTk_FreeCursor\fR, must have been returned by some previous call to \fBTk_GetCursor\fR or \fBTk_GetCursorFromData\fR. .BE - .SH DESCRIPTION .PP These procedures manage a collection of cursors @@ -118,7 +117,7 @@ in preference to black and white cursors. \fB@\fIsourceName\0maskName\0fgColor\0bgColor\fR In this form, \fIsourceName\fR and \fImaskName\fR are the names of files describing cursors for the cursor's source bits and mask. -Each file must be in standard X11 or X10 cursor format. +Each file must be in standard X11 cursor format. \fIFgColor\fR and \fIbgColor\fR indicate the colors to use for the cursor, in any of the forms acceptable to \fBTk_GetColor\fR. This @@ -213,8 +212,8 @@ with its Tk_Cursor token. There should be exactly one call to \fBTk_FreeCursor\fR for each call to \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, or \fBTk_GetCursorFromData\fR. - .SH BUGS +.PP In determining whether an existing cursor can be used to satisfy a new request, \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, and \fBTk_GetCursorFromData\fR @@ -228,6 +227,5 @@ a different file. Similarly, \fBTk_GetCursorFromData\fR assumes that if the same \fIsource\fR pointer is used in two different calls, then the pointers refer to the same data; it does not check to see if the actual data values have changed. - .SH KEYWORDS cursor diff --git a/doc/GetDash.3 b/doc/GetDash.3 index 8acc660..d1eeb70 100644 --- a/doc/GetDash.3 +++ b/doc/GetDash.3 @@ -13,28 +13,30 @@ Tk_GetDash \- convert from string to valid dash structure. .SH SYNOPSIS .nf \fB#include <tk.h>\fR -.sp + int \fBTk_GetDash\fR(\fIinterp, string, dashPtr\fR) +.fi .SH ARGUMENTS .AS Tk_Dash *dashPtr .AP Tcl_Interp *interp in Interpreter to use for error reporting. -.AP "const char *" string in +.AP "const char" *string in Textual value to be converted. .AP Tk_Dash *dashPtr out Points to place to store the dash pattern -value converted from \fIstring\fR. +value converted from \fIstring\fR. Must not be NULL. .BE - .SH DESCRIPTION .PP These procedure parses the string and fills in the result in the Tk_Dash structure. The string can be a list of integers or a character string containing only -.QW \fB.,\-_\fR -or spaces. If all -goes well, \fBTCL_OK\fR is returned. If \fIstring\fR does not have the +.QW \fB.,-_\fR +and spaces. If all +goes well, \fBTCL_OK\fR is returned and a dash descriptor is stored +in the variable pointed to by \fIdashPtr\fR. +If \fIstring\fR does not have the proper syntax then \fBTCL_ERROR\fR is returned, an error message is left in the interpreter's result, and nothing is stored at *\fIdashPtr\fR. .PP @@ -46,33 +48,35 @@ color. The other segments are drawn transparent. .PP The second possible syntax is a character list containing only 5 possible characters -.QW "\fB.,\-_ \fR" . +.QW "\fB.,-_ \fR" . The space can be used to enlarge the space between other line elements, and can not -occur as the first position in the string. Some examples: +occur in the first position of the string. Some examples: +.PP .CS \-dash . = \-dash {2 4} - \-dash \- = \-dash {6 4} - \-dash \-. = \-dash {6 4 2 4} - \-dash \-.. = \-dash {6 4 2 4 2 4} + \-dash - = \-dash {6 4} + \-dash -. = \-dash {6 4 2 4} + \-dash -.. = \-dash {6 4 2 4 2 4} \-dash {. } = \-dash {2 8} \-dash , = \-dash {4 4} .CE .PP -The main difference of this syntax with the previous is that it +The main difference between this syntax and the numeric is that it is shape-conserving. This means that all values in the dash list will be multiplied by the line width before display. This -assures that +ensures that .QW . will always be displayed as a dot and -.QW \- +.QW - always as a dash regardless of the line width. .PP On systems where only a limited set of dash patterns, the dash pattern will be displayed as the most close dash pattern that is available. For example, on Windows only the first 4 of the -above examples are available. The last 2 examples will be -displayed identically as the first one. - +above examples are available; the last 2 examples will be +displayed identically to the first one. +.SH "SEE ALSO" +canvas(n), Tk_CreateItemType(3) .SH KEYWORDS dash, conversion diff --git a/doc/GetFont.3 b/doc/GetFont.3 index 23dcf25..cf02f00 100644 --- a/doc/GetFont.3 +++ b/doc/GetFont.3 @@ -31,7 +31,6 @@ Tk_Font .sp void \fBTk_FreeFont(\fItkfont\fB)\fR - .SH ARGUMENTS .AS "const char" *tkfont .AP "Tcl_Interp" *interp in @@ -105,7 +104,6 @@ with the same information used to create it; for with its Tk_Font token. There should be exactly one call to \fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR for each call to \fBTk_AllocFontFromObj\fR or \fBTk_GetFont\fR. - .SH "SEE ALSO" Tk_FontId(3) .SH KEYWORDS diff --git a/doc/GetGC.3 b/doc/GetGC.3 index 621e109..44e06fb 100644 --- a/doc/GetGC.3 +++ b/doc/GetGC.3 @@ -34,7 +34,6 @@ Display for which \fIgc\fR was allocated. X identifier for graphics context that is no longer needed. Must have been allocated by \fBTk_GetGC\fR. .BE - .SH DESCRIPTION .PP \fBTk_GetGC\fR and \fBTk_FreeGC\fR manage a collection of graphics contexts @@ -67,6 +66,5 @@ each call to \fBTk_GetGC\fR. When a graphics context is no longer in use anywhere (i.e. it has been freed as many times as it has been gotten) \fBTk_FreeGC\fR will release it to the X server and delete it from the database. - .SH KEYWORDS graphics context diff --git a/doc/GetHWND.3 b/doc/GetHWND.3 index 54e7351..1a5ec2d 100644 --- a/doc/GetHWND.3 +++ b/doc/GetHWND.3 @@ -32,6 +32,5 @@ window given by \fIwindow\fR. \fBTk_AttachHWND\fR binds the Windows HWND identifier to the specified Tk_Window given by \fItkwin\fR. It returns an X Windows window that encapsulates the HWND. - .SH KEYWORDS identifier, window diff --git a/doc/GetImage.3 b/doc/GetImage.3 index 2d481f8..f2407bc 100644 --- a/doc/GetImage.3 +++ b/doc/GetImage.3 @@ -63,7 +63,6 @@ Store width of \fIimage\fR (in pixels) here. .AP "int" heightPtr out Store height of \fIimage\fR (in pixels) here. .BE - .SH DESCRIPTION .PP These procedures are invoked by widgets that wish to display images. @@ -74,7 +73,7 @@ identifies the window where the image will be displayed. \fBTk_GetImage\fR looks up the image in the table of existing images and returns a token for a new instance of the image. If the image does not exist then \fBTk_GetImage\fR returns NULL -and leaves an error message in \fIinterp->result\fR. +and leaves an error message in interpreter \fIinterp\fR's result. .PP When a widget wishes to actually display an image it must call \fBTk_RedrawImage\fR, identifying the image (\fIimage\fR), @@ -106,14 +105,14 @@ The \fIchangeProc\fR and \fIclientData\fR arguments to \fIchangeProc\fR will be called by Tk whenever a change occurs in the image; it must match the following prototype: .CS -typedef void Tk_ImageChangedProc( - ClientData \fIclientData\fR, - int \fIx\fR, - int \fIy\fR, - int \fIwidth\fR, - int \fIheight\fR, - int \fIimageWidth\fR, - int \fIimageHeight\fR); +typedef void \fBTk_ImageChangedProc\fR( + ClientData \fIclientData\fR, + int \fIx\fR, + int \fIy\fR, + int \fIwidth\fR, + int \fIheight\fR, + int \fIimageWidth\fR, + int \fIimageHeight\fR); .CE The \fIclientData\fR argument to \fIchangeProc\fR is the same as the \fIclientData\fR argument to \fBTk_GetImage\fR. @@ -125,9 +124,7 @@ they are specified in pixels measured from the upper-left corner of the image. The arguments \fIimageWidth\fR and \fIimageHeight\fR give the image's (new) size. - .SH "SEE ALSO" Tk_CreateImageType - .SH KEYWORDS images, redisplay diff --git a/doc/GetJoinStl.3 b/doc/GetJoinStl.3 index 81b5e9a..a717b72 100644 --- a/doc/GetJoinStl.3 +++ b/doc/GetJoinStl.3 @@ -24,18 +24,18 @@ const char * .AP Tcl_Interp *interp in Interpreter to use for error reporting. .AP "const char" *string in -String containing name of join style: one of -.QW bevel , -.QW miter , +String containing name of join style \- one of +.QW \fBbevel\fR , +.QW \fBmiter\fR , or -.QW round . +.QW \fBround\fR +\- or a unique abbreviation of one. .AP int *joinPtr out Pointer to location in which to store X join style corresponding to \fIstring\fR. .AP int join in Join style: one of \fBJoinBevel\fR, \fBJoinMiter\fR, \fBJoinRound\fR. .BE - .SH DESCRIPTION .PP \fBTk_GetJoinStyle\fR places in \fI*joinPtr\fR the X join style @@ -50,7 +50,7 @@ Under normal circumstances the return value is \fBTCL_OK\fR and \fIinterp\fR is unused. If \fIstring\fR does not contain a valid join style or an abbreviation of one of these names, then an error message is -stored in \fIinterp->result\fR, \fBTCL_ERROR\fR is returned, and +stored in interpreter \fIinterp\fR's result, \fBTCL_ERROR\fR is returned, and \fI*joinPtr\fR is unmodified. .PP \fBTk_NameOfJoinStyle\fR is the logical inverse of \fBTk_GetJoinStyle\fR. @@ -59,6 +59,5 @@ statically-allocated string corresponding to \fIjoin\fR. If \fIjoin\fR is not a legal join style, then .QW "unknown join style" is returned. - .SH KEYWORDS bevel, join style, miter, round diff --git a/doc/GetJustify.3 b/doc/GetJustify.3 index 7e879db..b51cb8d 100644 --- a/doc/GetJustify.3 +++ b/doc/GetJustify.3 @@ -27,11 +27,12 @@ const char * .AP Tcl_Interp *interp in Interpreter to use for error reporting, or NULL. .AP Tcl_Obj *objPtr in/out -String value contains name of justification style, one of -.QW left , -.QW right , +String value contains name of justification style \- one of +.QW \fBleft\fR , +.QW \fBright\fR , or -.QW center . +.QW \fBcenter\fR +\- or a unique abbreviation of one. The internal rep will be modified to cache corresponding justify value. .AP "const char" *string in Same as \fIobjPtr\fR except description of justification style is passed as @@ -82,6 +83,5 @@ corresponding to \fIjustify\fR. If \fIjustify\fR is not a legal justify value, then .QW "unknown justification style" is returned. - .SH KEYWORDS center, fill, justification, string diff --git a/doc/GetOption.3 b/doc/GetOption.3 index 432e18b..81846ad 100644 --- a/doc/GetOption.3 +++ b/doc/GetOption.3 @@ -26,7 +26,6 @@ Name of desired option. Class of desired option. Null means there is no class for this option; do lookup based on name only. .BE - .SH DESCRIPTION .PP This procedure is invoked to retrieve an option from the database @@ -39,6 +38,5 @@ is returned. If no option matches, then NULL is returned. \fBTk_GetOption\fR caches options related to \fItkwin\fR so that successive calls for the same \fItkwin\fR will execute much more quickly than successive calls for different windows. - .SH KEYWORDS class, name, option, retrieve diff --git a/doc/GetPixels.3 b/doc/GetPixels.3 index 2e6cc57..e7a9043 100644 --- a/doc/GetPixels.3 +++ b/doc/GetPixels.3 @@ -43,7 +43,6 @@ Pointer to location in which to store converted distance in pixels. .AP double *doublePtr out Pointer to location in which to store converted distance in millimeters. .BE - .SH DESCRIPTION .PP These procedures take as argument a specification of distance on @@ -85,13 +84,12 @@ value in \fIobjPtr\fR, which speeds up future calls to \fBTk_GetPixels\fR is identical to \fBTk_GetPixelsFromObj\fR except that the screen distance is specified with a string instead of an object. This prevents \fBTk_GetPixels\fR from caching the -return value, so \fBTk_GetAnchor\fR is less efficient than +return value, so \fBTk_GetPixels\fR is less efficient than \fBTk_GetPixelsFromObj\fR. .PP \fBTk_GetMMFromObj\fR and \fBTk_GetScreenMM\fR are similar to \fBTk_GetPixelsFromObj\fR and \fBTk_GetPixels\fR (respectively) except that they convert the screen distance to millimeters and store a double-precision floating-point result at \fI*doublePtr\fR. - .SH KEYWORDS centimeters, convert, inches, millimeters, pixels, points, screen units diff --git a/doc/GetPixmap.3 b/doc/GetPixmap.3 index 4bcab61..927c75c 100644 --- a/doc/GetPixmap.3 +++ b/doc/GetPixmap.3 @@ -33,7 +33,6 @@ Number of bits per pixel in pixmap. .AP Pixmap pixmap in Pixmap to destroy. .BE - .SH DESCRIPTION .PP These procedures are identical to the Xlib procedures \fBXCreatePixmap\fR @@ -49,6 +48,5 @@ with dimensions given by \fIwidth\fR, \fIheight\fR, and \fIdepth\fR, and returns its identifier. \fBTk_FreePixmap\fR destroys the pixmap given by \fIpixmap\fR and makes its resource identifier available for reuse. - .SH KEYWORDS pixmap, resource identifier diff --git a/doc/GetRelief.3 b/doc/GetRelief.3 index a65baf7..6e8681a 100644 --- a/doc/GetRelief.3 +++ b/doc/GetRelief.3 @@ -28,13 +28,14 @@ const char * Interpreter to use for error reporting. .AP Tcl_Obj *objPtr in/out String value contains name of relief, one of -.QW flat , -.QW groove , -.QW raised , -.QW ridge , -.QW solid , +.QW \fBflat\fR , +.QW \fBgroove\fR , +.QW \fBraised\fR , +.QW \fBridge\fR , +.QW \fBsolid\fR , or -.QW sunken ; +.QW \fBsunken\fR +(or any unique abbreviation thereof on input); the internal rep will be modified to cache corresponding relief value. .AP char *string in Same as \fIobjPtr\fR except description of relief is passed as diff --git a/doc/GetScroll.3 b/doc/GetScroll.3 index 2c98403..abd0880 100644 --- a/doc/GetScroll.3 +++ b/doc/GetScroll.3 @@ -9,46 +9,45 @@ .so man.macros .BS .SH NAME -Tk_GetScrollInfo, Tk_GetScrollInfoObj \- parse arguments for scrolling commands +Tk_GetScrollInfoObj, Tk_GetScrollInfo \- parse arguments for scrolling commands .SH SYNOPSIS .nf \fB#include <tk.h>\fR .sp int -\fBTk_GetScrollInfo(\fIinterp, argc, argv, dblPtr, intPtr\fB)\fR +\fBTk_GetScrollInfoObj(\fIinterp, objc, objv, dblPtr, intPtr\fB)\fR .sp int -\fBTk_GetScrollInfoObj(\fIinterp, objc, objv, dblPtr, intPtr\fB)\fR +\fBTk_GetScrollInfo(\fIinterp, argc, argv, dblPtr, intPtr\fB)\fR .SH ARGUMENTS -.AS "Tcl_Interp" *dblPtr +.AS "Tcl_Interp" *fractionPtr .AP Tcl_Interp *interp in Interpreter to use for error reporting. -.AP int argc in -Number of strings in \fIargv\fR array. -.AP "const char" *argv[] in -Argument strings. These represent the entire widget command, of -which the first word is typically the widget name and the second -word is typically \fBxview\fR or \fByview\fR. .AP int objc in Number of Tcl_Obj's in \fIobjv\fR array. .AP "Tcl_Obj *const" objv[] in Argument objects. These represent the entire widget command, of which the first word is typically the widget name and the second word is typically \fBxview\fR or \fByview\fR. -.AP double *dblPtr out +.AP int argc in +Number of strings in \fIargv\fR array. +.AP "const char" *argv[] in +Argument strings. These represent the entire widget command, of +which the first word is typically the widget name and the second +word is typically \fBxview\fR or \fByview\fR. +.AP double *fractionPtr out Filled in with fraction from \fBmoveto\fR option, if any. -.AP int *intPtr out +.AP int *stepsPtr out Filled in with line or page count from \fBscroll\fR option, if any. The value may be negative. .BE - .SH DESCRIPTION .PP -\fBTk_GetScrollInfo\fR parses the arguments expected by widget +\fBTk_GetScrollInfoObj\fR parses the arguments expected by widget scrolling commands such as \fBxview\fR and \fByview\fR. It receives the entire list of words that make up a widget command -and parses the words starting with \fIargv\fR[2]. -The words starting with \fIargv\fR[2] must have one of the following forms: +and parses the words starting with \fIobjv\fR[2]. +The words starting with \fIobjv\fR[2] must have one of the following forms: .CS \fBmoveto \fIfraction\fR \fBscroll \fInumber\fB units\fR @@ -57,20 +56,20 @@ The words starting with \fIargv\fR[2] must have one of the following forms: .LP Any of the \fBmoveto\fR, \fBscroll\fR, \fBunits\fR, and \fBpages\fR keywords may be abbreviated. -If \fIargv\fR has the \fBmoveto\fR form, \fBTK_SCROLL_MOVETO\fR -is returned as result and \fI*dblPtr\fR is filled in with the +If \fIobjv\fR has the \fBmoveto\fR form, \fBTK_SCROLL_MOVETO\fR +is returned as result and \fI*fractionPtr\fR is filled in with the \fIfraction\fR argument to the command, which must be a proper real value. -If \fIargv\fR has the \fBscroll\fR form, \fBTK_SCROLL_UNITS\fR -or \fBTK_SCROLL_PAGES\fR is returned and \fI*intPtr\fR is filled +If \fIobjv\fR has the \fBscroll\fR form, \fBTK_SCROLL_UNITS\fR +or \fBTK_SCROLL_PAGES\fR is returned and \fI*stepsPtr\fR is filled in with the \fInumber\fR value, which must be a proper integer. If an error occurs in parsing the arguments, \fBTK_SCROLL_ERROR\fR -is returned and an error message is left in \fIinterp->result\fR. +is returned and an error message is left in interpreter +\fIinterp\fR's result. .PP -\fBTk_GetScrollInfoObj\fR is identical in function to -\fBTk_GetScrollInfo\fR. However, \fBTk_GetScrollInfoObj\fR accepts -Tcl_Obj style arguments, making it more appropriate for use with new -development. - +\fBTk_GetScrollInfo\fR is identical in function to +\fBTk_GetScrollInfoObj\fR. However, \fBTk_GetScrollInfo\fR accepts +string arguments, making it more appropriate for use with legacy +widgets. .SH KEYWORDS parse, scrollbar, scrolling command, xview, yview diff --git a/doc/GetSelect.3 b/doc/GetSelect.3 index 47e2b60..8c30a2b 100644 --- a/doc/GetSelect.3 +++ b/doc/GetSelect.3 @@ -33,7 +33,6 @@ are retrieved. .AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE - .SH DESCRIPTION .PP \fBTk_GetSelection\fR retrieves the selection specified by the atom @@ -42,13 +41,15 @@ selection may actually be retrieved in several pieces; as each piece is retrieved, \fIproc\fR is called to process the piece. \fIProc\fR should have arguments and result that match the type \fBTk_GetSelProc\fR: +.PP .CS -typedef int Tk_GetSelProc( - ClientData \fIclientData\fR, - Tcl_Interp *\fIinterp\fR, - char *\fIportion\fR); +typedef int \fBTk_GetSelProc\fR( + ClientData \fIclientData\fR, + Tcl_Interp *\fIinterp\fR, + char *\fIportion\fR); .CE -The \fIclientData\fR and \fIinterp\fR parameters to \fIproc\fR +.PP +The \fIclientData\fR and \fIinterp\fR parameters to \fIproc\fR will be copies of the corresponding arguments to \fBTk_GetSelection\fR. \fIPortion\fR will be a pointer to a string containing part or all of the selection. For large @@ -68,10 +69,10 @@ been completely retrieved and processed by \fIproc\fR, or when a fatal error has occurred (e.g. the selection owner did not respond promptly). \fBTk_GetSelection\fR normally returns \fBTCL_OK\fR; if an error occurs, it returns \fBTCL_ERROR\fR and leaves an error message -in \fIinterp->result\fR. \fIProc\fR should also return either -\fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fIproc\fR encounters an error in dealing with the -selection, it should leave an error message in \fIinterp->result\fR -and return \fBTCL_ERROR\fR; this will abort the selection retrieval. - +in interpreter \fIinterp\fR's result. \fIProc\fR should also return either +\fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fIproc\fR encounters an error in +dealing with the selection, it should leave an error message in the +interpreter result and return \fBTCL_ERROR\fR; this will abort the +selection retrieval. .SH KEYWORDS format, get, selection retrieval diff --git a/doc/GetUid.3 b/doc/GetUid.3 index 18300cc..06b466a 100644 --- a/doc/GetUid.3 +++ b/doc/GetUid.3 @@ -21,7 +21,6 @@ Tk_Uid String for which the corresponding unique identifier is desired. .BE - .SH DESCRIPTION .PP \fBTk_GetUid\fR returns the unique identifier corresponding @@ -42,6 +41,5 @@ Tk_Uid may be compared directly (x == y) without having to call \fBstrcmp\fR. In addition, the return value from \fBTk_GetUid\fR will have the same string value as its argument (strcmp(Tk_GetUid(a), a) == 0). - .SH KEYWORDS atom, unique identifier diff --git a/doc/GetVRoot.3 b/doc/GetVRoot.3 index 18214b9..a65ef78 100644 --- a/doc/GetVRoot.3 +++ b/doc/GetVRoot.3 @@ -28,7 +28,6 @@ Points to word in which to store width of virtual root. .AP "int" heightPtr out Points to word in which to store height of virtual root. .BE - .SH DESCRIPTION .PP \fBTk_GetVRootGeometry\fR returns geometry information about the virtual @@ -43,6 +42,5 @@ If \fItkwin\fR is not associated with a virtual root (e.g. because the window manager does not use virtual roots) then *\fIxPtr\fR and *\fIyPtr\fR will be set to 0 and *\fIwidthPtr\fR and *\fIheightPtr\fR will be set to the dimensions of the screen containing \fItkwin\fR. - .SH KEYWORDS geometry, height, location, virtual root, width, window manager diff --git a/doc/GetVisual.3 b/doc/GetVisual.3 index d0d95e8..fe3d50c 100644 --- a/doc/GetVisual.3 +++ b/doc/GetVisual.3 @@ -39,7 +39,7 @@ It returns a pointer to the X Visual structure for the visual and stores the number of bits per pixel for it at \fI*depthPtr\fR. If \fIstring\fR is unrecognizable or if no suitable visual could be found, then NULL is returned and \fBTk_GetVisual\fR leaves -an error message in \fIinterp->result\fR. +an error message in interpreter \fIinterp\fR's result. If \fIcolormap\fR is non-NULL then \fBTk_GetVisual\fR also locates an appropriate colormap for use with the result visual and stores its X identifier at \fI*colormapPtr\fR. @@ -16,7 +16,6 @@ int .sp void \fBTk_Ungrab\fR(\fItkwin\fR) - .SH ARGUMENTS .AP Tcl_Interp *interp in Interpreter to use for error reporting @@ -25,7 +24,6 @@ Window on whose behalf the pointer is to be grabbed or released .AP int grabGlobal in Boolean indicating whether the grab is global or application local .BE - .SH DESCRIPTION .PP These functions are used to set or release a global or @@ -39,7 +37,6 @@ intended for windows in other applications) will be redirected to \fItkwin\fR. If the grab is application local, only mouse and keyboard events intended for a windows within the same application (but outside the tree rooted at \fItkwin\fR) will be redirected. - .PP \fBTk_Grab\fR sets a grab on a particular window. \fITkwin\fR specifies the window on whose behalf the pointer is to be grabbed. @@ -52,12 +49,10 @@ successfully, no window outside the tree rooted at \fItkwin\fR will receive pointer- or keyboard-related events until the next call to Tk_Ungrab. If a previous grab was in effect within the application, then it is replaced with a new one. - .PP -\fBTcl_Ungrab\fR releases a grab on the mouse pointer and keyboard, if +\fBTk_Ungrab\fR releases a grab on the mouse pointer and keyboard, if there is one set on the window given by \fItkwin\fR. Once a grab is released, pointer and keyboard events will start being delivered to other windows again. - .SH KEYWORDS grab, window diff --git a/doc/HWNDToWindow.3 b/doc/HWNDToWindow.3 index e58a2cd..9795099 100644 --- a/doc/HWNDToWindow.3 +++ b/doc/HWNDToWindow.3 @@ -17,12 +17,10 @@ Tk_Window .AP HWND hwnd in Windows handle for the window. .BE - .SH DESCRIPTION .PP Given a Windows HWND window identifier, this procedure returns the corresponding Tk_Window handle. If there is no Tk_Window corresponding to \fIhwnd\fR then NULL is returned. - .SH KEYWORDS Windows window id diff --git a/doc/HandleEvent.3 b/doc/HandleEvent.3 index 91a76aa..bc293b6 100644 --- a/doc/HandleEvent.3 +++ b/doc/HandleEvent.3 @@ -21,12 +21,11 @@ Tk_HandleEvent \- invoke event handlers for window system events Pointer to X event to dispatch to relevant handler(s). It is important that all unused fields of the structure be set to zero. .BE - .SH DESCRIPTION .PP \fBTk_HandleEvent\fR is a lower-level procedure that deals with window events. It is called by \fBTcl_ServiceEvent\fR (and indirectly by -\fBTcl_DoOneEvent\fR), and in a few other cases within Tk. +\fBTk_DoOneEvent\fR), and in a few other cases within Tk. It makes callbacks to any window event handlers (created by calls to \fBTk_CreateEventHandler\fR) that match \fIeventPtr\fR and then returns. In some cases @@ -43,6 +42,5 @@ as when a notifier has been popped up and an application wishes to wait for the user to click a button in the notifier before doing anything else. - .SH KEYWORDS callback, event, handler, window diff --git a/doc/IdToWindow.3 b/doc/IdToWindow.3 index 7d83a4c..f6e397d 100644 --- a/doc/IdToWindow.3 +++ b/doc/IdToWindow.3 @@ -22,13 +22,11 @@ X display containing the window. .AP Window window in X id for window. .BE - .SH DESCRIPTION .PP Given an X window identifier and the X display it corresponds to, this procedure returns the corresponding Tk_Window handle. If there is no Tk_Window corresponding to \fIwindow\fR then NULL is returned. - .SH KEYWORDS X window id diff --git a/doc/ImgChanged.3 b/doc/ImgChanged.3 index 3049e63..f4d2c04 100644 --- a/doc/ImgChanged.3 +++ b/doc/ImgChanged.3 @@ -35,7 +35,6 @@ Current width of image, in pixels. .AP "int" imageHeight in Current height of image, in pixels. .BE - .SH DESCRIPTION .PP An image manager calls \fBTk_ImageChanged\fR for an image @@ -59,9 +58,7 @@ that changed. If the size of the image should change, then \fBTk_ImageChanged\fR must be called to indicate the new size, even if no pixels need to be redisplayed. - .SH "SEE ALSO" Tk_CreateImageType - .SH KEYWORDS images, redisplay, image size changes diff --git a/doc/Inactive.3 b/doc/Inactive.3 index 7338676..5528fa5 100644 --- a/doc/Inactive.3 +++ b/doc/Inactive.3 @@ -21,7 +21,6 @@ long The display on which the user inactivity timer is to be queried or reset. .BE - .SH DESCRIPTION .PP \fBTk_GetUserInactiveTime\fR returns the number of milliseconds that @@ -31,6 +30,5 @@ support querying the user inactiviy time, \fB\-1\fR is returned. \fBTk_GetUserInactiveTime\fR resets the user inactivity timer of the given display to zero. On windowing systems that do not support multiple displays \fIdisplay\fR can be passed as \fBNULL\fR. - .SH KEYWORDS idle, inactive diff --git a/doc/InternAtom.3 b/doc/InternAtom.3 index 8e5e866..a16eee1 100644 --- a/doc/InternAtom.3 +++ b/doc/InternAtom.3 @@ -28,7 +28,6 @@ String name for which atom is desired. .AP Atom atom in Atom for which corresponding string name is desired. .BE - .SH DESCRIPTION .PP These procedures are similar to the Xlib procedures @@ -52,6 +51,5 @@ for the same information can be serviced from the cache without contacting the server. Thus \fBTk_InternAtom\fR and \fBTk_GetAtomName\fR are generally much faster than their Xlib counterparts, and they should be used in place of the Xlib procedures. - .SH KEYWORDS atom, cache, display diff --git a/doc/MainLoop.3 b/doc/MainLoop.3 index 6588713..ed4d0ea 100644 --- a/doc/MainLoop.3 +++ b/doc/MainLoop.3 @@ -16,7 +16,6 @@ Tk_MainLoop \- loop for events until all windows are deleted .sp \fBTk_MainLoop\fR() .BE - .SH DESCRIPTION .PP \fBTk_MainLoop\fR is a procedure that loops repeatedly calling @@ -25,6 +24,5 @@ left in this process (i.e. no main windows exist anymore). Most windowing applications will call \fBTk_MainLoop\fR after initialization; the main execution of the application will consist entirely of callbacks invoked via \fBTcl_DoOneEvent\fR. - .SH KEYWORDS application, event, main loop diff --git a/doc/MainWin.3 b/doc/MainWin.3 index 495e799..c3af3e7 100644 --- a/doc/MainWin.3 +++ b/doc/MainWin.3 @@ -9,8 +9,7 @@ .so man.macros .BS .SH NAME -Tk_MainWindow, Tk_GetNumMainWindows \- functions for querying main -window information +Tk_MainWindow, Tk_GetNumMainWindows \- functions for querying main window information .SH SYNOPSIS .nf \fB#include <tk.h>\fR @@ -20,13 +19,11 @@ Tk_Window .sp int \fBTk_GetNumMainWindows\fR() - .SH ARGUMENTS .AS Tcl_Interp *pathName .AP Tcl_Interp *interp in/out Interpreter associated with the application. .BE - .SH DESCRIPTION .PP A main window is a special kind of toplevel window used as the @@ -35,10 +32,9 @@ outermost window in an application. If \fIinterp\fR is associated with a Tk application then \fBTk_MainWindow\fR returns the application's main window. If there is no Tk application associated with \fIinterp\fR then \fBTk_MainWindow\fR returns NULL and -leaves an error message in \fIinterp->result\fR. +leaves an error message in interpreter \fIinterp\fR's result. .PP \fBTk_GetNumMainWindows\fR returns a count of the number of main -windows currently open in the process. - +windows currently open in the current thread. .SH KEYWORDS application, main window diff --git a/doc/MaintGeom.3 b/doc/MaintGeom.3 index b052ba1..d1c2d1c 100644 --- a/doc/MaintGeom.3 +++ b/doc/MaintGeom.3 @@ -36,7 +36,6 @@ Desired width for \fIslave\fR, in pixels. .AP int height in Desired height for \fIslave\fR, in pixels. .BE - .SH DESCRIPTION .PP \fBTk_MaintainGeometry\fR and \fBTk_UnmaintainGeometry\fR make it diff --git a/doc/ManageGeom.3 b/doc/ManageGeom.3 index 371b896..520546f 100644 --- a/doc/ManageGeom.3 +++ b/doc/ManageGeom.3 @@ -45,7 +45,7 @@ typedef struct { const char *\fIname\fR; Tk_GeomRequestProc *\fIrequestProc\fR; Tk_GeomLostSlaveProc *\fIlostSlaveProc\fR; -} Tk_GeomMgr; +} \fBTk_GeomMgr\fR; .CE The \fIname\fR field is the textual name for the geometry manager, such as \fBpack\fR or \fBplace\fR; this value will be returned @@ -57,9 +57,9 @@ slave to change its desired geometry. \fIrequestProc\fR should have arguments and results that match the type \fBTk_GeomRequestProc\fR: .CS -typedef void Tk_GeomRequestProc( - ClientData \fIclientData\fR, - Tk_Window \fItkwin\fR); +typedef void \fBTk_GeomRequestProc\fR( + ClientData \fIclientData\fR, + Tk_Window \fItkwin\fR); .CE The parameters to \fIrequestProc\fR will be identical to the corresponding parameters passed to \fBTk_ManageGeometry\fR. @@ -80,12 +80,11 @@ is the same as the window's current geometry manager. \fIlostSlaveProc\fR should have arguments and results that match the following prototype: .CS -typedef void Tk_GeomLostSlaveProc( - ClientData \fIclientData\fR, - Tk_Window \fItkwin\fR); +typedef void \fBTk_GeomLostSlaveProc\fR( + ClientData \fIclientData\fR, + Tk_Window \fItkwin\fR); .CE The parameters to \fIlostSlaveProc\fR will be identical to the corresponding parameters passed to \fBTk_ManageGeometry\fR. - .SH KEYWORDS callback, geometry, managed, request, unmanaged diff --git a/doc/MapWindow.3 b/doc/MapWindow.3 index ead9cd5..8abce64 100644 --- a/doc/MapWindow.3 +++ b/doc/MapWindow.3 @@ -23,7 +23,6 @@ Tk_Window .AP Tk_Window tkwin in Token for window. .BE - .SH DESCRIPTION .PP These procedures may be used to map and unmap windows @@ -46,6 +45,5 @@ These procedures should be used in place of the X procedures Tk's local data structure for \fItkwin\fR. Applications using Tk should not invoke \fBXMapWindow\fR and \fBXUnmapWindow\fR directly. - .SH KEYWORDS map, unmap, window diff --git a/doc/MoveToplev.3 b/doc/MoveToplev.3 index 18436a3..effed29 100644 --- a/doc/MoveToplev.3 +++ b/doc/MoveToplev.3 @@ -28,7 +28,6 @@ New y-coordinate for the top-left pixel of \fItkwin\fR's border, or the top-left pixel of the decorative border supplied for \fItkwin\fR by the window manager, if there is one. .BE - .SH DESCRIPTION .PP In general, a window should never set its own position; this should be @@ -48,6 +47,5 @@ When \fBTk_MoveToplevelWindow\fR is called it does not immediately pass on the new desired location to the window manager; it defers this action until all other outstanding work has been completed, using the \fBTk_DoWhenIdle\fR mechanism. - .SH KEYWORDS position, top-level window, window manager @@ -31,7 +31,6 @@ Interpreter to use for error reporting. .AP "const char" *pathName in Character string containing path name of window. .BE - .SH DESCRIPTION .PP Each window managed by Tk has two names, a short name that identifies @@ -49,8 +48,7 @@ as a Tk_Uid, which may be used just like a string pointer but also has the properties of a unique identifier (see the manual entry for \fBTk_GetUid\fR for details). .PP -The \fBTk_PathName\fR macro returns a -hierarchical name for \fItkwin\fR. +The \fBTk_PathName\fR macro returns a hierarchical name for \fItkwin\fR. Path names have a structure similar to file names in Unix but with dots between elements instead of slashes: the main window for an application has the path name @@ -75,7 +73,8 @@ The procedure \fBTk_NameToWindow\fR returns the token for a window given its path name (the \fIpathName\fR argument) and another window belonging to the same main window (\fItkwin\fR). It normally returns a token for the named window, but if no such window exists -\fBTk_NameToWindow\fR leaves an error message in \fIinterp->result\fR +\fBTk_NameToWindow\fR leaves an error message in interpreter +\fIinterp\fR's result and returns NULL. The \fItkwin\fR argument to \fBTk_NameToWindow\fR is needed because path names are only unique within a single application hierarchy. If, for example, a single process has opened @@ -83,6 +82,5 @@ two main windows, each will have a separate naming hierarchy and the same path name might appear in each of the hierarchies. Normally \fItkwin\fR is the main window of the desired hierarchy, but this need not be the case: any window in the desired hierarchy may be used. - .SH KEYWORDS name, path name, token, window diff --git a/doc/NameOfImg.3 b/doc/NameOfImg.3 index 049b94c..78332db 100644 --- a/doc/NameOfImg.3 +++ b/doc/NameOfImg.3 @@ -21,12 +21,10 @@ const char * Token for image, which was passed to image manager's \fIcreateProc\fR when the image was created. .BE - .SH DESCRIPTION .PP This procedure is invoked by image managers to find out the name of an image. Given the token for the image, it returns the string name for the image. - .SH KEYWORDS image manager, image name diff --git a/doc/OwnSelect.3 b/doc/OwnSelect.3 index 2977fcd..ed9bcab 100644 --- a/doc/OwnSelect.3 +++ b/doc/OwnSelect.3 @@ -26,7 +26,6 @@ Procedure to invoke when \fItkwin\fR loses selection ownership later. .AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE - .SH DESCRIPTION .PP \fBTk_OwnSelection\fR arranges for \fItkwin\fR to become the @@ -39,12 +38,12 @@ invoked so that the window can clean itself up (e.g. by unhighlighting the selection). \fIProc\fR should have arguments and result that match the type \fBTk_LostSelProc\fR: .CS -typedef void Tk_LostSelProc(ClientData \fIclientData\fR); +typedef void \fBTk_LostSelProc\fR( + ClientData \fIclientData\fR); .CE The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR argument given to \fBTk_OwnSelection\fR, and is usually a pointer to a data structure containing application-specific information about \fItkwin\fR. - .SH KEYWORDS own, selection owner diff --git a/doc/ParseArgv.3 b/doc/ParseArgv.3 index 65f184b..3a9bd49 100644 --- a/doc/ParseArgv.3 +++ b/doc/ParseArgv.3 @@ -60,8 +60,8 @@ elements of \fIargv\fR. .PP \fBTk_ParseArgv\fR normally returns the value \fBTCL_OK\fR. If an error occurs while parsing the arguments, then \fBTCL_ERROR\fR is returned and -\fBTk_ParseArgv\fR will leave an error message in \fIinterp->result\fR -in the standard Tcl fashion. In +\fBTk_ParseArgv\fR will leave an error message in the result of +interpreter \fIinterp\fR in the standard Tcl fashion. In the event of an error return, \fI*argvPtr\fR will not have been modified, but \fIargv\fR could have been partially modified. The possible causes of errors are explained below. @@ -70,12 +70,12 @@ The \fIargTable\fR array specifies the kinds of arguments that are expected; each of its entries has the following structure: .CS typedef struct { - char *\fIkey\fR; + const char *\fIkey\fR; int \fItype\fR; char *\fIsrc\fR; char *\fIdst\fR; - char *\fIhelp\fR; -} Tk_ArgvInfo; + const char *\fIhelp\fR; +} \fBTk_ArgvInfo\fR; .CE The \fIkey\fR field is a string such as .QW \-display @@ -186,7 +186,8 @@ specifiers of this type are ignored (as if they did not exist). \fBTK_ARGV_HELP\fR When this kind of option is encountered, \fBTk_ParseArgv\fR uses the \fIhelp\fR fields of \fIargTable\fR to format a message describing -all the valid arguments. The message is placed in \fIinterp->result\fR +all the valid arguments. The message is placed in interpreter +\fIinterp\fR's result and \fBTk_ParseArgv\fR returns \fBTCL_ERROR\fR. When this happens, the caller normally prints the help message and aborts. If the \fIkey\fR field of a \fBTK_ARGV_HELP\fR specifier is NULL, then the specifier will @@ -259,11 +260,12 @@ then return any that are left by compacting them to the beginning of \fIargv\fR (starting at \fIargv\fR[0]). \fIGenfunc\fR should return a count of how many arguments are left in \fIargv\fR; \fBTk_ParseArgv\fR will process them. If \fIgenfunc\fR encounters -an error then it should leave an error message in \fIinterp->result\fR, +an error then it should leave an error message in interpreter +\fIinterp\fR's result, in the usual Tcl fashion, and return \-1; when this happens \fBTk_ParseArgv\fR will abort its processing and return \fBTCL_ERROR\fR. .RE -.SH "FLAGS" +.SS "FLAGS" .TP \fBTK_ARGV_DONT_SKIP_FIRST_ARG\fR \fBTk_ParseArgv\fR normally treats \fIargv[0]\fR as a program @@ -329,7 +331,7 @@ main(argc, argv) \&... if (Tk_ParseArgv(interp, tkwin, &argc, argv, argTable, 0) != TCL_OK) { - fprintf(stderr, "%s\en", interp->result); + fprintf(stderr, "%s\en", Tcl_GetString(Tcl_GetObjResult(interp))); exit(1); } diff --git a/doc/QWinEvent.3 b/doc/QWinEvent.3 index e801fbc..caa5026 100644 --- a/doc/QWinEvent.3 +++ b/doc/QWinEvent.3 @@ -30,7 +30,6 @@ that all unused fields of the structure be set to zero. Where to add the new event in the queue: \fBTCL_QUEUE_TAIL\fR, \fBTCL_QUEUE_HEAD\fR, or \fBTCL_QUEUE_MARK\fR. .BE - .SH DESCRIPTION .PP \fBTk_QueueWindowEvent\fR places a window event on Tcl's internal event @@ -47,6 +46,5 @@ returns the previous value for collapse behavior on the \fIdisplay\fR. The \fIposition\fR argument to \fBTk_QueueWindowEvent\fR has the same significance as for \fBTcl_QueueEvent\fR; see the documentation for \fBTcl_QueueEvent\fR for details. - .SH KEYWORDS callback, clock, handler, modal timeout, events diff --git a/doc/Restack.3 b/doc/Restack.3 index f026aeb..2b9097f 100644 --- a/doc/Restack.3 +++ b/doc/Restack.3 @@ -28,7 +28,6 @@ must be \fBAbove\fR or \fBBelow\fR. Must be a sibling of \fItkwin\fR or a descendant of a sibling. If NULL then \fItkwin\fR is restacked above or below all siblings. .BE - .SH DESCRIPTION .PP \fBTk_RestackWindow\fR changes the stacking order of \fIwindow\fR relative @@ -42,6 +41,5 @@ just above or below \fIother\fR. The \fIaboveBelow\fR argument must have one of the symbolic values \fBAbove\fR or \fBBelow\fR. Both of these values are defined by the include file <X11/Xlib.h>. - .SH KEYWORDS above, below, obscure, stacking order diff --git a/doc/RestrictEv.3 b/doc/RestrictEv.3 index 0d17806..eb1f040 100644 --- a/doc/RestrictEv.3 +++ b/doc/RestrictEv.3 @@ -15,18 +15,17 @@ Tk_RestrictEvents \- filter and selectively delay X events \fB#include <tk.h>\fR .sp Tk_RestrictProc * -\fBTk_RestrictEvents\fR(\fIproc, clientData, prevClientDataPtr\fR) +\fBTk_RestrictEvents\fR(\fIproc, arg, prevArgPtr\fR) .SH ARGUMENTS -.AS Tk_RestrictProc **prevClientDataPtr +.AS Tk_RestrictProc **prevArgPtr .AP Tk_RestrictProc *proc in Predicate procedure to call to filter incoming X events. NULL means do not restrict events at all. -.AP ClientData clientData in +.AP ClientData arg in Arbitrary argument to pass to \fIproc\fR. -.AP ClientData *prevClientDataPtr out +.AP ClientData *prevArgPtr out Pointer to place to save argument to previous restrict procedure. .BE - .SH DESCRIPTION .PP This procedure is useful in certain situations where applications @@ -40,11 +39,11 @@ later time (e.g. when the event restriction is lifted), or discarded. is a procedure with arguments and result that match the type \fBTk_RestrictProc\fR: .CS -typedef Tk_RestrictAction Tk_RestrictProc( - ClientData \fIclientData\fR, - XEvent *\fIeventPtr\fR); +typedef Tk_RestrictAction \fBTk_RestrictProc\fR( + ClientData \fIarg\fR, + XEvent *\fIeventPtr\fR); .CE -The \fIclientData\fR argument is a copy of the \fIclientData\fR passed +The \fIarg\fR argument is a copy of the \fIarg\fR passed to \fBTk_RestrictEvents\fR; it may be used to provide \fIproc\fR with information it needs to filter events. The \fIeventPtr\fR points to an event under consideration. \fIProc\fR returns a restrict action @@ -56,7 +55,7 @@ left on the event queue for later processing. If the return value is \fBTK_DISCARD_EVENT\fR, then the event will be removed from the event queue and discarded without being processed. .PP -\fBTk_RestrictEvents\fR uses its return value and \fIprevClientDataPtr\fR +\fBTk_RestrictEvents\fR uses its return value and \fIprevArgPtr\fR to return information about the current event restriction procedure (a NULL return value means there are currently no restrictions). These values may be used to restore the previous restriction state diff --git a/doc/SetAppName.3 b/doc/SetAppName.3 index f69f920..3978850 100644 --- a/doc/SetAppName.3 +++ b/doc/SetAppName.3 @@ -24,7 +24,6 @@ application. .AP "const char" *name in Name under which to register the application. .BE - .SH DESCRIPTION .PP \fBTk_SetAppName\fR associates a name with a given application and @@ -59,6 +58,5 @@ so applications do not normally need to call it explicitly. .PP The command \fBtk appname\fR provides Tcl-level access to the functionality of \fBTk_SetAppName\fR. - .SH KEYWORDS application, name, register, send command diff --git a/doc/SetCaret.3 b/doc/SetCaret.3 index 571cf55..fd63f18 100644 --- a/doc/SetCaret.3 +++ b/doc/SetCaret.3 @@ -25,7 +25,6 @@ Window-relative y coordinate. .AP int h in Height of the caret in the window. .BE - .SH DESCRIPTION .PP \fBTk_SetCaretPos\fR sets the caret location for the display of the @@ -33,6 +32,5 @@ specified Tk_Window \fItkwin\fR. The caret is the per-display cursor location used for indicating global focus (e.g. to comply with Microsoft Accessibility guidelines), as well as for location of the over-the-spot XIM (X Input Methods) or Windows IME windows. - .SH KEYWORDS caret, cursor diff --git a/doc/SetClass.3 b/doc/SetClass.3 index b485b7d..707975d 100644 --- a/doc/SetClass.3 +++ b/doc/SetClass.3 @@ -25,7 +25,6 @@ Token for window. .AP char *class in New class name for window. .BE - .SH DESCRIPTION .PP \fBTk_SetClass\fR is called to associate a class with a particular @@ -54,6 +53,5 @@ the properties of a unique identifier (see the manual entry for \fBTk_GetUid\fR for details). If \fItkwin\fR has not yet been given a class, then \fBTk_Class\fR will return NULL. - .SH KEYWORDS class, unique identifier, window, window manager diff --git a/doc/SetClassProcs.3 b/doc/SetClassProcs.3 index 8e6004a..58618da 100644 --- a/doc/SetClassProcs.3 +++ b/doc/SetClassProcs.3 @@ -18,14 +18,13 @@ Tk_SetClassProcs \- register widget specific procedures .AS Tk_ClassProc instanceData .AP Tk_Window tkwin in Token for window to modify. -.AP Tk_ClassProcs *procs in +.AP "const Tk_ClassProcs" *procs in Pointer to data structure containing widget specific procedures. The data structure pointed to by \fIprocs\fR must be static: Tk keeps a reference to it as long as the window exists. .AP ClientData instanceData in Arbitrary one-word value to pass to widget callbacks. .BE - .SH DESCRIPTION .PP \fBTk_SetClassProcs\fR is called to register a set of procedures that @@ -38,7 +37,7 @@ typedef struct Tk_ClassProcs { Tk_ClassWorldChangedProc *\fIworldChangedProc\fR; Tk_ClassCreateProc *\fIcreateProc\fR; Tk_ClassModalProc *\fImodalProc\fR; -} Tk_ClassProcs; +} \fBTk_ClassProcs\fR; .CE The \fIsize\fR field is used to simplify future expansion of the structure. It should always be set to (literally) \fBsizeof(Tk_ClassProcs)\fR. @@ -50,8 +49,8 @@ widgets configured to use that font alias must update their display accordingly. \fIworldChangedProc\fR should have arguments and results that match the type \fBTk_ClassWorldChangedProc\fR: .CS -typedef void Tk_ClassWorldChangedProc( - ClientData \fIinstanceData\fR); +typedef void \fBTk_ClassWorldChangedProc\fR( + ClientData \fIinstanceData\fR); .CE The \fIinstanceData\fR parameter passed to the \fIworldChangedProc\fR will be identical to the \fIinstanceData\fR parameter passed to @@ -61,10 +60,10 @@ will be identical to the \fIinstanceData\fR parameter passed to invoked by \fBTk_MakeWindowExist\fR. \fIcreateProc\fR should have arguments and results that match the type \fBTk_ClassCreateProc\fR: .CS -typedef Window Tk_ClassCreateProc( - Tk_Window \fItkwin\fR, - Window \fIparent\fR, - ClientData \fIinstanceData\fR); +typedef Window \fBTk_ClassCreateProc\fR( + Tk_Window \fItkwin\fR, + Window \fIparent\fR, + ClientData \fIinstanceData\fR); .CE The \fItkwin\fR and \fIinstanceData\fR parameters will be identical to the \fItkwin\fR and \fIinstanceData\fR parameters passed to @@ -76,14 +75,13 @@ created window. triggered in order to handle a modal loop. \fImodalProc\fR should have arguments and results that match the type \fBTk_ClassModalProc\fR: .CS -typedef void Tk_ClassModalProc( - Tk_Window \fItkwin\fR, - XEvent *\fIeventPtr\fR); +typedef void \fBTk_ClassModalProc\fR( + Tk_Window \fItkwin\fR, + XEvent *\fIeventPtr\fR); .CE The \fItkwin\fR parameter to \fImodalProc\fR will be identical to the \fItkwin\fR parameter passed to \fBTk_SetClassProcs\fR. The \fIeventPtr\fR parameter will be a pointer to an XEvent structure describing the event being processed. - .SH KEYWORDS callback, class diff --git a/doc/SetGrid.3 b/doc/SetGrid.3 index 385c920..28e428b 100644 --- a/doc/SetGrid.3 +++ b/doc/SetGrid.3 @@ -32,7 +32,6 @@ Width of one grid unit, in pixels. .AP int heightInc in Height of one grid unit, in pixels. .BE - .SH DESCRIPTION .PP \fBTk_SetGrid\fR turns on gridded geometry management for \fItkwin\fR's @@ -60,6 +59,5 @@ toplevel, the calls for the new window have no effect. .PP See the \fBwm\fR manual entry for additional information on gridded geometry management. - .SH KEYWORDS grid, window, window manager diff --git a/doc/SetOptions.3 b/doc/SetOptions.3 index 028467a..ebd6f6a 100644 --- a/doc/SetOptions.3 +++ b/doc/SetOptions.3 @@ -259,7 +259,7 @@ typedef struct { int \fIobjOffset\fR; int \fIinternalOffset\fR; int \fIflags\fR; - ClientData \fIclientData\fR; + const void *\fIclientData\fR; int \fItypeMask\fR; } \fBTk_OptionSpec\fR; .CE diff --git a/doc/SetVisual.3 b/doc/SetVisual.3 index 11d6e76..6d3fd83 100644 --- a/doc/SetVisual.3 +++ b/doc/SetVisual.3 @@ -28,7 +28,6 @@ Number of bits per pixel desired for \fItkwin\fR. New colormap for \fItkwin\fR, which must be compatible with \fIvisual\fR and \fIdepth\fR. .BE - .SH DESCRIPTION .PP When Tk creates a new window it assigns it the default visual @@ -47,6 +46,5 @@ completed successfully. Note: \fBTk_SetWindowVisual\fR should not be called if you just want to change a window's colormap without changing its visual or depth; call \fBTk_SetWindowColormap\fR instead. - .SH KEYWORDS colormap, depth, visual diff --git a/doc/StrictMotif.3 b/doc/StrictMotif.3 index 6d1e049..4319d53 100644 --- a/doc/StrictMotif.3 +++ b/doc/StrictMotif.3 @@ -20,7 +20,6 @@ int .AP Tk_Window tkwin in Token for window. .BE - .SH DESCRIPTION .PP This procedure returns the current value of the \fBtk_strictMotif\fR @@ -35,6 +34,5 @@ is good enough, and extra features are welcome. This procedure uses a link to the Tcl variable to provide much faster access to the variable's value than could be had by calling \fBTcl_GetVar\fR. - .SH KEYWORDS Motif compliance, tk_strictMotif variable diff --git a/doc/TextLayout.3 b/doc/TextLayout.3 index cd4a938..3863ee7 100644 --- a/doc/TextLayout.3 +++ b/doc/TextLayout.3 @@ -39,7 +39,6 @@ int .sp void \fBTk_TextLayoutToPostscript(\fIinterp, layout\fB)\fR - .SH ARGUMENTS .AS Tk_TextLayout "*xPtr, *yPtr" .AP Tk_Font tkfont in @@ -124,9 +123,8 @@ Specifies the width and height, in pixels, of the rectangular area to compare for intersection against the text layout. .AP Tcl_Interp *interp out Postscript code that will print the text layout is appended to -\fIinterp->result\fR. +the result of interpreter \fIinterp\fR. .BE - .SH DESCRIPTION .PP These routines are for measuring and displaying single-font, multi-line, @@ -184,9 +182,11 @@ whose \fIx\fR-value is less than 0 will be considered closest to the first character on that line; any point whose \fIx\fR-value is greater than the width of the text layout will be considered closest to the last character on that line. The return value is the index of the character that was closest -to the point. Given a \fIlayout\fR with no characters, the value 0 will -always be returned, referring to a hypothetical zero-width placeholder -character. +to the point, or one more than the index of any character (to indicate that +the point was after the end of the string and that the corresponding caret +would be at the end of the string). Given a \fIlayout\fR with no characters, +the value 0 will always be returned, referring to a hypothetical zero-width +placeholder character. .PP \fBTk_CharBbox\fR uses the information in \fIlayout\fR to return the bounding box for the character specified by \fIindex\fR. The width of the @@ -231,8 +231,9 @@ array of strings that represent the individual lines in \fIlayout\fR. It is the responsibility of the caller to take the Postscript array of strings and add some Postscript function operate on the array to render each of the lines. The code that represents the Postscript array of -strings is appended to \fIinterp->result\fR. +strings is appended to interpreter \fIinterp\fR's result. .SH "DISPLAY MODEL" +.PP When measuring a text layout, space characters that occur at the end of a line are ignored. The space characters still exist and the insertion point can be positioned amongst them, but their additional width is ignored when diff --git a/doc/TkInitStubs.3 b/doc/TkInitStubs.3 index 69c0fb2..04f5611 100644 --- a/doc/TkInitStubs.3 +++ b/doc/TkInitStubs.3 @@ -34,7 +34,7 @@ as \fIversion\fR. The Tcl stubs mechanism defines a way to dynamically bind extensions to a particular Tcl implementation at run time. the stubs mechanism requires no changes to applications -incoporating Tcl/Tk interpreters. Only developers creating +incorporating Tcl/Tk interpreters. Only developers creating C-based Tcl/Tk extensions need to take steps to use the stubs mechanism with their extensions. See the \fBTcl_InitStubs\fR page for more information. @@ -48,15 +48,19 @@ Tcl functions. Call \fBTk_InitStubs\fR if the extension before calling any other Tk functions. .IP 2) 5 -Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the -\fB\-DUSE_TCL_STUBS\fR flag when compiling the extension. +Define the \fBUSE_TCL_STUBS\fR and the \fBUSE_TK_STUBS\fR +symbols. Typically, you would include the \fB\-DUSE_TCL_STUBS\fR and +the \fB\-DUSE_TK_STUBS\fR flags when compiling the extension. .IP 3) 5 -Link the extension with the Tcl and Tk stubs libraries instead of -the standard Tcl and Tk libraries. On Unix platforms, the library -names are \fIlibtclstub8.4.a\fR and \fIlibtkstub8.4.a\fR; on Windows -platforms, the library names are \fItclstub84.lib\fR and \fItkstub84.lib\fR -(adjust names with appropriate version number). +Link the extension with the Tcl and Tk stubs libraries instead of the +standard Tcl and Tk libraries. On Unix platforms, the library names +are \fIlibtclstub8.4.a\fR and \fIlibtkstub8.4.a\fR; on Windows +platforms, the library names are \fItclstub84.lib\fR and +\fItkstub84.lib\fR. Adjust the library names with appropriate version +number but note that the extension may only be used with versions of +Tcl/Tk that have that version number or higher. .SH DESCRIPTION +.PP \fBTk_InitStubs\fR attempts to initialize the Tk stub table pointers and ensure that the correct version of Tk is loaded. In addition to an interpreter handle, it accepts as arguments a version number diff --git a/doc/Tk_Init.3 b/doc/Tk_Init.3 index 8682c7d..7bc46dd 100644 --- a/doc/Tk_Init.3 +++ b/doc/Tk_Init.3 @@ -23,7 +23,6 @@ int Interpreter in which to load Tk. Tk should not already be loaded in this interpreter. .BE - .SH DESCRIPTION .PP \fBTk_Init\fR is the package initialization procedure for Tk. @@ -34,7 +33,7 @@ and creates a new Tk application, including its main window. If the initialization is successful \fBTk_Init\fR returns \fBTCL_OK\fR; if there is an error it returns \fBTCL_ERROR\fR. \fBTk_Init\fR also leaves a result or error message -in \fIinterp->result\fR. +in interpreter \fIinterp\fR's result. .PP If there is a variable \fBargv\fR in \fIinterp\fR, \fBTk_Init\fR treats the contents of this variable as a list of options for the @@ -82,6 +81,5 @@ from the user. \fBwm\fR If toplevels are ever allowed, wm can be used to remove decorations, move windows around, etc. - .SH KEYWORDS safe, application, initialization, load, main window diff --git a/doc/Tk_Main.3 b/doc/Tk_Main.3 index e45d597..a1bb149 100644 --- a/doc/Tk_Main.3 +++ b/doc/Tk_Main.3 @@ -20,12 +20,12 @@ Tk_Main \- main program for Tk-based applications .AP int argc in Number of elements in \fIargv\fR. .AP char *argv[] in -Array of strings containing command-line arguments. +Array of strings containing command-line arguments. On Windows, when +using -DUNICODE, the parameter type changes to wchar_t *. .AP Tcl_AppInitProc *appInitProc in Address of an application-specific initialization procedure. The value for this argument is usually \fBTcl_AppInit\fR. .BE - .SH DESCRIPTION .PP \fBTk_Main\fR acts as the main program for most Tk-based applications. @@ -50,11 +50,21 @@ for the application to perform its own initialization, such as defining application-specific commands. The procedure must have an interface that matches the type \fBTcl_AppInitProc\fR: .CS -typedef int Tcl_AppInitProc(Tcl_Interp *\fIinterp\fR); +typedef int \fBTcl_AppInitProc\fR( + Tcl_Interp *\fIinterp\fR); .CE \fIAppInitProc\fR is almost always a pointer to \fBTcl_AppInit\fR; for more details on this procedure, see the documentation for \fBTcl_AppInit\fR. - +.PP +\fBTk_Main\fR functions much the same as \fBTcl_Main\fR. In particular, +\fBTk_Main\fR supports both an interactive mode and a startup script +mode, with the file name and encoding of a startup script under the +control of the \fBTcl_SetStartupScript\fR and \fBTcl_GetStartupScript\fR +routines. However it calls \fBTk_MainLoop\fR after processing any +supplied script, and in interactive uses events registered with +\fBTcl_CreateFileHandler\fR to process user input. +.SH "SEE ALSO" +Tcl_DoOneEvent(3) .SH KEYWORDS application-specific initialization, command-line arguments, main program diff --git a/doc/WindowId.3 b/doc/WindowId.3 index a6050a2..6d55dc0 100644 --- a/doc/WindowId.3 +++ b/doc/WindowId.3 @@ -102,7 +102,6 @@ Tcl_Interp * .AP Tk_Window tkwin in Token for window. .BE - .SH DESCRIPTION .PP \fBTk_WindowId\fR and the other names listed above are @@ -183,7 +182,6 @@ and \fBTk_Colormap\fR returns the current colormap for the window. The visual characteristics are normally set from the defaults for the window's screen, but they may be overridden by calling \fBTk_SetWindowVisual\fR. - .SH KEYWORDS attributes, colormap, depth, display, height, geometry manager, identifier, mapped, requested size, screen, top-level, @@ -15,7 +15,6 @@ bell \- Ring a display's bell .SH SYNOPSIS \fBbell \fR?\fB\-displayof \fIwindow\fR? ?\fB\-nice\fR? .BE - .SH DESCRIPTION .PP This command rings the bell on the display for \fIwindow\fR and @@ -28,6 +27,8 @@ may be modified with programs such as \fBxset\fR. If \fB\-nice\fR is not specified, this command also resets the screen saver for the screen. Some screen savers will ignore this, but others will reset so that the screen becomes visible again. - .SH KEYWORDS beep, bell, ring +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -151,7 +151,6 @@ requirement. The \fBCommand\fR and \fBOption\fR modifiers are equivalents of \fBMod1\fR resp. \fBMod2\fR, they correspond to Macintosh-specific modifier keys. .PP -.VS 8.5 The \fBExtended\fR modifier is, at present, specific to Windows. It appears on events that are associated with the keys on the .QW "extended keyboard" . @@ -160,7 +159,6 @@ and \fBControl\fR keys at the right of the keyboard, the cursor keys in the cluster to the left of the numeric pad, the \fBNumLock\fR key, the \fBBreak\fR key, the \fBPrintScreen\fR key, and the \fB/\fR and \fBEnter\fR keys in the numeric keypad. -.VE 8.5 .SS "EVENT TYPES" .PP The \fItype\fR field may be any of the standard X event types, with a @@ -207,9 +205,7 @@ always routed to the window that currently has focus. When the event is received you can use the \fB%D\fR substitution to get the \fIdelta\fR field for the event, which is a integer value describing how the mouse wheel has moved. The smallest value for which the -system will report is defined by the OS. On Windows 95 & 98 machines -this value is at least 120 before it is reported. However, higher -resolution devices may be available in the future. The sign of the +system will report is defined by the OS. The sign of the value determines which direction your widget should scroll. Positive values should scroll up and negative values should scroll down. .IP "\fBKeyPress\fR, \fBKeyRelease\fR" 5 @@ -429,10 +425,7 @@ The \fIcount\fR field from the event. Valid only for \fBExpose\fR events. Indicates that there are \fIcount\fR pending \fBExpose\fR events which have not yet been delivered to the window. .IP \fB%d\fR 5 -The \fIdetail\fR -.VS 8.5 -or \fIuser_data\fR -.VE 8.5 +The \fIdetail\fR or \fIuser_data\fR field from the event. The \fB%d\fR is replaced by a string identifying the detail. For \fBEnter\fR, \fBLeave\fR, \fBFocusIn\fR, and \fBFocusOut\fR events, @@ -452,13 +445,11 @@ For \fBConfigureRequest\fR events, the string will be one of: \fBBelow\fR \fBNone\fR \fBBottomIf\fR \fBTopIf\fR .DE -.VS 8.5 For virtual events, the string will be whatever value is stored in the \fIuser_data\fR field when the event was created (typically with \fBevent generate\fR), or the empty string if the field is NULL. Virtual events corresponding to key sequence presses (see \fBevent add\fR for details) set the \fIuser_data\fR to NULL. -.VE 8.5 For events other than these, the substituted string is undefined. .RE .IP \fB%f\fR 5 @@ -534,9 +525,7 @@ The \fIborder_width\fR field from the event. Valid only for .IP \fB%D\fR 5 This reports the \fIdelta\fR value of a \fBMouseWheel\fR event. The \fIdelta\fR value represents the rotation units the mouse wheel has -been moved. On Windows 95 & 98 systems the smallest value for the -delta is 120. Future systems may support higher resolution values for -the delta. The sign of the value represents the direction the mouse +been moved. The sign of the value represents the direction the mouse wheel was scrolled. .IP \fB%E\fR 5 The \fIsend_event\fR field from the event. Valid for all event types. @@ -704,6 +693,7 @@ If an error occurs in executing the script for a binding then the The \fBbgerror\fR command will be executed at global level (outside the context of any Tcl procedure). .SH "EXAMPLES" +.PP Arrange for a string describing the motion of the mouse to be printed out when the mouse is double-clicked: .CS @@ -725,3 +715,6 @@ pack [label .l \-textvariable keysym \-padx 2m \-pady 1m] bgerror(n), bindtags(n), event(n), focus(n), grab(n), keysyms(n) .SH KEYWORDS binding, event +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/bindtags.n b/doc/bindtags.n index 7db16f8..dc3973b 100644 --- a/doc/bindtags.n +++ b/doc/bindtags.n @@ -14,7 +14,6 @@ bindtags \- Determine which bindings apply to a window, and order of evaluation .SH SYNOPSIS \fBbindtags \fIwindow \fR?\fItagList\fR? .BE - .SH DESCRIPTION .PP When a binding is created with the \fBbind\fR command, it is @@ -73,6 +72,7 @@ associated with the \fBButton\fR tag, will no longer apply to \fB.b\fR, but any bindings associated with \fBTrickyButton\fR (perhaps some new button behavior) will apply. .SH EXAMPLE +.PP If you have a set of nested \fBframe\fR widgets and you want events sent to a \fBbutton\fR widget to also be delivered to all the widgets up to the current \fBtoplevel\fR (in contrast to Tk's default @@ -93,9 +93,10 @@ proc setupBindtagsForTreeDelivery {widget} { \fBbindtags\fR $widget $tags } .CE - .SH "SEE ALSO" bind(n) - .SH KEYWORDS binding, event, tag +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/bitmap.n b/doc/bitmap.n index bcc44f8..ead3311 100644 --- a/doc/bitmap.n +++ b/doc/bitmap.n @@ -12,9 +12,13 @@ .SH NAME bitmap \- Images that display two colors .SH SYNOPSIS +.nf \fBimage create bitmap \fR?\fIname\fR? ?\fIoptions\fR? -.BE +\fIimageName \fBcget\fR \fIoption\fR +\fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +.fi +.BE .SH DESCRIPTION .PP A bitmap is an image whose pixels can display either of two colors @@ -30,7 +34,6 @@ producing a transparent effect. For other pixels, the image displays the foreground color if the source data is one and the background color if the source data is zero. - .SH "CREATING BITMAPS" .PP Like all images, bitmaps are created using the \fBimage create\fR @@ -38,6 +41,7 @@ command. Bitmaps support the following \fIoptions\fR: .TP \fB\-background \fIcolor\fR +. Specifies a background color for the image in any of the standard ways accepted by Tk. If this option is set to an empty string then the background pixels will be transparent. This effect @@ -45,6 +49,7 @@ is achieved by using the source bitmap as the mask bitmap, ignoring any \fB\-maskdata\fR or \fB\-maskfile\fR options. .TP \fB\-data \fIstring\fR +. Specifies the contents of the source bitmap as a string. The string must adhere to X11 bitmap format (e.g., as generated by the \fBbitmap\fR program). @@ -52,16 +57,19 @@ If both the \fB\-data\fR and \fB\-file\fR options are specified, the \fB\-data\fR option takes precedence. .TP \fB\-file \fIname\fR +. \fIname\fR gives the name of a file whose contents define the source bitmap. The file must adhere to X11 bitmap format (e.g., as generated by the \fBbitmap\fR program). .TP \fB\-foreground \fIcolor\fR +. Specifies a foreground color for the image in any of the standard ways accepted by Tk. .TP \fB\-maskdata \fIstring\fR +. Specifies the contents of the mask as a string. The string must adhere to X11 bitmap format (e.g., as generated by the \fBbitmap\fR program). @@ -69,11 +77,11 @@ If both the \fB\-maskdata\fR and \fB\-maskfile\fR options are specified, the \fB\-maskdata\fR option takes precedence. .TP \fB\-maskfile \fIname\fR +. \fIname\fR gives the name of a file whose contents define the mask. The file must adhere to X11 bitmap format (e.g., as generated by the \fBbitmap\fR program). - .SH "IMAGE COMMAND" .PP When a bitmap image is created, Tk also creates a new command @@ -89,12 +97,14 @@ determine the exact behavior of the command. The following commands are possible for bitmap images: .TP \fIimageName \fBcget\fR \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the -\fBimage create bitmap\fR command. +\fBimage create\fR \fBbitmap\fR command. .TP \fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options for the image. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIimageName\fR (see \fBTk_ConfigureInfo\fR for @@ -106,7 +116,9 @@ one or more \fIoption\-value\fR pairs are specified, then the command modifies the given option(s) to have the given value(s); in this case the command returns an empty string. \fIOption\fR may have any of the values accepted by the -\fBimage create bitmap\fR command. - +\fBimage create\fR \fBbitmap\fR command. .SH KEYWORDS bitmap, image +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/busy.n b/doc/busy.n new file mode 100644 index 0000000..e588275 --- /dev/null +++ b/doc/busy.n @@ -0,0 +1,267 @@ +'\" +'\" Copyright (c) 1993-1998 Lucent Technologies, Inc. +'\" Copyright (c) 2008 Jos Decoster +'\" +'\" Permission to use, copy, modify, and distribute this software and its +'\" documentation for any purpose and without fee is hereby granted, provided +'\" that the above copyright notice appear in all copies and that both that +'\" the copyright notice and warranty disclaimer appear in supporting +'\" documentation, and that the names of Lucent Technologies any of their +'\" entities not be used in advertising or publicity pertaining to +'\" distribution of the software without specific, written prior permission. +'\" +'\" Lucent Technologies disclaims all warranties with regard to this software, +'\" including all implied warranties of merchantability and fitness. In no +'\" event shall Lucent Technologies be liable for any special, indirect or +'\" consequential damages or any damages whatsoever resulting from loss of +'\" use, data or profits, whether in an action of contract, negligence or +'\" other tortuous action, arising out of or in connection with the use or +'\" performance of this software. +'\" +'\" BLT::busy command created by George Howlett. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH busy n "" Tk "Tk Built-In Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +busy \- confine pointer and keyboard events to a window sub-tree +.SH SYNOPSIS +\fBtk busy\fR \fIwindow \fR?\fIoptions\fR? +.sp +\fBtk busy hold\fR \fIwindow \fR?\fIoptions\fR? +.sp +\fBtk busy configure \fIwindow\fR ?\fIoption value\fR?... +.sp +\fBtk busy forget\fR \fIwindow \fR?\fIwindow \fR?... +.sp +\fBtk busy current\fR ?\fIpattern\fR? +.sp +\fBtk busy status \fIwindow\fR +.BE +.SH DESCRIPTION +.PP +The \fBtk busy\fR command provides a simple means to block keyboard, button, +and pointer events from Tk widgets, while overriding the widget's cursor with +a configurable busy cursor. +.SH INTRODUCTION +.PP +There are many times in applications where you want to temporarily restrict +what actions the user can take. For example, an application could have a +.QW Run +button that when pressed causes some processing to occur. However, while the +application is busy processing, you probably don't want the user to be +able to click the +.QW Run +button again. You may also want restrict the user from other tasks such as +clicking a +.QW Print +button. +.PP +The \fBtk busy\fR command lets you make Tk widgets busy. This means that user +interactions such as button clicks, moving the mouse, typing at the keyboard, +etc.\0are ignored by the widget. You can set a special cursor (like a watch) +that overrides the widget's normal cursor, providing feedback that the +application (widget) is temporarily busy. +.PP +When a widget is made busy, the widget and all of its descendants will ignore +events. It's easy to make an entire panel of widgets busy. You can simply make +the toplevel widget (such as +.QW . ) +busy. This is easier and far much more efficient than recursively traversing +the widget hierarchy, disabling each widget and re-configuring its cursor. +.PP +Often, the \fBtk busy\fR command can be used instead of Tk's \fBgrab\fR +command. Unlike \fBgrab\fR which restricts all user interactions to one +widget, with the \fBtk busy\fR command you can have more than one widget +active (for example, a +.QW Cancel +dialog and a +.QW Help +button). +.SS EXAMPLE +.PP +You can make several widgets busy by simply making its ancestor widget busy +using the \fBhold\fR operation. +.PP +.CS +frame .top +button .top.button; canvas .top.canvas +pack .top.button .top.canvas +pack .top +# . . . +\fBtk busy\fR hold .top +update +.CE +.PP +All the widgets within \fB.top\fR (including \fB.top\fR) are now busy. Using +\fBupdate\fR insures that \fBtk busy\fR command will take effect before any +other user events can occur. +.PP +When the application is no longer busy processing, you can allow user +interactions again and free any resources it allocated by the \fBforget\fR +operation. +.PP +.CS +\fBtk busy\fR forget .top +.CE +.PP +The busy window has a configurable cursor. You can change the busy cursor +using the \fBconfigure\fR operation. +.PP +.CS +\fBtk busy\fR configure .top \-cursor "watch" +.CE +.PP +Destroying the widget will also clean up any resources allocated by the \fBtk +busy\fR command. +.PP +.SH OPERATIONS +.PP +The following operations are available for the \fBtk busy\fR command: +.TP +\fBtk busy \fIwindow\fR ?\fIoption value\fR?... +. +Shortcut for \fBtk busy hold\fR command. +.TP +\fBtk busy hold \fIwindow\fR ?\fIoption value\fR?... +. +Makes the specified \fIwindow\fR (and its descendants in the Tk window +hierarchy) appear busy. \fIWindow\fR must be a valid path name of a Tk widget. +A transparent window is put in front of the specified window. This transparent +window is mapped the next time idle tasks are processed, and the specified +window and its descendants will be blocked from user interactions. Normally +\fBupdate\fR should be called immediately afterward to insure that the hold +operation is in effect before the application starts its processing. The +following configuration options are valid: +.RS +.TP +\fB\-cursor \fIcursorName\fR +. +Specifies the cursor to be displayed when the widget is made busy. +\fICursorName\fR can be in any form accepted by \fBTk_GetCursor\fR. The +default cursor is \fBwait\fR on Windows and \fBwatch\fR on other platforms. +.RE +.TP +\fBtk busy cget \fIwindow\fR \fIoption\fR +. +Queries the \fBtk busy\fR command configuration options for \fIwindow\fR. +\fIWindow\fR must be the path name of a widget previously made busy by the +\fBhold\fR operation. The command returns the present value of the specified +\fIoption\fR. \fIOption\fR may have any of the values accepted by the +\fBhold\fR operation. +.TP +\fBtk busy configure \fIwindow\fR ?\fIoption value\fR?... +. +Queries or modifies the \fBtk busy\fR command configuration options for +\fIwindow\fR. \fIWindow\fR must be the path name of a widget previously made +busy by the \fBhold\fR operation. If no options are specified, a list +describing all of the available options for \fIwindow\fR (see +\fBTk_ConfigureInfo\fR for information on the format of this list) is +returned. If \fIoption\fR is specified with no \fIvalue\fR, then the command +returns a list describing the one named option (this list will be identical to +the corresponding sublist of the value returned if no \fIoption\fR is +specified). If one or more \fIoption\-value\fR pairs are specified, then the +command modifies the given widget option(s) to have the given value(s); in +this case the command returns the empty string. \fIOption\fR may have any of +the values accepted by the \fBhold\fR operation. +.RS +.PP +Please note that the option database is referenced through \fIwindow\fR. For +example, if the widget \fB.frame\fR is to be made busy, the busy cursor can be +specified for it by either \fBoption\fR command: +.PP +.CS +option add *frame.busyCursor gumby +option add *Frame.BusyCursor gumby +.CE +.RE +.TP +\fBtk busy forget \fIwindow\fR ?\fIwindow\fR?... +. +Releases resources allocated by the \fBtk busy\fR command for \fIwindow\fR, +including the transparent window. User events will again be received by +\fIwindow\fR. Resources are also released when \fIwindow\fR is destroyed. +\fIWindow\fR must be the name of a widget specified in the \fBhold\fR +operation, otherwise an error is reported. +.TP +\fBtk busy current \fR?\fIpattern\fR? +. +Returns the pathnames of all widgets that are currently busy. If a +\fIpattern\fR is given, only the path names of busy widgets matching +\fIpattern\fR are returned. +.TP +\fBtk busy status \fIwindow\fR +. +Returns the status of a widget \fIwindow\fR. If \fIwindow\fR presently can not +receive user interactions, \fB1\fR is returned, otherwise \fB0\fR. +.SH "EVENT HANDLING" +.SS BINDINGS +.PP +The event blocking feature is implemented by creating and mapping a +transparent window that completely covers the widget. When the busy window is +mapped, it invisibly shields the widget and its hierarchy from all events that +may be sent. Like Tk widgets, busy windows have widget names in the Tk window +hierarchy. This means that you can use the \fBbind\fR command, to handle +events in the busy window. +.PP +.CS +\fBtk busy\fR hold .frame.canvas +bind .frame.canvas_Busy <Enter> { ... } +.CE +.PP +Normally the busy window is a sibling of the widget. The name of the busy +window is +.QW \fIwidget\fB_Busy\fR +where \fIwidget\fR is the name of the widget to be made busy. In the previous +example, the pathname of the busy window is +.QW \fB.frame.canvas_Busy\fR . +The exception is when the widget is a toplevel widget (such as +.QW . ) +where the busy window can't be made a sibling. The busy window is then a child +of the widget named +.QW \fIwidget\fB._Busy\fR +where \fIwidget\fR is the name of the toplevel widget. In the following +example, the pathname of the busy window is +.QW \fB._Busy\fR . +.PP +.CS +\fBtk busy\fR hold . +bind ._Busy <Enter> { ... } +.CE +.SS "ENTER/LEAVE EVENTS" +.PP +Mapping and unmapping busy windows generates Enter/Leave events for all +widgets they cover. Please note this if you are tracking Enter/Leave events in +widgets. +.SS "KEYBOARD EVENTS" +.PP +When a widget is made busy, the widget is prevented from gaining the keyboard +focus by the busy window. But if the widget already had focus, it still may +received keyboard events. To prevent this, you must move focus to another +window. +.PP +.CS +\fBtk busy\fR hold .frame +label .dummy +focus .dummy +update +.CE +.PP +The above example moves the focus from .frame immediately after invoking the +\fBhold\fR so that no keyboard events will be sent to \fB.frame\fR or any of +its descendants. +.SH PORTABILITY +.PP +Note that the \fBtk busy\fR command does not currently have any effect on OSX +when Tk is built using Aqua support. +.SH "SEE ALSO" +grab(n) +.SH KEYWORDS +busy, keyboard events, pointer events, window +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/button.n b/doc/button.n index 4acc05a..e9a45a3 100644 --- a/doc/button.n +++ b/doc/button.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -button \- Create and manipulate button widgets +button \- Create and manipulate 'button' action widgets .SH SYNOPSIS \fBbutton\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -57,14 +57,14 @@ The empty string is the default value. .OP \-state state State Specifies one of three states for the button: \fBnormal\fR, \fBactive\fR, or \fBdisabled\fR. In normal state the button is displayed using the -\fBforeground\fR and \fBbackground\fR options. The active state is +\fB\-foreground\fR and \fB\-background\fR options. The active state is typically used when the pointer is over the button. In active state -the button is displayed using the \fBactiveForeground\fR and -\fBactiveBackground\fR options. Disabled state means that the button +the button is displayed using the \fB\-activeforeground\fR and +\fB\-activebackground\fR options. Disabled state means that the button should be insensitive: the default bindings will refuse to activate the widget and will ignore mouse button presses. -In this state the \fBdisabledForeground\fR and -\fBbackground\fR options determine how the button is displayed. +In this state the \fB\-disabledforeground\fR and +\fB\-background\fR options determine how the button is displayed. .OP \-width width Width Specifies a desired width for the button. If an image or bitmap is being displayed in the button then the value is in @@ -75,7 +75,6 @@ If the width is negative then this specifies a minimum width. If this option is not specified, the button's desired width is computed from the size of the image or bitmap or text being displayed in it. .BE - .SH DESCRIPTION .PP The \fBbutton\fR command creates a new window (given by the @@ -92,18 +91,17 @@ there must not exist a window named \fIpathName\fR, but A button is a widget that displays a textual string, bitmap or image. If text is displayed, it must all be in a single font, but it can occupy multiple lines on the screen (if it contains newlines -or if wrapping occurs because of the \fBwrapLength\fR option) and +or if wrapping occurs because of the \fB\-wraplength\fR option) and one of the characters may optionally be underlined using the -\fBunderline\fR option. +\fB\-underline\fR option. It can display itself in either of three different ways, according to -the \fBstate\fR option; +the \fB\-state\fR option; it can be made to appear raised, sunken, or flat; and it can be made to flash. When a user invokes the button (by pressing mouse button 1 with the cursor over the button), then the Tcl command specified in the \fB\-command\fR option is invoked. - .SH "WIDGET COMMAND" .PP The \fBbutton\fR command creates a new Tcl command whose @@ -139,9 +137,9 @@ command. .TP \fIpathName \fBflash\fR Flash the button. This is accomplished by redisplaying the button -several times, alternating between active and normal colors. At -the end of the flash the button is left in the same normal/active -state as when the command was invoked. +several times, alternating between the configured activebackground +and background colors. At the end of the flash the button is left +in the same normal/active state as when the command was invoked. This command is ignored if the button's state is \fBdisabled\fR. .TP \fIpathName \fBinvoke\fR @@ -149,7 +147,6 @@ Invoke the Tcl command associated with the button, if there is one. The return value is the return value from the Tcl command, or an empty string if there is no command associated with the button. This command is ignored if the button's state is \fBdisabled\fR. - .SH "DEFAULT BINDINGS" .PP Tk automatically creates class bindings for buttons that give them @@ -176,27 +173,38 @@ actions occur: the button is completely non-responsive. .PP The behavior of buttons can be changed by defining new bindings for individual widgets or by redefining the class bindings. - +.SH "PLATFORM NOTES" +.PP +On Aqua/Mac OS X, some configuration options are ignored for the purpose of +drawing of the widget because they would otherwise conflict with platform +guidelines. The \fBconfigure\fR and \fBcget\fR subcommands can still +manipulate the values, but do not cause any variation to the look of the +widget. The options affected notably include \fB\-background\fR and +\fB\-relief\fR. .SH EXAMPLES +.PP This is the classic Tk .QW "Hello, World!" demonstration: .PP .CS - \fBbutton\fR .b \-text "Hello, World!" \-command exit - pack .b +\fBbutton\fR .b \-text "Hello, World!" \-command exit +pack .b .CE .PP This example demonstrates how to handle button accelerators: .PP .CS - \fBbutton\fR .b1 \-text Hello \-underline 0 - \fBbutton\fR .b2 \-text World \-underline 0 - bind . <Key\-h> {.b1 flash; .b1 invoke} - bind . <Key\-w> {.b2 flash; .b2 invoke} - pack .b1 .b2 +\fBbutton\fR .b1 \-text Hello \-underline 0 +\fBbutton\fR .b2 \-text World \-underline 0 +bind . <Key\-h> {.b1 flash; .b1 invoke} +bind . <Key\-w> {.b2 flash; .b2 invoke} +pack .b1 .b2 .CE .SH "SEE ALSO" ttk::button(n) .SH KEYWORDS button, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/canvas.n b/doc/canvas.n index 676c1cd..bc29cc3 100644 --- a/doc/canvas.n +++ b/doc/canvas.n @@ -11,7 +11,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -canvas \- Create and manipulate canvas widgets +canvas \- Create and manipulate 'canvas' hypergraphics drawing surface widgets .SH SYNOPSIS \fBcanvas\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -36,7 +36,7 @@ Defaults to true, which means that the view will be constrained within the scroll region. .OP \-height height Height Specifies a desired window height that the canvas widget should request from -its geometry manager. The value may be specified in any +its geometry manager. The value may be specified in any of the forms described in the \fBCOORDINATES\fR section below. .OP \-scrollregion scrollRegion ScrollRegion Specifies a list with four coordinates describing the left, top, right, and @@ -49,34 +49,34 @@ in any of the forms given in the \fBCOORDINATES\fR section below. Modifies the default state of the canvas where \fIstate\fR may be set to one of: \fBnormal\fR, \fBdisabled\fR, or \fBhidden\fR. Individual canvas objects all have their own state option which may override the default -state. Many options can take separate specifications such that the +state. Many options can take separate specifications such that the appearance of the item can be different in different situations. The options that start with \fBactive\fR control the appearance when the mouse pointer is over it, while the option starting with \fBdisabled\fR controls -the appearance when the state is disabled. Canvas items which are +the appearance when the state is disabled. Canvas items which are \fBdisabled\fR will not react to canvas bindings. .OP \-width width width Specifies a desired window width that the canvas widget should request from -its geometry manager. The value may be specified in any +its geometry manager. The value may be specified in any of the forms described in the \fBCOORDINATES\fR section below. .OP \-xscrollincrement xScrollIncrement ScrollIncrement Specifies an increment for horizontal scrolling, in any of the usual forms -permitted for screen distances. If the value of this option is greater +permitted for screen distances. If the value of this option is greater than zero, the horizontal view in the window will be constrained so that the canvas x coordinate at the left edge of the window is always an even -multiple of \fBxScrollIncrement\fR; furthermore, the units for scrolling +multiple of \fBxScrollIncrement\fR; furthermore, the units for scrolling (e.g., the change in view when the left and right arrows of a scrollbar -are selected) will also be \fBxScrollIncrement\fR. If the value of +are selected) will also be \fBxScrollIncrement\fR. If the value of this option is less than or equal to zero, then horizontal scrolling is unconstrained. .OP \-yscrollincrement yScrollIncrement ScrollIncrement Specifies an increment for vertical scrolling, in any of the usual forms -permitted for screen distances. If the value of this option is greater +permitted for screen distances. If the value of this option is greater than zero, the vertical view in the window will be constrained so that the canvas y coordinate at the top edge of the window is always an even -multiple of \fByScrollIncrement\fR; furthermore, the units for scrolling +multiple of \fByScrollIncrement\fR; furthermore, the units for scrolling (e.g., the change in view when the top and bottom arrows of a scrollbar -are selected) will also be \fByScrollIncrement\fR. If the value of +are selected) will also be \fByScrollIncrement\fR. If the value of this option is less than or equal to zero, then vertical scrolling is unconstrained. .BE @@ -88,7 +88,7 @@ Additional options, described above, may be specified on the command line or in the option database to configure aspects of the canvas such as its colors and 3-D relief. The \fBcanvas\fR command returns its -\fIpathName\fR argument. At the time this command is invoked, +\fIpathName\fR argument. At the time this command is invoked, there must not exist a window named \fIpathName\fR, but \fIpathName\fR's parent must exist. .PP @@ -97,7 +97,7 @@ A canvas displays any number of \fIitems\fR, which may be things like rectangles, circles, lines, and text. Items may be manipulated (e.g. moved or re-colored) and commands may be associated with items in much the same way that the \fBbind\fR -command allows commands to be bound to widgets. For example, +command allows commands to be bound to widgets. For example, a particular command may be associated with the <Button-1> event so that the command is invoked whenever button 1 is pressed with the mouse cursor over an item. @@ -117,22 +117,22 @@ display list, on top of everything else. Widget commands may be used to re-arrange the order of the display list. .PP -Window items are an exception to the above rules. The underlying +Window items are an exception to the above rules. The underlying window systems require them always to be drawn on top of other items. In addition, the stacking order of window items is not affected by any of the canvas widget commands; you must use -the \fBraise\fR and \fBlower\fR Tk commands instead. +the Tk \fBraise\fR command and \fBlower\fR command instead. .SH "ITEM IDS AND TAGS" .PP Items in a canvas widget may be named in either of two ways: by id or by tag. Each item has a unique identifying number, which is assigned to -that item when it is created. The id of an item never changes +that item when it is created. The id of an item never changes and id numbers are never re-used within the lifetime of a canvas widget. .PP Each item may also have any number of \fItags\fR associated -with it. A tag is just a string of characters, and it may +with it. A tag is just a string of characters, and it may take any form except that of an integer. For example, .QW x123 @@ -141,11 +141,11 @@ is OK but is not. The same tag may be associated with many different items. This is commonly done to group items in various interesting -ways; for example, all selected items might be given the tag +ways; for example, all selected items might be given the tag .QW selected . .PP The tag \fBall\fR is implicitly associated with every item -in the canvas; it may be used to invoke operations on +in the canvas; it may be used to invoke operations on all the items in the canvas. .PP The tag \fBcurrent\fR is managed automatically by Tk; @@ -172,7 +172,7 @@ tags by using operators: .QW \fB||\fR , .QW \fB^\fR , .QW \fB!\fR , -and parenthesized subexpressions. For example: +and parenthesized subexpressions. For example: .CS .c find withtag {(a&&!b)||(!a&&b)} .CE @@ -187,7 +187,7 @@ or tags, but not both. .PP Some widget commands only operate on a single item at a -time; if \fItagOrId\fR is specified in a way that +time; if \fItagOrId\fR is specified in a way that names multiple items, then the normal behavior is for the command to use the first (lowest) of these items in the display list that is suitable for the command. @@ -202,9 +202,9 @@ which are floating-point numbers optionally followed by one of several letters. If no letter is supplied then the distance is in pixels. If the letter is \fBm\fR then the distance is in millimeters on -the screen; if it is \fBc\fR then the distance is in centimeters; +the screen; if it is \fBc\fR then the distance is in centimeters; \fBi\fR means inches, and \fBp\fR means printers points (1/72 inch). -Larger y-coordinates refer to points lower on the screen; larger +Larger y-coordinates refer to points lower on the screen; larger x-coordinates refer to points farther to the right. Coordinates can be specified either as an even number of parameters, or as a single list parameter containing an even number of x and y @@ -215,7 +215,7 @@ Normally the origin of the canvas coordinate system is at the upper-left corner of the window containing the canvas. It is possible to adjust the origin of the canvas coordinate system relative to the origin of the window using the -\fBxview\fR and \fByview\fR widget commands; this is typically used +\fBxview\fR and \fByview\fR widget commands; this is typically used for scrolling. Canvases do not support scaling or rotation of the canvas coordinate system relative to the window coordinate system. @@ -227,7 +227,7 @@ Note that the default origin of the canvas's visible area is coincident with the origin for the whole window as that makes bindings using the mouse position easier to work with; you only need to use the \fBcanvasx\fR and \fBcanvasy\fR widget commands if you adjust the -origin of the visible area. However, this also means that any focus +origin of the visible area. However, this also means that any focus ring (as controlled by the \fB\-highlightthickness\fR option) and window border (as controlled by the \fB\-borderwidth\fR option) must be taken into account before you get to the visible area of the @@ -243,17 +243,18 @@ a range of characters or coordinates, and setting the insertion cursor position. An index may be specified in any of a number of ways, and different types of items may support different forms for specifying indices. -Text items support the following forms for an index; if you +Text items support the following forms for an index; if you define new types of text-like items, it would be advisable to support as many of these forms as practical. Note that it is possible to refer to the character just after -the last one in the text item; this is necessary for such +the last one in the text item; this is necessary for such tasks as inserting new text at the end of the item. Lines and Polygons do not support the insertion cursor and the selection. Their indices are supposed to be even always, because coordinates always appear in pairs. .TP 10 \fInumber\fR +. A decimal number giving the position of the desired character within the text item. 0 refers to the first character, 1 to the next character, and @@ -268,23 +269,28 @@ the length until the result is between zero and the length, inclusive. .TP 10 \fBend\fR +. Refers to the character or coordinate just after the last one in the item (same as the number of characters or coordinates in the item). .TP 10 \fBinsert\fR +. Refers to the character just before which the insertion cursor is drawn in this item. Not valid for lines and polygons. .TP 10 \fBsel.first\fR +. Refers to the first selected character in the item. If the selection is not in this item then this form is illegal. .TP 10 \fBsel.last\fR +. Refers to the last selected character in the item. If the selection is not in this item then this form is illegal. .TP 10 \fB@\fIx,y\fR +. Refers to the character or coordinate at the point given by \fIx\fR and \fIy\fR, where \fIx\fR and \fIy\fR are specified in the coordinate system of the canvas. @@ -303,15 +309,15 @@ color. The other segments are drawn transparent. .PP The second possible syntax is a character list containing only 5 possible characters -.QW "\fB.,\-_ \fR" . +.QW "\fB.,-_ \fR" . The space can be used to enlarge the space between other line elements, and cannot occur as the first position in the string. Some examples: .CS \-dash . \(-> \-dash {2 4} -\-dash \- \(-> \-dash {6 4} -\-dash \-. \(-> \-dash {6 4 2 4} -\-dash \-.. \(-> \-dash {6 4 2 4 2 4} +\-dash - \(-> \-dash {6 4} +\-dash -. \(-> \-dash {6 4 2 4} +\-dash -.. \(-> \-dash {6 4 2 4 2 4} \-dash {. } \(-> \-dash {2 8} \-dash , \(-> \-dash {4 4} .CE @@ -322,20 +328,20 @@ list will be multiplied by the line width before display. This assures that .QW . will always be displayed as a dot and -.QW \- +.QW - always as a dash regardless of the line width. .PP On systems which support only a limited set of dash patterns, the dash pattern will be displayed as the closest dash pattern that is available. For example, on Windows only the first 4 of the above examples are -available. The last 2 examples will be displayed identically to the first +available. The last 2 examples will be displayed identically to the first one. .SH "WIDGET COMMAND" .PP The \fBcanvas\fR command creates a new Tcl command whose -name is \fIpathName\fR. This +name is \fIpathName\fR. This command may be used to invoke various -operations on the widget. It has the following general form: +operations on the widget. It has the following general form: .CS \fIpathName option \fR?\fIarg arg ...\fR? .CE @@ -344,6 +350,7 @@ determine the exact behavior of the command. The following widget commands are possible for canvas widgets: .TP \fIpathName \fBaddtag \fItag searchSpec \fR?\fIarg arg ...\fR? +. For each item that meets the constraints specified by \fIsearchSpec\fR and the \fIarg\fRs, add \fItag\fR to the list of tags associated with the item if it @@ -357,21 +364,25 @@ forms: .RS .TP \fBabove \fItagOrId\fR +. Selects the item just after (above) the one given by \fItagOrId\fR in the display list. If \fItagOrId\fR denotes more than one item, then the last (topmost) of these items in the display list is used. .TP \fBall\fR +. Selects all the items in the canvas. .TP \fBbelow \fItagOrId\fR +. Selects the item just before (below) the one given by \fItagOrId\fR in the display list. If \fItagOrId\fR denotes more than one item, then the first (lowest) of these items in the display list is used. .TP \fBclosest \fIx y \fR?\fIhalo\fR? ?\fIstart\fR? +. Selects the item closest to the point given by \fIx\fR and \fIy\fR. If more than one item is at the same closest distance (e.g. two items overlap the point), then the top-most of these items (the @@ -387,16 +398,18 @@ If \fIstart\fR is specified, it names an item using a tag or id the given tag). Instead of selecting the topmost closest item, this form will select the topmost closest item that is below \fIstart\fR in -the display list; if no such item exists, then the selection +the display list; if no such item exists, then the selection behaves as if the \fIstart\fR argument had not been specified. .TP \fBenclosed\fR \fIx1\fR \fIy1\fR \fIx2\fR \fIy2\fR +. Selects all the items completely enclosed within the rectangular region given by \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR. \fIX1\fR must be no greater then \fIx2\fR and \fIy1\fR must be no greater than \fIy2\fR. .TP \fBoverlapping\fR \fIx1\fR \fIy1\fR \fIx2\fR \fIy2\fR +. Selects all the items that overlap or are enclosed within the rectangular region given by \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR. @@ -404,10 +417,12 @@ and \fIy2\fR. no greater than \fIy2\fR. .TP \fBwithtag \fItagOrId\fR +. Selects all the items given by \fItagOrId\fR. .RE .TP \fIpathName \fBbbox \fItagOrId\fR ?\fItagOrId tagOrId ...\fR? +. Returns a list with four elements giving an approximate bounding box for all the items named by the \fItagOrId\fR arguments. The list has the form @@ -424,6 +439,7 @@ to display) then an empty string is returned. .TP \fIpathName \fBbind \fItagOrId\fR ?\fIsequence\fR? ?\fIcommand\fR? +. This command associates \fIcommand\fR with all the items given by \fItagOrId\fR such that whenever the event sequence given by \fIsequence\fR occurs for one of the items the command will @@ -451,13 +467,13 @@ The only events for which bindings may be specified are those related to the mouse and keyboard (such as \fBEnter\fR, \fBLeave\fR, \fBButtonPress\fR, \fBMotion\fR, and \fBKeyPress\fR) or virtual events. The handling of events in canvases uses the current item defined in -\fBITEM IDS AND TAGS\fR above. \fBEnter\fR and \fBLeave\fR events +\fBITEM IDS AND TAGS\fR above. \fBEnter\fR and \fBLeave\fR events trigger for an item when it becomes the current item or ceases to be the current item; note that these events are different than \fBEnter\fR and \fBLeave\fR -events for windows. Mouse-related events are directed to the current -item, if any. Keyboard-related events are directed to the focus item, if -any (see the \fBfocus\fR widget command below for more on this). If a +events for windows. Mouse-related events are directed to the current +item, if any. Keyboard-related events are directed to the focus item, if +any (see the \fBfocus\fR widget command below for more on this). If a virtual event is used in a binding, that binding can trigger only if the virtual event is defined by an underlying mouse-related or keyboard-related event. @@ -484,33 +500,37 @@ for the window as a whole. .RE .TP \fIpathName \fBcanvasx \fIscreenx\fR ?\fIgridspacing\fR? +. Given a window x-coordinate in the canvas \fIscreenx\fR, this command returns the canvas x-coordinate that is displayed at that location. If \fIgridspacing\fR is specified, then the canvas coordinate is rounded to the nearest multiple of \fIgridspacing\fR units. .TP \fIpathName \fBcanvasy \fIscreeny\fR ?\fIgridspacing\fR? +. Given a window y-coordinate in the canvas \fIscreeny\fR this command returns the canvas y-coordinate that is displayed at that location. If \fIgridspacing\fR is specified, then the canvas coordinate is rounded to the nearest multiple of \fIgridspacing\fR units. .TP \fIpathName \fBcget\fR \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBcanvas\fR command. .TP \fIpathName \fBconfigure ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR? +. Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for -information on the format of this list). If \fIoption\fR is specified +information on the format of this list). If \fIoption\fR is specified with no \fIvalue\fR, then the command returns a list describing the one named option (this list will be identical to the corresponding -sublist of the value returned if no \fIoption\fR is specified). If +sublist of the value returned if no \fIoption\fR is specified). If one or more \fIoption\-value\fR pairs are specified, then the command -modifies the given widget option(s) to have the given value(s); in +modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string. \fIOption\fR may have any of the values accepted by the \fBcanvas\fR command. @@ -518,6 +538,7 @@ command. \fIpathName\fR \fBcoords \fItagOrId \fR?\fIx0 y0 ...\fR? .TP \fIpathName\fR \fBcoords \fItagOrId \fR?\fIcoordList\fR? +. Query or modify the coordinates that define an item. If no coordinates are specified, this command returns a list whose elements are the coordinates of the item named by @@ -530,9 +551,10 @@ the first one in the display list is used. \fIpathName \fBcreate \fItype x y \fR?\fIx y ...\fR? ?\fIoption value ...\fR? .TP \fIpathName \fBcreate \fItype coordList \fR?\fIoption value ...\fR? +. Create a new item in \fIpathName\fR of type \fItype\fR. -The exact format of the arguments after \fBtype\fR depends -on \fBtype\fR, but usually they consist of the coordinates for +The exact format of the arguments after \fItype\fR depends +on \fItype\fR, but usually they consist of the coordinates for one or more points, followed by specifications for zero or more item options. See the subsections on individual item types below for more @@ -540,21 +562,24 @@ on the syntax of this command. This command returns the id for the new item. .TP \fIpathName \fBdchars \fItagOrId first \fR?\fIlast\fR? +. For each item given by \fItagOrId\fR, delete the characters, or coordinates, in the range given by \fIfirst\fR and \fIlast\fR, inclusive. If some of the items given by \fItagOrId\fR do not support -indexing operations then they ignore dchars. +indexing operations then they ignore this operation. Text items interpret \fIfirst\fR and \fIlast\fR as indices to a character, -line and polygon items interpret them indices to a coordinate (an x,y pair). +line and polygon items interpret them as indices to a coordinate (an x,y pair). Indices are described in \fBINDICES\fR above. If \fIlast\fR is omitted, it defaults to \fIfirst\fR. This command returns an empty string. .TP \fIpathName \fBdelete \fR?\fItagOrId tagOrId ...\fR? +. Delete each of the items given by each \fItagOrId\fR, and return an empty string. .TP \fIpathName \fBdtag \fItagOrId \fR?\fItagToDelete\fR? +. For each of the items given by \fItagOrId\fR, delete the tag given by \fItagToDelete\fR from the list of those associated with the item. @@ -564,6 +589,7 @@ If \fItagToDelete\fR is omitted then it defaults to \fItagOrId\fR. This command returns an empty string. .TP \fIpathName \fBfind \fIsearchCommand \fR?\fIarg arg ...\fR? +. This command returns a list consisting of all the items that meet the constraints specified by \fIsearchCommand\fR and \fIarg\fR's. @@ -572,6 +598,7 @@ accepted by the \fBaddtag\fR command. The items are returned in stacking order, with the lowest item first. .TP \fIpathName \fBfocus \fR?\fItagOrId\fR? +. Set the keyboard focus for the canvas widget to the item given by \fItagOrId\fR. If \fItagOrId\fR refers to several items, then the focus is set @@ -600,6 +627,7 @@ the canvas (if it was not there already). .RE .TP \fIpathName \fBgettags\fR \fItagOrId\fR +. Return a list whose elements are the tags associated with the item given by \fItagOrId\fR. If \fItagOrId\fR refers to more than one item, then the tags @@ -608,24 +636,35 @@ If \fItagOrId\fR does not refer to any items, or if the item contains no tags, then an empty string is returned. .TP \fIpathName \fBicursor \fItagOrId index\fR +. Set the position of the insertion cursor for the item(s) given by \fItagOrId\fR to just before the character whose position is given by \fIindex\fR. If some or all of the items given by \fItagOrId\fR do not support an insertion cursor then this command has no effect on them. See \fBINDICES\fR above for a description of the legal forms for \fIindex\fR. -Note: the insertion cursor is only displayed in an item if -that item currently has the keyboard focus (see the widget -command \fBfocus\fR, below), but the cursor position may +Note: the insertion cursor is only displayed in an item if +that item currently has the keyboard focus (see the \fBfocus\fR widget +command, above), but the cursor position may be set even when the item does not have the focus. This command returns an empty string. .TP +\fIpathName \fBimove \fItagOrId index x y\fR +.VS 8.6 +This command causes the \fIindex\fR'th coordinate of each of the items +indicated by \fItagOrId\fR to be relocated to the location (\fIx\fR,\fIy\fR). +Each item interprets \fIindex\fR independently according to the rules +described in \fBINDICES\fR above. Out of the standard set of items, only line +and polygon items may have their coordinates relocated this way. +.VE 8.6 +.TP \fIpathName \fBindex \fItagOrId index\fR +. This command returns a decimal string giving the numerical index within \fItagOrId\fR corresponding to \fIindex\fR. \fIIndex\fR gives a textual description of the desired position as described in \fBINDICES\fR above. -Text items interpret \fIindex\fR as an index to a character, +Text items interpret \fIindex\fR as an index to a character, line and polygon items interpret it as an index to a coordinate (an x,y pair). The return value is guaranteed to lie between 0 and the number of characters, or coordinates, within the item, inclusive. @@ -634,10 +673,11 @@ is processed in the first of these items that supports indexing operations (in display list order). .TP \fIpathName \fBinsert \fItagOrId beforeThis string\fR +. For each of the items given by \fItagOrId\fR, if the item supports text or coordinate, insertion then \fIstring\fR is inserted into the item's text just before the character, or coordinate, whose index is \fIbeforeThis\fR. -Text items interpret \fIbeforeThis\fR as an index to a character, +Text items interpret \fIbeforeThis\fR as an index to a character, line and polygon items interpret it as an index to a coordinate (an x,y pair). For lines and polygons the \fIstring\fR must be a valid coordinate sequence. @@ -646,6 +686,7 @@ for \fIbeforeThis\fR. This command returns an empty string. .TP \fIpathName \fBitemcget\fR \fItagOrId\fR \fIoption\fR +. Returns the current value of the configuration option for the item given by \fItagOrId\fR whose name is \fIoption\fR. This command is similar to the \fBcget\fR widget command except that @@ -656,6 +697,7 @@ If \fItagOrId\fR is a tag that refers to more than one item, the first (lowest) such item is used. .TP \fIpathName \fBitemconfigure \fItagOrId\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR? +. This command is similar to the \fBconfigure\fR widget command except that it modifies item-specific options for the items given by \fItagOrId\fR instead of modifying options for the overall @@ -663,13 +705,13 @@ canvas widget. If no \fIoption\fR is specified, returns a list describing all of the available options for the first item given by \fItagOrId\fR (see \fBTk_ConfigureInfo\fR for -information on the format of this list). If \fIoption\fR is specified +information on the format of this list). If \fIoption\fR is specified with no \fIvalue\fR, then the command returns a list describing the one named option (this list will be identical to the corresponding -sublist of the value returned if no \fIoption\fR is specified). If +sublist of the value returned if no \fIoption\fR is specified). If one or more \fIoption\-value\fR pairs are specified, then the command modifies the given widget option(s) to have the given value(s) in -each of the items given by \fItagOrId\fR; in +each of the items given by \fItagOrId\fR; in this case the command returns an empty string. The \fIoption\fRs and \fIvalue\fRs are the same as those permissible in the \fBcreate\fR widget command when the item(s) were created; @@ -677,30 +719,45 @@ see the sections describing individual item types below for details on the legal options. .TP \fIpathName \fBlower \fItagOrId \fR?\fIbelowThis\fR? +. Move all of the items given by \fItagOrId\fR to a new position in the display list just before the item given by \fIbelowThis\fR. If \fItagOrId\fR refers to more than one item then all are moved but the relative order of the moved items will not be changed. -\fIBelowThis\fR is a tag or id; if it refers to more than one +\fIBelowThis\fR is a tag or id; if it refers to more than one item then the first (lowest) of these items in the display list is used as the destination location for the moved items. -Note: this command has no effect on window items. Window items always +Note: this command has no effect on window items. Window items always obscure other item types, and the stacking order of window items is -determined by the \fBraise\fR and \fBlower\fR commands, not the -\fBraise\fR and \fBlower\fR widget commands for canvases. +determined by the \fBraise\fR command and \fBlower\fR command, not the +\fBraise\fR widget command and \fBlower\fR widget command for canvases. This command returns an empty string. .TP \fIpathName \fBmove \fItagOrId xAmount yAmount\fR +. Move each of the items given by \fItagOrId\fR in the canvas coordinate space by adding \fIxAmount\fR to the x-coordinate of each point associated with the item and \fIyAmount\fR to the y-coordinate of each point associated with the item. This command returns an empty string. .TP +\fIpathName \fBmoveto \fItagOrId xPos yPos\fR +.VS 8.6 +Move the items given by \fItagOrId\fR in the canvas coordinate +space so that the first coordinate pair of the bottommost item with +tag \fItagOrId\fR is located at +position (\fIxPos\fR,\fIyPos\fR). \fIxPos\fR and \fIyPos\fR may be +the empty string, in which case the corresponding coordinate +will be unchanged. All items matching +\fItagOrId\fR remain in the same positions relative to each other. +This command returns an empty string. +.VE 8.6 +.TP \fIpathName \fBpostscript \fR?\fIoption value option value ...\fR? +. Generate a Postscript representation for part or all of the canvas. If the \fB\-file\fR option is specified then the Postscript is written -to a file and an empty string is returned; otherwise the Postscript +to a file and an empty string is returned; otherwise the Postscript is returned as the result of the command. If the interpreter that owns the canvas is marked as safe, the operation will fail because safe interpreters are not allowed to write files. @@ -711,18 +768,26 @@ of the operation. The Postscript is created in Encapsulated Postscript form using version 3.0 of the Document Structuring Conventions. Note: by default Postscript is only generated for information that -appears in the canvas's window on the screen. If the canvas is +appears in the canvas's window on the screen. If the canvas is freshly created it may still have its initial size of 1x1 pixel -so nothing will appear in the Postscript. To get around this problem +so nothing will appear in the Postscript. To get around this problem either invoke the \fBupdate\fR command to wait for the canvas window to reach its final size, or else use the \fB\-width\fR and \fB\-height\fR options to specify the area of the canvas to print. The \fIoption\fR\-\fIvalue\fR argument pairs provide additional -information to control the generation of Postscript. The following +information to control the generation of Postscript. The following options are supported: .RS .TP +\fB\-channel \fIchannelName\fR +. +Specifies the name of the channel to which to write the Postscript. +If this option and the \fB\-file\fR option are +not specified then the Postscript is returned as the +result of the command. +.TP \fB\-colormap \fIvarName\fR +. \fIVarName\fR must be the name of an array variable that specifies a color mapping to use in the Postscript. Each element of \fIvarName\fR must consist of Postscript @@ -738,17 +803,21 @@ in \fIvarName\fR for a given color, then Tk uses the red, green, and blue intensities from the X color. .TP \fB\-colormode \fImode\fR -Specifies how to output color information. \fIMode\fR must be either +. +Specifies how to output color information. \fIMode\fR must be either \fBcolor\fR (for full color output), \fBgray\fR (convert all colors to their gray-scale equivalents) or \fBmono\fR (convert all colors to black or white). .TP \fB\-file \fIfileName\fR +. Specifies the name of the file in which to write the Postscript. -If this option is not specified then the Postscript is returned as the -result of the command instead of being written to a file. +If this option and the \fB\-channel\fR option are +not specified then the Postscript is returned as the +result of the command. .TP \fB\-fontmap \fIvarName\fR +. \fIVarName\fR must be the name of an array variable that specifies a font mapping to use in the Postscript. Each element of \fIvarName\fR must consist of a Tcl list with @@ -763,14 +832,16 @@ Tk's guesses generally only work for well-known fonts such as Times and Helvetica and Courier, and only if the X font name does not omit any dashes up through the point size. For example, \fB\-*\-Courier\-Bold\-R\-Normal\-\-*\-120\-*\fR will work but -\fB*Courier\-Bold\-R\-Normal*120*\fR will not; Tk needs the dashes to +\fB*Courier\-Bold\-R\-Normal*120*\fR will not; Tk needs the dashes to parse the font name). .TP \fB\-height \fIsize\fR +. Specifies the height of the area of the canvas to print. Defaults to the height of the canvas window. .TP \fB\-pageanchor \fIanchor\fR +. Specifies which point of the printed area of the canvas should appear over the positioning point on the page (which is given by the \fB\-pagex\fR and \fB\-pagey\fR options). @@ -779,6 +850,7 @@ area of the canvas being printed (as it appears in the canvas window) should be over the positioning point. Defaults to \fBcenter\fR. .TP \fB\-pageheight \fIsize\fR +. Specifies that the Postscript should be scaled in both x and y so that the printed area is \fIsize\fR high on the Postscript page. \fISize\fR consists of a floating-point number followed by @@ -790,15 +862,17 @@ the scale factor from \fB\-pagewidth\fR is used (non-uniform scaling is not implemented). .TP \fB\-pagewidth \fIsize\fR +. Specifies that the Postscript should be scaled in both x and y so that the printed area is \fIsize\fR wide on the Postscript page. \fISize\fR has the same form as for \fB\-pageheight\fR. Defaults to the width of the printed area on the screen. If both \fB\-pageheight\fR and \fB\-pagewidth\fR are specified then -the scale factor from \fB\-pagewidth\fR is used (non-uniform scaling +the scale factor from \fB\-pagewidth\fR is used (non-uniform scaling is not implemented). .TP \fB\-pagex \fIposition\fR +. \fIPosition\fR gives the x-coordinate of the positioning point on the Postscript page, using any of the forms allowed for \fB\-pageheight\fR. Used in conjunction with the \fB\-pagey\fR and \fB\-pageanchor\fR options @@ -806,6 +880,7 @@ to determine where the printed area appears on the Postscript page. Defaults to the center of the page. .TP \fB\-pagey \fIposition\fR +. \fIPosition\fR gives the y-coordinate of the positioning point on the Postscript page, using any of the forms allowed for \fB\-pageheight\fR. Used in conjunction with the \fB\-pagex\fR and \fB\-pageanchor\fR options @@ -813,26 +888,30 @@ to determine where the printed area appears on the Postscript page. Defaults to the center of the page. .TP \fB\-rotate \fIboolean\fR +. \fIBoolean\fR specifies whether the printed area is to be rotated 90 degrees. In non-rotated output the x-axis of the printed area runs along the short dimension of the page -.PQ portrait orientation ; +.PQ portrait " orientation" ; in rotated output the x-axis runs along the long dimension of the page -.PQ landscape orientation . +.PQ landscape " orientation" . Defaults to non-rotated. .TP \fB\-width \fIsize\fR +. Specifies the width of the area of the canvas to print. Defaults to the width of the canvas window. .TP \fB\-x \fIposition\fR +. Specifies the x-coordinate of the left edge of the area of the canvas that is to be printed, in canvas coordinates, not window coordinates. Defaults to the coordinate of the left edge of the window. .TP \fB\-y \fIposition\fR +. Specifies the y-coordinate of the top edge of the area of the canvas that is to be printed, in canvas coordinates, not window coordinates. @@ -840,22 +919,39 @@ Defaults to the coordinate of the top edge of the window. .RE .TP \fIpathName \fBraise \fItagOrId \fR?\fIaboveThis\fR? +. Move all of the items given by \fItagOrId\fR to a new position in the display list just after the item given by \fIaboveThis\fR. If \fItagOrId\fR refers to more than one item then all are moved but the relative order of the moved items will not be changed. -\fIAboveThis\fR is a tag or id; if it refers to more than one +\fIAboveThis\fR is a tag or id; if it refers to more than one item then the last (topmost) of these items in the display list is used as the destination location for the moved items. -Note: this command has no effect on window items. Window items always -obscure other item types, and the stacking order of window items is -determined by the \fBraise\fR and \fBlower\fR commands, not the -\fBraise\fR and \fBlower\fR widget commands for canvases. This command returns an empty string. +.RS +.PP +Note: this command has no effect on window items. Window items always +obscure other item types, and the stacking order of window items is +determined by the \fBraise\fR command and \fBlower\fR command, not the +\fBraise\fR widget command and \fBlower\fR widget command for canvases. +.RE +.TP +\fIpathName \fBrchars \fItagOrId first last string\fR +.VS 8.6 +This command causes the text or coordinates between \fIfirst\fR and \fIlast\fR +for each of the items indicated by \fItagOrId\fR to be replaced by +\fIstring\fR. Each item interprets \fIfirst\fR and \fIlast\fR independently +according to the rules described in \fBINDICES\fR above. Out of the standard +set of items, text items support this operation by altering their text as +directed, and line and polygon items support this operation by altering their +coordinate list (in which case \fIstring\fR should be a list of coordinates to +use as a replacement). The other items ignore this operation. +.VE 8.6 .TP \fIpathName \fBscale \fItagOrId xOrigin yOrigin xScale yScale\fR -Rescale all of the items given by \fItagOrId\fR in canvas coordinate -space. +. +Rescale the coordinates of all of the items given by \fItagOrId\fR in canvas +coordinate space. \fIXOrigin\fR and \fIyOrigin\fR identify the origin for the scaling operation and \fIxScale\fR and \fIyScale\fR identify the scale factors for x- and y-coordinates, respectively (a scale factor of @@ -866,20 +962,29 @@ of \fIxScale\fR. Similarly, each y-coordinate is adjusted to change the distance from \fIyOrigin\fR by a factor of \fIyScale\fR. This command returns an empty string. +.RS +.PP +Note that some items have only a single pair of coordinates (e.g., text, +images and windows) and so scaling of them by this command can only move them +around. +.RE .TP \fIpathName \fBscan\fR \fIoption args\fR -This command is used to implement scanning on canvases. It has +. +This command is used to implement scanning on canvases. It has two forms, depending on \fIoption\fR: .RS .TP \fIpathName \fBscan mark \fIx y\fR -Records \fIx\fR and \fIy\fR and the canvas's current view; used +. +Records \fIx\fR and \fIy\fR and the canvas's current view; used in conjunction with later \fBscan dragto\fR commands. Typically this command is associated with a mouse button press in the widget and \fIx\fR and \fIy\fR are the coordinates of the -mouse. It returns an empty string. +mouse. It returns an empty string. .TP -\fIpathName \fBscan dragto \fIx y ?gain?\fR. +\fIpathName \fBscan dragto \fIx y ?gain?\fR +. This command computes the difference between its \fIx\fR and \fIy\fR arguments (which are typically mouse coordinates) and the \fIx\fR and \fIy\fR arguments to the last \fBscan mark\fR command for the widget. @@ -887,16 +992,17 @@ It then adjusts the view by \fIgain\fR times the difference in coordinates, where \fIgain\fR defaults to 10. This command is typically associated with mouse motion events in the widget, to produce the effect of -dragging the canvas at high speed through its window. The return +dragging the canvas at high speed through its window. The return value is an empty string. .RE .TP \fIpathName \fBselect \fIoption\fR ?\fItagOrId arg\fR? +. Manipulates the selection in one of several ways, depending on \fIoption\fR. The command may take any of the forms described below. In all of the descriptions below, \fItagOrId\fR must refer to -an item that supports indexing and selection; if it refers to +an item that supports indexing and selection; if it refers to multiple items then the first of these that supports indexing and the selection is used. \fIIndex\fR gives a textual description of a position @@ -904,6 +1010,7 @@ within \fItagOrId\fR, as described in \fBINDICES\fR above. .RS .TP \fIpathName \fBselect adjust \fItagOrId index\fR +. Locate the end of the selection in \fItagOrId\fR nearest to the character given by \fIindex\fR, and adjust that end of the selection to be at \fIindex\fR (i.e. including @@ -916,27 +1023,31 @@ command. Returns an empty string. .TP \fIpathName \fBselect clear\fR +. Clear the selection if it is in this widget. If the selection is not in this widget then the command has no effect. Returns an empty string. .TP \fIpathName \fBselect from \fItagOrId index\fR +. Set the selection anchor point for the widget to be just before the character given by \fIindex\fR in the item given by \fItagOrId\fR. -This command does not change the selection; it just sets +This command does not change the selection; it just sets the fixed end of the selection for future \fBselect to\fR commands. Returns an empty string. .TP \fIpathName \fBselect item\fR +. Returns the id of the selected item, if the selection is in an item in this canvas. If the selection is not in this canvas then an empty string is returned. .TP \fIpathName \fBselect to \fItagOrId index\fR +. Set the selection to consist of those characters of \fItagOrId\fR between the selection anchor point and \fIindex\fR. @@ -952,6 +1063,7 @@ Returns an empty string. .RE .TP \fIpathName \fBtype\fI tagOrId\fR +. Returns the type of the item given by \fItagOrId\fR, such as \fBrectangle\fR or \fBtext\fR. If \fItagOrId\fR refers to more than one item, then the type @@ -959,15 +1071,17 @@ of the first item in the display list is returned. If \fItagOrId\fR does not refer to any items at all then an empty string is returned. .TP -\fIpathName \fBxview \fR?\fIargs\fR? +\fIpathName \fBxview \fR?\fIargs\fR? +. This command is used to query and change the horizontal position of the information displayed in the canvas's window. It can take any of the following forms: .RS .TP \fIpathName \fBxview\fR +. Returns a list containing two elements. -Each element is a real fraction between 0 and 1; together they describe +Each element is a real fraction between 0 and 1; together they describe the horizontal span that is visible in the window. For example, if the first element is .2 and the second element is .6, 20% of the canvas's area (as defined by the \fB\-scrollregion\fR option) @@ -977,11 +1091,13 @@ These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR option. .TP \fIpathName \fBxview moveto\fI fraction\fR +. Adjusts the view in the window so that \fIfraction\fR of the total width of the canvas is off-screen to the left. \fIFraction\fR must be a fraction between 0 and 1. .TP \fIpathName \fBxview scroll \fInumber what\fR +. This command shifts the view in the window left or right according to \fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer. @@ -993,19 +1109,21 @@ or in units of one-tenth the window's width otherwise. If \fIwhat is \fBpages\fR then the view adjusts in units of nine-tenths the window's width. If \fInumber\fR is negative then information farther to the left -becomes visible; if it is positive then information farther to the right +becomes visible; if it is positive then information farther to the right becomes visible. .RE .TP \fIpathName \fByview \fI?args\fR? +. This command is used to query and change the vertical position of the information displayed in the canvas's window. It can take any of the following forms: .RS .TP \fIpathName \fByview\fR +. Returns a list containing two elements. -Each element is a real fraction between 0 and 1; together they describe +Each element is a real fraction between 0 and 1; together they describe the vertical span that is visible in the window. For example, if the first element is .6 and the second element is 1.0, the lowest 40% of the canvas's area (as defined by the \fB\-scrollregion\fR @@ -1014,11 +1132,13 @@ These are the same values passed to scrollbars via the \fB\-yscrollcommand\fR option. .TP \fIpathName \fByview moveto\fI fraction\fR +. Adjusts the view in the window so that \fIfraction\fR of the canvas's area is off-screen to the top. \fIFraction\fR is a fraction between 0 and 1. .TP \fIpathName \fByview scroll \fInumber what\fR +. This command adjusts the view in the window up or down according to \fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer. @@ -1029,15 +1149,15 @@ or in units of one-tenth the window's height otherwise. If \fIwhat\fR is \fBpages\fR then the view adjusts in units of nine-tenths the window's height. If \fInumber\fR is negative then higher information becomes -visible; if it is positive then lower information +visible; if it is positive then lower information becomes visible. .RE .SH "OVERVIEW OF ITEM TYPES" .PP The sections below describe the various types of items supported -by canvas widgets. Each item type is characterized by two things: +by canvas widgets. Each item type is characterized by two things: first, the form of the \fBcreate\fR command used to create -instances of the type; and second, a set of configuration options +instances of the type; and second, a set of configuration options for items of that type, which may be used in the \fBcreate\fR and \fBitemconfigure\fR widget commands. Most items do not support indexing or selection or the commands @@ -1049,15 +1169,25 @@ For lines and polygons the indexing facility is used to manipulate the coordinates of the item. .SS "COMMON ITEM OPTIONS" .PP -Many items share a common set of options. These options are +Many items share a common set of options. These options are explained here, and then referred to be each widget type for brevity. -.PP +.TP +\fB\-anchor \fIanchorPos\fR +. +\fIAnchorPos\fR tells how to position the item relative to the +positioning point for the item; it may have any of the forms +accepted by \fBTk_GetAnchor\fR. For example, if \fIanchorPos\fR +is \fBcenter\fR then the item is centered on the point; if +\fIanchorPos\fR is \fBn\fR then the item will be drawn so that +its top center point is at the positioning point. +This option defaults to \fBcenter\fR. .TP \fB\-dash \fIpattern\fR .TP \fB\-activedash \fIpattern\fR .TP \fB\-disableddash \fIpattern\fR +. This option specifies dash patterns for the normal, active state, and disabled state of an item. \fIpattern\fR may have any of the forms accepted by \fBTk_GetDash\fR. @@ -1065,9 +1195,10 @@ If the dash options are omitted then the default is a solid outline. See \fBDASH PATTERNS\fR for more information. .TP \fB\-dashoffset \fIoffset\fR +. The starting \fIoffset\fR in pixels into the pattern provided by the -\fB\-dash\fR option. \fB\-dashoffset\fR is ignored if there is no -\fB\-dash\fR pattern. The \fIoffset\fR may have any of the forms described +\fB\-dash\fR option. \fB\-dashoffset\fR is ignored if there is no +\fB\-dash\fR pattern. The \fIoffset\fR may have any of the forms described in the \fBCOORDINATES\fR section above. .TP \fB\-fill \fIcolor\fR @@ -1075,6 +1206,7 @@ in the \fBCOORDINATES\fR section above. \fB\-activefill \fIcolor\fR .TP \fB\-disabledfill \fIcolor\fR +. Specifies the color to be used to fill item's area. in its normal, active, and disabled states, \fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR. @@ -1088,29 +1220,33 @@ For the text item, it specifies the foreground color of the text. \fB\-activeoutline \fIcolor\fR .TP \fB\-disabledoutline \fIcolor\fR +. This option specifies the color that should be used to draw the outline of the item in its normal, active and disabled states. \fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR. -This option defaults to \fBblack\fR. If \fIcolor\fR is specified +This option defaults to \fBblack\fR. If \fIcolor\fR is specified as an empty string then no outline is drawn for the item. .TP \fB\-offset \fIoffset\fR -Specifies the offset of stipples. The offset value can be of the form -\fBx,y\fR or \fBside\fR, where side can be \fBn\fR, \fBne\fR, \fBe\fR, +. +Specifies the offset of stipples. The offset value can be of the form +\fBx,y\fR or \fIside\fR, where side can be \fBn\fR, \fBne\fR, \fBe\fR, \fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR. In the first case the origin is the origin of the toplevel of the current window. For the canvas itself and canvas objects the origin is the canvas origin, but putting \fB#\fR in front of the coordinate pair indicates using the toplevel origin instead. For canvas objects, the \fB\-offset\fR option is -used for stippling as well. For the line and polygon canvas items you can +used for stippling as well. For the line and polygon canvas items you can also specify an index as argument, which connects the stipple origin to one -of the coordinate points of the line/polygon. +of the coordinate points of the line/polygon. Note that stipple offsets are +\fIonly supported on X11\fR; they are silently ignored on other platforms. .TP \fB\-outlinestipple \fIbitmap\fR .TP \fB\-activeoutlinestipple \fIbitmap\fR .TP \fB\-disabledoutlinestipple \fIbitmap\fR +. This option specifies stipple patterns that should be used to draw the outline of the item in its normal, active and disabled states. Indicates that the outline for the item should be drawn with a stipple pattern; @@ -1125,20 +1261,16 @@ use X11 as their drawing API.\fR .TP \fB\-outlineoffset \fIoffset\fR . -Specifies the offset of the stipple pattern used for outlines. The -offset value can be of the form -.QW \fIx\fB,\fIy\fR -or the description of a side (one of \fBn\fR, \fBne\fR, \fBe\fR, -\fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR). This -option only has an effect when the outline is drawn as a stipple -pattern, and is only supported under X11. -.\" TODO: What does this actually do? What do the acceptable forms mean?! +Specifies the offset of the stipple pattern used for outlines, in the same way +that the \fB\-outline\fR option controls fill stipples. (See the +\fB\-outline\fR option for a description of the syntax of \fIoffset\fR.) .TP \fB\-stipple \fIbitmap\fR .TP \fB\-activestipple \fIbitmap\fR .TP \fB\-disabledstipple \fIbitmap\fR +. This option specifies stipple patterns that should be used to fill the item in its normal, active and disabled states. \fIbitmap\fR specifies the stipple pattern to use, in any of the @@ -1152,29 +1284,33 @@ For the text item, it affects the actual text. use X11 as their drawing API.\fR .TP \fB\-state \fIstate\fR +. This allows an item to override the canvas widget's global \fIstate\fR -option. It takes the same values: +option. It takes the same values: \fInormal\fR, \fIdisabled\fR or \fIhidden\fR. .TP \fB\-tags \fItagList\fR +. Specifies a set of tags to apply to the item. \fITagList\fR consists of a list of tag names, which replace any -existing tags for the item. \fITagList\fR may be an empty list. +existing tags for the item. \fITagList\fR may be an empty list. .TP \fB\-width \fIoutlineWidth\fR .TP \fB\-activewidth \fIoutlineWidth\fR .TP \fB\-disabledwidth \fIoutlineWidth\fR +. Specifies the width of the outline to be drawn around the item's region, in its normal, active and disabled states. \fIoutlineWidth\fR may be in any of the forms described in the \fBCOORDINATES\fR section above. If the \fB\-outline\fR option has been specified as an empty string then -this option has no effect. This option defaults to 1.0. +this option has no effect. This option defaults to 1.0. For arcs, wide outlines will be drawn centered on the edges of the arc's region. -.SH "ARC ITEMS" +.SH "STANDARD ITEM TYPES" +.SS "ARC ITEMS" .PP Items of type \fBarc\fR appear on the display as arc-shaped regions. An arc is a section of an oval delimited by two angles (specified @@ -1182,46 +1318,36 @@ by the \fB\-start\fR and \fB\-extent\fR options) and displayed in one of several ways (specified by the \fB\-style\fR option). Arcs are created with widget commands of the following form: .CS -\fIpathName \fBcreate arc \fIx1 y1 x2 y2 \fR?\fIoption value option value ...\fR? -\fIpathName \fBcreate arc \fIcoordList\fR ?\fIoption value option value ...\fR? +\fIpathName \fBcreate arc \fIx1 y1 x2 y2 \fR?\fIoption value ...\fR? +\fIpathName \fBcreate arc \fIcoordList\fR ?\fIoption value ...\fR? .CE The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR or \fIcoordList\fR give the coordinates of two diagonally opposite corners of a rectangular region enclosing the oval that defines the arc. After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR pairs, each of which sets one of the configuration options -for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be +for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be used in \fBitemconfigure\fR widget commands to change the item's configuration. An arc item becomes the current item when the mouse pointer is over any part that is painted or (when fully transparent) that would be painted if both the \fB\-fill\fR and \fB\-outline\fR options were non-empty. .PP The following standard options are supported by arcs: -.CS -\-dash -\-activedash -\-disableddash -\-dashoffset -\-fill -\-activefill -\-disabledfill -\-offset -\-outline -\-activeoutline -\-disabledoutline -\-outlineoffset -\-outlinestipple -\-activeoutlinestipple -\-disabledoutlinestipple -\-stipple -\-activestipple -\-disabledstipple -\-state -\-tags -\-width -\-activewidth -\-disabledwidth -.CE +.DS +.ta 3i +\fB\-dash\fR \fB\-activedash\fR +\fB\-disableddash\fR \fB\-dashoffset\fR +\fB\-fill\fR \fB\-activefill\fR +\fB\-disabledfill\fR \fB\-offset\fR +\fB\-outline\fR \fB\-activeoutline\fR +\fB\-disabledoutline\fR \fB\-outlineoffset\fR +\fB\-outlinestipple\fR \fB\-activeoutlinestipple\fR +\fB\-disabledoutlinestipple\fR \fB\-stipple\fR +\fB\-activestipple\fR \fB\-disabledstipple\fR +\fB\-state\fR \fB\-tags\fR +\fB\-width\fR \fB\-activewidth\fR +\fB\-disabledwidth\fR +.DE The following extra options are supported for arcs: .TP \fB\-extent \fIdegrees\fR @@ -1236,10 +1362,10 @@ modulo 360 is used as the extent. Specifies the beginning of the angular range occupied by the arc. \fIDegrees\fR is given in units of degrees measured counter-clockwise -from the 3-o'clock position; it may be either positive or negative. +from the 3-o'clock position; it may be either positive or negative. .TP \fB\-style \fItype\fR -Specifies how to draw the arc. If \fItype\fR is \fBpieslice\fR +Specifies how to draw the arc. If \fItype\fR is \fBpieslice\fR (the default) then the arc's region is defined by a section of the oval's perimeter plus two line segments, one between the center of the oval and each end of the perimeter section. @@ -1249,42 +1375,34 @@ connecting the two end points of the perimeter section. If \fItype\fR is \fBarc\fR then the arc's region consists of a section of the perimeter alone. In this last case the \fB\-fill\fR option is ignored. -.SH "BITMAP ITEMS" +.SS "BITMAP ITEMS" .PP Items of type \fBbitmap\fR appear on the display as images with two colors, foreground and background. Bitmaps are created with widget commands of the following form: .CS -\fIpathName \fBcreate bitmap \fIx y \fR?\fIoption value option value ...\fR? -\fIpathName \fBcreate bitmap \fIcoordList\fR ?\fIoption value option value ...\fR? +\fIpathName \fBcreate bitmap \fIx y \fR?\fIoption value ...\fR? +\fIpathName \fBcreate bitmap \fIcoordList\fR ?\fIoption value ...\fR? .CE The arguments \fIx\fR and \fIy\fR or \fIcoordList\fR (which must have two elements) specify the coordinates of a -point used to position the bitmap on the display (see the \fB\-anchor\fR -option below for more information on how bitmaps are displayed). +point used to position the bitmap on the display, as controlled by the +\fB\-anchor\fR option. After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR pairs, each of which sets one of the configuration options -for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be +for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be used in \fBitemconfigure\fR widget commands to change the item's configuration. A bitmap item becomes the current item when the mouse pointer is over any part of its bounding box. .PP The following standard options are supported by bitmaps: -.CS -\-state -\-tags -.CE +.DS +.ta 3i +\fB\-anchor\fR \fB\-state\fR +\fB\-tags\fR +.DE The following extra options are supported for bitmaps: .TP -\fB\-anchor \fIanchorPos\fR -\fIAnchorPos\fR tells how to position the bitmap relative to the -positioning point for the item; it may have any of the forms -accepted by \fBTk_GetAnchor\fR. For example, if \fIanchorPos\fR -is \fBcenter\fR then the bitmap is centered on the point; if -\fIanchorPos\fR is \fBn\fR then the bitmap will be drawn so that -its top center point is at the positioning point. -This option defaults to \fBcenter\fR. -.TP \fB\-background \fIcolor\fR .TP \fB\-activebackground \fIcolor\fR @@ -1295,7 +1413,7 @@ Specifies the color to use for each of the bitmap's valued pixels in its normal, active and disabled states. \fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR. If this option is not specified, or if it is specified as an empty -string, then nothing is displayed where the bitmap pixels are 0; this +string, then nothing is displayed where the bitmap pixels are 0; this produces a transparent effect. .TP \fB\-bitmap \fIbitmap\fR @@ -1317,41 +1435,33 @@ Specifies the color to use for each of the bitmap's valued pixels in its normal, active and disabled states. \fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR and defaults to \fBblack\fR. -.SH "IMAGE ITEMS" +.SS "IMAGE ITEMS" .PP Items of type \fBimage\fR are used to display images on a canvas. Images are created with widget commands of the following form: .CS -\fIpathName \fBcreate image \fIx y \fR?\fIoption value option value ...\fR? -\fIpathName \fBcreate image \fIcoordList\fR ?\fIoption value option value ...\fR? +\fIpathName \fBcreate image \fIx y \fR?\fIoption value ...\fR? +\fIpathName \fBcreate image \fIcoordList\fR ?\fIoption value ...\fR? .CE The arguments \fIx\fR and \fIy\fR or \fIcoordList\fR specify the coordinates of a -point used to position the image on the display (see the \fB\-anchor\fR -option below for more information). +point used to position the image on the display, as controlled by the +\fB\-anchor\fR option. After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR pairs, each of which sets one of the configuration options -for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be +for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be used in \fBitemconfigure\fR widget commands to change the item's configuration. An image item becomes the current item when the mouse pointer is over any part of its bounding box. .PP The following standard options are supported by images: -.CS -\-state -\-tags -.CE +.DS +.ta 3i +\fB\-anchor\fR \fB\-state\fR +\fB\-tags\fR +.DE The following extra options are supported for images: .TP -\fB\-anchor \fIanchorPos\fR -\fIAnchorPos\fR tells how to position the image relative to the -positioning point for the item; it may have any of the forms -accepted by \fBTk_GetAnchor\fR. For example, if \fIanchorPos\fR -is \fBcenter\fR then the image is centered on the point; if -\fIanchorPos\fR is \fBn\fR then the image will be drawn so that -its top center point is at the positioning point. -This option defaults to \fBcenter\fR. -.TP \fB\-image \fIname\fR .TP \fB\-activeimage \fIname\fR @@ -1361,46 +1471,40 @@ Specifies the name of the images to display in the item in is normal, active and disabled states. This image must have been created previously with the \fBimage create\fR command. -.SH "LINE ITEMS" +.SS "LINE ITEMS" .PP Items of type \fBline\fR appear on the display as one or more connected line segments or curves. -Line items support coordinate indexing operations using the canvas -widget commands: \fBdchars, index, insert.\fR +Line items support coordinate indexing operations using the \fBdchars\fR, +\fBindex\fR and \fBinsert\fR widget commands. Lines are created with widget commands of the following form: .CS -\fIpathName \fBcreate line \fIx1 y1... xn yn \fR?\fIoption value option value ...\fR? -\fIpathName \fBcreate line \fIcoordList\fR ?\fIoption value option value ...\fR? +\fIpathName \fBcreate line \fIx1 y1... xn yn \fR?\fIoption value ...\fR? +\fIpathName \fBcreate line \fIcoordList\fR ?\fIoption value ...\fR? .CE The arguments \fIx1\fR through \fIyn\fR or \fIcoordList\fR give the coordinates for a series of two or more points that describe a series of connected line segments. After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR pairs, each of which sets one of the configuration options -for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be +for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be used in \fBitemconfigure\fR widget commands to change the item's configuration. A line item is the current item whenever the mouse pointer is over any segment of the line, whether drawn or not and whether or not the line is smoothed. .PP The following standard options are supported by lines: -.CS -\-dash -\-activedash -\-disableddash -\-dashoffset -\-fill -\-activefill -\-disabledfill -\-stipple -\-activestipple -\-disabledstipple -\-state -\-tags -\-width -\-activewidth -\-disabledwidth -.CE +.DS +.ta 3i +\fB\-dash\fR \fB\-activedash\fR +\fB\-disableddash\fR \fB\-dashoffset\fR +\fB\-fill\fR \fB\-activefill\fR +\fB\-disabledfill\fR \fB\-stipple\fR +\fB\-activestipple\fR \fB\-disabledstipple\fR +\fB\-state\fR \fB\-tags\fR +\fB\-width\fR \fB\-activewidth\fR +\fB\-disabledwidth\fR +.DE The following extra options are supported for lines: .TP \fB\-arrow \fIwhere\fR @@ -1438,7 +1542,7 @@ Where arrowheads are drawn the cap style is ignored. \fB\-joinstyle \fIstyle\fR Specifies the ways in which joints are to be drawn at the vertices of the line. -\fIStyle\fR may have any of the forms accepted by \fBTk_GetCapStyle\fR +\fIStyle\fR may have any of the forms accepted by \fBTk_GetJoinStyle\fR (\fBbevel\fR, \fBmiter\fR, or \fBround\fR). If this option is not specified then it defaults to \fBround\fR. If the line only contains two points then this option is @@ -1447,40 +1551,38 @@ irrelevant. \fB\-smooth \fIsmoothMethod\fR \fIsmoothMethod\fR must have one of the forms accepted by \fBTcl_GetBoolean\fR or a line smoothing method. -.VS 8.5 Only \fBtrue\fR and \fBraw\fR are -supported in the core (with \fBbezier\fR being an alias for \fBtrue\fR), but more can be added at runtime. If a boolean -false value or empty string is given, no smoothing is applied. A boolean +supported in the core (with \fBbezier\fR being an alias for \fBtrue\fR), but more can be added at runtime. If a boolean +false value or empty string is given, no smoothing is applied. A boolean truth value assumes \fBtrue\fR smoothing. If the smoothing method is \fBtrue\fR, this indicates that the line should be drawn as a curve, rendered as a set of quadratic splines: one spline is drawn for the first and second line segments, one for the second -and third, and so on. Straight-line segments can be generated within +and third, and so on. Straight-line segments can be generated within a curve by duplicating the end-points of the desired line segment. If the smoothing method is \fBraw\fR, this indicates that the line should also be drawn as a curve but where the list of coordinates is such that the first coordinate pair (and every third coordinate pair thereafter) is a knot point on a cubic Bezier curve, and the other -coordinates are control points on the cubic Bezier curve. Straight +coordinates are control points on the cubic Bezier curve. Straight line segments can be generated within a curve by making control points -equal to their neighbouring knot points. If the last point is a +equal to their neighbouring knot points. If the last point is a control point and not a knot point, the point is repeated (one or two times) so that it also becomes a knot point. -.VE 8.5 .TP \fB\-splinesteps \fInumber\fR -Specifies the degree of smoothness desired for curves: each spline -will be approximated with \fInumber\fR line segments. This +Specifies the degree of smoothness desired for curves: each spline +will be approximated with \fInumber\fR line segments. This option is ignored unless the \fB\-smooth\fR option is true or \fBraw\fR. -.SH "OVAL ITEMS" +.SS "OVAL ITEMS" .PP Items of type \fBoval\fR appear as circular or oval regions on -the display. Each oval may have an outline, a fill, or -both. Ovals are created with widget commands of the +the display. Each oval may have an outline, a fill, or +both. Ovals are created with widget commands of the following form: .CS -\fIpathName \fBcreate oval \fIx1 y1 x2 y2 \fR?\fIoption value option value ...\fR? -\fIpathName \fBcreate oval \fIcoordList\fR ?\fIoption value option value ...\fR? +\fIpathName \fBcreate oval \fIx1 y1 x2 y2 \fR?\fIoption value ...\fR? +\fIpathName \fBcreate oval \fIcoordList\fR ?\fIoption value ...\fR? .CE The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR or \fIcoordList\fR give the coordinates of two diagonally opposite corners of a @@ -1491,48 +1593,39 @@ If the region is square then the resulting oval is circular; otherwise it is elongated in shape. After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR pairs, each of which sets one of the configuration options -for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be +for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be used in \fBitemconfigure\fR widget commands to change the item's configuration. An oval item becomes the current item when the mouse pointer is over any part that is painted or (when fully transparent) that would be painted if both the \fB\-fill\fR and \fB\-outline\fR options were non-empty. .PP The following standard options are supported by ovals: -.CS -\-dash -\-activedash -\-disableddash -\-dashoffset -\-fill -\-activefill -\-disabledfill -\-offset -\-outline -\-activeoutline -\-disabledoutline -\-outlineoffset -\-outlinestipple -\-activeoutlinestipple -\-disabledoutlinestipple -\-stipple -\-activestipple -\-disabledstipple -\-state -\-tags -\-width -\-activewidth -\-disabledwidth -.CE -.SH "POLYGON ITEMS" +.DS +.ta 3i +\fB\-dash\fR \fB\-activedash\fR +\fB\-disableddash\fR \fB\-dashoffset\fR +\fB\-fill\fR \fB\-activefill\fR +\fB\-disabledfill\fR \fB\-offset\fR +\fB\-outline\fR \fB\-activeoutline\fR +\fB\-disabledoutline\fR \fB\-outlineoffset\fR +\fB\-outlinestipple\fR \fB\-activeoutlinestipple\fR +\fB\-disabledoutlinestipple\fR \fB\-stipple\fR +\fB\-activestipple\fR \fB\-disabledstipple\fR +\fB\-state\fR \fB\-tags\fR +\fB\-width\fR \fB\-activewidth\fR +\fB\-disabledwidth\fR +.DE +There are no oval-specific options. +.SS "POLYGON ITEMS" .PP Items of type \fBpolygon\fR appear as polygonal or curved filled regions on the display. -Polygon items support coordinate indexing operations using the canvas -widget commands: \fBdchars, index, insert.\fR +Polygon items support coordinate indexing operations using the \fBdchars\fR, +\fBindex\fR and \fBinsert\fR widget commands. Polygons are created with widget commands of the following form: .CS -\fIpathName \fBcreate polygon \fIx1 y1 ... xn yn \fR?\fIoption value option value ...\fR? -\fIpathName \fBcreate polygon \fIcoordList\fR ?\fIoption value option value ...\fR? +\fIpathName \fBcreate polygon \fIx1 y1 ... xn yn \fR?\fIoption value ...\fR? +\fIpathName \fBcreate polygon \fIcoordList\fR ?\fIoption value ...\fR? .CE The arguments \fIx1\fR through \fIyn\fR or \fIcoordList\fR specify the coordinates for three or more points that define a polygon. @@ -1541,73 +1634,62 @@ close the shape; Tk will automatically close the periphery between the first and last points. After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR pairs, each of which sets one of the configuration options -for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be +for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be used in \fBitemconfigure\fR widget commands to change the item's configuration. A polygon item is the current item whenever the mouse pointer is over any part of the polygon, whether drawn or not and whether or not the outline is smoothed. .PP The following standard options are supported by polygons: -.CS -\-dash -\-activedash -\-disableddash -\-dashoffset -\-fill -\-activefill -\-disabledfill -\-offset -\-outline -\-activeoutline -\-disabledoutline -\-outlinestipple -\-activeoutlinestipple -\-disabledoutlinestipple -\-stipple -\-activestipple -\-disabledstipple -\-state -\-tags -\-width -\-activewidth -\-disabledwidth -.CE +.DS +.ta 3i +\fB\-dash\fR \fB\-activedash\fR +\fB\-disableddash\fR \fB\-dashoffset\fR +\fB\-fill\fR \fB\-activefill\fR +\fB\-disabledfill\fR \fB\-offset\fR +\fB\-outline\fR \fB\-activeoutline\fR +\fB\-disabledoutline\fR \fB\-outlineoffset\fR +\fB\-outlinestipple\fR \fB\-activeoutlinestipple\fR +\fB\-disabledoutlinestipple\fR \fB\-stipple\fR +\fB\-activestipple\fR \fB\-disabledstipple\fR +\fB\-state\fR \fB\-tags\fR +\fB\-width\fR \fB\-activewidth\fR +\fB\-disabledwidth\fR +.DE The following extra options are supported for polygons: .TP \fB\-joinstyle \fIstyle\fR Specifies the ways in which joints are to be drawn at the vertices of the outline. -\fIStyle\fR may have any of the forms accepted by \fBTk_GetCapStyle\fR +\fIStyle\fR may have any of the forms accepted by \fBTk_GetJoinStyle\fR (\fBbevel\fR, \fBmiter\fR, or \fBround\fR). If this option is not specified then it defaults to \fBround\fR. .TP \fB\-smooth \fIboolean\fR \fIBoolean\fR must have one of the forms accepted by \fBTcl_GetBoolean\fR -.VS 8.5 or a line smoothing method. Only \fBtrue\fR and \fBraw\fR are -supported in the core (with \fBbezier\fR being an alias for \fBtrue\fR), but more can be added at runtime. If a boolean -false value or empty string is given, no smoothing is applied. A boolean +supported in the core (with \fBbezier\fR being an alias for \fBtrue\fR), but more can be added at runtime. If a boolean +false value or empty string is given, no smoothing is applied. A boolean truth value assumes \fBtrue\fR smoothing. If the smoothing method is \fBtrue\fR, this indicates that the polygon should be drawn as a curve, rendered as a set of quadratic splines: one spline is drawn for the first and second line segments, one for the second -and third, and so on. Straight-line segments can be generated within +and third, and so on. Straight-line segments can be generated within a curve by duplicating the end-points of the desired line segment. If the smoothing method is \fBraw\fR, this indicates that the polygon should also be drawn as a curve but where the list of coordinates is such that the first coordinate pair (and every third coordinate pair thereafter) is a knot point on a cubic Bezier curve, and the other -coordinates are control points on the cubic Bezier curve. Straight +coordinates are control points on the cubic Bezier curve. Straight line segments can be venerated within a curve by making control points -equal to their neighbouring knot points. If the last point is not the +equal to their neighbouring knot points. If the last point is not the second point of a pair of control points, the point is repeated (one or two times) so that it also becomes the second point of a pair of control points (the associated knot point will be the first control point). -.VE 8.5 .TP \fB\-splinesteps \fInumber\fR -Specifies the degree of smoothness desired for curves: each spline -will be approximated with \fInumber\fR line segments. This +Specifies the degree of smoothness desired for curves: each spline +will be approximated with \fInumber\fR line segments. This option is ignored unless the \fB\-smooth\fR option is true or \fBraw\fR. .PP Polygon items are different from other items such as rectangles, ovals @@ -1617,18 +1699,18 @@ a polygon (e.g. for purposes of the \fBfind closest\fR and \fBfind overlapping\fR widget commands) even if it is not filled. For most other item types, an interior point is considered to be inside the item only if the item -is filled or if it has neither a fill nor an outline. If you would +is filled or if it has neither a fill nor an outline. If you would like an unfilled polygon whose interior points are not considered to be inside the polygon, use a line item instead. -.SH "RECTANGLE ITEMS" +.SS "RECTANGLE ITEMS" .PP Items of type \fBrectangle\fR appear as rectangular regions on -the display. Each rectangle may have an outline, a fill, or -both. Rectangles are created with widget commands of the +the display. Each rectangle may have an outline, a fill, or +both. Rectangles are created with widget commands of the following form: .CS -\fIpathName \fBcreate rectangle \fIx1 y1 x2 y2 \fR?\fIoption value option value ...\fR? -\fIpathName \fBcreate rectangle \fIcoordList\fR ?\fIoption value option value ...\fR? +\fIpathName \fBcreate rectangle \fIx1 y1 x2 y2 \fR?\fIoption value ...\fR? +\fIpathName \fBcreate rectangle \fIcoordList\fR ?\fIoption value ...\fR? .CE The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR or \fIcoordList\fR (which must have four elements) give @@ -1637,7 +1719,7 @@ the coordinates of two diagonally opposite corners of the rectangle its lower or right edges). After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR pairs, each of which sets one of the configuration options -for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be +for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be used in \fBitemconfigure\fR widget commands to change the item's configuration. A rectangle item becomes the current item when the mouse pointer is over any part that is painted or (when fully transparent) that @@ -1645,44 +1727,35 @@ would be painted if both the \fB\-fill\fR and \fB\-outline\fR options were non-empty. .PP The following standard options are supported by rectangles: -.CS -\-dash -\-activedash -\-disableddash -\-dashoffset -\-fill -\-activefill -\-disabledfill -\-offset -\-outline -\-activeoutline -\-disabledoutline -\-outlineoffset -\-outlinestipple -\-activeoutlinestipple -\-disabledoutlinestipple -\-stipple -\-activestipple -\-disabledstipple -\-state -\-tags -\-width -\-activewidth -\-disabledwidth -.CE -.SH "TEXT ITEMS" +.DS +.ta 3i +\fB\-dash\fR \fB\-activedash\fR +\fB\-disableddash\fR \fB\-dashoffset\fR +\fB\-fill\fR \fB\-activefill\fR +\fB\-disabledfill\fR \fB\-offset\fR +\fB\-outline\fR \fB\-activeoutline\fR +\fB\-disabledoutline\fR \fB\-outlineoffset\fR +\fB\-outlinestipple\fR \fB\-activeoutlinestipple\fR +\fB\-disabledoutlinestipple\fR \fB\-stipple\fR +\fB\-activestipple\fR \fB\-disabledstipple\fR +\fB\-state\fR \fB\-tags\fR +\fB\-width\fR \fB\-activewidth\fR +\fB\-disabledwidth\fR +.DE +There are no rectangle-specific options. +.SS "TEXT ITEMS" .PP A text item displays a string of characters on the screen in one or more lines. -Text items support indexing and selection, along with the -following text-related canvas widget commands: \fBdchars\fR, -\fBfocus\fR, \fBicursor\fR, \fBindex\fR, \fBinsert\fR, -\fBselect\fR. +Text items support indexing, editing and selection through the \fBdchars\fR +widget command, the \fBfocus\fR widget command, the \fBicursor\fR widget +command, the \fBindex\fR widget command, the \fBinsert\fR widget command, and +the \fBselect\fR widget command. Text items are created with widget commands of the following form: .CS -\fIpathName \fBcreate text \fIx y \fR?\fIoption value option value ...\fR? -\fIpathName \fBcreate text \fIcoordList\fR ?\fIoption value option value ...\fR? +\fIpathName \fBcreate text \fIx y \fR?\fIoption value ...\fR? +\fIpathName \fBcreate text \fIcoordList\fR ?\fIoption value ...\fR? .CE The arguments \fIx\fR and \fIy\fR or \fIcoordList\fR (which must have two elements) specify the coordinates of a @@ -1690,33 +1763,30 @@ point used to position the text on the display (see the options below for more information on how text is displayed). After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR pairs, each of which sets one of the configuration options -for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be +for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be used in \fBitemconfigure\fR widget commands to change the item's configuration. A text item becomes the current item when the mouse pointer is over any part of its bounding box. .PP The following standard options are supported by text items: -.CS -\-fill -\-activefill -\-disabledfill -\-stipple -\-activestipple -\-disabledstipple -\-state -\-tags -.CE +.DS +.ta 3i +\fB\-anchor\fR \fB\-fill\fR +\fB\-activefill\fR \fB\-disabledfill\fR +\fB\-stipple\fR \fB\-activestipple\fR +\fB\-disabledstipple\fR \fB\-state\fR +\fB\-tags\fR +.DE The following extra options are supported for text items: .TP -\fB\-anchor \fIanchorPos\fR -\fIAnchorPos\fR tells how to position the text relative to the -positioning point for the text; it may have any of the forms -accepted by \fBTk_GetAnchor\fR. For example, if \fIanchorPos\fR -is \fBcenter\fR then the text is centered on the point; if -\fIanchorPos\fR is \fBn\fR then the text will be drawn such that -the top center point of the rectangular region occupied by the -text will be at the positioning point. -This option defaults to \fBcenter\fR. +\fB\-angle \fIrotationDegrees\fR +.VS 8.6 +\fIRotationDegrees\fR tells how many degrees to rotate the text anticlockwise +about the positioning point for the text; it may have any floating-point value +from 0.0 to 360.0. For example, if \fIrotationDegrees\fR is \fB90\fR, then the +text will be drawn vertically from bottom to top. +This option defaults to \fB0.0\fR. +.VE 8.6 .TP \fB\-font \fIfontName\fR Specifies the font to use for the text item. @@ -1738,7 +1808,6 @@ Newline characters cause line breaks. The characters in the item may also be changed with the \fBinsert\fR and \fBdelete\fR widget commands. This option defaults to an empty string. -.VS 8.5 .TP \fB\-underline \fI\fR Specifies the integer index of a character within the text to be @@ -1746,7 +1815,6 @@ underlined. 0 corresponds to the first character of the text displayed, 1 to the next character, and so on. \-1 means that no underline should be drawn (if the whole text item is to be underlined, the appropriate font should be used instead). -.VE 8.5 .TP \fB\-width \fIlineLength\fR Specifies a maximum line length for the text, in any of the forms @@ -1755,25 +1823,25 @@ If this option is zero (the default) the text is broken into lines only at newline characters. However, if this option is non-zero then any line that would be longer than \fIlineLength\fR is broken just before a space -character to make the line shorter than \fIlineLength\fR; the +character to make the line shorter than \fIlineLength\fR; the space character is treated as if it were a newline character. -.SH "WINDOW ITEMS" +.SS "WINDOW ITEMS" .PP Items of type \fBwindow\fR cause a particular window to be displayed at a given position on the canvas. Window items are created with widget commands of the following form: .CS -\fIpathName \fBcreate window \fIx y \fR?\fIoption value option value ...\fR? -\fIpathName \fBcreate window \fIcoordList\fR ?\fIoption value option value ...\fR? +\fIpathName \fBcreate window \fIx y \fR?\fIoption value ...\fR? +\fIpathName \fBcreate window \fIcoordList\fR ?\fIoption value ...\fR? .CE The arguments \fIx\fR and \fIy\fR or \fIcoordList\fR (which must have two elements) specify the coordinates of a -point used to position the window on the display (see the \fB\-anchor\fR -option below for more information on how bitmaps are displayed). +point used to position the window on the display, as controlled by the +\fB\-anchor\fR option. After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR pairs, each of which sets one of the configuration options -for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be +for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be used in \fBitemconfigure\fR widget commands to change the item's configuration. Theoretically, a window item becomes the current item when the mouse pointer is over any part of its bounding box, but in practice this @@ -1781,22 +1849,13 @@ typically does not happen because the mouse pointer ceases to be over the canvas at that point. .PP The following standard options are supported by window items: -.CS -\-state -\-tags -.CE +.DS +.ta 3i +\fB\-anchor\fR \fB\-state\fR +\fB\-tags\fR +.DE The following extra options are supported for window items: .TP -\fB\-anchor \fIanchorPos\fR -. -\fIAnchorPos\fR tells how to position the window relative to the -positioning point for the item; it may have any of the forms -accepted by \fBTk_GetAnchor\fR. For example, if \fIanchorPos\fR -is \fBcenter\fR then the window is centered on the point; if -\fIanchorPos\fR is \fBn\fR then the window will be drawn so that -its top center point is at the positioning point. -This option defaults to \fBcenter\fR. -.TP \fB\-height \fIpixels\fR . Specifies the height to assign to the item's window. @@ -1820,9 +1879,9 @@ The window specified by \fIpathName\fR must either be a child of the canvas widget or a child of some ancestor of the canvas widget. \fIPathName\fR may not refer to a top-level window. .PP -Note: due to restrictions in the ways that windows are managed, it is not +Note: due to restrictions in the ways that windows are managed, it is not possible to draw other graphical items (such as lines and images) on top -of window items. A window item always obscures any graphics that +of window items. A window item always obscures any graphics that overlap it, regardless of their order in the display list. Also note that window items, unlike other canvas items, are not clipped for display by their containing canvas's border, and are instead clipped by the parent widget of @@ -1836,16 +1895,20 @@ See the documentation for \fBTk_CreateItemType\fR. .SH BINDINGS .PP In the current implementation, new canvases are not given any -default behavior: you will have to execute explicit Tcl commands +default behavior: you will have to execute explicit Tcl commands to give the canvas its behavior. .SH CREDITS .PP Tk's canvas widget is a blatant ripoff of ideas from Joel Bartlett's -\fIezd\fR program. \fIEzd\fR provides structured graphics in a Scheme -environment and preceded canvases by a year or two. Its simple +\fIezd\fR program. \fIEzd\fR provides structured graphics in a Scheme +environment and preceded canvases by a year or two. Its simple mechanisms for placing and animating graphical objects inspired the functions of canvases. .SH "SEE ALSO" bind(n), font(n), image(n), scrollbar(n) .SH KEYWORDS canvas, widget +'\" Local Variables: +'\" mode: nroff +'\" fill-column: 78 +'\" End: diff --git a/doc/checkbutton.n b/doc/checkbutton.n index 34d230b..2e6f840 100644 --- a/doc/checkbutton.n +++ b/doc/checkbutton.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -checkbutton \- Create and manipulate checkbutton widgets +checkbutton \- Create and manipulate 'checkbutton' boolean selection widgets .SH SYNOPSIS \fBcheckbutton\fI pathName \fR?\fIoptions\fR? .SO @@ -38,7 +38,7 @@ If this option is not specified, the button's desired height is computed from the size of the image or bitmap or text being displayed in it. .OP \-indicatoron indicatorOn IndicatorOn Specifies whether or not the indicator should be drawn. Must be a -proper boolean value. If false, the \fBrelief\fR option is +proper boolean value. If false, the \fB\-relief\fR option is ignored and the widget's relief is always sunken if the widget is selected and raised otherwise. .OP \-offrelief offRelief OffRelief @@ -79,34 +79,30 @@ whenever the widget is selected. If specified as an empty string then no special color is used for displaying when the widget is selected. .OP \-selectimage selectImage SelectImage -Specifies an image to display (in place of the \fBimage\fR option) +Specifies an image to display (in place of the \fB\-image\fR option) when the checkbutton is selected. -This option is ignored unless the \fBimage\fR option has been +This option is ignored unless the \fB\-image\fR option has been specified. .OP \-state state State Specifies one of three states for the checkbutton: \fBnormal\fR, \fBactive\fR, or \fBdisabled\fR. In normal state the checkbutton is displayed using the -\fBforeground\fR and \fBbackground\fR options. The active state is +\fB\-foreground\fR and \fB\-background\fR options. The active state is typically used when the pointer is over the checkbutton. In active state -the checkbutton is displayed using the \fBactiveForeground\fR and -\fBactiveBackground\fR options. Disabled state means that the checkbutton +the checkbutton is displayed using the \fB\-activeforeground\fR and +\fB\-activebackground\fR options. Disabled state means that the checkbutton should be insensitive: the default bindings will refuse to activate the widget and will ignore mouse button presses. -In this state the \fBdisabledForeground\fR and -\fBbackground\fR options determine how the checkbutton is displayed. +In this state the \fB\-disabledforeground\fR and +\fB\-background\fR options determine how the checkbutton is displayed. .OP \-tristateimage tristateImage TristateImage -.VS 8.5 -Specifies an image to display (in place of the \fBimage\fR option) +Specifies an image to display (in place of the \fB\-image\fR option) when the checkbutton is in tri-state mode. -This option is ignored unless the \fBimage\fR option has been +This option is ignored unless the \fB\-image\fR option has been specified. -.VE 8.5 .OP \-tristatevalue tristateValue Value -.VS 8.5 -Specifies the value that causes the checkbutton to display the multi-value +Specifies the value that causes the checkbutton to display the multi-value selection, also known as the tri-state mode. Defaults to .QW "" . -.VE 8.5 .OP \-variable variable Variable Specifies the name of a global variable to set to indicate whether or not this button is selected. Defaults to the name of the @@ -138,13 +134,13 @@ that displays a textual string, bitmap or image and a square called an \fIindicator\fR. If text is displayed, it must all be in a single font, but it can occupy multiple lines on the screen (if it contains newlines -or if wrapping occurs because of the \fBwrapLength\fR option) and +or if wrapping occurs because of the \fB\-wraplength\fR option) and one of the characters may optionally be underlined using the -\fBunderline\fR option. +\fB\-underline\fR option. A checkbutton has all of the behavior of a simple button, including the following: it can display itself in either of three different -ways, according to the \fBstate\fR option; +ways, according to the \fB\-state\fR option; it can be made to appear raised, sunken, or flat; it can be made to flash; and it invokes a Tcl command whenever mouse button 1 is clicked over the @@ -155,17 +151,16 @@ If a checkbutton is selected then the indicator is normally drawn with a selected appearance, and a Tcl variable associated with the checkbutton is set to a particular value (normally 1). -.VS 8.5 The indicator is drawn with a check mark inside. If the checkbutton is not selected, then the indicator is drawn with a deselected appearance, and the associated variable is set to a different value (typically 0). -The indicator is drawn without a check mark inside. In the special case -where the variable (if specified) has a value that matches the tristatevalue, -the indicator is drawn with a tri-state appearance and is in the tri-state -mode indicating mixed or multiple values. (This is used when the check +The indicator is drawn without a check mark inside. In the special case +where the variable (if specified) has a value that matches the tristatevalue, +the indicator is drawn with a tri-state appearance and is in the tri-state +mode indicating mixed or multiple values. (This is used when the check box represents the state of multiple items.) -The indicator is drawn in a platform dependent manner. Under Unix and +The indicator is drawn in a platform dependent manner. Under Unix and Windows, the background interior of the box is .QW grayed . Under Mac, the indicator is drawn with a dash mark inside. @@ -190,7 +185,6 @@ changes to and from the button's and .QW tristate values. -.VE 8.5 .SH "WIDGET COMMAND" .PP The \fBcheckbutton\fR command creates a new Tcl command whose @@ -270,7 +264,8 @@ invoked, if there is one). .IP [3] When a checkbutton has the input focus, the space key causes the checkbutton to be invoked. Under Windows, there are additional key bindings; plus -(+) and equal (=) select the button, and minus (\-) deselects the button. +(\fB+\fR) and equal (\fB=\fR) select the button, and minus (\fB\-\fR) +deselects the button. .PP If the checkbutton's state is \fBdisabled\fR then none of the above actions occur: the checkbutton is completely non-responsive. @@ -278,17 +273,21 @@ actions occur: the checkbutton is completely non-responsive. The behavior of checkbuttons can be changed by defining new bindings for individual widgets or by redefining the class bindings. .SH EXAMPLE +.PP This example shows a group of uncoupled checkbuttons. .PP .CS - labelframe .lbl \-text "Steps:" - \fBcheckbutton\fR .c1 \-text Lights \-variable lights - \fBcheckbutton\fR .c2 \-text Cameras \-variable cameras - \fBcheckbutton\fR .c3 \-text Action! \-variable action - pack .c1 .c2 .c3 \-in .lbl - pack .lbl +labelframe .lbl \-text "Steps:" +\fBcheckbutton\fR .c1 \-text Lights \-variable lights +\fBcheckbutton\fR .c2 \-text Cameras \-variable cameras +\fBcheckbutton\fR .c3 \-text Action! \-variable action +pack .c1 .c2 .c3 \-in .lbl +pack .lbl .CE .SH "SEE ALSO" button(n), options(n), radiobutton(n), ttk::checkbutton(n) .SH KEYWORDS checkbutton, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/chooseColor.n b/doc/chooseColor.n index c71577b..015b17d 100644 --- a/doc/chooseColor.n +++ b/doc/chooseColor.n @@ -13,7 +13,6 @@ tk_chooseColor \- pops up a dialog box for the user to select a color. .SH SYNOPSIS \fBtk_chooseColor \fR?\fIoption value ...\fR? .BE - .SH DESCRIPTION .PP The procedure \fBtk_chooseColor\fR pops up a dialog box for the @@ -38,9 +37,12 @@ name of the color in a form acceptable to \fBTk_GetColor\fR. If the user cancels the operation, both commands will return the empty string. .SH EXAMPLE +.PP .CS button .b \-bg [tk_chooseColor \-initialcolor gray \-title "Choose color"] .CE - .SH KEYWORDS -color selection dialog +color, color selection, dialog +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/chooseDirectory.n b/doc/chooseDirectory.n index da21762..86c593d 100644 --- a/doc/chooseDirectory.n +++ b/doc/chooseDirectory.n @@ -19,8 +19,11 @@ possible as command line arguments: .TP \fB\-initialdir\fR \fIdirname\fR Specifies that the directories in \fIdirectory\fR should be displayed -when the dialog pops up. If this parameter is not specified, then -the directories in the current working directory are displayed. If the +when the dialog pops up. If this parameter is not specified, +the initial directory defaults to the current working directory +on non-Windows systems and on Windows systems prior to Vista. +On Vista and later systems, the initial directory defaults to the last +user-selected directory for the application. If the parameter specifies a relative path, the return value will convert the relative path to an absolute path. .TP @@ -38,6 +41,7 @@ turns the file dialog into a sheet attached to the parent window. Specifies a string to display as the title of the dialog box. If this option is not specified, then a default title will be displayed. .SH EXAMPLE +.PP .CS set dir [\fBtk_chooseDirectory\fR \e \-initialdir ~ \-title "Choose a directory"] @@ -47,8 +51,10 @@ if {$dir eq ""} { label .l \-text "Selected $dir" } .CE - .SH "SEE ALSO" tk_getOpenFile(n), tk_getSaveFile(n) .SH KEYWORDS directory, selection, dialog, platform-specific +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/clipboard.n b/doc/clipboard.n index 442288d..374cbd1 100644 --- a/doc/clipboard.n +++ b/doc/clipboard.n @@ -14,7 +14,6 @@ clipboard \- Manipulate Tk clipboard .SH SYNOPSIS \fBclipboard \fIoption\fR ?\fIarg arg ...\fR? .BE - .SH DESCRIPTION .PP This command provides a Tcl interface to the Tk clipboard, @@ -28,15 +27,9 @@ appends should be completed before returning to the event loop. The first argument to \fBclipboard\fR determines the format of the rest of the arguments and the behavior of the command. The following forms are currently supported: -.PP -.TP -\fBclipboard clear\fR ?\fB\-displayof\fR \fIwindow\fR? -Claims ownership of the clipboard on \fIwindow\fR's display and removes -any previous contents. \fIWindow\fR defaults to -.QW . . -Returns an empty string. .TP \fBclipboard append\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-format\fR \fIformat\fR? ?\fB\-type\fR \fItype\fR? ?\fB\-\|\-\fR? \fIdata\fR +. Appends \fIdata\fR to the clipboard on \fIwindow\fR's display in the form given by \fItype\fR with the representation given by \fIformat\fR and claims ownership of the clipboard on \fIwindow\fR's @@ -47,15 +40,15 @@ display. (the desired .QW target for conversion, in ICCCM terminology), and -should be an atom name such as STRING or FILE_NAME; see the +should be an atom name such as \fBSTRING\fR or \fBFILE_NAME\fR; see the Inter-Client Communication Conventions Manual for complete details. -\fIType\fR defaults to STRING. +\fIType\fR defaults to \fBSTRING\fR. .PP The \fIformat\fR argument specifies the representation that should be used to transmit the selection to the requester (the second column of -Table 2 of the ICCCM), and defaults to STRING. If \fIformat\fR is -STRING, the selection is transmitted as 8-bit ASCII characters. If -\fIformat\fR is ATOM, then the \fIdata\fR is +Table 2 of the ICCCM), and defaults to \fBSTRING\fR. If \fIformat\fR is +\fBSTRING\fR, the selection is transmitted as 8-bit ASCII characters. If +\fIformat\fR is \fBATOM\fR, then the \fIdata\fR is divided into fields separated by white space; each field is converted to its atom value, and the 32-bit atom value is transmitted instead of the atom name. For any other \fIformat\fR, \fIdata\fR is divided @@ -69,8 +62,8 @@ boundaries. All items appended to the clipboard with the same .PP The \fIformat\fR argument is needed only for compatibility with clipboard requesters that do not use Tk. If the Tk toolkit is being -used to retrieve the CLIPBOARD selection then the value is converted back to -a string at the requesting end, so \fIformat\fR is +used to retrieve the \fBCLIPBOARD\fR selection then the value is +converted back to a string at the requesting end, so \fIformat\fR is irrelevant. .PP A \fB\-\|\-\fR argument may be specified to mark the end of options: the @@ -79,21 +72,30 @@ This feature may be convenient if, for example, \fIdata\fR starts with a \fB\-\fR. .RE .TP +\fBclipboard clear\fR ?\fB\-displayof\fR \fIwindow\fR? +. +Claims ownership of the clipboard on \fIwindow\fR's display and removes +any previous contents. \fIWindow\fR defaults to +.QW . . +Returns an empty string. +.TP \fBclipboard get\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-type\fR \fItype\fR? +. Retrieve data from the clipboard on \fIwindow\fR's display. \fIWindow\fR defaults to .QW . . \fIType\fR specifies the form in which -the data is to be returned and should be an atom name such as STRING -or FILE_NAME. \fIType\fR defaults to STRING. This command is +the data is to be returned and should be an atom name such as \fBSTRING\fR +or \fBFILE_NAME\fR. \fIType\fR defaults to \fBSTRING\fR. This command is equivalent to -.QW "\fBselection get \-selection CLIPBOARD\fR" . +.QW "\fBselection get\fR \fB\-selection CLIPBOARD\fR" . .RS .PP Note that on modern X11 systems, the most useful type to retrieve for transferred strings is not \fBSTRING\fR, but rather \fBUTF8_STRING\fR. .RE .SH EXAMPLES +.PP Get the current contents of the clipboard. .CS if {[catch {\fBclipboard get\fR} contents]} { @@ -146,9 +148,10 @@ bind $c <<Paste>> { } } .CE - .SH "SEE ALSO" interp(n), selection(n) - .SH KEYWORDS clear, format, clipboard, append, selection, type +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/colors.n b/doc/colors.n index 46c35aa..dc7007b 100644 --- a/doc/colors.n +++ b/doc/colors.n @@ -205,7 +205,7 @@ goldenrod1 255 193 37 goldenrod2 238 180 34 goldenrod3 205 155 29 goldenrod4 139 105 20 -gray 190 190 190 +gray 128 128 128 gray0 0 0 0 gray1 3 3 3 gray2 5 5 5 @@ -307,14 +307,14 @@ gray97 247 247 247 gray98 250 250 250 gray99 252 252 252 gray100 255 255 255 -green 0 255 0 +green 0 128 0 green yellow 173 255 47 green1 0 255 0 green2 0 238 0 green3 0 205 0 green4 0 139 0 GreenYellow 173 255 47 -grey 190 190 190 +grey 128 128 128 grey0 0 0 0 grey1 3 3 3 grey2 5 5 5 @@ -534,7 +534,7 @@ magenta1 255 0 255 magenta2 238 0 238 magenta3 205 0 205 magenta4 139 0 139 -maroon 176 48 96 +maroon 128 0 0 maroon1 255 52 179 maroon2 238 48 167 maroon3 205 41 144 @@ -651,7 +651,7 @@ plum3 205 150 205 plum4 139 102 139 powder blue 176 224 230 PowderBlue 176 224 230 -purple 160 32 240 +purple 128 0 128 purple1 155 48 255 purple2 145 44 238 purple3 125 38 205 @@ -933,19 +933,19 @@ On Windows, the following additional system colors are available .RS .DS .ta 6c -3dDarkShadow Highlight -3dLight HighlightText -ActiveBorder InactiveBorder -ActiveCaption InactiveCaption -AppWorkspace InactiveCaptionText -Background InfoBackground -ButtonFace InfoText -ButtonHighlight Menu -ButtonShadow MenuText -ButtonText Scrollbar -CaptionText Window -DisabledText WindowFrame -GrayText WindowText +system3dDarkShadow systemHighlight +system3dLight systemHighlightText +systemActiveBorder systemInactiveBorder +systemActiveCaption systemInactiveCaption +systemAppWorkspace systemInactiveCaptionText +systemBackground systemInfoBackground +systemButtonFace systemInfoText +systemButtonHighlight systemMenu +systemButtonShadow systemMenuText +systemButtonText systemScrollbar +systemCaptionText systemWindow +systemDisabledText systemWindowFrame +systemGrayText systemWindowText .DE .RE .SH "SEE ALSO" diff --git a/doc/console.n b/doc/console.n index bd98961..1313d3a 100644 --- a/doc/console.n +++ b/doc/console.n @@ -25,7 +25,7 @@ the Tk library. Except for TkAqua, this command is not available when Tk is loaded into a tclsh interpreter with .QW "\fBpackage require Tk\fR" , as a conventional terminal is expected to be present in that case. -In TkAqua, this command is ony available when stdin is \fB/dev/null\fR +In TkAqua, this command is only available when stdin is \fB/dev/null\fR (as is the case e.g. when the application embedding Tk is started from the Mac OS X Finder). .PP @@ -129,6 +129,7 @@ Most other behaviour is the same as a conventional text widget except for the way that the \fI<<Cut>>\fR event is handled identically to the \fI<<Copy>>\fR event. .SH EXAMPLE +.PP Not all platforms have the \fBconsole\fR command, so debugging code often has the following code fragment in it so output produced by \fBputs\fR can be seen while during development: @@ -139,3 +140,6 @@ catch {\fBconsole show\fR} destroy(n), fconfigure(n), history(n), interp(n), puts(n), text(n), wm(n) .SH KEYWORDS console, interpreter, window, interactive, output channels +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/cursors.n b/doc/cursors.n index b36f537..1662de4 100644 --- a/doc/cursors.n +++ b/doc/cursors.n @@ -135,12 +135,13 @@ On Mac OS X systems, the following cursors are mapped to native cursors: .RS .CS arrow +top_left_arrow +left_ptr cross crosshair +tcross ibeam none -plus -watch xterm .CE And the following additional native cursors are available: @@ -148,24 +149,43 @@ And the following additional native cursors are available: copyarrow aliasarrow contextualmenuarrow +movearrow text cross-hair -closedhand +hand openhand +closedhand +fist pointinghand +resize resizeleft resizeright resizeleftright resizeup resizedown resizeupdown +resizebottomleft +resizetopleft +resizebottomright +resizetopright notallowed poof +wait countinguphand countingdownhand countingupanddownhand spinning +help +bucket +cancel +eyedrop +eyedrop-full +zoom-in +zoom-out .CE .RE .SH KEYWORDS cursor, option +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/destroy.n b/doc/destroy.n index 00da4a7..3d4743a 100644 --- a/doc/destroy.n +++ b/doc/destroy.n @@ -27,6 +27,7 @@ in destroying a window the command aborts without destroying the remaining windows. No error is returned if \fIwindow\fR does not exist. .SH EXAMPLE +.PP Destroy all checkbuttons that are direct children of the given widget: .CS proc killCheckbuttonChildren {parent} { @@ -37,6 +38,8 @@ proc killCheckbuttonChildren {parent} { } } .CE - .SH KEYWORDS application, destroy, window +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/dialog.n b/doc/dialog.n index e154a7f..d2031d3 100644 --- a/doc/dialog.n +++ b/doc/dialog.n @@ -14,10 +14,10 @@ tk_dialog \- Create modal dialog and wait for response .SH SYNOPSIS \fBtk_dialog \fIwindow title text bitmap default string string ...\fR .BE - .SH DESCRIPTION .PP This procedure is part of the Tk script library. +It is largely \fIdeprecated\fR by the \fBtk_messageBox\fR. Its arguments describe a dialog box: .TP \fIwindow\fR @@ -31,7 +31,8 @@ Text to appear in the window manager's title bar for the dialog. Message to appear in the top portion of the dialog box. .TP \fIbitmap\fR -If non-empty, specifies a bitmap to display in the top portion of +If non-empty, specifies a bitmap (in a form suitable for Tk_GetBitmap) +to display in the top portion of the dialog, to the left of the text. If this is an empty string then no bitmap is displayed in the dialog. .TP @@ -59,13 +60,15 @@ While waiting for the user to respond, \fBtk_dialog\fR sets a local grab. This prevents the user from interacting with the application in any way except to invoke the dialog box. .SH EXAMPLE +.PP .CS set reply [\fBtk_dialog\fR .foo "The Title" "Do you want to say yes?" \e questhead 0 Yes No "I'm not sure"] .CE - .SH "SEE ALSO" tk_messageBox(n) - .SH KEYWORDS bitmap, dialog, modal +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/entry.n b/doc/entry.n index 8015f1c..ccfcd24 100644 --- a/doc/entry.n +++ b/doc/entry.n @@ -11,7 +11,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -entry \- Create and manipulate entry widgets +entry \- Create and manipulate 'entry' one-line text entry widgets .SH SYNOPSIS \fBentry\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -32,9 +32,9 @@ this option is the empty string, the normal background color is used. Specifies the foreground color to use when the entry is disabled. If this option is the empty string, the normal foreground color is used. .OP "\-invalidcommand or \-invcmd" invalidCommand InvalidCommand -Specifies a script to eval when \fBvalidateCommand\fR returns 0. +Specifies a script to eval when \fB\-validatecommand\fR returns 0. Setting it to {} disables this feature (the default). The best use -of this option is to set it to \fIbell\fR. See \fBValidation\fR +of this option is to set it to \fIbell\fR. See \fBVALIDATION\fR below for more information. .OP \-readonlybackground readonlyBackground ReadonlyBackground Specifies the background color to use when the entry is readonly. If @@ -64,15 +64,15 @@ be displayed in a different color, depending on the values of the Specifies the mode in which validation should operate: \fBnone\fR, \fBfocus\fR, \fBfocusin\fR, \fBfocusout\fR, \fBkey\fR, or \fBall\fR. It defaults to \fBnone\fR. When you want validation, you must explicitly -state which mode you wish to use. See \fBValidation\fR below for more. +state which mode you wish to use. See \fBVALIDATION\fR below for more. .OP "\-validatecommand or \-vcmd" validateCommand ValidateCommand Specifies a script to eval when you want to validate the input into the entry widget. Setting it to {} disables this feature (the default). This command must return a valid Tcl boolean value. If it returns 0 (or the valid Tcl boolean equivalent) then it means you reject the new edition -and it will not occur and the \fBinvalidCommand\fR will be evaluated if it +and it will not occur and the \fB\-invalidcommand\fR will be evaluated if it is set. If it returns 1, then the new edition occurs. -See \fBValidation\fR below for more information. +See \fBVALIDATION\fR below for more information. .OP \-width width Width Specifies an integer value indicating the desired width of the entry window, in average-size characters of the widget's font. @@ -96,7 +96,7 @@ allows that string to be edited using widget commands described below, which are typically bound to keystrokes and mouse actions. When first created, an entry's string is empty. A portion of the entry may be selected as described below. -If an entry is exporting its selection (see the \fBexportSelection\fR +If an entry is exporting its selection (see the \fB\-exportselection\fR option), then it will observe the standard X11 protocols for handling the selection; entry selections are available as type \fBSTRING\fR. Entries also observe the standard Tk rules for dealing with the @@ -108,31 +108,31 @@ Entries are capable of displaying strings that are too long to fit entirely within the widget's window. In this case, only a portion of the string will be displayed; commands described below may be used to change the view in the window. Entries use -the standard \fBxScrollCommand\fR mechanism for interacting with -scrollbars (see the description of the \fBxScrollCommand\fR option +the standard \fB\-xscrollcommand\fR mechanism for interacting with +scrollbars (see the description of the \fB\-xscrollcommand\fR option for details). They also support scanning, as described below. .SH VALIDATION .PP -Validation works by setting the \fBvalidateCommand\fR -option to a script which will be evaluated according to the \fBvalidate\fR -option as follows: +Validation works by setting the \fB\-validatecommand\fR option to a +script (\fIvalidateCommand\fR) which will be evaluated according to +the \fB\-validate\fR option as follows: .PP .IP \fBnone\fR 10 Default. This means no validation will occur. .IP \fBfocus\fR 10 -\fBvalidateCommand\fR will be called when the entry receives or +\fIvalidateCommand\fR will be called when the entry receives or loses focus. .IP \fBfocusin\fR 10 -\fBvalidateCommand\fR will be called when the entry receives focus. +\fIvalidateCommand\fR will be called when the entry receives focus. .IP \fBfocusout\fR 10 -\fBvalidateCommand\fR will be called when the entry loses focus. +\fIvalidateCommand\fR will be called when the entry loses focus. .IP \fBkey\fR 10 -\fBvalidateCommand\fR will be called when the entry is edited. +\fIvalidateCommand\fR will be called when the entry is edited. .IP \fBall\fR 10 -\fBvalidateCommand\fR will be called for all above conditions. +\fIvalidateCommand\fR will be called for all above conditions. .PP -It is possible to perform percent substitutions on the \fBvalidateCommand\fR -and \fBinvalidCommand\fR, +It is possible to perform percent substitutions on the value of the +\fB\-validatecommand\fR and \fB\-invalidcommand\fR options, just as you would in a \fBbind\fR script. The following substitutions are recognized: .PP @@ -157,32 +157,32 @@ The type of validation that triggered the callback .IP \fB%W\fR 5 The name of the entry widget. .PP -In general, the \fBtextVariable\fR and \fBvalidateCommand\fR can be +In general, the \fB\-textvariable\fR and \fB\-validatecommand\fR options can be dangerous to mix. Any problems have been overcome so that using the -\fBvalidateCommand\fR will not interfere with the traditional behavior of -the entry widget. Using the \fBtextVariable\fR for read-only purposes will +\fB\-validatecommand\fR will not interfere with the traditional behavior of +the entry widget. Using the \fB\-textvariable\fR for read-only purposes will never cause problems. The danger comes when you try set the -\fBtextVariable\fR to something that the \fBvalidateCommand\fR would not -accept, which causes \fBvalidate\fR to become \fInone\fR (the -\fBinvalidCommand\fR will not be triggered). The same happens -when an error occurs evaluating the \fBvalidateCommand\fR. +\fB\-textvariable\fR to something that the \fB\-validatecommand\fR would not +accept, which causes \fB\-validate\fR to become \fInone\fR (the +\fB\-invalidcommand\fR will not be triggered). The same happens +when an error occurs evaluating the \fB\-validatecommand\fR. .PP -Primarily, an error will occur when the \fBvalidateCommand\fR or -\fBinvalidCommand\fR encounters an error in its script while evaluating or -\fBvalidateCommand\fR does not return a valid Tcl boolean value. The -\fBvalidate\fR option will also set itself to \fBnone\fR when you edit the -entry widget from within either the \fBvalidateCommand\fR or the -\fBinvalidCommand\fR. Such editions will override the one that was being +Primarily, an error will occur when the \fB\-validatecommand\fR or +\fB\-invalidcommand\fR encounters an error in its script while evaluating or +\fB\-validatecommand\fR does not return a valid Tcl boolean value. The +\fB\-validate\fR option will also set itself to \fBnone\fR when you edit the +entry widget from within either the \fB\-validatecommand\fR or the +\fB\-invalidcommand\fR. Such editions will override the one that was being validated. If you wish to edit the entry widget (for example set it to {}) -during validation and still have the \fBvalidate\fR option set, you should +during validation and still have the \fB\-validate\fR option set, you should include the command .CS after idle {%W config \-validate %v} .CE -in the \fBvalidateCommand\fR or \fBinvalidCommand\fR (whichever one you +in the \fB\-validatecommand\fR or \fB\-invalidcommand\fR (whichever one you were editing the entry widget from). It is also recommended to not set an -associated \fBtextVariable\fR during validation, as that can cause the -entry widget to become out of sync with the \fBtextVariable\fR. +associated \fB\-textvariable\fR during validation, as that can cause the +entry widget to become out of sync with the \fB\-textvariable\fR. .SH "WIDGET COMMAND" .PP The \fBentry\fR command creates a new Tcl command whose @@ -369,9 +369,9 @@ Returns an empty string. .RE .TP \fIpathName \fBvalidate\fR -This command is used to force an evaluation of the \fBvalidateCommand\fR -independent of the conditions specified by the \fBvalidate\fR option. -This is done by temporarily setting the \fBvalidate\fR option to \fBall\fR. +This command is used to force an evaluation of the \fB\-validatecommand\fR +independent of the conditions specified by the \fB\-validate\fR option. +This is done by temporarily setting the \fB\-validate\fR option to \fBall\fR. It returns 0 or 1. .TP \fIpathName \fBxview \fIargs\fR @@ -534,3 +534,6 @@ individual widgets or by redefining the class bindings. ttk::entry(n) .SH KEYWORDS entry, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/event.n b/doc/event.n index 85033e9..7a3cfca 100644 --- a/doc/event.n +++ b/doc/event.n @@ -76,7 +76,7 @@ defined for the given virtual event; if the virtual event is not defined then an empty string is returned. .RS .PP -Note that virtual events that that are not bound to physical event +Note that virtual events that are not bound to physical event sequences are \fInot\fR returned by \fBevent info\fR. .RE .SH "EVENT FIELDS" @@ -108,13 +108,11 @@ Corresponds to the \fB%b\fR substitution for binding scripts. \fINumber\fR must be an integer; it specifies the \fIcount\fR field for the event. Valid for \fBExpose\fR events. Corresponds to the \fB%c\fR substitution for binding scripts. -.VS 8.5 .TP \fB\-data\fI string\fR \fIString\fR may be any value; it specifies the \fIuser_data\fR field for the event. Only valid for virtual events. Corresponds to the \fB%d\fR substitution for virtual events in binding scripts. -.VE 8.5 .TP \fB\-delta\fI number\fR \fINumber\fR must be an integer; it specifies the \fIdelta\fR field @@ -308,6 +306,7 @@ Any options that are not specified when generating an event are filled with the value 0, except for \fIserial\fR, which is filled with the next X event serial number. .SH "PREDEFINED VIRTUAL EVENTS" +.PP Tk defines the following virtual events for the purposes of notification: .TP @@ -366,6 +365,36 @@ Copy the currently selected widget contents to the clipboard. \fB<<Cut>>\fR Move the currently selected widget contents to the clipboard. .TP +\fB<<LineEnd>>\fR +. +Move to the end of the line in the current widget while deselecting any +selected contents. +.TP +\fB<<LineStart>>\fR +. +Move to the start of the line in the current widget while deselecting any +selected contents. +.TP +\fB<<NextChar>>\fR +. +Move to the next item (i.e., visible character) in the current widget while +deselecting any selected contents. +.TP +\fB<<NextLine>>\fR +. +Move to the next line in the current widget while deselecting any selected +contents. +.TP +\fB<<NextPara>>\fR +. +Move to the next paragraph in the current widget while deselecting any +selected contents. +.TP +\fB<<NextWord>>\fR +. +Move to the next group of items (i.e., visible word) in the current widget +while deselecting any selected contents. +.TP \fB<<Paste>>\fR Replace the currently selected widget contents with the contents of the clipboard. @@ -374,32 +403,123 @@ the clipboard. Insert the contents of the selection at the mouse location. (This event has meaningful \fB%x\fR and \fB%y\fR substitutions). .TP +\fB<<PrevChar>>\fR +. +Move to the previous item (i.e., visible character) in the current widget +while deselecting any selected contents. +.TP +\fB<<PrevLine>>\fR +. +Move to the previous line in the current widget while deselecting any selected +contents. +.TP +\fB<<PrevPara>>\fR +. +Move to the previous paragraph in the current widget while deselecting any +selected contents. +.TP \fB<<PrevWindow>>\fR Traverse to the previous window. .TP +\fB<<PrevWord>>\fR +. +Move to the previous group of items (i.e., visible word) in the current widget +while deselecting any selected contents. +.TP \fB<<Redo>>\fR Redo one undone action. .TP +\fB<<SelectAll>>\fR +. +Set the range of selected contents to the complete widget. +.TP +\fB<<SelectLineEnd>>\fR +. +Move to the end of the line in the current widget while extending the range +of selected contents. +.TP +\fB<<SelectLineStart>>\fR +. +Move to the start of the line in the current widget while extending the range +of selected contents. +.TP +\fB<<SelectNextChar>>\fR +. +Move to the next item (i.e., visible character) in the current widget while +extending the range of selected contents. +.TP +\fB<<SelectNextLine>>\fR +. +Move to the next line in the current widget while extending the range of +selected contents. +.TP +\fB<<SelectNextPara>>\fR +. +Move to the next paragraph in the current widget while extending the range +of selected contents. +.TP +\fB<<SelectNextWord>>\fR +. +Move to the next group of items (i.e., visible word) in the current widget +while extending the range of selected contents. +.TP +\fB<<SelectNone>>\fR +. +Reset the range of selected contents to be empty. +.TP +\fB<<SelectPrevChar>>\fR +. +Move to the previous item (i.e., visible character) in the current widget +while extending the range of selected contents. +.TP +\fB<<SelectPrevLine>>\fR +. +Move to the previous line in the current widget while extending the range of +selected contents. +.TP +\fB<<SelectPrevPara>>\fR +. +Move to the previous paragraph in the current widget while extending the +range of selected contents. +.TP +\fB<<SelectPrevWord>>\fR +. +Move to the previous group of items (i.e., visible word) in the current widget +while extending the range of selected contents. +.TP +\fB<<ToggleSelection>>\fR +. +Toggle the selection. +.TP \fB<<Undo>>\fR +. Undo the last action. -.SH "VIRTUAL EVENT EXAMPLES" +.SH EXAMPLES +.SS "MAPPING KEYS TO VIRTUAL EVENTS" .PP In order for a virtual event binding to trigger, two things must happen. First, the virtual event must be defined with the \fBevent add\fR command. Second, a binding must be created for the virtual event with the \fBbind\fR command. Consider the following virtual event definitions: +.PP .CS -event add <<Paste>> <Control-y> -event add <<Paste>> <Button-2> -event add <<Save>> <Control-X><Control-S> -event add <<Save>> <Shift-F12> +\fBevent add\fR <<Paste>> <Control-y> +\fBevent add\fR <<Paste>> <Button-2> +\fBevent add\fR <<Save>> <Control-X><Control-S> +\fBevent add\fR <<Save>> <Shift-F12> +if {[tk windowingsystem] eq "aqua"} { + \fBevent add\fR <<Save>> <Command-s> +} .CE +.PP In the \fBbind\fR command, a virtual event can be bound like any other builtin event type as follows: +.PP .CS bind Entry <<Paste>> {%W insert [selection get]} .CE +.PP The double angle brackets are used to specify that a virtual event is being bound. If the user types Control-y or presses button 2, or if a \fB<<Paste>>\fR virtual event is synthesized with \fBevent generate\fR, @@ -408,11 +528,13 @@ then the \fB<<Paste>>\fR binding will be invoked. If a virtual binding has the exact same sequence as a separate physical binding, then the physical binding will take precedence. Consider the following example: +.PP .CS -event add <<Paste>> <Control-y> <Meta-Control-y> +\fBevent add\fR <<Paste>> <Control-y> <Meta-Control-y> bind Entry <Control-y> {puts Control-y} bind Entry <<Paste>> {puts Paste} .CE +.PP When the user types Control-y the \fB<Control-y>\fR binding will be invoked, because a physical event is considered more specific than a virtual event, all other things being equal. @@ -430,18 +552,41 @@ ungeneratable. When a definition of a virtual event changes at run time, all windows will respond immediately to the new definition. Starting from the preceding example, if the following code is executed: +.PP .CS -bind <Entry> <Control-y> {} -event add <<Paste>> <Key-F6> +bind Entry <Control-y> {} +\fBevent add\fR <<Paste>> <Key-F6> .CE +.PP the behavior will change such in two ways. First, the shadowed \fB<<Paste>>\fR binding will emerge. Typing Control-y will no longer invoke the \fB<Control-y>\fR binding, but instead invoke the virtual event \fB<<Paste>>\fR. Second, pressing the F6 key will now also invoke the \fB<<Paste>>\fR binding. - +.SS "MOVING THE MOUSE POINTER" +.PP +Sometimes it is useful to be able to really move the mouse pointer. For +example, if you have some software that is capable of demonstrating directly +to the user how to use the program. To do this, you need to +.QW warp +the mouse around by using \fBevent generate\fR, like this: +.PP +.CS +for {set xy 0} {$xy < 200} {incr xy} { + \fBevent generate\fR . <Motion> -x $xy -y $xy -warp 1 + update + after 50 +} +.CE +.PP +Note that it is usually considered bad style to move the mouse pointer for the +user because it removes control from them. Therefore this technique should be +used with caution. Also note that it is not guaranteed to function on all +platforms. .SH "SEE ALSO" bind(n) - .SH KEYWORDS event, binding, define, handle, virtual event +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/focus.n b/doc/focus.n index d4f29e8..4b8bb2a 100644 --- a/doc/focus.n +++ b/doc/focus.n @@ -18,7 +18,6 @@ focus \- Manage the input focus \fBfocus \fIoption\fR ?\fIarg arg ...\fR? .fi .BE - .SH DESCRIPTION .PP The \fBfocus\fR command is used to manage the Tk input focus. @@ -106,6 +105,7 @@ number of problems that would occur if the X focus were actually moved; the fact that the X focus is on the top-level is invisible unless you use C code to query the X server directly. .SH "EXAMPLE" +.PP To make a window that only participates in the focus traversal ring when a variable is set, add the following bindings to the widgets \fIbefore\fR and \fIafter\fR it in that focus ring: @@ -130,6 +130,8 @@ bind .after <Shift\-Tab> { } \fBfocus\fR .before .CE - .SH KEYWORDS events, focus, keyboard, top-level, window manager +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/focusNext.n b/doc/focusNext.n index 11a3a49..ffcf971 100644 --- a/doc/focusNext.n +++ b/doc/focusNext.n @@ -18,7 +18,6 @@ tk_focusNext, tk_focusPrev, tk_focusFollowsMouse \- Utility procedures for manag .sp \fBtk_focusFollowsMouse\fR .BE - .SH DESCRIPTION .PP \fBtk_focusNext\fR is a utility procedure used for keyboard traversal. @@ -54,6 +53,8 @@ Note: at present there is no built-in support for returning the application to an explicit focus model; to do this you will have to write a script that deletes the bindings created by \fBtk_focusFollowsMouse\fR. - .SH KEYWORDS focus, keyboard traversal, top-level +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -26,7 +26,7 @@ first argument. The following forms are currently supported: Returns information about the actual attributes that are obtained when \fIfont\fR is used on \fIwindow\fR's display; the actual attributes obtained may differ from the attributes requested due to platform-dependent -limitations, such as the availability of font families and pointsizes. +limitations, such as the availability of font families and point sizes. \fIfont\fR is a font description; see \fBFONT DESCRIPTIONS\fR below. If the \fIwindow\fR argument is omitted, it defaults to the main window. If \fIoption\fR is specified, returns the value of that attribute; if it is @@ -50,6 +50,14 @@ then the command modifies the given named font to have the given values; in this case, all widgets using that font will redisplay themselves using the new attributes for the font. See \fBFONT OPTIONS\fR below for a list of the possible attributes. +.RS +.PP +Note that on Aqua/Mac OS X, the system fonts (see +\fBPLATFORM SPECIFIC FONTS\fR below) may not be actually altered because they +are implemented by the system theme. To achieve the effect of modification, +use \fBfont actual\fR to get their configuration and \fBfont create\fR to +synthesize a copy of the font which can be modified. +.RE .TP \fBfont create\fR ?\fIfontname\fR? ?\fIoption value ...\fR? . @@ -102,7 +110,7 @@ below for a list of the possible metrics. .TP \fBfont names\fR The return value is a list of all the named fonts that are currently defined. -.SH "FONT DESCRIPTION" +.SH "FONT DESCRIPTIONS" .PP The following formats are accepted as a font description anywhere \fIfont\fR is specified as an argument above; these same forms are also @@ -123,7 +131,7 @@ The platform-specific name of a font, interpreted by the graphics server. This also includes, under X, an XLFD (see [4]) for which a single .QW \fB*\fR character was used to elide more than one field in the middle of the -name. See \fBPLATFORM-SPECIFIC\fR issues for a list of the system fonts. +name. See \fBPLATFORM SPECIFIC FONTS\fR for a list of the system fonts. .TP [3] \fIfamily \fR?\fIsize\fR? ?\fIstyle\fR? ?\fIstyle ...\fR? . @@ -181,7 +189,7 @@ a garbage value); in that case, some system-dependent default font is chosen. If the font description does not match any of the above patterns, an error is generated. .SH "FONT METRICS" -. +.PP The following options are used by the \fBfont metrics\fR command to query font-specific data determined when the font was created. These properties are for the whole font itself and not for individual characters drawn in that @@ -223,6 +231,7 @@ individual characters have different widths. The widths of control characters, tab characters, and other non-printing characters are not included when calculating this value. .SH "FONT OPTIONS" +.PP The following options are supported on all platforms, and are used when constructing a named font or when specifying a font using style [5] as above: @@ -286,7 +295,7 @@ The value is a boolean flag that specifies whether a horizontal line should be drawn through the middle of characters in this font. The default value for overstrike is \fBfalse\fR. .SH "STANDARD FONTS" -.LP +.PP The following named fonts are supported on all systems, and default to values that match appropriate system defaults. .TP @@ -329,7 +338,7 @@ This font should be used for tooltip windows (transient information windows). It is \fInot\fR advised to change these fonts, as they may be modified by Tk itself in response to system changes. Instead, make a copy of the font and modify that. -.SH "PLATFORM-SPECIFIC FONTS" +.SH "PLATFORM SPECIFIC FONTS" .PP The following system fonts are supported: .TP @@ -373,6 +382,7 @@ theme fonts: .DE .RE .SH EXAMPLE +.PP Fill a text widget with lots of font demonstrators, one for every font family installed on your system: .CS @@ -390,9 +400,10 @@ foreach family [lsort \-dictionary [\fBfont families\fR]] { } } .CE - .SH "SEE ALSO" options(n) - .SH KEYWORDS font +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/fontchooser.n b/doc/fontchooser.n new file mode 100644 index 0000000..bdd51c7 --- /dev/null +++ b/doc/fontchooser.n @@ -0,0 +1,181 @@ +'\" +'\" Copyright (c) 2008 Daniel A. Steffen <das@users.sourceforge.net> +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH fontchooser n "" Tk "Tk Built-In Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +fontchooser \- control font selection dialog +.SH SYNOPSIS +\fBtk fontchooser\fR \fBconfigure\fR ?\fI\-option value \-option value ...\fR? +.sp +\fBtk fontchooser\fR \fBshow\fR +.sp +\fBtk fontchooser\fR \fBhide\fR +.BE +.SH DESCRIPTION +.PP +The \fBtk fontchooser\fR command controls the Tk font selection dialog. It uses +the native platform font selection dialog where available, or a dialog +implemented in Tcl otherwise. +.PP +Unlike most of the other Tk dialog commands, \fBtk fontchooser\fR does not +return an immediate result, as on some platforms (Mac OS X) the standard font +dialog is modeless while on others (Windows) it is modal. To accommodate this +difference, all user interaction with the dialog will be communicated to the +caller via callbacks or virtual events. +.PP +The \fBtk fontchooser\fR command can have one of the following forms: +.TP +\fBtk fontchooser\fR \fBconfigure \fR?\fI\-option value \-option value ...\fR? +. +Set or query one or more of the configurations options below (analogous to Tk +widget configuration). +.TP +\fBtk fontchooser\fR \fBshow\fR +. +Show the font selection dialog. Depending on the platform, may return +immediately or only once the dialog has been withdrawn. +.TP +\fBtk fontchooser\fR \fBhide\fR +. +Hide the font selection dialog if it is visible and cause any pending +\fBtk fontchooser\fR \fBshow\fR command to return. +.PP +.SH "CONFIGURATION OPTIONS" +.TP +\fB\-parent\fR +Specifies/returns the logical parent window of the font selection dialog +(similar to the \fB\-parent\fR option to other dialogs). The font selection +dialog is hidden if it is visible when the parent window is destroyed. +.TP +\fB\-title\fR +Specifies/returns the title of the dialog. Has no effect on platforms where the +font selection dialog does not support titles. +.TP +\fB\-font\fR +Specifies/returns the font that is currently selected in the dialog if it is +visible, or that will be initially selected when the dialog is shown (if +supported by the platform). Can be set to the empty string to indicate that no +font should be selected. Fonts can be specified in any form given by the "FONT +DESCRIPTION" section in the \fBfont\fR manual page. +.TP +\fB\-command\fR +Specifies/returns the command prefix to be called when a font selection has +been made by the user. The command prefix is evaluated at the global level +after having the specification of the selected font appended. On platforms +where the font selection dialog offers the user control of further font +attributes (such as color), additional key/value pairs may be appended before +evaluation. Can be set to the empty string to indicate that no callback should +be invoked. Fonts are specified by a list of form [3] of the "FONT DESCRIPTION" +section in the \fBfont\fR manual page (i.e. a list of the form +\fI{family size style ?style ...?}\fR). +.TP +\fB\-visible\fR +Read-only option that returns a boolean indicating whether the font selection +dialog is currently visible. Attempting to set this option results in an error. + +.PP +.SH "VIRTUAL EVENTS" +.TP +\fB<<TkFontchooserVisibility>>\fR +Sent to the dialog parent whenever the visibility of the font selection dialog +changes, both as a result of user action (e.g. disposing of the dialog via +OK/Cancel button or close box) and of the \fBtk fontchooser\fR +\fBshow\fR/\fBhide\fR commands being called. Binding scripts can determine the +current visibility of the dialog by querying the \fB\-visible\fR configuration +option. +.TP +\fB<<TkFontchooserFontChanged>>\fR +Sent to the dialog parent whenever the font selection dialog is visible and the +selected font changes, both as a result of user action and of the \fB\-font\fR +configuration option being set. Binding scripts can determine the currently +selected font by querying the \fB\-font\fR configuration option. +.PP +.SH NOTES +.PP +Callers should not expect a result from \fBtk fontchooser\fR \fBshow\fR and may +not assume that the dialog has been withdrawn or closed when the command +returns. All user interaction with the dialog is communicated to the caller via +the \fB\-command\fR callback and the \fB<<TkFontchooser*>>\fR virtual events. +It is implementation dependent which exact user actions result in the callback +being called resp. the virtual events being sent. Where an Apply or OK button +is present in the dialog, that button will trigger the \fB\-command\fR callback +and \fB<<TkFontchooserFontChanged>>\fR virtual event. On some implementations +other user actions may also have that effect; on Mac OS X for instance, the +standard font selection dialog immediately reflects all user choices to the +caller. +.PP +In the presence of multiple widgets intended to be influenced by the font +selection dialog, care needs to be taken to correctly handle focus changes: the +font selected in the dialog should always match the current font of the widget +with the focus, and the \fB\-command\fR callback should only act on the widget +with the focus. The recommended practice is to set font dialog \fB\-font\fR and +\fB\-command\fR configuration options in per\-widget \fB<FocusIn>\fR handlers +(and if necessary to unset them \- i.e. set to the empty string \- in +corresponding \fB<FocusOut>\fR handlers). This is particularly important for +implementers of library code using the font selection dialog, to avoid +conflicting with application code that may also want to use the dialog. +.PP +Because the font selection dialog is application-global, in the presence of +multiple interpreters calling \fBtk fontchooser\fR, only the \fB\-command\fR +callback set by the interpreter that most recently called \fBtk fontchooser\fR +\fBconfigure\fR or \fBtk fontchooser\fR \fBshow\fR will be invoked in response +to user action and only the \fB\-parent\fR set by that interpreter will receive +\fB<<TkFontchooser*>>\fR virtual events. +.PP +The font dialog implementation may only store (and return) \fBfont\fR +\fBactual\fR data as the value of the \fB\-font\fR configuration option. This +can be an issue when \fB\-font\fR is set to a named font, if that font is +subsequently changed, the font dialog \fB\-font\fR option needs to be set again +to ensure its selected font matches the new value of the named font. +.PP +.SH EXAMPLE +.PP +.CS +proc fontchooserDemo {} { + wm title . "Font Chooser Demo" + \fBtk fontchooser\fR \fBconfigure\fR \-parent . + button .b \-command fontchooserToggle \-takefocus 0 + fontchooserVisibility .b + bind . \fB<<TkFontchooserVisibility>>\fR \\ + [list fontchooserVisibility .b] + foreach w {.t1 .t2} { + text $w \-width 20 \-height 4 \-borderwidth 1 \-relief solid + bind $w <FocusIn> [list fontchooserFocus $w] + $w insert end "Text Widget $w" + } + .t1 configure \-font {Courier 14} + .t2 configure \-font {Times 16} + pack .b .t1 .t2; focus .t1 +} +proc fontchooserToggle {} { + \fBtk fontchooser\fR [expr { + [\fBtk fontchooser\fR \fBconfigure\fR \-visible] ? + "\fBhide\fR" : "\fBshow\fR"}] +} +proc fontchooserVisibility {w} { + $w configure \-text [expr { + [\fBtk fontchooser\fR \fBconfigure\fR \-visible] ? + "Hide Font Dialog" : "Show Font Dialog"}] +} +proc fontchooserFocus {w} { + \fBtk fontchooser\fR \fBconfigure\fR \-font [$w cget \-font] \\ + \-command [list fontchooserFontSelection $w] +} +proc fontchooserFontSelection {w font args} { + $w configure \-font [font actual $font] +} +fontchooserDemo +.CE +.SH "SEE ALSO" +font(n), tk(n) +.SH KEYWORDS +dialog, font, font selection, font chooser, font panel +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/frame.n b/doc/frame.n index 7eaed62..72a22db 100644 --- a/doc/frame.n +++ b/doc/frame.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -frame \- Create and manipulate frame widgets +frame \- Create and manipulate 'frame' simple container widgets .SH SYNOPSIS \fBframe\fR \fIpathName\fR ?\fIoptions\fR? .SO @@ -20,7 +20,7 @@ frame \- Create and manipulate frame widgets .SE .SH "WIDGET-SPECIFIC OPTIONS" .OP \-background background Background -This option is the same as the standard \fBbackground\fR option +This option is the same as the standard \fB\-background\fR option except that its value may also be specified as an empty string. In this case, the widget will display no background or border, and no colors will be consumed from its colormap for its background @@ -30,7 +30,7 @@ Specifies a class for the window. This class will be used when querying the option database for the window's other options, and it will also be used later for other purposes such as bindings. -The \fBclass\fR option may not be changed with the \fBconfigure\fR +The \fB\-class\fR option may not be changed with the \fBconfigure\fR widget command. .OP \-colormap colormap Colormap Specifies a colormap to use for the window. @@ -39,7 +39,7 @@ created for the window and its children, or the name of another window (which must be on the same screen and have the same visual as \fIpathName\fR), in which case the new window will use the colormap from the specified window. -If the \fBcolormap\fR option is not specified, the new window +If the \fB\-colormap\fR option is not specified, the new window uses the same colormap as its parent. This option may not be changed with the \fBconfigure\fR widget command. @@ -52,7 +52,7 @@ things like geometry requests. The window should not have any children of its own in this application. This option may not be changed with the \fBconfigure\fR widget command. -Note that \fB-borderwidth\fR, \fB-padx\fR and \fB-pady\fR are ignored when +Note that \fB\-borderwidth\fR, \fB\-padx\fR and \fB\-pady\fR are ignored when configured as a container since a container has no border. .OP \-height height Height Specifies the desired height for the window in any of the forms @@ -67,7 +67,7 @@ Specifies visual information for the new window in any of the forms accepted by \fBTk_GetVisual\fR. If this option is not specified, the new window will use the same visual as its parent. -The \fBvisual\fR option may not be modified with the \fBconfigure\fR +The \fB\-visual\fR option may not be modified with the \fBconfigure\fR widget command. .OP \-width width Width Specifies the desired width for the window in any of the forms @@ -134,3 +134,6 @@ frames are not intended to be interactive. labelframe(n), toplevel(n), ttk::frame(n) .SH KEYWORDS frame, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n index a57143e..f5e92ff 100644 --- a/doc/getOpenFile.n +++ b/doc/getOpenFile.n @@ -42,6 +42,7 @@ confirmation dialog be presented to the user. A false value requests that the overwrite take place without confirmation. Default value is true. .TP \fB\-defaultextension\fR \fIextension\fR +. Specifies a string that will be appended to the filename if the user enters a filename without an extension. The default value is the empty string, which means no extension will be appended to the filename in @@ -51,6 +52,7 @@ and the UNIX implementation guesses reasonable values for this from the \fB\-filetypes\fR option when this is not supplied. .TP \fB\-filetypes\fR \fIfilePatternList\fR +. If a \fBFile types\fR listbox exists in the file dialog on the particular platform, this option gives the \fIfiletype\fRs in this listbox. When the user choose a filetype in the listbox, only the files of that type @@ -61,32 +63,42 @@ types. See the section \fBSPECIFYING FILE PATTERNS\fR below for a discussion on the contents of \fIfilePatternList\fR. .TP \fB\-initialdir\fR \fIdirectory\fR +. Specifies that the files in \fIdirectory\fR should be displayed -when the dialog pops up. If this parameter is not specified, then -the files in the current working directory are displayed. If the +when the dialog pops up. If this parameter is not specified, +the initial directory defaults to the current working directory +on non-Windows systems and on Windows systems prior to Vista. +On Vista and later systems, the initial directory defaults to the last +user-selected directory for the application. If the parameter specifies a relative path, the return value will convert the relative path to an absolute path. .TP \fB\-initialfile\fR \fIfilename\fR +. Specifies a filename to be displayed in the dialog when it pops up. .TP \fB\-message\fR \fIstring\fR +. Specifies a message to include in the client area of the dialog. This is only available on Mac OS X. .TP \fB\-multiple\fR \fIboolean\fR +. Allows the user to choose multiple files from the Open dialog. .TP \fB\-parent\fR \fIwindow\fR +. Makes \fIwindow\fR the logical parent of the file dialog. The file dialog is displayed on top of its parent window. On Mac OS X, this turns the file dialog into a sheet attached to the parent window. .TP \fB\-title\fR \fItitleString\fR +. Specifies a string to display as the title of the dialog box. If this option is not specified, then a default title is displayed. .TP \fB\-typevariable\fR \fIvariableName\fR +. The global variable \fIvariableName\fR is used to preselect which filter is used from \fIfilterList\fR when the dialog box is opened and is updated when the dialog box is closed, to the last selected @@ -163,6 +175,7 @@ Extensions without a full stop character (e.g. .QW ~ ) are allowed but may not work on all platforms. .SH EXAMPLE +.PP .CS set types { {{Text Files} {.txt} } @@ -172,9 +185,9 @@ set types { {{GIF Files} {} GIFF} {{All Files} * } } -set filename [tk_getOpenFile \-filetypes $types] +set filename [\fBtk_getOpenFile\fR \-filetypes $types] -if {$filename != ""} { +if {$filename ne ""} { # Open the file ... } .CE @@ -182,3 +195,6 @@ if {$filename != ""} { tk_chooseDirectory .SH KEYWORDS file selection dialog +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -16,7 +16,6 @@ grab \- Confine pointer and keyboard events to a window sub-tree .sp \fBgrab \fIoption \fR?\fIarg arg \fR...? .BE - .SH DESCRIPTION .PP This command implements simple pointer and keyboard grabs for Tk. @@ -102,6 +101,7 @@ Returns \fBnone\fR if no grab is currently set on \fIwindow\fR, \fBlocal\fR if a local grab is set on \fIwindow\fR, and \fBglobal\fR if a global grab is set. .SH WARNING +.PP It is very easy to use global grabs to render a display completely unusable (e.g. by setting a grab on a widget which does not respond to events and not providing any mechanism for releasing the grab). Take @@ -121,6 +121,7 @@ only one of those applications can have a local grab for a given display at any given time. If the applications are in different processes, this restriction does not exist. .SH EXAMPLE +.PP Set a grab so that only one button may be clicked out of a group. The other buttons are unresponsive to the mouse until the middle button is clicked. @@ -130,6 +131,10 @@ pack [button .b2 \-text "Click me! #2" \-command {destroy .b2}] pack [button .b3 \-text "Click me! #3" \-command {destroy .b3}] \fBgrab\fR .b2 .CE - +.SH "SEE ALSO" +busy(n) .SH KEYWORDS grab, keyboard events, pointer events, window +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -22,44 +22,44 @@ The \fBgrid\fR command can have any of several forms, depending on the \fIoption\fR argument: .TP \fBgrid \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR? +. If the first argument to \fBgrid\fR is suitable as the first slave argument to \fBgrid configure\fR, either a window name (any value -starting with \fB.\fR) or one of the characters \fBx\fR or \fB^\fR +starting with \fB.\fR) or one of the characters \fBx\fR or \fB^\fR (see the \fBRELATIVE PLACEMENT\fR section below), then the command is processed in the same way as \fBgrid configure\fR. -.VS 8.5 .TP \fBgrid anchor \fImaster\fR ?\fIanchor\fR? +. The anchor value controls how to place the grid within the master when no row/column has any weight. See \fBTHE GRID ALGORITHM\fR below for further details. The default \fIanchor\fR is \fInw\fR. -.VE 8.5 .TP \fBgrid bbox \fImaster\fR ?\fIcolumn row\fR? ?\fIcolumn2 row2\fR? -With no arguments, +. +With no arguments, the bounding box (in pixels) of the grid is returned. The return value consists of 4 integers. The first two are the pixel offset from the master window (x then y) of the top-left corner of the grid, and the second two integers are the width and height of the grid, -also in pixels. If a single \fIcolumn\fR and \fIrow\fR is specified on +also in pixels. If a single \fIcolumn\fR and \fIrow\fR is specified on the command line, then the bounding box for that cell is returned, where the top left cell is numbered from zero. If both \fIcolumn\fR and \fIrow\fR arguments are specified, then the bounding box spanning the rows and columns indicated is returned. .TP \fBgrid columnconfigure \fImaster index \fR?\fI\-option value...\fR? -Query or set the column properties of the \fIindex\fR column of the +. +Query or set the column properties of the \fIindex\fR column of the geometry master, \fImaster\fR. The valid options are \fB\-minsize\fR, \fB\-weight\fR, \fB\-uniform\fR and \fB\-pad\fR. -If one or more options are provided, then \fIindex\fR may be given as +If one or more options are provided, then \fIindex\fR may be given as a list of column indices to which the configuration options will operate on. -.VS 8.5 Indices may be integers, window names or the keyword \fIall\fR. For \fIall\fR the options apply to all columns currently occupied be slave windows. For a window name, that window must be a slave of this master and the options apply to all columns currently occupied be the slave. -.VE 8.5 The \fB\-minsize\fR option sets the minimum size, in screen units, that will be permitted for this column. The \fB\-weight\fR option (an integer value) @@ -86,10 +86,11 @@ are returned in a list of pairs. .TP \fBgrid configure \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR? +. The arguments consist of the names of one or more slave windows followed by pairs of arguments that specify how to manage the slaves. -The characters \fB\-\fR, \fBx\fR and \fB^\fR, +The characters \fB\-\fR, \fBx\fR and \fB^\fR, can be specified instead of a window name to alter the default location of a \fIslave\fR, as described in the \fBRELATIVE PLACEMENT\fR section, below. @@ -97,6 +98,7 @@ The following options are supported: .RS .TP \fB\-column \fIn\fR +. Insert the slave so that it occupies the \fIn\fRth column in the grid. Column numbers start with 0. If this option is not supplied, then the slave is arranged just to the right of previous slave specified on this @@ -108,17 +110,20 @@ is incremented by one. Thus the \fBx\fR represents a blank column for this row in the grid. .TP \fB\-columnspan \fIn\fR +. Insert the slave so that it occupies \fIn\fR columns in the grid. The default is one column, unless the window name is followed by a \fB\-\fR, in which case the columnspan is incremented once for each immediately following \fB\-\fR. .TP \fB\-in \fIother\fR +. Insert the slave(s) in the master window given by \fIother\fR. The default is the first slave's parent window. .TP \fB\-ipadx \fIamount\fR +. The \fIamount\fR specifies how much horizontal internal padding to leave on each side of the slave(s). This is space is added inside the slave(s) border. @@ -126,12 +131,14 @@ The \fIamount\fR must be a valid screen distance, such as \fB2\fR or \fB.5c\fR. It defaults to 0. .TP \fB\-ipady \fIamount\fR +. The \fIamount\fR specifies how much vertical internal padding to leave on the top and bottom of the slave(s). This space is added inside the slave(s) border. The \fIamount\fR defaults to 0. .TP \fB\-padx \fIamount\fR +. The \fIamount\fR specifies how much horizontal external padding to leave on each side of the slave(s), in screen units. \fIAmount\fR may be a list @@ -140,6 +147,7 @@ The \fIamount\fR defaults to 0. This space is added outside the slave(s) border. .TP \fB\-pady \fIamount\fR +. The \fIamount\fR specifies how much vertical external padding to leave on the top and bottom of the slave(s), in screen units. \fIAmount\fR may be a list @@ -148,12 +156,14 @@ The \fIamount\fR defaults to 0. This space is added outside the slave(s) border. .TP \fB\-row \fIn\fR +. Insert the slave so that it occupies the \fIn\fRth row in the grid. Row numbers start with 0. If this option is not supplied, then the slave is arranged on the same row as the previous slave specified on this call to \fBgrid\fR, or the first unoccupied row if this is the first slave. .TP \fB\-rowspan \fIn\fR +. Insert the slave so that it occupies \fIn\fR rows in the grid. The default is one row. If the next \fBgrid\fR command contains \fB^\fR characters instead of \fIslaves\fR that line up with the columns @@ -161,6 +171,7 @@ of this \fIslave\fR, then the \fBrowspan\fR of this \fIslave\fR is extended by one. .TP \fB\-sticky \fIstyle\fR +. If a slave's cell is larger than its requested dimensions, this option may be used to position (or stretch) the slave within its cell. \fIStyle\fR is a string that contains zero or more of the characters @@ -171,7 +182,7 @@ east, or west) that the slave will .QW stick to. If both \fBn\fR and \fBs\fR (or \fBe\fR and \fBw\fR) are specified, the slave will be stretched to fill the entire -height (or width) of its cavity. The \fBsticky\fR option subsumes the +height (or width) of its cavity. The \fB\-sticky\fR option subsumes the combination of \fB\-anchor\fR and \fB\-fill\fR that is used by \fBpack\fR. The default is .QW "" , @@ -183,6 +194,7 @@ than receiving default values. .RE .TP \fBgrid forget \fIslave \fR?\fIslave ...\fR? +. Removes each of the \fIslave\fRs from grid for its master and unmaps their windows. The slaves will no longer be managed by the grid geometry manager. @@ -191,6 +203,7 @@ slave is managed once more by the grid geometry manager, the initial default settings are used. .TP \fBgrid info \fIslave\fR +. Returns a list whose elements are the current configuration state of the slave given by \fIslave\fR in the same option-value form that might be specified to \fBgrid configure\fR. @@ -199,12 +212,14 @@ The first two elements of the list are where \fImaster\fR is the slave's master. .TP \fBgrid location \fImaster x y\fR -Given \fIx\fR and \fIy\fR values in screen units relative to the master window, +. +Given \fIx\fR and \fIy\fR values in screen units relative to the master window, the column and row number at that \fIx\fR and \fIy\fR location is returned. For locations that are above or to the left of the grid, \fB\-1\fR is returned. .TP \fBgrid propagate \fImaster\fR ?\fIboolean\fR? +. If \fIboolean\fR has a true boolean value such as \fB1\fR or \fBon\fR then propagation is enabled for \fImaster\fR, which must be a window name (see \fBGEOMETRY PROPAGATION\fR below). @@ -217,18 +232,17 @@ for \fImaster\fR. Propagation is enabled by default. .TP \fBgrid rowconfigure \fImaster index \fR?\fI\-option value...\fR? -Query or set the row properties of the \fIindex\fR row of the +. +Query or set the row properties of the \fIindex\fR row of the geometry master, \fImaster\fR. The valid options are \fB\-minsize\fR, \fB\-weight\fR, \fB\-uniform\fR and \fB\-pad\fR. -If one or more options are provided, then \fIindex\fR may be given as +If one or more options are provided, then \fIindex\fR may be given as a list of row indices to which the configuration options will operate on. -.VS 8.5 Indices may be integers, window names or the keyword \fIall\fR. For \fIall\fR the options apply to all rows currently occupied be slave windows. For a window name, that window must be a slave of this master and the options apply to all rows currently occupied be the slave. -.VE 8.5 The \fB\-minsize\fR option sets the minimum size, in screen units, that will be permitted for this row. The \fB\-weight\fR option (an integer value) @@ -255,6 +269,7 @@ are returned in a list of pairs. .TP \fBgrid remove \fIslave \fR?\fIslave ...\fR? +. Removes each of the \fIslave\fRs from grid for its master and unmaps their windows. The slaves will no longer be managed by the grid geometry manager. @@ -264,12 +279,14 @@ slave is managed once more by the grid geometry manager, the previous values are retained. .TP \fBgrid size \fImaster\fR +. Returns the size of the grid (in columns then rows) for \fImaster\fR. The size is determined either by the \fIslave\fR occupying the largest -row or column, or the largest column or row with a \fBminsize\fR, -\fBweight\fR, or \fBpad\fR that is non-zero. +row or column, or the largest column or row with a \fB\-minsize\fR, +\fB\-weight\fR, or \fB\-pad\fR that is non-zero. .TP \fBgrid slaves \fImaster\fR ?\fI\-option value\fR? +. If no options are supplied, a list of all of the slaves in \fImaster\fR are returned, most recently manages first. \fIOption\fR can be either \fB\-row\fR or \fB\-column\fR which @@ -278,13 +295,13 @@ to be returned. .SH "RELATIVE PLACEMENT" .PP The \fBgrid\fR command contains a limited set of capabilities that -permit layouts to be created without specifying the row and column -information for each slave. This permits slaves to be rearranged, +permit layouts to be created without specifying the row and column +information for each slave. This permits slaves to be rearranged, added, or removed without the need to explicitly specify row and column information. -When no column or row information is specified for a \fIslave\fR, +When no column or row information is specified for a \fIslave\fR, default values are chosen for -\fBcolumn\fR, \fBrow\fR, \fBcolumnspan\fR and \fBrowspan\fR +\fB\-column\fR, \fB\-row\fR, \fB\-columnspan\fR and \fB\-rowspan\fR at the time the \fIslave\fR is managed. The values are chosen based upon the current layout of the grid, the position of the \fIslave\fR relative to other \fIslave\fRs in the same grid command, and the presence @@ -293,17 +310,20 @@ command where \fIslave\fR names are normally expected. .RS .TP \fB\-\fR -This increases the columnspan of the \fIslave\fR to the left. Several -\fB\-\fR's in a row will successively increase the columnspan. A \fB\-\fR +. +This increases the \fB\-columnspan\fR of the \fIslave\fR to the left. Several +\fB\-\fR's in a row will successively increase the number of columns spanned. A \fB\-\fR may not follow a \fB^\fR or a \fBx\fR, nor may it be the first \fIslave\fR argument to \fBgrid configure\fR. .TP \fBx\fR +. This leaves an empty column between the \fIslave\fR on the left and the \fIslave\fR on the right. .TP \fB^\fR -This extends the \fBrowspan\fR of the \fIslave\fR above the \fB^\fR's +. +This extends the \fB\-rowspan\fR of the \fIslave\fR above the \fB^\fR's in the grid. The number of \fB^\fR's in a row must match the number of columns spanned by the \fIslave\fR above it. .RE @@ -320,12 +340,12 @@ For the final step, each slave is positioned in its row(s) and column(s) based on the setting of its \fIsticky\fR flag. .PP To compute the minimum size of a layout, the grid geometry manager -first looks at all slaves whose columnspan and rowspan values are one, +first looks at all slaves whose \fB\-columnspan\fR and \fB\-rowspan\fR values are one, and computes the nominal size of each row or column to be either the \fIminsize\fR for that row or column, or the sum of the \fIpad\fRding plus the size of the largest slave, whichever is greater. After that the rows or columns in each uniform group adapt to each other. Then -the slaves whose rowspans or columnspans are greater than one are +the slaves whose row-spans or column-spans are greater than one are examined. If a group of rows or columns need to be increased in size in order to accommodate these slaves, then extra space is added to each row or column in the group according to its \fIweight\fR. For each @@ -337,9 +357,9 @@ allocated to them is always in proportion to their weights. (A weight of zero is considered to be 1.) In other words, a row or column configured with \fB\-weight 1 \-uniform a\fR will have exactly the same size as any other row or column configured with \fB\-weight 1 \-uniform -a\fR. A row or column configured with \fB\-weight 2 \-uniform b\fR will +a\fR. A row or column configured with \fB\-weight 2 \-uniform b\fR will be exactly twice as large as one that is configured with \fB\-weight 1 -\-uniform b\fR. +\-uniform b\fR. .PP More technically, each row or column in the group will have a size equal to \fIk*weight\fR for some constant \fIk\fR. The constant @@ -348,18 +368,16 @@ minimum size. For example, if all rows or columns in a group have the same weight, then each row or column will have the same size as the largest row or column in the group. .PP -.VS 8.5 For masters whose size is larger than the requested layout, the additional space is apportioned according to the row and column weights. If all of the weights are zero, the layout is placed within its master according to the \fIanchor\fR value. For masters whose size is smaller than the requested layout, space is taken -away from columns and rows according to their weights. However, once a +away from columns and rows according to their weights. However, once a column or row shrinks to its minsize, its weight is taken to be zero. If more space needs to be removed from a layout than would be permitted, as when all the rows or columns are at their minimum sizes, the layout is placed and clipped according to the \fIanchor\fR value. -.VE 8.5 .SH "GEOMETRY PROPAGATION" .PP The grid geometry manager normally computes how large a master must be to @@ -397,7 +415,9 @@ The \fBgrid\fR command is based on ideas taken from the \fIGridBag\fR geometry manager written by Doug. Stein, and the \fBblt_table\fR geometry manager, written by George Howlett. .SH EXAMPLES +.PP A toplevel window containing a text widget and two scrollbars: +.PP .CS # Make the widgets toplevel .t @@ -417,6 +437,7 @@ scrollbar .t.h \-orient horizontal \-command {.t.txt xview} Three widgets of equal width, despite their different .QW natural widths: +.PP .CS button .b \-text "Foo" entry .e \-variable foo @@ -429,3 +450,6 @@ label .l \-text "This is a fairly long piece of text" pack(n), place(n) .SH KEYWORDS geometry manager, location, grid, cell, propagation, size, pack +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/image.n b/doc/image.n index c4cfbfd..fd51cc0 100644 --- a/doc/image.n +++ b/doc/image.n @@ -14,7 +14,6 @@ image \- Create and manipulate images .SH SYNOPSIS \fBimage\fR \fIoption \fR?\fIarg arg ...\fR? .BE - .SH DESCRIPTION .PP The \fBimage\fR command is used to create, delete, and query images. @@ -94,9 +93,10 @@ See the \fBbitmap\fR manual entry for more information. Displays a variety of full-color images, using dithering to approximate colors on displays with limited color capabilities. See the \fBphoto\fR manual entry for more information. - .SH "SEE ALSO" bitmap(n), options(n), photo(n) - .SH KEYWORDS height, image, types of images, width +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/keysyms.n b/doc/keysyms.n index c599bca..bf81440 100644 --- a/doc/keysyms.n +++ b/doc/keysyms.n @@ -9,11 +9,11 @@ .SH NAME keysyms \- keysyms recognized by Tk .BE - .SH DESCRIPTION .PP -Tk recognizes many keysyms when specifying key bindings (e.g. -\fBbind . <Key-\fR\fIkeysym\fR\fB>\fR). The following list enumerates the +Tk recognizes many keysyms when specifying key bindings (e.g., +.QW "\fBbind\fR \fB. <Key-\fR\fIkeysym\fR\fB>\fR" ). +The following list enumerates the keysyms that will be recognized by Tk. Note that not all keysyms will be valid on all platforms. For example, on Unix systems, the presence of a particular keysym is dependant on the configuration of the @@ -919,9 +919,10 @@ Hyper_L 65517 0xffed Hyper_R 65518 0xffee Delete 65535 0xffff .CE - .SH "SEE ALSO" -bind - +bind(n), event(n) .SH KEYWORDS -keysym, bind, binding +bind, binding, event, keysym +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/label.n b/doc/label.n index 9bbc9e0..f2ba88c 100644 --- a/doc/label.n +++ b/doc/label.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -label \- Create and manipulate label widgets +label \- Create and manipulate 'label' non-interactive text or image widgets .SH SYNOPSIS \fBlabel\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -34,10 +34,10 @@ from the size of the image or bitmap or text being displayed in it. .OP \-state state State Specifies one of three states for the label: \fBnormal\fR, \fBactive\fR, or \fBdisabled\fR. In normal state the button is displayed using the -\fBforeground\fR and \fBbackground\fR options. In active state -the label is displayed using the \fBactiveForeground\fR and -\fBactiveBackground\fR options. In the disabled state the -\fBdisabledForeground\fR and \fBbackground\fR options determine how +\fB\-foreground\fR and \fB\-background\fR options. In active state +the label is displayed using the \fB\-activeforeground\fR and +\fB\-activebackground\fR options. In the disabled state the +\fB\-disabledforeground\fR and \fB\-background\fR options determine how the button is displayed. .OP \-width width Width Specifies a desired width for the label. @@ -63,9 +63,9 @@ there must not exist a window named \fIpathName\fR, but A label is a widget that displays a textual string, bitmap or image. If text is displayed, it must all be in a single font, but it can occupy multiple lines on the screen (if it contains newlines -or if wrapping occurs because of the \fBwrapLength\fR option) and +or if wrapping occurs because of the \fB\-wraplength\fR option) and one of the characters may optionally be underlined using the -\fBunderline\fR option. +\fB\-underline\fR option. The label can be manipulated in a few simple ways, such as changing its relief or text, using the commands described below. .SH "WIDGET COMMAND" @@ -105,6 +105,7 @@ command. When a new label is created, it has no default event bindings: labels are not intended to be interactive. .SH EXAMPLE +.PP .CS # Make the widgets \fBlabel\fR .t \-text "This widget is at the top" \-bg red @@ -124,3 +125,6 @@ pack .mid \-expand 1 \-fill both labelframe(n), button(n), ttk::label(n) .SH KEYWORDS label, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/labelframe.n b/doc/labelframe.n index cea4804..857208e 100644 --- a/doc/labelframe.n +++ b/doc/labelframe.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -labelframe \- Create and manipulate labelframe widgets +labelframe \- Create and manipulate 'labelframe' labelled container widgets .SH SYNOPSIS \fBlabelframe\fR \fIpathName\fR ?\fIoptions\fR? .SO @@ -21,7 +21,7 @@ labelframe \- Create and manipulate labelframe widgets .SE .SH "WIDGET-SPECIFIC OPTIONS" .OP \-background background Background -This option is the same as the standard \fBbackground\fR option +This option is the same as the standard \fB\-background\fR option except that its value may also be specified as an empty string. In this case, the widget will display no background or border, and no colors will be consumed from its colormap for its background @@ -31,7 +31,7 @@ Specifies a class for the window. This class will be used when querying the option database for the window's other options, and it will also be used later for other purposes such as bindings. -The \fBclass\fR option may not be changed with the \fBconfigure\fR +The \fB\-class\fR option may not be changed with the \fBconfigure\fR widget command. .OP \-colormap colormap Colormap Specifies a colormap to use for the window. @@ -40,7 +40,7 @@ created for the window and its children, or the name of another window (which must be on the same screen and have the same visual as \fIpathName\fR), in which case the new window will use the colormap from the specified window. -If the \fBcolormap\fR option is not specified, the new window +If the \fB\-colormap\fR option is not specified, the new window uses the same colormap as its parent. This option may not be changed with the \fBconfigure\fR widget command. @@ -66,7 +66,7 @@ Specifies visual information for the new window in any of the forms accepted by \fBTk_GetVisual\fR. If this option is not specified, the new window will use the same visual as its parent. -The \fBvisual\fR option may not be modified with the \fBconfigure\fR +The \fB\-visual\fR option may not be modified with the \fBconfigure\fR widget command. .OP \-width width Width Specifies the desired width for the window in any of the forms @@ -126,6 +126,7 @@ command. When a new labelframe is created, it has no default event bindings: labelframes are not intended to be interactive. .SH EXAMPLE +.PP This shows how to build part of a GUI for a hamburger vendor. The \fBlabelframe\fR widgets are used to organize the available choices by the kinds of things that the choices are being made over. @@ -169,3 +170,6 @@ set pickle none frame(n), label(n), ttk::labelframe(n) .SH KEYWORDS labelframe, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/listbox.n b/doc/listbox.n index 642e1f0..9f34b5e 100644 --- a/doc/listbox.n +++ b/doc/listbox.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -listbox \- Create and manipulate listbox widgets +listbox \- Create and manipulate 'listbox' item list widgets .SH SYNOPSIS \fBlistbox\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -75,7 +75,7 @@ When first created, a new listbox has no elements. Elements may be added or deleted using widget commands described below. In addition, one or more elements may be selected as described below. -If a listbox is exporting its selection (see \fBexportSelection\fR +If a listbox is exporting its selection (see \fB\-exportselection\fR option), then it will observe the standard X11 protocols for handling the selection. Listbox selections are available as type \fBSTRING\fR; @@ -85,8 +85,8 @@ newlines separating the elements. It is not necessary for all the elements to be displayed in the listbox window at once; commands described below may be used to change the view in the window. Listboxes allow -scrolling in both directions using the standard \fBxScrollCommand\fR -and \fByScrollCommand\fR options. +scrolling in both directions using the standard \fB\-xscrollcommand\fR +and \fB\-yscrollcommand\fR options. They also support scanning, as described below. .SH "INDICES" .PP @@ -96,20 +96,24 @@ An index specifies a particular element of the listbox, in any of the following ways: .TP 12 \fInumber\fR +. Specifies the element as a numerical index, where 0 corresponds to the first element in the listbox. .TP 12 \fBactive\fR +. Indicates the element that has the location cursor. This element will be displayed as specified by \fB\-activestyle\fR when the listbox has the keyboard focus, and it is specified with the \fBactivate\fR widget command. .TP 12 \fBanchor\fR +. Indicates the anchor point for the selection, which is set with the \fBselection anchor\fR widget command. .TP 12 \fBend\fR +. Indicates the end of the listbox. For most commands this refers to the last element in the listbox, but for a few commands such as \fBindex\fR and \fBinsert\fR @@ -138,6 +142,7 @@ determine the exact behavior of the command. The following commands are possible for listbox widgets: .TP \fIpathName \fBactivate\fR \fIindex\fR +. Sets the active element to the one indicated by \fIindex\fR. If \fIindex\fR is outside the range of elements in the listbox then the closest element is activated. @@ -146,6 +151,7 @@ widget has the input focus, and its index may be retrieved with the index \fBactive\fR. .TP \fIpathName \fBbbox\fR \fIindex\fR +. Returns a list of four numbers describing the bounding box of the text in the element given by \fIindex\fR. The first two elements of the list give the x and y coordinates @@ -160,12 +166,14 @@ partially visible, the result gives the full area of the element, including any parts that are not visible. .TP \fIpathName \fBcget\fR \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBlistbox\fR command. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for @@ -180,18 +188,21 @@ this case the command returns an empty string. command. .TP \fIpathName \fBcurselection\fR +. Returns a list containing the numerical indices of all of the elements in the listbox that are currently selected. If there are no elements selected in the listbox then an empty string is returned. .TP \fIpathName \fBdelete \fIfirst \fR?\fIlast\fR? +. Deletes one or more elements of the listbox. \fIFirst\fR and \fIlast\fR are indices specifying the first and last elements in the range to delete. If \fIlast\fR is not specified it defaults to \fIfirst\fR, i.e. a single element is deleted. .TP \fIpathName \fBget \fIfirst\fR ?\fIlast\fR? +. If \fIlast\fR is omitted, returns the contents of the listbox element indicated by \fIfirst\fR, or an empty string if \fIfirst\fR refers to a non-existent element. @@ -202,22 +213,26 @@ Both \fIfirst\fR and \fIlast\fR may have any of the standard forms for indices. .TP \fIpathName \fBindex \fIindex\fR +. Returns the integer index value that corresponds to \fIindex\fR. If \fIindex\fR is \fBend\fR the return value is a count of the number of elements in the listbox (not the index of the last element). .TP \fIpathName \fBinsert \fIindex \fR?\fIelement element ...\fR? +. Inserts zero or more new elements in the list just before the element given by \fIindex\fR. If \fIindex\fR is specified as \fBend\fR then the new elements are added to the end of the list. Returns an empty string. .TP \fIpathName \fBitemcget \fIindex option\fR +. Returns the current value of the item configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted -by the \fBlistbox itemconfigure\fR command. +by the \fBitemconfigure\fR command. .TP \fIpathName \fBitemconfigure \fIindex\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR? +. Query or modify the configuration options of an item in the listbox. If no \fIoption\fR is specified, returns a list describing all of the available options for the item (see \fBTk_ConfigureInfo\fR for @@ -232,40 +247,48 @@ are currently supported for items: .RS .TP \fB\-background \fIcolor\fR +. \fIColor\fR specifies the background color to use when displaying the item. It may have any of the forms accepted by \fBTk_GetColor\fR. .TP \fB\-foreground \fIcolor\fR +. \fIColor\fR specifies the foreground color to use when displaying the item. It may have any of the forms accepted by \fBTk_GetColor\fR. .TP \fB\-selectbackground \fIcolor\fR +. \fIcolor\fR specifies the background color to use when displaying the item while it is selected. It may have any of the forms accepted by \fBTk_GetColor\fR. .TP \fB\-selectforeground \fIcolor\fR +. \fIcolor\fR specifies the foreground color to use when displaying the item while it is selected. It may have any of the forms accepted by \fBTk_GetColor\fR. .RE .TP \fIpathName \fBnearest \fIy\fR +. Given a y-coordinate within the listbox window, this command returns the index of the (visible) listbox element nearest to that y-coordinate. .TP \fIpathName \fBscan\fR \fIoption args\fR +. This command is used to implement scanning on listboxes. It has two forms, depending on \fIoption\fR: .RS .TP \fIpathName \fBscan mark \fIx y\fR +. Records \fIx\fR and \fIy\fR and the current view in the listbox window; used in conjunction with later \fBscan dragto\fR commands. Typically this command is associated with a mouse button press in the widget. It returns an empty string. .TP \fIpathName \fBscan dragto \fIx y\fR. +. This command computes the difference between its \fIx\fR and \fIy\fR arguments and the \fIx\fR and \fIy\fR arguments to the last \fBscan mark\fR command for the widget. @@ -277,6 +300,7 @@ value is an empty string. .RE .TP \fIpathName \fBsee \fIindex\fR +. Adjust the view in the listbox so that the element given by \fIindex\fR is visible. If the element is already visible then the command has no effect; @@ -285,11 +309,13 @@ scrolls to bring the element into view at the edge; otherwise the listbox scrolls to center the element. .TP \fIpathName \fBselection \fIoption arg\fR +. This command is used to adjust the selection within a listbox. It has several forms, depending on \fIoption\fR: .RS .TP \fIpathName \fBselection anchor \fIindex\fR +. Sets the selection anchor to the element given by \fIindex\fR. If \fIindex\fR refers to a non-existent element, then the closest element is used. @@ -299,32 +325,38 @@ The index \fBanchor\fR may be used to refer to the anchor element. .TP \fIpathName \fBselection clear \fIfirst \fR?\fIlast\fR? +. If any of the elements between \fIfirst\fR and \fIlast\fR (inclusive) are selected, they are deselected. The selection state is not changed for elements outside this range. .TP \fIpathName \fBselection includes \fIindex\fR +. Returns 1 if the element indicated by \fIindex\fR is currently selected, 0 if it is not. .TP \fIpathName \fBselection set \fIfirst \fR?\fIlast\fR? +. Selects all of the elements in the range between \fIfirst\fR and \fIlast\fR, inclusive, without affecting the selection state of elements outside that range. .RE .TP \fIpathName \fBsize\fR +. Returns a decimal string indicating the total number of elements in the listbox. .TP -\fIpathName \fBxview \fIargs\fR +\fIpathName \fBxview \fR?\fIargs\fR +. This command is used to query and change the horizontal position of the information in the widget's window. It can take any of the following forms: .RS .TP \fIpathName \fBxview\fR +. Returns a list containing two elements. Each element is a real fraction between 0 and 1; together they describe the horizontal span that is visible in the window. @@ -334,17 +366,20 @@ in the window, and 40% of the text is off-screen to the right. These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR option. .TP -\fIpathName \fBxview\fR \fIindex\fR +\fIpathName \fBxview \fIindex\fR +. Adjusts the view in the window so that the character position given by \fIindex\fR is displayed at the left edge of the window. Character positions are defined by the width of the character \fB0\fR. .TP \fIpathName \fBxview moveto\fI fraction\fR +. Adjusts the view in the window so that \fIfraction\fR of the total width of the listbox text is off-screen to the left. \fIfraction\fR must be a fraction between 0 and 1. .TP \fIpathName \fBxview scroll \fInumber what\fR +. This command shifts the view in the window left or right according to \fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer. @@ -359,7 +394,8 @@ become visible; if it is positive then characters farther to the right become visible. .RE .TP -\fIpathName \fByview \fI?args\fR? +\fIpathName \fByview \fR?\fIargs\fR? +. This command is used to query and change the vertical position of the text in the widget's window. It can take any of the following forms: @@ -376,11 +412,13 @@ the last one in the window, relative to the listbox as a whole. These are the same values passed to scrollbars via the \fB\-yscrollcommand\fR option. .TP -\fIpathName \fByview\fR \fIindex\fR +\fIpathName \fByview \fIindex\fR +. Adjusts the view in the window so that the element given by \fIindex\fR is displayed at the top of the window. .TP \fIpathName \fByview moveto\fI fraction\fR +. Adjusts the view in the window so that the element given by \fIfraction\fR appears at the top of the window. \fIFraction\fR is a fraction between 0 and 1; 0 indicates the first @@ -388,6 +426,7 @@ element in the listbox, 0.33 indicates the element one-third the way through the listbox, and so on. .TP \fIpathName \fByview scroll \fInumber what\fR +. This command adjusts the view in the window up or down according to \fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer. @@ -403,7 +442,7 @@ become visible. .PP Tk automatically creates class bindings for listboxes that give them Motif-like behavior. Much of the behavior of a listbox is determined -by its \fBselectMode\fR option, which selects one of four ways +by its \fB\-selectmode\fR option, which selects one of four ways of dealing with the selection. .PP If the selection mode is \fBsingle\fR or \fBbrowse\fR, at most one @@ -412,10 +451,8 @@ In both modes, clicking button 1 on an element selects it and deselects any other selected item. In \fBbrowse\fR mode it is also possible to drag the selection with button 1. -.VS 8.5 On button 1, the listbox will also take focus if it has a \fBnormal\fR state. -.VE 8.5 .PP If the selection mode is \fBmultiple\fR or \fBextended\fR, any number of elements may be selected at once, including discontiguous @@ -431,9 +468,12 @@ Most people will probably want to use \fBbrowse\fR mode for single selections and \fBextended\fR mode for multiple selections; the other modes appear to be useful only in special situations. .PP -Any time the selection changes in the listbox, the virtual event -\fB<<ListboxSelect>>\fR will be generated. It is easiest to bind -to this event to be made aware of any changes to listbox selection. +Any time the set of selected item(s) in the listbox is updated by the +user through the keyboard or mouse, the virtual event +\fB<<ListboxSelect>>\fR will be generated. This virtual event will not +be generated when adjusting the selection with the \fIpathName +\fBselection\fR command. It is easiest to bind to this event to be +made aware of any user changes to listbox selection. .PP In addition to the above behavior, the following additional behavior is defined by the default bindings: @@ -533,6 +573,9 @@ a selection. The behavior of listboxes can be changed by defining new bindings for individual widgets or by redefining the class bindings. .SH "SEE ALSO" -ttk_treeview(n) +ttk::treeview(n) .SH KEYWORDS listbox, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/loadTk.n b/doc/loadTk.n index 2b34cc0..d4ec51e 100644 --- a/doc/loadTk.n +++ b/doc/loadTk.n @@ -9,73 +9,61 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -loadTk \- Load Tk into a safe interpreter. +safe::loadTk \- Load Tk into a safe interpreter. .SH SYNOPSIS -\fB::safe::loadTk \fIslave\fR ?\fB\-use\fR \fIwindowId\fR? ?\fB\-display\fR \fIdisplayName\fR? +\fBsafe::loadTk \fIslave\fR ?\fB\-use\fR \fIwindowId\fR? ?\fB\-display\fR \fIdisplayName\fR? .BE .SH DESCRIPTION -Safe Tk is based on Safe Tcl, which provides a mechanism -that allows restricted and mediated -access to auto-loading and packages for safe interpreters. -Safe Tk adds the ability to configure the interpreter -for safe Tk operations and load Tk into safe -interpreters. .PP -The \fB::safe::loadTk\fR command initializes the required data structures -in the named safe interpreter and then loads Tk into it. -The interpreter must have been created with \fB::safe::interpCreate\fR -or have been initialized with \fB::safe::interpInit\fR. -The command returns the name of the safe interpreter. -If \fB\-use\fR is specified, the window identified by the specified system -dependent identifier \fIwindowId\fR is used to contain the +Safe Tk is based on Safe Tcl, which provides a mechanism that allows +restricted and mediated access to auto-loading and packages for safe +interpreters. Safe Tk adds the ability to configure the interpreter for safe +Tk operations and load Tk into safe interpreters. +.PP +The \fBsafe::loadTk\fR command initializes the required data structures in +the named safe interpreter and then loads Tk into it. The interpreter must +have been created with \fBsafe::interpCreate\fR or have been initialized +with \fBsafe::interpInit\fR. The command returns the name of the safe +interpreter. If \fB\-use\fR is specified, the window identified by the +specified system dependent identifier \fIwindowId\fR is used to contain the .QW . -window of the safe interpreter; it can be any valid id, eventually -referencing a window belonging to another application. As a convenience, -if the window you plan to use is a Tk Window of the application you -can use the window name (e.g. \fB.x.y\fR) instead of its window Id -(\fB[winfo id .x.y]\fR). -When \fB\-use\fR is not specified, -a new toplevel window is created for the +window of the safe interpreter; it can be any valid id, eventually referencing +a window belonging to another application. As a convenience, if the window you +plan to use is a Tk Window of the application you can use the window name +(e.g., +.QW \fB.x.y\fR ) +instead of its window Id (e.g., from \fBwinfo id\fR \fB.x.y\fR). +When \fB\-use\fR is not specified, a new toplevel window is created for the .QW . -window of -the safe interpreter. On X11 if you want the embedded window -to use another display than the default one, specify it with -\fB\-display\fR. -See the \fBSECURITY ISSUES\fR section below for implementation details. - +window of the safe interpreter. On X11 if you want the embedded window to use +another display than the default one, specify it with \fB\-display\fR. See +the \fBSECURITY ISSUES\fR section below for implementation details. .SH "SECURITY ISSUES" .PP Please read the \fBsafe\fR manual page for Tcl to learn about the basic security considerations for Safe Tcl. .PP -\fB::safe::loadTk\fR adds the value of \fBtk_library\fR taken from the master +\fBsafe::loadTk\fR adds the value of \fBtk_library\fR taken from the master interpreter to the virtual access path of the safe interpreter so that auto-loading will work in the safe interpreter. .PP +Tk initialization is now safe with respect to not trusting the slave's state +for startup. \fBsafe::loadTk\fR registers the slave's name so when the Tk +initialization (\fBTk_SafeInit\fR) is called and in turn calls the master's +\fBsafe::InitTk\fR it will return the desired \fBargv\fR equivalent +(\fB\-use\fR \fIwindowId\fR, correct \fB\-display\fR, etc.) .PP -Tk initialization is now safe with respect to not trusting -the slave's state for startup. \fB::safe::loadTk\fR -registers the slave's name so -when the Tk initialization (\fBTk_SafeInit\fR) is called -and in turn calls the master's \fB::safe::InitTk\fR it will -return the desired \fBargv\fR equivalent (\fB\-use\fR -\fIwindowId\fR, correct \fB\-display\fR, etc.) -.PP -When \fB\-use\fR is not used, the new toplevel created is specially -decorated so the user is always aware that the user interface presented comes -from a potentially unsafe code and can easily delete the corresponding -interpreter. +When \fB\-use\fR is not used, the new toplevel created is specially decorated +so the user is always aware that the user interface presented comes from a +potentially unsafe code and can easily delete the corresponding interpreter. .PP -On X11, conflicting \fB\-use\fR and \fB\-display\fR are likely -to generate a fatal X error. - +On X11, conflicting \fB\-use\fR and \fB\-display\fR are likely to generate a +fatal X error. .SH "SEE ALSO" safe(n), interp(n), library(n), load(n), package(n), source(n), unknown(n) - .SH KEYWORDS -alias, auto\-loading, auto_mkindex, load, master interpreter, safe +alias, auto-loading, auto_mkindex, load, master interpreter, safe interpreter, slave interpreter, source - '\" Local Variables: '\" mode: nroff '\" End: diff --git a/doc/lower.n b/doc/lower.n index 3a47094..8159a8b 100644 --- a/doc/lower.n +++ b/doc/lower.n @@ -14,7 +14,6 @@ lower \- Change a window's position in the stacking order .SH SYNOPSIS \fBlower \fIwindow \fR?\fIbelowThis\fR? .BE - .SH DESCRIPTION .PP If the \fIbelowThis\fR argument is omitted then the command lowers @@ -28,9 +27,14 @@ In this case the \fBlower\fR command will insert \fIwindow\fR into the stacking order just below \fIbelowThis\fR (or the ancestor of \fIbelowThis\fR that is a sibling of \fIwindow\fR); this could end up either raising or lowering \fIwindow\fR. - +.PP +All \fBtoplevel\fR windows may be restacked with respect to each +other, whatever their relative path names, but the window manager is +not obligated to strictly honor requests to restack. .SH "SEE ALSO" raise - .SH KEYWORDS lower, obscure, stacking order +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -menu, tk_menuSetFocus \- Create and manipulate menu widgets +menu, tk_menuSetFocus \- Create and manipulate 'menu' widgets and menubars .SH SYNOPSIS .nf \fBmenu\fR \fIpathName \fR?\fIoptions\fR? @@ -40,6 +40,8 @@ top. If so, it will exist as entry 0 of the menu and the other entries will number starting at 1. The default menu bindings arrange for the menu to be torn off when the tear-off entry is invoked. +This option is ignored under Aqua/Mac OS X, where menus cannot +be torn off. .OP \-tearoffcommand tearOffCommand TearOffCommand If this option has a non-empty value, then it specifies a Tcl command to invoke whenever the menu is torn off. The actual command will @@ -52,6 +54,8 @@ and menu \fB.x.y\fR is torn off to create a new menu \fB.x.tearoff1\fR, then the command .QW "\fBa b .x.y .x.tearoff1\fR" will be invoked. +This option is ignored under Aqua/Mac OS X, where menus cannot +be torn off. .OP \-title title Title The string will be used to title the window created when this menu is torn off. If the title is NULL, then the window will have the title @@ -69,6 +73,9 @@ library. .PP The \fBmenu\fR command creates a new top-level window (given by the \fIpathName\fR argument) and makes it into a menu widget. +That menu widget can either be used as a pop-up window or applied to a +\fBtoplevel\fR (with its \fB\-menu\fR option) to make it into the menubar for +that toplevel. Additional options, described above, may be specified on the command line or in the option database @@ -203,7 +210,7 @@ supported on Windows. .SS "TEAR-OFF ENTRIES" .PP A tear-off entry appears at the top of the menu if enabled with the -\fBtearOff\fR option. It is not like other menu entries in that +\fB\-tearoff\fR option. It is not like other menu entries in that it cannot be created with the \fBadd\fR widget command and cannot be deleted with the \fBdelete\fR widget command. When a tear-off entry is created it appears as a dashed line at @@ -228,31 +235,43 @@ menubars, they may not be drawn with indicators on some platforms, due to system restrictions. .SS "SPECIAL MENUS IN MENUBARS" .PP -Certain menus in a menubar will be treated specially. On the -Macintosh, access to the special Application and Help menus is -provided. On Windows, access to the Windows System menu in each window -is provided. On X Windows, a special right-justified help menu may be -provided if Motif menu compatibility is enabled. In all cases, these -menus must be created with the command name of the menubar menu -concatenated with the special name. So for a menubar named .menubar, -on the Macintosh, the special menus would be .menubar.apple -and .menubar.help; on Windows, the special menu would be .menubar.system; -on X Windows, the help menu would be .menubar.help. -.PP -When Tk sees a .menubar.apple menu on the Macintosh, that menu's contents -make up the first items of the Application menu whenever the window -containing the menubar is in front. +Certain menus in a menubar will be treated specially. On the Macintosh, +access to the special Application, Window and Help menus is provided. On +Windows, access to the Windows System menu in each window is provided. +On X Windows, a special right-justified help menu may be provided if +Motif menu compatibility is enabled. In all cases, these menus must be +created with the command name of the menubar menu concatenated with the +special name. So for a menubar named .menubar, on the Macintosh, the +special menus would be .menubar.apple, .menubar.window and .menubar.help; +on Windows, the special menu would be .menubar.system; on X Windows, +the help menu would be .menubar.help. +.PP +When Tk sees a .menubar.apple menu as the first menu in a menubar on the +Macintosh, that menu's contents make up the first items of the +Application menu whenever the window containing the menubar is in front. After all of the Tk-defined items, the menu will have a separator, followed by all standard Application menu items. -.PP -When Tk sees a Help menu on the Macintosh, the menu's contents are -appended to the standard Help menu on the right of the user's menubar -whenever the window's menubar is in front. The first items in the menu +Such a .apple menu must be present in a menu when that menu is first +configured as a toplevel's menubar, otherwise a default application menu +(hidden from Tk) will be inserted into the menubar at that time and +subsequent addition of a .apple menu will no longer result in it +becoming the Application menu. +.PP +When Tk sees a .menubar.window menu on the Macintosh, the menu's +contents are inserted into the standard Window menu of the user's +menubar whenever the window's menubar is in front. The first items in +the menu are provided by Mac OS X, and the names of the current +toplevels are automatically appended after all the Tk-defined items and +a separator. +.PP +When Tk sees a .menubar.help menu on the Macintosh, the menu's contents +are appended to the standard Help menu of the user's menubar whenever +the window's menubar is in front. The first items in the menu are provided by Mac OS X. .PP When Tk sees a System menu on Windows, its items are appended to the -system menu that the menubar is attached to. This menu has an icon -representing a spacebar, and can be invoked with the mouse or by typing +system menu that the menubar is attached to. This menu is tied to the +application icon and can be invoked with the mouse or by typing Alt+Spacebar. Due to limitations in the Windows API, any font changes, colors, images, bitmaps, or tearoff images will not appear in the system menu. @@ -290,19 +309,23 @@ indicators are called \fIindex\fRes and may be specified in any of the following forms: .TP 12 \fBactive\fR +. Indicates the entry that is currently active. If no entry is active then this form is equivalent to \fBnone\fR. This form may not be abbreviated. .TP 12 \fBend\fR +. Indicates the bottommost entry in the menu. If there are no entries in the menu then this form is equivalent to \fBnone\fR. This form may not be abbreviated. .TP 12 \fBlast\fR +. Same as \fBend\fR. .TP 12 \fBnone\fR +. Indicates .QW "no entry at all" ; this is used most commonly with @@ -312,6 +335,7 @@ nothing to happen in the widget command. This form may not be abbreviated. .TP 12 \fB@\fInumber\fR +. In this form, \fInumber\fR is treated as a y-coordinate in the menu's window; the entry closest to that y-coordinate is used. For example, @@ -319,15 +343,17 @@ For example, indicates the top-most entry in the window. .TP 12 \fInumber\fR +. Specifies the entry numerically, where 0 corresponds to the top-most entry of the menu, 1 to the entry below it, and so on. .TP 12 \fIpattern\fR +. If the index does not satisfy one of the above forms then this form is used. \fIPattern\fR is pattern-matched against the label of each entry in the menu, in order from the top down, until a -matching entry is found. The rules of \fBTcl_StringMatch\fR +matching entry is found. The rules of \fBstring match\fR are used. .PP If the index could match more than one of the above forms, then @@ -336,6 +362,7 @@ the form earlier in the above list takes precedence. The following widget commands are possible for menu widgets: .TP \fIpathName \fBactivate \fIindex\fR +. Change the state of the entry indicated by \fIindex\fR to \fBactive\fR and redisplay it using its active colors. Any previously-active entry is deactivated. If \fIindex\fR @@ -344,44 +371,185 @@ disabled, then the menu ends up with no active entry. Returns an empty string. .TP \fIpathName \fBadd \fItype \fR?\fIoption value option value ...\fR? +. Add a new entry to the bottom of the menu. The new entry's type is given by \fItype\fR and must be one of \fBcascade\fR, \fBcheckbutton\fR, \fBcommand\fR, \fBradiobutton\fR, or \fBseparator\fR, or a unique abbreviation of one of the above. If additional arguments -are present, they specify any of the following options: -.RS +are present, they specify the options listed in the \fBMENU ENTRY OPTIONS\fR +section below. +The \fBadd\fR widget command returns an empty string. +.TP +\fIpathName \fBcget \fIoption\fR +. +Returns the current value of the configuration option given +by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBmenu\fR +command. +.TP +\fIpathName \fBclone \fInewPathname\fR ?\fIcloneType\fR? +. +Makes a clone of the current menu named \fInewPathName\fR. This clone +is a menu in its own right, but any changes to the clone are +propagated to the original menu and vice versa. \fIcloneType\fR can be +\fBnormal\fR, \fBmenubar\fR, or \fBtearoff\fR. Should not normally be +called outside of the Tk library. See the \fBCLONES\fR section for +more information. +.TP +\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. +Query or modify the configuration options of the widget. +If no \fIoption\fR is specified, returns a list describing all of +the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for +information on the format of this list). If \fIoption\fR is specified +with no \fIvalue\fR, then the command returns a list describing the +one named option (this list will be identical to the corresponding +sublist of the value returned if no \fIoption\fR is specified). If +one or more \fIoption\-value\fR pairs are specified, then the command +modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. +\fIOption\fR may have any of the values accepted by the \fBmenu\fR +command. +.TP +\fIpathName \fBdelete \fIindex1\fR ?\fIindex2\fR? +. +Delete all of the menu entries between \fIindex1\fR and +\fIindex2\fR inclusive. +If \fIindex2\fR is omitted then it defaults to \fIindex1\fR. +Attempts to delete a tear-off menu entry are ignored (instead, you +should change the \fB\-tearoff\fR option to remove the tear-off entry). +.TP +\fIpathName \fBentrycget \fIindex option\fR +. +Returns the current value of a configuration option for +the entry given by \fIindex\fR. +\fIOption\fR may have any of the names described in the +\fBMENU ENTRY OPTIONS\fR section below. +.TP +\fIpathName \fBentryconfigure \fIindex \fR?\fIoptions...\fR? +. +This command is similar to the \fBconfigure\fR command, except that +it applies to the options for an individual entry, whereas \fBconfigure\fR +applies to the options for the menu as a whole. +\fIOptions\fR may have any of the values described in the +\fBMENU ENTRY OPTIONS\fR +section below. If \fIoptions\fR are specified, options are +modified as indicated in the command and the command returns an empty string. +If no \fIoptions\fR are specified, returns a list describing +the current options for entry \fIindex\fR (see \fBTk_ConfigureInfo\fR for +information on the format of this list). +.TP +\fIpathName \fBindex \fIindex\fR +. +Returns the numerical index corresponding to \fIindex\fR, or +\fBnone\fR if \fIindex\fR was specified as \fBnone\fR. +.TP +\fIpathName \fBinsert \fIindex type \fR?\fIoption value option value ...\fR? +. +Same as the \fBadd\fR widget command except that it inserts the new +entry just before the entry given by \fIindex\fR, instead of appending +to the end of the menu. The \fItype\fR, \fIoption\fR, and \fIvalue\fR +arguments have the same interpretation as for the \fBadd\fR widget +command. It is not possible to insert new menu entries before the +tear-off entry, if the menu has one. +.TP +\fIpathName \fBinvoke \fIindex\fR +. +Invoke the action of the menu entry. See the sections on the +individual entries above for details on what happens. If the +menu entry is disabled then nothing happens. If the +entry has a command associated with it then the result of that +command is returned as the result of the \fBinvoke\fR widget +command. Otherwise the result is an empty string. Note: invoking +a menu entry does not automatically unpost the menu; the default +bindings normally take care of this before invoking the \fBinvoke\fR +widget command. +.TP +\fIpathName \fBpost \fIx y\fR +. +Arrange for the menu to be displayed on the screen at the root-window +coordinates given by \fIx\fR and \fIy\fR. These coordinates are +adjusted if necessary to guarantee that the entire menu is visible on +the screen. This command normally returns an empty string. +If the \fB\-postcommand\fR option has been specified, then its value is +executed as a Tcl script before posting the menu and the result of +that script is returned as the result of the \fBpost\fR widget +command. +If an error returns while executing the command, then the error is +returned without posting the menu. +.TP +\fIpathName \fBpostcascade \fIindex\fR +. +Posts the submenu associated with the cascade entry given by +\fIindex\fR, and unposts any previously posted submenu. +If \fIindex\fR does not correspond to a cascade entry, +or if \fIpathName\fR is not posted, +the command has no effect except to unpost any currently posted +submenu. +.TP +\fIpathName \fBtype \fIindex\fR +. +Returns the type of the menu entry given by \fIindex\fR. +This is the \fItype\fR argument passed to the \fBadd\fR or \fBinsert\fR widget +command when the entry was created, such as \fBcommand\fR +or \fBseparator\fR, or \fBtearoff\fR for a tear-off entry. +.TP +\fIpathName \fBunpost\fR +. +Unmap the window so that it is no longer displayed. If a +lower-level cascaded menu is posted, unpost that menu. Returns an +empty string. This subcommand does not work on Windows and the +Macintosh, as those platforms have their own way of unposting menus. +.TP +\fIpathName \fBxposition \fIindex\fR +. +Returns a decimal string giving the x-coordinate within the menu +window of the leftmost pixel in the entry specified by \fIindex\fR. +.TP +\fIpathName \fByposition \fIindex\fR +. +Returns a decimal string giving the y-coordinate within the menu +window of the topmost pixel in the entry specified by \fIindex\fR. +.SH "MENU ENTRY OPTIONS" +The following options are allowed on menu entries. Most options are not +supported by all entry types. .TP \fB\-activebackground \fIvalue\fR +. Specifies a background color to use for displaying this entry when it is active. If this option is specified as an empty string (the default), then the -\fBactiveBackground\fR option for the overall menu is used. +\fB\-activebackground\fR option for the overall menu is used. If the \fBtk_strictMotif\fR variable has been set to request strict Motif compliance, then this option is ignored and the \fB\-background\fR option is used in its place. This option is not available for separator or tear-off entries. .TP \fB\-activeforeground \fIvalue\fR +. Specifies a foreground color to use for displaying this entry when it is active. If this option is specified as an empty string (the default), then the -\fBactiveForeground\fR option for the overall menu is used. +\fB\-activeforeground\fR option for the overall menu is used. This option is not available for separator or tear-off entries. .TP \fB\-accelerator \fIvalue\fR +. Specifies a string to display at the right side of the menu entry. Normally describes an accelerator keystroke sequence that may be typed to invoke the same function as the menu entry. This option is not available for separator or tear-off entries. .TP \fB\-background \fIvalue\fR +. Specifies a background color to use for displaying this entry when it is in the normal state (neither active nor disabled). If this option is specified as an empty string (the default), then the -\fBbackground\fR option for the overall menu is used. +\fB\-background\fR option for the overall menu is used. This option is not available for separator or tear-off entries. .TP \fB\-bitmap \fIvalue\fR +. Specifies a bitmap to display in the menu instead of a textual label, in any of the forms accepted by \fBTk_GetBitmap\fR. This option overrides the \fB\-label\fR option @@ -393,15 +561,20 @@ If a \fB\-image\fR option has been specified, it overrides This option is not available for separator or tear-off entries. .TP \fB\-columnbreak \fIvalue\fR +. When this option is zero, the entry appears below the previous entry. When this option is one, the entry appears at the top of a new column in the menu. +This option is ignored on Aqua/Mac OS X, where menus are always a single +column. .TP \fB\-command \fIvalue\fR +. Specifies a Tcl command to execute when the menu entry is invoked. Not available for separator or tear-off entries. .TP \fB\-compound \fIvalue\fR +. Specifies whether the menu entry should display both an image and text, and if so, where the image should be placed relative to the text. Valid values for this option are \fBbottom\fR, \fBcenter\fR, @@ -411,26 +584,30 @@ text, depending on the values of the \fB\-image\fR and \fB\-bitmap\fR options. .TP \fB\-font \fIvalue\fR +. Specifies the font to use when drawing the label or accelerator string in this entry. If this option is specified as an empty string (the default) then -the \fBfont\fR option for the overall menu is used. +the \fB\-font\fR option for the overall menu is used. This option is not available for separator or tear-off entries. .TP \fB\-foreground \fIvalue\fR +. Specifies a foreground color to use for displaying this entry when it is in the normal state (neither active nor disabled). If this option is specified as an empty string (the default), then the -\fBforeground\fR option for the overall menu is used. +\fB\-foreground\fR option for the overall menu is used. This option is not available for separator or tear-off entries. .TP \fB\-hidemargin \fIvalue\fR +. Specifies whether the standard margins should be drawn for this menu entry. This is useful when creating palette with images in them, i.e., color palettes, pattern palettes, etc. 1 indicates that the margin for the entry is hidden; 0 means that the margin is used. .TP \fB\-image \fIvalue\fR +. Specifies an image to display in the menu instead of a text string or bitmap. The image must have been created by some previous invocation of @@ -442,36 +619,43 @@ bitmap label to be displayed. This option is not available for separator or tear-off entries. .TP \fB\-indicatoron \fIvalue\fR +. Available only for checkbutton and radiobutton entries. \fIValue\fR is a boolean that determines whether or not the indicator should be displayed. .TP \fB\-label \fIvalue\fR +. Specifies a string to display as an identifying label in the menu entry. Not available for separator or tear-off entries. .TP \fB\-menu \fIvalue\fR +. Available only for cascade entries. Specifies the path name of the submenu associated with this entry. The submenu must be a child of the menu. .TP \fB\-offvalue \fIvalue\fR +. Available only for checkbutton entries. Specifies the value to store in the entry's associated variable when the entry is deselected. .TP \fB\-onvalue \fIvalue\fR +. Available only for checkbutton entries. Specifies the value to store in the entry's associated variable when the entry is selected. .TP \fB\-selectcolor \fIvalue\fR +. Available only for checkbutton and radiobutton entries. Specifies the color to display in the indicator when the entry is selected. -If the value is an empty string (the default) then the \fBselectColor\fR +If the value is an empty string (the default) then the \fB\-selectcolor\fR option for the menu determines the indicator color. .TP \fB\-selectimage \fIvalue\fR +. Available only for checkbutton and radiobutton entries. Specifies an image to display in the entry (in place of the \fB\-image\fR option) when it is selected. @@ -481,22 +665,24 @@ This option is ignored unless the \fB\-image\fR option has been specified. .TP \fB\-state \fIvalue\fR +. Specifies one of three states for the entry: \fBnormal\fR, \fBactive\fR, or \fBdisabled\fR. In normal state the entry is displayed using the -\fBforeground\fR option for the menu and the \fBbackground\fR +\fB\-foreground\fR option for the menu and the \fB\-background\fR option from the entry or the menu. The active state is typically used when the pointer is over the entry. -In active state the entry is displayed using the \fBactiveForeground\fR -option for the menu along with the \fBactivebackground\fR option from +In active state the entry is displayed using the \fB\-activeforeground\fR +option for the menu along with the \fB\-activebackground\fR option from the entry. Disabled state means that the entry should be insensitive: the default bindings will refuse to activate or invoke the entry. In this state the entry is displayed according to the -\fBdisabledForeground\fR option for the menu and the -\fBbackground\fR option from the entry. +\fB\-disabledforeground\fR option for the menu and the +\fB\-background\fR option from the entry. This option is not available for separator entries. .TP \fB\-underline \fIvalue\fR +. Specifies the integer index of a character to underline in the entry. This option is also queried by the default bindings and used to implement keyboard traversal. @@ -506,143 +692,32 @@ If a bitmap or image is displayed in the entry then this option is ignored. This option is not available for separator or tear-off entries. .TP \fB\-value \fIvalue\fR +. Available only for radiobutton entries. Specifies the value to store in the entry's associated variable when the entry is selected. If an empty string is specified, then the \fB\-label\fR option for the entry as the value to store in the variable. .TP \fB\-variable \fIvalue\fR +. Available only for checkbutton and radiobutton entries. Specifies the name of a global variable to set when the entry is selected. For checkbutton entries the variable is also set when the entry is deselected. For radiobutton entries, changing the variable causes the currently-selected entry to deselect itself. -.LP -The \fBadd\fR widget command returns an empty string. +.RS +.PP +For checkbutton entries, the default value of this option is taken from the +\fB\-label\fR option, and for radiobutton entries a single fixed value is +used. It is recommended that you always set the \fB\-variable\fR option when +creating either a checkbutton or a radiobutton. .RE -.TP -\fIpathName \fBcget\fR \fIoption\fR -Returns the current value of the configuration option given -by \fIoption\fR. -\fIOption\fR may have any of the values accepted by the \fBmenu\fR -command. -.TP -\fIpathName\fR \fBclone\fR \fInewPathname ?cloneType?\fR -Makes a clone of the current menu named \fInewPathName\fR. This clone -is a menu in its own right, but any changes to the clone are -propagated to the original menu and vice versa. \fIcloneType\fR can be -\fBnormal\fR, \fBmenubar\fR, or \fBtearoff\fR. Should not normally be -called outside of the Tk library. See the \fBCLONES\fR section for -more information. -.TP -\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? -Query or modify the configuration options of the widget. -If no \fIoption\fR is specified, returns a list describing all of -the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for -information on the format of this list). If \fIoption\fR is specified -with no \fIvalue\fR, then the command returns a list describing the -one named option (this list will be identical to the corresponding -sublist of the value returned if no \fIoption\fR is specified). If -one or more \fIoption\-value\fR pairs are specified, then the command -modifies the given widget option(s) to have the given value(s); in -this case the command returns an empty string. -\fIOption\fR may have any of the values accepted by the \fBmenu\fR -command. -.TP -\fIpathName \fBdelete \fIindex1\fR ?\fIindex2\fR? -Delete all of the menu entries between \fIindex1\fR and -\fIindex2\fR inclusive. -If \fIindex2\fR is omitted then it defaults to \fIindex1\fR. -Attempts to delete a tear-off menu entry are ignored (instead, you -should change the \fBtearOff\fR option to remove the tear-off entry). -.TP -\fIpathName \fBentrycget\fR \fIindex option\fR -Returns the current value of a configuration option for -the entry given by \fIindex\fR. -\fIOption\fR may have any of the values accepted by the \fBadd\fR -widget command. -.TP -\fIpathName \fBentryconfigure \fIindex \fR?\fIoptions\fR? -This command is similar to the \fBconfigure\fR command, except that -it applies to the options for an individual entry, whereas \fBconfigure\fR -applies to the options for the menu as a whole. -\fIOptions\fR may have any of the values accepted by the \fBadd\fR -widget command. If \fIoptions\fR are specified, options are modified -as indicated -in the command and the command returns an empty string. -If no \fIoptions\fR are specified, returns a list describing -the current options for entry \fIindex\fR (see \fBTk_ConfigureInfo\fR for -information on the format of this list). -.TP -\fIpathName \fBindex \fIindex\fR -Returns the numerical index corresponding to \fIindex\fR, or -\fBnone\fR if \fIindex\fR was specified as \fBnone\fR. -.TP -\fIpathName \fBinsert \fIindex\fR \fItype \fR?\fIoption value option value ...\fR? -Same as the \fBadd\fR widget command except that it inserts the new -entry just before the entry given by \fIindex\fR, instead of appending -to the end of the menu. The \fItype\fR, \fIoption\fR, and \fIvalue\fR -arguments have the same interpretation as for the \fBadd\fR widget -command. It is not possible to insert new menu entries before the -tear-off entry, if the menu has one. -.TP -\fIpathName \fBinvoke \fIindex\fR -Invoke the action of the menu entry. See the sections on the -individual entries above for details on what happens. If the -menu entry is disabled then nothing happens. If the -entry has a command associated with it then the result of that -command is returned as the result of the \fBinvoke\fR widget -command. Otherwise the result is an empty string. Note: invoking -a menu entry does not automatically unpost the menu; the default -bindings normally take care of this before invoking the \fBinvoke\fR -widget command. -.TP -\fIpathName \fBpost \fIx y\fR -Arrange for the menu to be displayed on the screen at the root-window -coordinates given by \fIx\fR and \fIy\fR. These coordinates are -adjusted if necessary to guarantee that the entire menu is visible on -the screen. This command normally returns an empty string. -If the \fBpostCommand\fR option has been specified, then its value is -executed as a Tcl script before posting the menu and the result of -that script is returned as the result of the \fBpost\fR widget -command. -If an error returns while executing the command, then the error is -returned without posting the menu. -.TP -\fIpathName \fBpostcascade \fIindex\fR -Posts the submenu associated with the cascade entry given by -\fIindex\fR, and unposts any previously posted submenu. -If \fIindex\fR does not correspond to a cascade entry, -or if \fIpathName\fR is not posted, -the command has no effect except to unpost any currently posted -submenu. -.TP -\fIpathName \fBtype \fIindex\fR -Returns the type of the menu entry given by \fIindex\fR. -This is the \fItype\fR argument passed to the \fBadd\fR widget -command when the entry was created, such as \fBcommand\fR -or \fBseparator\fR, or \fBtearoff\fR for a tear-off entry. -.TP -\fIpathName \fBunpost\fR -Unmap the window so that it is no longer displayed. If a -lower-level cascaded menu is posted, unpost that menu. Returns an -empty string. This subcommand does not work on Windows and the -Macintosh, as those platforms have their own way of unposting menus. -.TP -\fIpathName \fBxposition \fIindex\fR -.VS 8.5 -Returns a decimal string giving the x-coordinate within the menu -window of the leftmost pixel in the entry specified by \fIindex\fR. -.VE 8.5 -.TP -\fIpathName \fByposition \fIindex\fR -Returns a decimal string giving the y-coordinate within the menu -window of the topmost pixel in the entry specified by \fIindex\fR. .SH "MENU CONFIGURATIONS" .PP The default bindings support four different ways of using menus: .TP \fBPulldown Menus in Menubar\fR +. This is the most common case. You create a menu widget that will become the menu bar. You then add cascade entries to this menu, specifying the pull down menus you wish to use in your menu bar. You then create all @@ -651,6 +726,7 @@ of the pulldowns. Once you have done this, specify the menu using the \fBtoplevel\fR manual entry for details. .TP \fBPulldown Menus in Menu Buttons\fR +. This is the compatible way to do menu bars. You create one menubutton widget for each top-level menu, and typically you arrange a series of menubuttons in a row in a menubar window. You also create the top-level menus @@ -662,12 +738,14 @@ will allow users to traverse and invoke the tree of menus via its menubutton; see the \fBmenubutton\fR manual entry for details. .TP \fBPopup Menus\fR +. Popup menus typically post in response to a mouse button press or keystroke. You create the popup menus and any cascaded submenus, then you call the \fBtk_popup\fR procedure at the appropriate time to post the top-level menu. .TP \fBOption Menus\fR +. An option menu consists of a menubutton with an associated menu that allows you to select one of several values. The current value is displayed in the menubutton and is also stored in a global @@ -675,6 +753,7 @@ variable. Use the \fBtk_optionMenu\fR procedure to create option menubuttons and their menus. .TP \fBTorn-off Menus\fR +. You create a torn-off menu by invoking the tear-off entry at the top of an existing menu. The default bindings will create a new menu that is a copy of the original menu and leave it permanently @@ -749,3 +828,6 @@ entries. bind(n), menubutton(n), ttk::menubutton(n), toplevel(n) .SH KEYWORDS menu, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/menubar.n b/doc/menubar.n index b80a6e1..023bf37 100644 --- a/doc/menubar.n +++ b/doc/menubar.n @@ -16,7 +16,6 @@ tk_menuBar, tk_bindForTraversal \- Obsolete support for menu bars .sp \fBtk_bindForTraversal \fIarg arg ... \fR .BE - .SH DESCRIPTION .PP These procedures were used in Tk 3.6 and earlier releases to help @@ -30,9 +29,10 @@ procedures will go away. From Tk 8.0 onwards, you should instead construct your menubar as a normal \fBmenu\fR and then attach it to the \fBtoplevel\fR of your choice using the \fB\-menu\fR option of that widget. - .SH "SEE ALSO" menu(n), toplevel(n) - .SH KEYWORDS keyboard traversal, menu, menu bar, post +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/menubutton.n b/doc/menubutton.n index 3680abc..08b52a0 100644 --- a/doc/menubutton.n +++ b/doc/menubutton.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -menubutton \- Create and manipulate menubutton widgets +menubutton \- Create and manipulate 'menubutton' pop-up menu indicator widgets .SH SYNOPSIS \fBmenubutton\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -53,12 +53,12 @@ Specifies one of three states for the menubutton: \fBnormal\fR, \fBactive\fR, or \fBdisabled\fR. In normal state the menubutton is displayed using the \fBforeground\fR and \fBbackground\fR options. The active state is typically used when the pointer is over the menubutton. In active state -the menubutton is displayed using the \fBactiveForeground\fR and -\fBactiveBackground\fR options. Disabled state means that the menubutton +the menubutton is displayed using the \fB\-activeforeground\fR and +\fB\-activebackground\fR options. Disabled state means that the menubutton should be insensitive: the default bindings will refuse to activate the widget and will ignore mouse button presses. -In this state the \fBdisabledForeground\fR and -\fBbackground\fR options determine how the button is displayed. +In this state the \fB\-disabledforeground\fR and +\fB\-background\fR options determine how the button is displayed. .OP \-width width Width Specifies a desired width for the menubutton. If an image or bitmap is being displayed in the menubutton then the value is in @@ -84,22 +84,28 @@ A menubutton is a widget that displays a textual string, bitmap, or image and is associated with a menu widget. If text is displayed, it must all be in a single font, but it can occupy multiple lines on the screen (if it contains newlines -or if wrapping occurs because of the \fBwrapLength\fR option) and +or if wrapping occurs because of the \fB\-wraplength\fR option) and one of the characters may optionally be underlined using the -\fBunderline\fR option. In normal usage, pressing +\fB\-underline\fR option. In normal usage, pressing mouse button 1 over the menubutton causes the associated menu to be posted just underneath the menubutton. If the mouse is moved over the menu before releasing the mouse button, the button release causes the underlying menu entry to be invoked. When the button is released, the menu is unposted. .PP -Menubuttons are typically organized into groups called menu bars +Menubuttons are used to construct a \fBtk_optionMenu\fR, which is the +preferred mechanism for allowing a user to select one item from a list +on Mac OS X. +.PP +Menubuttons were also typically organized into groups called menu bars that allow scanning: if the mouse button is pressed over one menubutton (causing it to post its menu) and the mouse is moved over another menubutton in the same menu bar without releasing the mouse button, then the menu of the first menubutton is unposted and the menu of the new menubutton is posted instead. +\fIThis use is deprecated\fR in favor of setting a \fBmenu\fR directly as a +menubar; see the \fBtoplevel\fR's \fB\-menu\fR option for how to do that. .PP There are several interactions between menubuttons and menus; see the \fBmenu\fR manual entry for information on various menu configurations, @@ -117,13 +123,15 @@ operations on the widget. It has the following general form: determine the exact behavior of the command. The following commands are possible for menubutton widgets: .TP -\fIpathName \fBcget\fR \fIoption\fR +\fIpathName \fBcget \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBmenubutton\fR command. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for @@ -168,7 +176,7 @@ When a menubutton is posted, its associated menu claims the input focus to allow keyboard traversal of the menu and its submenus. See the \fBmenu\fR manual entry for details on these bindings. .IP [7] -If the \fBunderline\fR option has been specified for a menubutton +If the \fB\-underline\fR option has been specified for a menubutton then keyboard traversal may be used to post the menubutton: Alt+\fIx\fR, where \fIx\fR is the underlined character (or its lower-case or upper-case equivalent), may be typed in any window @@ -189,3 +197,6 @@ individual widgets or by redefining the class bindings. ttk::menubutton(n), menu(n) .SH KEYWORDS menubutton, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/message.n b/doc/message.n index 926f0cb..bd635ac 100644 --- a/doc/message.n +++ b/doc/message.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -message \- Create and manipulate message widgets +message \- Create and manipulate 'message' non-interactive text widgets .SH SYNOPSIS \fBmessage\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -28,37 +28,37 @@ aspect ratio for the text. The aspect ratio is specified as be as wide as it is tall, 200 means the text should be twice as wide as it is tall, 50 means the text should be twice as tall as it is wide, and so on. -Used to choose line length for text if \fBwidth\fR option +Used to choose line length for text if \fB\-width\fR option is not specified. Defaults to 150. .OP \-justify justify Justify Specifies how to justify lines of text. Must be one of \fBleft\fR, \fBcenter\fR, or \fBright\fR. Defaults to \fBleft\fR. -This option works together with the \fBanchor\fR, \fBaspect\fR, -\fBpadX\fR, \fBpadY\fR, and \fBwidth\fR options to provide a variety +This option works together with the \fB\-anchor\fR, \fB\-aspect\fR, +\fB\-padx\fR, \fB\-pady\fR, and \fB\-width\fR options to provide a variety of arrangements of the text within the window. -The \fBaspect\fR and \fBwidth\fR options determine the amount of +The \fB\-aspect\fR and \fB\-width\fR options determine the amount of screen space needed to display the text. -The \fBanchor\fR, \fBpadX\fR, and \fBpadY\fR options determine where this +The \fB\-anchor\fR, \fB\-padx\fR, and \fB\-pady\fR options determine where this rectangular area is displayed within the widget's window, and the -\fBjustify\fR option determines how each line is displayed within that +\fB\-justify\fR option determines how each line is displayed within that rectangular region. -For example, suppose \fBanchor\fR is \fBe\fR and \fBjustify\fR is +For example, suppose \fB\-anchor\fR is \fBe\fR and \fB\-justify\fR is \fBleft\fR, and that the message window is much larger than needed for the text. The text will be displayed so that the left edges of all the lines -line up and the right edge of the longest line is \fBpadX\fR from +line up and the right edge of the longest line is \fB\-padx\fR from the right side of the window; the entire text block will be centered in the vertical span of the window. .OP \-width width Width Specifies the length of lines in the window. The value may have any of the forms acceptable to \fBTk_GetPixels\fR. -If this option has a value greater than zero then the \fBaspect\fR -option is ignored and the \fBwidth\fR option determines the line +If this option has a value greater than zero then the \fB\-aspect\fR +option is ignored and the \fB\-width\fR option determines the line length. If this option has a value less than or equal to zero, then -the \fBaspect\fR option determines the line length. +the \fB\-aspect\fR option determines the line length. .BE .SH DESCRIPTION .PP @@ -74,7 +74,8 @@ there must not exist a window named \fIpathName\fR, but \fIpathName\fR's parent must exist. .PP A message is a widget that displays a textual string. A message -widget has three special features. First, it breaks up +widget has three special features that differentiate it from a +\fBlabel\fR widget. First, it breaks up its string into lines in order to produce a given aspect ratio for the window. The line breaks are chosen at word boundaries wherever possible (if not even a single word would fit on a @@ -111,13 +112,15 @@ operations on the widget. It has the following general form: determine the exact behavior of the command. The following commands are possible for message widgets: .TP -\fIpathName \fBcget\fR \fIoption\fR +\fIpathName \fBcget \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBmessage\fR command. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for @@ -142,3 +145,6 @@ The most common result is that the line is justified wrong. label(n) .SH KEYWORDS message, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/option.n b/doc/option.n index dd1a644..8699c0d 100644 --- a/doc/option.n +++ b/doc/option.n @@ -26,8 +26,8 @@ database or to retrieve options from the database. The \fBadd\fR form of the command adds a new option to the database. \fIPattern\fR contains the option being specified, and consists of names and/or classes -separated by asterisks or dots, in the usual X format (see \fBPATTERN -FORMAT\fR). \fIValue\fR +separated by asterisks or dots, in the usual X format (see +\fBPATTERN FORMAT\fR). \fIValue\fR contains a text string to associate with \fIpattern\fR; this is the value that will be returned in calls to \fBTk_GetOption\fR or by invocations of the \fBoption get\fR command. If \fIpriority\fR @@ -63,22 +63,18 @@ The \fIpriority\fR arguments to the \fBoption\fR command are normally specified symbolically using one of the following values: .TP \fBwidgetDefault\fR -. Level 20. Used for default values hard-coded into widgets. .TP \fBstartupFile\fR -. Level 40. Used for options specified in application-specific startup files. .TP \fBuserDefault\fR -. Level 60. Used for options specified in user-specific defaults files, such as \fB.Xdefaults\fR, resource databases loaded into the X server, or user-specific startup files. .TP \fBinteractive\fR -. Level 80. Used for options specified interactively after the application starts running. If \fIpriority\fR is not specified, it defaults to this level. @@ -113,8 +109,10 @@ first word of the pattern is matched against the name and class of the .QW \fB.\fR \fBtoplevel\fR, which are usually set by options to \fBwish\fR. .SH EXAMPLES +.PP Instruct every button in the application to have red text on it unless -explicitly overridden (note that on some platforms the option is ignored): +explicitly overridden, by setting the \fBforeground\fR for the \fBButton\fR +class (note that on some platforms the option is ignored): .CS \fBoption add\fR *Button.foreground red startupFile .CE diff --git a/doc/optionMenu.n b/doc/optionMenu.n index db2c109..42275ce 100644 --- a/doc/optionMenu.n +++ b/doc/optionMenu.n @@ -33,9 +33,13 @@ The return value from \fBtk_optionMenu\fR is the name of the menu associated with \fIpathName\fR, so that the caller can change its configuration options or manipulate it in other ways. .SH EXAMPLE +.PP .CS tk_optionMenu .foo myVar Foo Bar Boo Spong Wibble pack .foo .CE .SH KEYWORDS option menu +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/options.n b/doc/options.n index 2faca8c..36937b1 100644 --- a/doc/options.n +++ b/doc/options.n @@ -12,8 +12,8 @@ .SH NAME options \- Standard options supported by widgets .BE - .SH DESCRIPTION +.PP This manual entry describes the common configuration options supported by widgets in the Tk toolkit. Every widget does not necessarily support every option (see the manual entries for individual widgets for a list @@ -72,18 +72,18 @@ widget. Specifies a bitmap to display in the widget, in any of the forms acceptable to \fBTk_GetBitmap\fR. The exact way in which the bitmap is displayed may be affected by -other options such as \fBanchor\fR or \fBjustify\fR. +other options such as \fB\-anchor\fR or \fB\-justify\fR. Typically, if this option is specified then it overrides other options that specify a textual value to display in the widget -but this is controlled by the \fBcompound\fR option; -the \fBbitmap\fR option may be reset to an empty string to re-enable +but this is controlled by the \fB\-compound\fR option; +the \fB\-bitmap\fR option may be reset to an empty string to re-enable a text display. -In widgets that support both \fBbitmap\fR and \fBimage\fR options, -\fBimage\fR will usually override \fBbitmap\fR. +In widgets that support both \fB\-bitmap\fR and \fB\-image\fR options, +\fB\-image\fR will usually override \fB\-bitmap\fR. .OP "\-borderwidth or \-bd" borderWidth BorderWidth Specifies a non-negative value indicating the width of the 3-D border to draw around the outside of the widget (if such a -border is being drawn; the \fBrelief\fR option typically determines +border is being drawn; the \fB\-relief\fR option typically determines this). The value may also be used when drawing 3-D effects in the interior of the widget. The value may have any of the forms acceptable to \fBTk_GetPixels\fR. @@ -139,10 +139,10 @@ If the value is zero, no focus highlight is drawn around the widget. .OP \-image image Image Specifies an image to display in the widget, which must have been created with the \fBimage create\fR command. -Typically, if the \fBimage\fR option is specified then it overrides other +Typically, if the \fB\-image\fR option is specified then it overrides other options that specify a bitmap or textual value to display in the -widget, though this is controlled by the \fBcompound\fR option; -the \fBimage\fR option may be reset to an empty string to re-enable +widget, though this is controlled by the \fB\-compound\fR option; +the \fB\-image\fR option may be reset to an empty string to re-enable a bitmap or text display. .OP \-insertbackground insertBackground Foreground Specifies the color to use as background in the area covered by the @@ -169,8 +169,8 @@ in each blink cycle. Specifies a value indicating the total width of the insertion cursor. The value may have any of the forms acceptable to \fBTk_GetPixels\fR. If a border has been specified for the insertion -cursor (using the \fBinsertBorderWidth\fR option), the border -will be drawn inside the width specified by the \fBinsertWidth\fR +cursor (using the \fB\-insertborderwidth\fR option), the border +will be drawn inside the width specified by the \fB\-insertwidth\fR option. .OP \-jump jump Jump For widgets with a slider that can be dragged to adjust a value, @@ -235,7 +235,7 @@ Specifies the number of milliseconds a button or key must be held down before it begins to auto-repeat. Used, for example, on the up- and down-arrows in scrollbars. .OP \-repeatinterval repeatInterval RepeatInterval -Used in conjunction with \fBrepeatDelay\fR: once auto-repeat +Used in conjunction with \fB\-repeatdelay\fR: once auto-repeat begins, this option determines the number of milliseconds between auto-repeats. .OP \-selectbackground selectBackground Foreground @@ -255,7 +255,7 @@ This option is typically used in text widgets, where the information in the widget has a natural size (the size of a character) and it makes sense for the window's dimensions to be integral numbers of these units. These natural window sizes form a grid. -If the \fBsetGrid\fR option is set to true then the widget will +If the \fB\-setgrid\fR option is set to true then the widget will communicate with the window manager so that when the user interactively resizes the top-level window that contains the widget, the dimensions of the window will be displayed to the user in grid units and the window @@ -266,7 +266,7 @@ entry for more details. Determines whether the window accepts the focus during keyboard traversal (e.g., Tab and Shift-Tab). Before setting the focus to a window, the traversal scripts -consult the value of the \fBtakeFocus\fR option. +consult the value of the \fB\-takefocus\fR option. A value of \fB0\fR means that the window should be skipped entirely during keyboard traversal. \fB1\fR means that the window should receive the input @@ -289,14 +289,14 @@ redefine the keyboard traversal scripts. .OP \-text text Text Specifies a string to be displayed inside the widget. The way in which the string is displayed depends on the particular widget and may be -determined by other options, such as \fBanchor\fR or \fBjustify\fR. +determined by other options, such as \fB\-anchor\fR or \fB\-justify\fR. .OP \-textvariable textVariable Variable Specifies the name of a global variable. The value of the variable is a text string to be displayed inside the widget; if the variable value changes then the widget will automatically update itself to reflect the new value. The way in which the string is displayed in the widget depends on the particular widget and may be determined by other options, such as -\fBanchor\fR or \fBjustify\fR. +\fB\-anchor\fR or \fB\-justify\fR. .OP \-troughcolor troughColor Background Specifies the color to use for the rectangular trough areas in widgets such as scrollbars and scales. This option is ignored for @@ -334,7 +334,7 @@ that is visible in the window, and the second fraction indicates the information just after the last portion that is visible. The command is then passed to the Tcl interpreter for execution. Typically the -\fBxScrollCommand\fR option consists of the path name of a scrollbar +\fB\-xscrollcommand\fR option consists of the path name of a scrollbar widget followed by .QW set , e.g. @@ -345,13 +345,14 @@ If this option is not specified, then no command will be executed. .OP \-yscrollcommand yScrollCommand ScrollCommand Specifies the prefix for a command used to communicate with vertical scrollbars. This option is treated in the same way as the -\fBxScrollCommand\fR option, except that it is used for vertical +\fB\-xscrollcommand\fR option, except that it is used for vertical scrollbars and is provided by widgets that support vertical scrolling. -See the description of \fBxScrollCommand\fR for details +See the description of \fB\-xscrollcommand\fR for details on how this option is used. - .SH "SEE ALSO" colors, cursors, font - .SH KEYWORDS class, name, standard option, switch +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/pack-old.n b/doc/pack-old.n index f29c454..217dba9 100644 --- a/doc/pack-old.n +++ b/doc/pack-old.n @@ -20,7 +20,6 @@ pack-old \- Obsolete syntax for packer geometry manager .sp \fBpack unpack \fIwindow\fR .BE - .SH DESCRIPTION .PP \fINote: this manual entry describes the syntax for the \fBpack\fI @@ -189,6 +188,8 @@ The packer makes geometry requests on behalf of the parent windows it manages. For each parent window it requests a size large enough to accommodate all the options specified by all the packed children, such that zero space would be leftover for \fBexpand\fR options. - .SH KEYWORDS geometry manager, location, packer, parcel, size +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -14,7 +14,6 @@ pack \- Geometry manager that packs around edges of cavity .SH SYNOPSIS \fBpack \fIoption arg \fR?\fIarg ...\fR? .BE - .SH DESCRIPTION .PP The \fBpack\fR command is used to communicate with the packer, @@ -259,6 +258,7 @@ will be highest in the stacking order. Or, you can use the \fBraise\fR and \fBlower\fR commands to change the stacking order of either the master or the slave. .SH EXAMPLE +.PP .CS # Make the widgets label .t \-text "This widget is at the top" \-bg red @@ -274,9 +274,10 @@ text .mid \fBpack\fR .r \-side right \-fill y \fBpack\fR .mid \-expand 1 \-fill both .CE - .SH "SEE ALSO" grid(n), place(n) - .SH KEYWORDS geometry manager, location, packer, parcel, propagation, size +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/palette.n b/doc/palette.n index 27a6460..085c4c6 100644 --- a/doc/palette.n +++ b/doc/palette.n @@ -17,7 +17,6 @@ tk_setPalette, tk_bisque \- Modify the Tk color palette .sp \fBtk_bisque\fR .BE - .SH DESCRIPTION .PP The \fBtk_setPalette\fR procedure changes the color scheme for Tk. @@ -67,6 +66,8 @@ The procedure \fBtk_bisque\fR is provided for backward compatibility: it restores the application's colors to the light brown .PQ bisque color scheme used in Tk 3.6 and earlier versions. - .SH KEYWORDS bisque, color, palette +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/panedwindow.n b/doc/panedwindow.n index 33e1e12..e2c954a 100644 --- a/doc/panedwindow.n +++ b/doc/panedwindow.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -panedwindow \- Create and manipulate panedwindow widgets +panedwindow \- Create and manipulate 'panedwindow' split container widgets .SH SYNOPSIS \fBpanedwindow\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -91,7 +91,8 @@ the panedwindow widget's path name. \fIOption\fR and the \fIarg\fRs determine the exact behavior of the command. The following commands are possible for panedwindow widgets: .TP -\fIpathName \fBadd \fIwindow ?window ...? ?option value ...?\fR +\fIpathName \fBadd \fIwindow \fR?\fIwindow ...\fR? ?\fIoption value ...\fR? +. Add one or more windows to the panedwindow, each in a separate pane. The arguments consist of the names of one or more windows followed by pairs of arguments that specify how to manage the windows. @@ -99,11 +100,13 @@ followed by pairs of arguments that specify how to manage the windows. \fBconfigure\fR subcommand. .TP \fIpathName \fBcget \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBpanedwindow\fR command. .TP -\fIpathName \fBconfigure \fI?option? ?value option value ...?\fR +\fIpathName \fBconfigure \fR?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for @@ -116,11 +119,13 @@ modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string. \fIOption\fR may have any of the values accepted by the \fBpanedwindow\fR command. .TP -\fIpathName \fBforget \fIwindow ?window ...?\fR +\fIpathName \fBforget \fIwindow \fR?\fIwindow ...\fR? +. Remove the pane containing \fIwindow\fR from the panedwindow. All geometry management options for \fIwindow\fR will be forgotten. .TP \fIpathName \fBidentify \fIx y\fR +. Identify the panedwindow component underneath the point given by \fIx\fR and \fIy\fR, in window coordinates. If the point is over a sash or a sash handle, the result is a two element list containing the @@ -128,53 +133,63 @@ index of the sash or handle, and a word indicating whether it is over a sash or a handle, such as {0 sash} or {2 handle}. If the point is over any other part of the panedwindow, the result is an empty list. .TP -\fIpathName \fBproxy \fI?args?\fR +\fIpathName \fBproxy \fR?\fIargs\fR? +. This command is used to query and change the position of the sash proxy, used for rubberband-style pane resizing. It can take any of the following forms: .RS .TP \fIpathName \fBproxy coord\fR +. Return a list containing the x and y coordinates of the most recent proxy location. .TP \fIpathName \fBproxy forget\fR +. Remove the proxy from the display. .TP \fIpathName \fBproxy place \fIx y\fR +. Place the proxy at the given \fIx\fR and \fIy\fR coordinates. .RE .TP -\fIpathName \fBsash \fI?args?\fR +\fIpathName \fBsash \fR?\fIargs\fR? This command is used to query and change the position of sashes in the panedwindow. It can take any of the following forms: .RS .TP \fIpathName \fBsash coord \fIindex\fR +. Return the current x and y coordinate pair for the sash given by \fIindex\fR. \fIIndex\fR must be an integer between 0 and 1 less than the number of panes in the panedwindow. The coordinates given are those of the top left corner of the region containing the sash. .TP \fIpathName \fBsash dragto \fIindex x y\fR +. This command computes the difference between the given coordinates and the coordinates given to the last \fBsash mark\fR command for the given sash. It then moves that sash the computed difference. The return value is the empty string. .TP \fIpathName \fBsash mark \fIindex x y\fR +. Records \fIx\fR and \fIy\fR for the sash given by \fIindex\fR; used in conjunction with later \fBsash dragto\fR commands to move the sash. .TP \fIpathName \fBsash place \fIindex x y\fR +. Place the sash given by \fIindex\fR at the given coordinates. .RE .TP \fIpathName \fBpanecget \fIwindow option\fR +. Query a management option for \fIwindow\fR. \fIOption\fR may be any value allowed by the \fBpaneconfigure\fR subcommand. .TP -\fIpathName \fBpaneconfigure \fIwindow ?option? ?value option value ...?\fR +\fIpathName \fBpaneconfigure \fIwindow \fR?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the management options for \fIwindow\fR. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for @@ -189,14 +204,17 @@ are supported: .RS .TP \fB\-after \fIwindow\fR +. Insert the window after the window specified. \fIwindow\fR should be the name of a window already managed by \fIpathName\fR. .TP \fB\-before \fIwindow\fR +. Insert the window before the window specified. \fIwindow\fR should be the name of a window already managed by \fIpathName\fR. .TP \fB\-height \fIsize\fR +. Specify a height for the window. The height will be the outer dimension of the window including its border, if any. If \fIsize\fR is an empty string, or if \fB\-height\fR is not specified, then the @@ -205,13 +223,13 @@ height may later be adjusted by the movement of sashes in the panedwindow. \fISize\fR may be any value accepted by \fBTk_GetPixels\fR. .TP \fB\-hide \fIboolean\fR -.VS 8.5 +. Controls the visibility of a pane. When the \fIboolean\fR is true (according to \fBTcl_GetBoolean\fR) the pane will not be visible, but it will still be maintained in the list of panes. -.VE 8.5 .TP \fB\-minsize \fIn\fR +. Specifies that the size of the window cannot be made less than \fIn\fR. This constraint only affects the size of the widget in the paned dimension \(em the x dimension for horizontal panedwindows, the y @@ -219,16 +237,19 @@ dimension for vertical panedwindows. May be any value accepted by \fBTk_GetPixels\fR. .TP \fB\-padx \fIn\fR +. Specifies a non-negative value indicating how much extra space to leave on each side of the window in the X-direction. The value may have any of the forms accepted by \fBTk_GetPixels\fR. .TP \fB\-pady \fIn\fR +. Specifies a non-negative value indicating how much extra space to leave on each side of the window in the Y-direction. The value may have any of the forms accepted by \fBTk_GetPixels\fR. .TP \fB\-sticky \fIstyle\fR +. If a window's pane is larger than the requested dimensions of the window, this option may be used to position (or stretch) the window within its pane. \fIStyle\fR is a string that contains zero or more @@ -242,7 +263,7 @@ are specified, the window will be stretched to fill the entire height (or width) of its cavity. .TP \fB\-stretch \fIwhen\fR -.VS 8.5 +. Controls how extra space is allocated to each of the panes. \fIWhen\fR is one of \fBalways\fR, \fBfirst\fR, \fBlast\fR, \fBmiddle\fR, and \fBnever\fR. @@ -254,25 +275,30 @@ definition: .RS .TP \fBalways\fR +. This pane will always stretch. .TP \fBfirst\fR -Only if this pane is the first pane (left-most or top-most) will it +. +Only if this pane is the first pane (left-most or top-most) will it stretch. .TP \fBlast\fR -Only if this pane is the last pane (right-most or bottom-most) will it +. +Only if this pane is the last pane (right-most or bottom-most) will it stretch. This is the default value. .TP \fBmiddle\fR +. Only if this pane is not the first or last pane will it stretch. .TP \fBnever\fR +. This pane will never stretch. .RE -.VE 8.5 .TP \fB\-width \fIsize\fR +. Specify a width for the window. The width will be the outer dimension of the window including its border, if any. If \fIsize\fR is an empty string, or if \fB\-width\fR is not specified, then the @@ -282,8 +308,10 @@ panedwindow. \fISize\fR may be any value accepted by \fBTk_GetPixels\fR. .RE .TP \fIpathName \fBpanes\fR +. Returns an ordered list of the widgets managed by \fIpathName\fR. .SH "RESIZING PANES" +.PP A pane is resized by grabbing the sash (or sash handle if present) and dragging with the mouse. This is accomplished via mouse motion bindings on the widget. When a sash is moved, the sizes of the panes @@ -306,3 +334,6 @@ values, etc.). ttk::panedwindow(n) .SH KEYWORDS panedwindow, widget, geometry management +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/photo.n b/doc/photo.n index dc30f08..0fe0c61 100644 --- a/doc/photo.n +++ b/doc/photo.n @@ -16,9 +16,22 @@ .SH NAME photo \- Full-color images .SH SYNOPSIS +.nf \fBimage create photo \fR?\fIname\fR? ?\fIoptions\fR? -.BE +\fIimageName \fBblank\fR +\fIimageName \fBcget \fIoption\fR +\fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +\fIimageName \fBcopy \fIsourceImage\fR ?\fIoption value(s) ...\fR? +\fIimageName \fBdata\fR ?\fIoption value(s) ...\fR? +\fIimageName \fBget \fIx y\fR +\fIimageName \fBput \fIdata\fR ?\fIoption value(s) ...\fR? +\fIimageName \fBread \fIfilename\fR ?\fIoption value(s) ...\fR? +\fIimageName \fBredither\fR +\fIimageName \fBtransparency \fIsubcommand \fR?\fIarg arg ...\fR? +\fIimageName \fBwrite \fIfilename\fR ?\fIoption value(s) ...\fR? +.fi +.BE .SH DESCRIPTION .PP A photo is an image whose pixels can display any color or be @@ -26,7 +39,11 @@ transparent. A photo image is stored internally in full color (32 bits per pixel), and is displayed using dithering if necessary. Image data for a photo image can be obtained from a file or a string, or it can be supplied from -C code through a procedural interface. At present, only GIF and PPM/PGM +C code through a procedural interface. At present, only +.VS 8.6 +PNG, +.VE 8.6 +GIF and PPM/PGM formats are supported, but an interface exists to allow additional image file formats to be added easily. A photo image is transparent in regions where no image data has been supplied @@ -39,24 +56,29 @@ command. Photos support the following \fIoptions\fR: .TP \fB\-data \fIstring\fR +. Specifies the contents of the image as a string. The string should contain binary data or, for some formats, base64-encoded data (this is -currently guaranteed to be supported for GIF images). The format of the +currently guaranteed to be supported for PNG and GIF images). The +format of the string must be one of those for which there is an image file format handler that will accept string data. If both the \fB\-data\fR and \fB\-file\fR options are specified, the \fB\-file\fR option takes precedence. .TP \fB\-format \fIformat-name\fR +. Specifies the name of the file format for the data specified with the \fB\-data\fR or \fB\-file\fR option. .TP \fB\-file \fIname\fR +. \fIname\fR gives the name of a file that is to be read to supply data for the photo image. The file format must be one of those for which there is an image file format handler that can read data. .TP \fB\-gamma \fIvalue\fR +. Specifies that the colors allocated for displaying this image in a window should be corrected for a non-linear display with the specified gamma exponent value. (The intensity produced by most @@ -68,12 +90,14 @@ will make the image lighter, and values less than one will make it darker. .TP \fB\-height \fInumber\fR +. Specifies the height of the image, in pixels. This option is useful primarily in situations where the user wishes to build up the contents of the image piece by piece. A value of zero (the default) allows the image to expand or shrink vertically to fit the data stored in it. .TP \fB\-palette \fIpalette-spec\fR +. Specifies the resolution of the color cube to be allocated for displaying this image, and thus the number of colors used from the colormaps of the windows where it is displayed. The @@ -85,6 +109,7 @@ number) is used, the image will be displayed in monochrome (i.e., grayscale). .TP \fB\-width \fInumber\fR +. Specifies the width of the image, in pixels. This option is useful primarily in situations where the user wishes to build up the contents of the image piece by piece. A value of zero (the default) allows the @@ -112,17 +137,20 @@ changed. The following commands are possible for photo images: .TP \fIimageName \fBblank\fR +. Blank the image; that is, set the entire image to have no data, so it will be displayed as transparent, and the background of whatever window it is displayed in will show through. .TP \fIimageName \fBcget\fR \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the -\fBimage create photo\fR command. +\fBimage create\fR \fBphoto\fR command. .TP \fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options for the image. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIimageName\fR (see \fBTk_ConfigureInfo\fR for @@ -134,9 +162,10 @@ one or more \fIoption\-value\fR pairs are specified, then the command modifies the given option(s) to have the given value(s); in this case the command returns an empty string. \fIOption\fR may have any of the values accepted by the -\fBimage create photo\fR command. +\fBimage create\fR \fBphoto\fR command. .TP \fIimageName \fBcopy\fR \fIsourceImage\fR ?\fIoption value(s) ...\fR? +. Copies a region from the image called \fIsourceImage\fR (which must be a photo image) to the image called \fIimageName\fR, possibly with pixel zooming and/or subsampling. If no options are specified, this @@ -146,6 +175,7 @@ options may be specified: .RS .TP \fB\-from \fIx1 y1 x2 y2\fR +. Specifies a rectangular sub-region of the source image to be copied. (\fIx1,y1\fR) and (\fIx2,y2\fR) specify diagonally opposite corners of the rectangle. If \fIx2\fR and \fIy2\fR are not specified, the @@ -155,6 +185,7 @@ rectangle but not the bottom or right edges. If the \fB\-from\fR option is not given, the default is the whole source image. .TP \fB\-to \fIx1 y1 x2 y2\fR +. Specifies a rectangular sub-region of the destination image to be affected. (\fIx1,y1\fR) and (\fIx2,y2\fR) specify diagonally opposite corners of the rectangle. If \fIx2\fR and \fIy2\fR are not specified, @@ -164,6 +195,7 @@ region (after subsampling and zooming, if specified). If \fIx2\fR and necessary to fill the destination region in a tiled fashion. .TP \fB\-shrink\fR +. Specifies that the size of the destination image should be reduced, if necessary, so that the region being copied into is at the bottom-right corner of the image. This option will not affect the width or height @@ -171,6 +203,7 @@ of the image if the user has specified a non-zero value for the \fB\-width\fR or \fB\-height\fR configuration option, respectively. .TP \fB\-zoom \fIx y\fR +. Specifies that the source region should be magnified by a factor of \fIx\fR in the X direction and \fIy\fR in the Y direction. If \fIy\fR is not given, the default value is the same as \fIx\fR. With this @@ -179,6 +212,7 @@ of \fIx\fR x \fIy\fR pixels in the destination image, all the same color. \fIx\fR and \fIy\fR must be greater than 0. .TP \fB\-subsample \fIx y\fR +. Specifies that the source image should be reduced in size by using only every \fIx\fRth pixel in the X direction and \fIy\fRth pixel in the Y direction. Negative values will cause the image to be flipped @@ -186,6 +220,7 @@ about the Y or X axes, respectively. If \fIy\fR is not given, the default value is the same as \fIx\fR. .TP \fB\-compositingrule \fIrule\fR +. Specifies how transparent pixels in the source image are combined with the destination image. When a compositing rule of \fIoverlay\fR is set, the old contents of the destination image are visible, as if the @@ -196,17 +231,20 @@ the source image is used as-is. The default compositing rule is \fIoverlay\fR. .RE .TP -\fIimageName \fBdata ?\fIoption value(s) ...\fR? +\fIimageName \fBdata\fR ?\fIoption value(s) ...\fR? +. Returns image data in the form of a string. The following options may be specified: .RS .TP \fB\-background\fI color\fR +. If the color is specified, the data will not contain any transparency information. In all transparent pixels the color will be replaced by the specified color. .TP \fB\-format\fI format-name\fR +. Specifies the name of the image file format handler to be used. Specifically, this subcommand searches for the first handler whose name matches an initial substring of @@ -220,6 +258,7 @@ format (where \fIrr\fR is a pair of hexadecimal digits for the red channel, \fIgg\fR for green, and \fIbb\fR for blue). .TP \fB\-from \fIx1 y1 x2 y2\fR +. Specifies a rectangular region of \fIimageName\fR to be returned. If only \fIx1\fR and \fIy1\fR are specified, the region extends from \fI(x1,y1)\fR to the bottom-right corner of @@ -229,16 +268,19 @@ and excluding x2,y2. The default, if this option is not given, is the whole image. .TP \fB\-grayscale\fR +. If this options is specified, the data will not contain color information. All pixel data will be transformed into grayscale. .RE .TP \fIimageName \fBget\fR \fIx y\fR +. Returns the color of the pixel at coordinates (\fIx\fR,\fIy\fR) in the image as a list of three integers between 0 and 255, representing the red, green and blue components respectively. .TP \fIimageName \fBput\fR \fIdata\fR ?\fIoption value(s) ...\fR? +. Sets pixels in \fI imageName\fR to the data specified in \fIdata\fR. This command first searches the list of image file format handlers for a handler that can interpret the data in \fIdata\fR, and then reads @@ -253,12 +295,14 @@ that color. The following options may be specified: .RS .TP \fB\-format \fIformat-name\fR +. Specifies the format of the image data in \fIdata\fR. Specifically, only image file format handlers whose names begin with \fIformat-name\fR will be used while searching for an image data format handler to read the data. .TP \fB\-to \fIx1 y1\fR ?\fIx2 y2\fR? +. Specifies the coordinates of the top-left corner (\fIx1\fR,\fIy1\fR) of the region of \fIimageName\fR into which the image data will be copied. The default position is (0,0). If \fIx2\fR,\fIy2\fR is given @@ -270,6 +314,7 @@ represented by (\fIx2\fR,\fIy2\fR) will be filled with that color. .RE .TP \fIimageName \fBread\fR \fIfilename\fR ?\fIoption value(s) ...\fR? +. Reads image data from the file named \fIfilename\fR into the image. This command first searches the list of image file format handlers for a handler that can interpret the data @@ -279,12 +324,14 @@ specified: .RS .TP \fB\-format \fIformat-name\fR +. Specifies the format of the image data in \fIfilename\fR. Specifically, only image file format handlers whose names begin with \fIformat-name\fR will be used while searching for an image data format handler to read the data. .TP \fB\-from \fIx1 y1 x2 y2\fR +. Specifies a rectangular sub-region of the image file data to be copied to the destination image. If only \fIx1\fR and \fIy1\fR are specified, the region extends from (\fIx1,y1\fR) to the bottom-right @@ -294,6 +341,7 @@ The default, if this option is not specified, is the whole of the image in the image file. .TP \fB\-shrink\fR +. If this option, the size of \fIimageName\fR will be reduced, if necessary, so that the region into which the image file data are read is at the bottom-right corner of the \fIimageName\fR. This option @@ -302,12 +350,14 @@ specified a non-zero value for the \fB\-width\fR or \fB\-height\fR configuration option, respectively. .TP \fB\-to \fIx y\fR +. Specifies the coordinates of the top-left corner of the region of \fIimageName\fR into which data from \fIfilename\fR are to be read. The default is (0,0). .RE .TP \fIimageName \fBredither\fR +. The dithering algorithm used in displaying photo images propagates quantization errors from one pixel to its neighbors. If the image data for \fIimageName\fR is supplied in pieces, the @@ -316,39 +366,47 @@ not noticeable, but if it is a problem, this command can be used to recalculate the dithered image in each window where the image is displayed. .TP -\fIimageName \fBtransparency \fIsubcommand ?arg arg ...?\fR +\fIimageName \fBtransparency \fIsubcommand \fR?\fIarg arg ...\fR? +. Allows examination and manipulation of the transparency information in the photo image. Several subcommands are available: .RS .TP \fIimageName \fBtransparency get \fIx y\fR +. Returns a boolean indicating if the pixel at (\fIx\fR,\fIy\fR) is transparent. .TP \fIimageName \fBtransparency set \fIx y boolean\fR +. Makes the pixel at (\fIx\fR,\fIy\fR) transparent if \fIboolean\fR is true, and makes that pixel opaque otherwise. .RE .TP \fIimageName \fBwrite \fIfilename\fR ?\fIoption value(s) ...\fR? +. Writes image data from \fIimageName\fR to a file named \fIfilename\fR. The following options may be specified: .RS .TP \fB\-background\fI color\fR +. If the color is specified, the data will not contain any transparency information. In all transparent pixels the color will be replaced by the specified color. .TP \fB\-format\fI format-name\fR +. Specifies the name of the image file format handler to be used to write the data to the file. Specifically, this subcommand searches for the first handler whose name matches an initial substring of \fIformat-name\fR and which has the capability to write an image -file. If this option is not given, this subcommand uses the first -handler that has the capability to write an image file. +file. If this option is not given, the format is guessed from +the file extension. If that cannot be determined, this subcommand +uses the first handler that has the capability to write an image file. .TP \fB\-from \fIx1 y1 x2 y2\fR +. Specifies a rectangular region of \fIimageName\fR to be written to the image file. If only \fIx1\fR and \fIy1\fR are specified, the region extends from \fI(x1,y1)\fR to the bottom-right corner of @@ -357,6 +415,7 @@ diagonally opposite corners of the rectangular region. The default, if this option is not given, is the whole image. .TP \fB\-grayscale\fR +. If this options is specified, the data will not contain color information. All pixel data will be transformed into grayscale. .RE @@ -366,8 +425,8 @@ The photo image code is structured to allow handlers for additional image file formats to be added easily. The photo image code maintains a list of these handlers. Handlers are added to the list by registering them with a call to \fBTk_CreatePhotoImageFormat\fR. The -standard Tk distribution comes with handlers for PPM/PGM and GIF formats, -which are automatically registered on initialization. +standard Tk distribution comes with handlers for PPM/PGM, PNG and GIF +formats, which are automatically registered on initialization. .PP When reading an image file or processing string data specified with the \fB\-data\fR configuration option, the @@ -391,6 +450,27 @@ that, which the handler can use, for example, to specify which variant to use of the formats supported by the handler. Note that not all image handlers may support writing transparency data to a file, even where the target image format does. +.SS "FORMAT SUBOPTIONS" +.PP +.VS 8.6 +Some image formats support sub-options, which are specified at the time that +the image is loaded using additional words in the \fB\-format\fR option. At +the time of writing, the following are supported: +.TP +\fBgif \-index\fI indexValue\fR +. +When parsing a multi-part GIF image, Tk normally only accesses the first +image. By giving the \fB\-index\fR sub-option, the \fIindexValue\fR'th value +may be used instead. The \fIindexValue\fR must be an integer from 0 up to the +number of image parts in the GIF data. +.TP +\fBpng \-alpha\fI alphaValue\fR +. +An additional alpha filtering for the overall image, which allows the +background on which the image is displayed to show through. This usually also +has the effect of desaturating the image. The \fIalphaValue\fR must be between +0.0 and 1.0. +.VE 8.6 .SH "COLOR ALLOCATION" .PP When a photo image is displayed in a window, the photo image code @@ -426,8 +506,10 @@ The photo image type was designed and implemented by Paul Mackerras, based on his earlier photo widget and some suggestions from John Ousterhout. .SH EXAMPLE +.PP Load an image from a file and tile it to the size of a window, which is useful for producing a tiled background: +.PP .CS # These lines should be called once \fBimage create photo\fR untiled \-file "theFile.ppm" @@ -439,9 +521,23 @@ set width [winfo width .someWidget] set height [winfo height .someWidget] tiled \fBcopy\fR untiled \-to 0 0 $width $height \-shrink .CE - +.PP +.VS 8.6 +The PNG image loader allows the application of an additional alpha factor +during loading, which is useful for generating images suitable for disabled +buttons: +.PP +.CS +\fBimage create photo\fR icon \-file "icon.png" +\fBimage create photo\fR iconDisabled \-file "icon.png" \e + \-format "png \-alpha 0.5" +button .b \-image icon \-disabledimage iconDisabled +.CE +.VE 8.6 .SH "SEE ALSO" image(n) - .SH KEYWORDS photo, image, color +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/place.n b/doc/place.n index 81aaff1..3a092c2 100644 --- a/doc/place.n +++ b/doc/place.n @@ -14,7 +14,6 @@ place \- Geometry manager for fixed or rubber-sheet placement .SH SYNOPSIS \fBplace \fIoption arg \fR?\fIarg ...\fR? .BE - .SH DESCRIPTION .PP The placer is a geometry manager for Tk. @@ -48,9 +47,9 @@ sublist of the value returned if no \fIoption\fR is specified). If one or more \fIoption\-value\fR pairs are specified, then the command modifies the given option(s) to have the given value(s); in this case the command returns an empty string. - -The following \fIoption\-value\fR pairs are supported: .RS +.PP +The following \fIoption\-value\fR pairs are supported: .TP \fB\-anchor \fIwhere\fR \fIWhere\fR specifies which point of \fIwindow\fR is to be positioned @@ -73,7 +72,8 @@ an option of \fB\-x 0\fR corresponds to an x-coordinate just inside the border and an option of \fB\-relwidth 1.0\fR means \fIwindow\fR will fill the area inside the master's border. - +.RS +.PP If \fImode\fR is \fBoutside\fR then the placer considers the area of the master to include its border; this mode is typically used when placing \fIwindow\fR @@ -83,6 +83,7 @@ case borders are ignored: the area of the master is considered to be its official X area, which includes any internal border but no external border. A bordermode of \fBignore\fR is probably not very useful. +.RE .TP \fB\-height \fIsize\fR \fISize\fR specifies the height for \fIwindow\fR in screen units @@ -238,15 +239,17 @@ set their requested sizes). To control the sizes of these windows, make them windows like frames and canvases that provide configuration options for this purpose. .SH EXAMPLE +.PP Make the label occupy the middle bit of the toplevel, no matter how it is resized: .CS label .l \-text "In the\enMiddle!" \-bg black \-fg white \fBplace\fR .l \-relwidth .3 \-relx .35 \-relheight .3 \-rely .35 .CE - .SH "SEE ALSO" grid(n), pack(n) - .SH KEYWORDS geometry manager, height, location, master, place, rubber sheet, slave, width +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/popup.n b/doc/popup.n index ddce3cb..0d32362 100644 --- a/doc/popup.n +++ b/doc/popup.n @@ -13,7 +13,6 @@ tk_popup \- Post a popup menu .SH SYNOPSIS \fBtk_popup \fImenu x y \fR?\fIentry\fR? .BE - .SH DESCRIPTION .PP This procedure posts a menu at a given position on the screen and @@ -27,6 +26,7 @@ Otherwise \fIentry\fR gives the index of an entry in \fImenu\fR and the menu will be positioned so that the entry is positioned over the given point. .SH EXAMPLE +.PP How to attach a simple popup menu to a widget. .CS # Create a menu @@ -40,9 +40,10 @@ pack [label .l \-text "Click me!"] # Arrange for the menu to pop up when the label is clicked bind .l <1> {\fBtk_popup\fR .popupMenu %X %Y} .CE - .SH "SEE ALSO" bind(n), menu(n), tk_optionMenu(n) - .SH KEYWORDS menu, popup +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/radiobutton.n b/doc/radiobutton.n index 565931c..557b42c 100644 --- a/doc/radiobutton.n +++ b/doc/radiobutton.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -radiobutton \- Create and manipulate radiobutton widgets +radiobutton \- Create and manipulate 'radiobutton' pick-one widgets .SH SYNOPSIS \fBradiobutton\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -38,16 +38,16 @@ If this option is not specified, the button's desired height is computed from the size of the image or bitmap or text being displayed in it. .OP \-indicatoron indicatorOn IndicatorOn Specifies whether or not the indicator should be drawn. Must be a -proper boolean value. If false, the \fBrelief\fR option is +proper boolean value. If false, the \fB\-relief\fR option is ignored and the widget's relief is always sunken if the widget is selected and raised otherwise. .OP \-selectcolor selectColor Background Specifies a background color to use when the button is selected. -If \fBindicatorOn\fR is true then the color applies to the indicator. +If \fB\-indicatoron\fR is true then the color applies to the indicator. Under Windows, this color is used as the background for the indicator regardless of the select state. -If \fBindicatorOn\fR is false, this color is used as the background -for the entire widget, in place of \fBbackground\fR or \fBactiveBackground\fR, +If \fB\-indicatoron\fR is false, this color is used as the background +for the entire widget, in place of \fB\-background\fR or \fB\-activeBackground\fR, whenever the widget is selected. If specified as an empty string then no special color is used for displaying when the widget is selected. @@ -72,34 +72,30 @@ raised\fR. If the value of this option is the empty string, then no alternative relief is used when the mouse cursor is over the radiobutton. The empty string is the default value. .OP \-selectimage selectImage SelectImage -Specifies an image to display (in place of the \fBimage\fR option) +Specifies an image to display (in place of the \fB\-image\fR option) when the radiobutton is selected. -This option is ignored unless the \fBimage\fR option has been +This option is ignored unless the \fB\-image\fR option has been specified. .OP \-state state State Specifies one of three states for the radiobutton: \fBnormal\fR, \fBactive\fR, or \fBdisabled\fR. In normal state the radiobutton is displayed using the -\fBforeground\fR and \fBbackground\fR options. The active state is +\fB\-foreground\fR and \fB\-background\fR options. The active state is typically used when the pointer is over the radiobutton. In active state -the radiobutton is displayed using the \fBactiveForeground\fR and -\fBactiveBackground\fR options. Disabled state means that the radiobutton +the radiobutton is displayed using the \fB\-activeforeground\fR and +\fB\-activebackground\fR options. Disabled state means that the radiobutton should be insensitive: the default bindings will refuse to activate the widget and will ignore mouse button presses. -In this state the \fBdisabledForeground\fR and -\fBbackground\fR options determine how the radiobutton is displayed. +In this state the \fB\-disabledforeground\fR and +\fB\-background\fR options determine how the radiobutton is displayed. .OP \-tristateimage tristateImage TristateImage -.VS 8.5 -Specifies an image to display (in place of the \fBimage\fR option) +Specifies an image to display (in place of the \fB\-image\fR option) when the radiobutton is selected. -This option is ignored unless the \fBimage\fR option has been +This option is ignored unless the \fB\-image\fR option has been specified. -.VE 8.5 .OP \-tristatevalue tristateValue Value -.VS 8.5 -Specifies the value that causes the radiobutton to display the multi-value +Specifies the value that causes the radiobutton to display the multi-value selection, also known as the tri-state mode. Defaults to .QW "" . -.VE 8.5 .OP \-value value Value Specifies value to store in the button's associated variable whenever this button is selected. @@ -133,11 +129,11 @@ A radiobutton is a widget that displays a textual string, bitmap or image and a diamond or circle called an \fIindicator\fR. If text is displayed, it must all be in a single font, but it can occupy multiple lines on the screen (if it contains newlines -or if wrapping occurs because of the \fBwrapLength\fR option) and +or if wrapping occurs because of the \fB\-wraplength\fR option) and one of the characters may optionally be underlined using the -\fBunderline\fR option. A radiobutton has +\fB\-underline\fR option. A radiobutton has all of the behavior of a simple button: it can display itself in either -of three different ways, according to the \fBstate\fR option; +of three different ways, according to the \fB\-state\fR option; it can be made to appear raised, sunken, or flat; it can be made to flash; and it invokes a Tcl command whenever mouse button 1 is clicked over the @@ -160,12 +156,10 @@ When a radiobutton is selected it sets the value of the variable to indicate that fact; each radiobutton also monitors the value of the variable and automatically selects and deselects itself when the variable's value changes. -.VS 8.5 -If the variable's value matches the \fBtristateValue\fR, then the radiobutton is -drawn using the tri-state mode. This mode is used to indicate mixed or -multiple values. (This is used when the radiobutton represents the state +If the variable's value matches the \fB\-tristatevalue\fR, then the radiobutton +is drawn using the tri-state mode. This mode is used to indicate mixed or +multiple values. (This is used when the radiobutton represents the state of multiple items.) -.VE 8.5 By default the variable \fBselectedButton\fR is used; its contents give the name of the button that is selected, or the empty string if no button associated with that @@ -190,12 +184,14 @@ determine the exact behavior of the command. The following commands are possible for radiobutton widgets: .TP \fIpathName \fBcget\fR \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBradiobutton\fR command. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for @@ -210,12 +206,14 @@ this case the command returns an empty string. command. .TP \fIpathName \fBdeselect\fR +. Deselects the radiobutton and sets the associated variable to an empty string. If this radiobutton was not currently selected, the command has no effect. .TP \fIpathName \fBflash\fR +. Flashes the radiobutton. This is accomplished by redisplaying the radiobutton several times, alternating between active and normal colors. At the end of the flash the radiobutton is left in the same normal/active @@ -223,6 +221,7 @@ state as when the command was invoked. This command is ignored if the radiobutton's state is \fBdisabled\fR. .TP \fIpathName \fBinvoke\fR +. Does just what would have happened if the user invoked the radiobutton with the mouse: selects the button and invokes its associated Tcl command, if there is one. @@ -231,6 +230,7 @@ empty string if there is no command associated with the radiobutton. This command is ignored if the radiobutton's state is \fBdisabled\fR. .TP \fIpathName \fBselect\fR +. Selects the radiobutton and sets the associated variable to the value corresponding to this widget. .SH BINDINGS @@ -261,3 +261,6 @@ individual widgets or by redefining the class bindings. checkbutton(n), labelframe(n), listbox(n), options(n), scale(n), ttk::radiobutton(n) .SH KEYWORDS radiobutton, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/raise.n b/doc/raise.n index b71a637..be20c74 100644 --- a/doc/raise.n +++ b/doc/raise.n @@ -14,7 +14,6 @@ raise \- Change a window's position in the stacking order .SH SYNOPSIS \fBraise \fIwindow \fR?\fIaboveThis\fR? .BE - .SH DESCRIPTION .PP If the \fIaboveThis\fR argument is omitted then the command raises @@ -28,7 +27,12 @@ In this case the \fBraise\fR command will insert \fIwindow\fR into the stacking order just above \fIaboveThis\fR (or the ancestor of \fIaboveThis\fR that is a sibling of \fIwindow\fR); this could end up either raising or lowering \fIwindow\fR. +.PP +All \fBtoplevel\fR windows may be restacked with respect to each +other, whatever their relative path names, but the window manager is +not obligated to strictly honor requests to restack. .SH EXAMPLE +.PP Make a button appear to be in a sibling frame that was created after it. This is is often necessary when building GUIs in the style where you create your activity widgets first before laying them out on the @@ -41,9 +45,10 @@ pack .b \-in .f pack [label .f.l2 \-text "This is below"] \fBraise\fR .b .CE - .SH "SEE ALSO" lower(n) - .SH KEYWORDS obscure, raise, stacking order +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/scale.n b/doc/scale.n index a9355a9..7bc5c59 100644 --- a/doc/scale.n +++ b/doc/scale.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -scale \- Create and manipulate scale widgets +scale \- Create and manipulate 'scale' value-controlled slider widgets .SH SYNOPSIS \fBscale\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -74,7 +74,7 @@ Specifies one of three states for the scale: \fBnormal\fR, If the scale is disabled then the value may not be changed and the scale will not activate. If the scale is active, the slider is displayed using the color -specified by the \fBactiveBackground\fR option. +specified by the \fB\-activebackground\fR option. .OP \-tickinterval tickInterval TickInterval Must be a real value. Determines the spacing between numerical @@ -83,7 +83,7 @@ If 0, no tick marks will be displayed. .OP \-to to To Specifies a real value corresponding to the right or bottom end of the scale. -This value may be either less than or greater than the \fBfrom\fR option. +This value may be either less than or greater than the \fB\-from\fR option. .OP \-variable variable Variable Specifies the name of a global variable to link to the scale. Whenever the value of the variable changes, the scale will update to reflect this @@ -96,7 +96,6 @@ Specifies the desired narrow dimension of the trough in screen units For vertical scales this is the trough's width; for horizontal scales this is the trough's height. .BE - .SH DESCRIPTION .PP The \fBscale\fR command creates a new window (given by the @@ -112,16 +111,16 @@ there must not exist a window named \fIpathName\fR, but .PP A scale is a widget that displays a rectangular \fItrough\fR and a small \fIslider\fR. The trough corresponds to a range -of real values (determined by the \fBfrom\fR, \fBto\fR, and -\fBresolution\fR options), +of real values (determined by the \fB\-from\fR, \fB\-to\fR, and +\fB\-resolution\fR options), and the position of the slider selects a particular real value. The slider's position (and hence the scale's value) may be adjusted with the mouse or keyboard as described in the \fBBINDINGS\fR section below. Whenever the scale's value is changed, a Tcl -command is invoked (using the \fBcommand\fR option) to notify +command is invoked (using the \fB\-command\fR option) to notify other interested widgets of the change. In addition, the value -of the scale can be linked to a Tcl variable (using the \fBvariable\fR +of the scale can be linked to a Tcl variable (using the \fB\-variable\fR option), so that changes in either are reflected in the other. .PP Three annotations may be displayed in a scale widget: a label @@ -146,12 +145,14 @@ determine the exact behavior of the command. The following commands are possible for scale widgets: .TP \fIpathName \fBcget\fR \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBscale\fR command. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for @@ -166,12 +167,14 @@ this case the command returns an empty string. command. .TP \fIpathName \fBcoords \fR?\fIvalue\fR? +. Returns a list whose elements are the x and y coordinates of the point along the centerline of the trough that corresponds to \fIvalue\fR. If \fIvalue\fR is omitted then the scale's current value is used. .TP \fIpathName \fBget\fR ?\fIx y\fR? +. If \fIx\fR and \fIy\fR are omitted, returns the current value of the scale. If \fIx\fR and \fIy\fR are specified, they give pixel coordinates within the widget; the command returns @@ -179,7 +182,8 @@ the scale value corresponding to the given pixel. Only one of \fIx\fR or \fIy\fR is used: for horizontal scales \fIy\fR is ignored, and for vertical scales \fIx\fR is ignored. .TP -\fIpathName \fBidentify\fR \fIx y\fR +\fIpathName \fBidentify \fIx y\fR +. Returns a string indicating what part of the scale lies under the coordinates given by \fIx\fR and \fIy\fR. A return value of \fBslider\fR means that the point is over @@ -190,7 +194,8 @@ of the slider below or to the right of the slider. If the point is not over one of these elements, an empty string is returned. .TP -\fIpathName \fBset\fR \fIvalue\fR +\fIpathName \fBset \fIvalue\fR +. This command is invoked to change the current value of the scale, and hence the position at which the slider is displayed. \fIValue\fR gives the new value for the scale. @@ -203,7 +208,7 @@ Where the behavior is different for vertical and horizontal scales, the horizontal behavior is described in parentheses. .IP [1] If button 1 is pressed in the trough, the scale's value will -be incremented or decremented by the value of the \fBresolution\fR +be incremented or decremented by the value of the \fB\-resolution\fR option so that the slider moves in the direction of the cursor. If the button is held down, the action auto-repeats. .IP [2] @@ -219,26 +224,30 @@ position. If the mouse is dragged with button 2 down, the scale's value changes with the drag. .IP [5] The Up and Left keys move the slider up (left) by the value -of the \fBresolution\fR option. +of the \fB\-resolution\fR option. .IP [6] The Down and Right keys move the slider down (right) by the value -of the \fBresolution\fR option. +of the \fB\-resolution\fR option. .IP [7] Control-Up and Control-Left move the slider up (left) by the -value of the \fBbigIncrement\fR option. +value of the \fB\-bigincrement\fR option. .IP [8] Control-Down and Control-Right move the slider down (right) by the -value of the \fBbigIncrement\fR option. +value of the \fB\-bigincrement\fR option. .IP [9] Home moves the slider to the top (left) end of its range. .IP [10] End moves the slider to the bottom (right) end of its range. .PP -If the scale is disabled using the \fBstate\fR option then +If the scale is disabled using the \fB\-state\fR option then none of the above bindings have any effect. .PP The behavior of scales can be changed by defining new bindings for individual widgets or by redefining the class bindings. - +.SH "SEE ALSO" +ttk::scale(n) .SH KEYWORDS scale, slider, trough, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/scrollbar.n b/doc/scrollbar.n index b12b5dd..4d148af 100644 --- a/doc/scrollbar.n +++ b/doc/scrollbar.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -scrollbar \- Create and manipulate scrollbar widgets +scrollbar \- Create and manipulate 'scrollbar' scrolling control and indicator widgets .SH SYNOPSIS \fBscrollbar\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -42,7 +42,7 @@ as described in \fBSCROLLING COMMANDS\fR below. Specifies the width of borders drawn around the internal elements of the scrollbar (the two arrows and the slider). The value may have any of the forms acceptable to \fBTk_GetPixels\fR. -If this value is less than zero, the value of the \fBborderWidth\fR +If this value is less than zero, the value of the \fB\-borderwidth\fR option is used in its place. .OP \-width width Width Specifies the desired narrow dimension of the scrollbar window, @@ -110,9 +110,10 @@ determine the exact behavior of the command. The following commands are possible for scrollbar widgets: .TP \fIpathName \fBactivate \fR?\fIelement\fR? +. Marks the element indicated by \fIelement\fR as active, which -causes it to be displayed as specified by the \fBactiveBackground\fR -and \fBactiveRelief\fR options. +causes it to be displayed as specified by the \fB\-activebackground\fR +and \fB\-activerelief\fR options. The only element values understood by this command are \fBarrow1\fR, \fBslider\fR, or \fBarrow2\fR. If any other value is specified then no element of the scrollbar @@ -121,13 +122,15 @@ If \fIelement\fR is not specified, the command returns the name of the element that is currently active, or an empty string if no element is active. .TP -\fIpathName \fBcget\fR \fIoption\fR +\fIpathName \fBcget \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBscrollbar\fR command. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for @@ -142,6 +145,7 @@ this case the command returns an empty string. command. .TP \fIpathName \fBdelta \fIdeltaX deltaY\fR +. Returns a real number indicating the fractional change in the scrollbar setting that corresponds to a given change in slider position. For example, if the scrollbar is horizontal, @@ -153,6 +157,7 @@ scrollbar setting must change to move the slider \fIdeltaY\fR pixels down. The arguments and the result may be zero or negative. .TP \fIpathName \fBfraction \fIx y\fR +. Returns a real number between 0 and 1 indicating where the point given by \fIx\fR and \fIy\fR lies in the trough area of the scrollbar. The value 0 corresponds to the top or left of the trough, the @@ -164,17 +169,20 @@ If \fIx\fR and \fIy\fR refer to a point outside the trough, the closest point in the trough is used. .TP \fIpathName \fBget\fR +. Returns the scrollbar settings in the form of a list whose elements are the arguments to the most recent \fBset\fR widget command. .TP -\fIpathName \fBidentify\fR \fIx y\fR +\fIpathName \fBidentify \fIx y\fR +. Returns the name of the element under the point given by \fIx\fR and \fIy\fR (such as \fBarrow1\fR), or an empty string if the point does not lie in any element of the scrollbar. \fIX\fR and \fIy\fR must be pixel coordinates relative to the scrollbar widget. .TP -\fIpathName \fBset\fR \fIfirst last\fR +\fIpathName \fBset \fIfirst last\fR +. This command is invoked by the scrollbar's associated widget to tell the scrollbar about the current view in the widget. The command takes two arguments, each of which is a real fraction @@ -194,9 +202,11 @@ The scrollbar makes the notification by evaluating a Tcl command generated from the scrollbar's \fB\-command\fR option. The command may take any of the following forms. In each case, \fIprefix\fR is the contents of the -\fB\-command\fR option, which usually has a form like \fB.t yview\fR +\fB\-command\fR option, which usually has a form like +.QW \fB.t yview\fR . .TP \fIprefix \fBmoveto \fIfraction\fR +. \fIFraction\fR is a real number between 0 and 1. The widget should adjust its view so that the point given by \fIfraction\fR appears at the beginning of the widget. @@ -206,6 +216,7 @@ refers to a point one-third of the way through the document, and so on. .TP \fIprefix \fBscroll \fInumber \fBunits\fR +. The widget should adjust its view by \fInumber\fR units. The units are defined in whatever way makes sense for the widget, such as characters or lines in a text widget. @@ -214,6 +225,7 @@ the top or left of the window, or \-1, which means that one unit should scroll off the bottom or right of the window. .TP \fIprefix \fBscroll \fInumber \fBpages\fR +. The widget should adjust its view by \fInumber\fR pages. It is up to the widget to define the meaning of a page; typically it is slightly less than what fits in the window, so that there @@ -230,7 +242,7 @@ is deprecated. In the old command syntax, the \fBset\fR widget command has the following form: .TP -\fIpathName \fBset\fR \fItotalUnits windowUnits firstUnit lastUnit\fR +\fIpathName \fBset \fItotalUnits windowUnits firstUnit lastUnit\fR In this form the arguments are all integers. \fITotalUnits\fR gives the total size of the object being displayed in the associated widget. The meaning of one unit depends on the associated @@ -262,6 +274,7 @@ If it is given two real arguments then the new syntax will be used in the future, and if it is given four integer arguments then the old syntax will be used. .SH BINDINGS +.PP Tk automatically creates class bindings for scrollbars that give them the following default behavior. If the behavior is different for vertical and horizontal scrollbars, @@ -328,6 +341,7 @@ The Home key adjusts the view to the top (left edge) of the document. .IP [14] The End key adjusts the view to the bottom (right edge) of the document. .SH EXAMPLE +.PP Create a window with a scrollable \fBtext\fR widget: .CS toplevel .tl @@ -341,3 +355,6 @@ grid rowconfigure .tl 0 \-weight 1 ttk:scrollbar(n) .SH KEYWORDS scrollbar, widget +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/selection.n b/doc/selection.n index 41d5d4b..e06a716 100644 --- a/doc/selection.n +++ b/doc/selection.n @@ -14,65 +14,66 @@ selection \- Manipulate the X selection .SH SYNOPSIS \fBselection \fIoption\fR ?\fIarg arg ...\fR? .BE - .SH DESCRIPTION .PP This command provides a Tcl interface to the X selection mechanism and implements the full selection functionality described in the X Inter-Client Communication Conventions Manual (ICCCM). .PP -Note that for management of the CLIPBOARD selection (see below), the +Note that for management of the \fBCLIPBOARD\fR selection (see below), the \fBclipboard\fR command may also be used. .PP The first argument to \fBselection\fR determines the format of the rest of the arguments and the behavior of the command. The following forms are currently supported: -.PP .TP \fBselection clear\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-selection\fR \fIselection\fR? +. If \fIselection\fR exists anywhere on \fIwindow\fR's display, clear it so that no window owns the selection anymore. \fISelection\fR specifies the X selection that should be cleared, and should be an -atom name such as PRIMARY or CLIPBOARD; see the Inter-Client +atom name such as \fBPRIMARY\fR or \fBCLIPBOARD\fR; see the Inter-Client Communication Conventions Manual for complete details. -\fISelection\fR defaults to PRIMARY and \fIwindow\fR defaults to +\fISelection\fR defaults to \fBPRIMARY\fR and \fIwindow\fR defaults to .QW . . Returns an empty string. .TP \fBselection get\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-selection\fR \fIselection\fR? ?\fB\-type\fR \fItype\fR? +. Retrieves the value of \fIselection\fR from \fIwindow\fR's display and -returns it as a result. \fISelection\fR defaults to PRIMARY and +returns it as a result. \fISelection\fR defaults to \fBPRIMARY\fR and \fIwindow\fR defaults to .QW . . \fIType\fR specifies the form in which the selection is to be returned (the desired .QW target for conversion, in ICCCM terminology), and -should be an atom name such as STRING or FILE_NAME; see the +should be an atom name such as \fBSTRING\fR or \fBFILE_NAME\fR; see the Inter-Client Communication Conventions Manual for complete details. -\fIType\fR defaults to STRING. The selection owner may choose to +\fIType\fR defaults to \fBSTRING\fR. The selection owner may choose to return the selection in any of several different representation -formats, such as STRING, UTF8_STRING, ATOM, INTEGER, etc. (this format -is different +formats, such as \fBSTRING\fR, \fBUTF8_STRING\fR, \fBATOM\fR, +\fBINTEGER\fR, etc. (this format is different than the selection type; see the ICCCM for all the confusing details). -If the selection is returned in a non-string format, such as INTEGER -or ATOM, the \fBselection\fR command converts it to string format as a +If the selection is returned in a non-string format, such as \fBINTEGER\fR +or \fBATOM\fR, the \fBselection\fR command converts it to string format as a collection of fields separated by spaces: atoms are converted to their textual names, and anything else is converted to hexadecimal integers. Note that \fBselection get\fR does not retrieve the selection in the -UTF8_STRING format unless told to. +\fBUTF8_STRING\fR format unless told to. .TP \fBselection handle\fR ?\fB\-selection\fR \fIs\fR? ?\fB\-type\fR \fIt\fR? ?\fB\-format\fR \fIf\fR? \fIwindow command\fR +. Creates a handler for selection requests, such that \fIcommand\fR will be executed whenever selection \fIs\fR is owned by \fIwindow\fR and someone attempts to retrieve it in the form given by type \fIt\fR (e.g. \fIt\fR is specified in the \fBselection get\fR command). -\fIS\fR defaults to PRIMARY, \fIt\fR defaults to STRING, and -\fIf\fR defaults to STRING. If \fIcommand\fR is an empty string +\fIS\fR defaults to \fBPRIMARY\fR, \fIt\fR defaults to \fBSTRING\fR, and +\fIf\fR defaults to \fBSTRING\fR. If \fIcommand\fR is an empty string then any existing handler for \fIwindow\fR, \fIt\fR, and \fIs\fR is removed. -Note that when the selection is handled as type STRING it is also -automatically handled as type UTF8_STRING as well. +Note that when the selection is handled as type \fBSTRING\fR it is also +automatically handled as type \fBUTF8_STRING\fR as well. .RS .PP When \fIselection\fR is requested, \fIwindow\fR is the selection owner, @@ -99,12 +100,12 @@ just as if the selection did not exist at all. .PP The \fIformat\fR argument specifies the representation that should be used to transmit the selection to the requester (the second column of -Table 2 of the ICCCM), and defaults to STRING. If \fIformat\fR is -STRING, the selection is transmitted as 8-bit ASCII characters (i.e. +Table 2 of the ICCCM), and defaults to \fBSTRING\fR. If \fIformat\fR is +\fBSTRING\fR, the selection is transmitted as 8-bit ASCII characters (i.e. just in the form returned by \fIcommand\fR, in the system \fBencoding\fR; -the UTF8_STRING format always uses UTF-8 as its encoding). +the \fBUTF8_STRING\fR format always uses UTF-8 as its encoding). If \fIformat\fR is -ATOM, then the return value from \fIcommand\fR is divided into fields +\fBATOM\fR, then the return value from \fIcommand\fR is divided into fields separated by white space; each field is converted to its atom value, and the 32-bit atom value is transmitted instead of the atom name. For any other \fIformat\fR, the return value from \fIcommand\fR is @@ -122,12 +123,14 @@ irrelevant. \fBselection own\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-selection\fR \fIselection\fR? .TP \fBselection own\fR ?\fB\-command\fR \fIcommand\fR? ?\fB\-selection\fR \fIselection\fR? \fIwindow\fR +. The first form of \fBselection own\fR returns the path name of the window in this application that owns \fIselection\fR on the display containing \fIwindow\fR, or an empty string if no window in this -application owns the selection. \fISelection\fR defaults to PRIMARY and +application owns the selection. \fISelection\fR defaults to \fBPRIMARY\fR and \fIwindow\fR defaults to .QW . . +.RS .PP The second form of \fBselection own\fR causes \fIwindow\fR to become the new owner of \fIselection\fR on \fIwindow\fR's display, returning @@ -136,16 +139,20 @@ that it has lost the selection. If \fIcommand\fR is specified, it is a Tcl script to execute when some other window claims ownership of the selection away from \fIwindow\fR. \fISelection\fR defaults to PRIMARY. +.RE .SH EXAMPLES +.PP On X11 platforms, one of the standard selections available is the -SECONDARY selection. Hardly anything uses it, but here is how to read +\fBSECONDARY\fR selection. Hardly anything uses it, but here is how to read it using Tk: +.PP .CS set selContents [\fBselection get\fR \-selection SECONDARY] .CE .PP Many different types of data may be available for a selection; the -special type TARGETS allows you to get a list of available types: +special type \fBTARGETS\fR allows you to get a list of available types: +.PP .CS foreach type [\fBselection get\fR \-type TARGETS] { puts "Selection PRIMARY supports type $type" @@ -153,14 +160,14 @@ foreach type [\fBselection get\fR \-type TARGETS] { .CE .PP To claim the selection, you must first set up a handler to supply the -data for the selection. Then you have to claim the selection... +data for the selection. Then you have to claim the selection... .CS # Set up the data handler ready for incoming requests set foo "This is a string with some data in it... blah blah" \fBselection handle\fR \-selection SECONDARY . getData proc getData {offset maxChars} { puts "Retrieving selection starting at $offset" - return [string range $::foo $offset [expr {$offset+$maxChars}]] + return [string range $::foo $offset [expr {$offset+$maxChars-1}]] } # Now we grab the selection itself @@ -174,3 +181,6 @@ proc lost {} { clipboard(n) .SH KEYWORDS clear, format, handler, ICCCM, own, selection, target, type +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -14,7 +14,6 @@ send \- Execute a command in a different application .SH SYNOPSIS \fBsend ?\fIoptions\fR? \fIapp cmd \fR?\fIarg arg ...\fR? .BE - .SH DESCRIPTION .PP This command arranges for \fIcmd\fR (and \fIarg\fRs) to be executed in the @@ -50,23 +49,20 @@ Serves no purpose except to terminate the list of options. This option is needed only if \fIapp\fR could contain a leading .QW \- character. - .SH "APPLICATION NAMES" .PP The name of an application is set initially from the name of the program or script that created the application. You can query and change the name of an application with the \fBtk appname\fR command. - .SH "DISABLING SENDS" .PP If the \fBsend\fR command is removed from an application (e.g. -with the command \fBrename send {}\fR) then the application +with the command \fBrename\fR \fBsend {}\fR) then the application will not respond to incoming send requests anymore, nor will it be able to issue outgoing requests. Communication can be reenabled by invoking the \fBtk appname\fR command. - .SH SECURITY .PP The \fBsend\fR command is potentially a serious security loophole. On Unix, @@ -89,6 +85,7 @@ such as that provide by \fBxauth\fR. Under Windows, \fBsend\fR is currently disabled. Most of the functionality is provided by the \fBdde\fR command instead. .SH EXAMPLE +.PP This script fragment can be used to make an application that only runs once on a particular display. .CS @@ -107,3 +104,6 @@ proc RemoteStart args { .CE .SH KEYWORDS application, dde, name, remote execution, security, send +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/spinbox.n b/doc/spinbox.n index 34b7014..7227cf1 100644 --- a/doc/spinbox.n +++ b/doc/spinbox.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -spinbox \- Create and manipulate spinbox widgets +spinbox \- Create and manipulate 'spinbox' value spinner widgets .SH SYNOPSIS \fBspinbox\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -57,9 +57,9 @@ are specified correctly, the spinbox will use these values to control its contents. This value must be less than the \fB\-to\fR option. If \fB\-values\fR is specified, it supercedes this option. .OP "\-invalidcommand or \-invcmd" invalidCommand InvalidCommand -Specifies a script to eval when \fBvalidateCommand\fR returns 0. Setting +Specifies a script to eval when \fB\-validatecommand\fR returns 0. Setting it to an empty string disables this feature (the default). The best use of -this option is to set it to \fIbell\fR. See \fBValidation\fR below for +this option is to set it to \fIbell\fR. See \fBVALIDATION\fR below for more information. .OP \-increment increment Increment A floating-point value specifying the increment. When used with @@ -89,16 +89,16 @@ If \fB\-values\fR is specified, it supercedes this option. Specifies the mode in which validation should operate: \fBnone\fR, \fBfocus\fR, \fBfocusin\fR, \fBfocusout\fR, \fBkey\fR, or \fBall\fR. It defaults to \fBnone\fR. When you want validation, you must explicitly -state which mode you wish to use. See \fBValidation\fR below for more. +state which mode you wish to use. See \fBVALIDATION\fR below for more. .OP "\-validatecommand or \-vcmd" validateCommand ValidateCommand Specifies a script to evaluate when you want to validate the input in the widget. Setting it to an empty string disables this feature (the default). Validation occurs according to the value of \fB\-validate\fR. This command must return a valid Tcl boolean value. If it returns 0 (or the valid Tcl boolean equivalent) then the value of the widget will not -change and the \fBinvalidCommand\fR will be evaluated if it is set. If it +change and the \fB\-invalidcommand\fR will be evaluated if it is set. If it returns 1, then value will be changed. -See \fBValidation\fR below for more information. +See \fBVALIDATION\fR below for more information. .OP \-values values Values Must be a proper list value. If specified, the spinbox will use these values as to control its contents, starting with the first value. This @@ -129,7 +129,7 @@ to move, or spin, through a fixed set of ascending or descending values such as times or dates in addition to editing the value as in an \fBentry\fR. When first created, a spinbox's string is empty. A portion of the spinbox may be selected as described below. -If a spinbox is exporting its selection (see the \fBexportSelection\fR +If a spinbox is exporting its selection (see the \fB\-exportselection\fR option), then it will observe the standard protocols for handling the selection; spinbox selections are available as type \fBSTRING\fR. Spinboxes also observe the standard Tk rules for dealing with the @@ -141,31 +141,31 @@ Spinboxes are capable of displaying strings that are too long to fit entirely within the widget's window. In this case, only a portion of the string will be displayed; commands described below may be used to change the view in the window. Spinboxes use -the standard \fBxScrollCommand\fR mechanism for interacting with -scrollbars (see the description of the \fBxScrollCommand\fR option +the standard \fB\-xscrollcommand\fR mechanism for interacting with +scrollbars (see the description of the \fB\-xscrollcommand\fR option for details). They also support scanning, as described below. .SH VALIDATION .PP -Validation works by setting the \fBvalidateCommand\fR -option to a script which will be evaluated according to the \fBvalidate\fR +Validation works by setting the \fB\-validatecommand\fR +option to a script which will be evaluated according to the \fB\-validate\fR option as follows: .PP .IP \fBnone\fR 10 Default. This means no validation will occur. .IP \fBfocus\fR 10 -\fBvalidateCommand\fR will be called when the spinbox receives or +The \fB\-validatecommand\fR will be called when the spinbox receives or loses focus. .IP \fBfocusin\fR 10 -\fBvalidateCommand\fR will be called when the spinbox receives focus. +The \fB\-validatecommand\fR will be called when the spinbox receives focus. .IP \fBfocusout\fR 10 -\fBvalidateCommand\fR will be called when the spinbox loses focus. +The \fB\-validatecommand\fR will be called when the spinbox loses focus. .IP \fBkey\fR 10 -\fBvalidateCommand\fR will be called when the spinbox is edited. +The \fB\-validatecommand\fR will be called when the spinbox is edited. .IP \fBall\fR 10 -\fBvalidateCommand\fR will be called for all above conditions. +The \fB\-validatecommand\fR will be called for all above conditions. .PP -It is possible to perform percent substitutions on the \fBvalidateCommand\fR -and \fBinvalidCommand\fR, just as you would in a \fBbind\fR script. The +It is possible to perform percent substitutions on the \fB\-validatecommand\fR +and \fB\-invalidcommand\fR scripts, just as you would in a \fBbind\fR script. The following substitutions are recognized: .PP .IP \fB%d\fR 5 @@ -190,32 +190,32 @@ The type of validation that triggered the callback .IP \fB%W\fR 5 The name of the spinbox widget. .PP -In general, the \fBtextVariable\fR and \fBvalidateCommand\fR can be +In general, the \fB\-textvariable\fR and \fB\-validatecommand\fR can be dangerous to mix. Any problems have been overcome so that using the -\fBvalidateCommand\fR will not interfere with the traditional behavior of -the spinbox widget. Using the \fBtextVariable\fR for read-only purposes will +\fB\-validatecommand\fR will not interfere with the traditional behavior of +the spinbox widget. Using the \fB\-textvariable\fR for read-only purposes will never cause problems. The danger comes when you try set the -\fBtextVariable\fR to something that the \fBvalidateCommand\fR would not -accept, which causes \fBvalidate\fR to become \fBnone\fR (the -\fBinvalidCommand\fR will not be triggered). The same happens -when an error occurs evaluating the \fBvalidateCommand\fR. +\fB\-textvariable\fR to something that the \fB\-validatecommand\fR would not +accept, which causes \fB\-validate\fR to become \fBnone\fR (the +\fB\-invalidcommand\fR will not be triggered). The same happens +when an error occurs evaluating the \fB\-validatecommand\fR. .PP -Primarily, an error will occur when the \fBvalidateCommand\fR or -\fBinvalidCommand\fR encounters an error in its script while evaluating or -\fBvalidateCommand\fR does not return a valid Tcl boolean value. The -\fBvalidate\fR option will also set itself to \fBnone\fR when you edit the -spinbox widget from within either the \fBvalidateCommand\fR or the -\fBinvalidCommand\fR. Such editions will override the one that was being +Primarily, an error will occur when the \fB\-validatecommand\fR or +\fB\-invalidcommand\fR encounters an error in its script while evaluating or +\fB\-validatecommand\fR does not return a valid Tcl boolean value. The +\fB\-validate\fR option will also set itself to \fBnone\fR when you edit the +spinbox widget from within either the \fB\-validatecommand\fR or the +\fB\-invalidcommand\fR. Such editions will override the one that was being validated. If you wish to edit the value of the widget -during validation and still have the \fBvalidate\fR option set, you should +during validation and still have the \fB\-validate\fR option set, you should include the command .CS \fI%W config \-validate %v\fR .CE -in the \fBvalidateCommand\fR or \fBinvalidCommand\fR (whichever one you +in the \fB\-validatecommand\fR or \fB\-invalidcommand\fR (whichever one you were editing the spinbox widget from). It is also recommended to not set an -associated \fBtextVariable\fR during validation, as that can cause the -spinbox widget to become out of sync with the \fBtextVariable\fR. +associated \fB\-textvariable\fR during validation, as that can cause the +spinbox widget to become out of sync with the \fB\-textvariable\fR. .PP Also, the \fBvalidate\fR option will set itself to \fBnone\fR when the spinbox value gets changed because of adjustment of \fBfrom\fR or \fBto\fR @@ -402,7 +402,7 @@ Returns an empty string. Returns 1 if there is are characters selected in the spinbox, 0 if nothing is selected. .TP -\fIpathName \fBselection range \fIstart\fR \fIend\fR +\fIpathName \fBselection range \fIstart end\fR Sets the selection to include the characters starting with the one indexed by \fIstart\fR and ending with the one just before \fIend\fR. @@ -430,9 +430,9 @@ value, otherwise it just returns the spinbox's string. If validation is on, it will occur when setting the string. .TP \fIpathName \fBvalidate\fR -This command is used to force an evaluation of the \fBvalidateCommand\fR -independent of the conditions specified by the \fBvalidate\fR option. -This is done by temporarily setting the \fBvalidate\fR option to \fBall\fR. +This command is used to force an evaluation of the \fB\-validatecommand\fR +independent of the conditions specified by the \fB\-validate\fR option. +This is done by temporarily setting the \fB\-validate\fR option to \fBall\fR. It returns 0 or 1. .TP \fIpathName \fBxview \fIargs\fR @@ -451,7 +451,7 @@ in the window, and 40% of the text is off-screen to the right. These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR option. .TP -\fIpathName \fBxview\fR \fIindex\fR +\fIpathName \fBxview \fIindex\fR Adjusts the view in the window so that the character given by \fIindex\fR is displayed at the left edge of the window. .TP @@ -473,7 +473,6 @@ If \fInumber\fR is negative then characters farther to the left become visible; if it is positive then characters farther to the right become visible. .RE - .SH "DEFAULT BINDINGS" .PP Tk automatically creates class bindings for spinboxes that give them @@ -590,6 +589,10 @@ take place. .PP The behavior of spinboxes can be changed by defining new bindings for individual widgets or by redefining the class bindings. - +.SH "SEE ALSO" +ttk::spinbox(n) .SH KEYWORDS spinbox, entry, widget +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -8,9 +8,9 @@ .TH text n 8.5 Tk "Tk Built-In Commands" .so man.macros .BS -'\" Note: do not modify the .SH NAME line immediately below! +'\" Note: do not modify the .SH NAME line immediately below! .SH NAME -text, tk_textCopy, tk_textCut, tk_textPaste \- Create and manipulate text widgets +text, tk_textCopy, tk_textCut, tk_textPaste \- Create and manipulate 'text' hypertext editing widgets .SH SYNOPSIS .nf \fBtext\fR \fIpathName \fR?\fIoptions\fR? @@ -29,1599 +29,1432 @@ text, tk_textCopy, tk_textCut, tk_textPaste \- Create and manipulate text widget .SE .SH "WIDGET-SPECIFIC OPTIONS" .OP \-autoseparators autoSeparators AutoSeparators -Specifies a boolean that says whether separators are automatically -inserted in the undo stack. Only meaningful when the \fB\-undo\fR -option is true. +Specifies a boolean that says whether separators are automatically inserted in +the undo stack. Only meaningful when the \fB\-undo\fR option is true. .OP \-blockcursor blockCursor BlockCursor -.VS 8.5 -Specifies a boolean that says whether the blinking insertion cursor -should be drawn as a character-sized rectangular block. If false -(the default) a thin vertical line is used for the insertion cursor. -.VE 8.5 +Specifies a boolean that says whether the blinking insertion cursor should be +drawn as a character-sized rectangular block. If false (the default) a thin +vertical line is used for the insertion cursor. .OP \-endline endLine EndLine -.VS 8.5 Specifies an integer line index representing the line of the underlying textual data store that should be just after the last line contained in -the widget. -This allows a text widget to reflect only a portion of a larger piece -of text. Instead of an integer, the empty string can be provided to -this configuration option, which will configure the widget to end -at the very last line in the textual data store. -.VE 8.5 +the widget. This allows a text widget to reflect only a portion of a +larger piece of text. Instead of an integer, the empty string can be +provided to this configuration option, which will configure the widget +to end at the very last line in the textual data store. .OP \-height height Height -Specifies the desired height for the window, in units of characters -in the font given by the \fB\-font\fR option. -Must be at least one. +Specifies the desired height for the window, in units of characters in the +font given by the \fB\-font\fR option. Must be at least one. .OP \-inactiveselectbackground inactiveSelectBackground Foreground -.VS 8.5 -Specifies the colour to use for the selection (the \fBsel\fR tag) when -the window does not have the input focus. If empty, \fB{}\fR, then no -selection is shown when the window does not have the focus. -.VE 8.5 +Specifies the colour to use for the selection (the \fBsel\fR tag) when the +window does not have the input focus. If empty, \fB{}\fR, then no selection is +shown when the window does not have the focus. +.OP \-insertunfocussed insertUnfocussed InsertUnfocussed +.VS 8.6 +Specifies how to display the insertion cursor when the widget does not have +the focus. Must be \fBnone\fR (the default) which means to not display the +cursor, \fBhollow\fR which means to display a hollow box, or \fBsolid\fR which +means to display a solid box. Note that \fBhollow\fR and \fBsolid\fR will +appear very similar when the \fB\-blockcursor\fR option is false. +.VE 8.6 .OP \-maxundo maxUndo MaxUndo -Specifies the maximum number of compound undo actions on the undo -stack. A zero or a negative value imply an unlimited undo stack. +Specifies the maximum number of compound undo actions on the undo stack. A +zero or a negative value imply an unlimited undo stack. .OP \-spacing1 spacing1 Spacing1 -Requests additional space above each text line in the widget, -using any of the standard forms for screen distances. -If a line wraps, this option only applies to the first line -on the display. -This option may be overridden with \fB\-spacing1\fR options in -tags. +Requests additional space above each text line in the widget, using any of the +standard forms for screen distances. If a line wraps, this option only applies +to the first line on the display. This option may be overridden with +\fB\-spacing1\fR options in tags. .OP \-spacing2 spacing2 Spacing2 -For lines that wrap (so that they cover more than one line on the -display) this option specifies additional space to provide between -the display lines that represent a single line of text. -The value may have any of the standard forms for screen distances. -This option may be overridden with \fB\-spacing2\fR options in -tags. +For lines that wrap (so that they cover more than one line on the display) +this option specifies additional space to provide between the display lines +that represent a single line of text. The value may have any of the standard +forms for screen distances. This option may be overridden with +\fB\-spacing2\fR options in tags. .OP \-spacing3 spacing3 Spacing3 -Requests additional space below each text line in the widget, -using any of the standard forms for screen distances. -If a line wraps, this option only applies to the last line -on the display. -This option may be overridden with \fB\-spacing3\fR options in -tags. +Requests additional space below each text line in the widget, using any of the +standard forms for screen distances. If a line wraps, this option only applies +to the last line on the display. This option may be overridden with +\fB\-spacing3\fR options in tags. .OP \-startline startLine StartLine -.VS 8.5 -Specifies an integer line index representing the first line of the -underlying textual data store that should be contained in the widget. -This allows a text widget to reflect only a portion of a larger piece -of text. Instead of an integer, the empty string can be provided to -this configuration option, which will configure the widget to start -at the very first line in the textual data store. -.VE 8.5 +Specifies an integer line index representing the first line of the underlying +textual data store that should be contained in the widget. This allows a text +widget to reflect only a portion of a larger piece of text. Instead of an +integer, the empty string can be provided to this configuration option, which +will configure the widget to start at the very first line in the textual data +store. .OP \-state state State -Specifies one of two states for the text: \fBnormal\fR or \fBdisabled\fR. -If the text is disabled then characters may not be inserted or deleted -and no insertion cursor will be displayed, even if the input focus is -in the widget. +Specifies one of two states for the text: \fBnormal\fR or \fBdisabled\fR. If +the text is disabled then characters may not be inserted or deleted and no +insertion cursor will be displayed, even if the input focus is in the widget. .OP \-tabs tabs Tabs -Specifies a set of tab stops for the window. The option's value consists -of a list of screen distances giving the positions of the tab stops, -each of which is a distance relative to the left edge of the widget -(excluding borders, padding, etc). Each -position may optionally be followed in the next list element -by one of the keywords \fBleft\fR, \fBright\fR, \fBcenter\fR, -or \fBnumeric\fR, which specifies how to justify -text relative to the tab stop. \fBLeft\fR is the default; it causes -the text following the tab character to be positioned with its left edge -at the tab position. \fBRight\fR means that the right edge of the text -following the tab character is positioned at the tab position, and -\fBcenter\fR means that the text is centered at the tab position. -\fBNumeric\fR means that the decimal point in the text is positioned -at the tab position; if there is no decimal point then the least -significant digit of the number is positioned just to the left of the -tab position; if there is no number in the text then the text is -right-justified at the tab position. -For example, +Specifies a set of tab stops for the window. The option's value consists of a +list of screen distances giving the positions of the tab stops, each of which +is a distance relative to the left edge of the widget (excluding borders, +padding, etc). Each position may optionally be followed in the next list +element by one of the keywords \fBleft\fR, \fBright\fR, \fBcenter\fR, or +\fBnumeric\fR, which specifies how to justify text relative to the tab stop. +\fBLeft\fR is the default; it causes the text following the tab character to +be positioned with its left edge at the tab position. \fBRight\fR means that +the right edge of the text following the tab character is positioned at the +tab position, and \fBcenter\fR means that the text is centered at the tab +position. \fBNumeric\fR means that the decimal point in the text is positioned +at the tab position; if there is no decimal point then the least significant +digit of the number is positioned just to the left of the tab position; if +there is no number in the text then the text is right-justified at the tab +position. For example, .QW "\fB\-tabs {2c left 4c 6c center}\fR" -creates three tab stops at two-centimeter intervals; the first two use left +creates three tab stops at two-centimeter intervals; the first two use left justification and the third uses center justification. .RS .PP -If the list of tab stops does not have enough elements to cover all -of the tabs in a text line, then Tk extrapolates new tab stops using -the spacing and alignment from the last tab stop in the list. Tab -distances must be strictly positive, and must always increase from one -tab stop to the next (if not, an error is thrown). -The value of the \fBtabs\fR option may be overridden by \fB\-tabs\fR -options in tags. -.PP -If no \fB\-tabs\fR option is specified, or if it is specified as -an empty list, then Tk uses default tabs spaced every eight -(average size) characters. To achieve a different standard spacing, -for example every 4 characters, simply configure the widget with +If the list of tab stops does not have enough elements to cover all of the +tabs in a text line, then Tk extrapolates new tab stops using the spacing and +alignment from the last tab stop in the list. Tab distances must be strictly +positive, and must always increase from one tab stop to the next (if not, an +error is thrown). The value of the \fB\-tabs\fR option may be overridden by +\fB\-tabs\fR options in tags. +.PP +If no \fB\-tabs\fR option is specified, or if it is specified as an empty +list, then Tk uses default tabs spaced every eight (average size) characters. +To achieve a different standard spacing, for example every 4 characters, +simply configure the widget with .QW "\fB\-tabs \N'34'[expr {4 * [font measure $font 0]}] left\N'34' \-tabstyle wordprocessor\fR" . .RE .OP \-tabstyle tabStyle TabStyle -Specifies how to interpret the relationship between tab stops on a line -and tabs in the text of that line. The value must be \fBtabular\fR (the -default) or \fBwordprocessor\fR. Note that tabs are interpreted as they -are encountered in the text. If the tab style is \fBtabular\fR then the -\fIn\fR'th tab character in the line's text will be associated with -the \fIn\fR'th -tab stop defined for that line. If the tab character's x coordinate -falls to the right of the \fIn\fR'th tab stop, then a gap of a single space -will be inserted as a fallback. If the tab style is \fBwordprocessor\fR -then any tab character being laid out will use (and be defined by) the -first tab stop to the right of the preceding characters already laid out -on that line. The value of the \fBtabstyle\fR option may be overridden -by \fB\-tabstyle\fR options in tags. +Specifies how to interpret the relationship between tab stops on a line and +tabs in the text of that line. The value must be \fBtabular\fR (the default) +or \fBwordprocessor\fR. Note that tabs are interpreted as they are encountered +in the text. If the tab style is \fBtabular\fR then the \fIn\fR'th tab +character in the line's text will be associated with the \fIn\fR'th tab stop +defined for that line. If the tab character's x coordinate falls to the right +of the \fIn\fR'th tab stop, then a gap of a single space will be inserted as a +fallback. If the tab style is \fBwordprocessor\fR then any tab character being +laid out will use (and be defined by) the first tab stop to the right of the +preceding characters already laid out on that line. The value of the +\fB\-tabstyle\fR option may be overridden by \fB\-tabstyle\fR options in tags. .OP \-undo undo Undo -Specifies a boolean that says whether the undo mechanism is active or -not. +Specifies a boolean that says whether the undo mechanism is active or not. .OP \-width width Width -Specifies the desired width for the window in units of characters -in the font given by the \fB\-font\fR option. -If the font does not have a uniform width then the width of the character +Specifies the desired width for the window in units of characters in the font +given by the \fB\-font\fR option. If the font does not have a uniform width +then the width of the character .QW 0 is used in translating from character units to screen units. .OP \-wrap wrap Wrap -Specifies how to handle lines in the text that are too long to be -displayed in a single line of the text's window. -The value must be \fBnone\fR or \fBchar\fR or \fBword\fR. -A wrap mode of \fBnone\fR means that each line of text appears as -exactly one line on the screen; extra characters that do not fit -on the screen are not displayed. -In the other modes each line of text will be broken up into several -screen lines if necessary to keep all the characters visible. -In \fBchar\fR mode a screen line break may occur after any character; -in \fBword\fR mode a line break will only be made at word boundaries. +Specifies how to handle lines in the text that are too long to be displayed in +a single line of the text's window. The value must be \fBnone\fR or \fBchar\fR +or \fBword\fR. A wrap mode of \fBnone\fR means that each line of text appears +as exactly one line on the screen; extra characters that do not fit on the +screen are not displayed. In the other modes each line of text will be broken +up into several screen lines if necessary to keep all the characters visible. +In \fBchar\fR mode a screen line break may occur after any character; in +\fBword\fR mode a line break will only be made at word boundaries. .BE - .SH DESCRIPTION .PP -The \fBtext\fR command creates a new window (given by the -\fIpathName\fR argument) and makes it into a text widget. -Additional -options, described above, may be specified on the command line -or in the option database -to configure aspects of the text such as its default background color -and relief. The \fBtext\fR command returns the -path name of the new window. -.PP -A text widget displays one or more lines of text and allows that -text to be edited. -Text widgets support four different kinds of annotations on the -text, called tags, marks, embedded windows or embedded images. -Tags allow different portions of the text -to be displayed with different fonts and colors. -In addition, Tcl commands can be associated with tags so -that scripts are invoked when particular actions such as keystrokes -and mouse button presses occur in particular ranges of the text. -See \fBTAGS\fR below for more details. -.PP -The second form of annotation consists of floating markers in the text -called +The \fBtext\fR command creates a new window (given by the \fIpathName\fR +argument) and makes it into a text widget. Additional options, described +above, may be specified on the command line or in the option database to +configure aspects of the text such as its default background color and relief. +The \fBtext\fR command returns the path name of the new window. +.PP +A text widget displays one or more lines of text and allows that text to be +edited. Text widgets support four different kinds of annotations on the text, +called tags, marks, embedded windows or embedded images. Tags allow different +portions of the text to be displayed with different fonts and colors. In +addition, Tcl commands can be associated with tags so that scripts are invoked +when particular actions such as keystrokes and mouse button presses occur in +particular ranges of the text. See \fBTAGS\fR below for more details. +.PP +The second form of annotation consists of floating markers in the text called .QW marks . -Marks are used to keep track of various interesting positions in the -text as it is edited. -See \fBMARKS\fR below for more details. +Marks are used to keep track of various interesting positions in the text as +it is edited. See \fBMARKS\fR below for more details. .PP -The third form of annotation allows arbitrary windows to be -embedded in a text widget. -See \fBEMBEDDED WINDOWS\fR below for more details. +The third form of annotation allows arbitrary windows to be embedded in a text +widget. See \fBEMBEDDED WINDOWS\fR below for more details. .PP The fourth form of annotation allows Tk images to be embedded in a text -widget. -See \fBEMBEDDED IMAGES\fR below for more details. +widget. See \fBEMBEDDED IMAGES\fR below for more details. .PP -The text widget also has a built-in undo/redo mechanism. -See \fBTHE UNDO MECHANISM\fR below for more details. +The text widget also has a built-in undo/redo mechanism. See +\fBTHE UNDO MECHANISM\fR below for more details. .PP -.VS 8.5 -The text widget allows for the creation of peer widgets. These are -other text widgets which share the same underlying data (text, marks, -tags, images, etc). See \fBPEER WIDGETS\fR below for more details. -.VE 8.5 +The text widget allows for the creation of peer widgets. These are other text +widgets which share the same underlying data (text, marks, tags, images, etc). +See \fBPEER WIDGETS\fR below for more details. .SH INDICES .PP -Many of the widget commands for texts take one or more indices -as arguments. -An index is a string used to indicate a particular place within -a text, such as a place to insert characters or one endpoint of a -range of characters to delete. -Indices have the syntax +Many of the widget commands for texts take one or more indices as arguments. +An index is a string used to indicate a particular place within a text, such +as a place to insert characters or one endpoint of a range of characters to +delete. Indices have the syntax .CS \fIbase modifier modifier modifier ...\fR .CE -Where \fIbase\fR gives a starting point and the \fImodifier\fRs -adjust the index from the starting point (e.g. move forward or -backward one character). Every index must contain a \fIbase\fR, -but the \fImodifier\fRs are optional. -.VS 8.5 -Most modifiers (as documented below) allow -an optional submodifier. Valid submodifiers are \fBany\fR -and \fBdisplay\fR. If the submodifier is abbreviated, then it must be -followed by whitespace, but otherwise there need be no space between the -submodifier and the following \fImodifier\fR. Typically the \fBdisplay\fR -submodifier adjusts the meaning of the following \fImodifier\fR to make -it refer to visual or non-elided units rather than logical units, but -this is explained for each relevant case below. Lastly, where \fIcount\fR -is used as part of a modifier, it can be positive or negative, so +Where \fIbase\fR gives a starting point and the \fImodifier\fRs adjust the +index from the starting point (e.g. move forward or backward one character). +Every index must contain a \fIbase\fR, but the \fImodifier\fRs are optional. +Most modifiers (as documented below) allow an optional submodifier. Valid +submodifiers are \fBany\fR and \fBdisplay\fR. If the submodifier is +abbreviated, then it must be followed by whitespace, but otherwise there need +be no space between the submodifier and the following \fImodifier\fR. +Typically the \fBdisplay\fR submodifier adjusts the meaning of the following +\fImodifier\fR to make it refer to visual or non-elided units rather than +logical units, but this is explained for each relevant case below. Lastly, +where \fIcount\fR is used as part of a modifier, it can be positive or +negative, so .QW "\fIbase\fR \- \-3 lines" is perfectly valid (and equivalent to .QW "\fIbase\fR +3lines" ). -.VE 8.5 .PP The \fIbase\fR for an index must have one of the following forms: .TP 12 \fIline\fB.\fIchar\fR -Indicates \fIchar\fR'th character on line \fIline\fR. -Lines are numbered from 1 for consistency with other UNIX programs -that use this numbering scheme. -Within a line, characters are numbered from 0. -If \fIchar\fR is \fBend\fR then it refers to the newline character -that ends the line. +. +Indicates \fIchar\fR'th character on line \fIline\fR. Lines are numbered from +1 for consistency with other UNIX programs that use this numbering scheme. +Within a line, characters are numbered from 0. If \fIchar\fR is \fBend\fR then +it refers to the newline character that ends the line. .TP 12 \fB@\fIx\fB,\fIy\fR -Indicates the character that covers the pixel whose x and y coordinates -within the text's window are \fIx\fR and \fIy\fR. +. +Indicates the character that covers the pixel whose x and y coordinates within +the text's window are \fIx\fR and \fIy\fR. .TP 12 \fBend\fR -Indicates the end of the text (the character just after the last -newline). +. +Indicates the end of the text (the character just after the last newline). .TP 12 \fImark\fR +. Indicates the character just after the mark whose name is \fImark\fR. .TP 12 \fItag\fB.first\fR -Indicates the first character in the text that has been tagged with +. +Indicates the first character in the text that has been tagged with \fItag\fR. +This form generates an error if no characters are currently tagged with \fItag\fR. -This form generates an error if no characters are currently tagged -with \fItag\fR. .TP 12 \fItag\fB.last\fR -Indicates the character just after the last one in the text that has -been tagged with \fItag\fR. -This form generates an error if no characters are currently tagged -with \fItag\fR. +. +Indicates the character just after the last one in the text that has been +tagged with \fItag\fR. This form generates an error if no characters are +currently tagged with \fItag\fR. .TP 12 \fIpathName\fR -Indicates the position of the embedded window whose name is -\fIpathName\fR. -This form generates an error if there is no embedded window -by the given name. +. +Indicates the position of the embedded window whose name is \fIpathName\fR. +This form generates an error if there is no embedded window by the given name. .TP 12 \fIimageName\fR -Indicates the position of the embedded image whose name is -\fIimageName\fR. -This form generates an error if there is no embedded image -by the given name. -.PP -If the \fIbase\fR could match more than one of the above forms, such -as a \fImark\fR and \fIimageName\fR both having the same value, then -the form earlier in the above list takes precedence. -If modifiers follow the base index, each one of them must have one -of the forms listed below. Keywords such as \fBchars\fR and \fBwordend\fR -may be abbreviated as long as the abbreviation is unambiguous. +. +Indicates the position of the embedded image whose name is \fIimageName\fR. +This form generates an error if there is no embedded image by the given name. +.PP +If the \fIbase\fR could match more than one of the above forms, such as a +\fImark\fR and \fIimageName\fR both having the same value, then the form +earlier in the above list takes precedence. If modifiers follow the base +index, each one of them must have one of the forms listed below. Keywords such +as \fBchars\fR and \fBwordend\fR may be abbreviated as long as the +abbreviation is unambiguous. .TP \fB+ \fIcount\fR ?\fIsubmodifier\fR? \fBchars\fR -.VS 8.5 -Adjust the index forward by \fIcount\fR characters, moving to later lines -in the text if necessary. If there are fewer than \fIcount\fR characters -in the text after the current index, then set the index to the last index -in the text. Spaces on either side of \fIcount\fR are optional. If the -\fBdisplay\fR submodifier is given, elided characters are skipped over -without being counted. If \fBany\fR is given, then all characters are -counted. For historical reasons, if neither modifier is given then the -count actually takes place in units of index positions (see \fBindices\fR -for details). This behaviour may be changed in a future major release, -so if you need an index count, you are encouraged to use \fBindices\fR -instead wherever possible. -.VE 8.5 +. +Adjust the index forward by \fIcount\fR characters, moving to later lines in +the text if necessary. If there are fewer than \fIcount\fR characters in the +text after the current index, then set the index to the last index in the +text. Spaces on either side of \fIcount\fR are optional. If the \fBdisplay\fR +submodifier is given, elided characters are skipped over without being +counted. If \fBany\fR is given, then all characters are counted. For +historical reasons, if neither modifier is given then the count actually takes +place in units of index positions (see \fBINDICES\fR for details). This +behaviour may be changed in a future major release, so if you need an index +count, you are encouraged to use \fBindices\fR instead wherever possible. .TP \fB\- \fIcount\fR ?\fIsubmodifier\fR? \fBchars\fR -Adjust the index backward by \fIcount\fR characters, moving to earlier -lines in the text if necessary. If there are fewer than \fIcount\fR -characters in the text before the current index, then set the index to -.VS 8.5 -the first index in the text (1.0). Spaces on either side of \fIcount\fR -are optional. If the \fBdisplay\fR submodifier is given, elided -characters are skipped over without being counted. If \fBany\fR is -given, then all characters are counted. For historical reasons, if -neither modifier is given then the count actually takes place in units of -index positions (see \fBindices\fR for details). This behaviour may be -changed in a future major release, so if you need an index count, you are -encouraged to use \fBindices\fR instead wherever possible. -.VE 8.5 +. +Adjust the index backward by \fIcount\fR characters, moving to earlier lines +in the text if necessary. If there are fewer than \fIcount\fR characters in +the text before the current index, then set the index to the first index in +the text (1.0). Spaces on either side of \fIcount\fR are optional. If the +\fBdisplay\fR submodifier is given, elided characters are skipped over without +being counted. If \fBany\fR is given, then all characters are counted. For +historical reasons, if neither modifier is given then the count actually takes +place in units of index positions (see \fBINDICES\fR for details). This +behavior may be changed in a future major release, so if you need an index +count, you are encouraged to use \fBindices\fR instead wherever possible. .TP \fB+ \fIcount\fR ?\fIsubmodifier\fR? \fBindices\fR -.VS 8.5 -Adjust the index forward by \fIcount\fR index positions, moving to later -lines in the text if necessary. If there are fewer than \fIcount\fR -index positions in the text after the current index, then set the index -to the last index position in the text. Spaces on either side of -\fIcount\fR are optional. Note that an index position is either a single -character or a single embedded image or embedded window. If the -\fBdisplay\fR submodifier is given, elided indices are skipped over -without being counted. If \fBany\fR is given, then all indices are -counted; this is also the default behaviour if no modifier is given. -.VE 8.5 +. +Adjust the index forward by \fIcount\fR index positions, moving to later lines +in the text if necessary. If there are fewer than \fIcount\fR index positions +in the text after the current index, then set the index to the last index +position in the text. Spaces on either side of \fIcount\fR are optional. Note +that an index position is either a single character or a single embedded image +or embedded window. If the \fBdisplay\fR submodifier is given, elided indices +are skipped over without being counted. If \fBany\fR is given, then all +indices are counted; this is also the default behaviour if no modifier is +given. .TP \fB\- \fIcount\fR ?\fIsubmodifier\fR? \fBindices\fR -.VS 8.5 -Adjust the index backward by \fIcount\fR index positions, moving to -earlier lines in the text if necessary. If there are fewer than -\fIcount\fR index positions in the text before the current index, then -set the index to the first index position (1.0) in the text. Spaces on -either side of \fIcount\fR are optional. If the \fBdisplay\fR -submodifier is given, elided indices are skipped over without being -counted. If \fBany\fR is given, then all indices are counted; this is -also the default behaviour if no modifier is given. -.VE 8.5 +. +Adjust the index backward by \fIcount\fR index positions, moving to earlier +lines in the text if necessary. If there are fewer than \fIcount\fR index +positions in the text before the current index, then set the index to the +first index position (1.0) in the text. Spaces on either side of \fIcount\fR +are optional. If the \fBdisplay\fR submodifier is given, elided indices are +skipped over without being counted. If \fBany\fR is given, then all indices +are counted; this is also the default behaviour if no modifier is given. .TP \fB+ \fIcount\fR ?\fIsubmodifier\fR? \fBlines\fR -.VS 8.5 -Adjust the index forward by \fIcount\fR lines, retaining the same -character position within the line. If there are fewer than \fIcount\fR -lines after the line containing the current index, then set the index to -refer to the same character position on the last line of the text. Then, -if the line is not long enough to contain a character at the indicated -character position, adjust the character position to refer to the last -character of the line (the newline). Spaces on either side of -\fIcount\fR are optional. If the \fBdisplay\fR submodifier is given, -then each visual display line is counted separately. Otherwise, if -\fBany\fR (or no modifier) is given, then each logical line (no matter -how many times it is visually wrapped) counts just once. If the relevant -lines are not wrapped, then these two methods of counting are equivalent. -.VE 8.5 +. +Adjust the index forward by \fIcount\fR lines, retaining the same character +position within the line. If there are fewer than \fIcount\fR lines after the +line containing the current index, then set the index to refer to the same +character position on the last line of the text. Then, if the line is not long +enough to contain a character at the indicated character position, adjust the +character position to refer to the last character of the line (the newline). +Spaces on either side of \fIcount\fR are optional. If the \fBdisplay\fR +submodifier is given, then each visual display line is counted separately. +Otherwise, if \fBany\fR (or no modifier) is given, then each logical line (no +matter how many times it is visually wrapped) counts just once. If the +relevant lines are not wrapped, then these two methods of counting are +equivalent. .TP \fB\- \fIcount\fR ?\fIsubmodifier\fR? \fBlines\fR -.VS 8.5 -Adjust the index backward by \fIcount\fR logical lines, retaining the -same character position within the line. If there are fewer than -\fIcount\fR lines before the line containing the current index, then set -the index to refer to the same character position on the first line of -the text. Then, if the line is not long enough to contain a character at -the indicated character position, adjust the character position to refer -to the last character of the line (the newline). Spaces on either side -of \fIcount\fR are optional. If the \fBdisplay\fR submodifier is given, -then each visual display line is counted separately. Otherwise, if -\fBany\fR (or no modifier) is given, then each logical line (no matter -how many times it is visually wrapped) counts just once. If the relevant -lines are not wrapped, then these two methods of counting are equivalent. -.VE 8.5 +. +Adjust the index backward by \fIcount\fR logical lines, retaining the same +character position within the line. If there are fewer than \fIcount\fR lines +before the line containing the current index, then set the index to refer to +the same character position on the first line of the text. Then, if the line +is not long enough to contain a character at the indicated character position, +adjust the character position to refer to the last character of the line (the +newline). Spaces on either side of \fIcount\fR are optional. If the +\fBdisplay\fR submodifier is given, then each visual display line is counted +separately. Otherwise, if \fBany\fR (or no modifier) is given, then each +logical line (no matter how many times it is visually wrapped) counts just +once. If the relevant lines are not wrapped, then these two methods of +counting are equivalent. .TP ?\fIsubmodifier\fR? \fBlinestart\fR -.VS 8.5 -Adjust the index to refer to the first index on the line. If the -\fBdisplay\fR submodifier is given, this is the first index on the -display line, otherwise on the logical line. -.VE 8.5 +. +Adjust the index to refer to the first index on the line. If the \fBdisplay\fR +submodifier is given, this is the first index on the display line, otherwise +on the logical line. .TP ?\fIsubmodifier\fR? \fBlineend\fR -.VS 8.5 -Adjust the index to refer to the last index on the line (the -newline). If the \fBdisplay\fR submodifier is given, this is the last -index on the display line, otherwise on the logical line. -.VE 8.5 +. +Adjust the index to refer to the last index on the line (the newline). If the +\fBdisplay\fR submodifier is given, this is the last index on the display +line, otherwise on the logical line. .TP ?\fIsubmodifier\fR? \fBwordstart\fR -.VS 8.5 -Adjust the index to refer to the first character of the word containing -the current index. A word consists of any number of adjacent characters -that are letters, digits, or underscores, or a single character that is -not one of these. If the \fBdisplay\fR submodifier is given, this only -examines non-elided characters, otherwise all characters (elided or not) -are examined. -.VE 8.5 +. +Adjust the index to refer to the first character of the word containing the +current index. A word consists of any number of adjacent characters that are +letters, digits, or underscores, or a single character that is not one of +these. If the \fBdisplay\fR submodifier is given, this only examines +non-elided characters, otherwise all characters (elided or not) are examined. .TP ?\fIsubmodifier\fR? \fBwordend\fR -.VS 8.5 -Adjust the index to refer to the character just after the last one of the -word containing the current index. If the current index refers to the -last character of the text then it is not modified. If the \fBdisplay\fR -submodifier is given, this only examines non-elided characters, otherwise -all characters (elided or not) are examined. -.PP -If more than one modifier is present then they are applied in -left-to-right order. For example, the index +. +Adjust the index to refer to the character just after the last one of the word +containing the current index. If the current index refers to the last +character of the text then it is not modified. If the \fBdisplay\fR +submodifier is given, this only examines non-elided characters, otherwise all +characters (elided or not) are examined. +.PP +If more than one modifier is present then they are applied in left-to-right +order. For example, the index .QW "\fBend \- 1 chars\fR" refers to the next-to-last character in the text and .QW "\fBinsert wordstart \- 1 c\fR" -refers to the character just before -the first one in the word containing the insertion cursor. Modifiers -are applied one by one in this left to right order, and after each step -the resulting index is constrained to be a valid index in the text -widget. So, for example, the index +refers to the character just before the first one in the word containing the +insertion cursor. Modifiers are applied one by one in this left to right +order, and after each step the resulting index is constrained to be a valid +index in the text widget. So, for example, the index .QW "\fB1.0 \-1c +1c\fR" refers to the index .QW \fB2.0\fR . .PP -Where modifiers result in index changes by display lines, display chars -or display indices, and the \fIbase\fR refers to an index inside an -elided tag, +Where modifiers result in index changes by display lines, display chars or +display indices, and the \fIbase\fR refers to an index inside an elided tag, that base index is considered to be equivalent to the first following non-elided index. -.VE 8.5 .SH TAGS .PP -The first form of annotation in text widgets is a tag. -A tag is a textual string that is associated with some of the characters -in a text. -Tags may contain arbitrary characters, but it is probably best to -avoid using the characters +The first form of annotation in text widgets is a tag. A tag is a textual +string that is associated with some of the characters in a text. Tags may +contain arbitrary characters, but it is probably best to avoid using the +characters .QW " " -(space), \fB+\fR, or \fB\-\fR: -these characters have special meaning in indices, so tags containing -them cannot be used as indices. -There may be any number of tags associated with characters in a -text. -Each tag may refer to a single character, a range of characters, or -several ranges of characters. -An individual character may have any number of tags associated with it. -.PP -A priority order is defined among tags, and this order is used in -implementing some of the tag-related functions described below. -When a tag is defined (by associating it with characters or setting -its display options or binding commands to it), it is given -a priority higher than any existing tag. -The priority order of tags may be redefined using the +(space), \fB+\fR, or \fB\-\fR: these characters have special meaning in +indices, so tags containing them cannot be used as indices. There may be any +number of tags associated with characters in a text. Each tag may refer to a +single character, a range of characters, or several ranges of characters. An +individual character may have any number of tags associated with it. +.PP +A priority order is defined among tags, and this order is used in implementing +some of the tag-related functions described below. When a tag is defined (by +associating it with characters or setting its display options or binding +commands to it), it is given a priority higher than any existing tag. The +priority order of tags may be redefined using the .QW "\fIpathName \fBtag raise\fR" and .QW "\fIpathName \fBtag lower\fR" widget commands. .PP -Tags serve three purposes in text widgets. -First, they control the way information is displayed on the screen. -By default, characters are displayed as determined by the -\fB\-background\fR, \fB\-font\fR, and \fB\-foreground\fR options for the -text widget. -However, display options may be associated with individual tags -using the +Tags serve three purposes in text widgets. First, they control the way +information is displayed on the screen. By default, characters are displayed +as determined by the \fB\-background\fR, \fB\-font\fR, and \fB\-foreground\fR +options for the text widget. However, display options may be associated with +individual tags using the .QW "\fIpathName \fBtag configure\fR" -widget command. -If a character has been tagged, then the display options associated -with the tag override the default display style. -The following options are currently supported for tags: +widget command. If a character has been tagged, then the display options +associated with the tag override the default display style. The following +options are currently supported for tags: .TP \fB\-background \fIcolor\fR -\fIColor\fR specifies the background color to use for characters -associated with the tag. -It may have any of the forms accepted by \fBTk_GetColor\fR. +. +\fIColor\fR specifies the background color to use for characters associated +with the tag. It may have any of the forms accepted by \fBTk_GetColor\fR. .TP \fB\-bgstipple \fIbitmap\fR -\fIBitmap\fR specifies a bitmap that is used as a stipple pattern -for the background. -It may have any of the forms accepted by \fBTk_GetBitmap\fR. -If \fIbitmap\fR has not been specified, or if it is specified -as an empty string, then a solid fill will be used for the -background. +. +\fIBitmap\fR specifies a bitmap that is used as a stipple pattern for the +background. It may have any of the forms accepted by \fBTk_GetBitmap\fR. If +\fIbitmap\fR has not been specified, or if it is specified as an empty string, +then a solid fill will be used for the background. .TP \fB\-borderwidth \fIpixels\fR -\fIPixels\fR specifies the width of a 3-D border to draw around -the background. -It may have any of the forms accepted by \fBTk_GetPixels\fR. -This option is used in conjunction with the \fB\-relief\fR -option to give a 3-D appearance to the background for characters; -it is ignored unless the \fB\-background\fR option -has been set for the tag. +. +\fIPixels\fR specifies the width of a border to draw around the tag using any +of the forms accepted by \fBTk_GetPixels\fR. This option should be used in +conjunction with the \fB\-relief\fR option to provide the desired border. .TP \fB\-elide \fIboolean\fR -\fIElide\fR specifies whether the data should -be elided. Elided data (characters, images, embedded windows, etc) is -not displayed and takes no space on screen, but further on behaves just -as normal data. +. +\fIElide\fR specifies whether the data should be elided. Elided data +(characters, images, embedded windows, etc.) is not displayed and takes no +space on screen, but further on behaves just as normal data. .TP \fB\-fgstipple \fIbitmap\fR -\fIBitmap\fR specifies a bitmap that is used as a stipple pattern -when drawing text and other foreground information such as -underlines. -It may have any of the forms accepted by \fBTk_GetBitmap\fR. -If \fIbitmap\fR has not been specified, or if it is specified -as an empty string, then a solid fill will be used. +. +\fIBitmap\fR specifies a bitmap that is used as a stipple pattern when drawing +text and other foreground information such as underlines. It may have any of +the forms accepted by \fBTk_GetBitmap\fR. If \fIbitmap\fR has not been +specified, or if it is specified as an empty string, then a solid fill will be +used. .TP \fB\-font \fIfontName\fR -\fIFontName\fR is the name of a font to use for drawing characters. -It may have any of the forms accepted by \fBTk_GetFont\fR. +. +\fIFontName\fR is the name of a font to use for drawing characters. It may +have any of the forms accepted by \fBTk_GetFont\fR. .TP \fB\-foreground \fIcolor\fR -\fIColor\fR specifies the color to use when drawing text and other -foreground information such as underlines. -It may have any of the forms accepted by \fBTk_GetColor\fR. +. +\fIColor\fR specifies the color to use when drawing text and other foreground +information such as underlines. It may have any of the forms accepted by +\fBTk_GetColor\fR. .TP \fB\-justify \fIjustify\fR +. If the first non-elided character of a display line has a tag for which this -option has been specified, then \fIjustify\fR determines how to -justify the line. -It must be one of \fBleft\fR, \fBright\fR, or \fBcenter\fR. -If a line wraps, then the justification for each line on the -display is determined by the first non-elided character of that display line. +option has been specified, then \fIjustify\fR determines how to justify the +line. It must be one of \fBleft\fR, \fBright\fR, or \fBcenter\fR. If a line +wraps, then the justification for each line on the display is determined by +the first non-elided character of that display line. .TP \fB\-lmargin1 \fIpixels\fR +. If the first non-elided character of a text line has a tag for which this -option has been specified, then \fIpixels\fR specifies how -much the line should be indented from the left edge of the -window. -\fIPixels\fR may have any of the standard forms for screen -distances. -If a line of text wraps, this option only applies to the -first line on the display; the \fB\-lmargin2\fR option controls -the indentation for subsequent lines. +option has been specified, then \fIpixels\fR specifies how much the line +should be indented from the left edge of the window. \fIPixels\fR may have any +of the standard forms for screen distances. If a line of text wraps, this +option only applies to the first line on the display; the \fB\-lmargin2\fR +option controls the indentation for subsequent lines. .TP \fB\-lmargin2 \fIpixels\fR +. If the first non-elided character of a display line has a tag for which this -option has been specified, and if the display line is not the -first for its text line (i.e., the text line has wrapped), then -\fIpixels\fR specifies how much the line should be indented from -the left edge of the window. -\fIPixels\fR may have any of the standard forms for screen -distances. -This option is only used when wrapping is enabled, and it only -applies to the second and later display lines for a text line. +option has been specified, and if the display line is not the first for its +text line (i.e., the text line has wrapped), then \fIpixels\fR specifies how +much the line should be indented from the left edge of the window. +\fIPixels\fR may have any of the standard forms for screen distances. This +option is only used when wrapping is enabled, and it only applies to the +second and later display lines for a text line. .TP \fB\-offset \fIpixels\fR -\fIPixels\fR specifies an amount by which the text's baseline -should be offset vertically from the baseline of the overall -line, in pixels. -For example, a positive offset can be used for superscripts -and a negative offset can be used for subscripts. -\fIPixels\fR may have any of the standard forms for screen +. +\fIPixels\fR specifies an amount by which the text's baseline should be offset +vertically from the baseline of the overall line, in pixels. For example, a +positive offset can be used for superscripts and a negative offset can be used +for subscripts. \fIPixels\fR may have any of the standard forms for screen distances. .TP \fB\-overstrike \fIboolean\fR -Specifies whether or not to draw a horizontal rule through -the middle of characters. -\fIBoolean\fR may have any of the forms accepted by \fBTcl_GetBoolean\fR. +. +Specifies whether or not to draw a horizontal rule through the middle of +characters. \fIBoolean\fR may have any of the forms accepted by +\fBTcl_GetBoolean\fR. .TP \fB\-relief \fIrelief\fR -\fIRelief\fR specifies the 3-D relief to use for drawing backgrounds, -in any of the forms accepted by \fBTk_GetRelief\fR. -This option is used in conjunction with the \fB\-borderwidth\fR -option to give a 3-D appearance to the background for characters; -it is ignored unless the \fB\-background\fR option -has been set for the tag. +. +\fIRelief\fR specifies the relief style to use for drawing the border, in any +of the forms accepted by \fBTk_GetRelief\fR. This option is used in +conjunction with the \fB\-borderwidth\fR option to enable to the desired +border appearance. .TP \fB\-rmargin \fIpixels\fR +. If the first non-elided character of a display line has a tag for which this -option has been specified, then \fIpixels\fR specifies how wide -a margin to leave between the end of the line and the right -edge of the window. -\fIPixels\fR may have any of the standard forms for screen -distances. -This option is only used when wrapping is enabled. -If a text line wraps, the right margin for each line on the -display is determined by the first non-elided character of that display -line. +option has been specified, then \fIpixels\fR specifies how wide a margin to +leave between the end of the line and the right edge of the window. +\fIPixels\fR may have any of the standard forms for screen distances. This +option is only used when wrapping is enabled. If a text line wraps, the right +margin for each line on the display is determined by the first non-elided +character of that display line. .TP \fB\-spacing1 \fIpixels\fR -\fIPixels\fR specifies how much additional space should be -left above each text line, using any of the standard forms for -screen distances. -If a line wraps, this option only applies to the first -line on the display. +. +\fIPixels\fR specifies how much additional space should be left above each +text line, using any of the standard forms for screen distances. If a line +wraps, this option only applies to the first line on the display. .TP \fB\-spacing2 \fIpixels\fR -For lines that wrap, this option specifies how much additional -space to leave between the display lines for a single text line. -\fIPixels\fR may have any of the standard forms for screen -distances. +. +For lines that wrap, this option specifies how much additional space to leave +between the display lines for a single text line. \fIPixels\fR may have any of +the standard forms for screen distances. .TP \fB\-spacing3 \fIpixels\fR -\fIPixels\fR specifies how much additional space should be -left below each text line, using any of the standard forms for -screen distances. -If a line wraps, this option only applies to the last -line on the display. +. +\fIPixels\fR specifies how much additional space should be left below each +text line, using any of the standard forms for screen distances. If a line +wraps, this option only applies to the last line on the display. .TP \fB\-tabs \fItabList\fR -\fITabList\fR specifies a set of tab stops in the same form -as for the \fB\-tabs\fR option for the text widget. This -option only applies to a display line if it applies to the -first non-elided character on that display line. -If this option is specified as an empty string, it cancels -the option, leaving it unspecified for the tag (the default). -If the option is specified as a non-empty string that is -an empty list, such as \fB\-tags\0{\0}\fR, then it requests -default 8-character tabs as described for the \fB\-tags\fR -widget option. +. +\fITabList\fR specifies a set of tab stops in the same form as for the +\fB\-tabs\fR option for the text widget. This option only applies to a display +line if it applies to the first non-elided character on that display line. If +this option is specified as an empty string, it cancels the option, leaving it +unspecified for the tag (the default). If the option is specified as a +non-empty string that is an empty list, such as \fB\-tags\0{\0}\fR, then it +requests default 8-character tabs as described for the \fB\-tags\fR widget +option. .TP \fB\-tabstyle \fIstyle\fR -\fIStyle\fR specifies either the \fItabular\fR or -\fIwordprocessor\fR style of tabbing to use for the text widget. -This option only applies to a display line if it applies to the -first non-elided character on that display line. -If this option is specified as an empty string, it cancels -the option, leaving it unspecified for the tag (the default). +. +\fIStyle\fR specifies either the \fItabular\fR or \fIwordprocessor\fR style of +tabbing to use for the text widget. This option only applies to a display line +if it applies to the first non-elided character on that display line. If this +option is specified as an empty string, it cancels the option, leaving it +unspecified for the tag (the default). .TP \fB\-underline \fIboolean\fR +. \fIBoolean\fR specifies whether or not to draw an underline underneath -characters. -It may have any of the forms accepted by \fBTcl_GetBoolean\fR. +characters. It may have any of the forms accepted by \fBTcl_GetBoolean\fR. .TP \fB\-wrap \fImode\fR -\fIMode\fR specifies how to handle lines that are wider than the -text's window. -It has the same legal values as the \fB\-wrap\fR option -for the text widget: \fBnone\fR, \fBchar\fR, or \fBword\fR. -If this tag option is specified, it overrides the \fB\-wrap\fR option -for the text widget. -.PP -If a character has several tags associated with it, and if their -display options conflict, then the options of the highest priority -tag are used. -If a particular display option has not been specified for a -particular tag, or if it is specified as an empty string, then -that option will never be used; the next-highest-priority -tag's option will used instead. -If no tag specifies a particular display option, then the default -style for the widget will be used. -.PP -The second purpose for tags is event bindings. -You can associate bindings with a tag in much the same way you can -associate bindings with a widget class: whenever particular X -events occur on characters with the given tag, a given -Tcl command will be executed. -Tag bindings can be used to give behaviors to ranges of characters; -among other things, this allows hypertext-like -features to be implemented. -For details, see the description of the +. +\fIMode\fR specifies how to handle lines that are wider than the text's +window. It has the same legal values as the \fB\-wrap\fR option for the text +widget: \fBnone\fR, \fBchar\fR, or \fBword\fR. If this tag option is +specified, it overrides the \fB\-wrap\fR option for the text widget. +.PP +If a character has several tags associated with it, and if their display +options conflict, then the options of the highest priority tag are used. If a +particular display option has not been specified for a particular tag, or if +it is specified as an empty string, then that option will never be used; the +next-highest-priority tag's option will used instead. If no tag specifies a +particular display option, then the default style for the widget will be used. +.PP +The second purpose for tags is event bindings. You can associate bindings with +a tag in much the same way you can associate bindings with a widget class: +whenever particular X events occur on characters with the given tag, a given +Tcl command will be executed. Tag bindings can be used to give behaviors to +ranges of characters; among other things, this allows hypertext-like features +to be implemented. For details, see the description of the .QW "\fIpathName \fBtag bind\fR" -widget command below. -.VS 8.5 -Tag bindings are shared between all peer widgets +widget command below. Tag bindings are shared between all peer widgets (including any bindings for the special \fBsel\fR tag). -.VE 8.5 -.PP -The third use for tags is in managing the selection. -See \fBTHE SELECTION\fR below. -.VS 8.5 -With the exception of the special \fBsel\fR -tag, all tags are shared between peer text widgets, and may be -manipulated on an equal basis from any such widget. The \fBsel\fR -tag exists separately and independently in each peer text widget (but -any tag bindings to \fBsel\fR are shared). -.VE 8.5 +.PP +The third use for tags is in managing the selection. See \fBTHE SELECTION\fR +below. With the exception of the special \fBsel\fR tag, all tags are shared +between peer text widgets, and may be manipulated on an equal basis from any +such widget. The \fBsel\fR tag exists separately and independently in each +peer text widget (but any tag bindings to \fBsel\fR are shared). .SH MARKS .PP -The second form of annotation in text widgets is a mark. -Marks are used for remembering particular places in a text. -They are something like tags, in that they have names and -they refer to places in the file, but a mark is not associated -with particular characters. -Instead, a mark is associated with the gap between two characters. -Only a single position may be associated with a mark at any given -time. -If the characters around a mark are deleted the mark will still -remain; it will just have new neighbor characters. -In contrast, if the characters containing a tag are deleted then -the tag will no longer have an association with characters in -the file. -Marks may be manipulated with the +The second form of annotation in text widgets is a mark. Marks are used for +remembering particular places in a text. They are something like tags, in that +they have names and they refer to places in the file, but a mark is not +associated with particular characters. Instead, a mark is associated with the +gap between two characters. Only a single position may be associated with a +mark at any given time. If the characters around a mark are deleted the mark +will still remain; it will just have new neighbor characters. In contrast, if +the characters containing a tag are deleted then the tag will no longer have +an association with characters in the file. Marks may be manipulated with the .QW "\fIpathName \fBmark\fR" -widget -command, and their current locations may be determined by using the +widget command, and their current locations may be determined by using the mark name as an index in widget commands. .PP Each mark also has a .QW gravity , -which is either \fBleft\fR or \fBright\fR. -The gravity for a mark specifies what happens to the mark when -text is inserted at the point of the mark. -If a mark has left gravity, then the mark is treated as if it -were attached to the character on its left, so the mark will -remain to the left of any text inserted at the mark position. -If the mark has right gravity, new text inserted at the mark -position will appear to the left of the mark (so that the mark -remains rightmost). The gravity for a mark defaults to \fBright\fR. -.PP -The name space for marks is different from that for tags: the -same name may be used for both a mark and a tag, but they will refer -to different things. -.PP -Two marks have special significance. -First, the mark \fBinsert\fR is associated with the insertion cursor, -as described under \fBTHE INSERTION CURSOR\fR below. -Second, the mark \fBcurrent\fR is associated with the character -closest to the mouse and is adjusted automatically to track the -mouse position and any changes to the text in the widget (one -exception: \fBcurrent\fR is not updated in response to mouse -motions if a mouse button is down; the update will be deferred -until all mouse buttons have been released). -Neither of these special marks may be deleted. -.VS 8.5 -With the exception of -these two special marks, all marks are shared between peer text -widgets, and may be manipulated on an equal basis from any peer. -.VE 8.5 +which is either \fBleft\fR or \fBright\fR. The gravity for a mark specifies +what happens to the mark when text is inserted at the point of the mark. If a +mark has left gravity, then the mark is treated as if it were attached to the +character on its left, so the mark will remain to the left of any text +inserted at the mark position. If the mark has right gravity, new text +inserted at the mark position will appear to the left of the mark (so that the +mark remains rightmost). The gravity for a mark defaults to \fBright\fR. +.PP +The name space for marks is different from that for tags: the same name may be +used for both a mark and a tag, but they will refer to different things. +.PP +Two marks have special significance. First, the mark \fBinsert\fR is +associated with the insertion cursor, as described under +\fBTHE INSERTION CURSOR\fR +below. Second, the mark \fBcurrent\fR is associated with the +character closest to the mouse and is adjusted automatically to track the +mouse position and any changes to the text in the widget (one exception: +\fBcurrent\fR is not updated in response to mouse motions if a mouse button is +down; the update will be deferred until all mouse buttons have been released). +Neither of these special marks may be deleted. With the exception of these two +special marks, all marks are shared between peer text widgets, and may be +manipulated on an equal basis from any peer. .SH "EMBEDDED WINDOWS" .PP -The third form of annotation in text widgets is an embedded window. -Each embedded window annotation causes a window to be displayed -at a particular point in the text. -There may be any number of embedded windows in a text widget, -and any widget may be used as an embedded window (subject to the -usual rules for geometry management, which require the text window -to be the parent of the embedded window or a descendant of its -parent). -.PP -The embedded window's position on the screen will be updated as the -text is modified or scrolled, and it will be mapped and unmapped as -it moves into and out of the visible area of the text widget. -Each embedded window occupies one -.VS 8.5 -unit's -.VE 8.5 -worth of index space -in the text widget, and it may be referred to either by the name -of its embedded window or by its position in the widget's -index space. -If the range of text containing the embedded window is deleted then -the window is destroyed. -.VS 8.5 -Similarly if the text widget as a whole is deleted, then the window is -destroyed. -.VE 8.5 -.PP -.VS 8.5 -Eliding an embedded window immediately after scheduling it for creation -via \fIpathName \fBwindow create \fIindex \fB-create\fR will prevent it -from being effectively created. -Uneliding an elided embedded window scheduled for creation via -\fIpathName \fBwindow create \fIindex \fB-create\fR will automatically -trigger the associated creation script. -After destroying an elided embedded window, the latter won't get -automatically recreated. -.VE 8.5 -.PP -When an embedded window is added to a text widget with the -\fIpathName \fBwindow create\fR widget command, several configuration -options may be associated with it. -These options may be modified later with the \fIpathName \fBwindow configure\fR -widget command. -The following options are currently supported: +The third form of annotation in text widgets is an embedded window. Each +embedded window annotation causes a window to be displayed at a particular +point in the text. There may be any number of embedded windows in a text +widget, and any widget may be used as an embedded window (subject to the usual +rules for geometry management, which require the text window to be the parent +of the embedded window or a descendant of its parent). +.PP +The embedded window's position on the screen will be updated as the text is +modified or scrolled, and it will be mapped and unmapped as it moves into and +out of the visible area of the text widget. Each embedded window occupies one +unit's worth of index space in the text widget, and it may be referred to +either by the name of its embedded window or by its position in the widget's +index space. If the range of text containing the embedded window is deleted +then the window is destroyed. Similarly if the text widget as a whole is +deleted, then the window is destroyed. +.PP +Eliding an embedded window immediately after scheduling it for creation via +\fIpathName \fBwindow create \fIindex \fB-create\fR will prevent it from being +effectively created. Uneliding an elided embedded window scheduled for creation +via \fIpathName \fBwindow create \fIindex \fB-create\fR will automatically +trigger the associated creation script. After destroying an elided embedded +window, the latter won't get automatically recreated. +.PP +When an embedded window is added to a text widget with the \fIpathName +\fBwindow create\fR widget command, several configuration options may be +associated with it. These options may be modified later with the \fIpathName +\fBwindow configure\fR widget command. The following options are currently +supported: .TP \fB\-align \fIwhere\fR -If the window is not as tall as the line in which it is displayed, -this option determines where the window is displayed in the line. -\fIWhere\fR must have one of the values \fBtop\fR (align the top of the window -with the top of the line), \fBcenter\fR (center the window -within the range of the line), \fBbottom\fR (align the bottom of the -window with the bottom of the line's area), -or \fBbaseline\fR (align the bottom of the window with the baseline -of the line). +. +If the window is not as tall as the line in which it is displayed, this option +determines where the window is displayed in the line. \fIWhere\fR must have +one of the values \fBtop\fR (align the top of the window with the top of the +line), \fBcenter\fR (center the window within the range of the line), +\fBbottom\fR (align the bottom of the window with the bottom of the line's +area), or \fBbaseline\fR (align the bottom of the window with the baseline of +the line). .TP \fB\-create \fIscript\fR -Specifies a Tcl script that may be evaluated to create the window -for the annotation. -If no \fB\-window\fR option has been specified for the annotation -this script will be evaluated when the annotation is about to -be displayed on the screen. -\fIScript\fR must create a window for the annotation and return -the name of that window as its result. -.VS 8.5 -Two substitutions will be performed in \fIscript\fR before evaluation. -\fI%W\fR will be substituted by the name of the parent text widget, -and \fI%%\fR will be substituted by a single \fI%\fR. -.VE 8.5 -If the annotation's window should ever be deleted, \fIscript\fR -will be evaluated again the next time the annotation is displayed. +. +Specifies a Tcl script that may be evaluated to create the window for the +annotation. If no \fB\-window\fR option has been specified for the annotation +this script will be evaluated when the annotation is about to be displayed on +the screen. \fIScript\fR must create a window for the annotation and return +the name of that window as its result. Two substitutions will be performed in +\fIscript\fR before evaluation. \fI%W\fR will be substituted by the name of +the parent text widget, and \fI%%\fR will be substituted by a single \fI%\fR. +If the annotation's window should ever be deleted, \fIscript\fR will be +evaluated again the next time the annotation is displayed. .TP \fB\-padx \fIpixels\fR -\fIPixels\fR specifies the amount of extra space to leave on -each side of the embedded window. -It may have any of the usual forms defined for a screen distance. +. +\fIPixels\fR specifies the amount of extra space to leave on each side of the +embedded window. It may have any of the usual forms defined for a screen +distance. .TP \fB\-pady \fIpixels\fR -\fIPixels\fR specifies the amount of extra space to leave on -the top and on the bottom of the embedded window. -It may have any of the usual forms defined for a screen distance. +. +\fIPixels\fR specifies the amount of extra space to leave on the top and on +the bottom of the embedded window. It may have any of the usual forms defined +for a screen distance. .TP \fB\-stretch \fIboolean\fR -If the requested height of the embedded window is less than the -height of the line in which it is displayed, this option can be -used to specify whether the window should be stretched vertically -to fill its line. -If the \fB\-pady\fR option has been specified as well, then the -requested padding will be retained even if the window is -stretched. +. +If the requested height of the embedded window is less than the height of the +line in which it is displayed, this option can be used to specify whether the +window should be stretched vertically to fill its line. If the \fB\-pady\fR +option has been specified as well, then the requested padding will be retained +even if the window is stretched. .TP \fB\-window \fIpathName\fR -Specifies the name of a window to display in the annotation. -.VS 8.5 -Note that if a \fIpathName\fR has been set, then later configuring a -window to the empty string will not delete the widget corresponding to -the old \fIpathName\fR. Rather it will remove the association between -the old \fIpathName\fR and the text widget. If multiple peer widgets -are in use, it is usually simpler to use the \fB\-create\fR option if -embedded windows are desired in each peer. -.VE 8.5 +. +Specifies the name of a window to display in the annotation. Note that if a +\fIpathName\fR has been set, then later configuring a window to the empty +string will not delete the widget corresponding to the old \fIpathName\fR. +Rather it will remove the association between the old \fIpathName\fR and the +text widget. If multiple peer widgets are in use, it is usually simpler to use +the \fB\-create\fR option if embedded windows are desired in each peer. .SH "EMBEDDED IMAGES" .PP -The final form of annotation in text widgets is an embedded image. -Each embedded image annotation causes an image to be displayed -at a particular point in the text. -There may be any number of embedded images in a text widget, -and a particular image may be embedded in multiple places in the same +The final form of annotation in text widgets is an embedded image. Each +embedded image annotation causes an image to be displayed at a particular +point in the text. There may be any number of embedded images in a text +widget, and a particular image may be embedded in multiple places in the same text widget. .PP -The embedded image's position on the screen will be updated as the -text is modified or scrolled. -Each embedded image occupies one -.VS 8.5 -unit's -.VE 8.5 -worth of index space -in the text widget, and it may be referred to either by -its position in the widget's index space, or the name it is assigned -when the image is inserted into the text widget with \fIpathName \fBimage create\fR. -If the range of text containing the embedded image is deleted then -that copy of the image is removed from the screen. -.PP -.VS 8.5 -Eliding an embedded image immediately after scheduling it for creation -via \fIpathName \fBimage create \fIindex \fB-create\fR will prevent it -from being effectively created. -Uneliding an elided embedded image scheduled for creation via -\fIpathName \fBimage create \fIindex \fB-create\fR will automatically -trigger the associated creation script. -After destroying an elided embedded image, the latter won't get -automatically recreated. -.VE 8.5 +The embedded image's position on the screen will be updated as the text is +modified or scrolled. Each embedded image occupies one unit's worth of index +space in the text widget, and it may be referred to either by its position in +the widget's index space, or the name it is assigned when the image is inserted +into the text widget with \fIpathName \fBimage create\fR. If the range of text +containing the embedded image is deleted then that copy of the image is removed +from the screen. +.PP +Eliding an embedded image immediately after scheduling it for creation via +\fIpathName \fBimage create \fIindex \fB-create\fR will prevent it from being +effectively created. Uneliding an elided embedded image scheduled for creation +via \fIpathName \fBimage create \fIindex \fB-create\fR will automatically +trigger the associated creation script. After destroying an elided embedded +image, the latter won't get automatically recreated. +.PP +When an embedded image is added to a text widget with the \fIpathName \fBimage +create\fR widget command, a name unique to this instance of the image is +returned. This name may then be used to refer to this image instance. The name +is taken to be the value of the \fB\-name\fR option (described below). If the +\fB\-name\fR option is not provided, the \fB\-image\fR name is used instead. +If the \fIimageName\fR is already in use in the text widget, then \fB#\fInn\fR +is added to the end of the \fIimageName\fR, where \fInn\fR is an arbitrary +integer. This insures the \fIimageName\fR is unique. Once this name is +assigned to this instance of the image, it does not change, even though the +\fB\-image\fR or \fB\-name\fR values can be changed with \fIpathName \fBimage +configure\fR. .PP When an embedded image is added to a text widget with the \fIpathName \fBimage -create\fR widget command, a name unique to this instance of the image -is returned. This name may then be used to refer to this image -instance. The name is taken to be the value of the \fB\-name\fR option -(described below). If the \fB\-name\fR option is not provided, the -\fB\-image\fR name is used instead. If the \fIimageName\fR is already -in use in the text widget, then \fB#\fInn\fR is added to the end of the -\fIimageName\fR, where \fInn\fR is an arbitrary integer. This insures -the \fIimageName\fR is unique. -Once this name is assigned to this instance of the image, it does not -change, even though the \fB\-image\fR or \fB\-name\fR values can be changed -with \fIpathName \fBimage configure\fR. -.PP -When an embedded image is added to a text widget with the -\fIpathName \fBimage create\fR widget command, several configuration -options may be associated with it. -These options may be modified later with the \fIpathName \fBimage configure\fR -widget command. -The following options are currently supported: +create\fR widget command, several configuration options may be associated with +it. These options may be modified later with the \fIpathName \fBimage +configure\fR widget command. The following options are currently supported: .TP \fB\-align \fIwhere\fR -If the image is not as tall as the line in which it is displayed, -this option determines where the image is displayed in the line. -\fIWhere\fR must have one of the values \fBtop\fR (align the top of the image -with the top of the line), \fBcenter\fR (center the image -within the range of the line), \fBbottom\fR (align the bottom of the -image with the bottom of the line's area), -or \fBbaseline\fR (align the bottom of the image with the baseline -of the line). +. +If the image is not as tall as the line in which it is displayed, this option +determines where the image is displayed in the line. \fIWhere\fR must have one +of the values \fBtop\fR (align the top of the image with the top of the line), +\fBcenter\fR (center the image within the range of the line), \fBbottom\fR +(align the bottom of the image with the bottom of the line's area), or +\fBbaseline\fR (align the bottom of the image with the baseline of the line). .TP \fB\-image \fIimage\fR -Specifies the name of the Tk image to display in the annotation. -If \fIimage\fR is not a valid Tk image, then an error is returned. +. +Specifies the name of the Tk image to display in the annotation. If +\fIimage\fR is not a valid Tk image, then an error is returned. .TP \fB\-name \fIImageName\fR -Specifies the name by which this image instance may be referenced in -the text widget. If \fIImageName\fR is not supplied, then the -name of the Tk image is used instead. -If the \fIimageName\fR is already in use, \fI#nn\fR is appended to -the end of the name as described above. +. +Specifies the name by which this image instance may be referenced in the text +widget. If \fIImageName\fR is not supplied, then the name of the Tk image is +used instead. If the \fIimageName\fR is already in use, \fI#nn\fR is appended +to the end of the name as described above. .TP \fB\-padx \fIpixels\fR -\fIPixels\fR specifies the amount of extra space to leave on -each side of the embedded image. -It may have any of the usual forms defined for a screen distance. +. +\fIPixels\fR specifies the amount of extra space to leave on each side of the +embedded image. It may have any of the usual forms defined for a screen +distance. .TP \fB\-pady \fIpixels\fR -\fIPixels\fR specifies the amount of extra space to leave on -the top and on the bottom of the embedded image. -It may have any of the usual forms defined for a screen distance. +. +\fIPixels\fR specifies the amount of extra space to leave on the top and on +the bottom of the embedded image. It may have any of the usual forms defined +for a screen distance. .SH "THE SELECTION" .PP -Selection support is implemented via tags. -If the \fBexportSelection\fR option for the text widget is true -then the \fBsel\fR tag will be associated with the selection: +Selection support is implemented via tags. If the \fB\-exportselection\fR option +for the text widget is true then the \fBsel\fR tag will be associated with the +selection: .IP [1] -Whenever characters are tagged with \fBsel\fR the text widget -will claim ownership of the selection. +Whenever characters are tagged with \fBsel\fR the text widget will claim +ownership of the selection. .IP [2] -Attempts to retrieve the -selection will be serviced by the text widget, returning all the -characters with the \fBsel\fR tag. +Attempts to retrieve the selection will be serviced by the text widget, +returning all the characters with the \fBsel\fR tag. .IP [3] -If the selection is claimed away by another application or by another -window within this application, then the \fBsel\fR tag will be removed -from all characters in the text. +If the selection is claimed away by another application or by another window +within this application, then the \fBsel\fR tag will be removed from all +characters in the text. .IP [4] -Whenever the \fBsel\fR tag range changes a virtual event -\fB<<Selection>>\fR is generated. +Whenever the \fBsel\fR tag range changes a virtual event \fB<<Selection>>\fR +is generated. .PP -The \fBsel\fR tag is automatically defined when a text widget is -created, and it may not be deleted with the +The \fBsel\fR tag is automatically defined when a text widget is created, and +it may not be deleted with the .QW "\fIpathName \fBtag delete\fR" -widget command. Furthermore, the \fBselectBackground\fR, -\fBselectBorderWidth\fR, and \fBselectForeground\fR options for -the text widget are tied to the \fB\-background\fR, -\fB\-borderwidth\fR, and \fB\-foreground\fR options for the \fBsel\fR -tag: changes in either will automatically be reflected in the -other. -.VS 8.5 -Also the -\fB\-inactiveselectbackground\fR option for the text widget is used -instead of \fB\-selectbackground\fR when the text widget does not have -the focus. This allows programmatic control over the visualization of -the \fBsel\fR tag for foreground and background windows, or to have -\fBsel\fR not shown at all (when \fB\-inactiveselectbackground\fR is -empty) for background windows. Each peer text widget has its own -\fBsel\fR tag which can be separately configured and set. -.VE 8.5 +widget command. Furthermore, the \fB\-selectbackground\fR, +\fB\-selectborderwidth\fR, and \fB\-selectforeground\fR options for the text +widget are tied to the \fB\-background\fR, \fB\-borderwidth\fR, and +\fB\-foreground\fR options for the \fBsel\fR tag: changes in either will +automatically be reflected in the other. Also the +\fB\-inactiveselectbackground\fR option for the text widget is used instead of +\fB\-selectbackground\fR when the text widget does not have the focus. This +allows programmatic control over the visualization of the \fBsel\fR tag for +foreground and background windows, or to have \fBsel\fR not shown at all (when +\fB\-inactiveselectbackground\fR is empty) for background windows. Each peer +text widget has its own \fBsel\fR tag which can be separately configured and +set. .SH "THE INSERTION CURSOR" .PP -The mark named \fBinsert\fR has special significance in text widgets. -It is defined automatically when a text widget is created and it -may not be unset with the +The mark named \fBinsert\fR has special significance in text widgets. It is +defined automatically when a text widget is created and it may not be unset +with the .QW "\fIpathName \fBmark unset\fR" -widget command. -The \fBinsert\fR mark represents the position of the insertion -cursor, and the insertion cursor will automatically be drawn at -this point whenever the text widget has the input focus. +widget command. The \fBinsert\fR mark represents the position of the insertion +cursor, and the insertion cursor will automatically be drawn at this point +whenever the text widget has the input focus. .SH "THE MODIFIED FLAG" -The text widget can keep track of changes to the content of the widget -by means of the modified flag. Inserting or deleting text will set -this flag. The flag can be queried, set and cleared programmatically -as well. Whenever the flag changes state a \fB<<Modified>>\fR virtual -event is generated. See the \fIpathName \fBedit modified\fR widget command for -more details. +.PP +The text widget can keep track of changes to the content of the widget by +means of the modified flag. Inserting or deleting text will set this flag. The +flag can be queried, set and cleared programmatically as well. Whenever the +flag changes state a \fB<<Modified>>\fR virtual event is generated. See the +\fIpathName \fBedit modified\fR widget command for more details. .SH "THE UNDO MECHANISM" .PP The text widget has an unlimited undo and redo mechanism (when the -\fB\-undo\fR widget option is true) which records every insert and -delete action on a stack. +\fB\-undo\fR widget option is true) which records every insert and delete +action on a stack. .PP Boundaries (called .QW separators ) -are inserted between edit actions. The -purpose of these separators is to group inserts, deletes and replaces -into one compound edit action. When undoing a change everything between -two separators will be undone. The undone changes are then moved to the -redo stack, so that an undone edit can be redone again. The redo stack -is cleared whenever new edit actions are recorded on the undo stack. The -undo and redo stacks can be cleared to keep their depth under control. -.PP -Separators are inserted automatically when the \fB\-autoseparators\fR -widget option is true. You can insert separators programmatically as -well. If a separator is already present at the top of the undo stack -no other will be inserted. That means that two separators on the undo -stack are always separated by at least one insert or delete action. -.PP -The undo mechanism is also linked to the modified flag. This means -that undoing or redoing changes can take a modified text widget back -to the unmodified state or vice versa. The modified flag will be set -automatically to the appropriate state. This automatic coupling -does not work when the modified flag has been set by the user, until -the flag has been reset again. +are inserted between edit actions. The purpose of these separators is to group +inserts, deletes and replaces into one compound edit action. When undoing a +change everything between two separators will be undone. The undone changes +are then moved to the redo stack, so that an undone edit can be redone again. +The redo stack is cleared whenever new edit actions are recorded on the undo +stack. The undo and redo stacks can be cleared to keep their depth under +control. +.PP +Separators are inserted automatically when the \fB\-autoseparators\fR widget +option is true. You can insert separators programmatically as well. If a +separator is already present at the top of the undo stack no other will be +inserted. That means that two separators on the undo stack are always +separated by at least one insert or delete action. +.PP +The undo mechanism is also linked to the modified flag. This means that +undoing or redoing changes can take a modified text widget back to the +unmodified state or vice versa. The modified flag will be set automatically to +the appropriate state. This automatic coupling does not work when the modified +flag has been set by the user, until the flag has been reset again. .PP See below for the \fIpathName \fBedit\fR widget command that controls the undo mechanism. .SH "PEER WIDGETS" .PP -.VS 8.5 -The text widget has a separate store of all its data concerning each -line's textual contents, marks, tags, images and windows, and the undo -stack. +The text widget has a separate store of all its data concerning each line's +textual contents, marks, tags, images and windows, and the undo stack. .PP -While this data store cannot be accessed directly (i.e. without a text -widget as an intermediary), multiple text widgets can be created, each -of which present different views on the same underlying data. Such -text widgets are known as peer text widgets. +While this data store cannot be accessed directly (i.e. without a text widget +as an intermediary), multiple text widgets can be created, each of which +present different views on the same underlying data. Such text widgets are +known as peer text widgets. .PP As text is added, deleted, edited and coloured in any one widget, and as -images, marks, tags are adjusted, all such changes will be reflected in -all peers. -.PP -All data and markup is shared, except for a few small details. First, -the \fBsel\fR tag may be set and configured (in its display style) -differently for each peer. Second, each peer has its own \fBinsert\fR -and \fBcurrent\fR mark positions (but all other marks are shared). -Third, embedded windows, which are arbitrary other widgets, cannot be -shared between peers. This means the \fB\-window\fR option of embedded -windows is independently set for each peer (it is advisable to use -the \fB\-create\fR script capabilities to allow each peer to create its -own embedded windows as needed). Fourth, all of the configuration -options of each peer (e.g. \fB\-font\fR, etc) can be set independently, -with the exception of \fB\-undo\fR, \fB\-maxUndo\fR, \fB\-autoSeparators\fR -(i.e. all undo, redo and modified state issues are shared). -.PP -Finally any single peer need not contain all lines from the underlying -data store. When creating a peer, a contiguous range of lines (e.g. -only lines 52 through 125) may be specified. This allows a peer to -contain just a small portion of the overall text. The range of lines -will expand and contract as text is inserted or deleted. The peer will -only ever display complete lines of text (one cannot share just part of -a line). If the peer's contents contracts to nothing (i.e. all complete -lines in the peer widget have been deleted from another widget), then it -is impossible for new lines to be inserted. The peer will simply become -an empty shell on which the background can be configured, but which will -never show any content (without manual reconfiguration of the start and -end lines). Note that a peer which does not contain all of the +images, marks, tags are adjusted, all such changes will be reflected in all +peers. +.PP +All data and markup is shared, except for a few small details. First, the +\fBsel\fR tag may be set and configured (in its display style) differently for +each peer. Second, each peer has its own \fBinsert\fR and \fBcurrent\fR mark +positions (but all other marks are shared). Third, embedded windows, which are +arbitrary other widgets, cannot be shared between peers. This means the +\fB\-window\fR option of embedded windows is independently set for each peer +(it is advisable to use the \fB\-create\fR script capabilities to allow each +peer to create its own embedded windows as needed). Fourth, all of the +configuration options of each peer (e.g. \fB\-font\fR, etc) can be set +independently, with the exception of \fB\-undo\fR, \fB\-maxundo\fR, +\fB\-autoseparators\fR (i.e. all undo, redo and modified state issues are +shared). +.PP +Finally any single peer need not contain all lines from the underlying data +store. When creating a peer, a contiguous range of lines (e.g. only lines 52 +through 125) may be specified. This allows a peer to contain just a small +portion of the overall text. The range of lines will expand and contract as +text is inserted or deleted. The peer will only ever display complete lines of +text (one cannot share just part of a line). If the peer's contents contracts +to nothing (i.e. all complete lines in the peer widget have been deleted from +another widget), then it is impossible for new lines to be inserted. The peer +will simply become an empty shell on which the background can be configured, +but which will never show any content (without manual reconfiguration of the +start and end lines). Note that a peer which does not contain all of the underlying data store still has indices numbered from .QW 1.0 to .QW end . -It is simply that those indices reflect a subset of the total data, and -data outside the contained range is not accessible to the peer. This -means that the command \fIpeerName \fBindex end\fR may return quite different -values in different peers. Similarly, commands like \fIpeerName \fBtag -ranges\fR will not return index ranges outside that which is meaningful -to the peer. The configuration options \fB\-startline\fR and -\fB\-endline\fR may be used to control how much of the underlying data is -contained in any given text widget. -.PP -Note that peers are really peers. Deleting the +It is simply that those indices reflect a subset of the total data, and data +outside the contained range is not accessible to the peer. This means that the +command \fIpeerName \fBindex end\fR may return quite different values in +different peers. Similarly, commands like \fIpeerName \fBtag ranges\fR will +not return index ranges outside that which is meaningful to the peer. The +configuration options \fB\-startline\fR and \fB\-endline\fR may be used to +control how much of the underlying data is contained in any given text widget. +.PP +Note that peers are really peers. Deleting the .QW original text widget will not cause any other peers to be deleted, or otherwise affected. .PP See below for the \fIpathName \fBpeer\fR widget command that controls the creation of peer widgets. -.VE 8.5 .SH "WIDGET COMMAND" .PP -The \fBtext\fR command creates a new Tcl command whose -name is the same as the path name of the text's window. This -command may be used to invoke various -operations on the widget. It has the following general form: +The \fBtext\fR command creates a new Tcl command whose name is the same as the +path name of the text's window. This command may be used to invoke various +operations on the widget. It has the following general form: .CS \fIpathName option \fR?\fIarg arg ...\fR? .CE -\fIPathName\fR is the name of the command, which is the same as -the text widget's path name. \fIOption\fR and the \fIarg\fRs -determine the exact behavior of the command. The following -commands are possible for text widgets: +\fIPathName\fR is the name of the command, which is the same as the text +widget's path name. \fIOption\fR and the \fIarg\fRs determine the exact +behavior of the command. The following commands are possible for text widgets: .TP \fIpathName \fBbbox \fIindex\fR -Returns a list of four elements describing the screen area -of the character given by \fIindex\fR. -The first two elements of the list give the x and y coordinates -of the upper-left corner of the area occupied by the -character, and the last two elements give the width and height -of the area. -If the character is only partially visible on the screen, then -the return value reflects just the visible part. -If the character is not visible on the screen then the return -value is an empty list. +. +Returns a list of four elements describing the screen area of the character +given by \fIindex\fR. The first two elements of the list give the x and y +coordinates of the upper-left corner of the area occupied by the character, +and the last two elements give the width and height of the area. If the +character is only partially visible on the screen, then the return value +reflects just the visible part. If the character is not visible on the screen +then the return value is an empty list. .TP \fIpathName \fBcget\fR \fIoption\fR -Returns the current value of the configuration option given -by \fIoption\fR. -\fIOption\fR may have any of the values accepted by the \fBtext\fR -command. +. +Returns the current value of the configuration option given by \fIoption\fR. +\fIOption\fR may have any of the values accepted by the \fBtext\fR command. .TP \fIpathName \fBcompare\fR \fIindex1 op index2\fR -Compares the indices given by \fIindex1\fR and \fIindex2\fR according -to the relational operator given by \fIop\fR, and returns 1 if -the relationship is satisfied and 0 if it is not. -\fIOp\fR must be one of the operators <, <=, ==, >=, >, or !=. -If \fIop\fR is == then 1 is returned if the two indices refer to -the same character, if \fIop\fR is < then 1 is returned if \fIindex1\fR -refers to an earlier character in the text than \fIindex2\fR, and -so on. +. +Compares the indices given by \fIindex1\fR and \fIindex2\fR according to the +relational operator given by \fIop\fR, and returns 1 if the relationship is +satisfied and 0 if it is not. \fIOp\fR must be one of the operators <, <=, ==, +>=, >, or !=. If \fIop\fR is == then 1 is returned if the two indices refer to +the same character, if \fIop\fR is < then 1 is returned if \fIindex1\fR refers +to an earlier character in the text than \fIindex2\fR, and so on. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR? -Query or modify the configuration options of the widget. -If no \fIoption\fR is specified, returns a list describing all of -the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for -information on the format of this list). If \fIoption\fR is specified -with no \fIvalue\fR, then the command returns a list describing the -one named option (this list will be identical to the corresponding -sublist of the value returned if no \fIoption\fR is specified). If -one or more \fIoption\-value\fR pairs are specified, then the command -modifies the given widget option(s) to have the given value(s); in -this case the command returns an empty string. -\fIOption\fR may have any of the values accepted by the \fBtext\fR -command. -.VS 8.5 +. +Query or modify the configuration options of the widget. If no \fIoption\fR is +specified, returns a list describing all of the available options for +\fIpathName\fR (see \fBTk_ConfigureInfo\fR for information on the format of +this list). If \fIoption\fR is specified with no \fIvalue\fR, then the command +returns a list describing the one named option (this list will be identical to +the corresponding sublist of the value returned if no \fIoption\fR is +specified). If one or more \fIoption\-value\fR pairs are specified, then the +command modifies the given widget option(s) to have the given value(s); in +this case the command returns an empty string. \fIOption\fR may have any of +the values accepted by the \fBtext\fR command. .TP \fIpathName \fBcount\fR \fI?options\fR? \fIindex1 index2\fR -Counts the number of relevant things between the two indices. -If \fIindex1\fR is after \fIindex2\fR, the result will be a negative number -(and this holds for each of the possible options). -The actual items which are counted depend on the -options given. The result is a list of integers, one for the result of -each counting option given. Valid counting options are \fB\-chars\fR, +. +Counts the number of relevant things between the two indices. If \fIindex1\fR +is after \fIindex2\fR, the result will be a negative number (and this holds +for each of the possible options). The actual items which are counted depend +on the options given. The result is a list of integers, one for the result of +each counting option given. Valid counting options are \fB\-chars\fR, \fB\-displaychars\fR, \fB\-displayindices\fR, \fB\-displaylines\fR, \fB\-indices\fR, \fB\-lines\fR, \fB\-xpixels\fR and \fB\-ypixels\fR. The default value, if no option is specified, is \fB\-indices\fR. There is an additional possible option \fB\-update\fR which is a modifier. If given (and if the text widget is managed by a geometry manager), then all subsequent -options ensure that any possible out of date information is recalculated. -This currently only has any effect for the \fI\-ypixels\fR count (which, if +options ensure that any possible out of date information is recalculated. +This currently only has any effect for the \fB\-ypixels\fR count (which, if \fB\-update\fR is not given, will use the text widget's current cached value -for each line). The count options are interpreted as follows: +for each line). The count options are interpreted as follows: .RS .IP \fB\-chars\fR -count all characters, whether elided or not. Do not count -embedded windows or images. +count all characters, whether elided or not. Do not count embedded windows or +images. .IP \fB\-displaychars\fR count all non-elided characters. .IP \fB\-displayindices\fR count all non-elided characters, windows and images. .IP \fB\-displaylines\fR -count all display lines (i.e. counting one for each -time a line wraps) from the line of the first index up to, but not -including the display line of the second index. Therefore if they are -both on the same display line, zero will be returned. By definition -displaylines are visible and therefore this only counts portions of -actual visible lines. +count all display lines (i.e. counting one for each time a line wraps) from +the line of the first index up to, but not including the display line of the +second index. Therefore if they are both on the same display line, zero will +be returned. By definition displaylines are visible and therefore this only +counts portions of actual visible lines. .IP \fB\-indices\fR -count all characters and embedded windows or images (i.e. -everything which counts in text-widget index space), whether they are -elided or not. +count all characters and embedded windows or images (i.e. everything which +counts in text-widget index space), whether they are elided or not. .IP \fB\-lines\fR -count all logical lines (irrespective of wrapping) from -the line of the first index up to, but not including the line of the -second index. Therefore if they are both on the same line, zero will be -returned. Logical lines are counted whether they are currently visible -(non-elided) or not. +count all logical lines (irrespective of wrapping) from the line of the first +index up to, but not including the line of the second index. Therefore if they +are both on the same line, zero will be returned. Logical lines are counted +whether they are currently visible (non-elided) or not. .IP \fB\-xpixels\fR -count the number of horizontal pixels from the first -pixel of the first index to (but not including) the first pixel of the -second index. To count the total desired width of the text widget -(assuming wrapping is not enabled), first find the longest line and then -use +count the number of horizontal pixels from the first pixel of the first index +to (but not including) the first pixel of the second index. To count the total +desired width of the text widget (assuming wrapping is not enabled), first +find the longest line and then use .QW ".text count \-xpixels \N'34'${line}.0\N'34' \N'34'${line}.0 lineend\N'34'" . .IP \fB\-ypixels\fR -count the number of vertical pixels from the first pixel -of the first index to (but not including) the first pixel of the second -index. If both indices are on the same display line, zero will be -returned. To count the total number of vertical pixels in the text -widget, use +count the number of vertical pixels from the first pixel of the first index to +(but not including) the first pixel of the second index. If both indices are +on the same display line, zero will be returned. To count the total number of +vertical pixels in the text widget, use .QW ".text count \-ypixels 1.0 end" , and to ensure this is up to date, use .QW ".text count \-update \-ypixels 1.0 end" . .PP -The command returns a positive or negative integer corresponding to the -number of items counted between the two indices. One such integer is -returned for each counting option given, so a list is returned if more -than one option was supplied. For example +The command returns a positive or negative integer corresponding to the number +of items counted between the two indices. One such integer is returned for +each counting option given, so a list is returned if more than one option was +supplied. For example .QW ".text count \-xpixels \-ypixels 1.3 4.5" is perfectly valid and will return a list of two elements. .RE -.VE 8.5 .TP \fIpathName \fBdebug \fR?\fIboolean\fR? -If \fIboolean\fR is specified, then it must have one of the true or -false values accepted by Tcl_GetBoolean. -If the value is a true one then internal consistency checks will be -turned on in the B-tree code associated with text widgets. -If \fIboolean\fR has a false value then the debugging checks will -be turned off. -In either case the command returns an empty string. -If \fIboolean\fR is not specified then the command returns \fBon\fR -or \fBoff\fR to indicate whether or not debugging is turned on. -There is a single debugging switch shared by all text widgets: turning -debugging on or off in any widget turns it on or off for all widgets. -For widgets with large amounts of text, the consistency checks may -cause a noticeable slow-down. +. +If \fIboolean\fR is specified, then it must have one of the true or false +values accepted by Tcl_GetBoolean. If the value is a true one then internal +consistency checks will be turned on in the B-tree code associated with text +widgets. If \fIboolean\fR has a false value then the debugging checks will be +turned off. In either case the command returns an empty string. If +\fIboolean\fR is not specified then the command returns \fBon\fR or \fBoff\fR +to indicate whether or not debugging is turned on. There is a single debugging +switch shared by all text widgets: turning debugging on or off in any widget +turns it on or off for all widgets. For widgets with large amounts of text, +the consistency checks may cause a noticeable slow-down. .RS .PP -When debugging is turned on, the drawing routines of the text widget -set the global variables \fBtk_textRedraw\fR and \fBtk_textRelayout\fR -to the lists of indices that are redrawn. The values of these variables -are tested by Tk's test suite. +When debugging is turned on, the drawing routines of the text widget set the +global variables \fBtk_textRedraw\fR and \fBtk_textRelayout\fR to the lists of +indices that are redrawn. The values of these variables are tested by Tk's +test suite. .RE .TP \fIpathName \fBdelete \fIindex1 \fR?\fIindex2 ...\fR? -Delete a range of characters from the text. -If both \fIindex1\fR and \fIindex2\fR are specified, then delete -all the characters starting with the one given by \fIindex1\fR -and stopping just before \fIindex2\fR (i.e. the character at -\fIindex2\fR is not deleted). -If \fIindex2\fR does not specify a position later in the text -than \fIindex1\fR then no characters are deleted. -If \fIindex2\fR is not specified then the single character at -\fIindex1\fR is deleted. -It is not allowable to delete characters in a way that would leave -the text without a newline as the last character. -The command returns an empty string. -If more indices are given, multiple ranges of text will be deleted. -All indices are first checked for validity before any deletions are made. -They are sorted and the text is removed from the last range to the -first range so deleted text does not cause an undesired index shifting -side-effects. If multiple ranges with the same start index are given, -then the longest range is used. If overlapping ranges are given, then -they will be merged into spans that do not cause deletion of text -outside the given ranges due to text shifted during deletion. +. +Delete a range of characters from the text. If both \fIindex1\fR and +\fIindex2\fR are specified, then delete all the characters starting with the +one given by \fIindex1\fR and stopping just before \fIindex2\fR (i.e. the +character at \fIindex2\fR is not deleted). If \fIindex2\fR does not specify a +position later in the text than \fIindex1\fR then no characters are deleted. +If \fIindex2\fR is not specified then the single character at \fIindex1\fR is +deleted. It is not allowable to delete characters in a way that would leave +the text without a newline as the last character. The command returns an empty +string. If more indices are given, multiple ranges of text will be deleted. +All indices are first checked for validity before any deletions are made. They +are sorted and the text is removed from the last range to the first range so +deleted text does not cause an undesired index shifting side-effects. If +multiple ranges with the same start index are given, then the longest range is +used. If overlapping ranges are given, then they will be merged into spans +that do not cause deletion of text outside the given ranges due to text +shifted during deletion. .TP \fIpathName \fBdlineinfo \fIindex\fR -Returns a list with five elements describing the area occupied -by the display line containing \fIindex\fR. -The first two elements of the list give the x and y coordinates -of the upper-left corner of the area occupied by the -line, the third and fourth elements give the width and height -of the area, and the fifth element gives the position of the baseline -for the line, measured down from the top of the area. -All of this information is measured in pixels. -If the current wrap mode is \fBnone\fR and the line extends beyond -the boundaries of the window, -the area returned reflects the entire area of the line, including the -portions that are out of the window. -If the line is shorter than the full width of the window then the -area returned reflects just the portion of the line that is occupied -by characters and embedded windows. -If the display line containing \fIindex\fR is not visible on -the screen then the return value is an empty list. +. +Returns a list with five elements describing the area occupied by the display +line containing \fIindex\fR. The first two elements of the list give the x and +y coordinates of the upper-left corner of the area occupied by the line, the +third and fourth elements give the width and height of the area, and the fifth +element gives the position of the baseline for the line, measured down from +the top of the area. All of this information is measured in pixels. If the +current wrap mode is \fBnone\fR and the line extends beyond the boundaries of +the window, the area returned reflects the entire area of the line, including +the portions that are out of the window. If the line is shorter than the full +width of the window then the area returned reflects just the portion of the +line that is occupied by characters and embedded windows. If the display line +containing \fIindex\fR is not visible on the screen then the return value is +an empty list. .TP \fIpathName \fBdump \fR?\fIswitches\fR? \fIindex1 \fR?\fIindex2\fR? -Return the contents of the text widget from \fIindex1\fR up to, -but not including \fIindex2\fR, -including the text and -information about marks, tags, and embedded windows. -If \fIindex2\fR is not specified, then it defaults to -one character past \fIindex1\fR. The information is returned -in the following format: +. +Return the contents of the text widget from \fIindex1\fR up to, but not +including \fIindex2\fR, including the text and information about marks, tags, +and embedded windows. If \fIindex2\fR is not specified, then it defaults to +one character past \fIindex1\fR. The information is returned in the following +format: .RS .LP \fIkey1 value1 index1 key2 value2 index2\fR ... .LP -The possible \fIkey\fR values are \fBtext\fR, \fBmark\fR, -\fBtagon\fR, \fBtagoff\fR, \fBimage\fR, and \fBwindow\fR. The corresponding -\fIvalue\fR is the text, mark name, tag name, image name, or window name. -The \fIindex\fR information is the index of the -start of the text, mark, tag transition, image or window. -One or more of the following switches (or abbreviations thereof) +The possible \fIkey\fR values are \fBtext\fR, \fBmark\fR, \fBtagon\fR, +\fBtagoff\fR, \fBimage\fR, and \fBwindow\fR. The corresponding \fIvalue\fR is +the text, mark name, tag name, image name, or window name. The \fIindex\fR +information is the index of the start of the text, mark, tag transition, image +or window. One or more of the following switches (or abbreviations thereof) may be specified to control the dump: .TP \fB\-all\fR +. Return information about all elements: text, marks, tags, images and windows. This is the default. .TP \fB\-command \fIcommand\fR +. Instead of returning the information as the result of the dump operation, invoke the \fIcommand\fR on each element of the text widget within the range. -The command has three arguments appended to it before it is evaluated: -the \fIkey\fR, \fIvalue\fR, and \fIindex\fR. +The command has three arguments appended to it before it is evaluated: the +\fIkey\fR, \fIvalue\fR, and \fIindex\fR. .TP \fB\-image\fR +. Include information about images in the dump results. .TP \fB\-mark\fR +. Include information about marks in the dump results. .TP \fB\-tag\fR -Include information about tag transitions in the dump results. Tag -information is returned as \fBtagon\fR and \fBtagoff\fR elements that -indicate the begin and end of each range of each tag, respectively. +. +Include information about tag transitions in the dump results. Tag information +is returned as \fBtagon\fR and \fBtagoff\fR elements that indicate the begin +and end of each range of each tag, respectively. .TP \fB\-text\fR -Include information about text in the dump results. The value is the -text up to the next element or the end of range indicated by \fIindex2\fR. -A text element does not span newlines. A multi-line block of text that -contains no marks or tag transitions will still be dumped as a set -of text segments that each end with a newline. The newline is part -of the value. +. +Include information about text in the dump results. The value is the text up +to the next element or the end of range indicated by \fIindex2\fR. A text +element does not span newlines. A multi-line block of text that contains no +marks or tag transitions will still be dumped as a set of text segments that +each end with a newline. The newline is part of the value. .TP \fB\-window\fR -Include information about embedded windows in the dump results. -The value of a window is its Tk pathname, unless the window -has not been created yet. (It must have a create script.) -In this case an empty string is returned, and you must query the -window by its index position to get more information. +. +Include information about embedded windows in the dump results. The value of a +window is its Tk pathname, unless the window has not been created yet. (It +must have a create script.) In this case an empty string is returned, and you +must query the window by its index position to get more information. .RE .TP \fIpathName \fBedit \fIoption \fR?\fIarg arg ...\fR? -This command controls the undo mechanism and the modified flag. The -exact behavior of the command depends on the \fIoption\fR argument -that follows the \fBedit\fR argument. The following forms of the -command are currently supported: +. +This command controls the undo mechanism and the modified flag. The exact +behavior of the command depends on the \fIoption\fR argument that follows the +\fBedit\fR argument. The following forms of the command are currently +supported: .RS .TP -\fIpathName \fBedit modified ?\fIboolean\fR? -If \fIboolean\fR is not specified, returns the modified flag of the -widget. The insert, delete, edit undo and edit redo commands or the -user can set or clear the modified flag. If \fIboolean\fR is -specified, sets the modified flag of the widget to \fIboolean\fR. +\fIpathName \fBedit modified \fR?\fIboolean\fR? +. +If \fIboolean\fR is not specified, returns the modified flag of the widget. +The insert, delete, edit undo and edit redo commands or the user can set or +clear the modified flag. If \fIboolean\fR is specified, sets the modified flag +of the widget to \fIboolean\fR. .TP \fIpathName \fBedit redo\fR -When the \fB\-undo\fR option is true, reapplies the last undone edits -provided no other edits were done since then. Generates an error when -the redo stack is empty. Does nothing when the \fB\-undo\fR option is -false. +. +When the \fB\-undo\fR option is true, reapplies the last undone edits provided +no other edits were done since then. Generates an error when the redo stack is +empty. Does nothing when the \fB\-undo\fR option is false. .TP \fIpathName \fBedit reset\fR +. Clears the undo and redo stacks. .TP \fIpathName \fBedit separator\fR -Inserts a separator (boundary) on the undo stack. Does nothing when -the \fB\-undo\fR option is false. +. +Inserts a separator (boundary) on the undo stack. Does nothing when the +\fB\-undo\fR option is false. .TP \fIpathName \fBedit undo\fR -Undoes the last edit action when the \fB\-undo\fR option is true. An -edit action is defined as all the insert and delete commands that are -recorded on the undo stack in between two separators. Generates an -error when the undo stack is empty. Does nothing when the \fB\-undo\fR -option is false. +. +Undoes the last edit action when the \fB\-undo\fR option is true. An edit +action is defined as all the insert and delete commands that are recorded on +the undo stack in between two separators. Generates an error when the undo +stack is empty. Does nothing when the \fB\-undo\fR option is false. .RE .TP -\fIpathName \fBget\fR \fI?\-displaychars?\fR \fI\-\- index1\fR ?\fIindex2 ...\fR? -Return a range of characters from the text. -The return value will be all the characters in the text starting -with the one whose index is \fIindex1\fR and ending just before -the one whose index is \fIindex2\fR (the character at \fIindex2\fR -will not be returned). -If \fIindex2\fR is omitted then the single character at \fIindex1\fR -is returned. -If there are no characters in the specified range (e.g. \fIindex1\fR -is past the end of the file or \fIindex2\fR is less than or equal -to \fIindex1\fR) then an empty string is returned. -If the specified range contains embedded windows, no information -about them is included in the returned string. -If multiple index pairs are given, multiple ranges of text will be returned -in a list. Invalid ranges will not be represented with empty strings in -the list. The ranges are returned in the order passed to \fIpathName \fBget\fR. -.VS 8.5 -If the \fB\-displaychars\fR option is given, then, within each range, -only those characters which are not elided will be returned. This may -have the effect that some of the returned ranges are empty strings. -.VE 8.5 +\fIpathName \fBget\fR ?\fB\-displaychars\fR? ?\fB\-\-\fR? \fIindex1\fR ?\fIindex2 ...\fR? +. +Return a range of characters from the text. The return value will be all the +characters in the text starting with the one whose index is \fIindex1\fR and +ending just before the one whose index is \fIindex2\fR (the character at +\fIindex2\fR will not be returned). If \fIindex2\fR is omitted then the single +character at \fIindex1\fR is returned. If there are no characters in the +specified range (e.g. \fIindex1\fR is past the end of the file or \fIindex2\fR +is less than or equal to \fIindex1\fR) then an empty string is returned. If +the specified range contains embedded windows, no information about them is +included in the returned string. If multiple index pairs are given, multiple +ranges of text will be returned in a list. Invalid ranges will not be +represented with empty strings in the list. The ranges are returned in the +order passed to \fIpathName \fBget\fR. If the \fB\-displaychars\fR option is +given, then, within each range, only those characters which are not elided +will be returned. This may have the effect that some of the returned ranges +are empty strings. .TP \fIpathName \fBimage \fIoption \fR?\fIarg arg ...\fR? -This command is used to manipulate embedded images. -The behavior of the command depends on the \fIoption\fR argument -that follows the \fBtag\fR argument. -The following forms of the command are currently supported: +. +This command is used to manipulate embedded images. The behavior of the +command depends on the \fIoption\fR argument that follows the \fBtag\fR +argument. The following forms of the command are currently supported: .RS .TP -\fIpathName \fBimage cget\fR \fIindex option\fR -Returns the value of a configuration option for an embedded image. -\fIIndex\fR identifies the embedded image, and \fIoption\fR -specifies a particular configuration option, which must be one of -the ones listed in the section \fBEMBEDDED IMAGES\fR. +\fIpathName \fBimage cget \fIindex option\fR +. +Returns the value of a configuration option for an embedded image. \fIIndex\fR +identifies the embedded image, and \fIoption\fR specifies a particular +configuration option, which must be one of the ones listed in the section +\fBEMBEDDED IMAGES\fR. .TP \fIpathName \fBimage configure \fIindex\fR ?\fIoption value ...\fR? -Query or modify the configuration options for an embedded image. -If no \fIoption\fR is specified, returns a list describing all of -the available options for the embedded image at \fIindex\fR -(see \fBTk_ConfigureInfo\fR for information on the format of this list). -If \fIoption\fR is specified with no \fIvalue\fR, then the command -returns a list describing the one named option (this list will be -identical to the corresponding sublist of the value returned if no -\fIoption\fR is specified). -If one or more \fIoption\-value\fR pairs are specified, then the command -modifies the given option(s) to have the given value(s); in -this case the command returns an empty string. -See \fBEMBEDDED IMAGES\fR for information on the options that -are supported. +. +Query or modify the configuration options for an embedded image. If no +\fIoption\fR is specified, returns a list describing all of the available +options for the embedded image at \fIindex\fR (see \fBTk_ConfigureInfo\fR for +information on the format of this list). If \fIoption\fR is specified with no +\fIvalue\fR, then the command returns a list describing the one named option +(this list will be identical to the corresponding sublist of the value +returned if no \fIoption\fR is specified). If one or more \fIoption\-value\fR +pairs are specified, then the command modifies the given option(s) to have the +given value(s); in this case the command returns an empty string. See +\fBEMBEDDED IMAGES\fR for information on the options that are supported. .TP \fIpathName \fBimage create \fIindex\fR ?\fIoption value ...\fR? -This command creates a new image annotation, which will appear -in the text at the position given by \fIindex\fR. -Any number of \fIoption\-value\fR pairs may be specified to -configure the annotation. -Returns a unique identifier that may be used as an index to refer to -this image. -See \fBEMBEDDED IMAGES\fR for information on the options that -are supported, and a description of the identifier returned. +. +This command creates a new image annotation, which will appear in the text at +the position given by \fIindex\fR. Any number of \fIoption\-value\fR pairs may +be specified to configure the annotation. Returns a unique identifier that may +be used as an index to refer to this image. See \fBEMBEDDED IMAGES\fR for +information on the options that are supported, and a description of the +identifier returned. .TP \fIpathName \fBimage names\fR +. Returns a list whose elements are the names of all image instances currently embedded in \fIwindow\fR. .RE .TP \fIpathName \fBindex \fIindex\fR -Returns the position corresponding to \fIindex\fR in the form -\fIline.char\fR where \fIline\fR is the line number and \fIchar\fR -is the character number. +. +Returns the position corresponding to \fIindex\fR in the form \fIline.char\fR +where \fIline\fR is the line number and \fIchar\fR is the character number. \fIIndex\fR may have any of the forms described under \fBINDICES\fR above. .TP \fIpathName \fBinsert \fIindex chars \fR?\fItagList chars tagList ...\fR? +. Inserts all of the \fIchars\fR arguments just before the character at -\fIindex\fR. -If \fIindex\fR refers to the end of the text (the character after -the last newline) then the new text is inserted just before the -last newline instead. -If there is a single \fIchars\fR argument and no \fItagList\fR, then -the new text will receive any tags that are present on both the -character before and the character after the insertion point; if a tag -is present on only one of these characters then it will not be -applied to the new text. -If \fItagList\fR is specified then it consists of a list of -tag names; the new characters will receive all of the tags in -this list and no others, regardless of the tags present around -the insertion point. -If multiple \fIchars\fR\-\fItagList\fR argument pairs are present, -they produce the same effect as if a separate \fIpathName \fBinsert\fR widget -command had been issued for each pair, in order. -The last \fItagList\fR argument may be omitted. +\fIindex\fR. If \fIindex\fR refers to the end of the text (the character after +the last newline) then the new text is inserted just before the last newline +instead. If there is a single \fIchars\fR argument and no \fItagList\fR, then +the new text will receive any tags that are present on both the character +before and the character after the insertion point; if a tag is present on +only one of these characters then it will not be applied to the new text. If +\fItagList\fR is specified then it consists of a list of tag names; the new +characters will receive all of the tags in this list and no others, regardless +of the tags present around the insertion point. If multiple +\fIchars\fR\-\fItagList\fR argument pairs are present, they produce the same +effect as if a separate \fIpathName \fBinsert\fR widget command had been +issued for each pair, in order. The last \fItagList\fR argument may be +omitted. .TP \fIpathName \fBmark \fIoption \fR?\fIarg arg ...\fR? -This command is used to manipulate marks. The exact behavior of -the command depends on the \fIoption\fR argument that follows -the \fBmark\fR argument. The following forms of the command -are currently supported: +. +This command is used to manipulate marks. The exact behavior of the command +depends on the \fIoption\fR argument that follows the \fBmark\fR argument. The +following forms of the command are currently supported: .RS .TP \fIpathName \fBmark gravity \fImarkName\fR ?\fIdirection\fR? -If \fIdirection\fR is not specified, returns \fBleft\fR or \fBright\fR -to indicate which of its adjacent characters \fImarkName\fR is attached -to. -If \fIdirection\fR is specified, it must be \fBleft\fR or \fBright\fR; -the gravity of \fImarkName\fR is set to the given value. +. +If \fIdirection\fR is not specified, returns \fBleft\fR or \fBright\fR to +indicate which of its adjacent characters \fImarkName\fR is attached to. If +\fIdirection\fR is specified, it must be \fBleft\fR or \fBright\fR; the +gravity of \fImarkName\fR is set to the given value. .TP \fIpathName \fBmark names\fR -Returns a list whose elements are the names of all the marks that -are currently set. +. +Returns a list whose elements are the names of all the marks that are +currently set. .TP \fIpathName \fBmark next \fIindex\fR -Returns the name of the next mark at or after \fIindex\fR. -If \fIindex\fR is specified in numerical form, then the search for -the next mark begins at that index. -If \fIindex\fR is the name of a mark, then the search for -the next mark begins immediately after that mark. -This can still return a mark at the same position if -there are multiple marks at the same index. -These semantics mean that the \fBmark next\fR operation can be used to -step through all the marks in a text widget in the same order -as the mark information returned by the \fIpathName \fBdump\fR operation. -If a mark has been set to the special \fBend\fR index, -then it appears to be \fIafter\fR \fBend\fR with respect to the \fIpathName \fBmark next\fR operation. -An empty string is returned if there are no marks after \fIindex\fR. +. +Returns the name of the next mark at or after \fIindex\fR. If \fIindex\fR is +specified in numerical form, then the search for the next mark begins at that +index. If \fIindex\fR is the name of a mark, then the search for the next mark +begins immediately after that mark. This can still return a mark at the same +position if there are multiple marks at the same index. These semantics mean +that the \fBmark next\fR operation can be used to step through all the marks +in a text widget in the same order as the mark information returned by the +\fIpathName \fBdump\fR operation. If a mark has been set to the special +\fBend\fR index, then it appears to be \fIafter\fR \fBend\fR with respect to +the \fIpathName \fBmark next\fR operation. An empty string is returned if +there are no marks after \fIindex\fR. .TP \fIpathName \fBmark previous \fIindex\fR -Returns the name of the mark at or before \fIindex\fR. -If \fIindex\fR is specified in numerical form, then the search for -the previous mark begins with the character just before that index. -If \fIindex\fR is the name of a mark, then the search for -the next mark begins immediately before that mark. -This can still return a mark at the same position if -there are multiple marks at the same index. -These semantics mean that the \fIpathName \fBmark previous\fR operation can be used to -step through all the marks in a text widget in the reverse order -as the mark information returned by the \fIpathName \fBdump\fR operation. -An empty string is returned if there are no marks before \fIindex\fR. +. +Returns the name of the mark at or before \fIindex\fR. If \fIindex\fR is +specified in numerical form, then the search for the previous mark begins with +the character just before that index. If \fIindex\fR is the name of a mark, +then the search for the next mark begins immediately before that mark. This +can still return a mark at the same position if there are multiple marks at +the same index. These semantics mean that the \fIpathName \fBmark previous\fR +operation can be used to step through all the marks in a text widget in the +reverse order as the mark information returned by the \fIpathName \fBdump\fR +operation. An empty string is returned if there are no marks before +\fIindex\fR. .TP \fIpathName \fBmark set \fImarkName index\fR -Sets the mark named \fImarkName\fR to a position just before the -character at \fIindex\fR. -If \fImarkName\fR already exists, it is moved from its old position; -if it does not exist, a new mark is created. -This command returns an empty string. +. +Sets the mark named \fImarkName\fR to a position just before the character at +\fIindex\fR. If \fImarkName\fR already exists, it is moved from its old +position; if it does not exist, a new mark is created. This command returns an +empty string. .TP \fIpathName \fBmark unset \fImarkName \fR?\fImarkName markName ...\fR? -Remove the mark corresponding to each of the \fImarkName\fR arguments. -The removed marks will not be usable in indices and will not be -returned by future calls to +. +Remove the mark corresponding to each of the \fImarkName\fR arguments. The +removed marks will not be usable in indices and will not be returned by future +calls to .QW "\fIpathName \fBmark names\fR" . This command returns an empty string. .RE .TP -\fIpathName \fBpeer\fR \fIoption args\fR -.VS 8.5 -This command is used to create and query widget peers. It has -two forms, depending on \fIoption\fR: +\fIpathName \fBpeer \fIoption args\fR +. +This command is used to create and query widget peers. It has two forms, +depending on \fIoption\fR: .RS .TP \fIpathName \fBpeer create \fInewPathName\fR ?\fIoptions\fR? -Creates a peer text widget with the given \fInewPathName\fR, and any -optional standard configuration options (as for the \fItext\fR command). -By default the peer will have the same start and end line as the -parent widget, but these can be overridden with the standard -configuration options. +. +Creates a peer text widget with the given \fInewPathName\fR, and any optional +standard configuration options (as for the \fItext\fR command). By default the +peer will have the same start and end line as the parent widget, but these can +be overridden with the standard configuration options. .TP \fIpathName \fBpeer names\fR +. Returns a list of peers of this widget (this does not include the widget -itself). The order within this list is undefined. +itself). The order within this list is undefined. .RE .TP -\fIpathName \fBreplace\fR \fIindex1 index2 chars\fR ?\fItagList chars tagList ...\fR? -Replaces the range of characters between \fIindex1\fR and \fIindex2\fR -with the given characters and tags. See the section on \fIpathName -\fBinsert\fR for an explanation of the handling of the \fItagList...\fR -arguments, and the section on \fIpathName -\fBdelete\fR for an explanation of the handling of the indices. If -\fIindex2\fR corresponds to an index earlier in the text than +\fIpathName \fBreplace \fIindex1 index2 chars\fR ?\fItagList chars tagList ...\fR? +. +Replaces the range of characters between \fIindex1\fR and \fIindex2\fR with +the given characters and tags. See the section on \fIpathName \fBinsert\fR for +an explanation of the handling of the \fItagList...\fR arguments, and the +section on \fIpathName \fBdelete\fR for an explanation of the handling of the +indices. If \fIindex2\fR corresponds to an index earlier in the text than \fIindex1\fR, an error will be generated. .RS .PP -The deletion and insertion are arranged so that no unnecessary -scrolling of the window or movement of insertion cursor occurs. In -addition the undo/redo stack are correctly modified, if undo operations -are active in the text widget. The command returns an empty string. +The deletion and insertion are arranged so that no unnecessary scrolling of +the window or movement of insertion cursor occurs. In addition the undo/redo +stack are correctly modified, if undo operations are active in the text +widget. The command returns an empty string. .RE -.VE 8.5 .TP -\fIpathName \fBscan\fR \fIoption args\fR -This command is used to implement scanning on texts. It has -two forms, depending on \fIoption\fR: +\fIpathName \fBscan \fIoption args\fR +. +This command is used to implement scanning on texts. It has two forms, +depending on \fIoption\fR: .RS .TP \fIpathName \fBscan mark \fIx y\fR -Records \fIx\fR and \fIy\fR and the current view in the text window, -for use in conjunction with later \fIpathName \fBscan dragto\fR commands. -Typically this command is associated with a mouse button press in -the widget. It returns an empty string. +. +Records \fIx\fR and \fIy\fR and the current view in the text window, for use +in conjunction with later \fIpathName \fBscan dragto\fR commands. Typically +this command is associated with a mouse button press in the widget. It returns +an empty string. .TP \fIpathName \fBscan dragto \fIx y\fR -This command computes the difference between its \fIx\fR and \fIy\fR -arguments and the \fIx\fR and \fIy\fR arguments to the last -\fIpathName \fBscan mark\fR command for the widget. -It then adjusts the view by 10 times the difference in coordinates. -This command is typically associated -with mouse motion events in the widget, to produce the effect of -dragging the text at high speed through the window. The return -value is an empty string. +. +This command computes the difference between its \fIx\fR and \fIy\fR arguments +and the \fIx\fR and \fIy\fR arguments to the last \fIpathName \fBscan mark\fR +command for the widget. It then adjusts the view by 10 times the difference in +coordinates. This command is typically associated with mouse motion events in +the widget, to produce the effect of dragging the text at high speed through +the window. The return value is an empty string. .RE .TP \fIpathName \fBsearch \fR?\fIswitches\fR? \fIpattern index \fR?\fIstopIndex\fR? -Searches the text in \fIpathName\fR starting at \fIindex\fR for a range -of characters that matches \fIpattern\fR. -If a match is found, the index of the first character in the match is -returned as result; otherwise an empty string is returned. -One or more of the following switches (or abbreviations thereof) +. +Searches the text in \fIpathName\fR starting at \fIindex\fR for a range of +characters that matches \fIpattern\fR. If a match is found, the index of the +first character in the match is returned as result; otherwise an empty string +is returned. One or more of the following switches (or abbreviations thereof) may be specified to control the search: .RS .TP \fB\-forwards\fR -The search will proceed forward through the text, finding the first -matching range starting at or after the position given by \fIindex\fR. -This is the default. +. +The search will proceed forward through the text, finding the first matching +range starting at or after the position given by \fIindex\fR. This is the +default. .TP \fB\-backwards\fR -The search will proceed backward through the text, finding the -matching range closest to \fIindex\fR whose first character -is before \fIindex\fR -.VS 8.5 -(it is not allowed to be at \fIindex\fR). Note that, for a variety of -reasons, backwards searches can be substantially slower than forwards -searches (particularly when using \fB\-regexp\fR), so it is recommended -that performance-critical code use forward searches. -.VE 8.5 +. +The search will proceed backward through the text, finding the matching range +closest to \fIindex\fR whose first character is before \fIindex\fR (it is not +allowed to be at \fIindex\fR). Note that, for a variety of reasons, backwards +searches can be substantially slower than forwards searches (particularly when +using \fB\-regexp\fR), so it is recommended that performance-critical code use +forward searches. .TP \fB\-exact\fR -Use exact matching: the characters in the matching range must be -identical to those in \fIpattern\fR. -This is the default. +. +Use exact matching: the characters in the matching range must be identical to +those in \fIpattern\fR. This is the default. .TP \fB\-regexp\fR -Treat \fIpattern\fR as a regular expression and match it against -the text using the rules for regular expressions (see the \fBregexp\fR -command for details). -.VS 8.5 -The default matching automatically passes -both the \fB\-lineanchor\fR and \fB\-linestop\fR options -to the regexp engine (unless \fB\-nolinestop\fR is used), so that -\fI^$\fR match beginning and end of line, and \fI.\fR, \fI[^\fR -sequences will never match the newline character \fI\en\fR. -.VE 8.5 +. +Treat \fIpattern\fR as a regular expression and match it against the text +using the rules for regular expressions (see the \fBregexp\fR command +and the \fBre_syntax\fR page for +details). The default matching automatically passes both the +\fB\-lineanchor\fR and \fB\-linestop\fR options to the regexp engine (unless +\fB\-nolinestop\fR is used), so that \fI^$\fR match beginning and end of line, +and \fI.\fR, \fI[^\fR sequences will never match the newline character +\fI\en\fR. .TP \fB\-nolinestop\fR -.VS 8.5 -This allows \fI.\fR and \fI[^\fR sequences to match the newline -character \fI\en\fR, which they will otherwise not do (see the \fBregexp\fR -command for details). This option is only meaningful if \fB\-regexp\fR -is also given, and an error will be thrown otherwise. For example, -to match the entire text, use +. +This allows \fI.\fR and \fI[^\fR sequences to match the newline character +\fI\en\fR, which they will otherwise not do (see the \fBregexp\fR command for +details). This option is only meaningful if \fB\-regexp\fR is also given, and +an error will be thrown otherwise. For example, to match the entire text, use .QW "\fIpathName \fBsearch \-nolinestop \-regexp\fR \N'34'.*\N'34' 1.0" . -.VE 8.5 .TP \fB\-nocase\fR +. Ignore case differences between the pattern and the text. .TP \fB\-count\fI varName\fR -The argument following \fB\-count\fR gives the name of a variable; -if a match is found, the number of index positions between beginning and -end of the matching range will be stored in the variable. If there are no -embedded images or windows in the matching range (and there are no -elided characters if \fB\-elide\fR is not given), this is equivalent to the -number of characters matched. In either case, the range \fImatchIdx\fR to -\fImatchIdx + $count chars\fR will return the entire matched text. +. +The argument following \fB\-count\fR gives the name of a variable; if a match +is found, the number of index positions between beginning and end of the +matching range will be stored in the variable. If there are no embedded images +or windows in the matching range (and there are no elided characters if +\fB\-elide\fR is not given), this is equivalent to the number of characters +matched. In either case, the range \fImatchIdx\fR to \fImatchIdx + $count +chars\fR will return the entire matched text. .TP \fB\-all\fR -.VS 8.5 -Find all matches in the given range and return a list of the indices of -the first character of each match. If a \fB\-count\fI varName\fR switch is -given, then \fIvarName\fR is also set to a list containing one element -for each successful match. Note that, even for exact searches, the -elements of this list may be different, if there are embedded images, -windows or hidden text. Searches with \fB\-all\fR behave very -similarly to the Tcl command \fBregexp \-all\fR, in that overlapping -matches are not normally returned. For example, applying an -\fB\-all\fR search of the pattern +. +Find all matches in the given range and return a list of the indices of the +first character of each match. If a \fB\-count\fI varName\fR switch is given, +then \fIvarName\fR is also set to a list containing one element for each +successful match. Note that, even for exact searches, the elements of this +list may be different, if there are embedded images, windows or hidden text. +Searches with \fB\-all\fR behave very similarly to the Tcl command \fBregexp +\-all\fR, in that overlapping matches are not normally returned. For example, +applying an \fB\-all\fR search of the pattern .QW \ew+ against .QW "hello there" @@ -1630,620 +1463,555 @@ will just match twice, once for each word, and matching against .QW ZooZooZoo will just match once. -.VE 8.5 .TP \fB\-overlap\fR -.VS 8.5 -When performing \fB\-all\fR searches, the normal behaviour is that -matches which overlap an already-found match will not be returned. This -switch changes that behaviour so that all matches which are not totally -enclosed within another match are returned. For example, applying an -\fB\-overlap\fR search of the pattern +. +When performing \fB\-all\fR searches, the normal behaviour is that matches +which overlap an already-found match will not be returned. This switch changes +that behaviour so that all matches which are not totally enclosed within +another match are returned. For example, applying an \fB\-overlap\fR search of +the pattern .QW \ew+ against .QW "hello there" -will just match twice (i.e. no different to just \fB\-all\fR), -but matching +will just match twice (i.e. no different to just \fB\-all\fR), but matching .QW Z[a\-z]+Z against .QW ZooZooZoo -will now match twice. -An error will be thrown if this switch is used without \fB\-all\fR. -.VE 8.5 +will now match twice. An error will be thrown if this switch is used without +\fB\-all\fR. .TP \fB\-strictlimits\fR -.VS 8.5 -When performing any search, the normal behaviour is that -the start and stop limits are checked with respect to the -start of the matching text. With the \fB\-strictlimits\fR flag, -the entire matching range must lie inside the start and stop -limits specified for the match to be valid. -.VE 8.5 +. +When performing any search, the normal behaviour is that the start and stop +limits are checked with respect to the start of the matching text. With the +\fB\-strictlimits\fR flag, the entire matching range must lie inside the start +and stop limits specified for the match to be valid. .TP \fB\-elide\fR -Find elided (hidden) text as well. By default only displayed text is -searched. +. +Find elided (hidden) text as well. By default only displayed text is searched. .TP \fB\-\|\-\fR -This switch has no effect except to terminate the list of switches: -the next argument will be treated as \fIpattern\fR even if it starts -with \fB\-\fR. -.PP -.VS 8.5 -The matching range may be within a single line of text, or run across -multiple lines (if parts of the pattern can match a new-line). For -regular expression matching one can use the various newline-matching -features such as \fB$\fR to match the end of a line, \fB^\fR to match -the beginning of a line, and to control -whether \fB.\fR is allowed to match a new-line. -.VE 8.5 -If \fIstopIndex\fR is specified, the search stops at that index: -for forward searches, no match at or after \fIstopIndex\fR will -be considered; for backward searches, no match earlier in the -text than \fIstopIndex\fR will be considered. -If \fIstopIndex\fR is omitted, the entire text will be searched: -when the beginning or end of the text is reached, the search -continues at the other end until the starting location is reached -again; if \fIstopIndex\fR is specified, no wrap-around will occur. -This means that, for example, if the search is \fB\-forwards\fR -but \fIstopIndex\fR is earlier in the text than \fIstartIndex\fR, -nothing will ever be found. See \fBKNOWN BUGS\fR below for a number of -minor limitations of the \fIpathName \fBsearch\fR command. +. +This switch has no effect except to terminate the list of switches: the next +argument will be treated as \fIpattern\fR even if it starts with \fB\-\fR. +.PP +The matching range may be within a single line of text, or run across multiple +lines (if parts of the pattern can match a new-line). For regular expression +matching one can use the various newline-matching features such as \fB$\fR to +match the end of a line, \fB^\fR to match the beginning of a line, and to +control whether \fB.\fR is allowed to match a new-line. If \fIstopIndex\fR is +specified, the search stops at that index: for forward searches, no match at +or after \fIstopIndex\fR will be considered; for backward searches, no match +earlier in the text than \fIstopIndex\fR will be considered. If +\fIstopIndex\fR is omitted, the entire text will be searched: when the +beginning or end of the text is reached, the search continues at the other end +until the starting location is reached again; if \fIstopIndex\fR is specified, +no wrap-around will occur. This means that, for example, if the search is +\fB\-forwards\fR but \fIstopIndex\fR is earlier in the text than +\fIstartIndex\fR, nothing will ever be found. See \fBKNOWN BUGS\fR below for a +number of minor limitations of the \fIpathName \fBsearch\fR command. .RE .TP \fIpathName \fBsee \fIindex\fR -Adjusts the view in the window so that the character given by \fIindex\fR -is completely visible. -If \fIindex\fR is already visible then the command does nothing. -If \fIindex\fR is a short distance out of view, the command -adjusts the view just enough to make \fIindex\fR visible at the -edge of the window. -If \fIindex\fR is far out of view, then the command centers -\fIindex\fR in the window. +. +Adjusts the view in the window so that the character given by \fIindex\fR is +completely visible. If \fIindex\fR is already visible then the command does +nothing. If \fIindex\fR is a short distance out of view, the command adjusts +the view just enough to make \fIindex\fR visible at the edge of the window. +If \fIindex\fR is far out of view, then the command centers \fIindex\fR in the +window. .TP \fIpathName \fBtag \fIoption \fR?\fIarg arg ...\fR? -This command is used to manipulate tags. The exact behavior of the -command depends on the \fIoption\fR argument that follows the -\fBtag\fR argument. The following forms of the command are currently -supported: +. +This command is used to manipulate tags. The exact behavior of the command +depends on the \fIoption\fR argument that follows the \fBtag\fR argument. The +following forms of the command are currently supported: .RS .TP \fIpathName \fBtag add \fItagName index1 \fR?\fIindex2 index1 index2 ...\fR? -Associate the tag \fItagName\fR with all of the characters starting -with \fIindex1\fR and ending just before -\fIindex2\fR (the character at \fIindex2\fR is not tagged). -A single command may contain any number of \fIindex1\fR\-\fIindex2\fR -pairs. -If the last \fIindex2\fR is omitted then the single character at -\fIindex1\fR is tagged. -If there are no characters in the specified range (e.g. \fIindex1\fR -is past the end of the file or \fIindex2\fR is less than or equal -to \fIindex1\fR) then the command has no effect. +. +Associate the tag \fItagName\fR with all of the characters starting with +\fIindex1\fR and ending just before \fIindex2\fR (the character at +\fIindex2\fR is not tagged). A single command may contain any number of +\fIindex1\fR\-\fIindex2\fR pairs. If the last \fIindex2\fR is omitted then the +single character at \fIindex1\fR is tagged. If there are no characters in the +specified range (e.g. \fIindex1\fR is past the end of the file or \fIindex2\fR +is less than or equal to \fIindex1\fR) then the command has no effect. .TP \fIpathName \fBtag bind \fItagName\fR ?\fIsequence\fR? ?\fIscript\fR? -This command associates \fIscript\fR with the tag given by -\fItagName\fR. -Whenever the event sequence given by \fIsequence\fR occurs for a -character that has been tagged with \fItagName\fR, -the script will be invoked. -This widget command is similar to the \fBbind\fR command except that -it operates on characters in a text rather than entire widgets. -See the \fBbind\fR manual entry for complete details -on the syntax of \fIsequence\fR and the substitutions performed -on \fIscript\fR before invoking it. -If all arguments are specified then a new binding is created, replacing -any existing binding for the same \fIsequence\fR and \fItagName\fR -(if the first character of \fIscript\fR is +. +This command associates \fIscript\fR with the tag given by \fItagName\fR. +Whenever the event sequence given by \fIsequence\fR occurs for a character +that has been tagged with \fItagName\fR, the script will be invoked. This +widget command is similar to the \fBbind\fR command except that it operates on +characters in a text rather than entire widgets. See the \fBbind\fR manual +entry for complete details on the syntax of \fIsequence\fR and the +substitutions performed on \fIscript\fR before invoking it. If all arguments +are specified then a new binding is created, replacing any existing binding +for the same \fIsequence\fR and \fItagName\fR (if the first character of +\fIscript\fR is .QW + -then \fIscript\fR augments an existing binding rather than replacing it). -In this case the return value is an empty string. -If \fIscript\fR is omitted then the command returns the \fIscript\fR -associated with \fItagName\fR and \fIsequence\fR (an error occurs -if there is no such binding). -If both \fIscript\fR and \fIsequence\fR are omitted then the command -returns a list of all the sequences for which bindings have been -defined for \fItagName\fR. +then \fIscript\fR augments an existing binding rather than replacing it). In +this case the return value is an empty string. If \fIscript\fR is omitted then +the command returns the \fIscript\fR associated with \fItagName\fR and +\fIsequence\fR (an error occurs if there is no such binding). If both +\fIscript\fR and \fIsequence\fR are omitted then the command returns a list of +all the sequences for which bindings have been defined for \fItagName\fR. .RS .PP -The only events for which bindings may be specified are those related -to the mouse and keyboard (such as \fBEnter\fR, \fBLeave\fR, -\fBButtonPress\fR, \fBMotion\fR, and \fBKeyPress\fR) or virtual events. -Event bindings for a text widget use the \fBcurrent\fR mark described -under \fBMARKS\fR above. An \fBEnter\fR event triggers for a tag when the tag -first becomes present on the current character, and a \fBLeave\fR event -triggers for a tag when it ceases to be present on the current character. -\fBEnter\fR and \fBLeave\fR events can happen either because the -\fBcurrent\fR mark moved or because the character at that position -changed. Note that these events are different than \fBEnter\fR and -\fBLeave\fR events for windows. Mouse and keyboard events are directed -to the current character. If a virtual event is used in a binding, that -binding can trigger only if the virtual event is defined by an underlying +The only events for which bindings may be specified are those related to the +mouse and keyboard (such as \fBEnter\fR, \fBLeave\fR, \fBButtonPress\fR, +\fBMotion\fR, and \fBKeyPress\fR) or virtual events. Event bindings for a text +widget use the \fBcurrent\fR mark described under \fBMARKS\fR above. An +\fBEnter\fR event triggers for a tag when the tag first becomes present on the +current character, and a \fBLeave\fR event triggers for a tag when it ceases +to be present on the current character. \fBEnter\fR and \fBLeave\fR events can +happen either because the \fBcurrent\fR mark moved or because the character at +that position changed. Note that these events are different than \fBEnter\fR +and \fBLeave\fR events for windows. Mouse and keyboard events are directed to +the current character. If a virtual event is used in a binding, that binding +can trigger only if the virtual event is defined by an underlying mouse-related or keyboard-related event. .PP -It is possible for the current character to have multiple tags, -and for each of them to have a binding for a particular event -sequence. -When this occurs, one binding is invoked for each tag, in order -from lowest-priority to highest priority. -If there are multiple matching bindings for a single tag, then -the most specific binding is chosen (see the manual entry for -the \fBbind\fR command for details). -\fBcontinue\fR and \fBbreak\fR commands within binding scripts -are processed in the same way as for bindings created with -the \fBbind\fR command. -.PP -If bindings are created for the widget as a whole using the -\fBbind\fR command, then those bindings will supplement the -tag bindings. -The tag bindings will be invoked first, followed by bindings -for the window as a whole. +It is possible for the current character to have multiple tags, and for each +of them to have a binding for a particular event sequence. When this occurs, +one binding is invoked for each tag, in order from lowest-priority to highest +priority. If there are multiple matching bindings for a single tag, then the +most specific binding is chosen (see the manual entry for the \fBbind\fR +command for details). \fBcontinue\fR and \fBbreak\fR commands within binding +scripts are processed in the same way as for bindings created with the +\fBbind\fR command. +.PP +If bindings are created for the widget as a whole using the \fBbind\fR +command, then those bindings will supplement the tag bindings. The tag +bindings will be invoked first, followed by bindings for the window as a +whole. .RE .TP -\fIpathName \fBtag cget\fR \fItagName option\fR +\fIpathName \fBtag cget \fItagName option\fR +. This command returns the current value of the option named \fIoption\fR -associated with the tag given by \fItagName\fR. -\fIOption\fR may have any of the values accepted by the \fIpathName \fBtag -configure\fR widget command. +associated with the tag given by \fItagName\fR. \fIOption\fR may have any of +the values accepted by the \fIpathName \fBtag configure\fR widget command. .TP \fIpathName \fBtag configure \fItagName\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR? -This command is similar to the \fIpathName \fBconfigure\fR widget command except -that it modifies options associated with the tag given by \fItagName\fR -instead of modifying options for the overall text widget. -If no \fIoption\fR is specified, the command returns a list describing -all of the available options for \fItagName\fR (see \fBTk_ConfigureInfo\fR -for information on the format of this list). -If \fIoption\fR is specified with no \fIvalue\fR, then the command returns -a list describing the one named option (this list will be identical to -the corresponding sublist of the value returned if no \fIoption\fR -is specified). -If one or more \fIoption\-value\fR pairs are specified, then the command -modifies the given option(s) to have the given value(s) in \fItagName\fR; -in this case the command returns an empty string. +. +This command is similar to the \fIpathName \fBconfigure\fR widget command +except that it modifies options associated with the tag given by \fItagName\fR +instead of modifying options for the overall text widget. If no \fIoption\fR +is specified, the command returns a list describing all of the available +options for \fItagName\fR (see \fBTk_ConfigureInfo\fR for information on the +format of this list). If \fIoption\fR is specified with no \fIvalue\fR, then +the command returns a list describing the one named option (this list will be +identical to the corresponding sublist of the value returned if no +\fIoption\fR is specified). If one or more \fIoption\-value\fR pairs are +specified, then the command modifies the given option(s) to have the given +value(s) in \fItagName\fR; in this case the command returns an empty string. See \fBTAGS\fR above for details on the options available for tags. .TP \fIpathName \fBtag delete \fItagName \fR?\fItagName ...\fR? -Deletes all tag information for each of the \fItagName\fR -arguments. -The command removes the tags from all characters in the file -and also deletes any other information associated with the tags, -such as bindings and display information. -The command returns an empty string. +. +Deletes all tag information for each of the \fItagName\fR arguments. The +command removes the tags from all characters in the file and also deletes any +other information associated with the tags, such as bindings and display +information. The command returns an empty string. .TP \fIpathName\fB tag lower \fItagName \fR?\fIbelowThis\fR? -Changes the priority of tag \fItagName\fR so that it is just lower -in priority than the tag whose name is \fIbelowThis\fR. -If \fIbelowThis\fR is omitted, then \fItagName\fR's priority -is changed to make it lowest priority of all tags. +. +Changes the priority of tag \fItagName\fR so that it is just lower in priority +than the tag whose name is \fIbelowThis\fR. If \fIbelowThis\fR is omitted, +then \fItagName\fR's priority is changed to make it lowest priority of all +tags. .TP \fIpathName \fBtag names \fR?\fIindex\fR? -Returns a list whose elements are the names of all the tags that -are active at the character position given by \fIindex\fR. -If \fIindex\fR is omitted, then the return value will describe -all of the tags that exist for the text (this includes all tags -that have been named in a +. +Returns a list whose elements are the names of all the tags that are active at +the character position given by \fIindex\fR. If \fIindex\fR is omitted, then +the return value will describe all of the tags that exist for the text (this +includes all tags that have been named in a .QW "\fIpathName \fBtag\fR" widget command but have not been deleted by a .QW "\fIpathName \fBtag delete\fR" -widget command, even if no characters are currently marked with the tag). -The list will be sorted in order from lowest priority to highest -priority. +widget command, even if no characters are currently marked with the tag). The +list will be sorted in order from lowest priority to highest priority. .TP \fIpathName \fBtag nextrange \fItagName index1 \fR?\fIindex2\fR? -This command searches the text for a range of characters tagged -with \fItagName\fR where the first character of the range is -no earlier than the character at \fIindex1\fR and no later than -the character just before \fIindex2\fR (a range starting at -\fIindex2\fR will not be considered). -If several matching ranges exist, the first one is chosen. -The command's return value is a list containing -two elements, which are the index of the first character of the -range and the index of the character just after the last one in -the range. -If no matching range is found then the return value is an -empty string. -If \fIindex2\fR is not given then it defaults to the end of the text. +. +This command searches the text for a range of characters tagged with +\fItagName\fR where the first character of the range is no earlier than the +character at \fIindex1\fR and no later than the character just before +\fIindex2\fR (a range starting at \fIindex2\fR will not be considered). If +several matching ranges exist, the first one is chosen. The command's return +value is a list containing two elements, which are the index of the first +character of the range and the index of the character just after the last one +in the range. If no matching range is found then the return value is an empty +string. If \fIindex2\fR is not given then it defaults to the end of the text. .TP \fIpathName \fBtag prevrange \fItagName index1 \fR?\fIindex2\fR? -This command searches the text for a range of characters tagged -with \fItagName\fR where the first character of the range is -before the character at \fIindex1\fR and no earlier than -the character at \fIindex2\fR (a range starting at -\fIindex2\fR will be considered). -If several matching ranges exist, the one closest to \fIindex1\fR is chosen. -The command's return value is a list containing -two elements, which are the index of the first character of the -range and the index of the character just after the last one in -the range. -If no matching range is found then the return value is an -empty string. +. +This command searches the text for a range of characters tagged with +\fItagName\fR where the first character of the range is before the character +at \fIindex1\fR and no earlier than the character at \fIindex2\fR (a range +starting at \fIindex2\fR will be considered). If several matching ranges +exist, the one closest to \fIindex1\fR is chosen. The command's return value +is a list containing two elements, which are the index of the first character +of the range and the index of the character just after the last one in the +range. If no matching range is found then the return value is an empty string. If \fIindex2\fR is not given then it defaults to the beginning of the text. .TP \fIpathName\fB tag raise \fItagName \fR?\fIaboveThis\fR? -Changes the priority of tag \fItagName\fR so that it is just higher -in priority than the tag whose name is \fIaboveThis\fR. -If \fIaboveThis\fR is omitted, then \fItagName\fR's priority -is changed to make it highest priority of all tags. +. +Changes the priority of tag \fItagName\fR so that it is just higher in +priority than the tag whose name is \fIaboveThis\fR. If \fIaboveThis\fR is +omitted, then \fItagName\fR's priority is changed to make it highest priority +of all tags. .TP \fIpathName \fBtag ranges \fItagName\fR -Returns a list describing all of the ranges of text that have been -tagged with \fItagName\fR. -The first two elements of the list describe the first tagged range -in the text, the next two elements describe the second range, and -so on. -The first element of each pair contains the index of the first -character of the range, and the second element of the pair contains -the index of the character just after the last one in the -range. -If there are no characters tagged with \fItag\fR then an -empty string is returned. +. +Returns a list describing all of the ranges of text that have been tagged with +\fItagName\fR. The first two elements of the list describe the first tagged +range in the text, the next two elements describe the second range, and so on. +The first element of each pair contains the index of the first character of +the range, and the second element of the pair contains the index of the +character just after the last one in the range. If there are no characters +tagged with \fItag\fR then an empty string is returned. .TP \fIpathName \fBtag remove \fItagName index1 \fR?\fIindex2 index1 index2 ...\fR? -Remove the tag \fItagName\fR from all of the characters starting -at \fIindex1\fR and ending just before -\fIindex2\fR (the character at \fIindex2\fR is not affected). -A single command may contain any number of \fIindex1\fR\-\fIindex2\fR -pairs. -If the last \fIindex2\fR is omitted then the tag is removed from the -single character at \fIindex1\fR. -If there are no characters in the specified range (e.g. \fIindex1\fR -is past the end of the file or \fIindex2\fR is less than or equal -to \fIindex1\fR) then the command has no effect. -This command returns an empty string. +. +Remove the tag \fItagName\fR from all of the characters starting at +\fIindex1\fR and ending just before \fIindex2\fR (the character at +\fIindex2\fR is not affected). A single command may contain any number of +\fIindex1\fR\-\fIindex2\fR pairs. If the last \fIindex2\fR is omitted then the +tag is removed from the single character at \fIindex1\fR. If there are no +characters in the specified range (e.g. \fIindex1\fR is past the end of the +file or \fIindex2\fR is less than or equal to \fIindex1\fR) then the command +has no effect. This command returns an empty string. .RE .TP \fIpathName \fBwindow \fIoption \fR?\fIarg arg ...\fR? -This command is used to manipulate embedded windows. -The behavior of the command depends on the \fIoption\fR argument -that follows the \fBwindow\fR argument. -The following forms of the command are currently supported: +. +This command is used to manipulate embedded windows. The behavior of the +command depends on the \fIoption\fR argument that follows the \fBwindow\fR +argument. The following forms of the command are currently supported: .RS .TP -\fIpathName \fBwindow cget\fR \fIindex option\fR +\fIpathName \fBwindow cget \fIindex option\fR +. Returns the value of a configuration option for an embedded window. -\fIIndex\fR identifies the embedded window, and \fIoption\fR -specifies a particular configuration option, which must be one of -the ones listed in the section \fBEMBEDDED WINDOWS\fR. +\fIIndex\fR identifies the embedded window, and \fIoption\fR specifies a +particular configuration option, which must be one of the ones listed in the +section \fBEMBEDDED WINDOWS\fR. .TP \fIpathName \fBwindow configure \fIindex\fR ?\fIoption value ...\fR? -Query or modify the configuration options for an embedded window. -If no \fIoption\fR is specified, returns a list describing all of -the available options for the embedded window at \fIindex\fR -(see \fBTk_ConfigureInfo\fR for information on the format of this list). -If \fIoption\fR is specified with no \fIvalue\fR, then the command -returns a list describing the one named option (this list will be -identical to the corresponding sublist of the value returned if no -\fIoption\fR is specified). -If one or more \fIoption\-value\fR pairs are specified, then the command -modifies the given option(s) to have the given value(s); in -this case the command returns an empty string. -See \fBEMBEDDED WINDOWS\fR for information on the options that -are supported. +. +Query or modify the configuration options for an embedded window. If no +\fIoption\fR is specified, returns a list describing all of the available +options for the embedded window at \fIindex\fR (see \fBTk_ConfigureInfo\fR for +information on the format of this list). If \fIoption\fR is specified with no +\fIvalue\fR, then the command returns a list describing the one named option +(this list will be identical to the corresponding sublist of the value +returned if no \fIoption\fR is specified). If one or more \fIoption\-value\fR +pairs are specified, then the command modifies the given option(s) to have the +given value(s); in this case the command returns an empty string. See +\fBEMBEDDED WINDOWS\fR for information on the options that are supported. .TP \fIpathName \fBwindow create \fIindex\fR ?\fIoption value ...\fR? -This command creates a new window annotation, which will appear -in the text at the position given by \fIindex\fR. -Any number of \fIoption\-value\fR pairs may be specified to -configure the annotation. -See \fBEMBEDDED WINDOWS\fR for information on the options that -are supported. -Returns an empty string. +. +This command creates a new window annotation, which will appear in the text at +the position given by \fIindex\fR. Any number of \fIoption\-value\fR pairs may +be specified to configure the annotation. See \fBEMBEDDED WINDOWS\fR for +information on the options that are supported. Returns an empty string. .TP \fIpathName \fBwindow names\fR -Returns a list whose elements are the names of all windows currently -embedded in \fIwindow\fR. +. +Returns a list whose elements are the names of all windows currently embedded +in \fIwindow\fR. .RE .TP \fIpathName \fBxview \fIoption args\fR -This command is used to query and change the horizontal position of the -text in the widget's window. It can take any of the following -forms: +. +This command is used to query and change the horizontal position of the text +in the widget's window. It can take any of the following forms: .RS .TP \fIpathName \fBxview\fR -Returns a list containing two elements. -Each element is a real fraction between 0 and 1; together they describe -the portion of the document's horizontal span that is visible in -the window. -For example, if the first element is .2 and the second element is .6, -20% of the text is off-screen to the left, the middle 40% is visible -in the window, and 40% of the text is off-screen to the right. -The fractions refer only to the lines that are actually visible in the -window: if the lines in the window are all very short, so that they -are entirely visible, the returned fractions will be 0 and 1, -even if there are other lines in the text that are -much wider than the window. +. +Returns a list containing two elements. Each element is a real fraction +between 0 and 1; together they describe the portion of the document's +horizontal span that is visible in the window. For example, if the first +element is .2 and the second element is .6, 20% of the text is off-screen to +the left, the middle 40% is visible in the window, and 40% of the text is +off-screen to the right. The fractions refer only to the lines that are +actually visible in the window: if the lines in the window are all very short, +so that they are entirely visible, the returned fractions will be 0 and 1, +even if there are other lines in the text that are much wider than the window. These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR option. .TP \fIpathName \fBxview moveto\fI fraction\fR -Adjusts the view in the window so that \fIfraction\fR of the horizontal -span of the text is off-screen to the left. -\fIFraction\fR is a fraction between 0 and 1. +. +Adjusts the view in the window so that \fIfraction\fR of the horizontal span +of the text is off-screen to the left. \fIFraction\fR is a fraction between 0 +and 1. .TP \fIpathName \fBxview scroll \fInumber what\fR +. This command shifts the view in the window left or right according to -\fInumber\fR and \fIwhat\fR. -\fIWhat\fR must be \fBunits\fR, \fBpages\fR or \fBpixels\fR. -.VS 8.5 -If \fIwhat\fR is \fBunits\fR or \fBpages\fR then \fInumber\fR must be an -integer, otherwise number may be specified in any of the forms acceptable -to \fBTk_GetPixels\fR, such as +\fInumber\fR and \fIwhat\fR. \fIWhat\fR must be \fBunits\fR, \fBpages\fR or +\fBpixels\fR. If \fIwhat\fR is \fBunits\fR or \fBpages\fR then \fInumber\fR +must be an integer, otherwise number may be specified in any of the forms +acceptable to \fBTk_GetPixels\fR, such as .QW 2.0c or .QW 1i -(the result is rounded -to the nearest integer value. If no units are given, pixels are -assumed). If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by -\fInumber\fR average-width characters on the display; if it is +(the result is rounded to the nearest integer value. If no units are given, +pixels are assumed). If \fIwhat\fR is \fBunits\fR, the view adjusts left or +right by \fInumber\fR average-width characters on the display; if it is \fBpages\fR then the view adjusts by \fInumber\fR screenfuls; if it is -\fBpixels\fR then the view adjusts by \fInumber\fR pixels. If -.VE 8.5 -\fInumber\fR is negative then characters farther to the left become -visible; if it is positive then characters farther to the right become -visible. +\fBpixels\fR then the view adjusts by \fInumber\fR pixels. If \fInumber\fR is +negative then characters farther to the left become visible; if it is positive +then characters farther to the right become visible. .RE .TP -\fIpathName \fByview \fI?args\fR? -This command is used to query and change the vertical position of the -text in the widget's window. -It can take any of the following forms: +\fIpathName \fByview \fR?\fIargs\fR? +. +This command is used to query and change the vertical position of the text in +the widget's window. It can take any of the following forms: .RS .TP \fIpathName \fByview\fR +. Returns a list containing two elements, both of which are real fractions -between 0 and 1. -The first element gives the position of the first visible pixel of the -first character (or image, etc) in the -top line in the window, relative to the text as a whole (0.5 means -it is halfway through the text, for example). -The second element gives the position of the first pixel just after the -last visible one in the bottom line of the window, -relative to the text as a whole. -These are the same values passed to scrollbars via the \fB\-yscrollcommand\fR -option. +between 0 and 1. The first element gives the position of the first visible +pixel of the first character (or image, etc) in the top line in the window, +relative to the text as a whole (0.5 means it is halfway through the text, for +example). The second element gives the position of the first pixel just after +the last visible one in the bottom line of the window, relative to the text as +a whole. These are the same values passed to scrollbars via the +\fB\-yscrollcommand\fR option. .TP \fIpathName \fByview moveto\fI fraction\fR +. Adjusts the view in the window so that the pixel given by \fIfraction\fR -appears at the top of the top line of the window. -\fIFraction\fR is a fraction between 0 and 1; 0 indicates the first -pixel of the first character in the text, 0.33 indicates the pixel that is -one-third the way through the text; and so on. -.VS 8.5 -Values close to 1 will -indicate values close to the last pixel in the text (1 actually refers -to one pixel beyond the last pixel), but in such cases the widget will -never scroll beyond the last pixel, and so a value of 1 will effectively -be rounded back to whatever fraction ensures the last pixel is at the -bottom of the window, and some other pixel is at the top. -.VE 8.5 +appears at the top of the top line of the window. \fIFraction\fR is a fraction +between 0 and 1; 0 indicates the first pixel of the first character in the +text, 0.33 indicates the pixel that is one-third the way through the text; and +so on. Values close to 1 will indicate values close to the last pixel in the +text (1 actually refers to one pixel beyond the last pixel), but in such cases +the widget will never scroll beyond the last pixel, and so a value of 1 will +effectively be rounded back to whatever fraction ensures the last pixel is at +the bottom of the window, and some other pixel is at the top. .TP \fIpathName \fByview scroll \fInumber what\fR +. This command adjust the view in the window up or down according to -\fInumber\fR and \fIwhat\fR. -\fIWhat\fR must be \fBunits\fR, \fBpages\fR or \fBpixels\fR. -.VS 8.5 -If \fIwhat\fR is \fBunits\fR or \fBpages\fR then \fInumber\fR must be an -integer, otherwise number may be specified in any of the forms acceptable -to \fBTk_GetPixels\fR, such as +\fInumber\fR and \fIwhat\fR. \fIWhat\fR must be \fBunits\fR, \fBpages\fR or +\fBpixels\fR. If \fIwhat\fR is \fBunits\fR or \fBpages\fR then \fInumber\fR +must be an integer, otherwise number may be specified in any of the forms +acceptable to \fBTk_GetPixels\fR, such as .QW 2.0c or .QW 1i -(the result is rounded -to the nearest integer value. If no units are given, pixels are -assumed). If \fIwhat\fR is \fBunits\fR, the view adjusts up or down by -\fInumber\fR lines on the display; if it is \fBpages\fR then the view +(the result is rounded to the nearest integer value. If no units are given, +pixels are assumed). If \fIwhat\fR is \fBunits\fR, the view adjusts up or down +by \fInumber\fR lines on the display; if it is \fBpages\fR then the view adjusts by \fInumber\fR screenfuls; if it is \fBpixels\fR then the view -adjusts by \fInumber\fR pixels. -.VE 8.5 -If \fInumber\fR is negative then earlier positions in the text -become visible; if it is positive then later positions in the text -become visible. +adjusts by \fInumber\fR pixels. If \fInumber\fR is negative then earlier +positions in the text become visible; if it is positive then later positions +in the text become visible. .TP \fIpathName \fByview \fR?\fB\-pickplace\fR? \fIindex\fR -Changes the view in the widget's window to make \fIindex\fR visible. -If the \fB\-pickplace\fR option is not specified then \fIindex\fR will -appear at the top of the window. -If \fB\-pickplace\fR is specified then the widget chooses where -\fIindex\fR appears in the window: +. +Changes the view in the widget's window to make \fIindex\fR visible. If the +\fB\-pickplace\fR option is not specified then \fIindex\fR will appear at the +top of the window. If \fB\-pickplace\fR is specified then the widget chooses +where \fIindex\fR appears in the window: .RS .IP [1] -If \fIindex\fR is already visible somewhere in the window then the -command does nothing. +If \fIindex\fR is already visible somewhere in the window then the command +does nothing. .IP [2] -If \fIindex\fR is only a few lines off-screen above the window then -it will be positioned at the top of the window. +If \fIindex\fR is only a few lines off-screen above the window then it will be +positioned at the top of the window. .IP [3] -If \fIindex\fR is only a few lines off-screen below the window then -it will be positioned at the bottom of the window. +If \fIindex\fR is only a few lines off-screen below the window then it will be +positioned at the bottom of the window. .IP [4] Otherwise, \fIindex\fR will be centered in the window. -.LP -The \fB\-pickplace\fR option has been obsoleted by the \fIpathName \fBsee\fR widget -command (\fIpathName \fBsee\fR handles both x- and y-motion to make a location -visible, whereas the \fB\-pickplace\fR mode only handles motion in y). +.PP +The \fB\-pickplace\fR option has been obsoleted by the \fIpathName \fBsee\fR +widget command (\fIpathName \fBsee\fR handles both x- and y-motion to make a +location visible, whereas the \fB\-pickplace\fR mode only handles motion in +y). .RE .TP \fIpathName \fByview \fInumber\fR -This command makes the first character on the line after -the one given by \fInumber\fR visible at the top of the window. -\fINumber\fR must be an integer. -This command used to be used for scrolling, but now it is obsolete. +. +This command makes the first character on the line after the one given by +\fInumber\fR visible at the top of the window. \fINumber\fR must be an +integer. This command used to be used for scrolling, but now it is obsolete. .RE .SH BINDINGS .PP -Tk automatically creates class bindings for texts that give them -the following default behavior. -In the descriptions below, +Tk automatically creates class bindings for texts that give them the following +default behavior. In the descriptions below, .QW word -is dependent on the value of -the \fBtcl_wordchars\fR variable. See \fBtclvars\fR(n). +is dependent on the value of the \fBtcl_wordchars\fR variable. See +\fBtclvars\fR(n). .IP [1] -Clicking mouse button 1 positions the insertion cursor -just before the character underneath the mouse cursor, sets the -input focus to this widget, and clears any selection in the widget. -Dragging with mouse button 1 strokes out a selection between -the insertion cursor and the character under the mouse. +Clicking mouse button 1 positions the insertion cursor just before the +character underneath the mouse cursor, sets the input focus to this widget, +and clears any selection in the widget. Dragging with mouse button 1 strokes +out a selection between the insertion cursor and the character under the +mouse. .IP [2] -Double-clicking with mouse button 1 selects the word under the mouse -and positions the insertion cursor at the start of the word. -Dragging after a double click will stroke out a selection consisting -of whole words. +Double-clicking with mouse button 1 selects the word under the mouse and +positions the insertion cursor at the start of the word. Dragging after a +double click will stroke out a selection consisting of whole words. .IP [3] -Triple-clicking with mouse button 1 selects the line under the mouse -and positions the insertion cursor at the start of the line. -Dragging after a triple click will stroke out a selection consisting -of whole lines. +Triple-clicking with mouse button 1 selects the line under the mouse and +positions the insertion cursor at the start of the line. Dragging after a +triple click will stroke out a selection consisting of whole lines. .IP [4] -The ends of the selection can be adjusted by dragging with mouse -button 1 while the Shift key is down; this will adjust the end -of the selection that was nearest to the mouse cursor when button -1 was pressed. -If the button is double-clicked before dragging then the selection -will be adjusted in units of whole words; if it is triple-clicked -then the selection will be adjusted in units of whole lines. +The ends of the selection can be adjusted by dragging with mouse button 1 +while the Shift key is down; this will adjust the end of the selection that +was nearest to the mouse cursor when button 1 was pressed. If the button is +double-clicked before dragging then the selection will be adjusted in units of +whole words; if it is triple-clicked then the selection will be adjusted in +units of whole lines. .IP [5] Clicking mouse button 1 with the Control key down will reposition the insertion cursor without affecting the selection. .IP [6] -If any normal printing characters are typed, they are -inserted at the point of the insertion cursor. -.IP [7] -The view in the widget can be adjusted by dragging with mouse button 2. -If mouse button 2 is clicked without moving the mouse, the selection -is copied into the text at the position of the mouse cursor. -The Insert key also inserts the selection, but at the position of +If any normal printing characters are typed, they are inserted at the point of the insertion cursor. +.IP [7] +The view in the widget can be adjusted by dragging with mouse button 2. If +mouse button 2 is clicked without moving the mouse, the selection is copied +into the text at the position of the mouse cursor. The Insert key also inserts +the selection, but at the position of the insertion cursor. .IP [8] -If the mouse is dragged out of the widget -while button 1 is pressed, the entry will automatically scroll to -make more text visible (if there is more text off-screen on the side -where the mouse left the window). +If the mouse is dragged out of the widget while button 1 is pressed, the entry +will automatically scroll to make more text visible (if there is more text +off-screen on the side where the mouse left the window). .IP [9] -The Left and Right keys move the insertion cursor one character to the -left or right; they also clear any selection in the text. -If Left or Right is typed with the Shift key down, then the insertion -cursor moves and the selection is extended to include the new character. -Control-Left and Control-Right move the insertion cursor by words, and -Control-Shift-Left and Control-Shift-Right move the insertion cursor -by words and also extend the selection. -Control-b and Control-f behave the same as Left and Right, respectively. -Meta-b and Meta-f behave the same as Control-Left and Control-Right, -respectively. +The Left and Right keys move the insertion cursor one character to the left or +right; they also clear any selection in the text. If Left or Right is typed +with the Shift key down, then the insertion cursor moves and the selection is +extended to include the new character. Control-Left and Control-Right move the +insertion cursor by words, and Control-Shift-Left and Control-Shift-Right move +the insertion cursor by words and also extend the selection. Control-b and +Control-f behave the same as Left and Right, respectively. Meta-b and Meta-f +behave the same as Control-Left and Control-Right, respectively. .IP [10] -The Up and Down keys move the insertion cursor one line up or -down and clear any selection in the text. -If Up or Right is typed with the Shift key down, then the insertion -cursor moves and the selection is extended to include the new character. -Control-Up and Control-Down move the insertion cursor by paragraphs (groups -of lines separated by blank lines), and -Control-Shift-Up and Control-Shift-Down move the insertion cursor -by paragraphs and also extend the selection. -Control-p and Control-n behave the same as Up and Down, respectively. +The Up and Down keys move the insertion cursor one line up or down and clear +any selection in the text. If Up or Right is typed with the Shift key down, +then the insertion cursor moves and the selection is extended to include the +new character. Control-Up and Control-Down move the insertion cursor by +paragraphs (groups of lines separated by blank lines), and Control-Shift-Up +and Control-Shift-Down move the insertion cursor by paragraphs and also extend +the selection. Control-p and Control-n behave the same as Up and Down, +respectively. .IP [11] -The Next and Prior keys move the insertion cursor forward or backwards -by one screenful and clear any selection in the text. -If the Shift key is held down while Next or Prior is typed, then -the selection is extended to include the new character. +The Next and Prior keys move the insertion cursor forward or backwards by one +screenful and clear any selection in the text. If the Shift key is held down +while Next or Prior is typed, then the selection is extended to include the +new character. .IP [12] Control-Next and Control-Prior scroll the view right or left by one page without moving the insertion cursor or affecting the selection. .IP [13] -Home and Control-a move the insertion cursor to the -beginning of its display line and clear any selection in the widget. -Shift-Home moves the insertion cursor to the beginning of the display line -and also extends the selection to that point. +Home and Control-a move the insertion cursor to the beginning of its display +line and clear any selection in the widget. Shift-Home moves the insertion +cursor to the beginning of the display line and also extends the selection to +that point. .IP [14] -End and Control-e move the insertion cursor to the -end of the display line and clear any selection in the widget. -Shift-End moves the cursor to the end of the display line and extends -the selection to that point. +End and Control-e move the insertion cursor to the end of the display line and +clear any selection in the widget. Shift-End moves the cursor to the end of +the display line and extends the selection to that point. .IP [15] -Control-Home and Meta-< move the insertion cursor to the beginning of -the text and clear any selection in the widget. -Control-Shift-Home moves the insertion cursor to the beginning of the text -and also extends the selection to that point. +Control-Home and Meta-< move the insertion cursor to the beginning of the text +and clear any selection in the widget. Control-Shift-Home moves the insertion +cursor to the beginning of the text and also extends the selection to that +point. .IP [16] -Control-End and Meta-> move the insertion cursor to the end of the -text and clear any selection in the widget. -Control-Shift-End moves the cursor to the end of the text and extends -the selection to that point. +Control-End and Meta-> move the insertion cursor to the end of the text and +clear any selection in the widget. Control-Shift-End moves the cursor to the +end of the text and extends the selection to that point. .IP [17] -The Select key and Control-Space set the selection anchor to the position -of the insertion cursor. They do not affect the current selection. -Shift-Select and Control-Shift-Space adjust the selection to the -current position of the insertion cursor, selecting from the anchor -to the insertion cursor if there was not any selection previously. +The Select key and Control-Space set the selection anchor to the position of +the insertion cursor. They do not affect the current selection. Shift-Select +and Control-Shift-Space adjust the selection to the current position of the +insertion cursor, selecting from the anchor to the insertion cursor if there +was not any selection previously. .IP [18] Control-/ selects the entire contents of the widget. .IP [19] Control-\e clears any selection in the widget. .IP [20] -The F16 key (labelled Copy on many Sun workstations) or Meta-w -copies the selection in the widget to the clipboard, if there is a selection. -This action is carried out by the command \fBtk_textCopy\fR. +The F16 key (labelled Copy on many Sun workstations) or Meta-w copies the +selection in the widget to the clipboard, if there is a selection. This +action is carried out by the command \fBtk_textCopy\fR. .IP [21] -The F20 key (labelled Cut on many Sun workstations) or Control-w -copies the selection in the widget to the clipboard and deletes -the selection. -This action is carried out by the command \fBtk_textCut\fR. -If there is no selection in the widget then these keys have no effect. +The F20 key (labelled Cut on many Sun workstations) or Control-w copies the +selection in the widget to the clipboard and deletes the selection. This +action is carried out by the command \fBtk_textCut\fR. If there is no +selection in the widget then these keys have no effect. .IP [22] -The F18 key (labelled Paste on many Sun workstations) or Control-y -inserts the contents of the clipboard at the position of the -insertion cursor. -This action is carried out by the command \fBtk_textPaste\fR. +The F18 key (labelled Paste on many Sun workstations) or Control-y inserts the +contents of the clipboard at the position of the insertion cursor. This action +is carried out by the command \fBtk_textPaste\fR. .IP [23] -The Delete key deletes the selection, if there is one in the widget. -If there is no selection, it deletes the character to the right of -the insertion cursor. +The Delete key deletes the selection, if there is one in the widget. If there +is no selection, it deletes the character to the right of the insertion +cursor. .IP [24] -Backspace and Control-h delete the selection, if there is one -in the widget. -If there is no selection, they delete the character to the left of -the insertion cursor. +Backspace and Control-h delete the selection, if there is one in the widget. +If there is no selection, they delete the character to the left of the +insertion cursor. .IP [25] Control-d deletes the character to the right of the insertion cursor. .IP [26] Meta-d deletes the word to the right of the insertion cursor. .IP [27] -Control-k deletes from the insertion cursor to the end of its line; -if the insertion cursor is already at the end of a line, then -Control-k deletes the newline character. +Control-k deletes from the insertion cursor to the end of its line; if the +insertion cursor is already at the end of a line, then Control-k deletes the +newline character. .IP [28] -Control-o opens a new line by inserting a newline character in -front of the insertion cursor without moving the insertion cursor. +Control-o opens a new line by inserting a newline character in front of the +insertion cursor without moving the insertion cursor. .IP [29] -Meta-backspace and Meta-Delete delete the word to the left of the -insertion cursor. +Meta-backspace and Meta-Delete delete the word to the left of the insertion +cursor. .IP [30] -Control-x deletes whatever is selected in the text widget -after copying it to the clipboard. +Control-x deletes whatever is selected in the text widget after copying it to +the clipboard. .IP [31] -Control-t reverses the order of the two characters to the right of -the insertion cursor. +Control-t reverses the order of the two characters to the right of the +insertion cursor. .IP [32] -Control-z (undoes the last edit action if the \fB\-undo\fR option is -true. Does nothing otherwise. +Control-z undoes the last edit action if the \fB\-undo\fR option is true. +Does nothing otherwise. .IP [33] -Control-Z (or Control-y on Windows) reapplies the last undone edit -action if the \fB\-undo\fR option is true. Does nothing otherwise. +Control-Z (or Control-y on Windows) reapplies the last undone edit action if +the \fB\-undo\fR option is true. Does nothing otherwise. .PP -If the widget is disabled using the \fB\-state\fR option, then its -view can still be adjusted and text can still be selected, -but no insertion cursor will be displayed and no text modifications will -take place. +If the widget is disabled using the \fB\-state\fR option, then its view can +still be adjusted and text can still be selected, but no insertion cursor will +be displayed and no text modifications will take place. .PP -The behavior of texts can be changed by defining new bindings for -individual widgets or by redefining the class bindings. +The behavior of texts can be changed by defining new bindings for individual +widgets or by redefining the class bindings. .SH "KNOWN ISSUES" .SS "ISSUES CONCERNING CHARS AND INDICES" -.VS 8.5 .PP Before Tk 8.5, the widget used the string .QW chars -to refer to index positions (which included characters, embedded -windows and embedded images). As of Tk 8.5 the text widget deals -separately and correctly with +to refer to index positions (which included characters, embedded windows and +embedded images). As of Tk 8.5 the text widget deals separately and correctly +with .QW chars and .QW indices . @@ -2251,89 +2019,78 @@ For backwards compatibility, however, the index modifiers .QW "+N chars" and .QW "\-N chars" -continue to refer to indices. -One must use any of the full forms +continue to refer to indices. One must use any of the full forms .QW "+N any chars" or .QW "\-N any chars" -etc. to refer to actual character indices. This confusion may be fixed in a +etc. to refer to actual character indices. This confusion may be fixed in a future release by making the widget correctly interpret .QW "+N chars" as a synonym for .QW "+N any chars" . -.VE 8.5 .SS "PERFORMANCE ISSUES" .PP -Text widgets should run efficiently under a variety -of conditions. The text widget uses about 2-3 bytes of -main memory for each byte of text, so texts containing a megabyte -or more should be practical on most workstations. -Text is represented internally with a modified B-tree structure -that makes operations relatively efficient even with large texts. -Tags are included in the B-tree structure in a way that allows -tags to span large ranges or have many disjoint smaller ranges -without loss of efficiency. -Marks are also implemented in a way that allows large numbers of -marks. -In most cases it is fine to have large numbers of unique tags, -or a tag that has many distinct ranges. -.PP -One performance problem can arise if you have hundreds or thousands -of different tags that all have the following characteristics: -the first and last ranges of each tag are near the beginning and -end of the text, respectively, -or a single tag range covers most of the text widget. -The cost of adding and deleting tags like this is proportional -to the number of other tags with the same properties. -In contrast, there is no problem with having thousands of distinct -tags if their overall ranges are localized and spread uniformly throughout -the text. -.PP -Very long text lines can be expensive, -especially if they have many marks and tags within them. -.PP -The display line with the insert cursor is redrawn each time the -cursor blinks, which causes a steady stream of graphics traffic. -Set the \fBinsertOffTime\fR attribute to 0 avoid this. +Text widgets should run efficiently under a variety of conditions. The text +widget uses about 2-3 bytes of main memory for each byte of text, so texts +containing a megabyte or more should be practical on most workstations. Text +is represented internally with a modified B-tree structure that makes +operations relatively efficient even with large texts. Tags are included in +the B-tree structure in a way that allows tags to span large ranges or have +many disjoint smaller ranges without loss of efficiency. Marks are also +implemented in a way that allows large numbers of marks. In most cases it is +fine to have large numbers of unique tags, or a tag that has many distinct +ranges. +.PP +One performance problem can arise if you have hundreds or thousands of +different tags that all have the following characteristics: the first and last +ranges of each tag are near the beginning and end of the text, respectively, +or a single tag range covers most of the text widget. The cost of adding and +deleting tags like this is proportional to the number of other tags with the +same properties. In contrast, there is no problem with having thousands of +distinct tags if their overall ranges are localized and spread uniformly +throughout the text. +.PP +Very long text lines can be expensive, especially if they have many marks and +tags within them. +.PP +The display line with the insert cursor is redrawn each time the cursor +blinks, which causes a steady stream of graphics traffic. Set the +\fB\-insertofftime\fR attribute to 0 avoid this. .SS "KNOWN BUGS" -.VS 8.5 -.PP -The \fIpathName \fBsearch \-regexp\fR sub-command attempts to perform sophisticated -regexp matching across multiple lines in an efficient fashion (since Tk -8.5), examining each line individually, and then in small groups of lines, -whether searching forwards or backwards. Under certain conditions the -search result might differ from that obtained by applying the same regexp -to the entire text from the widget in one go. For example, when -searching with a greedy regexp, the widget will continue to attempt to -add extra lines to the match as long as one of two conditions are true: -either Tcl's regexp library returns a code to indicate a longer match is -possible (but there are known bugs in Tcl which mean this code is not -always correctly returned); or if each extra line added results in at -least a partial match with the pattern. This means in the case where the -first extra line added results in no match and Tcl's regexp system -returns the incorrect code and adding a second extra line would actually -match, the text widget will return the wrong result. In practice this is -a rare problem, but it can occur, for example: +.PP +The \fIpathName \fBsearch \-regexp\fR sub-command attempts to perform +sophisticated regexp matching across multiple lines in an efficient fashion +(since Tk 8.5), examining each line individually, and then in small groups of +lines, whether searching forwards or backwards. Under certain conditions the +search result might differ from that obtained by applying the same regexp to +the entire text from the widget in one go. For example, when searching with a +greedy regexp, the widget will continue to attempt to add extra lines to the +match as long as one of two conditions are true: either Tcl's regexp library +returns a code to indicate a longer match is possible (but there are known +bugs in Tcl which mean this code is not always correctly returned); or if each +extra line added results in at least a partial match with the pattern. This +means in the case where the first extra line added results in no match and +Tcl's regexp system returns the incorrect code and adding a second extra line +would actually match, the text widget will return the wrong result. In +practice this is a rare problem, but it can occur, for example: .CS -pack [text .t] +pack [\fBtext\fR .t] \&.t insert 1.0 "aaaa\enbbbb\encccc\enbbbb\enaaaa\en" \&.t search \-regexp \-\- {(a+|b+\enc+\enb+)+\ena+} 1.0 .CE -will not find a match when one exists of 19 -characters starting from the first +will not find a match when one exists of 19 characters starting from the first .QW b . .PP -Whenever one possible match is fully enclosed in another, the search -command will attempt to ensure only the larger match is returned. -When performing backwards regexp searches it is possible that Tcl -will not always achieve this, in the case where a match is preceded by -one or more short, non-overlapping matches, all of which are preceded -by a large match which actually encompasses all of them. The search -algorithm used by the widget does not look back arbitrarily far for a -possible match which might cover large portions of the widget. -For example: +Whenever one possible match is fully enclosed in another, the search command +will attempt to ensure only the larger match is returned. When performing +backwards regexp searches it is possible that Tcl will not always achieve +this, in the case where a match is preceded by one or more short, +non-overlapping matches, all of which are preceded by a large match which +actually encompasses all of them. The search algorithm used by the widget does +not look back arbitrarily far for a possible match which might cover large +portions of the widget. For example: .CS -pack [text .t] +pack [\fBtext\fR .t] \&.t insert 1.0 "aaaa\enbbbb\enbbbb\enbbbb\enbbbb\\n" \&.t search \-regexp \-backward \-\- {b+\en|a+\en(b+\en)+} end .CE @@ -2350,8 +2107,10 @@ and when really it should only match at .QW 1.0 since that match encloses all the others. -.VE 8.5 .SH "SEE ALSO" entry(n), scrollbar(n) .SH KEYWORDS text, widget, tkvars +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -14,7 +14,6 @@ tk \- Manipulate Tk internal state .SH SYNOPSIS \fBtk\fR \fIoption \fR?\fIarg arg ...\fR? .BE - .SH DESCRIPTION .PP The \fBtk\fR command provides access to miscellaneous @@ -46,7 +45,14 @@ If sends have been disabled by deleting the \fBsend\fR command, this command will reenable them and recreate the \fBsend\fR command. .TP -\fBtk caret window \fR?\fB\-x \fIx\fR? ?\fB\-y \fIy\fR? ?\fB\-height \fIheight\fR? +\fBtk busy \fIsubcommand\fR ... +. +This command controls the marking of window hierarchies as +.QW busy , +rendering them non-interactive while some other operation is proceeding. For +more details see the \fBbusy\fR manual page. +.TP +\fBtk caret \fIwindow \fR?\fB\-x \fIx\fR? ?\fB\-y \fIy\fR? ?\fB\-height \fIheight\fR? . Sets and queries the caret location for the display of the specified Tk window \fIwindow\fR. The caret is the per-display cursor location @@ -54,17 +60,39 @@ used for indicating global focus (e.g. to comply with Microsoft Accessibility guidelines), as well as for location of the over-the-spot XIM (X Input Methods) or Windows IME windows. If no options are specified, the last values used for setting the caret are return in option-value pair -format. \fI\-x\fR and \fI\-y\fR represent window-relative coordinates, and -\fI\-height\fR is the height of the current cursor location, or the height +format. \fB\-x\fR and \fB\-y\fR represent window-relative coordinates, and +\fB\-height\fR is the height of the current cursor location, or the height of the specified \fIwindow\fR if none is given. .TP +\fBtk inactive \fR?\fB\-displayof \fIwindow\fR? ?\fBreset\fR? +. +Returns a positive integer, the number of milliseconds since the last +time the user interacted with the system. If the \fB\-displayof\fR +option is given then the return value refers to the display of +\fIwindow\fR; otherwise it refers to the display of the application's +main window. +.RS +.PP +\fBtk inactive\fR will return \-1, if querying the user inactive time +is not supported by the system, and in safe interpreters. +.PP +If the literal string \fBreset\fR is given as an additional argument, +the timer is reset and an empty string is returned. Resetting the +inactivity time is forbidden in safe interpreters and will throw an +error if tried. +.RE +.TP +\fBtk fontchooser \fIsubcommand\fR ... +Controls the Tk font selection dialog. For more details see the +\fBfontchooser\fR manual page. +.TP \fBtk scaling \fR?\fB\-displayof \fIwindow\fR? ?\fInumber\fR? . Sets and queries the current scaling factor used by Tk to convert between physical units (for example, points, inches, or millimeters) and pixels. The \fInumber\fR argument is a floating point number that specifies the number of pixels per point on \fIwindow\fR's display. If the \fIwindow\fR argument is -omitted, it defaults to the main window. If the \fInumber\fR argument is +omitted, it defaults to the main window. If the \fInumber\fR argument is omitted, the current value of the scaling factor is returned. .RS .PP @@ -83,24 +111,6 @@ is undefined whether existing widgets will resize themselves dynamically to accommodate the new scaling factor. .RE .TP -\fBtk inactive \fR?\fB\-displayof \fIwindow\fR? ?\fBreset\fR? -. -Returns a positive integer, the number of milliseconds since the last -time the user interacted with the system. If the \fB\-displayof\fR -option is given then the return value refers to the display of -\fIwindow\fR; otherwise it refers to the display of the application's -main window. -.RS -.PP -\fBtk inactive\fR will return \-1, if querying the user inactive time -is not supported by the system, and in safe interpreters. -.PP -If the literal string \fBreset\fR is given as an additional argument, -the timer is reset and an empty string is returned. Resetting the -inactivity time is forbidden in safe interpreters and will throw and -error if tried. -.RE -.TP \fBtk useinputmethods \fR?\fB\-displayof \fIwindow\fR? ?\fIboolean\fR? . Sets and queries the state of whether Tk should use XIM (X Input Methods) @@ -117,6 +127,9 @@ Returns the current Tk windowing system, one of \fBx11\fR (X11-based), \fBwin32\fR (MS Windows), or \fBaqua\fR (Mac OS X Aqua). .SH "SEE ALSO" -send(n), winfo(n) +busy(n), fontchooser(n), send(n), winfo(n) .SH KEYWORDS application name, send +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/tkerror.n b/doc/tkerror.n index d66bf0f..0780901 100644 --- a/doc/tkerror.n +++ b/doc/tkerror.n @@ -14,7 +14,6 @@ tkerror \- Command invoked to process background errors .SH SYNOPSIS \fBtkerror \fImessage\fR .BE - .SH DESCRIPTION .PP Note: as of Tk 4.1 the \fBtkerror\fR command has been renamed to @@ -31,6 +30,8 @@ to the user. If you want your own error management you should directly override \fBbgerror\fR instead of \fBtkerror\fR. Documentation for \fBbgerror\fR is available as part of Tcl's documentation. - .SH KEYWORDS background error, reporting +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/tkvars.n b/doc/tkvars.n index 4a45868..a80fd54 100644 --- a/doc/tkvars.n +++ b/doc/tkvars.n @@ -10,20 +10,22 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -tkvars \- Variables used or set by Tk +geometry, tk_library, tk_patchLevel, tk_strictMotif, tk_version \- Variables used or set by Tk .BE - .SH DESCRIPTION .PP The following Tcl variables are either set or used by Tk at various times in its execution: .TP 15 \fBtk_library\fR +. This variable holds the file name for a directory containing a library of Tcl scripts related to Tk. These scripts include an initialization file that is normally processed whenever a Tk application starts up, plus other files containing procedures that implement default behaviors for widgets. +.RS +.PP The initial value of \fBtcl_library\fR is set when Tk is added to an interpreter; this is done by searching several different directories until one is found that contains an appropriate Tk startup script. @@ -34,36 +36,34 @@ directory, then Tk checks several other directories based on a compiled-in default location, the location of the Tcl library directory, the location of the binary containing the application, and the current working directory. +.PP The variable can be modified by an application to switch to a different library. +.RE .TP \fBtk_patchLevel\fR -Contains a decimal integer giving the current patch level for Tk. +. +Contains a dot-separated sequence of decimal integers giving the +current patch level for Tk. The patch level is incremented for each new release or patch, and it uniquely identifies an official version of Tk. -.TP -\fBtk::Priv\fR -This variable is an array containing several pieces of information -that are private to Tk. The elements of \fBtk::Priv\fR are used by -Tk library procedures and default bindings. -They should not be accessed by any code outside Tk. +.RS +.PP +This value is normally the same as the result of +.QW "\fBpackage require\fR \fBTk\fR" . +.RE .TP \fBtk_strictMotif\fR +. This variable is set to zero by default. If an application sets it to one, then Tk attempts to adhere as closely as possible to Motif look-and-feel standards. For example, active elements such as buttons and scrollbar sliders will not change color when the pointer passes over them. -.TP -\fBtk_textRedraw\fR -.TP -\fBtk_textRelayout\fR -These variables are set by text widgets when they have debugging -turned on. The values written to these variables can be used to -test or debug text widget operations. These variables are mostly -used by Tk's test suite. +Modern applications should not normally set this variable. .TP 15 \fBtk_version\fR +. Tk sets this variable in the interpreter for each application. The variable holds the current version number of the Tk library in the form \fImajor\fR.\fIminor\fR. \fIMajor\fR and @@ -73,6 +73,38 @@ any Tk release that includes changes that are not backward compatible work with the new release). The minor version number increases with each new release of Tk, except that it resets to zero whenever the major version number changes. - +.SS "INTERNAL AND DEBUGGING VARIABLES" +.PP +These variables should not normally be set by user code. +.TP +\fBtk::Priv\fR +. +This variable is an array containing several pieces of information +that are private to Tk. The elements of \fBtk::Priv\fR are used by +Tk library procedures and default bindings. +They should not be accessed by any code outside Tk. +.TP +\fBtk_textRedraw\fR +.TP +\fBtk_textRelayout\fR +. +These variables are set by text widgets when they have debugging +turned on. The values written to these variables can be used to +test or debug text widget operations. These variables are mostly +used by Tk's test suite. +.SH "OTHER GLOBAL VARIABLES" +The following variables are only guaranteed to exist in \fBwish\fR +executables; the Tk library does not define them itself but many Tk +environments do. +.TP 6 +\fBgeometry\fR +. +If set, contains the user-supplied geometry specification to use for +the main Tk window. +.SH "SEE ALSO" +package(n), tclvars(n), wish(1) .SH KEYWORDS -variables, version, text +environment, text, variables, version +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/tkwait.n b/doc/tkwait.n index 334d518..a31aee7 100644 --- a/doc/tkwait.n +++ b/doc/tkwait.n @@ -18,7 +18,6 @@ tkwait \- Wait for variable to change or window to be destroyed .sp \fBtkwait window \fIname\fR .BE - .SH DESCRIPTION .PP The \fBtkwait\fR command waits for one of several things to happen, @@ -44,6 +43,10 @@ the normal fashion, so the application will continue to respond to user interactions. If an event handler invokes \fBtkwait\fR again, the nested call to \fBtkwait\fR must complete before the outer call can complete. - +.SH "SEE ALSO" +bind(n), vwait(n) .SH KEYWORDS variable, visibility, wait, window +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/doc/toplevel.n b/doc/toplevel.n index 80008be..271d9f1 100644 --- a/doc/toplevel.n +++ b/doc/toplevel.n @@ -10,7 +10,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -toplevel \- Create and manipulate toplevel widgets +toplevel \- Create and manipulate 'toplevel' main and popup window widgets .SH SYNOPSIS \fBtoplevel\fR \fIpathName \fR?\fIoptions\fR? .SO @@ -20,7 +20,7 @@ toplevel \- Create and manipulate toplevel widgets .SE .SH "WIDGET-SPECIFIC OPTIONS" .OP \-background background Background -This option is the same as the standard \fBbackground\fR option +This option is the same as the standard \fB\-background\fR option except that its value may also be specified as an empty string. In this case, the widget will display no background or border, and no colors will be consumed from its colormap for its background @@ -30,7 +30,7 @@ Specifies a class for the window. This class will be used when querying the option database for the window's other options, and it will also be used later for other purposes such as bindings. -The \fBclass\fR option may not be changed with the \fBconfigure\fR +The \fB\-class\fR option may not be changed with the \fBconfigure\fR widget command. .OP \-colormap colormap Colormap Specifies a colormap to use for the window. @@ -39,7 +39,7 @@ created for the window and its children, or the name of another window (which must be on the same screen and have the same visual as \fIpathName\fR), in which case the new window will use the colormap from the specified window. -If the \fBcolormap\fR option is not specified, the new window +If the \fB\-colormap\fR option is not specified, the new window uses the default colormap of its screen. This option may not be changed with the \fBconfigure\fR widget command. @@ -86,7 +86,7 @@ Specifies visual information for the new window in any of the forms accepted by \fBTk_GetVisual\fR. If this option is not specified, the new window will use the default visual for its screen. -The \fBvisual\fR option may not be modified with the \fBconfigure\fR +The \fB\-visual\fR option may not be modified with the \fBconfigure\fR widget command. .OP \-width width Width Specifies the desired width for the window in any of the forms @@ -94,7 +94,6 @@ acceptable to \fBTk_GetPixels\fR. If this option is less than or equal to zero then the window will not request any size at all. .BE - .SH DESCRIPTION .PP The \fBtoplevel\fR command creates a new toplevel widget (given @@ -112,7 +111,6 @@ purpose of a toplevel is to serve as a container for dialog boxes and other collections of widgets. The only visible features of a toplevel are its background color and an optional 3-D border to make the toplevel appear raised or sunken. - .SH "WIDGET COMMAND" .PP The \fBtoplevel\fR command creates a new Tcl command whose @@ -127,7 +125,7 @@ the toplevel widget's path name. \fIOption\fR and the \fIarg\fRs determine the exact behavior of the command. The following commands are possible for toplevel widgets: .TP -\fIpathName \fBcget\fR \fIoption\fR +\fIpathName \fBcget \fIoption\fR Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBtoplevel\fR @@ -146,18 +144,14 @@ modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string. \fIOption\fR may have any of the values accepted by the \fBtoplevel\fR command. - .SH BINDINGS .PP When a new toplevel is created, it has no default event bindings: toplevels are not intended to be interactive. - .SH "SEE ALSO" frame(n) - .SH KEYWORDS toplevel, widget - '\" Local Variables: '\" mode: nroff '\" End: diff --git a/doc/ttk_Geometry.3 b/doc/ttk_Geometry.3 index f403004..8dfae37 100644 --- a/doc/ttk_Geometry.3 +++ b/doc/ttk_Geometry.3 @@ -88,7 +88,7 @@ One of the standard Tk relief options (TK_RELIEF_RAISED, TK_RELIEF_SUNKEN, etc.). See \fBTk_GetReliefFromObj\fR. .AP short right in -Extra padding (in pixles) to add to the right side of a region. +Extra padding (in pixels) to add to the right side of a region. .AP Ttk_Side side in One of \fBTTK_SIDE_LEFT\fR, \fBTTK_SIDE_TOP\fR, \fBTTK_SIDE_RIGHT\fR, or \fBTTK_SIDE_BOTTOM\fR. @@ -128,7 +128,7 @@ typedef struct { .CE All coordinates are relative to the window. .PP -\fBTtk_MakeBox\fR is a convenience routine that contsructs +\fBTtk_MakeBox\fR is a convenience routine that constructs a \fBTtk_Box\fR structure representing a region \fIwidth\fR pixels wide, \fIheight\fR pixels tall, at the specified \fIx, y\fR coordinates. .PP @@ -173,7 +173,7 @@ typedef struct { } \fBTtk_Padding\fR; .CE .PP -\fBTtk_MakePadding\fR is a convenience routine that contsructs +\fBTtk_MakePadding\fR is a convenience routine that constructs a \fBTtk_Padding\fR structure with the specified left, top, right, and bottom components. .PP diff --git a/doc/ttk_entry.n b/doc/ttk_entry.n index 924aa05..34779a6 100644 --- a/doc/ttk_entry.n +++ b/doc/ttk_entry.n @@ -39,7 +39,7 @@ requests when it has a selection. .\" MAYBE: .OP \-insertbackground insertBackground Foreground .\" MAYBE: .OP \-insertwidth insertWidth InsertWidth .OP \-invalidcommand invalidCommand InvalidCommand -A script template to evaluate whenever the \fBvalidateCommand\fR returns 0. +A script template to evaluate whenever the \fB\-validatecommand\fR returns 0. See \fBVALIDATION\fR below for more information. .OP \-justify justify Justify Specifies how the text is aligned within the entry widget. @@ -87,7 +87,7 @@ in average-size characters of the widget's font. .SH NOTES .PP A portion of the entry may be selected as described below. -If an entry is exporting its selection (see the \fBexportSelection\fR +If an entry is exporting its selection (see the \fB\-exportselection\fR option), then it will observe the standard X11 protocols for handling the selection; entry selections are available as type \fBSTRING\fR. Entries also observe the standard Tk rules for dealing with the @@ -99,8 +99,8 @@ Entries are capable of displaying strings that are too long to fit entirely within the widget's window. In this case, only a portion of the string will be displayed; commands described below may be used to change the view in the window. Entries use -the standard \fBxScrollCommand\fR mechanism for interacting with -scrollbars (see the description of the \fBxScrollCommand\fR option +the standard \fB\-xscrollcommand\fR mechanism for interacting with +scrollbars (see the description of the \fB\-xscrollcommand\fR option for details). .SH "INDICES" .PP diff --git a/doc/ttk_notebook.n b/doc/ttk_notebook.n index 12c3d6b..cecae48 100644 --- a/doc/ttk_notebook.n +++ b/doc/ttk_notebook.n @@ -100,7 +100,7 @@ which returns the number of tabs .QW "\fIpathname \fBindex\fR" ). .SH "WIDGET COMMAND" .TP -\fIpathname \fBadd\fR \fIwindow\fR ?\fIoptions...\fR? +\fIpathname \fBadd \fIwindow\fR ?\fIoptions...\fR? Adds a new tab to the notebook. See \fBTAB OPTIONS\fR for the list of available \fIoptions\fR. If \fIwindow\fR is currently managed by the notebook but hidden, @@ -109,38 +109,38 @@ it is restored to its previous position. \fIpathname \fBconfigure\fR ?\fIoptions\fR? See \fIttk::widget(n)\fR. .TP -\fIpathname \fBcget\fR \fIoption\fR +\fIpathname \fBcget \fIoption\fR See \fIttk::widget(n)\fR. .TP -\fIpathname \fBforget\fR \fItabid\fR +\fIpathname \fBforget \fItabid\fR Removes the tab specified by \fItabid\fR, unmaps and unmanages the associated window. .TP -\fIpathname \fBhide\fR \fItabid\fR +\fIpathname \fBhide \fItabid\fR Hides the tab specified by \fItabid\fR. The tab will not be displayed, but the associated window remains managed by the notebook and its configuration remembered. Hidden tabs may be restored with the \fBadd\fR command. .TP -\fIpathname \fBidentify\fR \fIcomponent\fR \fIx\fR \fIy\fR +\fIpathname \fBidentify\fI component x y\fR Returns the name of the element under the point given by \fIx\fR and \fIy\fR, or the empty string if no component is present at that location. The following subcommands are supported: .RS .TP -\fIpathname \fBidentify\fR \fBelement\fR \fIx\fR \fIy\fR +\fIpathname \fBidentify element\fR \fIx y\fR Returns the name of the element at the specified location. .TP -\fIpathname \fBidentify\fR \fBtab\fR \fIx\fR \fIy\fR +\fIpathname \fBidentify tab\fR \fIx y\fR Returns the index of the tab at the specified location. .RE .TP -\fIpathname \fBindex\fR \fItabid\fR +\fIpathname \fBindex \fItabid\fR Returns the numeric index of the tab specified by \fItabid\fR, or the total number of tabs if \fItabid\fR is the string .QW \fBend\fR . .TP -\fIpathname \fBinsert\fR \fIpos\fR \fIsubwindow\fR \fIoptions...\fR +\fIpathname \fBinsert \fIpos subwindow options...\fR Inserts a pane at the specified position. \fIpos\fR is either the string \fBend\fR, an integer index, or the name of a managed subwindow. @@ -148,7 +148,7 @@ If \fIsubwindow\fR is already managed by the notebook, moves it to the specified position. See \fBTAB OPTIONS\fR for the list of available options. .TP -\fIpathname \fBinstate\fR \fIstatespec \fR?\fIscript...\fR? +\fIpathname \fBinstate \fIstatespec \fR?\fIscript...\fR? See \fIttk::widget(n)\fR. .TP \fIpathname \fBselect\fR ?\fItabid\fR? @@ -161,7 +161,7 @@ currently selected pane. \fIpathname \fBstate\fR ?\fIstatespec\fR? See \fIttk::widget(n)\fR. .TP -\fIpathname \fBtab\fR \fItabid\fR ?\fI\-option \fR?\fIvalue ...\fR +\fIpathname \fBtab \fItabid\fR ?\fI\-option \fR?\fIvalue ...\fR Query or modify the options of the specific tab. If no \fI\-option\fR is specified, returns a dictionary of the tab option values. @@ -184,9 +184,9 @@ containing the notebook as follows: .IP \(bu \fBControl-Tab\fR selects the tab following the currently selected one. .IP \(bu -\fBShift-Control-Tab\fR selects the tab preceding the currently selected one. +\fBControl-Shift-Tab\fR selects the tab preceding the currently selected one. .IP \(bu -\fBAlt-K\fR, where \fBK\fR is the mnemonic (underlined) character +\fBAlt-\fIK\fR, where \fIK\fR is the mnemonic (underlined) character of any tab, will select that tab. .PP Multiple notebooks in a single toplevel may be enabled for traversal, diff --git a/doc/ttk_panedwindow.n b/doc/ttk_panedwindow.n index 27eb57d..29fca1d 100644 --- a/doc/ttk_panedwindow.n +++ b/doc/ttk_panedwindow.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH ttk::panedwindow n 8.5.9 Tk "Tk Themed Widget" +.TH ttk::panedwindow n 8.5 Tk "Tk Themed Widget" .so man.macros .BS .SH NAME @@ -52,29 +52,29 @@ Supports the standard \fBconfigure\fR, \fBcget\fR, \fBstate\fR, and \fBinstate\fR commands; see \fIttk::widget(n)\fR for details. Additional commands: .TP -\fIpathname\fR \fBadd\fR \fIsubwindow\fR \fIoptions...\fR +\fIpathname \fBadd \fIsubwindow options...\fR Adds a new pane to the window. See \fBPANE OPTIONS\fR for the list of available options. .TP -\fIpathname\fR \fBforget\fR \fIpane\fR +\fIpathname \fBforget \fIpane\fR Removes the specified subpane from the widget. \fIpane\fR is either an integer index or the name of a managed subwindow. .TP -\fIpathname\fR \fBidentify\fR \fIcomponent\fR \fIx\fR \fIy\fR +\fIpathname \fBidentify \fIcomponent x y\fR Returns the name of the element under the point given by \fIx\fR and \fIy\fR, or the empty string if no component is present at that location. If \fIcomponent\fR is omitted, it defaults to \fBsash\fR. The following subcommands are supported: .RS .TP -\fIpathname\fR \fBidentify\fR \fBelement\fR \fIx\fR \fIy\fR +\fIpathname \fBidentify element \fIx y\fR Returns the name of the element at the specified location. .TP -\fIpathname\fR \fBidentify\fR \fBsash\fR \fIx\fR \fIy\fR +\fIpathname \fBidentify sash \fIx y\fR Returns the index of the sash at the specified location. .RE .TP -\fIpathname\fR \fBinsert\fR \fIpos\fR \fIsubwindow\fR \fIoptions...\fR +\fIpathname \fBinsert \fIpos subwindow options...\fR Inserts a pane at the specified position. \fIpos\fR is either the string \fBend\fR, an integer index, or the name of a managed subwindow. @@ -82,7 +82,7 @@ If \fIsubwindow\fR is already managed by the paned window, moves it to the specified position. See \fBPANE OPTIONS\fR for the list of available options. .TP -\fIpathname\fR \fBpane\fR \fIpane \-option \fR?\fIvalue \fR?\fI\-option value...\fR +\fIpathname \fBpane \fIpane \-option \fR?\fIvalue \fR?\fI\-option value...\fR Query or modify the options of the specified \fIpane\fR, where \fIpane\fR is either an integer index or the name of a managed subwindow. If no \fI\-option\fR is specified, returns a dictionary of the pane @@ -90,10 +90,10 @@ option values. If one \fI\-option\fR is specified, returns the value of that \fIoption\fR. Otherwise, sets the \fI\-option\fRs to the corresponding \fIvalue\fRs. .TP -\fIpathname\fR \fBpanes\fR +\fIpathname \fBpanes\fR Returns the list of all windows managed by the widget. .TP -\fIpathname\fR \fBsashpos\fR \fIindex\fR ?\fInewpos\fR? +\fIpathname \fBsashpos \fIindex\fR ?\fInewpos\fR? If \fInewpos\fR is specified, sets the position of sash number \fIindex\fR. May adjust the positions of adjacent sashes diff --git a/doc/ttk_progressbar.n b/doc/ttk_progressbar.n index 3b90371..6306450 100644 --- a/doc/ttk_progressbar.n +++ b/doc/ttk_progressbar.n @@ -57,13 +57,13 @@ to provide additional animation effects. .SH "WIDGET COMMAND" .PP .TP -\fIpathName \fBcget\fR \fIoption\fR +\fIpathName \fBcget \fIoption\fR Returns the current value of the specified \fIoption\fR; see \fIttk::widget(n)\fR. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? Modify or query widget options; see \fIttk::widget(n)\fR. .TP -\fIpathName \fBidentify\fR \fIx y\fR +\fIpathName \fBidentify \fIx y\fR Returns the name of the element at position \fIx\fR, \fIy\fR. See \fIttk::widget(n)\fR. .TP diff --git a/doc/ttk_radiobutton.n b/doc/ttk_radiobutton.n index 86fc417..c16f2cd 100644 --- a/doc/ttk_radiobutton.n +++ b/doc/ttk_radiobutton.n @@ -29,7 +29,7 @@ it sets the variable to its associated value. .OP \-command command Command A Tcl script to evaluate whenever the widget is invoked. .OP \-value Value Value -The value to store in the associated \fI\-variable\fR +The value to store in the associated \fB\-variable\fR when the widget is selected. .OP \-variable variable Variable The name of a global variable whose value is linked to the widget. diff --git a/doc/ttk_scale.n b/doc/ttk_scale.n index 7371b58..b52f9ac 100644 --- a/doc/ttk_scale.n +++ b/doc/ttk_scale.n @@ -39,7 +39,7 @@ or vertically. Must be either \fBhorizontal\fR or \fBvertical\fR or an abbreviation of one of these. .OP \-to to To Specifies a real value corresponding to the right or bottom end of the scale. -This value may be either less than or greater than the \fBfrom\fR option. +This value may be either less than or greater than the \fB\-from\fR option. .OP \-value value Value Specifies the current floating-point value of the variable. .OP \-variable variable Variable @@ -65,7 +65,7 @@ Get the current value of the \fB\-value\fR option, or the value corresponding to the coordinates \fIx,y\fR if they are specified. \fIX\fR and \fIy\fR are pixel coordinates relative to the scale widget origin. .TP -\fIpathName \fBidentify\fR \fIx y\fR +\fIpathName \fBidentify \fIx y\fR Returns the name of the element at position \fIx\fR, \fIy\fR. See \fIttk::widget(n)\fR. .TP diff --git a/doc/ttk_scrollbar.n b/doc/ttk_scrollbar.n index 0a2c719..56df214 100644 --- a/doc/ttk_scrollbar.n +++ b/doc/ttk_scrollbar.n @@ -48,7 +48,7 @@ Specifies the orientation of the scrollbar. .SH "WIDGET COMMAND" .PP .TP -\fIpathName \fBcget\fR \fIoption\fR +\fIpathName \fBcget \fIoption\fR Returns the current value of the specified \fIoption\fR; see \fIttk::widget(n)\fR. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? @@ -58,14 +58,14 @@ Modify or query widget options; see \fIttk::widget(n)\fR. Returns the scrollbar settings in the form of a list whose elements are the arguments to the most recent \fBset\fR widget command. .TP -\fIpathName \fBidentify\fR \fIx y\fR +\fIpathName \fBidentify \fIx y\fR Returns the name of the element at position \fIx\fR, \fIy\fR. See \fIttk::widget(n)\fR. .TP \fIpathName \fBinstate \fIstatespec\fR ?\fIscript\fR? Test the widget state; see \fIttk::widget(n)\fR. .TP -\fIpathName \fBset\fR \fIfirst last\fR +\fIpathName \fBset \fIfirst last\fR This command is normally invoked by the scrollbar's associated widget from an \fB\-xscrollcommand\fR or \fB\-yscrollcommand\fR callback. Specifies the visible range to be displayed. diff --git a/doc/ttk_spinbox.n b/doc/ttk_spinbox.n index 3c7287a..f10af3d 100644 --- a/doc/ttk_spinbox.n +++ b/doc/ttk_spinbox.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH ttk::spinbox n 8.5.9 Tk "Tk Themed Widget" +.TH ttk::spinbox n 8.5 Tk "Tk Themed Widget" .so man.macros .BS .SH NAME @@ -30,11 +30,11 @@ to a Tcl variable. .SH "WIDGET-SPECIFIC OPTIONS" .OP \-from from From A floating\-point value specifying the lowest value for the spinbox. This is -used in conjunction with \fI\-to\fR and \fI\-increment\fR to set a numerical +used in conjunction with \fB\-to\fR and \fB\-increment\fR to set a numerical range. .OP \-to to To A floating\-point value specifying the highest permissible value for the -widget. See also \fI\-from\fR and \fI\-increment\fR. +widget. See also \fB\-from\fR and \fB\-increment\fR. range. .OP \-increment increment Increment A floating\-point value specifying the change in value to be applied each @@ -42,8 +42,8 @@ time one of the widget spin buttons is pressed. The up button applies a positive increment, the down button applies a negative increment. .OP \-values values Values This must be a Tcl list of values. If this option is set then this will -override any range set using the \fI\-from\fR, \fI\-to\fR and -\fI\-increment\fR options. The widget will instead use the values +override any range set using the \fB\-from\fR, \fB\-to\fR and +\fB\-increment\fR options. The widget will instead use the values specified beginning with the first value. .OP \-wrap wrap Wrap Must be a proper boolean value. If on, the spinbox will wrap around the @@ -61,7 +61,7 @@ See the \fBttk::entry\fR manual for information about indexing characters. .SH "VALIDATION" .PP See the \fBttk::entry\fR manual for information about using the -\fI\-validate\fR and \fI\-validatecommand\fR options. +\fB\-validate\fR and \fB\-validatecommand\fR options. .SH "WIDGET COMMAND" .PP The following subcommands are possible for spinbox widgets in addition to @@ -73,9 +73,9 @@ the commands described for the \fBttk::entry\fR widget: Returns the spinbox's current value. .TP \fIpathName \fBset \fIvalue\fR -Set the spinbox string to \fIvalue\fR. If a \fI\-format\fR option has +Set the spinbox string to \fIvalue\fR. If a \fB\-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 +or is not set or the \fB\-values\fR option has been used then the value is set directly. .SH "VIRTUAL EVENTS" .PP diff --git a/doc/ttk_treeview.n b/doc/ttk_treeview.n index ef8d34d..dd83c20 100644 --- a/doc/ttk_treeview.n +++ b/doc/ttk_treeview.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH ttk::treeview n 8.5.9 Tk "Tk Themed Widget" +.TH ttk::treeview n 8.5 Tk "Tk Themed Widget" .so man.macros .BS .SH NAME @@ -380,16 +380,16 @@ the specified tag. \fIpathName \fBtag names\fR Returns a list of all tags used by the widget. .TP -\fIpathName \fBtag add\fR \fItag\fR \fIitems\fR +\fIpathName \fBtag add \fItag items\fR Adds the specified \fItag\fR to each of the listed \fIitems\fR. If \fItag\fR is already present for a particular item, -then the \fB-tags\fR for that item are unchanged. +then the \fB\-tags\fR for that item are unchanged. .TP -\fIpathName \fBtag remove\fR \fItag\fR ?\fIitems\fR? +\fIpathName \fBtag remove \fItag\fR ?\fIitems\fR? Removes the specified \fItag\fR from each of the listed \fIitems\fR. If \fIitems\fR is omitted, removes \fItag\fR from each item in the tree. If \fItag\fR is not present for a particular item, -then the \fB-tags\fR for that item are unchanged. +then the \fB\-tags\fR for that item are unchanged. .RE .TP \fIpathName \fBxview \fIargs\fR diff --git a/doc/ttk_vsapi.n b/doc/ttk_vsapi.n index 96fdf28..34145fb 100644 --- a/doc/ttk_vsapi.n +++ b/doc/ttk_vsapi.n @@ -14,54 +14,58 @@ ttk_vsapi \- Define a Microsoft Visual Styles element .BE .SH DESCRIPTION .PP -The \fIvsapi\fR element factory creates a new element +The \fBvsapi\fR element factory creates a new element in the current theme whose visual appearance is drawn using the -Microsoft Visual Styles API which is reponsible for the themed styles +Microsoft Visual Styles API which is responsible for the themed styles on Windows XP and Vista. This factory permits any of the Visual -Styles parts to be declared as ttk elements that can then be -included in a style layout to modify the appearance of ttk widgets. +Styles parts to be declared as Ttk elements that can then be +included in a style layout to modify the appearance of Ttk widgets. .PP \fIclassName\fR and \fIpartId\fR are required parameters and specify the Visual Styles class and part as given in the Microsoft -documentation. The \fIstateMap\fR may be provided to map ttk states to +documentation. The \fIstateMap\fR may be provided to map Ttk states to Visual Styles API states (see \fBSTATE MAP\fR). .SH "OPTIONS" .PP Valid \fIoptions\fR are: .TP -\fB\-padding\fR \fIpadding\fR +\fB\-padding \fIpadding\fR +. Specify the element's interior padding. \fIpadding\fR is a list of up to four integers specifying the left, top, right and bottom padding quantities respectively. This option may not be mixed with any other options. .TP -\fB\-margins\fR \fIpadding\fR +\fB\-margins \fIpadding\fR +. Specifies the elements exterior padding. \fIpadding\fR is a list of up to four integers specifying the left, top, right and bottom padding quantities respectively. This option may not be mixed with any other options. .TP -\fB\-width\fR \fIwidth\fR +\fB\-width \fIwidth\fR +. Specifies the height for the element. If this option is set then the Visual Styles API will not be queried for the recommended -size or the part. If this option is set then \fI-height\fR should -also be set. The \fI-width\fR and \fI-height\fR options cannot -be mixed with the \fI-padding\fR or \fI-margins\fR options. +size or the part. If this option is set then \fB\-height\fR should +also be set. The \fB\-width\fR and \fB\-height\fR options cannot +be mixed with the \fB\-padding\fR or \fB\-margins\fR options. .TP -\fB\-height\fR \fIheight\fR -Specifies the height of the element. See the comments for \fI-width\fR. +\fB\-height \fIheight\fR +. +Specifies the height of the element. See the comments for \fB\-width\fR. .SH "STATE MAP" .PP The \fIstateMap\fR parameter is a list of ttk states and the corresponding Visual Styles API state value. -This permits the element appearence to respond to changes in the +This permits the element appearance to respond to changes in the widget state such as becoming active or being pressed. The list should be as described for the \fBttk::style map\fR command but note that the last pair in the list should be the default state and is typically and empty list and 1. Unfortunately all the Visual Styles parts have different state values and these must be looked up either in the Microsoft documentation or more likely in the header files. The -original header to use was \fItmschema.h\fR but in more recent +original header to use was \fItmschema.h\fR, but in more recent versions of the Windows Development Kit this is \fIvssym32.h\fR. .PP If no \fIstateMap\fR parameter is given there is an implicit default @@ -73,16 +77,16 @@ a \fBttk::button\fR(n). This uses the WINDOW part WP_SMALLCLOSEBUTTON and as documented the states CBS_DISABLED, CBS_HOT, CBS_NORMAL and CBS_PUSHED are mapped from ttk states. .CS -ttk::style element create smallclose vsapi WINDOW 19 \\ +ttk::style element create smallclose \fBvsapi\fR WINDOW 19 \\ {disabled 4 pressed 3 active 2 {} 1} ttk::style layout CloseButton {CloseButton.smallclose -sticky news} pack [ttk::button .close -style CloseButton] .CE .PP -Change the appearence of a \fBttk::checkbutton\fR(n) to use the +Change the appearance of a \fBttk::checkbutton\fR(n) to use the Explorer pin part EBP_HEADERPIN. .CS -ttk::style element create pin vsapi EXPLORERBAR 3 { +ttk::style element create pin \fBvsapi\fR EXPLORERBAR 3 { {pressed !selected} 3 {active !selected} 2 {pressed selected} 6 diff --git a/doc/ttk_widget.n b/doc/ttk_widget.n index 390635c..2ecc29f 100644 --- a/doc/ttk_widget.n +++ b/doc/ttk_widget.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH ttk::widget n 8.5.9 Tk "Tk Themed Widget" +.TH ttk::widget n 8.5 Tk "Tk Themed Widget" .so man.macros .BS .SH NAME @@ -54,7 +54,7 @@ The first fraction indicates the first information in the widget that is visible in the window, and the second fraction indicates the information just after the last portion that is visible. .PP -Typically the \fBxScrollCommand\fR option consists of the path name +Typically the \fB\-xscrollcommand\fR option consists of the path name of a \fBscrollbar\fR widget followed by .QW set , e.g. @@ -123,11 +123,13 @@ but the \fBstate\fR widget command does not affect the \fB\-state\fR option. .SH COMMANDS .TP -\fIpathName \fBcget\fR \fIoption\fR +\fIpathName \fBcget \fIoption\fR +. Returns the current value of the configuration option given by \fIoption\fR. .TP \fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR? +. Query or modify the configuration options of the widget. If one or more \fIoption\-value\fR pairs are specified, then the command modifies the given widget option(s) @@ -142,14 +144,16 @@ and current value. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR. .TP -\fIpathName \fBidentify\fR \fBelement\fR \fIx y\fR +\fIpathName \fBidentify element \fIx y\fR +. Returns the name of the element under the point given by \fIx\fR and \fIy\fR, or an empty string if the point does not lie within any element. \fIx\fR and \fIy\fR are pixel coordinates relative to the widget. Some widgets accept other \fBidentify\fR subcommands. .TP -\fIpathName \fBinstate\fR \fIstatespec\fR ?\fIscript\fR? +\fIpathName \fBinstate \fIstatespec\fR ?\fIscript\fR? +. Test the widget's state. If \fIscript\fR is not specified, returns 1 if the widget state matches \fIstatespec\fR and 0 otherwise. @@ -159,6 +163,7 @@ if {[\fIpathName\fR instate \fIstateSpec\fR]} \fIscript\fR .CE .TP \fIpathName \fBstate\fR ?\fIstateSpec\fR? +. Modify or inquire widget state. If \fIstateSpec\fR is present, sets the widget state: for each flag in \fIstateSpec\fR, sets the corresponding flag @@ -178,6 +183,7 @@ The widget state is a bitmap of independent state flags. Widget state flags include: .TP \fBactive\fR +. The mouse cursor is over the widget and pressing a mouse button will cause some action to occur. (aka .QW prelight @@ -187,19 +193,23 @@ and pressing a mouse button will cause some action to occur. (aka .QW hover ). .TP \fBdisabled\fR +. Widget is disabled under program control (aka .QW unavailable , -.QW inactive ) +.QW inactive ). .TP \fBfocus\fR -Widget has keyboard focus +. +Widget has keyboard focus. .TP \fBpressed\fR +. Widget is being pressed (aka .QW armed in Motif). .TP \fBselected\fR +. .QW On , .QW true , or @@ -207,6 +217,7 @@ or for things like checkbuttons and radiobuttons. .TP \fBbackground\fR +. Windows and the Mac have a notion of an .QW active or foreground window. @@ -214,9 +225,11 @@ The \fBbackground\fR state is set for widgets in a background window, and cleared for those in the foreground window. .TP \fBreadonly\fR +. Widget should not allow user modification. .TP \fBalternate\fR +. A widget-specific alternate display format. For example, used for checkbuttons and radiobuttons in the .QW tristate @@ -225,11 +238,13 @@ or state, and for buttons with \fB\-default active\fR. .TP \fBinvalid\fR +. The widget's value is invalid. (Potential uses: scale widget value out of bounds, entry widget value failed validation.) .TP \fBhover\fR +. The mouse cursor is within the widget. This is similar to the \fBactive\fP state; it is used in some themes for widgets that @@ -245,13 +260,13 @@ indicating that the bit is off. set b [ttk::button .b] # Disable the widget: -$b state disabled +$b \fBstate\fR disabled # Invoke the widget only if it is currently pressed and enabled: -$b instate {pressed !disabled} { .b invoke } +$b \fBinstate\fR {pressed !disabled} { .b invoke } # Reenable widget: -$b state !disabled +$b \fBstate\fR !disabled .CE .SH "SEE ALSO" ttk::intro(n), ttk::style(n) diff --git a/doc/winfo.n b/doc/winfo.n index bb8e057..5008448 100644 --- a/doc/winfo.n +++ b/doc/winfo.n @@ -14,7 +14,6 @@ winfo \- Return window-related information .SH SYNOPSIS \fBwinfo\fR \fIoption \fR?\fIarg arg ...\fR? .BE - .SH DESCRIPTION .PP The \fBwinfo\fR command is used to retrieve information about windows @@ -105,7 +104,7 @@ in pixels. \fBwinfo height \fIwindow\fR Returns a decimal string giving \fIwindow\fR's height in pixels. When a window is first created its height will be 1 pixel; the -height will eventually be changed by a geometry manager to fulfill +height will eventually be changed by a geometry manager to fulfil the window's needs. If you need the true height immediately after creating a widget, invoke \fBupdate\fR to force the geometry manager to arrange it, @@ -316,7 +315,7 @@ Returns 0 if there is no virtual root window for \fIwindow\fR. \fBwinfo width \fIwindow\fR Returns a decimal string giving \fIwindow\fR's width in pixels. When a window is first created its width will be 1 pixel; the -width will eventually be changed by a geometry manager to fulfill +width will eventually be changed by a geometry manager to fulfil the window's needs. If you need the true width immediately after creating a widget, invoke \fBupdate\fR to force the geometry manager to arrange it, @@ -335,6 +334,7 @@ parent, of the upper-left corner of \fIwindow\fR's border (or \fIwindow\fR if it has no border). .SH EXAMPLE +.PP Print where the mouse pointer is and what window it is currently over: .CS lassign [\fBwinfo pointerxy\fR .] x y @@ -346,7 +346,9 @@ if {$win eq ""} { puts "over $win" } .CE - .SH KEYWORDS atom, children, class, geometry, height, identifier, information, interpreters, mapped, parent, path name, screen, virtual root, width, window +'\" Local Variables: +'\" mode: nroff +'\" End: @@ -15,10 +15,8 @@ wish \- Simple windowing shell \fBwish\fR ?\fB\-encoding \fIname\fR? ?\fIfileName arg arg ...\fR? .SH OPTIONS .IP "\fB\-encoding \fIname\fR" 20 -.VS 8.5 Specifies the encoding of the text stored in \fIfileName\fR. This option is only recognized prior to the \fIfileName\fR argument. -.VE 8.5 .IP "\fB\-colormap \fInew\fR" 20 Specifies that the window should have a new private colormap instead of using the default colormap for the screen. @@ -63,7 +61,7 @@ language, the Tk toolkit, and a main program that reads commands from standard input or from a file. It creates a main window and then processes Tcl commands. If \fBwish\fR is invoked with arguments, then the first few -arguments, ?\fB\-encoding \fIname\fR? ?\fIfileName\fR? specify the +arguments, ?\fB\-encoding \fIname\fR? ?\fIfileName\fR?, specify the name of a script file, and, optionally, the encoding of the text data stored in that script file. A value for \fIfileName\fR is recognized if the appropriate argument @@ -213,5 +211,8 @@ The variable \fBtcl_prompt2\fR is used in a similar way when a newline is typed but the current command is not yet complete; if \fBtcl_prompt2\fR is not set then no prompt is output for incomplete commands. +.SH "SEE ALSO" +tclsh(1), toplevel(n), Tk_Main(3), Tk_MainLoop(3), Tk_MainWindow(3) .SH KEYWORDS -shell, toolkit +application, argument, interpreter, prompt, script file, shell, +toolkit, toplevel @@ -27,6 +27,7 @@ top-level window. The legal forms for the \fBwm\fR command are: .TP \fBwm aspect \fIwindow\fR ?\fIminNumer minDenom maxNumer maxDenom\fR? +. If \fIminNumer\fR, \fIminDenom\fR, \fImaxNumer\fR, and \fImaxDenom\fR are all specified, then they will be passed to the window manager and the window manager should use them to enforce a range of @@ -47,6 +48,7 @@ returned). \fBwm attributes \fIwindow\fR ?\fBoption\fR? .TP \fBwm attributes \fIwindow\fR ?\fBoption value option value...\fR? +. This subcommand returns or sets platform specific attributes associated with a window. The first form returns a list of the platform specific flags and their values. The second form returns the value for the @@ -57,82 +59,162 @@ values are as follows: All platforms support the following attributes (though X11 users should see the notes below): .TP +\fB\-alpha\fR +. +Specifies the alpha transparency level of the toplevel. It accepts a value +from \fB0.0\fR (fully transparent) to \fB1.0\fR (opaque). Values outside that +range will be constrained. Where not supported, the \fB\-alpha\fR value +remains at \fB1.0\fR. +.TP \fB\-fullscreen\fR +. Places the window in a mode that takes up the entire screen, has no borders, and covers the general use area (i.e. Start menu and taskbar on Windows, dock and menubar on OSX, general window decorations on X11). .TP \fB\-topmost\fR +. Specifies whether this is a topmost window (displays above all other windows). .PP On Windows, the following attributes may be set. .TP -\fB\-alpha\fR -.VS 8.5 -Specifies the alpha transparency level of the toplevel. -It accepts a value from \fB0.0\fR (fully transparent) to \fB1.0\fR -(opaque). Values outside that range will be constrained. This is -supported on Windows 2000/XP+. Where not supported, the \fB\-alpha\fR -value remains at \fB1.0\fR. -.VE 8.5 -.TP \fB\-disabled\fR +. Specifies whether the window is in a disabled state. .TP \fB\-toolwindow\fR +. Specifies a toolwindow style window (as defined in the MSDN). .TP \fB\-transparentcolor\fR -.VS 8.5 +. Specifies the transparent color index of the toplevel. It takes any color value accepted by \fBTk_GetColor\fR. If the empty string is specified (default), no transparent color is used. This is supported on Windows 2000/XP+. Where not supported, the \fB\-transparentcolor\fR value remains at \fB{}\fR. -.VE 8.5 .PP On Mac OS X, the following attributes may be set. .TP -\fB\-alpha\fR -Specifies the alpha transparency level of the window. -It accepts a value from \fB0.0\fR (fully transparent) to \fB1.0\fR (opaque), -values outside that range will be constrained. -.TP \fB\-modified\fR +. Specifies the modification state of the window (determines whether the window close widget contains the modification indicator and whether the proxy icon is draggable). .TP \fB\-notify\fR +. Specifies process notification state (bouncing of the application dock icon). .TP \fB\-titlepath\fR +. Specifies the path of the file referenced as the window proxy icon (which can be dragged and dropped in lieu of the file's finder icon). .TP \fB\-transparent\fR +. Makes the window content area transparent and turns off the window shadow. For -the transparency to be effecive, the toplevel background needs to be set to a +the transparency to be effective, the toplevel background needs to be set to a color with some alpha, e.g. .QW systemTransparent . .PP -On X11, the following attributes may be set. -These are not supported by all window managers, -and will have no effect under older WMs. +On X11, the following attributes may be set. These are not supported by all +window managers, and will have no effect under older WMs. .\" See http://www.freedesktop.org/Standards/wm-spec .TP +\fB\-type\fR +.VS 8.6 +Requests that the window should be interpreted by the window manager as being +of the specified type(s). This may cause the window to be decorated in a +different way or otherwise managed differently, though exactly what happens is +entirely up to the window manager. A list of types may be used, in order of +preference. The following values are mapped to constants defined in the EWMH +specification (using others is possible, but not advised): +.RS +.TP +\fBdesktop\fR +. +indicates a desktop feature, +.TP +\fBdock\fR +. +indicates a dock/panel feature, +.TP +\fBtoolbar\fR +. +indicates a toolbar window that should be acting on behalf of another window, +as indicated with \fBwm transient\fR, +.TP +\fBmenu\fR +. +indicates a torn-off menu that should be acting on behalf of another window, +as indicated with \fBwm transient\fR, +.TP +\fButility\fR +. +indicates a utility window (e.g., palette or toolbox) that should be acting on +behalf of another window, as indicated with \fBwm transient\fR, +.TP +\fBsplash\fR +. +indicates a splash screen, displayed during application start up, +.TP +\fBdialog\fR +. +indicates a general dialog window, that should be acting on behalf of another +window, as indicated with \fBwm transient\fR, +.TP +\fBdropdown_menu\fR +. +indicates a menu summoned from a menu bar, which should usually also be set to +be override-redirected (with \fBwm overrideredirect\fR), +.TP +\fBpopup_menu\fR +. +indicates a popup menu, which should usually also be set to be +override-redirected (with \fBwm overrideredirect\fR), +.TP +\fBtooltip\fR +. +indicates a tooltip window, which should usually also be set to be +override-redirected (with \fBwm overrideredirect\fR), +.TP +\fBnotification\fR +. +indicates a window that provides a background notification of some event, +which should usually also be set to be override-redirected (with \fBwm +overrideredirect\fR), +.TP +\fBcombo\fR +. +indicates the drop-down list of a combobox widget, which should usually also +be set to be override-redirected (with \fBwm overrideredirect\fR), +.TP +\fBdnd\fR +. +indicates a window that represents something being dragged, which should +usually also be set to be override-redirected (with +\fBwm overrideredirect\fR), +.TP +\fBnormal\fR +. +indicates a window that has no special interpretation. +.RE +.VE 8.6 +.TP \fB\-zoomed\fR -Requests that the window should be maximized. -This is the same as \fBwm state zoomed\fR on Windows and Mac OS X. +. +Requests that the window should be maximized. This is the same as \fBwm state +zoomed\fR on Windows and Mac OS X. .PP -On X11, changes to window attributes are performed asynchronously. -Querying the value of an attribute returns the current state, -which will not be the same as the value most recently set -if the window manager has not yet processed the request -or if it does not support the attribute. +On X11, changes to window attributes are performed asynchronously. Querying +the value of an attribute returns the current state, which will not be the +same as the value most recently set if the window manager has not yet +processed the request or if it does not support the attribute. .RE .TP \fBwm client \fIwindow\fR ?\fIname\fR? +. If \fIname\fR is specified, this command stores \fIname\fR (which should be the name of the host on which the application is executing) in \fIwindow\fR's @@ -145,6 +227,7 @@ If \fIname\fR is specified as an empty string, the command deletes the \fBWM_CLIENT_MACHINE\fR property from \fIwindow\fR. .TP \fBwm colormapwindows \fIwindow\fR ?\fIwindowList\fR? +. This command is used to manipulate the \fBWM_COLORMAP_WINDOWS\fR property, which provides information to the window managers about windows that have private colormaps. @@ -175,6 +258,7 @@ See the ICCCM documentation for more information on the .RE .TP \fBwm command \fIwindow\fR ?\fIvalue\fR? +. If \fIvalue\fR is specified, this command stores \fIvalue\fR in \fIwindow\fR's \fBWM_COMMAND\fR property for use by the window manager or session manager and returns an empty string. @@ -186,6 +270,7 @@ If \fIvalue\fR is specified as an empty string, the command deletes the \fBWM_COMMAND\fR property from \fIwindow\fR. .TP \fBwm deiconify \fIwindow\fR +. Arrange for \fIwindow\fR to be displayed in normal (non-iconified) form. This is done by mapping the window. If the window has never been mapped then this command will not map the window, but it will ensure @@ -195,6 +280,7 @@ raised and be given the focus (made the active window). Returns an empty string. .TP \fBwm focusmodel \fIwindow\fR ?\fBactive\fR|\fBpassive\fR? +. If \fBactive\fR or \fBpassive\fR is supplied as an optional argument to the command, then it specifies the focus model for \fIwindow\fR. In this case the command returns an empty string. If no additional @@ -214,6 +300,7 @@ assumes a passive model of focusing. .RE .TP \fBwm forget \fIwindow\fR +. The \fIwindow\fR will be unmapped from the screen and will no longer be managed by \fBwm\fR. Windows created with the \fBtoplevel\fR command will be treated like \fBframe\fR windows once they are no @@ -221,6 +308,7 @@ longer managed by \fBwm\fR, however, the \fB\-menu\fR configuration will be remembered and the menus will return once the widget is managed again. .TP \fBwm frame \fIwindow\fR +. If \fIwindow\fR has been reparented by the window manager into a decorative frame, the command returns the platform specific window identifier for the outermost frame that contains \fIwindow\fR (the @@ -229,6 +317,7 @@ has not been reparented by the window manager then the command returns the platform specific window identifier for \fIwindow\fR. .TP \fBwm geometry \fIwindow\fR ?\fInewGeometry\fR? +. If \fInewGeometry\fR is specified, then the geometry of \fIwindow\fR is changed and an empty string is returned. Otherwise the current geometry for \fIwindow\fR is returned (this is the most recent @@ -272,6 +361,7 @@ made through this command. .RE .TP \fBwm grid \fIwindow\fR ?\fIbaseWidth baseHeight widthInc heightInc\fR? +. This command indicates that \fIwindow\fR is to be managed as a gridded window. It also specifies the relationship between grid units and pixel units. @@ -307,6 +397,7 @@ provide easier access to the same functionality. .RE .TP \fBwm group \fIwindow\fR ?\fIpathName\fR? +. If \fIpathName\fR is specified, it gives the path name for the leader of a group of related windows. The window manager may use this information, for example, to unmap all of the windows in a group when the group's @@ -317,6 +408,7 @@ returns the path name of \fIwindow\fR's current group leader, or an empty string if \fIwindow\fR is not part of any group. .TP \fBwm iconbitmap \fIwindow\fR ?\fIbitmap\fR? +. If \fIbitmap\fR is specified, then it names a bitmap in the standard forms accepted by Tk (see the \fBTk_GetBitmap\fR manual entry for details). This bitmap is passed to the window manager to be displayed in @@ -327,10 +419,11 @@ If \fIbitmap\fR is specified then the command returns an empty string. Otherwise it returns the name of the current icon bitmap associated with \fIwindow\fR, or an empty string if \fIwindow\fR has no icon bitmap. On the Windows operating -system, an additional flag is supported: +system, an additional flag is supported: .RS .TP \fBwm iconbitmap \fIwindow\fR ?\fB\-default\fR? ?\fIimage\fR? +. If the \fB\-default\fR flag is given, the icon is applied to all toplevel windows (existing and future) to which no other specific icon has yet been applied. @@ -344,11 +437,13 @@ a bitmap. .RE .TP \fBwm iconify \fIwindow\fR +. Arrange for \fIwindow\fR to be iconified. It \fIwindow\fR has not yet been mapped for the first time, this command will arrange for it to appear in the iconified state when it is eventually mapped. .TP \fBwm iconmask \fIwindow\fR ?\fIbitmap\fR? +. If \fIbitmap\fR is specified, then it names a bitmap in the standard forms accepted by Tk (see the \fBTk_GetBitmap\fR manual entry for details). This bitmap is passed to the window manager to be used as a mask @@ -363,6 +458,7 @@ returns the name of the current icon mask associated with \fIwindow\fR, or an empty string if no mask is in effect. .TP \fBwm iconname \fIwindow\fR ?\fInewName\fR? +. If \fInewName\fR is specified, then it is passed to the window manager; the window manager should display \fInewName\fR inside the icon associated with \fIwindow\fR. In this case an empty @@ -371,9 +467,9 @@ then the command returns the current icon name for \fIwindow\fR, or an empty string if no icon name has been specified (in this case the window manager will normally display the window's title, as specified with the \fBwm title\fR command). -.VS 8.5 .TP \fBwm iconphoto \fIwindow\fR ?\fB\-default\fR? \fIimage1\fR ?\fIimage2 ...\fR? +. Sets the titlebar icon for \fIwindow\fR based on the named photo images. If \fB\-default\fR is specified, this is applied to all future created toplevels as well. The data in the images is taken as a snapshot at the @@ -393,10 +489,10 @@ simultaneously. It is recommended to use not more than 2 icons, placing the larger icon first. .PP On Macintosh, this currently does nothing. -.VE 8.5 .RE .TP \fBwm iconposition \fIwindow\fR ?\fIx y\fR? +. If \fIx\fR and \fIy\fR are specified, they are passed to the window manager as a hint about where to position the icon for \fIwindow\fR. In this case an empty string is returned. If \fIx\fR and \fIy\fR are @@ -406,6 +502,7 @@ a Tcl list containing two values, which are the current icon position hints (if no hints are in effect then an empty string is returned). .TP \fBwm iconwindow \fIwindow\fR ?\fIpathName\fR? +. If \fIpathName\fR is specified, it is the path name for a window to use as icon for \fIwindow\fR: when \fIwindow\fR is iconified then \fIpathName\fR will be mapped to serve as icon, and when \fIwindow\fR @@ -423,6 +520,7 @@ those events. Note: not all window managers support the notion of an icon window. .TP \fBwm manage \fIwidget\fR +. The \fIwidget\fR specified will become a stand alone top-level window. The window will be decorated with the window managers title bar, etc. Only \fIframe\fR, \fIlabelframe\fR and \fItoplevel\fR widgets can be used @@ -431,6 +529,7 @@ an error. Attempting to manage a \fItoplevel\fR widget is benign and achieves nothing. See also \fBGEOMETRY MANAGEMENT\fR. .TP \fBwm maxsize \fIwindow\fR ?\fIwidth height\fR? +. If \fIwidth\fR and \fIheight\fR are specified, they give the maximum permissible dimensions for \fIwindow\fR. For gridded windows the dimensions are specified in @@ -445,6 +544,7 @@ The maximum size defaults to the size of the screen. See the sections on geometry management below for more information. .TP \fBwm minsize \fIwindow\fR ?\fIwidth height\fR? +. If \fIwidth\fR and \fIheight\fR are specified, they give the minimum permissible dimensions for \fIwindow\fR. For gridded windows the dimensions are specified in @@ -459,6 +559,7 @@ The minimum size defaults to one pixel in each dimension. See the sections on geometry management below for more information. .TP \fBwm overrideredirect \fIwindow\fR ?\fIboolean\fR? +. If \fIboolean\fR is specified, it must have a proper boolean form and the override-redirect flag for \fIwindow\fR is set to that value. If \fIboolean\fR is not specified then \fB1\fR or \fB0\fR is @@ -469,8 +570,16 @@ it to be ignored by the window manager; among other things, this means that the window will not be reparented from the root window into a decorative frame and the user will not be able to manipulate the window using the normal window manager mechanisms. +.RS +.PP +Note that the override-redirect flag is only guaranteed to be taken notice of +when the window is first mapped or when mapped after the state is changed from +withdrawn to normal. Some, but not all, platforms will take notice at +additional times. +.RE .TP \fBwm positionfrom \fIwindow\fR ?\fIwho\fR? +. If \fIwho\fR is specified, it must be either \fBprogram\fR or \fBuser\fR, or an abbreviation of one of these two. It indicates whether \fIwindow\fR's current position was requested by the @@ -491,6 +600,7 @@ when a \fBwm geometry\fR command is invoked, unless the source has been set explicitly to \fBprogram\fR. .TP \fBwm protocol \fIwindow\fR ?\fIname\fR? ?\fIcommand\fR? +. This command is used to manage window manager protocols such as \fBWM_DELETE_WINDOW\fR. \fIName\fR is the name of an atom corresponding to a window manager @@ -524,6 +634,7 @@ which it was received. .RE .TP \fBwm resizable \fIwindow\fR ?\fIwidth height\fR? +. This command controls whether or not the user may interactively resize a top-level window. If \fIwidth\fR and \fIheight\fR are specified, they are boolean values that determine whether the @@ -539,6 +650,7 @@ command. If there has been no such operation then the window's natural size will be used. .TP \fBwm sizefrom \fIwindow\fR ?\fIwho\fR? +. If \fIwho\fR is specified, it must be either \fBprogram\fR or \fBuser\fR, or an abbreviation of one of these two. It indicates whether \fIwindow\fR's current size was requested by the @@ -556,6 +668,7 @@ no source has been specified yet. Most window managers interpret as equivalent to \fBprogram\fR. .TP \fBwm stackorder \fIwindow\fR ?\fBisabove\fR|\fBisbelow \fIwindow\fR? +. The \fBstackorder\fR command returns a list of toplevel windows in stacking order, from lowest to highest. When a single toplevel window is passed, the returned list recursively includes all of the @@ -569,6 +682,7 @@ or not the first window is currently above or below the second window in the stacking order. .TP \fBwm state \fIwindow\fR ?newstate? +. If \fInewstate\fR is specified, the window will be set to the new state, otherwise it returns the current state of \fIwindow\fR: either \fBnormal\fR, \fBiconic\fR, \fBwithdrawn\fR, \fBicon\fR, or (Windows and Mac @@ -580,6 +694,7 @@ purpose is to serve as the icon for some other window (via the \fBwm iconwindow\fR command). The \fBicon\fR state cannot be set. .TP \fBwm title \fIwindow\fR ?\fIstring\fR? +. If \fIstring\fR is specified, then it will be passed to the window manager for use as the title for \fIwindow\fR (the window manager should display this string in \fIwindow\fR's title bar). In this @@ -588,6 +703,7 @@ specified then the command returns the current title for the \fIwindow\fR. The title for a window defaults to its name. .TP \fBwm transient \fIwindow\fR ?\fImaster\fR? +. If \fImaster\fR is specified, then the window manager is informed that \fIwindow\fR is a transient window (e.g. pull-down menu) working on behalf of \fImaster\fR (where \fImaster\fR is the @@ -599,8 +715,12 @@ empty string if \fIwindow\fR is not currently a transient window. A transient window will mirror state changes in the master and inherit the state of the master when initially mapped. It is an error to attempt to make a window a transient of itself. +The window manager may also decorate a transient window differently, removing +some features normally present (e.g., minimize and maximize buttons) though +this is entirely at the discretion of the window manager. .TP \fBwm withdraw \fIwindow\fR +. Arranges for \fIwindow\fR to be withdrawn from the screen. This causes the window to be unmapped and forgotten about by the window manager. If the window @@ -693,6 +813,7 @@ operation of the \fBwm\fR command. For example, some changes will not take effect if the window is already active: the window will have to be withdrawn and de-iconified in order to make the change happen. .SH EXAMPLES +.PP A fixed-size window that says that it is fixed-size too: .CS toplevel .fixed @@ -727,3 +848,6 @@ set y [expr {([winfo screenheight .]\-[winfo height .msg])/2}] toplevel(n), winfo(n) .SH KEYWORDS aspect ratio, deiconify, focus model, geometry, grid, group, icon, iconify, increments, position, size, title, top-level window, units, window manager +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/generic/default.h b/generic/default.h index 6156f4d..e6ef132 100644 --- a/generic/default.h +++ b/generic/default.h @@ -14,8 +14,7 @@ #ifndef _DEFAULT #define _DEFAULT -#if defined(__WIN32__) || defined(_WIN32) || \ - defined(__MINGW32__) +#ifdef _WIN32 # include "tkWinDefault.h" #else # if defined(MAC_OSX_TK) diff --git a/generic/tk.decls b/generic/tk.decls index 2825111..9ceb3af 100644 --- a/generic/tk.decls +++ b/generic/tk.decls @@ -20,6 +20,7 @@ library tk interface tk hooks {tkPlat tkInt tkIntPlat tkIntXlib} +scspec EXTERN # Declare each of the functions in the public Tk interface. Note that # the an index should never be reused for a different function in order @@ -104,7 +105,7 @@ declare 18 { Tk_Window tkwin, const char *value, char *widgRec, int offset) } declare 19 { - char *Tk_CanvasTagsPrintProc(ClientData clientData, Tk_Window tkwin, + CONST86 char *Tk_CanvasTagsPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr) } declare 20 { @@ -127,24 +128,24 @@ declare 24 { } declare 25 { int Tk_ClipboardAppend(Tcl_Interp *interp, Tk_Window tkwin, - Atom target, Atom format, char *buffer) + Atom target, Atom format, const char *buffer) } declare 26 { int Tk_ClipboardClear(Tcl_Interp *interp, Tk_Window tkwin) } declare 27 { int Tk_ConfigureInfo(Tcl_Interp *interp, - Tk_Window tkwin, Tk_ConfigSpec *specs, + Tk_Window tkwin, const Tk_ConfigSpec *specs, char *widgRec, const char *argvName, int flags) } declare 28 { int Tk_ConfigureValue(Tcl_Interp *interp, - Tk_Window tkwin, Tk_ConfigSpec *specs, + Tk_Window tkwin, const Tk_ConfigSpec *specs, char *widgRec, const char *argvName, int flags) } declare 29 { int Tk_ConfigureWidget(Tcl_Interp *interp, - Tk_Window tkwin, Tk_ConfigSpec *specs, + Tk_Window tkwin, const Tk_ConfigSpec *specs, int argc, CONST84 char **argv, char *widgRec, int flags) } @@ -164,7 +165,7 @@ declare 32 { declare 33 { unsigned long Tk_CreateBinding(Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, - const char *eventStr, const char *command, int append) + const char *eventStr, const char *script, int append) } declare 34 { Tk_BindingTable Tk_CreateBindingTable(Tcl_Interp *interp) @@ -183,13 +184,13 @@ declare 37 { void Tk_CreateGenericHandler(Tk_GenericProc *proc, ClientData clientData) } declare 38 { - void Tk_CreateImageType(Tk_ImageType *typePtr) + void Tk_CreateImageType(const Tk_ImageType *typePtr) } declare 39 { void Tk_CreateItemType(Tk_ItemType *typePtr) } declare 40 { - void Tk_CreatePhotoImageFormat(Tk_PhotoImageFormat *formatPtr) + void Tk_CreatePhotoImageFormat(const Tk_PhotoImageFormat *formatPtr) } declare 41 { void Tk_CreateSelHandler(Tk_Window tkwin, @@ -207,7 +208,7 @@ declare 43 { } declare 44 { int Tk_DefineBitmap(Tcl_Interp *interp, const char *name, - const char *source, int width, int height) + const void *source, int width, int height) } declare 45 { void Tk_DefineCursor(Tk_Window window, Tk_Cursor cursor) @@ -316,7 +317,7 @@ declare 73 { void Tk_FreeImage(Tk_Image image) } declare 74 { - void Tk_FreeOptions(Tk_ConfigSpec *specs, + void Tk_FreeOptions(const Tk_ConfigSpec *specs, char *widgRec, Display *display, int needFlags) } declare 75 { @@ -359,7 +360,7 @@ declare 85 { } declare 86 { Pixmap Tk_GetBitmapFromData(Tcl_Interp *interp, - Tk_Window tkwin, const char *source, int width, int height) + Tk_Window tkwin, const void *source, int width, int height) } declare 87 { int Tk_GetCapStyle(Tcl_Interp *interp, const char *str, int *capPtr) @@ -403,7 +404,7 @@ declare 97 { } declare 98 { ClientData Tk_GetImageMasterData(Tcl_Interp *interp, - const char *name, Tk_ImageType **typePtrPtr) + const char *name, CONST86 Tk_ImageType **typePtrPtr) } declare 99 { Tk_ItemType *Tk_GetItemTypes(void) @@ -561,7 +562,7 @@ declare 142 { declare 143 { int Tk_ParseArgv(Tcl_Interp *interp, Tk_Window tkwin, int *argcPtr, CONST84 char **argv, - Tk_ArgvInfo *argTable, int flags) + const Tk_ArgvInfo *argTable, int flags) } declare 144 { void Tk_PhotoPutBlock_NoComposite(Tk_PhotoHandle handle, @@ -824,7 +825,7 @@ declare 216 { int Tk_CreateConsoleWindow(Tcl_Interp *interp) } declare 217 { - void Tk_CreateSmoothMethod(Tcl_Interp *interp, Tk_SmoothMethod *method) + void Tk_CreateSmoothMethod(Tcl_Interp *interp, const Tk_SmoothMethod *method) } #declare 218 { # void Tk_CreateCanvasVisitor(Tcl_Interp *interp, void *typePtr) @@ -923,7 +924,7 @@ declare 241 { } declare 242 { void Tk_SetClassProcs(Tk_Window tkwin, - Tk_ClassProcs *procs, ClientData instanceData) + const Tk_ClassProcs *procs, ClientData instanceData) } # New in 8.4a4 @@ -1062,13 +1063,10 @@ declare 271 { # Developers who need to produce a file [load]able into legacy interps must # build against legacy sources. declare 272 { - void Tk_CreateOldImageType(Tk_ImageType *typePtr) + void Tk_CreateOldImageType(const Tk_ImageType *typePtr) } declare 273 { - void Tk_CreateOldPhotoImageFormat(Tk_PhotoImageFormat *formatPtr) -} -declare 275 { - void TkUnusedStubEntry(void) + void Tk_CreateOldPhotoImageFormat(const Tk_PhotoImageFormat *formatPtr) } # Define the platform specific public Tk interface. These functions are @@ -1147,31 +1145,9 @@ declare 10 aqua { # Public functions that are not accessible via the stubs table. export { - const char *Tk_InitStubs(Tcl_Interp *interp, const char *version, - int exact) -} -export { const char *Tk_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact) } - -# Global variables that need to be exported from the tcl shared library. - -export { - TkStubs *tkStubsPtr (fool checkstubs) -} -export { - TkPlatStubs *tkPlatStubsPtr (fool checkstubs) -} -export { - TkIntStubs *tkIntStubsPtr (fool checkstubs) -} -export { - TkIntPlatStubs *tkIntPlatStubsPtr (fool checkstubs) -} -export { - TkIntXlibStubs *tkIntXlibStubsPtr (fool checkstubs) -} # Local Variables: # mode: tcl diff --git a/generic/tk.h b/generic/tk.h index e356ce5..4a655a4 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -17,18 +17,35 @@ #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 or better +#if (TCL_MAJOR_VERSION != 8) || (TCL_MINOR_VERSION < 6) +# error Tk 8.6 must be compiled with tcl.h from Tcl 8.6 or better #endif -#ifndef _ANSI_ARGS_ -# ifndef NO_PROTOTYPES -# define _ANSI_ARGS_(x) x -# else -# define _ANSI_ARGS_(x) () -# endif +#ifndef CONST84 +# define CONST84 const +# define CONST84_RETURN const #endif - +#ifndef CONST86 +# define CONST86 CONST84 +#endif +#ifndef EXTERN +# define EXTERN extern TCL_STORAGE_CLASS +#endif + +/* + * Utility macros: STRINGIFY takes an argument and wraps it in "" (double + * quotation marks), JOIN joins two arguments. + */ + +#ifndef STRINGIFY +# define STRINGIFY(x) STRINGIFY1(x) +# define STRINGIFY1(x) #x +#endif +#ifndef JOIN +# define JOIN(a,b) JOIN1(a,b) +# define JOIN1(a,b) a##b +#endif + /* * For C++ compilers, use extern "C" */ @@ -45,8 +62,7 @@ extern "C" { * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.in (as above) * README (sections 0 and 1) - * macosx/Wish.xcode/project.pbxproj (not patchlevel) 1 LOC - * macosx/Wish-Common.xcconfig (not patchlevel) 1 LOC + * macosx/Tk-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) * unix/README (not patchlevel) * unix/tk.spec (1 LOC patch) @@ -57,13 +73,13 @@ extern "C" { */ #define TK_MAJOR_VERSION 8 -#define TK_MINOR_VERSION 5 +#define TK_MINOR_VERSION 6 #define TK_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TK_RELEASE_SERIAL 18 - -#define TK_VERSION "8.5" -#define TK_PATCH_LEVEL "8.5.18" +#define TK_RELEASE_SERIAL 4 +#define TK_VERSION "8.6" +#define TK_PATCH_LEVEL "8.6.4" + /* * A special definition used to allow this header file to be included from * windows or mac resource files so that they can obtain version information. @@ -190,7 +206,7 @@ typedef struct Tk_OptionSpec { * the record. */ int flags; /* Any combination of the values defined * below. */ - ClientData clientData; /* An alternate place to put option-specific + const void *clientData; /* An alternate place to put option-specific * data. Used for the monochrome default value * for colors, etc. */ int typeMask; /* An arbitrary bit mask defined by the class @@ -216,15 +232,15 @@ typedef struct Tk_OptionSpec { * option config code to handle a custom option. */ -typedef int (Tk_CustomOptionSetProc) _ANSI_ARGS_((ClientData clientData, +typedef int (Tk_CustomOptionSetProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj **value, char *widgRec, - int offset, char *saveInternalPtr, int flags)); -typedef Tcl_Obj *(Tk_CustomOptionGetProc) _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin, char *widgRec, int offset)); -typedef void (Tk_CustomOptionRestoreProc) _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin, char *internalPtr, char *saveInternalPtr)); -typedef void (Tk_CustomOptionFreeProc) _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin, char *internalPtr)); + int offset, char *saveInternalPtr, int flags); +typedef Tcl_Obj *(Tk_CustomOptionGetProc) (ClientData clientData, + Tk_Window tkwin, char *widgRec, int offset); +typedef void (Tk_CustomOptionRestoreProc) (ClientData clientData, + Tk_Window tkwin, char *internalPtr, char *saveInternalPtr); +typedef void (Tk_CustomOptionFreeProc) (ClientData clientData, Tk_Window tkwin, + char *internalPtr); typedef struct Tk_ObjCustomOption { const char *name; /* Name of the custom option. */ @@ -318,12 +334,10 @@ typedef struct Tk_SavedOptions { #ifndef __NO_OLD_CONFIG -typedef int (Tk_OptionParseProc) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, Tk_Window tkwin, CONST84 char *value, char *widgRec, - int offset)); -typedef char *(Tk_OptionPrintProc) _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin, char *widgRec, int offset, - Tcl_FreeProc **freeProcPtr)); +typedef int (Tk_OptionParseProc) (ClientData clientData, Tcl_Interp *interp, + Tk_Window tkwin, CONST84 char *value, char *widgRec, int offset); +typedef CONST86 char *(Tk_OptionPrintProc) (ClientData clientData, + Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); typedef struct Tk_CustomOption { Tk_OptionParseProc *parseProc; @@ -348,7 +362,7 @@ typedef struct Tk_ConfigSpec { int type; /* Type of option, such as TK_CONFIG_COLOR; * see definitions below. Last option in table * must have type TK_CONFIG_END. */ - char *argvName; /* Switch used to specify option in argv. NULL + CONST86 char *argvName; /* Switch used to specify option in argv. NULL * means this spec is part of a group. */ Tk_Uid dbName; /* Name for option in option database. */ Tk_Uid dbClass; /* Class for option in database. */ @@ -360,7 +374,8 @@ typedef struct Tk_ConfigSpec { int specFlags; /* Any combination of the values defined * below; other bits are used internally by * tkConfig.c. */ - Tk_CustomOption *customPtr; /* If type is TK_CONFIG_CUSTOM then this is a + CONST86 Tk_CustomOption *customPtr; + /* If type is TK_CONFIG_CUSTOM then this is a * pointer to info about how to parse and * print the option. Otherwise it is * irrelevant. */ @@ -408,14 +423,14 @@ typedef enum { */ typedef struct { - char *key; /* The key string that flags the option in the + CONST86 char *key; /* The key string that flags the option in the * argv array. */ int type; /* Indicates option type; see below. */ char *src; /* Value to be used in setting dst; usage * depends on type. */ char *dst; /* Address of value to be modified; usage * depends on type. */ - char *help; /* Documentation message describing this + CONST86 char *help; /* Documentation message describing this * option. */ } Tk_ArgvInfo; @@ -554,11 +569,10 @@ typedef struct Tk_FontMetrics { * behavior. */ -typedef Window (Tk_ClassCreateProc) _ANSI_ARGS_((Tk_Window tkwin, - Window parent, ClientData instanceData)); -typedef void (Tk_ClassWorldChangedProc) _ANSI_ARGS_((ClientData instanceData)); -typedef void (Tk_ClassModalProc) _ANSI_ARGS_((Tk_Window tkwin, - XEvent *eventPtr)); +typedef Window (Tk_ClassCreateProc) (Tk_Window tkwin, Window parent, + ClientData instanceData); +typedef void (Tk_ClassWorldChangedProc) (ClientData instanceData); +typedef void (Tk_ClassModalProc) (Tk_Window tkwin, XEvent *eventPtr); typedef struct Tk_ClassProcs { unsigned int size; @@ -599,10 +613,8 @@ typedef struct Tk_ClassProcs { * the geometry manager to carry out certain functions. */ -typedef void (Tk_GeomRequestProc) _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin)); -typedef void (Tk_GeomLostSlaveProc) _ANSI_ARGS_((ClientData clientData, - Tk_Window tkwin)); +typedef void (Tk_GeomRequestProc) (ClientData clientData, Tk_Window tkwin); +typedef void (Tk_GeomLostSlaveProc) (ClientData clientData, Tk_Window tkwin); typedef struct Tk_GeomMgr { const char *name; /* Name of the geometry manager (command used @@ -801,6 +813,7 @@ typedef struct Tk_FakeWin { int internalBorderBottom; int minReqWidth; int minReqHeight; + char *dummy20; /* geometryMaster */ } Tk_FakeWin; /* @@ -843,9 +856,6 @@ typedef struct Tk_FakeWin { * embedded application), and both the containing * and embedded halves are associated with * windows in this particular process. - * TK_DEFER_MODAL: 1 means that this window has deferred a modal - * loop until all of the bindings for the current - * event have been invoked. * TK_WRAPPER: 1 means that this window is the extra wrapper * window created around a toplevel to hold the * menubar under Unix. See tkUnixWm.c for more @@ -882,7 +892,6 @@ typedef struct Tk_FakeWin { #define TK_EMBEDDED 0x100 #define TK_CONTAINER 0x200 #define TK_BOTH_HALVES 0x400 -#define TK_DEFER_MODAL 0x800 #define TK_WRAPPER 0x1000 #define TK_REPARENTED 0x2000 #define TK_ANONYMOUS_WINDOW 0x4000 @@ -906,13 +915,11 @@ typedef enum { } Tk_State; typedef struct Tk_SmoothMethod { - char *name; - int (*coordProc) _ANSI_ARGS_((Tk_Canvas canvas, - double *pointPtr, int numPoints, int numSteps, - XPoint xPoints[], double dblPoints[])); - void (*postscriptProc) _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, double *coordPtr, - int numPoints, int numSteps)); + CONST86 char *name; + int (*coordProc) (Tk_Canvas canvas, double *pointPtr, int numPoints, + int numSteps, XPoint xPoints[], double dblPoints[]); + void (*postscriptProc) (Tcl_Interp *interp, Tk_Canvas canvas, + double *coordPtr, int numPoints, int numSteps); } Tk_SmoothMethod; /* @@ -981,66 +988,69 @@ typedef struct Tk_Item { */ #ifdef USE_OLD_CANVAS -typedef int Tk_ItemCreateProc _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - char **argv)); -typedef int Tk_ItemConfigureProc _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - char **argv, int flags)); -typedef int Tk_ItemCoordProc _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - char **argv)); +typedef int (Tk_ItemCreateProc)(Tcl_Interp *interp, Tk_Canvas canvas, + Tk_Item *itemPtr, int argc, char **argv); +typedef int (Tk_ItemConfigureProc)(Tcl_Interp *interp, Tk_Canvas canvas, + Tk_Item *itemPtr, int argc, char **argv, int flags); +typedef int (Tk_ItemCoordProc)(Tcl_Interp *interp, Tk_Canvas canvas, + Tk_Item *itemPtr, int argc, char **argv); #else -typedef int Tk_ItemCreateProc _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *const objv[])); -typedef int Tk_ItemConfigureProc _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *const objv[], int flags)); -typedef int Tk_ItemCoordProc _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *const argv[])); -#endif -typedef void Tk_ItemDeleteProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, Display *display)); -typedef void Tk_ItemDisplayProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, Display *display, Drawable dst, - int x, int y, int width, int height)); -typedef double Tk_ItemPointProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, double *pointPtr)); -typedef int Tk_ItemAreaProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, double *rectPtr)); -typedef int Tk_ItemPostscriptProc _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, int prepass)); -typedef void Tk_ItemScaleProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, double originX, double originY, - double scaleX, double scaleY)); -typedef void Tk_ItemTranslateProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, double deltaX, double deltaY)); -typedef int Tk_ItemIndexProc _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Canvas canvas, Tk_Item *itemPtr, char *indexString, - int *indexPtr)); -typedef void Tk_ItemCursorProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, int index)); -typedef int Tk_ItemSelectionProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, int offset, char *buffer, - int maxBytes)); -typedef void Tk_ItemInsertProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, int beforeThis, char *string)); -typedef void Tk_ItemDCharsProc _ANSI_ARGS_((Tk_Canvas canvas, - Tk_Item *itemPtr, int first, int last)); +typedef int (Tk_ItemCreateProc)(Tcl_Interp *interp, Tk_Canvas canvas, + Tk_Item *itemPtr, int argc, Tcl_Obj *const objv[]); +typedef int (Tk_ItemConfigureProc)(Tcl_Interp *interp, Tk_Canvas canvas, + Tk_Item *itemPtr, int argc, Tcl_Obj *const objv[], + int flags); +typedef int (Tk_ItemCoordProc)(Tcl_Interp *interp, Tk_Canvas canvas, + Tk_Item *itemPtr, int argc, Tcl_Obj *const argv[]); +#endif /* USE_OLD_CANVAS */ +typedef void (Tk_ItemDeleteProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + Display *display); +typedef void (Tk_ItemDisplayProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + Display *display, Drawable dst, int x, int y, int width, + int height); +typedef double (Tk_ItemPointProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + double *pointPtr); +typedef int (Tk_ItemAreaProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + double *rectPtr); +typedef int (Tk_ItemPostscriptProc)(Tcl_Interp *interp, Tk_Canvas canvas, + Tk_Item *itemPtr, int prepass); +typedef void (Tk_ItemScaleProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + double originX, double originY, double scaleX, + double scaleY); +typedef void (Tk_ItemTranslateProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + double deltaX, double deltaY); +#ifdef USE_OLD_CANVAS +typedef int (Tk_ItemIndexProc)(Tcl_Interp *interp, Tk_Canvas canvas, + Tk_Item *itemPtr, char *indexString, int *indexPtr); +#else +typedef int (Tk_ItemIndexProc)(Tcl_Interp *interp, Tk_Canvas canvas, + Tk_Item *itemPtr, Tcl_Obj *indexString, int *indexPtr); +#endif /* USE_OLD_CANVAS */ +typedef void (Tk_ItemCursorProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + int index); +typedef int (Tk_ItemSelectionProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + int offset, char *buffer, int maxBytes); +#ifdef USE_OLD_CANVAS +typedef void (Tk_ItemInsertProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + int beforeThis, char *string); +#else +typedef void (Tk_ItemInsertProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + int beforeThis, Tcl_Obj *string); +#endif /* USE_OLD_CANVAS */ +typedef void (Tk_ItemDCharsProc)(Tk_Canvas canvas, Tk_Item *itemPtr, + int first, int last); #ifndef __NO_OLD_CONFIG typedef struct Tk_ItemType { - char *name; /* The name of this type of item, such as + CONST86 char *name; /* The name of this type of item, such as * "line". */ int itemSize; /* Total amount of space needed for item's * record. */ Tk_ItemCreateProc *createProc; /* Procedure to create a new item of this * type. */ - Tk_ConfigSpec *configSpecs; /* Pointer to array of configuration specs for + CONST86 Tk_ConfigSpec *configSpecs; /* Pointer to array of configuration specs for * this type. Used for returning configuration * info. */ Tk_ItemConfigureProc *configProc; @@ -1089,7 +1099,14 @@ typedef struct Tk_ItemType { char *reserved4; } Tk_ItemType; -#endif +/* + * Flag (used in the alwaysRedraw field) to say whether an item supports + * point-level manipulation like the line and polygon items. + */ + +#define TK_MOVABLE_POINTS 2 + +#endif /* __NO_OLD_CONFIG */ /* * The following structure provides information about the selection and the @@ -1175,9 +1192,9 @@ typedef struct Tk_Outline { Tk_Dash dash; /* Dash pattern. */ Tk_Dash activeDash; /* Dash pattern if state is active. */ Tk_Dash disabledDash; /* Dash pattern if state is disabled. */ - VOID *reserved1; /* Reserved for future expansion. */ - VOID *reserved2; - VOID *reserved3; + void *reserved1; /* Reserved for future expansion. */ + void *reserved2; + void *reserved3; Tk_TSOffset tsoffset; /* Stipple offset for outline. */ XColor *color; /* Outline color. */ XColor *activeColor; /* Outline color if state is active. */ @@ -1199,28 +1216,25 @@ typedef struct Tk_Outline { typedef struct Tk_ImageType Tk_ImageType; #ifdef USE_OLD_IMAGE -typedef int (Tk_ImageCreateProc) _ANSI_ARGS_((Tcl_Interp *interp, - char *name, int argc, char **argv, Tk_ImageType *typePtr, - Tk_ImageMaster master, ClientData *masterDataPtr)); +typedef int (Tk_ImageCreateProc) (Tcl_Interp *interp, char *name, int argc, + char **argv, Tk_ImageType *typePtr, Tk_ImageMaster master, + ClientData *masterDataPtr); #else -typedef int (Tk_ImageCreateProc) _ANSI_ARGS_((Tcl_Interp *interp, - char *name, int objc, Tcl_Obj *const objv[], Tk_ImageType *typePtr, - Tk_ImageMaster master, ClientData *masterDataPtr)); -#endif -typedef ClientData (Tk_ImageGetProc) _ANSI_ARGS_((Tk_Window tkwin, - ClientData masterData)); -typedef void (Tk_ImageDisplayProc) _ANSI_ARGS_((ClientData instanceData, - Display *display, Drawable drawable, int imageX, int imageY, - int width, int height, int drawableX, int drawableY)); -typedef void (Tk_ImageFreeProc) _ANSI_ARGS_((ClientData instanceData, - Display *display)); -typedef void (Tk_ImageDeleteProc) _ANSI_ARGS_((ClientData masterData)); -typedef void (Tk_ImageChangedProc) _ANSI_ARGS_((ClientData clientData, - int x, int y, int width, int height, int imageWidth, - int imageHeight)); -typedef int (Tk_ImagePostscriptProc) _ANSI_ARGS_((ClientData clientData, +typedef int (Tk_ImageCreateProc) (Tcl_Interp *interp, CONST86 char *name, int objc, + Tcl_Obj *const objv[], CONST86 Tk_ImageType *typePtr, Tk_ImageMaster master, + ClientData *masterDataPtr); +#endif /* USE_OLD_IMAGE */ +typedef ClientData (Tk_ImageGetProc) (Tk_Window tkwin, ClientData masterData); +typedef void (Tk_ImageDisplayProc) (ClientData instanceData, Display *display, + Drawable drawable, int imageX, int imageY, int width, int height, + int drawableX, int drawableY); +typedef void (Tk_ImageFreeProc) (ClientData instanceData, Display *display); +typedef void (Tk_ImageDeleteProc) (ClientData masterData); +typedef void (Tk_ImageChangedProc) (ClientData clientData, int x, int y, + int width, int height, int imageWidth, int imageHeight); +typedef int (Tk_ImagePostscriptProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psinfo, - int x, int y, int width, int height, int prepass)); + int x, int y, int width, int height, int prepass); /* * The following structure represents a particular type of image (bitmap, xpm @@ -1231,7 +1245,7 @@ typedef int (Tk_ImagePostscriptProc) _ANSI_ARGS_((ClientData clientData, */ struct Tk_ImageType { - char *name; /* Name of image type. */ + CONST86 char *name; /* Name of image type. */ Tk_ImageCreateProc *createProc; /* Procedure to call to create a new image of * this type. */ @@ -1305,41 +1319,36 @@ typedef struct Tk_PhotoImageBlock { typedef struct Tk_PhotoImageFormat Tk_PhotoImageFormat; #ifdef USE_OLD_IMAGE -typedef int (Tk_ImageFileMatchProc) _ANSI_ARGS_((Tcl_Channel chan, - char *fileName, char *formatString, int *widthPtr, int *heightPtr)); -typedef int (Tk_ImageStringMatchProc) _ANSI_ARGS_((char *string, - char *formatString, int *widthPtr, int *heightPtr)); -typedef int (Tk_ImageFileReadProc) _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Channel chan, char *fileName, char *formatString, - Tk_PhotoHandle imageHandle, int destX, int destY, - int width, int height, int srcX, int srcY)); -typedef int (Tk_ImageStringReadProc) _ANSI_ARGS_((Tcl_Interp *interp, - char *string, char *formatString, Tk_PhotoHandle imageHandle, - int destX, int destY, int width, int height, int srcX, int srcY)); -typedef int (Tk_ImageFileWriteProc) _ANSI_ARGS_((Tcl_Interp *interp, - char *fileName, char *formatString, Tk_PhotoImageBlock *blockPtr)); -typedef int (Tk_ImageStringWriteProc) _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_DString *dataPtr, char *formatString, - Tk_PhotoImageBlock *blockPtr)); +typedef int (Tk_ImageFileMatchProc) (Tcl_Channel chan, char *fileName, + char *formatString, int *widthPtr, int *heightPtr); +typedef int (Tk_ImageStringMatchProc) (char *string, char *formatString, + int *widthPtr, int *heightPtr); +typedef int (Tk_ImageFileReadProc) (Tcl_Interp *interp, Tcl_Channel chan, + char *fileName, char *formatString, Tk_PhotoHandle imageHandle, + int destX, int destY, int width, int height, int srcX, int srcY); +typedef int (Tk_ImageStringReadProc) (Tcl_Interp *interp, char *string, + char *formatString, Tk_PhotoHandle imageHandle, int destX, int destY, + int width, int height, int srcX, int srcY); +typedef int (Tk_ImageFileWriteProc) (Tcl_Interp *interp, char *fileName, + char *formatString, Tk_PhotoImageBlock *blockPtr); +typedef int (Tk_ImageStringWriteProc) (Tcl_Interp *interp, + Tcl_DString *dataPtr, char *formatString, Tk_PhotoImageBlock *blockPtr); #else -typedef int (Tk_ImageFileMatchProc) _ANSI_ARGS_((Tcl_Channel chan, - const char *fileName, Tcl_Obj *format, int *widthPtr, - int *heightPtr, Tcl_Interp *interp)); -typedef int (Tk_ImageStringMatchProc) _ANSI_ARGS_((Tcl_Obj *dataObj, - Tcl_Obj *format, int *widthPtr, int *heightPtr, - Tcl_Interp *interp)); -typedef int (Tk_ImageFileReadProc) _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Channel chan, const char *fileName, Tcl_Obj *format, - Tk_PhotoHandle imageHandle, int destX, int destY, - int width, int height, int srcX, int srcY)); -typedef int (Tk_ImageStringReadProc) _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *dataObj, Tcl_Obj *format, Tk_PhotoHandle imageHandle, - int destX, int destY, int width, int height, int srcX, int srcY)); -typedef int (Tk_ImageFileWriteProc) _ANSI_ARGS_((Tcl_Interp *interp, - const char *fileName, Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr)); -typedef int (Tk_ImageStringWriteProc) _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr)); -#endif +typedef int (Tk_ImageFileMatchProc) (Tcl_Channel chan, const char *fileName, + Tcl_Obj *format, int *widthPtr, int *heightPtr, Tcl_Interp *interp); +typedef int (Tk_ImageStringMatchProc) (Tcl_Obj *dataObj, Tcl_Obj *format, + int *widthPtr, int *heightPtr, Tcl_Interp *interp); +typedef int (Tk_ImageFileReadProc) (Tcl_Interp *interp, Tcl_Channel chan, + const char *fileName, Tcl_Obj *format, Tk_PhotoHandle imageHandle, + int destX, int destY, int width, int height, int srcX, int srcY); +typedef int (Tk_ImageStringReadProc) (Tcl_Interp *interp, Tcl_Obj *dataObj, + Tcl_Obj *format, Tk_PhotoHandle imageHandle, int destX, int destY, + int width, int height, int srcX, int srcY); +typedef int (Tk_ImageFileWriteProc) (Tcl_Interp *interp, const char *fileName, + Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr); +typedef int (Tk_ImageStringWriteProc) (Tcl_Interp *interp, Tcl_Obj *format, + Tk_PhotoImageBlock *blockPtr); +#endif /* USE_OLD_IMAGE */ /* * The following structure represents a particular file format for storing @@ -1348,7 +1357,7 @@ typedef int (Tk_ImageStringWriteProc) _ANSI_ARGS_((Tcl_Interp *interp, */ struct Tk_PhotoImageFormat { - char *name; /* Name of image file format */ + CONST86 char *name; /* Name of image file format */ Tk_ImageFileMatchProc *fileMatchProc; /* Procedure to call to determine whether an * image file matches this format. */ @@ -1394,41 +1403,41 @@ struct Tk_PhotoImageFormat { * declare widget elements. */ -typedef void (Tk_GetElementSizeProc) _ANSI_ARGS_((ClientData clientData, - char *recordPtr, const Tk_OptionSpec **optionsPtr, Tk_Window tkwin, - int width, int height, int inner, int *widthPtr, int *heightPtr)); -typedef void (Tk_GetElementBoxProc) _ANSI_ARGS_((ClientData clientData, - char *recordPtr, const Tk_OptionSpec **optionsPtr, Tk_Window tkwin, - int x, int y, int width, int height, int inner, int *xPtr, int *yPtr, - int *widthPtr, int *heightPtr)); -typedef int (Tk_GetElementBorderWidthProc) _ANSI_ARGS_((ClientData clientData, - char *recordPtr, const Tk_OptionSpec **optionsPtr, Tk_Window tkwin)); -typedef void (Tk_DrawElementProc) _ANSI_ARGS_((ClientData clientData, - char *recordPtr, const Tk_OptionSpec **optionsPtr, Tk_Window tkwin, - Drawable d, int x, int y, int width, int height, int state)); +typedef void (Tk_GetElementSizeProc) (ClientData clientData, char *recordPtr, + const Tk_OptionSpec **optionsPtr, Tk_Window tkwin, int width, + int height, int inner, int *widthPtr, int *heightPtr); +typedef void (Tk_GetElementBoxProc) (ClientData clientData, char *recordPtr, + const Tk_OptionSpec **optionsPtr, Tk_Window tkwin, int x, int y, + int width, int height, int inner, int *xPtr, int *yPtr, int *widthPtr, + int *heightPtr); +typedef int (Tk_GetElementBorderWidthProc) (ClientData clientData, + char *recordPtr, const Tk_OptionSpec **optionsPtr, Tk_Window tkwin); +typedef void (Tk_DrawElementProc) (ClientData clientData, char *recordPtr, + const Tk_OptionSpec **optionsPtr, Tk_Window tkwin, Drawable d, int x, + int y, int width, int height, int state); typedef struct Tk_ElementOptionSpec { - char *name; /* Name of the required option. */ - Tk_OptionType type; /* Accepted option type. TK_OPTION_END means - * any. */ + char *name; /* Name of the required option. */ + Tk_OptionType type; /* Accepted option type. TK_OPTION_END means + * any. */ } Tk_ElementOptionSpec; typedef struct Tk_ElementSpec { - int version; /* Version of the style support. */ - char *name; /* Name of element. */ + int version; /* Version of the style support. */ + char *name; /* Name of element. */ Tk_ElementOptionSpec *options; - /* List of required options. Last one's name - * must be NULL. */ + /* List of required options. Last one's name + * must be NULL. */ Tk_GetElementSizeProc *getSize; - /* Compute the external (resp. internal) size - * of the element from its desired internal - * (resp. external) size. */ + /* Compute the external (resp. internal) size + * of the element from its desired internal + * (resp. external) size. */ Tk_GetElementBoxProc *getBox; - /* Compute the inscribed or bounding boxes - * within a given area. */ + /* Compute the inscribed or bounding boxes + * within a given area. */ Tk_GetElementBorderWidthProc *getBorderWidth; - /* Return the element's internal border width. - * Mostly useful for widgets. */ + /* Return the element's internal border width. + * Mostly useful for widgets. */ Tk_DrawElementProc *draw; /* Draw the element in the given bounding * box. */ } Tk_ElementSpec; @@ -1487,13 +1496,17 @@ typedef struct Tk_ElementSpec { #define Tk_Release Tcl_Release /* Removed Tk_Main, use macro instead */ -#define Tk_Main(argc, argv, proc) \ - Tk_MainEx(argc, argv, proc, Tcl_CreateInterp()) - -const char * Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, - const char *version, int exact)); -EXTERN const char * Tk_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp, - const char *version, int exact)); +#if defined(_WIN32) || defined(__CYGWIN__) +#define Tk_Main(argc, argv, proc) Tk_MainEx(argc, argv, proc, \ + (Tcl_FindExecutable(0), (Tcl_CreateInterp)())) +#else +#define Tk_Main(argc, argv, proc) Tk_MainEx(argc, argv, proc, \ + (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) +#endif +const char * Tk_InitStubs(Tcl_Interp *interp, const char *version, + int exact); +EXTERN const char * Tk_PkgInitStubsCheck(Tcl_Interp *interp, + const char *version, int exact); #ifndef USE_TK_STUBS #define Tk_InitStubs(interp, version, exact) \ @@ -1510,21 +1523,17 @@ EXTERN const char * Tk_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp, *---------------------------------------------------------------------- */ -typedef int (Tk_ErrorProc) _ANSI_ARGS_((ClientData clientData, - XErrorEvent *errEventPtr)); -typedef void (Tk_EventProc) _ANSI_ARGS_((ClientData clientData, - XEvent *eventPtr)); -typedef int (Tk_GenericProc) _ANSI_ARGS_((ClientData clientData, - XEvent *eventPtr)); -typedef int (Tk_ClientMessageProc) _ANSI_ARGS_((Tk_Window tkwin, - XEvent *eventPtr)); -typedef int (Tk_GetSelProc) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, char *portion)); -typedef void (Tk_LostSelProc) _ANSI_ARGS_((ClientData clientData)); -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)); +typedef int (Tk_ErrorProc) (ClientData clientData, XErrorEvent *errEventPtr); +typedef void (Tk_EventProc) (ClientData clientData, XEvent *eventPtr); +typedef int (Tk_GenericProc) (ClientData clientData, XEvent *eventPtr); +typedef int (Tk_ClientMessageProc) (Tk_Window tkwin, XEvent *eventPtr); +typedef int (Tk_GetSelProc) (ClientData clientData, Tcl_Interp *interp, + CONST86 char *portion); +typedef void (Tk_LostSelProc) (ClientData clientData); +typedef Tk_RestrictAction (Tk_RestrictProc) (ClientData clientData, + XEvent *eventPtr); +typedef int (Tk_SelectionProc) (ClientData clientData, int offset, + char *buffer, int maxBytes); /* *---------------------------------------------------------------------- diff --git a/generic/tk3d.c b/generic/tk3d.c index caa40dd..87ddf76 100644 --- a/generic/tk3d.c +++ b/generic/tk3d.c @@ -19,7 +19,7 @@ * by Tk_GetReliefFromObj. */ -static CONST char *reliefStrings[] = { +static const char *const reliefStrings[] = { "flat", "groove", "raised", "ridge", "solid", "sunken", NULL }; @@ -30,6 +30,7 @@ static CONST char *reliefStrings[] = { static void BorderInit(TkDisplay *dispPtr); static void DupBorderObjProc(Tcl_Obj *srcObjPtr, Tcl_Obj *dupObjPtr); +static void FreeBorderObj(Tcl_Obj *objPtr); static void FreeBorderObjProc(Tcl_Obj *objPtr); static int Intersect(XPoint *a1Ptr, XPoint *a2Ptr, XPoint *b1Ptr, XPoint *b2Ptr, XPoint *iPtr); @@ -45,7 +46,7 @@ static void ShiftLine(XPoint *p1Ptr, XPoint *p2Ptr, * is set. */ -Tcl_ObjType tkBorderObjType = { +const Tcl_ObjType tkBorderObjType = { "border", /* name */ FreeBorderObjProc, /* freeIntRepProc */ DupBorderObjProc, /* dupIntRepProc */ @@ -71,8 +72,8 @@ Tcl_ObjType tkBorderObjType = { * Side effects: * The border is added to an internal database with a reference count. * For each call to this function, there should eventually be a call to - * FreeBorderObjProc so that the database is cleaned up when borders - * aren't in use anymore. + * FreeBorderObj so that the database is cleaned up when borders aren't + * in use anymore. * *---------------------------------------------------------------------- */ @@ -89,7 +90,7 @@ Tk_Alloc3DBorderFromObj( if (objPtr->typePtr != &tkBorderObjType) { InitBorderObj(objPtr); } - borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1; + borderPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * If the object currently points to a TkBorder, see if it's the one we @@ -103,7 +104,7 @@ Tk_Alloc3DBorderFromObj( * longer in use. Clear the reference. */ - FreeBorderObjProc(objPtr); + FreeBorderObj(objPtr); borderPtr = NULL; } else if ((Tk_Screen(tkwin) == borderPtr->screen) && (Tk_Colormap(tkwin) == borderPtr->colormap)) { @@ -116,9 +117,7 @@ Tk_Alloc3DBorderFromObj( * The object didn't point to the border that we wanted. Search the list * of borders with the same name to see if one of the others is the right * one. - */ - - /* + * * If the cached value is NULL, either the object type was not a color * going in, or the object is a color type but had previously been freed. * @@ -128,16 +127,16 @@ Tk_Alloc3DBorderFromObj( */ if (borderPtr != NULL) { - TkBorder *firstBorderPtr = - (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr); - FreeBorderObjProc(objPtr); + TkBorder *firstBorderPtr = Tcl_GetHashValue(borderPtr->hashPtr); + + FreeBorderObj(objPtr); for (borderPtr = firstBorderPtr ; borderPtr != NULL; borderPtr = borderPtr->nextPtr) { if ((Tk_Screen(tkwin) == borderPtr->screen) - && (Tk_Colormap(tkwin) == borderPtr->colormap)) { + && (Tk_Colormap(tkwin) == borderPtr->colormap)) { borderPtr->resourceRefCount++; borderPtr->objRefCount++; - objPtr->internalRep.twoPtrValue.ptr1 = (void *) borderPtr; + objPtr->internalRep.twoPtrValue.ptr1 = borderPtr; return (Tk_3DBorder) borderPtr; } } @@ -149,7 +148,7 @@ Tk_Alloc3DBorderFromObj( borderPtr = (TkBorder *) Tk_Get3DBorder(interp, tkwin, Tcl_GetString(objPtr)); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) borderPtr; + objPtr->internalRep.twoPtrValue.ptr1 = borderPtr; if (borderPtr != NULL) { borderPtr->objRefCount++; } @@ -201,7 +200,7 @@ Tk_Get3DBorder( hashPtr = Tcl_CreateHashEntry(&dispPtr->borderTable, colorName, &isNew); if (!isNew) { - existingBorderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr); + existingBorderPtr = Tcl_GetHashValue(hashPtr); for (borderPtr = existingBorderPtr; borderPtr != NULL; borderPtr = borderPtr->nextPtr) { if ((Tk_Screen(tkwin) == borderPtr->screen) @@ -318,7 +317,7 @@ Tk_Draw3DRectangle( *-------------------------------------------------------------- */ -CONST char * +const char * Tk_NameOf3DBorder( Tk_3DBorder border) /* Token for border. */ { @@ -426,7 +425,7 @@ Tk_Free3DBorder( return; } - prevPtr = (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr); + prevPtr = Tcl_GetHashValue(borderPtr->hashPtr); TkpFreeBorder(borderPtr); if (borderPtr->bgColorPtr != NULL) { Tk_FreeColor(borderPtr->bgColorPtr); @@ -462,7 +461,7 @@ Tk_Free3DBorder( prevPtr->nextPtr = borderPtr->nextPtr; } if (borderPtr->objRefCount == 0) { - ckfree((char *) borderPtr); + ckfree(borderPtr); } } @@ -494,13 +493,13 @@ Tk_Free3DBorderFromObj( Tcl_Obj *objPtr) /* The Tcl_Obj * to be freed. */ { Tk_Free3DBorder(Tk_Get3DBorderFromObj(tkwin, objPtr)); - FreeBorderObjProc(objPtr); + FreeBorderObj(objPtr); } /* *--------------------------------------------------------------------------- * - * FreeBorderObjProc -- + * FreeBorderObjProc, FreeBorderObj -- * * This proc is called to release an object reference to a border. Called * when the object's internal rep is released or when the cached @@ -520,13 +519,21 @@ static void FreeBorderObjProc( Tcl_Obj *objPtr) /* The object we are releasing. */ { - TkBorder *borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1; + FreeBorderObj(objPtr); + objPtr->typePtr = NULL; +} + +static void +FreeBorderObj( + Tcl_Obj *objPtr) /* The object we are releasing. */ +{ + TkBorder *borderPtr = objPtr->internalRep.twoPtrValue.ptr1; if (borderPtr != NULL) { borderPtr->objRefCount--; if ((borderPtr->objRefCount == 0) && (borderPtr->resourceRefCount == 0)) { - ckfree((char *) borderPtr); + ckfree(borderPtr); } objPtr->internalRep.twoPtrValue.ptr1 = NULL; } @@ -555,10 +562,10 @@ DupBorderObjProc( Tcl_Obj *srcObjPtr, /* The object we are copying from. */ Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { - TkBorder *borderPtr = (TkBorder *) srcObjPtr->internalRep.twoPtrValue.ptr1; + TkBorder *borderPtr = srcObjPtr->internalRep.twoPtrValue.ptr1; dupObjPtr->typePtr = srcObjPtr->typePtr; - dupObjPtr->internalRep.twoPtrValue.ptr1 = (void *) borderPtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = borderPtr; if (borderPtr != NULL) { borderPtr->objRefCount++; @@ -617,8 +624,8 @@ Tk_GetReliefFromObj( * from. */ int *resultPtr) /* Where to place the answer. */ { - return Tcl_GetIndexFromObj(interp, objPtr, reliefStrings, "relief", 0, - resultPtr); + return Tcl_GetIndexFromObjStruct(interp, objPtr, reliefStrings, + sizeof(char *), "relief", 0, resultPtr); } /* @@ -643,7 +650,7 @@ Tk_GetReliefFromObj( int Tk_GetRelief( Tcl_Interp *interp, /* For error messages. */ - CONST char *name, /* Name of a relief type. */ + const char *name, /* Name of a relief type. */ int *reliefPtr) /* Where to store converted relief. */ { char c; @@ -655,22 +662,21 @@ Tk_GetRelief( *reliefPtr = TK_RELIEF_FLAT; } else if ((c == 'g') && (strncmp(name, "groove", length) == 0) && (length >= 2)) { - *reliefPtr = TK_RELIEF_GROOVE; + *reliefPtr = TK_RELIEF_GROOVE; } else if ((c == 'r') && (strncmp(name, "raised", length) == 0) && (length >= 2)) { *reliefPtr = TK_RELIEF_RAISED; } else if ((c == 'r') && (strncmp(name, "ridge", length) == 0)) { - *reliefPtr = TK_RELIEF_RIDGE; + *reliefPtr = TK_RELIEF_RIDGE; } else if ((c == 's') && (strncmp(name, "solid", length) == 0)) { *reliefPtr = TK_RELIEF_SOLID; } else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) { *reliefPtr = TK_RELIEF_SUNKEN; } else { - char buf[200]; - - sprintf(buf, "bad relief type \"%.50s\": must be %s", - name, "flat, groove, raised, ridge, solid, or sunken"); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("bad relief \"%.50s\": must be %s", + name, "flat, groove, raised, ridge, solid, or sunken")); + Tcl_SetErrorCode(interp, "TK", "VALUE", "RELIEF", NULL); return TCL_ERROR; } return TCL_OK; @@ -692,7 +698,7 @@ Tk_GetRelief( *-------------------------------------------------------------- */ -CONST char * +const char * Tk_NameOfRelief( int relief) /* One of TK_RELIEF_FLAT, TK_RELIEF_RAISED, or * TK_RELIEF_SUNKEN. */ @@ -768,9 +774,8 @@ Tk_Draw3DPolygon( */ if ((leftRelief == TK_RELIEF_GROOVE) || (leftRelief == TK_RELIEF_RIDGE)) { - int halfWidth; + int halfWidth = borderWidth/2; - halfWidth = borderWidth/2; Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints, halfWidth, (leftRelief == TK_RELIEF_GROOVE) ? TK_RELIEF_RAISED : TK_RELIEF_SUNKEN); @@ -980,8 +985,8 @@ Tk_Fill3DRectangle( if ((width > doubleBorder) && (height > doubleBorder)) { XFillRectangle(Tk_Display(tkwin), drawable, borderPtr->bgGC, x + borderWidth, y + borderWidth, - (unsigned int) (width - doubleBorder), - (unsigned int) (height - doubleBorder)); + (unsigned) (width - doubleBorder), + (unsigned) (height - doubleBorder)); } if (borderWidth) { Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width, @@ -1083,19 +1088,18 @@ ShiftLine( XPoint *p3Ptr) /* Store coords of point on new line here. */ { int dx, dy, dxNeg, dyNeg; - - /* - * The table below is used for a quick approximation in computing the new - * point. An index into the table is 128 times the slope of the original - * line (the slope must always be between 0 and 1). The value of the table - * entry is 128 times the amount to displace the new line in y for each - * unit of perpendicular distance. In other words, the table maps from the - * tangent of an angle to the inverse of its cosine. If the slope of the - * original line is greater than 1, then the displacement is done in x - * rather than in y. - */ - - static int shiftTable[129]; + static int shiftTable[129]; /* Used for a quick approximation in computing + * the new point. An index into the table is + * 128 times the slope of the original line + * (the slope must always be between 0 and 1). + * The value of the table entry is 128 times + * the amount to displace the new line in y + * for each unit of perpendicular distance. In + * other words, the table maps from the + * tangent of an angle to the inverse of its + * cosine. If the slope of the original line + * is greater than 1, then the displacement is + * done in x rather than in y. */ /* * Initialize the table if this is the first time it is used. @@ -1249,7 +1253,7 @@ Tk_Get3DBorderFromObj( * cached in the internal representation of the Tcl_Obj. Check it out... */ - borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1; + borderPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((borderPtr != NULL) && (borderPtr->resourceRefCount > 0) && (Tk_Screen(tkwin) == borderPtr->screen) @@ -1277,12 +1281,12 @@ Tk_Get3DBorderFromObj( if (hashPtr == NULL) { goto error; } - for (borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr); - (borderPtr != NULL); borderPtr = borderPtr->nextPtr) { + for (borderPtr = Tcl_GetHashValue(hashPtr); borderPtr != NULL; + borderPtr = borderPtr->nextPtr) { if ((Tk_Screen(tkwin) == borderPtr->screen) && (Tk_Colormap(tkwin) == borderPtr->colormap)) { - FreeBorderObjProc(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) borderPtr; + FreeBorderObj(objPtr); + objPtr->internalRep.twoPtrValue.ptr1 = borderPtr; borderPtr->objRefCount++; return (Tk_3DBorder) borderPtr; } @@ -1329,7 +1333,7 @@ InitBorderObj( Tcl_GetString(objPtr); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &tkBorderObjType; objPtr->internalRep.twoPtrValue.ptr1 = NULL; @@ -1358,22 +1362,23 @@ Tcl_Obj * TkDebugBorder( Tk_Window tkwin, /* The window in which the border will be used * (not currently used). */ - char *name) /* Name of the desired color. */ + const char *name) /* Name of the desired color. */ { - TkBorder *borderPtr; Tcl_HashEntry *hashPtr; - Tcl_Obj *resultPtr, *objPtr; + Tcl_Obj *resultPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; resultPtr = Tcl_NewObj(); hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, name); if (hashPtr != NULL) { - borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr); + TkBorder *borderPtr = Tcl_GetHashValue(hashPtr); + if (borderPtr == NULL) { Tcl_Panic("TkDebugBorder found empty hash table entry"); } for ( ; (borderPtr != NULL); borderPtr = borderPtr->nextPtr) { - objPtr = Tcl_NewObj(); + Tcl_Obj *objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(borderPtr->resourceRefCount)); Tcl_ListObjAppendElement(NULL, objPtr, diff --git a/generic/tk3d.h b/generic/tk3d.h index 5e0a0cf..891e927 100644 --- a/generic/tk3d.h +++ b/generic/tk3d.h @@ -12,12 +12,7 @@ #ifndef _TK3D #define _TK3D -#include <tkInt.h> - -#ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif +#include "tkInt.h" /* * One of the following data structures is allocated for each 3-D border @@ -40,9 +35,8 @@ typedef struct TkBorder { * no longer valid and it isn't present in * borderTable: it is being kept around only * because there are objects referring to it. - * The structure is freed when - * resourceRefCount and objRefCount are both - * 0. */ + * The structure is freed when objRefCount and + * resourceRefCount are both 0. */ int objRefCount; /* The number of Tcl objects that reference * this structure. */ XColor *bgColorPtr; /* Background color (intensity between @@ -88,7 +82,4 @@ MODULE_SCOPE TkBorder *TkpGetBorder(void); MODULE_SCOPE void TkpGetShadows(TkBorder *borderPtr, Tk_Window tkwin); MODULE_SCOPE void TkpFreeBorder(TkBorder *borderPtr); -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TK3D */ diff --git a/generic/tkArgv.c b/generic/tkArgv.c index a338e45..6c2c5c5 100644 --- a/generic/tkArgv.c +++ b/generic/tkArgv.c @@ -18,7 +18,7 @@ * every application. */ -static Tk_ArgvInfo defaultTable[] = { +static const Tk_ArgvInfo defaultTable[] = { {"-help", TK_ARGV_HELP, NULL, NULL, "Print summary of command-line options and abort"}, {NULL, TK_ARGV_END, NULL, NULL, NULL} @@ -28,7 +28,7 @@ static Tk_ArgvInfo defaultTable[] = { * Forward declarations for functions defined in this file: */ -static void PrintUsage(Tcl_Interp *interp, Tk_ArgvInfo *argTable, +static void PrintUsage(Tcl_Interp *interp, const Tk_ArgvInfo *argTable, int flags); /* @@ -61,17 +61,17 @@ Tk_ParseArgv( * means ignore Tk option specs. */ int *argcPtr, /* Number of arguments in argv. Modified to * hold # args left in argv at end. */ - CONST char **argv, /* Array of arguments. Modified to hold those + const char **argv, /* Array of arguments. Modified to hold those * that couldn't be processed here. */ - Tk_ArgvInfo *argTable, /* Array of option descriptions */ + const Tk_ArgvInfo *argTable, /* Array of option descriptions */ int flags) /* Or'ed combination of various flag bits, * such as TK_ARGV_NO_DEFAULTS. */ { - register Tk_ArgvInfo *infoPtr; + register const Tk_ArgvInfo *infoPtr; /* Pointer to the current entry in the table * of argument descriptions. */ - Tk_ArgvInfo *matchPtr; /* Descriptor that matches current argument. */ - CONST char *curArg; /* Current argument */ + const Tk_ArgvInfo *matchPtr;/* Descriptor that matches current argument. */ + const char *curArg; /* Current argument */ register char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. * because first char. will almost always be @@ -83,6 +83,7 @@ Tk_ParseArgv( * than srcIndex). */ int argc; /* # arguments in argv still to process. */ size_t length; /* Number of characters in current argument. */ + char *endPtr; /* Used for identifying junk in arguments. */ int i; if (flags & TK_ARGV_DONT_SKIP_FIRST_ARG) { @@ -139,8 +140,10 @@ Tk_ParseArgv( continue; } if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", curArg, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous option \"%s\"", curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "AMBIGUOUS", curArg, + NULL); return TCL_ERROR; } matchPtr = infoPtr; @@ -153,8 +156,10 @@ Tk_ParseArgv( */ if (flags & TK_ARGV_NO_LEFTOVERS) { - Tcl_AppendResult(interp, "unrecognized argument \"", - curArg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unrecognized argument \"%s\"", curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "UNRECOGNIZED", curArg, + NULL); return TCL_ERROR; } argv[dstIndex] = curArg; @@ -175,25 +180,23 @@ Tk_ParseArgv( case TK_ARGV_INT: if (argc == 0) { goto missingArg; - } else { - char *endPtr; - - *((int *) infoPtr->dst) = strtol(argv[srcIndex], &endPtr, 0); - if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { - Tcl_AppendResult(interp,"expected integer argument for \"", - infoPtr->key, "\" but got \"", argv[srcIndex], - "\"", NULL); - return TCL_ERROR; - } - srcIndex++; - argc--; } + *((int *) infoPtr->dst) = strtol(argv[srcIndex], &endPtr, 0); + if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected %s argument for \"%s\" but got \"%s\"", + "integer", infoPtr->key, argv[srcIndex])); + Tcl_SetErrorCode(interp, "TK", "ARG", "INTEGER", curArg,NULL); + return TCL_ERROR; + } + srcIndex++; + argc--; break; case TK_ARGV_STRING: if (argc == 0) { goto missingArg; } - *((CONST char **)infoPtr->dst) = argv[srcIndex]; + *((const char **) infoPtr->dst) = argv[srcIndex]; srcIndex++; argc--; break; @@ -201,7 +204,7 @@ Tk_ParseArgv( if (argc == 0) { goto missingArg; } - *((Tk_Uid *)infoPtr->dst) = Tk_GetUid(argv[srcIndex]); + *((Tk_Uid *) infoPtr->dst) = Tk_GetUid(argv[srcIndex]); srcIndex++; argc--; break; @@ -211,37 +214,35 @@ Tk_ParseArgv( case TK_ARGV_FLOAT: if (argc == 0) { goto missingArg; - } else { - char *endPtr; - - *((double *) infoPtr->dst) = strtod(argv[srcIndex], &endPtr); - if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { - Tcl_AppendResult(interp, "expected floating-point ", - "argument for \"", infoPtr->key, "\" but got \"", - argv[srcIndex], "\"", NULL); - return TCL_ERROR; - } - srcIndex++; - argc--; } + *((double *) infoPtr->dst) = strtod(argv[srcIndex], &endPtr); + if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected %s argument for \"%s\" but got \"%s\"", + "floating-point", infoPtr->key, argv[srcIndex])); + Tcl_SetErrorCode(interp, "TK", "ARG", "FLOAT", curArg, NULL); + return TCL_ERROR; + } + srcIndex++; + argc--; break; case TK_ARGV_FUNC: { - typedef int (ArgvFunc)(char *, char *, CONST char *); + typedef int (ArgvFunc)(char *, const char *, const char *); ArgvFunc *handlerProc = (ArgvFunc *) infoPtr->src; - if ((*handlerProc)(infoPtr->dst, infoPtr->key, argv[srcIndex])) { + if (handlerProc(infoPtr->dst, infoPtr->key, argv[srcIndex])) { srcIndex++; argc--; } break; } case TK_ARGV_GENFUNC: { - typedef int (ArgvGenFunc)(char *, Tcl_Interp *, char *, int, - CONST char **); + typedef int (ArgvGenFunc)(char *, Tcl_Interp *, const char *, int, + const char **); ArgvGenFunc *handlerProc = (ArgvGenFunc *) infoPtr->src; - argc = (*handlerProc)(infoPtr->dst, interp, infoPtr->key, - argc, argv+srcIndex); + argc = handlerProc(infoPtr->dst, interp, infoPtr->key, argc, + argv+srcIndex); if (argc < 0) { return TCL_ERROR; } @@ -249,6 +250,7 @@ Tk_ParseArgv( } case TK_ARGV_HELP: PrintUsage(interp, argTable, flags); + Tcl_SetErrorCode(interp, "TK", "ARG", "HELP", NULL); return TCL_ERROR; case TK_ARGV_CONST_OPTION: Tk_AddOption(tkwin, infoPtr->dst, infoPtr->src, @@ -265,8 +267,11 @@ Tk_ParseArgv( break; case TK_ARGV_OPTION_NAME_VALUE: if (argc < 2) { - Tcl_AppendResult(interp, "\"", curArg, - "\" option requires two following arguments", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" option requires two following arguments", + curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "NAME_VALUE", curArg, + NULL); return TCL_ERROR; } Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1], @@ -274,14 +279,12 @@ Tk_ParseArgv( srcIndex += 2; argc -= 2; break; - default: { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad argument type %d in Tk_ArgvInfo", infoPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument type %d in Tk_ArgvInfo", infoPtr->type)); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } - } } /* @@ -301,8 +304,9 @@ Tk_ParseArgv( return TCL_OK; missingArg: - Tcl_AppendResult(interp, "\"", curArg, - "\" option requires an additional argument", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" option requires an additional argument", curArg)); + Tcl_SetErrorCode(interp, "TK", "ARG", "MISSING", curArg, NULL); return TCL_ERROR; } @@ -328,15 +332,15 @@ static void PrintUsage( Tcl_Interp *interp, /* Place information in this interp's result * area. */ - Tk_ArgvInfo *argTable, /* Array of command-specific argument + const Tk_ArgvInfo *argTable,/* Array of command-specific argument * descriptions. */ int flags) /* If the TK_ARGV_NO_DEFAULTS bit is set in * this word, then don't generate information * for default options. */ { - register Tk_ArgvInfo *infoPtr; + register const Tk_ArgvInfo *infoPtr; size_t width, i, numSpaces; - char tmp[TCL_DOUBLE_SPACE]; + Tcl_Obj *message; /* * First, compute the width of the widest option key, so that we can make @@ -348,6 +352,7 @@ PrintUsage( for (infoPtr = i ? defaultTable : argTable; infoPtr->type != TK_ARGV_END; infoPtr++) { size_t length; + if (infoPtr->key == NULL) { continue; } @@ -358,35 +363,35 @@ PrintUsage( } } - Tcl_AppendResult(interp, "Command-specific options:", NULL); + message = Tcl_NewStringObj("Command-specific options:", -1); for (i = 0; ; i++) { for (infoPtr = i ? defaultTable : argTable; infoPtr->type != TK_ARGV_END; infoPtr++) { if ((infoPtr->type == TK_ARGV_HELP) && (infoPtr->key == NULL)) { - Tcl_AppendResult(interp, "\n", infoPtr->help, NULL); + Tcl_AppendPrintfToObj(message, "\n%s", infoPtr->help); continue; } - Tcl_AppendResult(interp, "\n ", infoPtr->key, ":", NULL); + Tcl_AppendPrintfToObj(message, "\n %s:", infoPtr->key); numSpaces = width + 1 - strlen(infoPtr->key); while (numSpaces-- > 0) { - Tcl_AppendResult(interp, " ", NULL); + Tcl_AppendToObj(message, " ", 1); } - Tcl_AppendResult(interp, infoPtr->help, NULL); + Tcl_AppendToObj(message, infoPtr->help, -1); switch (infoPtr->type) { case TK_ARGV_INT: - sprintf(tmp, "%d", *((int *) infoPtr->dst)); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); + Tcl_AppendPrintfToObj(message, "\n\t\tDefault value: %d", + *((int *) infoPtr->dst)); break; case TK_ARGV_FLOAT: - Tcl_PrintDouble(NULL, *((double *) infoPtr->dst), tmp); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); + Tcl_AppendPrintfToObj(message, "\n\t\tDefault value: %f", + *((double *) infoPtr->dst)); break; case TK_ARGV_STRING: { char *string = *((char **) infoPtr->dst); if (string != NULL) { - Tcl_AppendResult(interp, "\n\t\tDefault value: \"", string, - "\"", NULL); + Tcl_AppendPrintfToObj(message, + "\n\t\tDefault value: \"%s\"", string); } break; } @@ -398,8 +403,9 @@ PrintUsage( if ((flags & TK_ARGV_NO_DEFAULTS) || (i > 0)) { break; } - Tcl_AppendResult(interp, "\nGeneric options for all commands:", NULL); + Tcl_AppendToObj(message, "\nGeneric options for all commands:", -1); } + Tcl_SetObjResult(interp, message); } /* diff --git a/generic/tkAtom.c b/generic/tkAtom.c index fe1b5b3..2491fb2 100644 --- a/generic/tkAtom.c +++ b/generic/tkAtom.c @@ -20,7 +20,7 @@ * those found in xatom.h */ -static const char *atomNameArray[] = { +static const char *const atomNameArray[] = { "PRIMARY", "SECONDARY", "ARC", "ATOM", "BITMAP", "CARDINAL", "COLORMAP", "CURSOR", "CUT_BUFFER0", @@ -76,10 +76,10 @@ Atom Tk_InternAtom( Tk_Window tkwin, /* Window token; map name to atom for this * window's display. */ - CONST char *name) /* Name to turn into atom. */ + const char *name) /* Name to turn into atom. */ { - register TkDisplay *dispPtr; - register Tcl_HashEntry *hPtr; + TkDisplay *dispPtr; + Tcl_HashEntry *hPtr; int isNew; dispPtr = ((TkWindow *) tkwin)->dispPtr; @@ -97,7 +97,7 @@ Tk_InternAtom( hPtr2 = Tcl_CreateHashEntry(&dispPtr->atomTable, INT2PTR(atom), &isNew); Tcl_SetHashValue(hPtr2, Tcl_GetHashKey(&dispPtr->nameTable, hPtr)); } - return (Atom) PTR2INT(Tcl_GetHashValue(hPtr)); + return (Atom)PTR2INT(Tcl_GetHashValue(hPtr)); } /* @@ -121,14 +121,14 @@ Tk_InternAtom( *-------------------------------------------------------------- */ -CONST char * +const char * Tk_GetAtomName( Tk_Window tkwin, /* Window token; map atom to name relative to * this window's display. */ Atom atom) /* Atom whose name is wanted. */ { - register TkDisplay *dispPtr; - register Tcl_HashEntry *hPtr; + TkDisplay *dispPtr; + Tcl_HashEntry *hPtr; dispPtr = ((TkWindow *) tkwin)->dispPtr; if (!dispPtr->atomInit) { @@ -137,23 +137,22 @@ Tk_GetAtomName( hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, INT2PTR(atom)); if (hPtr == NULL) { - char *name; + const char *name; Tk_ErrorHandler handler; - int isNew, mustFree; + int isNew; + char *mustFree = NULL; handler = Tk_CreateErrorHandler(dispPtr->display, BadAtom, -1, -1, - NULL, (ClientData) NULL); - name = XGetAtomName(dispPtr->display, atom); - mustFree = 1; + NULL, NULL); + name = mustFree = XGetAtomName(dispPtr->display, atom); if (name == NULL) { name = "?bad atom?"; - mustFree = 0; } Tk_DeleteErrorHandler(handler); hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &isNew); Tcl_SetHashValue(hPtr, INT2PTR(atom)); if (mustFree) { - XFree(name); + XFree(mustFree); } name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr); hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, INT2PTR(atom), &isNew); @@ -180,7 +179,7 @@ Tk_GetAtomName( static void AtomInit( - register TkDisplay *dispPtr)/* Display to initialize. */ + TkDisplay *dispPtr)/* Display to initialize. */ { Tcl_HashEntry *hPtr; Atom atom; diff --git a/generic/tkBind.c b/generic/tkBind.c index c4f8226..9cd3b7b 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -14,7 +14,7 @@ #include "tkInt.h" -#ifdef __WIN32__ +#ifdef _WIN32 #include "tkWinInt.h" #elif defined(MAC_OSX_TK) #include "tkMacOSXInt.h" @@ -29,13 +29,10 @@ * * Init/Free this package. * - * Tcl "bind" command (actually located in tkCmds.c). - * "bind" command implementation. - * "bind" implementation helpers. + * Tcl "bind" command (actually located in tkCmds.c) core implementation, plus + * helpers. * - * Tcl "event" command. - * "event" command implementation. - * "event" implementation helpers. + * Tcl "event" command implementation, plus helpers. * * Package-specific common helpers. * @@ -79,7 +76,7 @@ typedef union { */ #define EVENT_BUFFER_SIZE 30 -typedef struct BindingTable { +typedef struct Tk_BindingTable_ { XEvent eventRing[EVENT_BUFFER_SIZE]; /* Circular queue of recent events (higher * indices are for more recent events). */ @@ -108,12 +105,12 @@ typedef struct BindingTable { * * A virtual event is usually never part of the event stream, but instead is * synthesized inline by matching low-level events. However, a virtual event - * may be generated by platform-specific code or by Tcl scripts. In that case, + * may be generated by platform-specific code or by Tcl commands. In that case, * no lookup of the virtual event will need to be done using this table, * because the virtual event is actually in the event stream. */ -typedef struct VirtualEventTable { +typedef struct { Tcl_HashTable patternTable; /* Used to map from a physical event to a list * of patterns that may match that event. Keys * are PatternTableKey structs, values are @@ -140,7 +137,7 @@ typedef struct VirtualEventTable { * tables and virtual event tables. */ -typedef struct PatternTableKey { +typedef struct { ClientData object; /* For binding table, identifies the binding * tag of the object (or class of objects) * relative to which the event occurred. For @@ -156,7 +153,7 @@ typedef struct PatternTableKey { * events as part of the process of converting X events into Tcl commands. */ -typedef struct TkPattern { +typedef struct { int eventType; /* Type of X event, e.g. ButtonPress. */ int needMods; /* Mask of modifiers that must be present (0 * means no modifiers are required). */ @@ -193,21 +190,10 @@ typedef struct TkPattern { typedef struct PatSeq { int numPats; /* Number of patterns in sequence (usually * 1). */ - TkBindEvalProc *eventProc; /* The function that will be invoked on the - * clientData when this pattern sequence - * matches. */ - TkBindFreeProc *freeProc; /* The function that will be invoked to - * release the clientData when this pattern - * sequence is freed. */ - ClientData clientData; /* Arbitray data passed to eventProc and - * freeProc when sequence matches. */ + char *script; /* Binding script to evaluate when sequence + * matches (ckalloc()ed) */ int flags; /* Miscellaneous flag values; see below for * definitions. */ - int refCount; /* Number of times that this binding is in the - * midst of executing. If greater than 1, then - * a recursive invocation is happening. Only - * when this is zero can the binding actually - * be freed. */ struct PatSeq *nextSeqPtr; /* Next in list of all pattern sequences that * have the same initial pattern. NULL means * end of list. */ @@ -238,16 +224,9 @@ typedef struct PatSeq { * must occur with nearby X and Y mouse coordinates and * close in time. This is typically used to restrict * multiple button presses. - * MARKED_DELETED 1 means that this binding has been marked as deleted - * and removed from the binding table, but its memory - * could not be released because it was already queued - * for execution. When the binding is actually about to - * be executed, this flag will be checked and the binding - * skipped if set. */ #define PAT_NEARBY 0x1 -#define MARKED_DELETED 0x2 /* * Constants that define how close together two events must be in milliseconds @@ -275,7 +254,7 @@ typedef struct VirtualOwners { * to associate a virtual event with all the physical events that can trigger * it. */ -typedef struct PhysicalsOwned { +typedef struct { int numOwned; /* Number of physical events owned. */ PatSeq *patSeqs[1]; /* Array of pointers to physical event * patterns. Enough space will actually be @@ -285,7 +264,7 @@ typedef struct PhysicalsOwned { /* * One of the following structures exists for each interpreter. This structure * keeps track of the current display and screen in the interpreter, so that a - * script can be invoked whenever the display/screen changes (the script does + * command can be invoked whenever the display/screen changes (the command does * things like point tk::Priv at a display-specific structure). */ @@ -298,44 +277,17 @@ typedef struct { } ScreenInfo; /* - * The following structure is used to keep track of all the C bindings that - * are awaiting invocation and whether the window they refer to has been - * destroyed. If the window is destroyed, then all pending callbacks for that - * window will be cancelled. The Tcl bindings will still all be invoked, - * however. - */ - -typedef struct PendingBinding { - struct PendingBinding *nextPtr; - /* Next in chain of pending bindings, in case - * a recursive binding evaluation is in - * progress. */ - Tk_Window tkwin; /* The window that the following bindings - * depend upon. */ - int deleted; /* Set to non-zero by window cleanup code if - * tkwin is deleted. */ - PatSeq *matchArray[5]; /* Array of pending C bindings. The actual - * size of this depends on how many C bindings - * matched the event passed to Tk_BindEvent. - * THIS FIELD MUST BE THE LAST IN THE - * STRUCTURE. */ -} PendingBinding; - -/* * The following structure keeps track of all the information local to the * binding package on a per interpreter basis. */ -typedef struct BindInfo { +typedef struct TkBindInfo_ { VirtualEventTable virtualEventTable; /* The virtual events that exist in this * interpreter. */ ScreenInfo screenInfo; /* Keeps track of the current display and * screen, so it can be restored after a * binding has executed. */ - PendingBinding *pendingList;/* The list of pending C bindings, kept in - * case a C or Tcl binding causes the target - * window to be deleted. */ int deleted; /* 1 the application has been deleted but the * structure has been preserved. */ } BindInfo; @@ -352,10 +304,10 @@ typedef struct BindInfo { #ifdef REDO_KEYSYM_LOOKUP typedef struct { - char *name; /* Name of keysym. */ + const char *name; /* Name of keysym. */ KeySym value; /* Numeric identifier for keysym. */ } KeySymInfo; -static KeySymInfo keyArray[] = { +static const KeySymInfo keyArray[] = { #ifndef lint #include "ks_names.h" #endif @@ -381,7 +333,7 @@ TCL_DECLARE_MUTEX(bindMutex) */ typedef struct { - char *name; /* Name of modifier. */ + const char *name; /* Name of modifier. */ int mask; /* Button/modifier mask value, such as * Button1Mask. */ int flags; /* Various flags; see below for @@ -405,7 +357,7 @@ typedef struct { #define QUADRUPLE 4 #define MULT_CLICKS 7 -static ModInfo modArray[] = { +static const ModInfo modArray[] = { {"Control", ControlMask, 0}, {"Shift", ShiftMask, 0}, {"Lock", LockMask, 0}, @@ -450,7 +402,7 @@ static Tcl_HashTable modTable; */ typedef struct { - char *name; /* Name of event. */ + const char *name; /* Name of event. */ int type; /* Event type for X, such as ButtonPress. */ int eventMask; /* Mask bits (for XSelectInput) for this event * type. */ @@ -463,7 +415,7 @@ typedef struct { * unless you've asked about button events. */ -static EventInfo eventArray[] = { +static const EventInfo eventArray[] = { {"Key", KeyPress, KeyPressMask}, {"KeyPress", KeyPress, KeyPressMask}, {"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask}, @@ -535,7 +487,7 @@ static Tcl_HashTable eventTable; #define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL) #define KEY_BUTTON_MOTION_CROSSING (KEY|BUTTON|MOTION|VIRTUAL|CROSSING) -static int flagArray[TK_LASTEVENT] = { +static const int flagArray[TK_LASTEVENT] = { /* Not used */ 0, /* Not used */ 0, /* KeyPress */ KEY, @@ -654,15 +606,14 @@ static void ChangeScreen(Tcl_Interp *interp, char *dispName, int screenIndex); static int CreateVirtualEvent(Tcl_Interp *interp, VirtualEventTable *vetPtr, char *virtString, - char *eventString); + const char *eventString); static int DeleteVirtualEvent(Tcl_Interp *interp, VirtualEventTable *vetPtr, char *virtString, - char *eventString); + const char *eventString); static void DeleteVirtualEventTable(VirtualEventTable *vetPtr); static void ExpandPercents(TkWindow *winPtr, const char *before, XEvent *eventPtr,KeySym keySym, unsigned int scriptCount, Tcl_DString *dsPtr); -static void FreeTclBinding(ClientData clientData); static PatSeq * FindSequence(Tcl_Interp *interp, Tcl_HashTable *patternTablePtr, ClientData object, const char *eventString, int create, @@ -670,9 +621,9 @@ static PatSeq * FindSequence(Tcl_Interp *interp, static void GetAllVirtualEvents(Tcl_Interp *interp, VirtualEventTable *vetPtr); static char * GetField(char *p, char *copy, int size); -static void GetPatternString(PatSeq *psPtr, Tcl_DString *dsPtr); +static Tcl_Obj * GetPatternObj(PatSeq *psPtr); static int GetVirtualEvent(Tcl_Interp *interp, - VirtualEventTable *vetPtr, char *virtString); + VirtualEventTable *vetPtr, Tcl_Obj *virtName); static Tk_Uid GetVirtualEventUid(Tcl_Interp *interp, char *virtString); static int HandleEventGenerate(Tcl_Interp *interp, Tk_Window main, @@ -688,15 +639,6 @@ static int ParseEventDescription(Tcl_Interp *interp, const char **eventStringPtr, TkPattern *patPtr, unsigned long *eventMaskPtr); static void DoWarp(ClientData clientData); - -/* - * The following define is used as a short circuit for the callback function - * to evaluate a TclBinding. The actual evaluation of the binding is handled - * inline, because special things have to be done with a Tcl binding before - * evaluation time. - */ - -#define EvalTclBinding ((TkBindEvalProc *) 1) /* *--------------------------------------------------------------------------- @@ -735,11 +677,11 @@ TkBindInit( Tcl_MutexLock(&bindMutex); if (!initialized) { Tcl_HashEntry *hPtr; - ModInfo *modPtr; - EventInfo *eiPtr; + const ModInfo *modPtr; + const EventInfo *eiPtr; int newEntry; #ifdef REDO_KEYSYM_LOOKUP - KeySymInfo *kPtr; + const KeySymInfo *kPtr; Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS); Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS); @@ -772,14 +714,13 @@ TkBindInit( mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp); - bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo)); + bindInfoPtr = ckalloc(sizeof(BindInfo)); InitVirtualEventTable(&bindInfoPtr->virtualEventTable); bindInfoPtr->screenInfo.curDispPtr = NULL; bindInfoPtr->screenInfo.curScreenIndex = -1; bindInfoPtr->screenInfo.bindingDepth = 0; - bindInfoPtr->pendingList = NULL; bindInfoPtr->deleted = 0; - mainPtr->bindInfo = (TkBindInfo) bindInfoPtr; + mainPtr->bindInfo = bindInfoPtr; TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable); } @@ -810,10 +751,10 @@ TkBindFree( Tk_DeleteBindingTable(mainPtr->bindingTable); mainPtr->bindingTable = NULL; - bindInfoPtr = (BindInfo *) mainPtr->bindInfo; + bindInfoPtr = mainPtr->bindInfo; DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable); bindInfoPtr->deleted = 1; - Tcl_EventuallyFree((ClientData) bindInfoPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(bindInfoPtr, TCL_DYNAMIC); mainPtr->bindInfo = NULL; } @@ -840,14 +781,13 @@ Tk_CreateBindingTable( * table: commands are executed in this * interpreter. */ { - BindingTable *bindPtr; + BindingTable *bindPtr = ckalloc(sizeof(BindingTable)); int i; /* * Create and initialize a new binding table. */ - bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable)); for (i = 0; i < EVENT_BUFFER_SIZE; i++) { bindPtr->eventRing[i].type = -1; } @@ -856,7 +796,7 @@ Tk_CreateBindingTable( sizeof(PatternTableKey)/sizeof(int)); Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS); bindPtr->interp = interp; - return (Tk_BindingTable) bindPtr; + return bindPtr; } /* @@ -878,10 +818,8 @@ Tk_CreateBindingTable( void Tk_DeleteBindingTable( - Tk_BindingTable bindingTable) - /* Token for the binding table to destroy. */ + Tk_BindingTable bindPtr) /* Token for the binding table to destroy. */ { - BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr, *nextPtr; Tcl_HashEntry *hPtr; Tcl_HashSearch search; @@ -892,16 +830,10 @@ Tk_DeleteBindingTable( for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); - psPtr != NULL; psPtr = nextPtr) { + for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) { nextPtr = psPtr->nextSeqPtr; - psPtr->flags |= MARKED_DELETED; - if (psPtr->refCount == 0) { - if (psPtr->freeProc != NULL) { - (*psPtr->freeProc)(psPtr->clientData); - } - ckfree((char *) psPtr); - } + ckfree(psPtr->script); + ckfree(psPtr); } } @@ -911,7 +843,7 @@ Tk_DeleteBindingTable( Tcl_DeleteHashTable(&bindPtr->patternTable); Tcl_DeleteHashTable(&bindPtr->objectTable); - ckfree((char *) bindPtr); + ckfree(bindPtr); } /* @@ -941,13 +873,12 @@ Tk_DeleteBindingTable( unsigned long Tk_CreateBinding( Tcl_Interp *interp, /* Used for error reporting. */ - Tk_BindingTable bindingTable, - /* Table in which to create binding. */ + Tk_BindingTable bindPtr, /* Table in which to create binding. */ ClientData object, /* Token for object with which binding is * associated. */ const char *eventString, /* String describing event sequence that * triggers binding. */ - const char *command, /* Contains Tcl command to execute when + const char *script, /* Contains Tcl script to execute when * binding triggers. */ int append) /* 0 means replace any existing binding for * eventString; 1 means append to that @@ -956,12 +887,11 @@ Tk_CreateBinding( * string, the existing binding will always be * replaced. */ { - BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr; unsigned long eventMask; char *newStr, *oldStr; - if (!*command) { + if (!*script) { /* Silently ignore empty scripts -- see SF#3006842 */ return 1; } @@ -970,7 +900,7 @@ Tk_CreateBinding( if (psPtr == NULL) { return 0; } - if (psPtr->eventProc == NULL) { + if (psPtr->script == NULL) { int isNew; Tcl_HashEntry *hPtr; @@ -985,120 +915,29 @@ Tk_CreateBinding( if (isNew) { psPtr->nextObjPtr = NULL; } else { - psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr); + psPtr->nextObjPtr = Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, psPtr); - } else if (psPtr->eventProc != EvalTclBinding) { - /* - * Free existing procedural binding. - */ - - if (psPtr->freeProc != NULL) { - (*psPtr->freeProc)(psPtr->clientData); - } - psPtr->clientData = NULL; - append = 0; } - oldStr = (char *) psPtr->clientData; + oldStr = psPtr->script; if ((append != 0) && (oldStr != NULL)) { - size_t length; + size_t length1 = strlen(oldStr), length2 = strlen(script); - length = strlen(oldStr) + strlen(command) + 2; - newStr = (char *) ckalloc((unsigned) length); - sprintf(newStr, "%s\n%s", oldStr, command); + newStr = ckalloc(length1 + length2 + 2); + memcpy(newStr, oldStr, length1); + newStr[length1] = '\n'; + memcpy(newStr+length1+1, script, length2+1); } else { - newStr = (char *) ckalloc((unsigned) strlen(command) + 1); - strcpy(newStr, command); + size_t length = strlen(script); + + newStr = ckalloc(length + 1); + memcpy(newStr, script, length+1); } if (oldStr != NULL) { ckfree(oldStr); } - psPtr->eventProc = EvalTclBinding; - psPtr->freeProc = FreeTclBinding; - psPtr->clientData = (ClientData) newStr; - return eventMask; -} - -/* - *--------------------------------------------------------------------------- - * - * TkCreateBindingProcedure -- - * - * Add a C binding to a binding table, so that future calls to - * Tk_BindEvent may callback the function in the binding. - * - * Results: - - * The return value is 0 if an error occurred while setting up the - * binding. In this case, an error message will be left in the interp's - * result. If all went well then the return value is a mask of the event - * types that must be made available to Tk_BindEvent in order to properly - * detect when this binding triggers. This value can be used to determine - * what events to select for in a window, for example. - * - * Side effects: - * Any existing binding on the same event sequence will be replaced. - * - *--------------------------------------------------------------------------- - */ - -unsigned long -TkCreateBindingProcedure( - Tcl_Interp *interp, /* Used for error reporting. */ - Tk_BindingTable bindingTable, - /* Table in which to create binding. */ - ClientData object, /* Token for object with which binding is - * associated. */ - const char *eventString, /* String describing event sequence that - * triggers binding. */ - TkBindEvalProc *eventProc, /* Function to invoke when binding triggers. - * Must not be NULL. */ - TkBindFreeProc *freeProc, /* Function to invoke when binding is freed. - * May be NULL for no function. */ - ClientData clientData) /* Arbitrary ClientData to pass to eventProc - * and freeProc. */ -{ - BindingTable *bindPtr = (BindingTable *) bindingTable; - PatSeq *psPtr; - unsigned long eventMask; - - psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString, - 1, 1, &eventMask); - if (psPtr == NULL) { - return 0; - } - if (psPtr->eventProc == NULL) { - int isNew; - Tcl_HashEntry *hPtr; - - /* - * This pattern sequence was just created. Link the pattern into the - * list associated with the object, so that if the object goes away, - * these bindings will all automatically be deleted. - */ - - hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object, - &isNew); - if (isNew) { - psPtr->nextObjPtr = NULL; - } else { - psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr); - } - Tcl_SetHashValue(hPtr, psPtr); - } else { - /* - * Free existing callback. - */ - - if (psPtr->freeProc != NULL) { - (*psPtr->freeProc)(psPtr->clientData); - } - } - - psPtr->eventProc = eventProc; - psPtr->freeProc = freeProc; - psPtr->clientData = clientData; + psPtr->script = newStr; return eventMask; } @@ -1123,14 +962,12 @@ TkCreateBindingProcedure( int Tk_DeleteBinding( Tcl_Interp *interp, /* Used for error reporting. */ - Tk_BindingTable bindingTable, - /* Table in which to delete binding. */ + Tk_BindingTable bindPtr, /* Table in which to delete binding. */ ClientData object, /* Token for object with which binding is * associated. */ const char *eventString) /* String describing event sequence that * triggers binding. */ { - BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr, *prevPtr; unsigned long eventMask; Tcl_HashEntry *hPtr; @@ -1151,7 +988,7 @@ Tk_DeleteBinding( if (hPtr == NULL) { Tcl_Panic("Tk_DeleteBinding couldn't find object table entry"); } - prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr); + prevPtr = Tcl_GetHashValue(hPtr); if (prevPtr == psPtr) { Tcl_SetHashValue(hPtr, psPtr->nextObjPtr); } else { @@ -1165,7 +1002,7 @@ Tk_DeleteBinding( } } } - prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr); + prevPtr = Tcl_GetHashValue(psPtr->hPtr); if (prevPtr == psPtr) { if (psPtr->nextSeqPtr == NULL) { Tcl_DeleteHashEntry(psPtr->hPtr); @@ -1184,13 +1021,8 @@ Tk_DeleteBinding( } } - psPtr->flags |= MARKED_DELETED; - if (psPtr->refCount == 0) { - if (psPtr->freeProc != NULL) { - (*psPtr->freeProc)(psPtr->clientData); - } - ckfree((char *) psPtr); - } + ckfree(psPtr->script); + ckfree(psPtr); return TCL_OK; } @@ -1199,10 +1031,10 @@ Tk_DeleteBinding( * * Tk_GetBinding -- * - * Return the command associated with a given event string. + * Return the script associated with a given event string. * * Results: - * The return value is a pointer to the command string associated with + * The return value is a pointer to the script associated with * eventString for object in the domain given by bindingTable. If there * is no binding for eventString, or if eventString is improperly formed, * then NULL is returned and an error message is left in the interp's @@ -1218,14 +1050,12 @@ Tk_DeleteBinding( const char * Tk_GetBinding( Tcl_Interp *interp, /* Interpreter for error reporting. */ - Tk_BindingTable bindingTable, - /* Table in which to look for binding. */ + Tk_BindingTable bindPtr, /* Table in which to look for binding. */ ClientData object, /* Token for object with which binding is * associated. */ const char *eventString) /* String describing event sequence that * triggers binding. */ { - BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr; unsigned long eventMask; @@ -1234,10 +1064,7 @@ Tk_GetBinding( if (psPtr == NULL) { return NULL; } - if (psPtr->eventProc == EvalTclBinding) { - return (const char *) psPtr->clientData; - } - return ""; + return psPtr->script; } /* @@ -1263,32 +1090,29 @@ Tk_GetBinding( void Tk_GetAllBindings( Tcl_Interp *interp, /* Interpreter returning result or error. */ - Tk_BindingTable bindingTable, - /* Table in which to look for bindings. */ + Tk_BindingTable bindPtr, /* Table in which to look for bindings. */ ClientData object) /* Token for object. */ { - BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr; Tcl_HashEntry *hPtr; - Tcl_DString ds; + Tcl_Obj *resultObj; hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object); if (hPtr == NULL) { return; } - Tcl_DStringInit(&ds); - for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; + + resultObj = Tcl_NewObj(); + for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = psPtr->nextObjPtr) { /* * For each binding, output information about each of the patterns in * its sequence. */ - Tcl_DStringSetLength(&ds, 0); - GetPatternString(psPtr, &ds); - Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + Tcl_ListObjAppendElement(NULL, resultObj, GetPatternObj(psPtr)); } - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, resultObj); } /* @@ -1310,11 +1134,9 @@ Tk_GetAllBindings( void Tk_DeleteAllBindings( - Tk_BindingTable bindingTable, - /* Table in which to delete bindings. */ + Tk_BindingTable bindPtr, /* Table in which to delete bindings. */ ClientData object) /* Token for object. */ { - BindingTable *bindPtr = (BindingTable *) bindingTable; PatSeq *psPtr, *prevPtr; PatSeq *nextPtr; Tcl_HashEntry *hPtr; @@ -1323,7 +1145,7 @@ Tk_DeleteAllBindings( if (hPtr == NULL) { return; } - for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; + for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = nextPtr) { nextPtr = psPtr->nextObjPtr; @@ -1333,7 +1155,7 @@ Tk_DeleteAllBindings( * hash entry too. */ - prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr); + prevPtr = Tcl_GetHashValue(psPtr->hPtr); if (prevPtr == psPtr) { if (psPtr->nextSeqPtr == NULL) { Tcl_DeleteHashEntry(psPtr->hPtr); @@ -1351,14 +1173,8 @@ Tk_DeleteAllBindings( } } } - psPtr->flags |= MARKED_DELETED; - - if (psPtr->refCount == 0) { - if (psPtr->freeProc != NULL) { - (*psPtr->freeProc)(psPtr->clientData); - } - ckfree((char *) psPtr); - } + ckfree(psPtr->script); + ckfree(psPtr); } Tcl_DeleteHashEntry(hPtr); } @@ -1378,27 +1194,19 @@ Tk_DeleteAllBindings( * None. * * Side effects: - * Depends on the command associated with the matching binding. + * Depends on the script associated with the matching binding. * - * All Tcl bindings scripts for each object are accumulated before the + * All Tcl binding scripts for each object are accumulated before the * first binding is evaluated. If the action of a Tcl binding is to * change or delete a binding, or delete the window associated with the * binding, all the original Tcl binding scripts will still fire. - * Contrast this with C binding functions. If a pending C binding (one - * that hasn't fired yet, but is queued to be fired for this window) is - * deleted, it will not be called, and if it is changed, then the new - * binding function will be called. If the window itself is deleted, no - * further C binding functions will be called for this window. When both - * Tcl binding scripts and C binding functions are interleaved, the above - * rules still apply. * *--------------------------------------------------------------------------- */ void Tk_BindEvent( - Tk_BindingTable bindingTable, - /* Table in which to look for bindings. */ + Tk_BindingTable bindPtr, /* Table in which to look for bindings. */ XEvent *eventPtr, /* What actually happened. */ Tk_Window tkwin, /* Window on display where event occurred * (needed in order to locate display @@ -1407,24 +1215,21 @@ Tk_BindEvent( ClientData *objectPtr) /* Array of one or more objects to check for a * matching binding. */ { - BindingTable *bindPtr; TkDisplay *dispPtr; ScreenInfo *screenPtr; BindInfo *bindInfoPtr; TkDisplay *oldDispPtr; XEvent *ringPtr; PatSeq *vMatchDetailList, *vMatchNoDetailList; - int flags, oldScreen, i, deferModal; - unsigned int matchCount, matchSpace; + int flags, oldScreen; unsigned int scriptCount; Tcl_Interp *interp; - Tcl_DString scripts, savedResult; + Tcl_DString scripts; + Tcl_InterpState interpState; Detail detail; char *p, *end; - PendingBinding staticPending, *pendingPtr; TkWindow *winPtr = (TkWindow *) tkwin; PatternTableKey key; - Tk_ClassModalProc *modalProc; /* * Ignore events on windows that don't have names: these are windows like @@ -1455,9 +1260,8 @@ Tk_BindEvent( } } - bindPtr = (BindingTable *) bindingTable; dispPtr = ((TkWindow *) tkwin)->dispPtr; - bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo; + bindInfoPtr = winPtr->mainPtr->bindInfo; /* * Add the new event to the ring of saved events for the binding table. @@ -1517,7 +1321,7 @@ Tk_BindEvent( } } ringPtr = &bindPtr->eventRing[bindPtr->curEvent]; - memcpy((void *) ringPtr, (void *) eventPtr, sizeof(XEvent)); + memcpy(ringPtr, eventPtr, sizeof(XEvent)); detail.clientData = 0; flags = flagArray[ringPtr->type]; if (flags & KEY) { @@ -1551,14 +1355,14 @@ Tk_BindEvent( hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key); if (hPtr != NULL) { - vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr); + vMatchDetailList = Tcl_GetHashValue(hPtr); } if (key.detail.clientData != 0) { key.detail.clientData = 0; hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key); if (hPtr != NULL) { - vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr); + vMatchNoDetailList = Tcl_GetHashValue(hPtr); } } } @@ -1567,14 +1371,10 @@ Tk_BindEvent( * Loop over all the binding tags, finding the binding script or callback * for each one. Append all of the binding scripts, with %-sequences * expanded, to "scripts", with null characters separating the scripts for - * each object. Append all the callbacks to the array of pending - * callbacks. + * each object. */ - pendingPtr = &staticPending; - matchCount = 0; scriptCount = 0; - matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *); Tcl_DStringInit(&scripts); for ( ; numObjects > 0; numObjects--, objectPtr++) { @@ -1594,9 +1394,8 @@ Tk_BindEvent( key.detail = detail; hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); if (hPtr != NULL) { - matchPtr = MatchPatterns(dispPtr, bindPtr, - (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL, - &sourcePtr); + matchPtr = MatchPatterns(dispPtr, bindPtr, Tcl_GetHashValue(hPtr), + matchPtr, NULL, &sourcePtr); } if (vMatchDetailList != NULL) { @@ -1614,47 +1413,18 @@ Tk_BindEvent( hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key); if (hPtr != NULL) { matchPtr = MatchPatterns(dispPtr, bindPtr, - (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL, - &sourcePtr); + Tcl_GetHashValue(hPtr), matchPtr, NULL, &sourcePtr); } if (vMatchNoDetailList != NULL) { matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList, matchPtr, objectPtr, &sourcePtr); } - } if (matchPtr != NULL) { - if (sourcePtr->eventProc == NULL) { - Tcl_Panic("Tk_BindEvent: missing command"); - } - if (sourcePtr->eventProc == EvalTclBinding) { - ExpandPercents(winPtr, (char *) sourcePtr->clientData, - eventPtr, detail.keySym, scriptCount++, &scripts); - } else { - if (matchCount >= matchSpace) { - PendingBinding *newPtr; - unsigned int oldSize, newSize; - - oldSize = sizeof(staticPending) - - sizeof(staticPending.matchArray) - + matchSpace * sizeof(PatSeq*); - matchSpace *= 2; - newSize = sizeof(staticPending) - - sizeof(staticPending.matchArray) - + matchSpace * sizeof(PatSeq*); - newPtr = (PendingBinding *) ckalloc(newSize); - memcpy((void *) newPtr, (void *) pendingPtr, oldSize); - if (pendingPtr != &staticPending) { - ckfree((char *) pendingPtr); - } - pendingPtr = newPtr; - } - sourcePtr->refCount++; - pendingPtr->matchArray[matchCount] = sourcePtr; - matchCount++; - } + ExpandPercents(winPtr, sourcePtr->script, eventPtr, + detail.keySym, scriptCount++, &scripts); /* * A "" is added to the scripts string to separate the various @@ -1686,14 +1456,13 @@ Tk_BindEvent( */ interp = bindPtr->interp; - Tcl_DStringInit(&savedResult); /* * Save information about the current screen, then invoke a script if the * screen has changed. */ - Tcl_DStringGetResult(interp, &savedResult); + interpState = Tcl_SaveInterpState(interp, TCL_OK); screenPtr = &bindInfoPtr->screenInfo; oldDispPtr = screenPtr->curDispPtr; oldScreen = screenPtr->curScreenIndex; @@ -1704,40 +1473,18 @@ Tk_BindEvent( ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex); } - if (matchCount > 0) { - /* - * Remember the list of pending C binding callbacks, so we can mark - * them as deleted and not call them if the act of evaluating a C or - * Tcl binding deletes a C binding callback or even the whole window. - */ - - pendingPtr->nextPtr = bindInfoPtr->pendingList; - pendingPtr->tkwin = tkwin; - pendingPtr->deleted = 0; - bindInfoPtr->pendingList = pendingPtr; - } - - /* - * Save the current value of the TK_DEFER_MODAL flag so we can restore it - * at the end of the loop. Clear the flag so we can detect any recursive - * requests for a modal loop. - */ - - flags = winPtr->flags; - winPtr->flags &= ~TK_DEFER_MODAL; - p = Tcl_DStringValue(&scripts); end = p + Tcl_DStringLength(&scripts); - i = 0; /* - * Be carefule when dereferencing screenPtr or bindInfoPtr. If we evaluate + * Be careful when dereferencing screenPtr or bindInfoPtr. If we evaluate * something that destroys ".", bindInfoPtr would have been freed, but we * can tell that by first checking to see if winPtr->mainPtr == NULL. */ - Tcl_Preserve((ClientData) bindInfoPtr); + Tcl_Preserve(bindInfoPtr); while (p < end) { + int len = (int) strlen(p); int code; if (!bindInfoPtr->deleted) { @@ -1745,31 +1492,8 @@ Tk_BindEvent( } Tcl_AllowExceptions(interp); - if (*p == '\0') { - PatSeq *psPtr; - - psPtr = pendingPtr->matchArray[i]; - i++; - code = TCL_OK; - if ((pendingPtr->deleted == 0) - && ((psPtr->flags & MARKED_DELETED) == 0)) { - code = (*psPtr->eventProc)(psPtr->clientData, interp, eventPtr, - tkwin, detail.keySym); - } - psPtr->refCount--; - if ((psPtr->refCount == 0) && (psPtr->flags & MARKED_DELETED)) { - if (psPtr->freeProc != NULL) { - (*psPtr->freeProc)(psPtr->clientData); - } - ckfree((char *) psPtr); - } - } else { - int len = (int) strlen(p); - - code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL); - p += len; - } - p++; + code = Tcl_EvalEx(interp, p, len, TCL_EVAL_GLOBAL); + p += len + 1; if (!bindInfoPtr->deleted) { screenPtr->bindingDepth--; @@ -1783,29 +1507,12 @@ Tk_BindEvent( break; } else { Tcl_AddErrorInfo(interp, "\n (command bound to event)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); break; } } } - if (matchCount > 0 && !pendingPtr->deleted) { - /* - * Restore the original modal flag value and invoke the modal loop if - * needed. - */ - - deferModal = winPtr->flags & TK_DEFER_MODAL; - winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL) - | (flags & TK_DEFER_MODAL); - if (deferModal) { - modalProc = Tk_GetClassProc(winPtr->classProcsPtr, modalProc); - if (modalProc != NULL) { - (*modalProc)(tkwin, eventPtr); - } - } - } - if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0) && ((oldDispPtr != screenPtr->curDispPtr) || (oldScreen != screenPtr->curScreenIndex))) { @@ -1818,74 +1525,10 @@ Tk_BindEvent( screenPtr->curScreenIndex = oldScreen; ChangeScreen(interp, oldDispPtr->name, oldScreen); } - Tcl_DStringResult(interp, &savedResult); + (void) Tcl_RestoreInterpState(interp, interpState); Tcl_DStringFree(&scripts); - if (matchCount > 0) { - if (!bindInfoPtr->deleted) { - /* - * Delete the pending list from the list of pending scripts for - * this window. - */ - - PendingBinding **curPtrPtr; - - for (curPtrPtr = &bindInfoPtr->pendingList; ; ) { - if (*curPtrPtr == pendingPtr) { - *curPtrPtr = pendingPtr->nextPtr; - break; - } - curPtrPtr = &(*curPtrPtr)->nextPtr; - } - } - if (pendingPtr != &staticPending) { - ckfree((char *) pendingPtr); - } - } - Tcl_Release((ClientData) bindInfoPtr); -} - -/* - *--------------------------------------------------------------------------- - * - * TkBindDeadWindow -- - * - * This function is invoked when it is determined that a window is dead. - * It cleans up bind-related information about the window - * - * Results: - * None. - * - * Side effects: - * Any pending C bindings for this window are cancelled. - * - *--------------------------------------------------------------------------- - */ - -void -TkBindDeadWindow( - TkWindow *winPtr) /* The window that is being deleted. */ -{ - BindInfo *bindInfoPtr; - PendingBinding *curPtr; - - /* - * Certain special windows like those used for send and clipboard have no - * mainPtr. - */ - - if (winPtr->mainPtr == NULL) { - return; - } - - bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo; - curPtr = bindInfoPtr->pendingList; - while (curPtr != NULL) { - if (curPtr->tkwin == (Tk_Window) winPtr) { - curPtr->deleted = 1; - } - curPtr = curPtr->nextPtr; - } + Tcl_Release(bindInfoPtr); } /* @@ -1924,6 +1567,7 @@ TkBindDeadWindow( * *---------------------------------------------------------------------- */ + static PatSeq * MatchPatterns( TkDisplay *dispPtr, /* Display from which the event came. */ @@ -2147,7 +1791,7 @@ MatchPatterns( * virtual event's definition. */ - PatSeq *virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr); + PatSeq *virtMatchPtr = Tcl_GetHashValue(hPtr); if ((virtMatchPtr->numPats != 1) || (virtMatchPtr->nextSeqPtr != NULL)) { @@ -2538,7 +2182,7 @@ ExpandPercents( goto doNumber; case 'K': if ((flags & KEY) && (eventPtr->type != MouseWheelEvent)) { - char *name = TkKeysymToString(keySym); + const char *name = TkKeysymToString(keySym); if (name != NULL) { string = name; @@ -2589,13 +2233,19 @@ ExpandPercents( } case 'X': if (flags & KEY_BUTTON_MOTION_CROSSING) { + number = eventPtr->xkey.x_root; + Tk_IdToWindow(eventPtr->xany.display, + eventPtr->xany.window); goto doNumber; } goto doString; case 'Y': if (flags & KEY_BUTTON_MOTION_CROSSING) { + number = eventPtr->xkey.y_root; + Tk_IdToWindow(eventPtr->xany.display, + eventPtr->xany.window); goto doNumber; } goto doString; @@ -2650,23 +2300,18 @@ ChangeScreen( char *dispName, /* Name of new display. */ int screenIndex) /* Index of new screen. */ { - Tcl_DString cmd; + Tcl_Obj *cmdObj = Tcl_ObjPrintf("::tk::ScreenChanged %s.%d", + dispName, screenIndex); int code; - char screen[TCL_INTEGER_SPACE]; - - Tcl_DStringInit(&cmd); - Tcl_DStringAppend(&cmd, "tk::ScreenChanged ", 18); - Tcl_DStringAppend(&cmd, dispName, -1); - sprintf(screen, ".%d", screenIndex); - Tcl_DStringAppend(&cmd, screen, -1); - code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), - TCL_EVAL_GLOBAL); - Tcl_DStringFree(&cmd); + + Tcl_IncrRefCount(cmdObj); + code = Tcl_EvalObjEx(interp, cmdObj, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (changing screen in event binding)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); } + Tcl_DecrRefCount(cmdObj); } /* @@ -2693,11 +2338,13 @@ Tk_EventObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int index; - Tk_Window tkwin; - VirtualEventTable *vetPtr; - TkBindInfo bindInfo; - static const char *optionStrings[] = { + int index, i; + char *name; + const char *event; + Tk_Window tkwin = clientData; + TkBindInfo bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo; + VirtualEventTable *vetPtr = &bindInfo->virtualEventTable; + static const char *const optionStrings[] = { "add", "delete", "generate", "info", NULL }; @@ -2705,24 +2352,18 @@ Tk_EventObjCmd( EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO }; - tkwin = (Tk_Window) clientData; - bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo; - vetPtr = &((BindInfo *) bindInfo)->virtualEventTable; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { - case EVENT_ADD: { - int i; - char *name, *event; - + case EVENT_ADD: if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "virtual sequence ?sequence ...?"); @@ -2736,14 +2377,9 @@ Tk_EventObjCmd( } } break; - } - case EVENT_DELETE: { - int i; - char *name, *event; - + case EVENT_DELETE: if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, - "virtual ?sequence sequence ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "virtual ?sequence ...?"); return TCL_ERROR; } name = Tcl_GetString(objv[2]); @@ -2757,10 +2393,10 @@ Tk_EventObjCmd( } } break; - } case EVENT_GENERATE: if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?"); + Tcl_WrongNumArgs(interp, 2, objv, + "window event ?-option value ...?"); return TCL_ERROR; } return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2); @@ -2769,7 +2405,7 @@ Tk_EventObjCmd( GetAllVirtualEvents(interp, vetPtr); return TCL_OK; } else if (objc == 3) { - return GetVirtualEvent(interp, vetPtr, Tcl_GetString(objv[2])); + return GetVirtualEvent(interp, vetPtr, objv[2]); } else { Tcl_WrongNumArgs(interp, 2, objv, "?virtual?"); return TCL_ERROR; @@ -2832,18 +2468,18 @@ DeleteVirtualEventTable( hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); + psPtr = Tcl_GetHashValue(hPtr); for ( ; psPtr != NULL; psPtr = nextPtr) { nextPtr = psPtr->nextSeqPtr; - ckfree((char *) psPtr->voPtr); - ckfree((char *) psPtr); + ckfree(psPtr->voPtr); + ckfree(psPtr); } } Tcl_DeleteHashTable(&vetPtr->patternTable); hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ckfree((char *) Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(&vetPtr->nameTable); } @@ -2873,7 +2509,7 @@ CreateVirtualEvent( Tcl_Interp *interp, /* Used for error reporting. */ VirtualEventTable *vetPtr, /* Table in which to augment virtual event. */ char *virtString, /* Name of new virtual event. */ - char *eventString) /* String describing physical event that + const char *eventString) /* String describing physical event that * triggers virtual event. */ { PatSeq *psPtr; @@ -2909,9 +2545,9 @@ CreateVirtualEvent( * Make virtual event own the physical event. */ - poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr); + poPtr = Tcl_GetHashValue(vhPtr); if (poPtr == NULL) { - poPtr = (PhysicalsOwned *) ckalloc(sizeof(PhysicalsOwned)); + poPtr = ckalloc(sizeof(PhysicalsOwned)); poPtr->numOwned = 0; } else { /* @@ -2926,10 +2562,10 @@ CreateVirtualEvent( return TCL_OK; } } - poPtr = (PhysicalsOwned *) ckrealloc((char *) poPtr, - sizeof(PhysicalsOwned) + poPtr->numOwned * sizeof(PatSeq *)); + poPtr = ckrealloc(poPtr, sizeof(PhysicalsOwned) + + poPtr->numOwned * sizeof(PatSeq *)); } - Tcl_SetHashValue(vhPtr, (ClientData) poPtr); + Tcl_SetHashValue(vhPtr, poPtr); poPtr->patSeqs[poPtr->numOwned] = psPtr; poPtr->numOwned++; @@ -2939,11 +2575,10 @@ CreateVirtualEvent( voPtr = psPtr->voPtr; if (voPtr == NULL) { - voPtr = (VirtualOwners *) ckalloc(sizeof(VirtualOwners)); + voPtr = ckalloc(sizeof(VirtualOwners)); voPtr->numOwners = 0; } else { - voPtr = (VirtualOwners *) ckrealloc((char *) voPtr, - sizeof(VirtualOwners) + voPtr = ckrealloc(voPtr, sizeof(VirtualOwners) + voPtr->numOwners * sizeof(Tcl_HashEntry *)); } psPtr->voPtr = voPtr; @@ -2982,7 +2617,7 @@ DeleteVirtualEvent( VirtualEventTable *vetPtr, /* Table in which to delete event. */ char *virtString, /* String describing event sequence that * triggers binding. */ - char *eventString) /* The event sequence that should be deleted, + const char *eventString) /* The event sequence that should be deleted, * or NULL to delete all event sequences for * the entire virtual event. */ { @@ -3001,7 +2636,7 @@ DeleteVirtualEvent( if (vhPtr == NULL) { return TCL_OK; } - poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr); + poPtr = Tcl_GetHashValue(vhPtr); eventPSPtr = NULL; if (eventString != NULL) { @@ -3016,7 +2651,7 @@ DeleteVirtualEvent( eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString, 0, 0, &eventMask); if (eventPSPtr == NULL) { - const char *string = Tcl_GetStringResult(interp); + const char *string = Tcl_GetString(Tcl_GetObjResult(interp)); return (string[0] != '\0') ? TCL_ERROR : TCL_OK; } @@ -3050,7 +2685,7 @@ DeleteVirtualEvent( * from physical->virtual map. */ - PatSeq *prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr); + PatSeq *prevPtr = Tcl_GetHashValue(psPtr->hPtr); if (prevPtr == psPtr) { if (psPtr->nextSeqPtr == NULL) { @@ -3070,8 +2705,8 @@ DeleteVirtualEvent( } } } - ckfree((char *) psPtr->voPtr); - ckfree((char *) psPtr); + ckfree(psPtr->voPtr); + ckfree(psPtr); } else { /* * This physical event still triggers some other virtual @@ -3108,7 +2743,7 @@ DeleteVirtualEvent( * itself should be deleted. */ - ckfree((char *) poPtr); + ckfree(poPtr); Tcl_DeleteHashEntry(vhPtr); } return TCL_OK; @@ -3140,15 +2775,15 @@ static int GetVirtualEvent( Tcl_Interp *interp, /* Interpreter for reporting. */ VirtualEventTable *vetPtr, /* Table in which to look for event. */ - char *virtString) /* String describing virtual event. */ + Tcl_Obj *virtName) /* String describing virtual event. */ { Tcl_HashEntry *vhPtr; - Tcl_DString ds; int iPhys; PhysicalsOwned *poPtr; Tk_Uid virtUid; + Tcl_Obj *resultObj; - virtUid = GetVirtualEventUid(interp, virtString); + virtUid = GetVirtualEventUid(interp, Tcl_GetString(virtName)); if (virtUid == NULL) { return TCL_ERROR; } @@ -3158,15 +2793,13 @@ GetVirtualEvent( return TCL_OK; } - Tcl_DStringInit(&ds); - - poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr); + resultObj = Tcl_NewObj(); + poPtr = Tcl_GetHashValue(vhPtr); for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) { - Tcl_DStringSetLength(&ds, 0); - GetPatternString(poPtr->patSeqs[iPhys], &ds); - Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + Tcl_ListObjAppendElement(NULL, resultObj, + GetPatternObj(poPtr->patSeqs[iPhys])); } - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -3196,20 +2829,15 @@ GetAllVirtualEvents( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - Tcl_DString ds; - - Tcl_DStringInit(&ds); + Tcl_Obj *resultObj; + resultObj = Tcl_NewObj(); hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, "<<", 2); - Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1); - Tcl_DStringAppend(&ds, ">>", 2); - Tcl_AppendElement(interp, Tcl_DStringValue(&ds)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( + "<<%s>>", (char *) Tcl_GetHashKey(hPtr->tablePtr, hPtr))); } - - Tcl_DStringFree(&ds); + Tcl_SetObjResult(interp, resultObj); } /* @@ -3256,7 +2884,7 @@ HandleEventGenerate( { union {XEvent general; XVirtualEvent virtual;} event; const char *p; - char *name, *windowName; + const char *name, *windowName; int count, flags, synch, i, number, warp; Tcl_QueuePosition pos; TkPattern pat; @@ -3264,7 +2892,8 @@ HandleEventGenerate( TkWindow *mainPtr; unsigned long eventMask; Tcl_Obj *userDataObj; - static const char *fieldStrings[] = { + + static const char *const fieldStrings[] = { "-when", "-above", "-borderwidth", "-button", "-count", "-data", "-delta", "-detail", "-focus", "-height", @@ -3295,8 +2924,11 @@ HandleEventGenerate( mainPtr = (TkWindow *) mainWin; if ((tkwin == NULL) || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { - Tcl_AppendResult(interp, "window id \"", Tcl_GetString(objv[0]), - "\" doesn't exist in this application", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window id \"%s\" doesn't exist in this application", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", + Tcl_GetString(objv[0]), NULL); return TCL_ERROR; } @@ -3310,17 +2942,19 @@ HandleEventGenerate( return TCL_ERROR; } if (count != 1) { - Tcl_SetResult(interp, "Double or Triple modifier not allowed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Double or Triple modifier not allowed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_MODIFIER", NULL); return TCL_ERROR; } if (*p != '\0') { - Tcl_SetResult(interp, "only one event specification allowed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "only one event specification allowed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MULTIPLE", NULL); return TCL_ERROR; } - memset((void *) &event, 0, sizeof(event)); + memset(&event, 0, sizeof(event)); event.general.xany.type = pat.eventType; event.general.xany.serial = NextRequest(Tk_Display(tkwin)); event.general.xany.send_event = False; @@ -3360,6 +2994,11 @@ HandleEventGenerate( event.general.xkey.y_root = -1; } + if (event.general.xany.type == FocusIn + || event.general.xany.type == FocusOut) { + event.general.xany.send_event = GENERATED_FOCUS_EVENT_MAGIC; + } + /* * Process the remaining arguments to fill in additional fields of the * event. @@ -3375,8 +3014,8 @@ HandleEventGenerate( optionPtr = objv[i]; valuePtr = objv[i + 1]; - if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, optionPtr, fieldStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } if (objc & 1) { @@ -3387,8 +3026,9 @@ HandleEventGenerate( * is missing. */ - Tcl_AppendResult(interp, "value for \"", Tcl_GetString(optionPtr), - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MISSING_VALUE", NULL); return TCL_ERROR; } @@ -3524,20 +3164,24 @@ HandleEventGenerate( break; case EVENT_KEYSYM: { KeySym keysym; - char *value; + const char *value; value = Tcl_GetString(valuePtr); keysym = TkStringToKeysym(value); if (keysym == NoSymbol) { - Tcl_AppendResult(interp, "unknown keysym \"", value, "\"", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown keysym \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", value, NULL); return TCL_ERROR; } TkpSetKeycodeAndState(tkwin, keysym, &event.general); if (event.general.xkey.keycode == 0) { - Tcl_AppendResult(interp, "no keycode for keysym \"", value, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no keycode for keysym \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYCODE", value, + NULL); return TCL_ERROR; } if (!(flags & KEY) @@ -3712,7 +3356,7 @@ HandleEventGenerate( if (Tk_GetPixelsFromObj(interp,tkwin,valuePtr,&number) != TCL_OK) { return TCL_ERROR; } - if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) { + if (flags & KEY_BUTTON_MOTION_CROSSING) { event.general.xkey.x = number; /* @@ -3766,12 +3410,22 @@ HandleEventGenerate( continue; badopt: - Tcl_AppendResult(interp, name, " event doesn't accept \"", - Tcl_GetString(optionPtr), "\" option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s event doesn't accept \"%s\" option", + name, Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_OPTION", NULL); return TCL_ERROR; } + + /* + * Don't generate events for windows that don't exist yet. + */ + + if (!event.general.xany.window) { + goto done; + } + if (userDataObj != NULL) { - XVirtualEvent *vePtr = (XVirtualEvent *) &event; /* * Must be virtual event to set that variable to non-NULL. Now we want @@ -3780,7 +3434,7 @@ HandleEventGenerate( * refcount will be decremented once the event has been processed. */ - vePtr->user_data = userDataObj; + event.virtual.user_data = userDataObj; Tcl_IncrRefCount(userDataObj); } @@ -3803,13 +3457,17 @@ HandleEventGenerate( TkDisplay *dispPtr = TkGetDisplay(event.general.xmotion.display); if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) { - Tcl_DoWhenIdle(DoWarp, (ClientData) dispPtr); + Tcl_DoWhenIdle(DoWarp, dispPtr); dispPtr->flags |= TK_DISPLAY_IN_WARP; } - dispPtr->warpWindow = event.general.xany.window; - dispPtr->warpX = event.general.xkey.x; - dispPtr->warpY = event.general.xkey.y; + dispPtr->warpWindow = Tk_IdToWindow(Tk_Display(mainWin), + event.general.xmotion.window); + dispPtr->warpMainwin = mainWin; + dispPtr->warpX = event.general.xmotion.x; + dispPtr->warpY = event.general.xmotion.y; } + + done: Tcl_ResetResult(interp); return TCL_OK; } @@ -3821,32 +3479,38 @@ NameToWindow( Tcl_Obj *objPtr, /* Contains name or id string of window. */ Tk_Window *tkwinPtr) /* Filled with token for window. */ { - char *name; + const char *name = Tcl_GetString(objPtr); Tk_Window tkwin; - Window id; - name = Tcl_GetString(objPtr); if (name[0] == '.') { tkwin = Tk_NameToWindow(interp, name, mainWin); if (tkwin == NULL) { return TCL_ERROR; } - *tkwinPtr = tkwin; } else { + Window id; + /* * Check for the winPtr being valid, even if it looks ok to * TkpScanWindowId. [Bug #411307] */ - if ((TkpScanWindowId(NULL, name, &id) != TCL_OK) || - ((*tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), id)) - == NULL)) { - Tcl_AppendResult(interp, "bad window name/identifier \"", - name, "\"", NULL); - return TCL_ERROR; + if (TkpScanWindowId(NULL, name, &id) != TCL_OK) { + goto badWindow; + } + tkwin = Tk_IdToWindow(Tk_Display(mainWin), id); + if (tkwin == NULL) { + goto badWindow; } } + *tkwinPtr = tkwin; return TCL_OK; + + badWindow: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window name/identifier \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW_ID", name, NULL); + return TCL_ERROR; } /* @@ -3864,14 +3528,14 @@ NameToWindow( * *------------------------------------------------------------------------- */ + static void DoWarp( ClientData clientData) { - TkDisplay *dispPtr = (TkDisplay *) clientData; + TkDisplay *dispPtr = clientData; - XWarpPointer(dispPtr->display, (Window) None, (Window) dispPtr->warpWindow, - 0, 0, 0, 0, (int) dispPtr->warpX, (int) dispPtr->warpY); + TkpWarpPointer(dispPtr); XForceScreenSaver(dispPtr->display, ScreenSaverReset); dispPtr->flags &= ~TK_DISPLAY_IN_WARP; } @@ -3908,8 +3572,9 @@ GetVirtualEventUid( if (length < 5 || virtString[0] != '<' || virtString[1] != '<' || virtString[length - 2] != '>' || virtString[length - 1] != '>') { - Tcl_AppendResult(interp, "virtual event \"", virtString, - "\" is badly formed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "virtual event \"%s\" is badly formed", virtString)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", NULL); return NULL; } virtString[length - 2] = '\0'; @@ -4001,9 +3666,11 @@ FindSequence( if (eventMask & VirtualEventMask) { if (allowVirtual == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "virtual event not allowed in definition of another virtual event", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "INNER", + NULL); return NULL; } virtualFound = 1; @@ -4029,12 +3696,16 @@ FindSequence( */ if (numPats == 0) { - Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no events specified in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NO_EVENTS", NULL); return NULL; } if ((numPats > 1) && (virtualFound != 0)) { - Tcl_SetResult(interp, "virtual events may not be composed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual events may not be composed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "COMPOSITION", + NULL); return NULL; } @@ -4046,12 +3717,11 @@ FindSequence( hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &isNew); sequenceSize = numPats*sizeof(TkPattern); if (!isNew) { - for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL; + for (psPtr = Tcl_GetHashValue(hPtr); psPtr != NULL; psPtr = psPtr->nextSeqPtr) { if ((numPats == psPtr->numPats) && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY)) - && (memcmp((char *) patPtr, (char *) psPtr->pats, - sequenceSize) == 0)) { + && (memcmp(patPtr, psPtr->pats, sequenceSize) == 0)) { goto done; } } @@ -4071,21 +3741,17 @@ FindSequence( return NULL; } - psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq) - + (numPats-1)*sizeof(TkPattern))); + psPtr = ckalloc(sizeof(PatSeq) + (numPats-1)*sizeof(TkPattern)); psPtr->numPats = numPats; - psPtr->eventProc = NULL; - psPtr->freeProc = NULL; - psPtr->clientData = NULL; + psPtr->script = NULL; psPtr->flags = flags; - psPtr->refCount = 0; - psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr); + psPtr->nextSeqPtr = Tcl_GetHashValue(hPtr); psPtr->hPtr = hPtr; psPtr->voPtr = NULL; psPtr->nextObjPtr = NULL; Tcl_SetHashValue(hPtr, psPtr); - memcpy((void *) psPtr->pats, (void *) patPtr, sequenceSize); + memcpy(psPtr->pats, patPtr, sequenceSize); done: *maskPtr = eventMask; @@ -4157,10 +3823,9 @@ ParseEventDescription( if (isprint(UCHAR(*p))) { patPtr->detail.keySym = *p; } else { - char buf[64]; - - sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ASCII character 0x%x", UCHAR(*p))); + Tcl_SetErrorCode(interp, "TK", "EVENT", "BAD_CHAR", NULL); count = 0; goto done; } @@ -4201,14 +3866,18 @@ ParseEventDescription( p = strchr(field, '>'); if (p == field) { - Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "virtual event \"<<>>\" is badly formed", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", + NULL); count = 0; goto done; } if ((p == NULL) || (p[1] != '>')) { - Tcl_SetResult(interp, "missing \">\" in virtual binding", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in virtual binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "VIRTUAL", "MALFORMED", + NULL); count = 0; goto done; } @@ -4239,7 +3908,7 @@ ParseEventDescription( if (hPtr == NULL) { break; } - modPtr = (ModInfo *) Tcl_GetHashValue(hPtr); + modPtr = Tcl_GetHashValue(hPtr); patPtr->needMods |= modPtr->mask; if (modPtr->flags & MULT_CLICKS) { int i = modPtr->flags & MULT_CLICKS; @@ -4257,7 +3926,7 @@ ParseEventDescription( eventFlags = 0; hPtr = Tcl_FindHashEntry(&eventTable, field); if (hPtr != NULL) { - EventInfo *eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr); + const EventInfo *eiPtr = Tcl_GetHashValue(hPtr); patPtr->eventType = eiPtr->type; eventFlags = flagArray[eiPtr->type]; @@ -4274,9 +3943,11 @@ ParseEventDescription( eventMask = ButtonPressMask; } else if (eventFlags & KEY) { goto getKeysym; - } else if ((eventFlags & BUTTON) == 0) { - Tcl_AppendResult(interp, "specified button \"", field, - "\" for non-button event", NULL); + } else if (!(eventFlags & BUTTON)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified button \"%s\" for non-button event", + field)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_BUTTON", NULL); count = 0; goto done; } @@ -4286,24 +3957,28 @@ ParseEventDescription( getKeysym: patPtr->detail.keySym = TkStringToKeysym(field); if (patPtr->detail.keySym == NoSymbol) { - Tcl_AppendResult(interp, "bad event type or keysym \"", - field, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad event type or keysym \"%s\"", field)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "KEYSYM", field, + NULL); count = 0; goto done; } if (eventFlags == 0) { patPtr->eventType = KeyPress; eventMask = KeyPressMask; - } else if ((eventFlags & KEY) == 0) { - Tcl_AppendResult(interp, "specified keysym \"", field, - "\" for non-key event", NULL); + } else if (!(eventFlags & KEY)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "specified keysym \"%s\" for non-key event", field)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "NON_KEY", NULL); count = 0; goto done; } } } else if (eventFlags == 0) { - Tcl_SetResult(interp, "no event type or button # or keysym", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no event type or button # or keysym", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "UNMODIFIABLE", NULL); count = 0; goto done; } @@ -4315,14 +3990,16 @@ ParseEventDescription( while (*p != '\0') { p++; if (*p == '>') { - Tcl_SetResult(interp, - "extra characters after detail in binding", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra characters after detail in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "PAST_DETAIL", NULL); count = 0; goto done; } } - Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing \">\" in binding", -1)); + Tcl_SetErrorCode(interp, "TK", "EVENT", "MALFORMED", NULL); count = 0; goto done; } @@ -4377,31 +4054,30 @@ GetField( /* *--------------------------------------------------------------------------- * - * GetPatternString -- + * GetPatternObj -- * * Produce a string version of the given event, for displaying to the * user. * * Results: - * The string is left in dsPtr. + * The string is returned as a Tcl_Obj. * * Side effects: - * It is the caller's responsibility to initialize the DString before and - * to free it after calling this function. + * It is the caller's responsibility to arrange for the object to be + * released; it starts with a refCount of zero. * *--------------------------------------------------------------------------- */ -static void -GetPatternString( - PatSeq *psPtr, - Tcl_DString *dsPtr) +static Tcl_Obj * +GetPatternObj( + PatSeq *psPtr) { TkPattern *patPtr; - char c, buffer[TCL_INTEGER_SPACE]; int patsLeft, needMods; - ModInfo *modPtr; - EventInfo *eiPtr; + const ModInfo *modPtr; + const EventInfo *eiPtr; + Tcl_Obj *patternObj = Tcl_NewObj(); /* * The order of the patterns in the sequence is backwards from the order @@ -4415,14 +4091,15 @@ GetPatternString( */ if ((patPtr->eventType == KeyPress) - && ((psPtr->flags & PAT_NEARBY) == 0) + && !(psPtr->flags & PAT_NEARBY) && (patPtr->needMods == 0) && (patPtr->detail.keySym < 128) && isprint(UCHAR(patPtr->detail.keySym)) && (patPtr->detail.keySym != '<') && (patPtr->detail.keySym != ' ')) { - c = (char) patPtr->detail.keySym; - Tcl_DStringAppend(dsPtr, &c, 1); + char c = (char) patPtr->detail.keySym; + + Tcl_AppendToObj(patternObj, &c, 1); continue; } @@ -4431,9 +4108,7 @@ GetPatternString( */ if (patPtr->eventType == VirtualEvent) { - Tcl_DStringAppend(dsPtr, "<<", 2); - Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1); - Tcl_DStringAppend(dsPtr, ">>", 2); + Tcl_AppendPrintfToObj(patternObj, "<<%s>>", patPtr->detail.name); continue; } @@ -4443,27 +4118,26 @@ GetPatternString( * or button detail. */ - Tcl_DStringAppend(dsPtr, "<", 1); + Tcl_AppendToObj(patternObj, "<", 1); if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1) - && (memcmp((char *) patPtr, (char *) (patPtr-1), - sizeof(TkPattern)) == 0)) { + && (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { patsLeft--; patPtr--; - if ((patsLeft > 1) && (memcmp((char *) patPtr, - (char *) (patPtr-1), sizeof(TkPattern)) == 0)) { + if ((patsLeft > 1) && + (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { patsLeft--; patPtr--; - if ((patsLeft > 1) && (memcmp((char *) patPtr, - (char *) (patPtr-1), sizeof(TkPattern)) == 0)) { - patsLeft--; - patPtr--; - Tcl_DStringAppend(dsPtr, "Quadruple-", 10); - } else { - Tcl_DStringAppend(dsPtr, "Triple-", 7); - } + if ((patsLeft > 1) && + (memcmp(patPtr, patPtr-1, sizeof(TkPattern)) == 0)) { + patsLeft--; + patPtr--; + Tcl_AppendToObj(patternObj, "Quadruple-", 10); + } else { + Tcl_AppendToObj(patternObj, "Triple-", 7); + } } else { - Tcl_DStringAppend(dsPtr, "Double-", 7); + Tcl_AppendToObj(patternObj, "Double-", 7); } } @@ -4471,16 +4145,15 @@ GetPatternString( needMods != 0; modPtr++) { if (modPtr->mask & needMods) { needMods &= ~modPtr->mask; - Tcl_DStringAppend(dsPtr, modPtr->name, -1); - Tcl_DStringAppend(dsPtr, "-", 1); + Tcl_AppendPrintfToObj(patternObj, "%s-", modPtr->name); } } for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) { if (eiPtr->type == patPtr->eventType) { - Tcl_DStringAppend(dsPtr, eiPtr->name, -1); + Tcl_AppendToObj(patternObj, eiPtr->name, -1); if (patPtr->detail.clientData != 0) { - Tcl_DStringAppend(dsPtr, "-", 1); + Tcl_AppendToObj(patternObj, "-", 1); } break; } @@ -4489,43 +4162,20 @@ GetPatternString( if (patPtr->detail.clientData != 0) { if ((patPtr->eventType == KeyPress) || (patPtr->eventType == KeyRelease)) { - char *string = TkKeysymToString(patPtr->detail.keySym); + const char *string = TkKeysymToString(patPtr->detail.keySym); + if (string != NULL) { - Tcl_DStringAppend(dsPtr, string, -1); + Tcl_AppendToObj(patternObj, string, -1); } } else { - sprintf(buffer, "%d", patPtr->detail.button); - Tcl_DStringAppend(dsPtr, buffer, -1); + Tcl_AppendPrintfToObj(patternObj, "%d", patPtr->detail.button); } } - Tcl_DStringAppend(dsPtr, ">", 1); + Tcl_AppendToObj(patternObj, ">", 1); } -} - -/* - *--------------------------------------------------------------------------- - * - * EvalTclBinding -- - * - * The function that is invoked by Tk_BindEvent when a Tcl binding is - * fired. - * - * Results: - * A standard Tcl result code, the result of globally evaluating the - * percent-substitued binding string. - * - * Side effects: - * Normal side effects due to eval. - * - *--------------------------------------------------------------------------- - */ -static void -FreeTclBinding( - ClientData clientData) -{ - ckfree((char *) clientData); + return patternObj; } /* @@ -4547,7 +4197,7 @@ FreeTclBinding( KeySym TkStringToKeysym( - char *name) /* Name of a keysym. */ + const char *name) /* Name of a keysym. */ { #ifdef REDO_KEYSYM_LOOKUP Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&keySymTable, name); @@ -4583,7 +4233,7 @@ TkStringToKeysym( *---------------------------------------------------------------------- */ -char * +const char * TkKeysymToString( KeySym keysym) { @@ -4591,7 +4241,7 @@ TkKeysymToString( Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym); if (hPtr != NULL) { - return (char *) Tcl_GetHashValue(hPtr); + return Tcl_GetHashValue(hPtr); } #endif /* REDO_KEYSYM_LOOKUP */ @@ -4601,41 +4251,6 @@ TkKeysymToString( /* *---------------------------------------------------------------------- * - * TkCopyAndGlobalEval -- - * - * 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. - * - * Results: - * Returns the result of evaluating script, including both a standard Tcl - * completion code and a string in the interp's result. - * - * Side effects: - * Any; depends on script. - * - *---------------------------------------------------------------------- - */ - -int -TkCopyAndGlobalEval( - Tcl_Interp *interp, /* Interpreter in which to evaluate script. */ - char *script) /* Script to evaluate. */ -{ - Tcl_DString buffer; - int code; - - Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, script, -1); - code = Tcl_EvalEx(interp, Tcl_DStringValue(&buffer), - Tcl_DStringLength(&buffer), TCL_EVAL_GLOBAL); - Tcl_DStringFree(&buffer); - return code; -} - -/* - *---------------------------------------------------------------------- - * * TkpGetBindingXEvent -- * * This function returns the XEvent associated with the currently @@ -4657,7 +4272,7 @@ TkpGetBindingXEvent( Tcl_Interp *interp) /* Interpreter. */ { TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp); - BindingTable *bindPtr = (BindingTable *) winPtr->mainPtr->bindingTable; + BindingTable *bindPtr = winPtr->mainPtr->bindingTable; return &(bindPtr->eventRing[bindPtr->curEvent]); } diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index f7df546..88f3e2b 100644 --- a/generic/tkBitmap.c +++ b/generic/tkBitmap.c @@ -108,6 +108,7 @@ static void BitmapInit(TkDisplay *dispPtr); static void DupBitmapObjProc(Tcl_Obj *srcObjPtr, Tcl_Obj *dupObjPtr); static void FreeBitmap(TkBitmap *bitmapPtr); +static void FreeBitmapObj(Tcl_Obj *objPtr); static void FreeBitmapObjProc(Tcl_Obj *objPtr); static TkBitmap * GetBitmap(Tcl_Interp *interp, Tk_Window tkwin, const char *name); @@ -120,7 +121,7 @@ static void InitBitmapObj(Tcl_Obj *objPtr); * field of the Tcl_Obj points to a TkBitmap object. */ -Tcl_ObjType tkBitmapObjType = { +const Tcl_ObjType tkBitmapObjType = { "bitmap", /* name */ FreeBitmapObjProc, /* freeIntRepProc */ DupBitmapObjProc, /* dupIntRepProc */ @@ -166,7 +167,7 @@ Tk_AllocBitmapFromObj( if (objPtr->typePtr != &tkBitmapObjType) { InitBitmapObj(objPtr); } - bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1; + bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * If the object currently points to a TkBitmap, see if it's the one we @@ -180,7 +181,7 @@ Tk_AllocBitmapFromObj( * longer in use. Clear the reference. */ - FreeBitmapObjProc(objPtr); + FreeBitmapObj(objPtr); bitmapPtr = NULL; } else if ((Tk_Display(tkwin) == bitmapPtr->display) && (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) { @@ -196,16 +197,16 @@ Tk_AllocBitmapFromObj( */ if (bitmapPtr != NULL) { - TkBitmap *firstBitmapPtr = (TkBitmap *) - Tcl_GetHashValue(bitmapPtr->nameHashPtr); - FreeBitmapObjProc(objPtr); + TkBitmap *firstBitmapPtr = Tcl_GetHashValue(bitmapPtr->nameHashPtr); + + FreeBitmapObj(objPtr); for (bitmapPtr = firstBitmapPtr; bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) { if ((Tk_Display(tkwin) == bitmapPtr->display) && (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) { bitmapPtr->resourceRefCount++; bitmapPtr->objRefCount++; - objPtr->internalRep.twoPtrValue.ptr1 = (void *) bitmapPtr; + objPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr; return bitmapPtr->bitmap; } } @@ -216,7 +217,7 @@ Tk_AllocBitmapFromObj( */ bitmapPtr = GetBitmap(interp, tkwin, Tcl_GetString(objPtr)); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) bitmapPtr; + objPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr; if (bitmapPtr == NULL) { return None; } @@ -306,7 +307,7 @@ GetBitmap( Pixmap bitmap; int isNew, width = 0, height = 0, dummy2; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!dispPtr->bitmapInit) { @@ -316,11 +317,11 @@ GetBitmap( nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string, &isNew); if (!isNew) { - existingBitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr); + existingBitmapPtr = Tcl_GetHashValue(nameHashPtr); for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) { - if ( (Tk_Display(tkwin) == bitmapPtr->display) && - (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum) ) { + if ((Tk_Display(tkwin) == bitmapPtr->display) && + (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) { bitmapPtr->resourceRefCount++; return bitmapPtr; } @@ -341,8 +342,10 @@ GetBitmap( int result; if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't specify bitmap with '@' in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify bitmap with '@' in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL); goto error; } @@ -362,8 +365,9 @@ GetBitmap( &bitmap, &dummy2, &dummy2); if (result != BitmapSuccess) { if (interp != NULL) { - Tcl_AppendResult(interp, "error reading bitmap file \"", - string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading bitmap file \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "BITMAP", "FILE_ERROR", NULL); } Tcl_DStringFree(&buffer); goto error; @@ -383,13 +387,15 @@ GetBitmap( if (bitmap == None) { if (interp != NULL) { - Tcl_AppendResult(interp, "bitmap \"", string, - "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bitmap \"%s\" not defined", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BITMAP", string, + NULL); } goto error; } } else { - predefPtr = (TkPredefBitmap *) Tcl_GetHashValue(predefHashPtr); + predefPtr = Tcl_GetHashValue(predefHashPtr); width = predefPtr->width; height = predefPtr->height; if (predefPtr->native) { @@ -410,7 +416,7 @@ GetBitmap( * Add information about this bitmap to our database. */ - bitmapPtr = (TkBitmap *) ckalloc(sizeof(TkBitmap)); + bitmapPtr = ckalloc(sizeof(TkBitmap)); bitmapPtr->bitmap = bitmap; bitmapPtr->width = width; bitmapPtr->height = height; @@ -461,14 +467,14 @@ Tk_DefineBitmap( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ const char *name, /* Name to use for bitmap. Must not already be * defined as a bitmap. */ - const char *source, /* Address of bits for bitmap. */ + const void *source, /* Address of bits for bitmap. */ int width, /* Width of bitmap. */ int height) /* Height of bitmap. */ { int isNew; Tcl_HashEntry *predefHashPtr; TkPredefBitmap *predefPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -486,11 +492,12 @@ Tk_DefineBitmap( predefHashPtr = Tcl_CreateHashEntry(&tsdPtr->predefBitmapTable, name, &isNew); if (!isNew) { - Tcl_AppendResult(interp, "bitmap \"", name, "\" is already defined", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bitmap \"%s\" is already defined", name)); + Tcl_SetErrorCode(interp, "TK", "BITMAP", "EXISTS", NULL); return TCL_ERROR; } - predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap)); + predefPtr = ckalloc(sizeof(TkPredefBitmap)); predefPtr->source = source; predefPtr->width = width; predefPtr->height = height; @@ -533,7 +540,7 @@ Tk_NameOfBitmap( if (idHashPtr == NULL) { goto unknown; } - bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr); + bitmapPtr = Tcl_GetHashValue(idHashPtr); return bitmapPtr->nameHashPtr->key.string; } @@ -575,7 +582,7 @@ Tk_SizeOfBitmap( if (idHashPtr == NULL) { goto unknownBitmap; } - bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr); + bitmapPtr = Tcl_GetHashValue(idHashPtr); *widthPtr = bitmapPtr->width; *heightPtr = bitmapPtr->height; } @@ -612,7 +619,7 @@ FreeBitmap( Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap); Tcl_DeleteHashEntry(bitmapPtr->idHashPtr); - prevPtr = (TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr); + prevPtr = Tcl_GetHashValue(bitmapPtr->nameHashPtr); if (prevPtr == bitmapPtr) { if (bitmapPtr->nextPtr == NULL) { Tcl_DeleteHashEntry(bitmapPtr->nameHashPtr); @@ -626,7 +633,7 @@ FreeBitmap( prevPtr->nextPtr = bitmapPtr->nextPtr; } if (bitmapPtr->objRefCount == 0) { - ckfree((char *) bitmapPtr); + ckfree(bitmapPtr); } } @@ -664,7 +671,7 @@ Tk_FreeBitmap( if (idHashPtr == NULL) { Tcl_Panic("Tk_FreeBitmap received unknown bitmap argument"); } - FreeBitmap((TkBitmap *) Tcl_GetHashValue(idHashPtr)); + FreeBitmap(Tcl_GetHashValue(idHashPtr)); } /* @@ -700,7 +707,7 @@ Tk_FreeBitmapFromObj( /* *--------------------------------------------------------------------------- * - * FreeBitmapObjProc -- + * FreeBitmapObjProc, FreeBitmapObj -- * * This proc is called to release an object reference to a bitmap. * Called when the object's internal rep is released or when the cached @@ -720,13 +727,21 @@ static void FreeBitmapObjProc( Tcl_Obj *objPtr) /* The object we are releasing. */ { - TkBitmap *bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1; + FreeBitmapObj(objPtr); + objPtr->typePtr = NULL; +} + +static void +FreeBitmapObj( + Tcl_Obj *objPtr) /* The object we are releasing. */ +{ + TkBitmap *bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1; if (bitmapPtr != NULL) { bitmapPtr->objRefCount--; if ((bitmapPtr->objRefCount == 0) && (bitmapPtr->resourceRefCount == 0)) { - ckfree((char *) bitmapPtr); + ckfree(bitmapPtr); } objPtr->internalRep.twoPtrValue.ptr1 = NULL; } @@ -755,10 +770,10 @@ DupBitmapObjProc( Tcl_Obj *srcObjPtr, /* The object we are copying from. */ Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { - TkBitmap *bitmapPtr = (TkBitmap *) srcObjPtr->internalRep.twoPtrValue.ptr1; + TkBitmap *bitmapPtr = srcObjPtr->internalRep.twoPtrValue.ptr1; dupObjPtr->typePtr = srcObjPtr->typePtr; - dupObjPtr->internalRep.twoPtrValue.ptr1 = (void *) bitmapPtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr; if (bitmapPtr != NULL) { bitmapPtr->objRefCount++; @@ -796,7 +811,7 @@ Pixmap Tk_GetBitmapFromData( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tk_Window tkwin, /* Window in which bitmap will be used. */ - const char *source, /* Bitmap data for bitmap shape. */ + const void *source, /* Bitmap data for bitmap shape. */ int width, int height) /* Dimensions of bitmap. */ { DataKey nameKey; @@ -805,7 +820,7 @@ Tk_GetBitmapFromData( char string[16 + TCL_INTEGER_SPACE]; char *name; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { @@ -818,7 +833,7 @@ Tk_GetBitmapFromData( dataHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapDataTable, (char *) &nameKey, &isNew); if (!isNew) { - name = (char *) Tcl_GetHashValue(dataHashPtr); + name = Tcl_GetHashValue(dataHashPtr); } else { dispPtr->bitmapAutoNumber++; sprintf(string, "_tk%d", dispPtr->bitmapAutoNumber); @@ -896,14 +911,14 @@ GetBitmapFromObj( InitBitmapObj(objPtr); } - bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1; + bitmapPtr = objPtr->internalRep.twoPtrValue.ptr1; if (bitmapPtr != NULL) { if ((bitmapPtr->resourceRefCount > 0) && (Tk_Display(tkwin) == bitmapPtr->display)) { return bitmapPtr; } hashPtr = bitmapPtr->nameHashPtr; - FreeBitmapObjProc(objPtr); + FreeBitmapObj(objPtr); } else { hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable, Tcl_GetString(objPtr)); @@ -917,10 +932,10 @@ GetBitmapFromObj( * more TkBitmap structures. See if any of them will work. */ - for (bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr); - bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) { + for (bitmapPtr = Tcl_GetHashValue(hashPtr); bitmapPtr != NULL; + bitmapPtr = bitmapPtr->nextPtr) { if (Tk_Display(tkwin) == bitmapPtr->display) { - objPtr->internalRep.twoPtrValue.ptr1 = (void *) bitmapPtr; + objPtr->internalRep.twoPtrValue.ptr1 = bitmapPtr; bitmapPtr->objRefCount++; return bitmapPtr; } @@ -965,7 +980,7 @@ InitBitmapObj( Tcl_GetString(objPtr); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &tkBitmapObjType; objPtr->internalRep.twoPtrValue.ptr1 = NULL; @@ -997,7 +1012,7 @@ BitmapInit( * or NULL if unavailable. */ { Tcl_Interp *dummy; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1010,25 +1025,25 @@ BitmapInit( dummy = Tcl_CreateInterp(); Tcl_InitHashTable(&tsdPtr->predefBitmapTable, TCL_STRING_KEYS); - Tk_DefineBitmap(dummy, "error", (char *) error_bits, + Tk_DefineBitmap(dummy, "error", error_bits, error_width, error_height); - Tk_DefineBitmap(dummy, "gray75", (char *) gray75_bits, + Tk_DefineBitmap(dummy, "gray75", gray75_bits, gray75_width, gray75_height); - Tk_DefineBitmap(dummy, "gray50", (char *) gray50_bits, + Tk_DefineBitmap(dummy, "gray50", gray50_bits, gray50_width, gray50_height); - Tk_DefineBitmap(dummy, "gray25", (char *) gray25_bits, + Tk_DefineBitmap(dummy, "gray25", gray25_bits, gray25_width, gray25_height); - Tk_DefineBitmap(dummy, "gray12", (char *) gray12_bits, + Tk_DefineBitmap(dummy, "gray12", gray12_bits, gray12_width, gray12_height); - Tk_DefineBitmap(dummy, "hourglass", (char *) hourglass_bits, + Tk_DefineBitmap(dummy, "hourglass", hourglass_bits, hourglass_width, hourglass_height); - Tk_DefineBitmap(dummy, "info", (char *) info_bits, + Tk_DefineBitmap(dummy, "info", info_bits, info_width, info_height); - Tk_DefineBitmap(dummy, "questhead", (char *) questhead_bits, + Tk_DefineBitmap(dummy, "questhead", questhead_bits, questhead_width, questhead_height); - Tk_DefineBitmap(dummy, "question", (char *) question_bits, + Tk_DefineBitmap(dummy, "question", question_bits, question_width, question_height); - Tk_DefineBitmap(dummy, "warning", (char *) warning_bits, + Tk_DefineBitmap(dummy, "warning", warning_bits, warning_width, warning_height); TkpDefineNativeBitmaps(); @@ -1089,7 +1104,7 @@ TkReadBitmapFile( { char *data; - data = TkGetBitmapData(NULL, NULL, (char *) filename, + data = TkGetBitmapData(NULL, NULL, filename, (int *) width_return, (int *) height_return, x_hot_return, y_hot_return); if (data == NULL) { @@ -1125,7 +1140,7 @@ Tcl_Obj * TkDebugBitmap( Tk_Window tkwin, /* The window in which the bitmap will be used * (not currently used). */ - char *name) /* Name of the desired color. */ + const char *name) /* Name of the desired color. */ { TkBitmap *bitmapPtr; Tcl_HashEntry *hashPtr; @@ -1135,7 +1150,7 @@ TkDebugBitmap( resultPtr = Tcl_NewObj(); hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable, name); if (hashPtr != NULL) { - bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr); + bitmapPtr = Tcl_GetHashValue(hashPtr); if (bitmapPtr == NULL) { Tcl_Panic("TkDebugBitmap found empty hash table entry"); } @@ -1175,7 +1190,7 @@ TkDebugBitmap( Tcl_HashTable * TkGetBitmapPredefTable(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); return &tsdPtr->predefBitmapTable; diff --git a/generic/tkBusy.c b/generic/tkBusy.c new file mode 100644 index 0000000..65248a2 --- /dev/null +++ b/generic/tkBusy.c @@ -0,0 +1,928 @@ +/* + * tkBusy.c -- + * + * This file provides functions that implement busy for Tk. + * + * Copyright 1993-1998 Lucent Technologies, Inc. + * + * The "busy" command was created by George Howlett. Adapted for + * integration into Tk by Jos Decoster and Donal K. Fellows. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tkInt.h" +#include "tkBusy.h" +#include "default.h" + +/* + * Things about the busy system that may be configured. Note that currently on + * OSX/Aqua, that's nothing at all. + */ + +static const Tk_OptionSpec busyOptionSpecs[] = { +#ifndef MAC_OSX_TK + {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", + DEF_BUSY_CURSOR, -1, Tk_Offset(Busy, cursor), + TK_OPTION_NULL_OK, 0, 0}, +#endif + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} +}; + +/* + * Forward declarations of functions defined in this file. + */ + +static void BusyEventProc(ClientData clientData, + XEvent *eventPtr); +static void BusyGeometryProc(ClientData clientData, + Tk_Window tkwin); +static void BusyCustodyProc(ClientData clientData, + Tk_Window tkwin); +static int ConfigureBusy(Tcl_Interp *interp, Busy *busyPtr, + int objc, Tcl_Obj *const objv[]); +static Busy * CreateBusy(Tcl_Interp *interp, Tk_Window tkRef); +static void DestroyBusy(void *dataPtr); +static void DoConfigureNotify(Tk_FakeWin *winPtr); +static inline Tk_Window FirstChild(Tk_Window parent); +static Busy * GetBusy(Tcl_Interp *interp, + Tcl_HashTable *busyTablePtr, + Tcl_Obj *const windowObj); +static int HoldBusy(Tcl_HashTable *busyTablePtr, + Tcl_Interp *interp, Tcl_Obj *const windowObj, + int configObjc, Tcl_Obj *const configObjv[]); +static void MakeTransparentWindowExist(Tk_Window tkwin, + Window parent); +static inline Tk_Window NextChild(Tk_Window tkwin); +static void RefWinEventProc(ClientData clientData, + register XEvent *eventPtr); +static inline void SetWindowInstanceData(Tk_Window tkwin, + ClientData instanceData); + +/* + * The "busy" geometry manager definition. + */ + +static Tk_GeomMgr busyMgrInfo = { + "busy", /* Name of geometry manager used by winfo */ + BusyGeometryProc, /* Procedure to for new geometry requests */ + BusyCustodyProc, /* Procedure when window is taken away */ +}; + +/* + * Helper functions, need to check if a Tcl/Tk alternative already exists. + */ + +static inline Tk_Window +FirstChild( + Tk_Window parent) +{ + struct TkWindow *parentPtr = (struct TkWindow *) parent; + + return (Tk_Window) parentPtr->childList; +} + +static inline Tk_Window +NextChild( + Tk_Window tkwin) +{ + struct TkWindow *winPtr = (struct TkWindow *) tkwin; + + if (winPtr == NULL) { + return NULL; + } + return (Tk_Window) winPtr->nextPtr; +} + +static inline void +SetWindowInstanceData( + Tk_Window tkwin, + ClientData instanceData) +{ + struct TkWindow *winPtr = (struct TkWindow *) tkwin; + + winPtr->instanceData = instanceData; +} + +/* + *---------------------------------------------------------------------- + * + * BusyCustodyProc -- + * + * This procedure is invoked when the busy window has been stolen by + * another geometry manager. The information and memory associated with + * the busy window is released. I don't know why anyone would try to pack + * a busy window, but this should keep everything sane, if it is. + * + * Results: + * None. + * + * Side effects: + * The Busy structure is freed at the next idle point. + * + *---------------------------------------------------------------------- + */ + +/* ARGSUSED */ +static void +BusyCustodyProc( + ClientData clientData, /* Information about the busy window. */ + Tk_Window tkwin) /* Not used. */ +{ + Busy *busyPtr = clientData; + + Tk_DeleteEventHandler(busyPtr->tkBusy, StructureNotifyMask, BusyEventProc, + busyPtr); + TkpHideBusyWindow(busyPtr); + busyPtr->tkBusy = NULL; + Tcl_EventuallyFree(busyPtr, (Tcl_FreeProc *)DestroyBusy); +} + +/* + *---------------------------------------------------------------------- + * + * BusyGeometryProc -- + * + * This procedure is invoked by Tk_GeometryRequest for busy windows. + * Busy windows never request geometry, so it's unlikely that this + * function will ever be called;it exists simply as a place holder for + * the GeomProc in the Geometry Manager structure. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +/* ARGSUSED */ +static void +BusyGeometryProc( + ClientData clientData, /* Information about window that got new + * preferred geometry. */ + Tk_Window tkwin) /* Other Tk-related information about the + * window. */ +{ + /* Should never get here */ +} + +/* + *---------------------------------------------------------------------- + * + * DoConfigureNotify -- + * + * Generate a ConfigureNotify event describing the current configuration + * of a window. + * + * Results: + * None. + * + * Side effects: + * An event is generated and processed by Tk_HandleEvent. + * + *---------------------------------------------------------------------- + */ + +static void +DoConfigureNotify( + Tk_FakeWin *winPtr) /* Window whose configuration was just + * changed. */ +{ + XEvent event; + + event.type = ConfigureNotify; + event.xconfigure.serial = LastKnownRequestProcessed(winPtr->display); + event.xconfigure.send_event = False; + event.xconfigure.display = winPtr->display; + event.xconfigure.event = winPtr->window; + event.xconfigure.window = winPtr->window; + event.xconfigure.x = winPtr->changes.x; + event.xconfigure.y = winPtr->changes.y; + event.xconfigure.width = winPtr->changes.width; + event.xconfigure.height = winPtr->changes.height; + event.xconfigure.border_width = winPtr->changes.border_width; + if (winPtr->changes.stack_mode == Above) { + event.xconfigure.above = winPtr->changes.sibling; + } else { + event.xconfigure.above = None; + } + event.xconfigure.override_redirect = winPtr->atts.override_redirect; + Tk_HandleEvent(&event); +} + +/* + *---------------------------------------------------------------------- + * + * RefWinEventProc -- + * + * This procedure is invoked by the Tk dispatcher for the following + * events on the reference window. If the reference and parent windows + * are the same, only the first event is important. + * + * 1) ConfigureNotify The reference window has been resized or + * moved. Move and resize the busy window to be + * the same size and position of the reference + * window. + * + * 2) DestroyNotify The reference window was destroyed. Destroy + * the busy window and the free resources used. + * + * 3) MapNotify The reference window was (re)shown. Map the + * busy window again. + * + * 4) UnmapNotify The reference window was hidden. Unmap the + * busy window. + * + * Results: + * None. + * + * Side effects: + * When the reference window gets deleted, internal structures get + * cleaned up. When it gets resized, the busy window is resized + * accordingly. If it's displayed, the busy window is displayed. And when + * it's hidden, the busy window is unmapped. + * + *---------------------------------------------------------------------- + */ + +static void +RefWinEventProc( + ClientData clientData, /* Busy window record */ + register XEvent *eventPtr) /* Event which triggered call to routine */ +{ + register Busy *busyPtr = clientData; + + switch (eventPtr->type) { + case ReparentNotify: + case DestroyNotify: + /* + * Arrange for the busy structure to be removed at a proper time. + */ + + Tcl_EventuallyFree(busyPtr, (Tcl_FreeProc *)DestroyBusy); + break; + + case ConfigureNotify: + if ((busyPtr->width != Tk_Width(busyPtr->tkRef)) || + (busyPtr->height != Tk_Height(busyPtr->tkRef)) || + (busyPtr->x != Tk_X(busyPtr->tkRef)) || + (busyPtr->y != Tk_Y(busyPtr->tkRef))) { + int x, y; + + busyPtr->width = Tk_Width(busyPtr->tkRef); + busyPtr->height = Tk_Height(busyPtr->tkRef); + busyPtr->x = Tk_X(busyPtr->tkRef); + busyPtr->y = Tk_Y(busyPtr->tkRef); + + x = y = 0; + + if (busyPtr->tkParent != busyPtr->tkRef) { + Tk_Window tkwin; + + for (tkwin = busyPtr->tkRef; (tkwin != NULL) && + (!Tk_IsTopLevel(tkwin)); tkwin = Tk_Parent(tkwin)) { + if (tkwin == busyPtr->tkParent) { + break; + } + x += Tk_X(tkwin) + Tk_Changes(tkwin)->border_width; + y += Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width; + } + } + if (busyPtr->tkBusy != NULL) { + Tk_MoveResizeWindow(busyPtr->tkBusy, x, y, busyPtr->width, + busyPtr->height); + TkpShowBusyWindow(busyPtr); + } + } + break; + + case MapNotify: + if (busyPtr->tkParent != busyPtr->tkRef) { + TkpShowBusyWindow(busyPtr); + } + break; + + case UnmapNotify: + if (busyPtr->tkParent != busyPtr->tkRef) { + TkpHideBusyWindow(busyPtr); + } + break; + } +} + +/* + *---------------------------------------------------------------------- + * + * DestroyBusy -- + * + * This procedure is called from the Tk event dispatcher. It releases X + * resources and memory used by the busy window and updates the internal + * hash table. + * + * Results: + * None. + * + * Side effects: + * Memory and resources are released and the Tk event handler is removed. + * + *---------------------------------------------------------------------- + */ + +static void +DestroyBusy( + void *data) /* Busy window structure record */ +{ + register Busy *busyPtr = data; + + if (busyPtr->hashPtr != NULL) { + Tcl_DeleteHashEntry(busyPtr->hashPtr); + } + Tk_DeleteEventHandler(busyPtr->tkRef, StructureNotifyMask, + RefWinEventProc, busyPtr); + + if (busyPtr->tkBusy != NULL) { + Tk_FreeConfigOptions(data, busyPtr->optionTable, busyPtr->tkBusy); + Tk_DeleteEventHandler(busyPtr->tkBusy, StructureNotifyMask, + BusyEventProc, busyPtr); + Tk_ManageGeometry(busyPtr->tkBusy, NULL, busyPtr); + Tk_DestroyWindow(busyPtr->tkBusy); + } + ckfree(data); +} + +/* + *---------------------------------------------------------------------- + * + * BusyEventProc -- + * + * This procedure is invoked by the Tk dispatcher for events on the busy + * window itself. We're only concerned with destroy events. + * + * It might be necessary (someday) to watch resize events. Right now, I + * don't think there's any point in it. + * + * Results: + * None. + * + * Side effects: + * When a busy window is destroyed, all internal structures associated + * with it released at the next idle point. + * + *---------------------------------------------------------------------- + */ + +static void +BusyEventProc( + ClientData clientData, /* Busy window record */ + XEvent *eventPtr) /* Event which triggered call to routine */ +{ + Busy *busyPtr = clientData; + + if (eventPtr->type == DestroyNotify) { + busyPtr->tkBusy = NULL; + Tcl_EventuallyFree(busyPtr, (Tcl_FreeProc *)DestroyBusy); + } +} + +/* + *---------------------------------------------------------------------- + * + * MakeTransparentWindowExist -- + * + * Similar to Tk_MakeWindowExist but instead creates a transparent window + * to block for user events from sibling windows. + * + * Differences from Tk_MakeWindowExist. + * + * 1. This is always a "busy" window. There's never a platform-specific + * class procedure to execute instead. + * 2. The window is transparent and never will contain children, so + * colormap information is irrelevant. + * + * Results: + * None. + * + * Side effects: + * When the procedure returns, the internal window associated with tkwin + * is guaranteed to exist. This may require the window's ancestors to be + * created too. + * + *---------------------------------------------------------------------- + */ + +static void +MakeTransparentWindowExist( + Tk_Window tkwin, /* Token for window. */ + Window parent) /* Parent window. */ +{ + TkWindow *winPtr = (TkWindow *) tkwin; + Tcl_HashEntry *hPtr; + int notUsed; + TkDisplay *dispPtr; + + if (winPtr->window != None) { + return; /* Window already exists. */ + } + + /* + * Create a transparent window and put it on top. + */ + + TkpMakeTransparentWindowExist(tkwin, parent); + + dispPtr = winPtr->dispPtr; + hPtr = Tcl_CreateHashEntry(&dispPtr->winTable, (char *) winPtr->window, + ¬Used); + Tcl_SetHashValue(hPtr, winPtr); + winPtr->dirtyAtts = 0; + winPtr->dirtyChanges = 0; + + if (!(winPtr->flags & TK_TOP_HIERARCHY)) { + TkWindow *winPtr2; + + /* + * If any siblings higher up in the stacking order have already been + * created then move this window to its rightful position in the + * stacking order. + * + * NOTE: this code ignores any changes anyone might have made to the + * sibling and stack_mode field of the window's attributes, so it + * really isn't safe for these to be manipulated except by calling + * Tk_RestackWindow. + */ + + for (winPtr2 = winPtr->nextPtr; winPtr2 != NULL; + winPtr2 = winPtr2->nextPtr) { + if ((winPtr2->window != None) && + !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) { + XWindowChanges changes; + + changes.sibling = winPtr2->window; + changes.stack_mode = Below; + XConfigureWindow(winPtr->display, winPtr->window, + CWSibling | CWStackMode, &changes); + break; + } + } + } + + /* + * Issue a ConfigureNotify event if there were deferred configuration + * changes (but skip it if the window is being deleted; the + * ConfigureNotify event could cause problems if we're being called from + * Tk_DestroyWindow under some conditions). + */ + + if ((winPtr->flags & TK_NEED_CONFIG_NOTIFY) + && !(winPtr->flags & TK_ALREADY_DEAD)) { + winPtr->flags &= ~TK_NEED_CONFIG_NOTIFY; + DoConfigureNotify((Tk_FakeWin *) tkwin); + } +} + +/* + *---------------------------------------------------------------------- + * + * CreateBusy -- + * + * Creates a child transparent window that obscures its parent window + * thereby effectively blocking device events. The size and position of + * the busy window is exactly that of the reference window. + * + * We want to create sibling to the window to be blocked. If the busy + * window is a child of the window to be blocked, Enter/Leave events can + * sneak through. Futhermore under WIN32, messages of transparent windows + * are sent directly to the parent. The only exception to this are + * toplevels, since we can't make a sibling. Fortunately, toplevel + * windows rarely receive events that need blocking. + * + * Results: + * Returns a pointer to the new busy window structure. + * + * Side effects: + * When the busy window is eventually displayed, it will screen device + * events (in the area of the reference window) from reaching its parent + * window and its children. User feed back can be achieved by changing + * the cursor. + * + *---------------------------------------------------------------------- + */ + +static Busy * +CreateBusy( + Tcl_Interp *interp, /* Interpreter to report error to */ + Tk_Window tkRef) /* Window hosting the busy window */ +{ + Busy *busyPtr; + int length, x, y; + const char *fmt; + char *name; + Tk_Window tkBusy, tkChild, tkParent; + Window parent; + Tk_FakeWin *winPtr; + + busyPtr = ckalloc(sizeof(Busy)); + x = y = 0; + length = strlen(Tk_Name(tkRef)); + name = ckalloc(length + 6); + if (Tk_IsTopLevel(tkRef)) { + fmt = "_Busy"; /* Child */ + tkParent = tkRef; + } else { + Tk_Window tkwin; + + fmt = "%s_Busy"; /* Sibling */ + tkParent = Tk_Parent(tkRef); + for (tkwin = tkRef; (tkwin != NULL) && !Tk_IsTopLevel(tkwin); + tkwin = Tk_Parent(tkwin)) { + if (tkwin == tkParent) { + break; + } + x += Tk_X(tkwin) + Tk_Changes(tkwin)->border_width; + y += Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width; + } + } + for (tkChild = FirstChild(tkParent); tkChild != NULL; + tkChild = NextChild(tkChild)) { + Tk_MakeWindowExist(tkChild); + } + sprintf(name, fmt, Tk_Name(tkRef)); + tkBusy = Tk_CreateWindow(interp, tkParent, name, NULL); + ckfree(name); + + if (tkBusy == NULL) { + return NULL; + } + Tk_MakeWindowExist(tkRef); + busyPtr->display = Tk_Display(tkRef); + busyPtr->interp = interp; + busyPtr->tkRef = tkRef; + busyPtr->tkParent = tkParent; + busyPtr->tkBusy = tkBusy; + busyPtr->width = Tk_Width(tkRef); + busyPtr->height = Tk_Height(tkRef); + busyPtr->x = Tk_X(tkRef); + busyPtr->y = Tk_Y(tkRef); + busyPtr->cursor = None; + Tk_SetClass(tkBusy, "Busy"); + busyPtr->optionTable = Tk_CreateOptionTable(interp, busyOptionSpecs); + if (Tk_InitOptions(interp, (char *) busyPtr, busyPtr->optionTable, + tkBusy) != TCL_OK) { + Tk_DestroyWindow(tkBusy); + return NULL; + } + SetWindowInstanceData(tkBusy, busyPtr); + winPtr = (Tk_FakeWin *) tkRef; + + TkpCreateBusy(winPtr, tkRef, &parent, tkParent, busyPtr); + + MakeTransparentWindowExist(tkBusy, parent); + + Tk_MoveResizeWindow(tkBusy, x, y, busyPtr->width, busyPtr->height); + + /* + * Only worry if the busy window is destroyed. + */ + + Tk_CreateEventHandler(tkBusy, StructureNotifyMask, BusyEventProc, + busyPtr); + + /* + * Indicate that the busy window's geometry is being managed. This will + * also notify us if the busy window is ever packed. + */ + + Tk_ManageGeometry(tkBusy, &busyMgrInfo, busyPtr); + if (busyPtr->cursor != None) { + Tk_DefineCursor(tkBusy, busyPtr->cursor); + } + + /* + * Track the reference window to see if it is resized or destroyed. + */ + + Tk_CreateEventHandler(tkRef, StructureNotifyMask, RefWinEventProc, + busyPtr); + return busyPtr; +} + +/* + *---------------------------------------------------------------------- + * + * ConfigureBusy -- + * + * This procedure is called from the Tk event dispatcher. It releases X + * resources and memory used by the busy window and updates the internal + * hash table. + * + * Results: + * None. + * + * Side effects: + * Memory and resources are released and the Tk event handler is removed. + * + *---------------------------------------------------------------------- + */ + +static int +ConfigureBusy( + Tcl_Interp *interp, + Busy *busyPtr, + int objc, + Tcl_Obj *const objv[]) +{ + Tk_Cursor oldCursor = busyPtr->cursor; + + if (Tk_SetOptions(interp, (char *) busyPtr, busyPtr->optionTable, objc, + objv, busyPtr->tkBusy, NULL, NULL) != TCL_OK) { + return TCL_ERROR; + } + if (busyPtr->cursor != oldCursor) { + if (busyPtr->cursor == None) { + Tk_UndefineCursor(busyPtr->tkBusy); + } else { + Tk_DefineCursor(busyPtr->tkBusy, busyPtr->cursor); + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * GetBusy -- + * + * Returns the busy window structure associated with the reference + * window, keyed by its path name. The clientData argument is the main + * window of the interpreter, used to search for the reference window in + * its own window hierarchy. + * + * Results: + * If path name represents a reference window with a busy window, a + * pointer to the busy window structure is returned. Otherwise, NULL is + * returned and an error message is left in interp->result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static Busy * +GetBusy( + Tcl_Interp *interp, /* Interpreter to look up main window of. */ + Tcl_HashTable *busyTablePtr,/* Busy hash table */ + Tcl_Obj *const windowObj) /* Path name of parent window */ +{ + Tcl_HashEntry *hPtr; + Tk_Window tkwin; + + if (TkGetWindowFromObj(interp, Tk_MainWindow(interp), windowObj, + &tkwin) != TCL_OK) { + return NULL; + } + hPtr = Tcl_FindHashEntry(busyTablePtr, (char *) tkwin); + if (hPtr == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find busy window \"%s\"", Tcl_GetString(windowObj))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BUSY", + Tcl_GetString(windowObj), NULL); + return NULL; + } + return Tcl_GetHashValue(hPtr); +} + +/* + *---------------------------------------------------------------------- + * + * HoldBusy -- + * + * Creates (if necessary) and maps a busy window, thereby preventing + * device events from being be received by the parent window and its + * children. + * + * Results: + * Returns a standard TCL result. If path name represents a busy window, + * it is unmapped and TCL_OK is returned. Otherwise, TCL_ERROR is + * returned and an error message is left in interp->result. + * + * Side effects: + * The busy window is created and displayed, blocking events from the + * parent window and its children. + * + *---------------------------------------------------------------------- + */ + +static int +HoldBusy( + Tcl_HashTable *busyTablePtr,/* Busy hash table. */ + Tcl_Interp *interp, /* Interpreter to report errors to. */ + Tcl_Obj *const windowObj, /* Window name. */ + int configObjc, /* Option pairs. */ + Tcl_Obj *const configObjv[]) +{ + Tk_Window tkwin; + Tcl_HashEntry *hPtr; + Busy *busyPtr; + int isNew, result; + + if (TkGetWindowFromObj(interp, Tk_MainWindow(interp), windowObj, + &tkwin) != TCL_OK) { + return TCL_ERROR; + } + hPtr = Tcl_CreateHashEntry(busyTablePtr, (char *) tkwin, &isNew); + if (isNew) { + busyPtr = CreateBusy(interp, tkwin); + if (busyPtr == NULL) { + return TCL_ERROR; + } + Tcl_SetHashValue(hPtr, busyPtr); + busyPtr->hashPtr = hPtr; + } else { + busyPtr = Tcl_GetHashValue(hPtr); + } + + busyPtr->tablePtr = busyTablePtr; + result = ConfigureBusy(interp, busyPtr, configObjc, configObjv); + + /* + * Don't map the busy window unless the reference window is also currently + * displayed. + */ + + if (Tk_IsMapped(busyPtr->tkRef)) { + TkpShowBusyWindow(busyPtr); + } else { + TkpHideBusyWindow(busyPtr); + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_BusyObjCmd -- + * + * This function is invoked to process the "tk busy" Tcl command. See the + * user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Tk_BusyObjCmd( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tk_Window tkwin = clientData; + Tcl_HashTable *busyTablePtr = &((TkWindow *) tkwin)->mainPtr->busyTable; + Busy *busyPtr; + Tcl_Obj *objPtr; + int index, result = TCL_OK; + static const char *const optionStrings[] = { + "cget", "configure", "current", "forget", "hold", "status", NULL + }; + enum options { + BUSY_CGET, BUSY_CONFIGURE, BUSY_CURRENT, BUSY_FORGET, BUSY_HOLD, + BUSY_STATUS + }; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "options ?arg arg ...?"); + return TCL_ERROR; + } + + /* + * [tk busy <window>] command shortcut. + */ + + if (Tcl_GetString(objv[1])[0] == '.') { + if (objc%2 == 1) { + Tcl_WrongNumArgs(interp, 1, objv, "window ?option value ...?"); + return TCL_ERROR; + } + return HoldBusy(busyTablePtr, interp, objv[1], objc-2, objv+2); + } + + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum options) index) { + case BUSY_CGET: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window option"); + return TCL_ERROR; + } + busyPtr = GetBusy(interp, busyTablePtr, objv[2]); + if (busyPtr == NULL) { + return TCL_ERROR; + } + Tcl_Preserve(busyPtr); + objPtr = Tk_GetOptionValue(interp, (char *) busyPtr, + busyPtr->optionTable, objv[3], busyPtr->tkBusy); + if (objPtr == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, objPtr); + } + Tcl_Release(busyPtr); + return result; + + case BUSY_CONFIGURE: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?option? ?value ...?"); + return TCL_ERROR; + } + busyPtr = GetBusy(interp, busyTablePtr, objv[2]); + if (busyPtr == NULL) { + return TCL_ERROR; + } + Tcl_Preserve(busyPtr); + if (objc <= 4) { + objPtr = Tk_GetOptionInfo(interp, (char *) busyPtr, + busyPtr->optionTable, (objc == 4) ? objv[3] : NULL, + busyPtr->tkBusy); + if (objPtr == NULL) { + result = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, objPtr); + } + } else { + result = ConfigureBusy(interp, busyPtr, objc-3, objv+3); + } + Tcl_Release(busyPtr); + return result; + + case BUSY_CURRENT: { + Tcl_HashEntry *hPtr; + Tcl_HashSearch cursor; + const char *pattern = (objc == 3 ? Tcl_GetString(objv[2]) : NULL); + + objPtr = Tcl_NewObj(); + for (hPtr = Tcl_FirstHashEntry(busyTablePtr, &cursor); hPtr != NULL; + hPtr = Tcl_NextHashEntry(&cursor)) { + busyPtr = Tcl_GetHashValue(hPtr); + if (pattern == NULL || + Tcl_StringMatch(Tk_PathName(busyPtr->tkRef), pattern)) { + Tcl_ListObjAppendElement(interp, objPtr, + TkNewWindowObj(busyPtr->tkRef)); + } + } + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; + } + + case BUSY_FORGET: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + busyPtr = GetBusy(interp, busyTablePtr, objv[2]); + if (busyPtr == NULL) { + return TCL_ERROR; + } + TkpHideBusyWindow(busyPtr); + Tcl_EventuallyFree(busyPtr, (Tcl_FreeProc *)DestroyBusy); + return TCL_OK; + + case BUSY_HOLD: + if (objc < 3 || objc%2 != 1) { + Tcl_WrongNumArgs(interp, 2, objv, "window ?option value ...?"); + return TCL_ERROR; + } + return HoldBusy(busyTablePtr, interp, objv[2], objc-3, objv+3); + + case BUSY_STATUS: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + GetBusy(interp, busyTablePtr, objv[2]) != NULL)); + return TCL_OK; + } + + Tcl_Panic("unhandled option: %d", index); + return TCL_ERROR; /* Unreachable */ +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tkBusy.h b/generic/tkBusy.h new file mode 100644 index 0000000..9e6b69b --- /dev/null +++ b/generic/tkBusy.h @@ -0,0 +1,41 @@ +/* + * tkBusy.h -- + * + * This file defines the type of the structure describing a busy window. + * + * Copyright 1993-1998 Lucent Technologies, Inc. + * + * The "busy" command was created by George Howlett. Adapted for + * integration into Tk by Jos Decoster and Donal K. Fellows. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +typedef struct Busy { + Display *display; /* Display of busy window */ + Tcl_Interp *interp; /* Interpreter where "busy" command was + * created. It's used to key the searches in + * the window hierarchy. See the "windows" + * command. */ + Tk_Window tkBusy; /* Busy window: Transparent window used to + * block delivery of events to windows + * underneath it. */ + Tk_Window tkParent; /* Parent window of the busy window. It may be + * the reference window (if the reference is a + * toplevel) or a mutual ancestor of the + * reference window */ + Tk_Window tkRef; /* Reference window of the busy window. It is + * used to manage the size and position of the + * busy window. */ + int x, y; /* Position of the reference window */ + int width, height; /* Size of the reference window. Retained to + * know if the reference window has been + * reconfigured to a new size. */ + int menuBar; /* Menu bar flag. */ + Tk_Cursor cursor; /* Cursor for the busy window. */ + Tcl_HashEntry *hashPtr; /* Used the delete the busy window entry out + * of the global hash table. */ + Tcl_HashTable *tablePtr; + Tk_OptionTable optionTable; +} Busy; diff --git a/generic/tkButton.c b/generic/tkButton.c index 70bba83..b7e314e 100644 --- a/generic/tkButton.c +++ b/generic/tkButton.c @@ -71,19 +71,19 @@ char tkDefLabelPady[TCL_INTEGER_SPACE] = DEF_LABCHKRAD_PADY; static const Tk_OptionSpec labelOptionSpecs[] = { {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground", DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder), - 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0}, + 0, DEF_BUTTON_ACTIVE_BG_MONO, 0}, {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background", DEF_BUTTON_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg), - TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0}, + TK_OPTION_NULL_OK, DEF_BUTTON_ACTIVE_FG_MONO, 0}, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder), - 0, (ClientData) DEF_BUTTON_BG_MONO, 0}, + 0, DEF_BUTTON_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap), TK_OPTION_NULL_OK, 0, 0}, @@ -92,7 +92,7 @@ static const Tk_OptionSpec labelOptionSpecs[] = { Tk_Offset(TkButton, borderWidth), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0, - (ClientData) compoundStrings, 0}, + compoundStrings, 0}, {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor), TK_OPTION_NULL_OK, 0, 0}, @@ -101,7 +101,7 @@ static const Tk_OptionSpec labelOptionSpecs[] = { -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", @@ -134,7 +134,7 @@ static const Tk_OptionSpec labelOptionSpecs[] = { DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_LABEL_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1, TK_OPTION_NULL_OK, 0, 0}, @@ -150,25 +150,25 @@ static const Tk_OptionSpec labelOptionSpecs[] = { {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr), Tk_Offset(TkButton, wrapLength), 0, 0, 0}, - {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0} + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} }; static const Tk_OptionSpec buttonOptionSpecs[] = { {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground", DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder), - 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0}, + 0, DEF_BUTTON_ACTIVE_BG_MONO, 0}, {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background", DEF_BUTTON_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg), - TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0}, + TK_OPTION_NULL_OK, DEF_BUTTON_ACTIVE_FG_MONO, 0}, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder), - 0, (ClientData) DEF_BUTTON_BG_MONO, 0}, + 0, DEF_BUTTON_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap), TK_OPTION_NULL_OK, 0, 0}, @@ -180,19 +180,19 @@ static const Tk_OptionSpec buttonOptionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0, - (ClientData) compoundStrings, 0}, + compoundStrings, 0}, {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-default", "default", "Default", DEF_BUTTON_DEFAULT, -1, Tk_Offset(TkButton, defaultState), - 0, (ClientData) defaultStrings, 0}, + 0, defaultStrings, 0}, {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground", "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR, -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", @@ -235,7 +235,7 @@ static const Tk_OptionSpec buttonOptionSpecs[] = { 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1, TK_OPTION_NULL_OK, 0, 0}, @@ -257,19 +257,19 @@ static const Tk_OptionSpec buttonOptionSpecs[] = { static const Tk_OptionSpec checkbuttonOptionSpecs[] = { {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground", DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder), - 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0}, + 0, DEF_BUTTON_ACTIVE_BG_MONO, 0}, {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background", DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg), - TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0}, + TK_OPTION_NULL_OK, DEF_BUTTON_ACTIVE_FG_MONO, 0}, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder), - 0, (ClientData) DEF_BUTTON_BG_MONO, 0}, + 0, DEF_BUTTON_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap), TK_OPTION_NULL_OK, 0, 0}, @@ -281,7 +281,7 @@ static const Tk_OptionSpec checkbuttonOptionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0, - (ClientData) compoundStrings, 0}, + compoundStrings, 0}, {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor), TK_OPTION_NULL_OK, 0, 0}, @@ -290,7 +290,7 @@ static const Tk_OptionSpec checkbuttonOptionSpecs[] = { -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", @@ -334,13 +334,13 @@ static const Tk_OptionSpec checkbuttonOptionSpecs[] = { DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0}, {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background", DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder), - TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0}, + TK_OPTION_NULL_OK, DEF_BUTTON_SELECT_MONO, 0}, {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage", DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1, TK_OPTION_NULL_OK, 0, 0}, @@ -370,19 +370,19 @@ static const Tk_OptionSpec checkbuttonOptionSpecs[] = { static const Tk_OptionSpec radiobuttonOptionSpecs[] = { {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground", DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder), - 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0}, + 0, DEF_BUTTON_ACTIVE_BG_MONO, 0}, {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background", DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg), - TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0}, + TK_OPTION_NULL_OK, DEF_BUTTON_ACTIVE_FG_MONO, 0}, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder), - 0, (ClientData) DEF_BUTTON_BG_MONO, 0}, + 0, DEF_BUTTON_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap", DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap), TK_OPTION_NULL_OK, 0, 0}, @@ -394,7 +394,7 @@ static const Tk_OptionSpec radiobuttonOptionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkButton, compound), 0, - (ClientData) compoundStrings, 0}, + compoundStrings, 0}, {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor), TK_OPTION_NULL_OK, 0, 0}, @@ -403,7 +403,7 @@ static const Tk_OptionSpec radiobuttonOptionSpecs[] = { -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", @@ -444,13 +444,13 @@ static const Tk_OptionSpec radiobuttonOptionSpecs[] = { DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0}, {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background", DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder), - TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0}, + TK_OPTION_NULL_OK, DEF_BUTTON_SELECT_MONO, 0}, {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage", DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1, TK_OPTION_NULL_OK, 0, 0}, @@ -497,7 +497,7 @@ static const Tk_OptionSpec *const optionSpecs[] = { * enumerated type used to dispatch the widget command. */ -static const char *commandNames[][8] = { +static const char *const commandNames[][8] = { {"cget", "configure", NULL}, {"cget", "configure", "flash", "invoke", NULL}, {"cget", "configure", "deselect", "flash", "invoke", "select", @@ -508,7 +508,7 @@ enum command { COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH, COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE }; -static enum command map[][8] = { +static const enum command map[][8] = { {COMMAND_CGET, COMMAND_CONFIGURE}, {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_FLASH, COMMAND_INVOKE}, {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH, @@ -639,7 +639,7 @@ ButtonCreate( TkButton *butPtr; Tk_OptionTable optionTable; Tk_Window tkwin; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->defaultsInitialized) { @@ -648,7 +648,7 @@ ButtonCreate( } if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -672,7 +672,7 @@ ButtonCreate( Tk_SetClass(tkwin, classNames[type]); butPtr = TkpCreateButton(tkwin); - Tk_SetClassProcs(tkwin, &tkpButtonProcs, (ClientData) butPtr); + Tk_SetClassProcs(tkwin, &tkpButtonProcs, butPtr); /* * Initialize the data structure for the button. @@ -682,7 +682,7 @@ ButtonCreate( butPtr->display = Tk_Display(tkwin); butPtr->interp = interp; butPtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin), - ButtonWidgetObjCmd, (ClientData) butPtr, ButtonCmdDeletedProc); + ButtonWidgetObjCmd, butPtr, ButtonCmdDeletedProc); butPtr->type = type; butPtr->optionTable = optionTable; butPtr->textPtr = NULL; @@ -747,7 +747,7 @@ ButtonCreate( Tk_CreateEventHandler(butPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - ButtonEventProc, (ClientData) butPtr); + ButtonEventProc, butPtr); if (Tk_InitOptions(interp, (char *) butPtr, optionTable, tkwin) != TCL_OK) { @@ -759,8 +759,7 @@ ButtonCreate( return TCL_ERROR; } - Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(butPtr->tkwin), - -1); + Tcl_SetObjResult(interp, TkNewWindowObj(butPtr->tkwin)); return TCL_OK; } @@ -789,21 +788,21 @@ ButtonWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - TkButton *butPtr = (TkButton *) clientData; + TkButton *butPtr = clientData; int index; int result; Tcl_Obj *objPtr; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - result = Tcl_GetIndexFromObj(interp, objv[1], commandNames[butPtr->type], - "option", 0, &index); + result = Tcl_GetIndexFromObjStruct(interp, objv[1], commandNames[butPtr->type], + sizeof(char *), "option", 0, &index); if (result != TCL_OK) { return result; } - Tcl_Preserve((ClientData) butPtr); + Tcl_Preserve(butPtr); switch (map[butPtr->type][index]) { case COMMAND_CGET: @@ -815,9 +814,8 @@ ButtonWidgetObjCmd( butPtr->optionTable, objv[2], butPtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); break; case COMMAND_CONFIGURE: @@ -827,9 +825,8 @@ ButtonWidgetObjCmd( butPtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { result = ConfigureButton(interp, butPtr, objc-2, objv+2); } @@ -872,7 +869,7 @@ ButtonWidgetObjCmd( Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder); } - TkpDisplayButton((ClientData) butPtr); + TkpDisplayButton(butPtr); /* * Special note: must cancel any existing idle handler for @@ -880,7 +877,7 @@ ButtonWidgetObjCmd( * TkpDisplayButton cleared the REDRAW_PENDING flag. */ - Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr); + Tcl_CancelIdleCall(TkpDisplayButton, butPtr); XFlush(butPtr->display); Tcl_Sleep(50); } @@ -922,11 +919,11 @@ ButtonWidgetObjCmd( } break; } - Tcl_Release((ClientData) butPtr); + Tcl_Release(butPtr); return result; error: - Tcl_Release((ClientData) butPtr); + Tcl_Release(butPtr); return TCL_ERROR; } @@ -955,7 +952,7 @@ DestroyButton( TkpDestroyButton(butPtr); if (butPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr); + Tcl_CancelIdleCall(TkpDisplayButton, butPtr); } /* @@ -965,9 +962,9 @@ DestroyButton( Tcl_DeleteCommandFromToken(butPtr->interp, butPtr->widgetCmd); if (butPtr->textVarNamePtr != NULL) { - Tcl_UntraceVar(butPtr->interp, Tcl_GetString(butPtr->textVarNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ButtonTextVarProc, (ClientData) butPtr); + Tcl_UntraceVar2(butPtr->interp, Tcl_GetString(butPtr->textVarNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonTextVarProc, butPtr); } if (butPtr->image != NULL) { Tk_FreeImage(butPtr->image); @@ -1000,14 +997,14 @@ DestroyButton( Tk_FreeTextLayout(butPtr->textLayout); } if (butPtr->selVarNamePtr != NULL) { - Tcl_UntraceVar(butPtr->interp, Tcl_GetString(butPtr->selVarNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ButtonVarProc, (ClientData) butPtr); + Tcl_UntraceVar2(butPtr->interp, Tcl_GetString(butPtr->selVarNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, butPtr); } Tk_FreeConfigOptions((char *) butPtr, butPtr->optionTable, butPtr->tkwin); butPtr->tkwin = NULL; - Tcl_EventuallyFree((ClientData) butPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(butPtr, TCL_DYNAMIC); } /* @@ -1048,14 +1045,14 @@ ConfigureButton( */ if (butPtr->textVarNamePtr != NULL) { - Tcl_UntraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ButtonTextVarProc, (ClientData) butPtr); + Tcl_UntraceVar2(interp, Tcl_GetString(butPtr->textVarNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonTextVarProc, butPtr); } if (butPtr->selVarNamePtr != NULL) { - Tcl_UntraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ButtonVarProc, (ClientData) butPtr); + Tcl_UntraceVar2(interp, Tcl_GetString(butPtr->selVarNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, butPtr); } /* @@ -1187,7 +1184,7 @@ ConfigureButton( if (butPtr->imagePtr != NULL) { image = Tk_GetImage(butPtr->interp, butPtr->tkwin, Tcl_GetString(butPtr->imagePtr), ButtonImageProc, - (ClientData) butPtr); + butPtr); if (image == NULL) { continue; } @@ -1201,7 +1198,7 @@ ConfigureButton( if (butPtr->selectImagePtr != NULL) { image = Tk_GetImage(butPtr->interp, butPtr->tkwin, Tcl_GetString(butPtr->selectImagePtr), - ButtonSelectImageProc, (ClientData) butPtr); + ButtonSelectImageProc, butPtr); if (image == NULL) { continue; } @@ -1215,7 +1212,7 @@ ConfigureButton( if (butPtr->tristateImagePtr != NULL) { image = Tk_GetImage(butPtr->interp, butPtr->tkwin, Tcl_GetString(butPtr->tristateImagePtr), - ButtonTristateImageProc, (ClientData) butPtr); + ButtonTristateImageProc, butPtr); if (image == NULL) { continue; } @@ -1300,17 +1297,17 @@ ConfigureButton( */ if (butPtr->textVarNamePtr != NULL) { - Tcl_TraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ButtonTextVarProc, (ClientData) butPtr); + Tcl_TraceVar2(interp, Tcl_GetString(butPtr->textVarNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonTextVarProc, butPtr); } if (butPtr->selVarNamePtr != NULL) { - Tcl_TraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ButtonVarProc, (ClientData) butPtr); + Tcl_TraceVar2(interp, Tcl_GetString(butPtr->selVarNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ButtonVarProc, butPtr); } - TkButtonWorldChanged((ClientData) butPtr); + TkButtonWorldChanged(butPtr); if (error) { Tcl_SetObjResult(interp, errorResult); Tcl_DecrRefCount(errorResult); @@ -1345,9 +1342,7 @@ TkButtonWorldChanged( XGCValues gcValues; GC newGC; unsigned long mask; - TkButton *butPtr; - - butPtr = (TkButton *) instanceData; + TkButton *butPtr = instanceData; /* * Recompute GCs. @@ -1430,7 +1425,7 @@ TkButtonWorldChanged( */ if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr); + Tcl_DoWhenIdle(TkpDisplayButton, butPtr); butPtr->flags |= REDRAW_PENDING; } } @@ -1458,7 +1453,7 @@ ButtonEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - TkButton *butPtr = (TkButton *) clientData; + TkButton *butPtr = clientData; if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) { goto redraw; } else if (eventPtr->type == ConfigureNotify) { @@ -1489,7 +1484,7 @@ ButtonEventProc( redraw: if ((butPtr->tkwin != NULL) && !(butPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr); + Tcl_DoWhenIdle(TkpDisplayButton, butPtr); butPtr->flags |= REDRAW_PENDING; } } @@ -1516,7 +1511,7 @@ static void ButtonCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - TkButton *butPtr = (TkButton *) clientData; + TkButton *butPtr = clientData; /* * This function could be invoked either because the window was destroyed @@ -1611,23 +1606,20 @@ ButtonVarProc( const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - register TkButton *butPtr = (TkButton *) clientData; - char *name, *value; + register TkButton *butPtr = clientData; + const char *value; Tcl_Obj *valuePtr; - name = Tcl_GetString(butPtr->selVarNamePtr); - /* * If the variable is being unset, then just re-establish the trace unless * the whole interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { - butPtr->flags &= ~SELECTED; - butPtr->flags &= ~TRISTATED; + butPtr->flags &= ~(SELECTED | TRISTATED); if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_TraceVar(interp, name, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + Tcl_TraceVar2(interp, Tcl_GetString(butPtr->selVarNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonVarProc, clientData); } goto redisplay; @@ -1638,7 +1630,8 @@ ButtonVarProc( * button. */ - valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY); + valuePtr = Tcl_ObjGetVar2(interp, butPtr->selVarNamePtr, NULL, + TCL_GLOBAL_ONLY); if (valuePtr == NULL) { value = Tcl_GetString(butPtr->tristateValuePtr); } else { @@ -1650,7 +1643,7 @@ ButtonVarProc( } butPtr->flags |= SELECTED; butPtr->flags &= ~TRISTATED; - } else if (butPtr->offValuePtr + } else if (butPtr->offValuePtr && strcmp(value, Tcl_GetString(butPtr->offValuePtr)) == 0) { if (!(butPtr->flags & (SELECTED | TRISTATED))) { return NULL; @@ -1671,7 +1664,7 @@ ButtonVarProc( redisplay: if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr); + Tcl_DoWhenIdle(TkpDisplayButton, butPtr); butPtr->flags |= REDRAW_PENDING; } return NULL; @@ -1703,16 +1696,13 @@ ButtonTextVarProc( const char *name2, /* Not used. */ int flags) /* Information about what happened. */ { - TkButton *butPtr = (TkButton *) clientData; - char *name; + TkButton *butPtr = clientData; Tcl_Obj *valuePtr; if (butPtr->flags & BUTTON_DELETED) { return NULL; } - name = Tcl_GetString(butPtr->textVarNamePtr); - /* * If the variable is unset, then immediately recreate it unless the whole * interpreter is going away. @@ -1720,16 +1710,17 @@ ButtonTextVarProc( if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_SetVar2Ex(interp, name, NULL, butPtr->textPtr, - TCL_GLOBAL_ONLY); - Tcl_TraceVar(interp, name, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + Tcl_ObjSetVar2(interp, butPtr->textVarNamePtr, NULL, + butPtr->textPtr, TCL_GLOBAL_ONLY); + Tcl_TraceVar2(interp, Tcl_GetString(butPtr->textVarNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ButtonTextVarProc, clientData); } return NULL; } - valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY); + valuePtr = Tcl_ObjGetVar2(interp, butPtr->textVarNamePtr, NULL, + TCL_GLOBAL_ONLY); if (valuePtr == NULL) { valuePtr = Tcl_NewObj(); } @@ -1740,7 +1731,7 @@ ButtonTextVarProc( if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr); + Tcl_DoWhenIdle(TkpDisplayButton, butPtr); butPtr->flags |= REDRAW_PENDING; } return NULL; @@ -1773,12 +1764,12 @@ ButtonImageProc( * <= 0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkButton *butPtr = (TkButton *) clientData; + register TkButton *butPtr = clientData; if (butPtr->tkwin != NULL) { TkpComputeButtonGeometry(butPtr); if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr); + Tcl_DoWhenIdle(TkpDisplayButton, butPtr); butPtr->flags |= REDRAW_PENDING; } } @@ -1811,16 +1802,22 @@ ButtonSelectImageProc( * <= 0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkButton *butPtr = (TkButton *) clientData; + register TkButton *butPtr = clientData; +#ifdef MAC_OSX_TK + if (butPtr->tkwin != NULL) { + TkpComputeButtonGeometry(butPtr); + } +#else /* * Don't recompute geometry: it's controlled by the primary image. */ +#endif if ((butPtr->flags & SELECTED) && (butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr); + Tcl_DoWhenIdle(TkpDisplayButton, butPtr); butPtr->flags |= REDRAW_PENDING; } } @@ -1852,16 +1849,22 @@ ButtonTristateImageProc( * <= 0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkButton *butPtr = (TkButton *) clientData; + register TkButton *butPtr = clientData; +#ifdef MAC_OSX_TK + if (butPtr->tkwin != NULL) { + TkpComputeButtonGeometry(butPtr); + } +#else /* * Don't recompute geometry: it's controlled by the primary image. */ +#endif if ((butPtr->flags & TRISTATED) && (butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr); + Tcl_DoWhenIdle(TkpDisplayButton, butPtr); butPtr->flags |= REDRAW_PENDING; } } diff --git a/generic/tkButton.h b/generic/tkButton.h index 09aaee2..7ed464f 100644 --- a/generic/tkButton.h +++ b/generic/tkButton.h @@ -292,7 +292,7 @@ typedef struct { * and button/label defaults, for use in optionSpecs. */ -MODULE_SCOPE Tk_ClassProcs tkpButtonProcs; +MODULE_SCOPE const Tk_ClassProcs tkpButtonProcs; MODULE_SCOPE char tkDefButtonHighlightWidth[TCL_INTEGER_SPACE]; MODULE_SCOPE char tkDefButtonPadx[TCL_INTEGER_SPACE]; MODULE_SCOPE char tkDefButtonPady[TCL_INTEGER_SPACE]; diff --git a/generic/tkCanvArc.c b/generic/tkCanvArc.c index ecd57b8..4e4c582 100644 --- a/generic/tkCanvArc.c +++ b/generic/tkCanvArc.c @@ -10,7 +10,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <stdio.h> #include "tkInt.h" #include "tkCanvas.h" @@ -79,48 +78,42 @@ typedef struct ArcItem { */ static int StyleParseProc(ClientData clientData, Tcl_Interp *interp, - Tk_Window tkwin, CONST char *value, + Tk_Window tkwin, const char *value, char *widgRec, int offset); -static char * StylePrintProc(ClientData clientData, Tk_Window tkwin, +static const char * StylePrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); -static Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, (ClientData) 2 +static const Tk_CustomOption stateOption = { + TkStateParseProc, TkStatePrintProc, INT2PTR(2) }; -static Tk_CustomOption styleOption = { - (Tk_OptionParseProc *) StyleParseProc, - StylePrintProc, (ClientData) NULL +static const Tk_CustomOption styleOption = { + StyleParseProc, StylePrintProc, NULL }; -static Tk_CustomOption tagsOption = { - (Tk_OptionParseProc *) Tk_CanvasTagsParseProc, - Tk_CanvasTagsPrintProc, (ClientData) NULL +static const Tk_CustomOption tagsOption = { + Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL }; -static Tk_CustomOption dashOption = { - (Tk_OptionParseProc *) TkCanvasDashParseProc, - TkCanvasDashPrintProc, (ClientData) NULL +static const Tk_CustomOption dashOption = { + TkCanvasDashParseProc, TkCanvasDashPrintProc, NULL }; -static Tk_CustomOption offsetOption = { - (Tk_OptionParseProc *) TkOffsetParseProc, - TkOffsetPrintProc, (ClientData) (TK_OFFSET_RELATIVE) +static const Tk_CustomOption offsetOption = { + TkOffsetParseProc, TkOffsetPrintProc, INT2PTR(TK_OFFSET_RELATIVE) }; -static Tk_CustomOption pixelOption = { - (Tk_OptionParseProc *) TkPixelParseProc, - TkPixelPrintProc, (ClientData) NULL +static const Tk_CustomOption pixelOption = { + TkPixelParseProc, TkPixelPrintProc, NULL }; -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_CUSTOM, "-activedash", NULL, NULL, NULL, Tk_Offset(ArcItem, outline.activeDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-activefill", NULL, NULL, - NULL, Tk_Offset(ArcItem, activeFillColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, activeFillColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-activeoutline", NULL, NULL, - NULL, Tk_Offset(ArcItem, outline.activeColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, outline.activeColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-activeoutlinestipple", NULL, NULL, - NULL, Tk_Offset(ArcItem, outline.activeStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, outline.activeStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL, - NULL, Tk_Offset(ArcItem, activeFillStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, activeFillStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-activewidth", NULL, NULL, "0.0", Tk_Offset(ArcItem, outline.activeWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, @@ -128,41 +121,41 @@ static Tk_ConfigSpec configSpecs[] = { NULL, Tk_Offset(ArcItem, outline.dash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_PIXELS, "-dashoffset", NULL, NULL, - "0", Tk_Offset(ArcItem, outline.offset), TK_CONFIG_DONT_SET_DEFAULT}, + "0", Tk_Offset(ArcItem, outline.offset), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-disableddash", NULL, NULL, NULL, Tk_Offset(ArcItem, outline.disabledDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL, - NULL, Tk_Offset(ArcItem, disabledFillColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, disabledFillColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-disabledoutline", NULL, NULL, - NULL, Tk_Offset(ArcItem, outline.disabledColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, outline.disabledColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-disabledoutlinestipple", NULL, NULL, - NULL, Tk_Offset(ArcItem, outline.disabledStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, outline.disabledStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL, - NULL, Tk_Offset(ArcItem, disabledFillStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, disabledFillStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-disabledwidth", NULL, NULL, "0.0", Tk_Offset(ArcItem, outline.disabledWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, {TK_CONFIG_DOUBLE, "-extent", NULL, NULL, - "90", Tk_Offset(ArcItem, extent), TK_CONFIG_DONT_SET_DEFAULT}, + "90", Tk_Offset(ArcItem, extent), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_COLOR, "-fill", NULL, NULL, - NULL, Tk_Offset(ArcItem, fillColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, fillColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-offset", NULL, NULL, "0,0", Tk_Offset(ArcItem, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_COLOR, "-outline", NULL, NULL, - "black", Tk_Offset(ArcItem, outline.color), TK_CONFIG_NULL_OK}, + "black", Tk_Offset(ArcItem, outline.color), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-outlineoffset", NULL, NULL, "0,0", Tk_Offset(ArcItem, outline.tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_BITMAP, "-outlinestipple", NULL, NULL, - NULL, Tk_Offset(ArcItem, outline.stipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, outline.stipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_DOUBLE, "-start", NULL, NULL, - "0", Tk_Offset(ArcItem, start), TK_CONFIG_DONT_SET_DEFAULT}, + "0", Tk_Offset(ArcItem, start), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-state", NULL, NULL, NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption}, {TK_CONFIG_BITMAP, "-stipple", NULL, NULL, - NULL, Tk_Offset(ArcItem, fillStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ArcItem, fillStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-style", NULL, NULL, NULL, Tk_Offset(ArcItem, style), TK_CONFIG_DONT_SET_DEFAULT, &styleOption}, @@ -171,7 +164,7 @@ static Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_CUSTOM, "-width", NULL, NULL, "1.0", Tk_Offset(ArcItem, outline.width), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -181,17 +174,17 @@ static Tk_ConfigSpec configSpecs[] = { static void ComputeArcBbox(Tk_Canvas canvas, ArcItem *arcPtr); static int ConfigureArc(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, - Tcl_Obj *CONST objv[], int flags); + Tcl_Obj *const objv[], int flags); static int CreateArc(Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void DeleteArc(Tk_Canvas canvas, Tk_Item *itemPtr, Display *display); static void DisplayArc(Tk_Canvas canvas, Tk_Item *itemPtr, Display *display, Drawable dst, int x, int y, int width, int height); static int ArcCoords(Tcl_Interp *interp, Tk_Canvas canvas, - Tk_Item *itemPtr, int objc, Tcl_Obj *CONST objv[]); + Tk_Item *itemPtr, int objc, Tcl_Obj *const objv[]); static int ArcToArea(Tk_Canvas canvas, Tk_Item *itemPtr, double *rectPtr); static double ArcToPoint(Tk_Canvas canvas, @@ -239,11 +232,8 @@ Tk_ItemType tkArcType = { NULL, /* insertProc */ NULL, /* dTextProc */ NULL, /* nextPtr */ + NULL, 0, NULL, NULL }; - -#ifndef PI -#define PI 3.14159265358979323846 -#endif /* *-------------------------------------------------------------- @@ -271,13 +261,13 @@ CreateArc( Tk_Item *itemPtr, /* Record to hold new item; header has been * initialized by caller. */ int objc, /* Number of arguments in objv. */ - Tcl_Obj *CONST objv[]) /* Arguments describing arc. */ + Tcl_Obj *const objv[]) /* Arguments describing arc. */ { ArcItem *arcPtr = (ArcItem *) itemPtr; int i; if (objc == 0) { - Tcl_Panic("canvas did not pass any coords\n"); + Tcl_Panic("canvas did not pass any coords"); } /* @@ -307,7 +297,7 @@ CreateArc( */ for (i = 1; i < objc; i++) { - char *arg = Tcl_GetString(objv[i]); + const char *arg = Tcl_GetString(objv[i]); if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { break; @@ -349,32 +339,28 @@ ArcCoords( Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ - Tcl_Obj *CONST objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ + Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { ArcItem *arcPtr = (ArcItem *) itemPtr; if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(arcPtr->bbox[0]); - - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(arcPtr->bbox[1]); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(arcPtr->bbox[2]); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(arcPtr->bbox[3]); - Tcl_ListObjAppendElement(interp, obj, subobj); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *objs[4]; + + objs[0] = Tcl_NewDoubleObj(arcPtr->bbox[0]); + objs[1] = Tcl_NewDoubleObj(arcPtr->bbox[1]); + objs[2] = Tcl_NewDoubleObj(arcPtr->bbox[2]); + objs[3] = Tcl_NewDoubleObj(arcPtr->bbox[3]); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs)); } else if ((objc == 1)||(objc == 4)) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 4) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 4, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "ARC", + NULL); return TCL_ERROR; } } @@ -390,10 +376,9 @@ ArcCoords( } ComputeArcBbox(canvas, arcPtr); } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 4, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "ARC", NULL); return TCL_ERROR; } return TCL_OK; @@ -424,7 +409,7 @@ ConfigureArc( Tk_Canvas canvas, /* Canvas containing itemPtr. */ Tk_Item *itemPtr, /* Arc item to reconfigure. */ int objc, /* Number of elements in objv. */ - Tcl_Obj *CONST objv[], /* Arguments describing things to configure. */ + Tcl_Obj *const objv[], /* Arguments describing things to configure. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { ArcItem *arcPtr = (ArcItem *) itemPtr; @@ -440,7 +425,7 @@ ConfigureArc( tkwin = Tk_CanvasTkwin(canvas); if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, - (CONST char **) objv, (char *) arcPtr, flags|TK_CONFIG_OBJS)) { + (const char **) objv, (char *) arcPtr, flags|TK_CONFIG_OBJS)) { return TCL_ERROR; } @@ -501,7 +486,7 @@ ConfigureArc( arcPtr->outline.gc = newGC; if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } if (state==TK_STATE_HIDDEN) { ComputeArcBbox(canvas, arcPtr); @@ -510,7 +495,7 @@ ConfigureArc( color = arcPtr->fillColor; stipple = arcPtr->fillStipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (arcPtr->activeFillColor!=NULL) { color = arcPtr->activeFillColor; } @@ -598,7 +583,7 @@ DeleteArc( Tk_DeleteOutline(display, &(arcPtr->outline)); if (arcPtr->numOutlinePoints != 0) { - ckfree((char *) arcPtr->outlinePtr); + ckfree(arcPtr->outlinePtr); } if (arcPtr->fillColor != NULL) { Tk_FreeColor(arcPtr->fillColor); @@ -651,7 +636,7 @@ ComputeArcBbox( Tk_State state = arcPtr->header.state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = arcPtr->outline.width; @@ -662,7 +647,7 @@ ComputeArcBbox( arcPtr->header.x1 = arcPtr->header.x2 = arcPtr->header.y1 = arcPtr->header.y2 = -1; return; - } else if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *) arcPtr) { + } else if (Canvas(canvas)->currentItemPtr == (Tk_Item *) arcPtr) { if (arcPtr->outline.activeWidth>width) { width = arcPtr->outline.activeWidth; } @@ -794,7 +779,7 @@ DisplayArc( Pixmap stipple; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } lineWidth = arcPtr->outline.width; if (lineWidth < 1.0) { @@ -802,7 +787,7 @@ DisplayArc( } dashnumber = arcPtr->outline.dash.number; stipple = arcPtr->fillStipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (arcPtr->outline.activeWidth>lineWidth) { lineWidth = arcPtr->outline.activeWidth; } @@ -970,11 +955,11 @@ ArcToPoint( Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = (double) arcPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (arcPtr->outline.activeWidth>width) { width = (double) arcPtr->outline.activeWidth; } @@ -1146,10 +1131,10 @@ ArcToArea( Tk_State state = itemPtr->state; if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = (double) arcPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (arcPtr->outline.activeWidth>width) { width = (double) arcPtr->outline.activeWidth; } @@ -1461,14 +1446,13 @@ ComputeArcOutline( */ if (arcPtr->numOutlinePoints == 0) { - arcPtr->outlinePtr = (double *) ckalloc((unsigned) - (26 * sizeof(double))); + arcPtr->outlinePtr = ckalloc(26 * sizeof(double)); arcPtr->numOutlinePoints = 22; } outlinePtr = arcPtr->outlinePtr; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } /* @@ -1526,7 +1510,7 @@ ComputeArcOutline( */ width = arcPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *) arcPtr) { + if (Canvas(canvas)->currentItemPtr == (Tk_Item *) arcPtr) { if (arcPtr->outline.activeWidth>arcPtr->outline.width) { width = arcPtr->outline.activeWidth; } @@ -1834,13 +1818,14 @@ ArcToPostscript( * being created. */ { ArcItem *arcPtr = (ArcItem *) itemPtr; - char buffer[400]; double y1, y2, ang1, ang2; XColor *color; Pixmap stipple; XColor *fillColor; Pixmap fillStipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; y1 = Tk_CanvasPsY(canvas, arcPtr->bbox[1]); y2 = Tk_CanvasPsY(canvas, arcPtr->bbox[3]); @@ -1852,13 +1837,13 @@ ArcToPostscript( } if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } color = arcPtr->outline.color; stipple = arcPtr->outline.stipple; fillColor = arcPtr->fillColor; fillStipple = arcPtr->fillStipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (arcPtr->outline.activeColor!=NULL) { color = arcPtr->outline.activeColor; } @@ -1887,37 +1872,51 @@ ArcToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * If the arc is filled, output Postscript for the interior region of the * arc. */ if (arcPtr->fillGC != None) { - sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + Tcl_AppendPrintfToObj(psObj, + "matrix currentmatrix\n" + "%.15g %.15g translate %.15g %.15g scale\n", (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); - Tcl_AppendResult(interp, buffer, NULL); - if (arcPtr->style == CHORD_STYLE) { - sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", - ang1, ang2); - } else { - sprintf(buffer, - "0 0 moveto 0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", - ang1, ang2); + + if (arcPtr->style != CHORD_STYLE) { + Tcl_AppendToObj(psObj, "0 0 moveto ", -1); } - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, + "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n", + ang1, ang2); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (arcPtr->outline.gc != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } @@ -1926,57 +1925,86 @@ ArcToPostscript( */ if (arcPtr->outline.gc != None) { - sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n", + Tcl_AppendPrintfToObj(psObj, + "matrix currentmatrix\n" + "%.15g %.15g translate %.15g %.15g scale\n", (arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2, (arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, "0 0 1 %.15g %.15g", ang1, ang2); - Tcl_AppendResult(interp, buffer, - " arc\nsetmatrix\n0 setlinecap\n", NULL); - if (Tk_CanvasPsOutline(canvas, itemPtr, &(arcPtr->outline)) != TCL_OK){ - return TCL_ERROR; + Tcl_AppendPrintfToObj(psObj, + "0 0 1 %.15g %.15g arc\nsetmatrix\n0 setlinecap\n", + ang1, ang2); + + Tcl_ResetResult(interp); + if (Tk_CanvasPsOutline(canvas, itemPtr, &arcPtr->outline) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (arcPtr->style != ARC_STYLE) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); + + Tcl_ResetResult(interp); if (arcPtr->style == CHORD_STYLE) { Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS); } else { Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS); - if (Tk_CanvasPsColor(interp, canvas, color) - != TCL_OK) { - return TCL_ERROR; + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); - if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK){ - return TCL_ERROR; + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); + if (Tk_CanvasPsStipple(interp, canvas, stipple) !=TCL_OK){ + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); + + Tcl_ResetResult(interp); Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS, PIE_OUTLINE2_PTS); } - if (Tk_CanvasPsColor(interp, canvas, color) - != TCL_OK) { - return TCL_ERROR; + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } } + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* @@ -2002,7 +2030,7 @@ StyleParseProc( ClientData clientData, /* some flags.*/ Tcl_Interp *interp, /* Used for reporting errors. */ Tk_Window tkwin, /* Window containing canvas widget. */ - CONST char *value, /* Value of option. */ + const char *value, /* Value of option. */ char *widgRec, /* Pointer to record for item. */ int offset) /* Offset into item. */ { @@ -2032,8 +2060,10 @@ StyleParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad -style option \"", value, - "\": must be arc, chord, or pieslice", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad -style option \"%s\": must be arc, chord, or pieslice", + value)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARC_STYLE", NULL); *stylePtr = PIESLICE_STYLE; return TCL_ERROR; } @@ -2059,7 +2089,7 @@ StyleParseProc( *-------------------------------------------------------------- */ -static char * +static const char * StylePrintProc( ClientData clientData, /* Ignored. */ Tk_Window tkwin, /* Ignored. */ diff --git a/generic/tkCanvBmap.c b/generic/tkCanvBmap.c index 30aa429..d7d54f4 100644 --- a/generic/tkCanvBmap.c +++ b/generic/tkCanvBmap.c @@ -10,7 +10,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <stdio.h> #include "tkInt.h" #include "tkCanvas.h" @@ -41,45 +40,43 @@ typedef struct BitmapItem { * Information used for parsing configuration specs: */ -static Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, (ClientData) 2 +static const Tk_CustomOption stateOption = { + TkStateParseProc, TkStatePrintProc, INT2PTR(2) }; -static Tk_CustomOption tagsOption = { - (Tk_OptionParseProc *) Tk_CanvasTagsParseProc, - Tk_CanvasTagsPrintProc, (ClientData) NULL +static const Tk_CustomOption tagsOption = { + Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL }; -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_COLOR, "-activebackground", NULL, NULL, - NULL, Tk_Offset(BitmapItem, activeBgColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(BitmapItem, activeBgColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-activebitmap", NULL, NULL, - NULL, Tk_Offset(BitmapItem, activeBitmap), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(BitmapItem, activeBitmap), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-activeforeground", NULL, NULL, - NULL, Tk_Offset(BitmapItem, activeFgColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(BitmapItem, activeFgColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_ANCHOR, "-anchor", NULL, NULL, - "center", Tk_Offset(BitmapItem, anchor), TK_CONFIG_DONT_SET_DEFAULT}, + "center", Tk_Offset(BitmapItem, anchor), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_COLOR, "-background", NULL, NULL, - NULL, Tk_Offset(BitmapItem, bgColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(BitmapItem, bgColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-bitmap", NULL, NULL, - NULL, Tk_Offset(BitmapItem, bitmap), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(BitmapItem, bitmap), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-disabledbackground", NULL, NULL, NULL, Tk_Offset(BitmapItem, disabledBgColor), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-disabledbitmap", NULL, NULL, NULL, Tk_Offset(BitmapItem, disabledBitmap), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-disabledforeground", NULL, NULL, NULL, Tk_Offset(BitmapItem, disabledFgColor), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-foreground", NULL, NULL, - "black", Tk_Offset(BitmapItem, fgColor), 0}, + "black", Tk_Offset(BitmapItem, fgColor), 0, NULL}, {TK_CONFIG_CUSTOM, "-state", NULL, NULL, NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption}, {TK_CONFIG_CUSTOM, "-tags", NULL, NULL, NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -88,7 +85,7 @@ static Tk_ConfigSpec configSpecs[] = { static int BitmapCoords(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int BitmapToArea(Tk_Canvas canvas, Tk_Item *itemPtr, double *rectPtr); static double BitmapToPoint(Tk_Canvas canvas, @@ -99,10 +96,10 @@ static void ComputeBitmapBbox(Tk_Canvas canvas, BitmapItem *bmapPtr); static int ConfigureBitmap(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, - Tcl_Obj *CONST objv[], int flags); + Tcl_Obj *const objv[], int flags); static int TkcCreateBitmap(Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void DeleteBitmap(Tk_Canvas canvas, Tk_Item *itemPtr, Display *display); static void DisplayBitmap(Tk_Canvas canvas, @@ -140,6 +137,7 @@ Tk_ItemType tkBitmapType = { NULL, /* insertProc */ NULL, /* dTextProc */ NULL, /* nextPtr */ + NULL, 0, NULL, NULL }; /* @@ -168,13 +166,13 @@ TkcCreateBitmap( Tk_Item *itemPtr, /* Record to hold new item; header has been * initialized by caller. */ int objc, /* Number of arguments in objv. */ - Tcl_Obj *CONST objv[]) /* Arguments describing rectangle. */ + Tcl_Obj *const objv[]) /* Arguments describing rectangle. */ { BitmapItem *bmapPtr = (BitmapItem *) itemPtr; int i; if (objc == 0) { - Tcl_Panic("canvas did not pass any coords\n"); + Tcl_Panic("canvas did not pass any coords"); } /* @@ -201,7 +199,7 @@ TkcCreateBitmap( if (objc == 1) { i = 1; } else { - char *arg = Tcl_GetString(objv[1]); + const char *arg = Tcl_GetString(objv[1]); i = 2; if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; @@ -244,17 +242,15 @@ BitmapCoords( Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ - Tcl_Obj *CONST objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ + Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { BitmapItem *bmapPtr = (BitmapItem *) itemPtr; if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(bmapPtr->x); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(bmapPtr->y); - Tcl_ListObjAppendElement(interp, obj, subobj); + Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bmapPtr->x)); + Tcl_ListObjAppendElement(NULL, obj, Tcl_NewDoubleObj(bmapPtr->y)); Tcl_SetObjResult(interp, obj); } else if (objc < 3) { if (objc == 1) { @@ -262,10 +258,10 @@ BitmapCoords( (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "BITMAP", + NULL); return TCL_ERROR; } } @@ -277,10 +273,9 @@ BitmapCoords( } ComputeBitmapBbox(canvas, bmapPtr); } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "BITMAP", NULL); return TCL_ERROR; } return TCL_OK; @@ -310,7 +305,7 @@ ConfigureBitmap( Tk_Canvas canvas, /* Canvas containing itemPtr. */ Tk_Item *itemPtr, /* Bitmap item to reconfigure. */ int objc, /* Number of elements in objv. */ - Tcl_Obj *CONST objv[], /* Arguments describing things to configure. */ + Tcl_Obj *const objv[], /* Arguments describing things to configure. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { BitmapItem *bmapPtr = (BitmapItem *) itemPtr; @@ -325,7 +320,7 @@ ConfigureBitmap( tkwin = Tk_CanvasTkwin(canvas); if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, - (CONST char **) objv, (char *) bmapPtr, flags|TK_CONFIG_OBJS)) { + (const char **) objv, (char *) bmapPtr, flags|TK_CONFIG_OBJS)) { return TCL_ERROR; } @@ -345,7 +340,7 @@ ConfigureBitmap( } if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } if (state == TK_STATE_HIDDEN) { ComputeBitmapBbox(canvas, bmapPtr); @@ -354,7 +349,7 @@ ConfigureBitmap( fgColor = bmapPtr->fgColor; bgColor = bmapPtr->bgColor; bitmap = bmapPtr->bitmap; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (bmapPtr->activeFgColor!=NULL) { fgColor = bmapPtr->activeFgColor; } @@ -486,10 +481,10 @@ ComputeBitmapBbox( Tk_State state = bmapPtr->header.state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } bitmap = bmapPtr->bitmap; - if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)bmapPtr) { + if (Canvas(canvas)->currentItemPtr == (Tk_Item *)bmapPtr) { if (bmapPtr->activeBitmap!=None) { bitmap = bmapPtr->activeBitmap; } @@ -596,10 +591,10 @@ DisplayBitmap( */ if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } bitmap = bmapPtr->bitmap; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (bmapPtr->activeBitmap!=None) { bitmap = bmapPtr->activeBitmap; } @@ -855,19 +850,20 @@ BitmapToPostscript( double x, y; int width, height, rowsAtOnce, rowsThisTime; int curRow; - char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4]; XColor *fgColor; XColor *bgColor; Pixmap bitmap; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } fgColor = bmapPtr->fgColor; bgColor = bmapPtr->bgColor; bitmap = bmapPtr->bitmap; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (bmapPtr->activeFgColor!=NULL) { fgColor = bmapPtr->activeFgColor; } @@ -915,18 +911,29 @@ BitmapToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * Color the background, if there is one. */ if (bgColor != NULL) { - sprintf(buffer, - "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n", - x, y, width, height, -width, "0 rlineto closepath"); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g moveto %d 0 rlineto 0 %d rlineto " + "%d 0 rlineto closepath\n", + x, y, width, height, -width); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, bgColor) != TCL_OK) { - return TCL_ERROR; + goto error; } - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + Tcl_AppendToObj(psObj, "fill\n", -1); } /* @@ -937,37 +944,61 @@ BitmapToPostscript( */ if (fgColor != NULL) { + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fgColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (width > 60000) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't generate Postscript", - " for bitmaps more than 60000 pixels wide", NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't generate Postscript for bitmaps more than 60000" + " pixels wide", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); + goto error; } + rowsAtOnce = 60000/width; if (rowsAtOnce < 1) { rowsAtOnce = 1; } - sprintf(buffer, "%.15g %.15g translate\n", x, y+height); - Tcl_AppendResult(interp, buffer, NULL); + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y+height); + for (curRow = 0; curRow < height; curRow += rowsAtOnce) { rowsThisTime = rowsAtOnce; if (rowsThisTime > (height - curRow)) { rowsThisTime = height - curRow; } - sprintf(buffer, "0 -%.15g translate\n%d %d true matrix {\n", + + Tcl_AppendPrintfToObj(psObj, + "0 -%.15g translate\n%d %d true matrix {\n", (double) rowsThisTime, width, rowsThisTime); - Tcl_AppendResult(interp, buffer, NULL); + + Tcl_ResetResult(interp); if (Tk_CanvasPsBitmap(interp, canvas, bitmap, 0, curRow, width, rowsThisTime) != TCL_OK) { - return TCL_ERROR; + goto error; } - Tcl_AppendResult(interp, "\n} imagemask\n", NULL); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + Tcl_AppendToObj(psObj, "\n} imagemask\n", -1); } } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvImg.c b/generic/tkCanvImg.c index 9e928c7..899741a 100644 --- a/generic/tkCanvImg.c +++ b/generic/tkCanvImg.c @@ -10,7 +10,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <stdio.h> #include "tkInt.h" #include "tkCanvas.h" @@ -44,29 +43,27 @@ typedef struct ImageItem { * Information used for parsing configuration specs: */ -static Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, (ClientData) 2 +static const Tk_CustomOption stateOption = { + TkStateParseProc, TkStatePrintProc, INT2PTR(2) }; -static Tk_CustomOption tagsOption = { - (Tk_OptionParseProc *) Tk_CanvasTagsParseProc, - Tk_CanvasTagsPrintProc, (ClientData) NULL +static const Tk_CustomOption tagsOption = { + Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL }; -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_STRING, "-activeimage", NULL, NULL, - NULL, Tk_Offset(ImageItem, activeImageString), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ImageItem, activeImageString), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_ANCHOR, "-anchor", NULL, NULL, - "center", Tk_Offset(ImageItem, anchor), TK_CONFIG_DONT_SET_DEFAULT}, + "center", Tk_Offset(ImageItem, anchor), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_STRING, "-disabledimage", NULL, NULL, - NULL, Tk_Offset(ImageItem, disabledImageString), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ImageItem, disabledImageString), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_STRING, "-image", NULL, NULL, - NULL, Tk_Offset(ImageItem, imageString), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(ImageItem, imageString), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-state", NULL, NULL, NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption}, {TK_CONFIG_CUSTOM, "-tags", NULL, NULL, NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -78,7 +75,7 @@ static void ImageChangedProc(ClientData clientData, int imgHeight); static int ImageCoords(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[]); + Tcl_Obj *const argv[]); static int ImageToArea(Tk_Canvas canvas, Tk_Item *itemPtr, double *rectPtr); static double ImageToPoint(Tk_Canvas canvas, @@ -88,10 +85,10 @@ static int ImageToPostscript(Tcl_Interp *interp, static void ComputeImageBbox(Tk_Canvas canvas, ImageItem *imgPtr); static int ConfigureImage(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST argv[], int flags); + Tcl_Obj *const argv[], int flags); static int CreateImage(Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST argv[]); + int argc, Tcl_Obj *const argv[]); static void DeleteImage(Tk_Canvas canvas, Tk_Item *itemPtr, Display *display); static void DisplayImage(Tk_Canvas canvas, @@ -129,6 +126,7 @@ Tk_ItemType tkImageType = { NULL, /* insertProc */ NULL, /* dTextProc */ NULL, /* nextPtr */ + NULL, 0, NULL, NULL }; /* @@ -157,13 +155,13 @@ CreateImage( Tk_Item *itemPtr, /* Record to hold new item; header has been * initialized by caller. */ int objc, /* Number of arguments in objv. */ - Tcl_Obj *CONST objv[]) /* Arguments describing rectangle. */ + Tcl_Obj *const objv[]) /* Arguments describing rectangle. */ { ImageItem *imgPtr = (ImageItem *) itemPtr; int i; if (objc == 0) { - Tcl_Panic("canvas did not pass any coords\n"); + Tcl_Panic("canvas did not pass any coords"); } /* @@ -187,7 +185,7 @@ CreateImage( if (objc == 1) { i = 1; } else { - char *arg = Tcl_GetString(objv[1]); + const char *arg = Tcl_GetString(objv[1]); i = 2; if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; @@ -229,42 +227,40 @@ ImageCoords( Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ - Tcl_Obj *CONST objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ + Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { ImageItem *imgPtr = (ImageItem *) itemPtr; if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); + Tcl_Obj *objs[2]; - Tcl_Obj *subobj = Tcl_NewDoubleObj(imgPtr->x); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(imgPtr->y); - Tcl_ListObjAppendElement(interp, obj, subobj); - Tcl_SetObjResult(interp, obj); + objs[0] = Tcl_NewDoubleObj(imgPtr->x); + objs[1] = Tcl_NewDoubleObj(imgPtr->y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs)); } else if (objc < 3) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { - char buf[64]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE", + NULL); return TCL_ERROR; } } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &imgPtr->x) != TCL_OK) + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], + &imgPtr->x) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &imgPtr->y) != TCL_OK)) { return TCL_ERROR; } ComputeImageBbox(canvas, imgPtr); } else { - char buf[64]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE", NULL); return TCL_ERROR; } return TCL_OK; @@ -294,7 +290,7 @@ ConfigureImage( Tk_Canvas canvas, /* Canvas containing itemPtr. */ Tk_Item *itemPtr, /* Image item to reconfigure. */ int objc, /* Number of elements in objv. */ - Tcl_Obj *CONST objv[], /* Arguments describing things to configure. */ + Tcl_Obj *const objv[], /* Arguments describing things to configure. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { ImageItem *imgPtr = (ImageItem *) itemPtr; @@ -303,7 +299,7 @@ ConfigureImage( tkwin = Tk_CanvasTkwin(canvas); if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, - (CONST char **) objv, (char *) imgPtr, flags|TK_CONFIG_OBJS)) { + (const char **) objv, (char *) imgPtr, flags|TK_CONFIG_OBJS)) { return TCL_ERROR; } @@ -321,7 +317,7 @@ ConfigureImage( } if (imgPtr->imageString != NULL) { image = Tk_GetImage(interp, tkwin, imgPtr->imageString, - ImageChangedProc, (ClientData) imgPtr); + ImageChangedProc, imgPtr); if (image == NULL) { return TCL_ERROR; } @@ -334,7 +330,7 @@ ConfigureImage( imgPtr->image = image; if (imgPtr->activeImageString != NULL) { image = Tk_GetImage(interp, tkwin, imgPtr->activeImageString, - ImageChangedProc, (ClientData) imgPtr); + ImageChangedProc, imgPtr); if (image == NULL) { return TCL_ERROR; } @@ -347,7 +343,7 @@ ConfigureImage( imgPtr->activeImage = image; if (imgPtr->disabledImageString != NULL) { image = Tk_GetImage(interp, tkwin, imgPtr->disabledImageString, - ImageChangedProc, (ClientData) imgPtr); + ImageChangedProc, imgPtr); if (image == NULL) { return TCL_ERROR; } @@ -437,10 +433,10 @@ ComputeImageBbox( Tk_State state = imgPtr->header.state; if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } image = imgPtr->image; - if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)imgPtr) { + if (Canvas(canvas)->currentItemPtr == (Tk_Item *)imgPtr) { if (imgPtr->activeImage != NULL) { image = imgPtr->activeImage; } @@ -540,11 +536,11 @@ DisplayImage( Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } image = imgPtr->image; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (imgPtr->activeImage != NULL) { image = imgPtr->activeImage; } @@ -697,21 +693,19 @@ ImageToPostscript( * information; 0 means final Postscript is * being created.*/ { - ImageItem *imgPtr = (ImageItem *)itemPtr; + ImageItem *imgPtr = (ImageItem *) itemPtr; Tk_Window canvasWin = Tk_CanvasTkwin(canvas); - - char buffer[256]; double x, y; int width, height; Tk_Image image; Tk_State state = itemPtr->state; - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } image = imgPtr->image; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (imgPtr->activeImage != NULL) { image = imgPtr->activeImage; } @@ -750,8 +744,14 @@ ImageToPostscript( } if (!prepass) { - sprintf(buffer, "%.15g %.15g", x, y); - Tcl_AppendResult(interp, buffer, " translate\n", NULL); + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate\n", x, y); } return Tk_PostscriptImage(image, interp, canvasWin, @@ -851,7 +851,7 @@ ImageChangedProc( * 0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - ImageItem *imgPtr = (ImageItem *) clientData; + ImageItem *imgPtr = clientData; /* * If the image's size changed and it's not anchored at its northwest diff --git a/generic/tkCanvLine.c b/generic/tkCanvLine.c index cce3460..087aa56 100644 --- a/generic/tkCanvLine.c +++ b/generic/tkCanvLine.c @@ -11,7 +11,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <stdio.h> #include "tkInt.h" #include "tkCanvas.h" @@ -23,7 +22,7 @@ typedef enum { ARROWS_NONE, ARROWS_FIRST, ARROWS_LAST, ARROWS_BOTH } Arrows; -typedef struct LineItem { +typedef struct LineItem { Tk_Item header; /* Generic stuff that's the same for all * types. MUST BE FIRST IN STRUCTURE. */ Tk_Outline outline; /* Outline structure */ @@ -59,7 +58,7 @@ typedef struct LineItem { * point in line (PTS_IN_ARROW points, first * of which is tip). Malloc'ed. NULL means no * arrowhead at last point. */ - Tk_SmoothMethod *smooth; /* Non-zero means draw line smoothed (i.e. + const Tk_SmoothMethod *smooth; /* Non-zero means draw line smoothed (i.e. * with Bezier splines). */ int splineSteps; /* Number of steps in each spline segment. */ } LineItem; @@ -76,15 +75,15 @@ typedef struct LineItem { static int ArrowheadPostscript(Tcl_Interp *interp, Tk_Canvas canvas, LineItem *linePtr, - double *arrowPtr); + double *arrowPtr, Tcl_Obj *psObj); static void ComputeLineBbox(Tk_Canvas canvas, LineItem *linePtr); static int ConfigureLine(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, - Tcl_Obj *CONST objv[], int flags); + Tcl_Obj *const objv[], int flags); static int ConfigureArrows(Tk_Canvas canvas, LineItem *linePtr); static int CreateLine(Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void DeleteLine(Tk_Canvas canvas, Tk_Item *itemPtr, Display *display); static void DisplayLine(Tk_Canvas canvas, @@ -95,7 +94,7 @@ static int GetLineIndex(Tcl_Interp *interp, Tcl_Obj *obj, int *indexPtr); static int LineCoords(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void LineDeleteCoords(Tk_Canvas canvas, Tk_Item *itemPtr, int first, int last); static void LineInsert(Tk_Canvas canvas, @@ -108,14 +107,14 @@ static int LineToPostscript(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int prepass); static int ArrowParseProc(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *recordPtr, int offset); -static char * ArrowPrintProc(ClientData clientData, + const char *value, char *recordPtr, int offset); +static const char * ArrowPrintProc(ClientData clientData, Tk_Window tkwin, char *recordPtr, int offset, Tcl_FreeProc **freeProcPtr); static int ParseArrowShape(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *recordPtr, int offset); -static char * PrintArrowShape(ClientData clientData, + const char *value, char *recordPtr, int offset); +static const char * PrintArrowShape(ClientData clientData, Tk_Window tkwin, char *recordPtr, int offset, Tcl_FreeProc **freeProcPtr); static void ScaleLine(Tk_Canvas canvas, @@ -123,84 +122,77 @@ static void ScaleLine(Tk_Canvas canvas, double scaleX, double scaleY); static void TranslateLine(Tk_Canvas canvas, Tk_Item *itemPtr, double deltaX, double deltaY); - + /* * Information used for parsing configuration specs. If you change any of the * default strings, be sure to change the corresponding default values in * CreateLine. */ -static Tk_CustomOption arrowShapeOption = { - (Tk_OptionParseProc *) ParseArrowShape, - PrintArrowShape, (ClientData) NULL +static const Tk_CustomOption arrowShapeOption = { + ParseArrowShape, PrintArrowShape, NULL }; -static Tk_CustomOption arrowOption = { - (Tk_OptionParseProc *) ArrowParseProc, - ArrowPrintProc, (ClientData) NULL +static const Tk_CustomOption arrowOption = { + ArrowParseProc, ArrowPrintProc, NULL }; -static Tk_CustomOption smoothOption = { - (Tk_OptionParseProc *) TkSmoothParseProc, - TkSmoothPrintProc, (ClientData) NULL +static const Tk_CustomOption smoothOption = { + TkSmoothParseProc, TkSmoothPrintProc, NULL }; -static Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, (ClientData) 2 +static const Tk_CustomOption stateOption = { + TkStateParseProc, TkStatePrintProc, INT2PTR(2) }; -static Tk_CustomOption tagsOption = { - (Tk_OptionParseProc *) Tk_CanvasTagsParseProc, - Tk_CanvasTagsPrintProc, (ClientData) NULL +static const Tk_CustomOption tagsOption = { + Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL }; -static Tk_CustomOption dashOption = { - (Tk_OptionParseProc *) TkCanvasDashParseProc, - TkCanvasDashPrintProc, (ClientData) NULL +static const Tk_CustomOption dashOption = { + TkCanvasDashParseProc, TkCanvasDashPrintProc, NULL }; -static Tk_CustomOption offsetOption = { - (Tk_OptionParseProc *) TkOffsetParseProc, - TkOffsetPrintProc, - (ClientData) (TK_OFFSET_RELATIVE|TK_OFFSET_INDEX) +static const Tk_CustomOption offsetOption = { + TkOffsetParseProc, TkOffsetPrintProc, + INT2PTR(TK_OFFSET_RELATIVE|TK_OFFSET_INDEX) }; -static Tk_CustomOption pixelOption = { - (Tk_OptionParseProc *) TkPixelParseProc, - TkPixelPrintProc, (ClientData) NULL +static const Tk_CustomOption pixelOption = { + TkPixelParseProc, TkPixelPrintProc, NULL }; -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_CUSTOM, "-activedash", NULL, NULL, NULL, Tk_Offset(LineItem, outline.activeDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-activefill", NULL, NULL, - NULL, Tk_Offset(LineItem, outline.activeColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(LineItem, outline.activeColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL, - NULL, Tk_Offset(LineItem, outline.activeStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(LineItem, outline.activeStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-activewidth", NULL, NULL, "0.0", Tk_Offset(LineItem, outline.activeWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, {TK_CONFIG_CUSTOM, "-arrow", NULL, NULL, - "none", Tk_Offset(LineItem, arrow), TK_CONFIG_DONT_SET_DEFAULT, &arrowOption}, + "none", Tk_Offset(LineItem, arrow), + TK_CONFIG_DONT_SET_DEFAULT, &arrowOption}, {TK_CONFIG_CUSTOM, "-arrowshape", NULL, NULL, "8 10 3", Tk_Offset(LineItem, arrowShapeA), TK_CONFIG_DONT_SET_DEFAULT, &arrowShapeOption}, {TK_CONFIG_CAP_STYLE, "-capstyle", NULL, NULL, - "butt", Tk_Offset(LineItem, capStyle), TK_CONFIG_DONT_SET_DEFAULT}, + "butt", Tk_Offset(LineItem, capStyle), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_COLOR, "-fill", NULL, NULL, - "black", Tk_Offset(LineItem, outline.color), TK_CONFIG_NULL_OK}, + "black", Tk_Offset(LineItem, outline.color), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-dash", NULL, NULL, NULL, Tk_Offset(LineItem, outline.dash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_PIXELS, "-dashoffset", NULL, NULL, - "0", Tk_Offset(LineItem, outline.offset), TK_CONFIG_DONT_SET_DEFAULT}, + "0", Tk_Offset(LineItem, outline.offset), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-disableddash", NULL, NULL, NULL, Tk_Offset(LineItem, outline.disabledDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL, - NULL, Tk_Offset(LineItem, outline.disabledColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(LineItem, outline.disabledColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL, - NULL, Tk_Offset(LineItem, outline.disabledStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(LineItem, outline.disabledStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-disabledwidth", NULL, NULL, "0.0", Tk_Offset(LineItem, outline.disabledWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, {TK_CONFIG_JOIN_STYLE, "-joinstyle", NULL, NULL, - "round", Tk_Offset(LineItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT}, + "round", Tk_Offset(LineItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-offset", NULL, NULL, "0,0", Tk_Offset(LineItem, outline.tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, @@ -208,17 +200,17 @@ static Tk_ConfigSpec configSpecs[] = { "0", Tk_Offset(LineItem, smooth), TK_CONFIG_DONT_SET_DEFAULT, &smoothOption}, {TK_CONFIG_INT, "-splinesteps", NULL, NULL, - "12", Tk_Offset(LineItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT}, + "12", Tk_Offset(LineItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-state", NULL, NULL, NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption}, {TK_CONFIG_BITMAP, "-stipple", NULL, NULL, - NULL, Tk_Offset(LineItem, outline.stipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(LineItem, outline.stipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-tags", NULL, NULL, NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, {TK_CONFIG_CUSTOM, "-width", NULL, NULL, "1.0", Tk_Offset(LineItem, outline.width), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -235,18 +227,19 @@ Tk_ItemType tkLineType = { LineCoords, /* coordProc */ DeleteLine, /* deleteProc */ DisplayLine, /* displayProc */ - TK_CONFIG_OBJS, /* flags */ + TK_CONFIG_OBJS | TK_MOVABLE_POINTS, /* flags */ LineToPoint, /* pointProc */ LineToArea, /* areaProc */ LineToPostscript, /* postscriptProc */ ScaleLine, /* scaleProc */ TranslateLine, /* translateProc */ - (Tk_ItemIndexProc *) GetLineIndex, /* indexProc */ + GetLineIndex, /* indexProc */ NULL, /* icursorProc */ NULL, /* selectionProc */ - (Tk_ItemInsertProc *) LineInsert, /* insertProc */ + LineInsert, /* insertProc */ LineDeleteCoords, /* dTextProc */ NULL, /* nextPtr */ + NULL, 0, NULL, NULL }; /* @@ -283,13 +276,13 @@ CreateLine( Tk_Item *itemPtr, /* Record to hold new item; header has been * initialized by caller. */ int objc, /* Number of arguments in objv. */ - Tcl_Obj *CONST objv[]) /* Arguments describing line. */ + Tcl_Obj *const objv[]) /* Arguments describing line. */ { LineItem *linePtr = (LineItem *) itemPtr; int i; if (objc == 0) { - Tcl_Panic("canvas did not pass any coords\n"); + Tcl_Panic("canvas did not pass any coords"); } /* @@ -297,7 +290,7 @@ CreateLine( * proper cleanup after errors during the the remainder of this function. */ - Tk_CreateOutline(&(linePtr->outline)); + Tk_CreateOutline(&linePtr->outline); linePtr->canvas = canvas; linePtr->numPoints = 0; linePtr->coordPtr = NULL; @@ -320,7 +313,7 @@ CreateLine( */ for (i = 1; i < objc; i++) { - char *arg = Tcl_GetString(objv[i]); + const char *arg = Tcl_GetString(objv[i]); if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { break; @@ -362,7 +355,7 @@ LineCoords( Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ - Tcl_Obj *CONST objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ + Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { LineItem *linePtr = (LineItem *) itemPtr; int i, numPoints; @@ -398,55 +391,52 @@ LineCoords( } } if (objc & 1) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected an even number, got %d", - objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected an even number, got %d", + objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "LINE", NULL); return TCL_ERROR; } else if (objc < 4) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected at least 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected at least 4, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "LINE", NULL); return TCL_ERROR; - } else { - numPoints = objc/2; - if (linePtr->numPoints != numPoints) { - coordPtr = (double *) - ckalloc((unsigned) (sizeof(double) * objc)); - if (linePtr->coordPtr != NULL) { - ckfree((char *) linePtr->coordPtr); - } - linePtr->coordPtr = coordPtr; - linePtr->numPoints = numPoints; - } - coordPtr = linePtr->coordPtr; - for (i = 0; i <objc; i++) { - if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], - coordPtr++) != TCL_OK) { - return TCL_ERROR; - } - } - - /* - * Update arrowheads by throwing away any existing arrow-head - * information and calling ConfigureArrows to recompute it. - */ + } - if (linePtr->firstArrowPtr != NULL) { - ckfree((char *) linePtr->firstArrowPtr); - linePtr->firstArrowPtr = NULL; - } - if (linePtr->lastArrowPtr != NULL) { - ckfree((char *) linePtr->lastArrowPtr); - linePtr->lastArrowPtr = NULL; + numPoints = objc/2; + if (linePtr->numPoints != numPoints) { + coordPtr = ckalloc(sizeof(double) * objc); + if (linePtr->coordPtr != NULL) { + ckfree(linePtr->coordPtr); } - if (linePtr->arrow != ARROWS_NONE) { - ConfigureArrows(canvas, linePtr); + linePtr->coordPtr = coordPtr; + linePtr->numPoints = numPoints; + } + coordPtr = linePtr->coordPtr; + for (i = 0; i < objc ; i++) { + if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], + coordPtr++) != TCL_OK) { + return TCL_ERROR; } - ComputeLineBbox(canvas, linePtr); } + + /* + * Update arrowheads by throwing away any existing arrow-head information + * and calling ConfigureArrows to recompute it. + */ + + if (linePtr->firstArrowPtr != NULL) { + ckfree(linePtr->firstArrowPtr); + linePtr->firstArrowPtr = NULL; + } + if (linePtr->lastArrowPtr != NULL) { + ckfree(linePtr->lastArrowPtr); + linePtr->lastArrowPtr = NULL; + } + if (linePtr->arrow != ARROWS_NONE) { + ConfigureArrows(canvas, linePtr); + } + ComputeLineBbox(canvas, linePtr); return TCL_OK; } @@ -474,8 +464,8 @@ ConfigureLine( Tcl_Interp *interp, /* Used for error reporting. */ Tk_Canvas canvas, /* Canvas containing itemPtr. */ Tk_Item *itemPtr, /* Line item to reconfigure. */ - int objc, /* Number of elements in objv. */ - Tcl_Obj *CONST objv[], /* Arguments describing things to configure. */ + int objc, /* Number of elements in objv. */ + Tcl_Obj *const objv[], /* Arguments describing things to configure. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { LineItem *linePtr = (LineItem *) itemPtr; @@ -487,7 +477,7 @@ ConfigureLine( tkwin = Tk_CanvasTkwin(canvas); if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, - (CONST char **) objv, (char *) linePtr, flags|TK_CONFIG_OBJS)) { + (const char **) objv, (char *) linePtr, flags|TK_CONFIG_OBJS)) { return TCL_ERROR; } @@ -498,8 +488,8 @@ ConfigureLine( state = itemPtr->state; - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } if (linePtr->outline.activeWidth > linePtr->outline.width || @@ -510,8 +500,7 @@ ConfigureLine( } else { itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT; } - mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, - &(linePtr->outline)); + mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &linePtr->outline); if (mask) { if (linePtr->arrow == ARROWS_NONE) { gcValues.cap_style = linePtr->capStyle; @@ -522,9 +511,10 @@ ConfigureLine( newGC = Tk_GetGC(tkwin, mask, &gcValues); #ifdef MAC_OSX_TK /* - * Mac OS X CG drawing needs access to linewidth even for - * arrow fills (as linewidth controls antialiasing). + * Mac OS X CG drawing needs access to linewidth even for arrow fills + * (as linewidth controls antialiasing). */ + mask |= GCLineWidth; #else gcValues.line_width = 0; @@ -552,7 +542,7 @@ ConfigureLine( linePtr->splineSteps = 100; } - if ((!linePtr->numPoints) || (state==TK_STATE_HIDDEN)) { + if ((!linePtr->numPoints) || (state == TK_STATE_HIDDEN)) { ComputeLineBbox(canvas, linePtr); return TCL_OK; } @@ -566,7 +556,7 @@ ConfigureLine( && (linePtr->arrow != ARROWS_BOTH)) { linePtr->coordPtr[0] = linePtr->firstArrowPtr[0]; linePtr->coordPtr[1] = linePtr->firstArrowPtr[1]; - ckfree((char *) linePtr->firstArrowPtr); + ckfree(linePtr->firstArrowPtr); linePtr->firstArrowPtr = NULL; } if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != ARROWS_LAST) @@ -576,7 +566,7 @@ ConfigureLine( i = 2*(linePtr->numPoints-1); linePtr->coordPtr[i] = linePtr->lastArrowPtr[0]; linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1]; - ckfree((char *) linePtr->lastArrowPtr); + ckfree(linePtr->lastArrowPtr); linePtr->lastArrowPtr = NULL; } if (linePtr->arrow != ARROWS_NONE) { @@ -617,18 +607,18 @@ DeleteLine( { LineItem *linePtr = (LineItem *) itemPtr; - Tk_DeleteOutline(display, &(linePtr->outline)); + Tk_DeleteOutline(display, &linePtr->outline); if (linePtr->coordPtr != NULL) { - ckfree((char *) linePtr->coordPtr); + ckfree(linePtr->coordPtr); } if (linePtr->arrowGC != None) { Tk_FreeGC(display, linePtr->arrowGC); } if (linePtr->firstArrowPtr != NULL) { - ckfree((char *) linePtr->firstArrowPtr); + ckfree(linePtr->firstArrowPtr); } if (linePtr->lastArrowPtr != NULL) { - ckfree((char *) linePtr->lastArrowPtr); + ckfree(linePtr->lastArrowPtr); } } @@ -660,11 +650,11 @@ ComputeLineBbox( Tk_State state = linePtr->header.state; Tk_TSOffset *tsoffset; - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } - if (!(linePtr->numPoints) || (state==TK_STATE_HIDDEN)) { + if (!(linePtr->numPoints) || (state == TK_STATE_HIDDEN)) { linePtr->header.x1 = -1; linePtr->header.x2 = -1; linePtr->header.y1 = -1; @@ -673,18 +663,18 @@ ComputeLineBbox( } width = linePtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)linePtr) { - if (linePtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == (Tk_Item *)linePtr) { + if (linePtr->outline.activeWidth > width) { width = linePtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { - if (linePtr->outline.disabledWidth>0) { + } else if (state == TK_STATE_DISABLED) { + if (linePtr->outline.disabledWidth > 0) { width = linePtr->outline.disabledWidth; } } coordPtr = linePtr->coordPtr; - linePtr->header.x1 = linePtr->header.x2 = (int) *coordPtr; + linePtr->header.x1 = linePtr->header.x2 = (int) coordPtr[0]; linePtr->header.y1 = linePtr->header.y2 = (int) coordPtr[1]; /* @@ -692,8 +682,8 @@ ComputeLineBbox( * all directions by the line's width to take care of butting or rounded * corners and projecting or rounded caps. This expansion is an * overestimate (worst-case is square root of two over two) but it's - * simple. eDon't do anything special for curves. This causes an - * additional overestimate in the bounding box, but is faster. + * simple. Don't do anything special for curves. This causes an additional + * overestimate in the bounding box, but is faster. */ for (i = 1, coordPtr = linePtr->coordPtr+2; i < linePtr->numPoints; @@ -715,16 +705,20 @@ ComputeLineBbox( tsoffset = &linePtr->outline.tsoffset; if (tsoffset->flags & TK_OFFSET_INDEX) { - double *coordPtr = linePtr->coordPtr + (tsoffset->flags & ~TK_OFFSET_INDEX); + double *coordPtr = linePtr->coordPtr + + (tsoffset->flags & ~TK_OFFSET_INDEX); + if (tsoffset->flags <= 0) { coordPtr = linePtr->coordPtr; - if ((linePtr->arrow == ARROWS_FIRST) || (linePtr->arrow == ARROWS_BOTH)) { + if ((linePtr->arrow == ARROWS_FIRST) + || (linePtr->arrow == ARROWS_BOTH)) { coordPtr = linePtr->firstArrowPtr; } } if (tsoffset->flags > (linePtr->numPoints * 2)) { coordPtr = linePtr->coordPtr + (linePtr->numPoints * 2); - if ((linePtr->arrow == ARROWS_LAST) || (linePtr->arrow == ARROWS_BOTH)) { + if ((linePtr->arrow == ARROWS_LAST) + || (linePtr->arrow == ARROWS_BOTH)) { coordPtr = linePtr->lastArrowPtr; } } @@ -753,7 +747,7 @@ ComputeLineBbox( linePtr->header.y1 -= intWidth; linePtr->header.y2 += intWidth; - if (linePtr->numPoints==1) { + if (linePtr->numPoints == 1) { linePtr->header.x1 -= 1; linePtr->header.x2 += 1; linePtr->header.y1 -= 1; @@ -846,19 +840,19 @@ DisplayLine( int numPoints; Tk_State state = itemPtr->state; - if ((!linePtr->numPoints)||(linePtr->outline.gc==None)) { + if ((!linePtr->numPoints) || (linePtr->outline.gc == None)) { return; } if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } linewidth = linePtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (linePtr->outline.activeWidth != linewidth) { linewidth = linePtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { + } else if (state == TK_STATE_DISABLED) { if (linePtr->outline.disabledWidth != linewidth) { linewidth = linePtr->outline.disabledWidth; } @@ -880,14 +874,14 @@ DisplayLine( if (numPoints <= MAX_STATIC_POINTS) { pointPtr = staticPoints; } else { - pointPtr = (XPoint *)ckalloc((unsigned)(numPoints * 3*sizeof(XPoint))); + pointPtr = ckalloc(numPoints * 3 * sizeof(XPoint)); } if ((linePtr->smooth) && (linePtr->numPoints > 2)) { numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr, linePtr->numPoints, linePtr->splineSteps, pointPtr, NULL); } else { - numPoints = TkCanvTranslatePath((TkCanvas*)canvas, numPoints, + numPoints = TkCanvTranslatePath((TkCanvas *) canvas, numPoints, linePtr->coordPtr, 0, pointPtr); } @@ -898,23 +892,25 @@ DisplayLine( * read-only. */ - if (Tk_ChangeOutlineGC(canvas, itemPtr, &(linePtr->outline))) { - Tk_CanvasSetOffset(canvas, linePtr->arrowGC, &linePtr->outline.tsoffset); + if (Tk_ChangeOutlineGC(canvas, itemPtr, &linePtr->outline)) { + Tk_CanvasSetOffset(canvas, linePtr->arrowGC, + &linePtr->outline.tsoffset); } - if (numPoints>1) { + if (numPoints > 1) { XDrawLines(display, drawable, linePtr->outline.gc, pointPtr, numPoints, - CoordModeOrigin); + CoordModeOrigin); } else { int intwidth = (int) (linewidth + 0.5); - if (intwidth<1) { - intwidth=1; + + if (intwidth < 1) { + intwidth = 1; } XFillArc(display, drawable, linePtr->outline.gc, pointPtr->x - intwidth/2, pointPtr->y - intwidth/2, - (unsigned int)intwidth+1, (unsigned int)intwidth+1, 0, 64*360); + (unsigned) intwidth+1, (unsigned) intwidth+1, 0, 64*360); } if (pointPtr != staticPoints) { - ckfree((char *) pointPtr); + ckfree(pointPtr); } /* @@ -929,7 +925,7 @@ DisplayLine( TkFillPolygon(canvas, linePtr->lastArrowPtr, PTS_IN_ARROW, display, drawable, linePtr->arrowGC, NULL); } - if (Tk_ResetOutlineGC(canvas, itemPtr, &(linePtr->outline))) { + if (Tk_ResetOutlineGC(canvas, itemPtr, &linePtr->outline)) { XSetTSOrigin(display, linePtr->arrowGC, 0, 0); } } @@ -965,7 +961,7 @@ LineInsert( Tcl_Obj **objv; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } if (!obj || (Tcl_ListObjGetElements(NULL, obj, &objc, &objv) != TCL_OK) @@ -987,16 +983,15 @@ LineInsert( linePtr->coordPtr[length-2] = linePtr->lastArrowPtr[0]; linePtr->coordPtr[length-1] = linePtr->lastArrowPtr[1]; } - newCoordPtr = (double *) - ckalloc(sizeof(double) * (unsigned)(length + objc)); + newCoordPtr = ckalloc(sizeof(double) * (length + objc)); for (i=0; i<beforeThis; i++) { newCoordPtr[i] = linePtr->coordPtr[i]; } for (i=0; i<objc; i++) { if (Tcl_GetDoubleFromObj(NULL, objv[i], &newCoordPtr[i + beforeThis]) != TCL_OK) { - Tcl_ResetResult(((TkCanvas *)canvas)->interp); - ckfree((char *) newCoordPtr); + Tcl_ResetResult(Canvas(canvas)->interp); + ckfree(newCoordPtr); return; } } @@ -1005,13 +1000,13 @@ LineInsert( newCoordPtr[i+objc] = linePtr->coordPtr[i]; } if (linePtr->coordPtr) { - ckfree((char *) linePtr->coordPtr); + ckfree(linePtr->coordPtr); } linePtr->coordPtr = newCoordPtr; - length += objc; + length += objc ; linePtr->numPoints = length / 2; - if ((length>3) && (state != TK_STATE_HIDDEN)) { + if ((length > 3) && (state != TK_STATE_HIDDEN)) { /* * This is some optimizing code that will result that only the part of * the polygon that changed (and the objects that are overlapping with @@ -1023,19 +1018,25 @@ LineInsert( itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW; - if (beforeThis>0) {beforeThis -= 2; objc+=2; } - if ((beforeThis+objc)<length) objc+=2; + if (beforeThis > 0) { + beforeThis -= 2; + objc += 2; + } + if (beforeThis+objc < length) { + objc += 2; + } if (linePtr->smooth) { - if(beforeThis>0) { - beforeThis-=2; objc+=2; + if (beforeThis > 0) { + beforeThis -= 2; + objc += 2; } - if((beforeThis+objc+2)<length) { - objc+=2; + if (beforeThis+objc+2 < length) { + objc += 2; } } itemPtr->x1 = itemPtr->x2 = (int) linePtr->coordPtr[beforeThis]; itemPtr->y1 = itemPtr->y2 = (int) linePtr->coordPtr[beforeThis+1]; - if ((linePtr->firstArrowPtr != NULL) && (beforeThis<1)) { + if ((linePtr->firstArrowPtr != NULL) && (beforeThis < 1)) { /* * Include old first arrow. */ @@ -1045,7 +1046,7 @@ LineInsert( TkIncludePoint(itemPtr, coordPtr); } } - if ((linePtr->lastArrowPtr != NULL) && ((beforeThis+objc)>=length)) { + if ((linePtr->lastArrowPtr != NULL) && (beforeThis+objc >= length)) { /* * Include old last arrow. */ @@ -1055,18 +1056,18 @@ LineInsert( TkIncludePoint(itemPtr, coordPtr); } } - coordPtr = linePtr->coordPtr+beforeThis+2; + coordPtr = linePtr->coordPtr + beforeThis + 2; for (i=2; i<objc; i+=2) { TkIncludePoint(itemPtr, coordPtr); - coordPtr+=2; + coordPtr += 2; } } if (linePtr->firstArrowPtr != NULL) { - ckfree((char *) linePtr->firstArrowPtr); + ckfree(linePtr->firstArrowPtr); linePtr->firstArrowPtr = NULL; } if (linePtr->lastArrowPtr != NULL) { - ckfree((char *) linePtr->lastArrowPtr); + ckfree(linePtr->lastArrowPtr); linePtr->lastArrowPtr = NULL; } if (linePtr->arrow != ARROWS_NONE) { @@ -1077,7 +1078,7 @@ LineInsert( double width; int intWidth; - if ((linePtr->firstArrowPtr != NULL) && (beforeThis>2)) { + if ((linePtr->firstArrowPtr != NULL) && (beforeThis > 2)) { /* * Include new first arrow. */ @@ -1098,12 +1099,12 @@ LineInsert( } } width = linePtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (linePtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (linePtr->outline.activeWidth > width) { width = linePtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { - if (linePtr->outline.disabledWidth>0) { + } else if (state == TK_STATE_DISABLED) { + if (linePtr->outline.disabledWidth > 0) { width = linePtr->outline.disabledWidth; } } @@ -1111,8 +1112,10 @@ LineInsert( if (intWidth < 1) { intWidth = 1; } - itemPtr->x1 -= intWidth; itemPtr->y1 -= intWidth; - itemPtr->x2 += intWidth; itemPtr->y2 += intWidth; + itemPtr->x1 -= intWidth; + itemPtr->y1 -= intWidth; + itemPtr->x2 += intWidth; + itemPtr->y2 += intWidth; Tk_CanvasEventuallyRedraw(canvas, itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); } @@ -1151,7 +1154,7 @@ LineDeleteCoords( Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } first &= -2; @@ -1191,7 +1194,7 @@ LineDeleteCoords( } } - if (!(first1 < 2) && (last1 >= length-2)) { + if ((first1 >= 2) || (last1 < length-2)) { /* * This is some optimizing code that will result that only the part of * the line that changed (and the objects that are overlapping with @@ -1237,11 +1240,11 @@ LineDeleteCoords( } linePtr->numPoints -= count/2; if (linePtr->firstArrowPtr != NULL) { - ckfree((char *) linePtr->firstArrowPtr); + ckfree(linePtr->firstArrowPtr); linePtr->firstArrowPtr = NULL; } if (linePtr->lastArrowPtr != NULL) { - ckfree((char *) linePtr->lastArrowPtr); + ckfree(linePtr->lastArrowPtr); linePtr->lastArrowPtr = NULL; } if (linePtr->arrow != ARROWS_NONE) { @@ -1272,11 +1275,11 @@ LineDeleteCoords( } } width = linePtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (linePtr->outline.activeWidth > width) { width = linePtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { + } else if (state == TK_STATE_DISABLED) { if (linePtr->outline.disabledWidth > 0) { width = linePtr->outline.disabledWidth; } @@ -1340,17 +1343,17 @@ LineToPoint( * which to do the check. */ - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } width = linePtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (linePtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (linePtr->outline.activeWidth > width) { width = linePtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { - if (linePtr->outline.disabledWidth>0) { + } else if (state == TK_STATE_DISABLED) { + if (linePtr->outline.disabledWidth > 0) { width = linePtr->outline.disabledWidth; } } @@ -1361,8 +1364,7 @@ LineToPoint( if (numPoints <= MAX_STATIC_POINTS) { linePoints = staticSpace; } else { - linePoints = (double *) ckalloc((unsigned) - (2*numPoints*sizeof(double))); + linePoints = ckalloc(2 * numPoints * sizeof(double)); } numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr, linePtr->numPoints, linePtr->splineSteps, NULL, linePoints); @@ -1375,12 +1377,14 @@ LineToPoint( width = 1.0; } - if (!numPoints || itemPtr->state==TK_STATE_HIDDEN) { + if (!numPoints || itemPtr->state == TK_STATE_HIDDEN) { return bestDist; } else if (numPoints == 1) { bestDist = hypot(linePoints[0]-pointPtr[0], linePoints[1]-pointPtr[1]) - width/2.0; - if (bestDist < 0) bestDist = 0; + if (bestDist < 0) { + bestDist = 0; + } return bestDist; } @@ -1519,7 +1523,7 @@ LineToPoint( done: if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) { - ckfree((char *) linePoints); + ckfree(linePoints); } return bestDist; } @@ -1556,23 +1560,23 @@ LineToArea( double radius, width; Tk_State state = itemPtr->state; - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } width = linePtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (linePtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (linePtr->outline.activeWidth > width) { width = linePtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { - if (linePtr->outline.disabledWidth>0) { + } else if (state == TK_STATE_DISABLED) { + if (linePtr->outline.disabledWidth > 0) { width = linePtr->outline.disabledWidth; } } radius = (width+1.0)/2.0; - if ((state==TK_STATE_HIDDEN) || !linePtr->numPoints) { + if ((state == TK_STATE_HIDDEN) || !linePtr->numPoints) { return -1; } else if (linePtr->numPoints == 1) { double oval[4]; @@ -1595,8 +1599,7 @@ LineToArea( if (numPoints <= MAX_STATIC_POINTS) { linePoints = staticSpace; } else { - linePoints = (double *) ckalloc((unsigned) - (2*numPoints*sizeof(double))); + linePoints = ckalloc(2 * numPoints * sizeof(double)); } numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr, linePtr->numPoints, linePtr->splineSteps, NULL, linePoints); @@ -1609,13 +1612,12 @@ LineToArea( * Check the segments of the line. */ - if (width < 1.0) { + if (width < 1.0) { width = 1.0; } - result = TkThickPolyLineToArea(linePoints, numPoints, - width, linePtr->capStyle, linePtr->joinStyle, - rectPtr); + result = TkThickPolyLineToArea(linePoints, numPoints, width, + linePtr->capStyle, linePtr->joinStyle, rectPtr); if (result == 0) { goto done; } @@ -1643,7 +1645,7 @@ LineToArea( done: if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) { - ckfree((char *) linePoints); + ckfree(linePoints); } return result; } @@ -1688,7 +1690,7 @@ ScaleLine( if (linePtr->firstArrowPtr != NULL) { linePtr->coordPtr[0] = linePtr->firstArrowPtr[0]; linePtr->coordPtr[1] = linePtr->firstArrowPtr[1]; - ckfree((char *) linePtr->firstArrowPtr); + ckfree(linePtr->firstArrowPtr); linePtr->firstArrowPtr = NULL; } if (linePtr->lastArrowPtr != NULL) { @@ -1697,7 +1699,7 @@ ScaleLine( i = 2*(linePtr->numPoints-1); linePtr->coordPtr[i] = linePtr->lastArrowPtr[0]; linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1]; - ckfree((char *) linePtr->lastArrowPtr); + ckfree(linePtr->lastArrowPtr); linePtr->lastArrowPtr = NULL; } for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints; @@ -1741,27 +1743,19 @@ GetLineIndex( int *indexPtr) /* Where to store converted index. */ { LineItem *linePtr = (LineItem *) itemPtr; - int length; - char *string = Tcl_GetStringFromObj(obj, &length); + const char *string = Tcl_GetString(obj); if (string[0] == 'e') { - if (strncmp(string, "end", (unsigned) length) == 0) { + if (strncmp(string, "end", obj->length) == 0) { *indexPtr = 2*linePtr->numPoints; } else { - /* - * Some of the paths here leave messages in interp->result, so we - * have to clear it out before storing our own message. - */ - - badIndex: - Tcl_SetResult(interp, NULL, TCL_STATIC); - Tcl_AppendResult(interp, "bad index \"", string, "\"", NULL); - return TCL_ERROR; + goto badIndex; } } else if (string[0] == '@') { int i; - double x ,y, bestDist, dist, *coordPtr; - char *end, *p; + double x, y, bestDist, dist, *coordPtr; + char *end; + const char *p; p = string+1; x = strtod(p, &end); @@ -1776,9 +1770,9 @@ GetLineIndex( bestDist = 1.0e36; coordPtr = linePtr->coordPtr; *indexPtr = 0; - for(i=0; i<linePtr->numPoints; i++) { + for (i=0; i<linePtr->numPoints; i++) { dist = hypot(coordPtr[0] - x, coordPtr[1] - y); - if (dist<bestDist) { + if (dist < bestDist) { bestDist = dist; *indexPtr = 2*i; } @@ -1788,7 +1782,7 @@ GetLineIndex( if (Tcl_GetIntFromObj(interp, obj, indexPtr) != TCL_OK) { goto badIndex; } - *indexPtr &= -2; /* if index is odd, make it even */ + *indexPtr &= -2; /* If index is odd, make it even. */ if (*indexPtr < 0){ *indexPtr = 0; } else if (*indexPtr > (2*linePtr->numPoints)) { @@ -1796,6 +1790,17 @@ GetLineIndex( } } return TCL_OK; + + /* + * Some of the paths here leave messages in interp->result, so we have to + * clear it out before storing our own message. + */ + + badIndex: + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "LINE", NULL); + return TCL_ERROR; } /* @@ -1873,7 +1878,7 @@ ParseArrowShape( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Used for error reporting. */ Tk_Window tkwin, /* Not used. */ - CONST char *value, /* Textual specification of arrow shape. */ + const char *value, /* Textual specification of arrow shape. */ char *recordPtr, /* Pointer to item record in which to store * arrow information. */ int offset) /* Offset of shape information in widget @@ -1882,23 +1887,15 @@ ParseArrowShape( LineItem *linePtr = (LineItem *) recordPtr; double a, b, c; int argc; - CONST char **argv = NULL; + const char **argv = NULL; if (offset != Tk_Offset(LineItem, arrowShapeA)) { Tcl_Panic("ParseArrowShape received bogus offset"); } if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) { - syntaxError: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad arrow shape \"", value, - "\": must be list with three numbers", NULL); - if (argv != NULL) { - ckfree((char *) argv); - } - return TCL_ERROR; - } - if (argc != 3) { + goto syntaxError; + } else if (argc != 3) { goto syntaxError; } if ((Tk_CanvasGetCoord(interp, linePtr->canvas, argv[0], &a) != TCL_OK) @@ -1908,11 +1905,23 @@ ParseArrowShape( != TCL_OK)) { goto syntaxError; } - linePtr->arrowShapeA = (float)a; - linePtr->arrowShapeB = (float)b; - linePtr->arrowShapeC = (float)c; - ckfree((char *) argv); + + linePtr->arrowShapeA = (float) a; + linePtr->arrowShapeB = (float) b; + linePtr->arrowShapeC = (float) c; + ckfree(argv); return TCL_OK; + + syntaxError: + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad arrow shape \"%s\": must be list with three numbers", + value)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARROW_SHAPE", NULL); + if (argv != NULL) { + ckfree(argv); + } + return TCL_ERROR; } /* @@ -1933,7 +1942,7 @@ ParseArrowShape( */ /* ARGSUSED */ -static char * +static const char * PrintArrowShape( ClientData clientData, /* Not used. */ Tk_Window tkwin, /* Window associated with linePtr's widget. */ @@ -1944,16 +1953,14 @@ PrintArrowShape( * string here. */ { LineItem *linePtr = (LineItem *) recordPtr; - char *buffer; + char *buffer = ckalloc(120); - buffer = (char *) ckalloc(120); sprintf(buffer, "%.5g %.5g %.5g", linePtr->arrowShapeA, linePtr->arrowShapeB, linePtr->arrowShapeC); *freeProcPtr = TCL_DYNAMIC; return buffer; } - /* *-------------------------------------------------------------- * @@ -1977,7 +1984,7 @@ ArrowParseProc( ClientData clientData, /* some flags.*/ Tcl_Interp *interp, /* Used for reporting errors. */ Tk_Window tkwin, /* Window containing canvas widget. */ - CONST char *value, /* Value of option. */ + const char *value, /* Value of option. */ char *widgRec, /* Pointer to record for item. */ int offset) /* Offset into item. */ { @@ -1986,7 +1993,7 @@ ArrowParseProc( register Arrows *arrowPtr = (Arrows *) (widgRec + offset); - if(value == NULL || *value == 0) { + if (value == NULL || *value == 0) { *arrowPtr = ARROWS_NONE; return TCL_OK; } @@ -2011,8 +2018,10 @@ ArrowParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad arrow spec \"", value, - "\": must be none, first, last, or both", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad arrow spec \"%s\": must be none, first, last, or both", + value)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ARROW", NULL); *arrowPtr = ARROWS_NONE; return TCL_ERROR; } @@ -2038,7 +2047,7 @@ ArrowParseProc( *-------------------------------------------------------------- */ -static char * +static const char * ArrowPrintProc( ClientData clientData, /* Ignored. */ Tk_Window tkwin, /* Window containing canvas widget. */ @@ -2102,21 +2111,21 @@ ConfigureArrows( double width; Tk_State state = linePtr->header.state; - if (linePtr->numPoints <2) { + if (linePtr->numPoints < 2) { return TCL_OK; } - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } width = linePtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)linePtr) { - if (linePtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == (Tk_Item *)linePtr) { + if (linePtr->outline.activeWidth > width) { width = linePtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { - if (linePtr->outline.disabledWidth>0) { + } else if (state == TK_STATE_DISABLED) { + if (linePtr->outline.disabledWidth > 0) { width = linePtr->outline.disabledWidth; } } @@ -2143,8 +2152,7 @@ ConfigureArrows( if (linePtr->arrow != ARROWS_LAST) { poly = linePtr->firstArrowPtr; if (poly == NULL) { - poly = (double *) ckalloc((unsigned) - (2*PTS_IN_ARROW*sizeof(double))); + poly = ckalloc(2 * PTS_IN_ARROW * sizeof(double)); poly[0] = poly[10] = linePtr->coordPtr[0]; poly[1] = poly[11] = linePtr->coordPtr[1]; linePtr->firstArrowPtr = poly; @@ -2188,8 +2196,7 @@ ConfigureArrows( coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2); poly = linePtr->lastArrowPtr; if (poly == NULL) { - poly = (double *) - ckalloc((unsigned) (2*PTS_IN_ARROW*sizeof(double))); + poly = ckalloc(2 * PTS_IN_ARROW * sizeof(double)); poly[0] = poly[10] = coordPtr[2]; poly[1] = poly[11] = coordPtr[3]; linePtr->lastArrowPtr = poly; @@ -2251,129 +2258,150 @@ LineToPostscript( * being created. */ { LineItem *linePtr = (LineItem *) itemPtr; - char buffer[64 + TCL_INTEGER_SPACE]; - char *style; - + int style; double width; XColor *color; Pixmap stipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } width = linePtr->outline.width; color = linePtr->outline.color; stipple = linePtr->outline.stipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (linePtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (linePtr->outline.activeWidth > width) { width = linePtr->outline.activeWidth; } - if (linePtr->outline.activeColor!=NULL) { + if (linePtr->outline.activeColor != NULL) { color = linePtr->outline.activeColor; } - if (linePtr->outline.activeStipple!=None) { + if (linePtr->outline.activeStipple != None) { stipple = linePtr->outline.activeStipple; } - } else if (state==TK_STATE_DISABLED) { - if (linePtr->outline.disabledWidth>0) { + } else if (state == TK_STATE_DISABLED) { + if (linePtr->outline.disabledWidth > 0) { width = linePtr->outline.disabledWidth; } - if (linePtr->outline.disabledColor!=NULL) { + if (linePtr->outline.disabledColor != NULL) { color = linePtr->outline.disabledColor; } - if (linePtr->outline.disabledStipple!=None) { + if (linePtr->outline.disabledStipple != None) { stipple = linePtr->outline.disabledStipple; } } - if (color == NULL || linePtr->numPoints<1 || linePtr->coordPtr==NULL) { + if (color == NULL || linePtr->numPoints < 1 || linePtr->coordPtr == NULL){ return TCL_OK; } - if (linePtr->numPoints==1) { - sprintf(buffer, "%.15g %.15g translate %.15g %.15g", + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Check if we're just doing a "pixel". + */ + + if (linePtr->numPoints == 1) { + Tcl_AppendToObj(psObj, "matrix currentmatrix\n", -1); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g translate %.15g %.15g", linePtr->coordPtr[0], Tk_CanvasPsY(canvas, linePtr->coordPtr[1]), width/2.0, width/2.0); - Tcl_AppendResult(interp, "matrix currentmatrix\n",buffer, - " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", NULL); + Tcl_AppendToObj(psObj, + " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - return TCL_OK; + goto done; } + /* * Generate a path for the line's center-line (do this differently for * straight lines and smoothed lines). */ + Tcl_ResetResult(interp); if ((!linePtr->smooth) || (linePtr->numPoints < 3)) { Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints); + } else if ((stipple == None) && linePtr->smooth->postscriptProc) { + linePtr->smooth->postscriptProc(interp, canvas, linePtr->coordPtr, + linePtr->numPoints, linePtr->splineSteps); } else { - if ((stipple == None) && linePtr->smooth->postscriptProc) { - linePtr->smooth->postscriptProc(interp, canvas, - linePtr->coordPtr, linePtr->numPoints, linePtr->splineSteps); - } else { - /* - * Special hack: Postscript printers don't appear to be able to - * turn a path drawn with "curveto"s into a clipping path without - * exceeding resource limits, so TkMakeBezierPostscript won't work - * for stippled curves. Instead, generate all of the intermediate - * points here and output them into the Postscript file with - * "lineto"s instead. - */ + /* + * Special hack: Postscript printers don't appear to be able to turn a + * path drawn with "curveto"s into a clipping path without exceeding + * resource limits, so TkMakeBezierPostscript won't work for stippled + * curves. Instead, generate all of the intermediate points here and + * output them into the Postscript file with "lineto"s instead. + */ - double staticPoints[2*MAX_STATIC_POINTS]; - double *pointPtr; - int numPoints; + double staticPoints[2*MAX_STATIC_POINTS]; + double *pointPtr; + int numPoints; - numPoints = linePtr->smooth->coordProc(canvas, NULL, - linePtr->numPoints, linePtr->splineSteps, NULL, NULL); - pointPtr = staticPoints; - if (numPoints > MAX_STATIC_POINTS) { - pointPtr = (double *) ckalloc((unsigned) - (numPoints * 2 * sizeof(double))); - } - numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr, - linePtr->numPoints, linePtr->splineSteps, NULL, pointPtr); - Tk_CanvasPsPath(interp, canvas, pointPtr, numPoints); - if (pointPtr != staticPoints) { - ckfree((char *) pointPtr); - } + numPoints = linePtr->smooth->coordProc(canvas, NULL, + linePtr->numPoints, linePtr->splineSteps, NULL, NULL); + pointPtr = staticPoints; + if (numPoints > MAX_STATIC_POINTS) { + pointPtr = ckalloc(numPoints * 2 * sizeof(double)); + } + numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr, + linePtr->numPoints, linePtr->splineSteps, NULL, pointPtr); + Tk_CanvasPsPath(interp, canvas, pointPtr, numPoints); + if (pointPtr != staticPoints) { + ckfree(pointPtr); } } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); /* * Set other line-drawing parameters and stroke out the line. */ - style = "0 setlinecap\n"; if (linePtr->capStyle == CapRound) { - style = "1 setlinecap\n"; + style = 1; } else if (linePtr->capStyle == CapProjecting) { - style = "2 setlinecap\n"; + style = 2; + } else { + style = 0; } - Tcl_AppendResult(interp, style, NULL); - style = "0 setlinejoin\n"; + Tcl_AppendPrintfToObj(psObj, "%d setlinecap\n", style); if (linePtr->joinStyle == JoinRound) { - style = "1 setlinejoin\n"; + style = 1; } else if (linePtr->joinStyle == JoinBevel) { - style = "2 setlinejoin\n"; + style = 2; + } else { + style = 0; } - Tcl_AppendResult(interp, style, NULL); + Tcl_AppendPrintfToObj(psObj, "%d setlinejoin\n", style); - if (Tk_CanvasPsOutline(canvas, itemPtr, &(linePtr->outline)) != TCL_OK) { - return TCL_ERROR; + Tcl_ResetResult(interp); + if (Tk_CanvasPsOutline(canvas, itemPtr, &linePtr->outline) != TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); /* * Output polygons for the arrowheads, if there are any. @@ -2381,23 +2409,37 @@ LineToPostscript( if (linePtr->firstArrowPtr != NULL) { if (stipple != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } if (ArrowheadPostscript(interp, canvas, linePtr, - linePtr->firstArrowPtr) != TCL_OK) { - return TCL_ERROR; + linePtr->firstArrowPtr, psObj) != TCL_OK) { + goto error; } } if (linePtr->lastArrowPtr != NULL) { if (stipple != None) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } if (ArrowheadPostscript(interp, canvas, linePtr, - linePtr->lastArrowPtr) != TCL_OK) { - return TCL_ERROR; + linePtr->lastArrowPtr, psObj) != TCL_OK) { + goto error; } } + + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* @@ -2412,7 +2454,7 @@ LineToPostscript( * The return value is a standard Tcl result. If an error occurs in * generating Postscript then an error message is left in the interp's * result, replacing whatever used to be there. If no error occurs, then - * Postscript for the arrowhead is appended to the result. + * Postscript for the arrowhead is appended to the given object. * * Side effects: * None. @@ -2422,39 +2464,47 @@ LineToPostscript( static int ArrowheadPostscript( - Tcl_Interp *interp, /* Leave Postscript or error message here. */ + Tcl_Interp *interp, /* Leave error message here; non-error results + * will be discarded by caller. */ Tk_Canvas canvas, /* Information about overall canvas. */ LineItem *linePtr, /* Line item for which Postscript is being * generated. */ - double *arrowPtr) /* Pointer to first of five points describing + double *arrowPtr, /* Pointer to first of five points describing * arrowhead polygon. */ + Tcl_Obj *psObj) /* Append postscript to this object. */ { Pixmap stipple; Tk_State state = linePtr->header.state; - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } stipple = linePtr->outline.stipple; - if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)linePtr) { + if (Canvas(canvas)->currentItemPtr == (Tk_Item *) linePtr) { if (linePtr->outline.activeStipple!=None) { stipple = linePtr->outline.activeStipple; } - } else if (state==TK_STATE_DISABLED) { + } else if (state == TK_STATE_DISABLED) { if (linePtr->outline.activeStipple!=None) { stipple = linePtr->outline.disabledStipple; } } + Tcl_ResetResult(interp); Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } return TCL_OK; } diff --git a/generic/tkCanvPoly.c b/generic/tkCanvPoly.c index b86bc63..b4ef098 100644 --- a/generic/tkCanvPoly.c +++ b/generic/tkCanvPoly.c @@ -11,7 +11,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <stdio.h> #include "tkInt.h" #include "tkCanvas.h" @@ -44,7 +43,7 @@ typedef struct PolygonItem { Pixmap disabledFillStipple; /* Stipple bitmap for filling polygon if state * is disabled. */ GC fillGC; /* Graphics context for filling polygon. */ - Tk_SmoothMethod *smooth; /* Non-zero means draw shape smoothed (i.e. + const Tk_SmoothMethod *smooth; /* Non-zero means draw shape smoothed (i.e. * with Bezier splines). */ int splineSteps; /* Number of steps in each spline segment. */ int autoClosed; /* Zero means the given polygon was closed, @@ -55,45 +54,39 @@ typedef struct PolygonItem { * Information used for parsing configuration specs: */ -static Tk_CustomOption smoothOption = { - (Tk_OptionParseProc *) TkSmoothParseProc, - TkSmoothPrintProc, (ClientData) NULL +static const Tk_CustomOption smoothOption = { + TkSmoothParseProc, TkSmoothPrintProc, NULL }; -static Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, (ClientData) 2 +static const Tk_CustomOption stateOption = { + TkStateParseProc, TkStatePrintProc, INT2PTR(2) }; -static Tk_CustomOption tagsOption = { - (Tk_OptionParseProc *) Tk_CanvasTagsParseProc, - Tk_CanvasTagsPrintProc, (ClientData) NULL +static const Tk_CustomOption tagsOption = { + Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL }; -static Tk_CustomOption dashOption = { - (Tk_OptionParseProc *) TkCanvasDashParseProc, - TkCanvasDashPrintProc, (ClientData) NULL +static const Tk_CustomOption dashOption = { + TkCanvasDashParseProc, TkCanvasDashPrintProc, NULL }; -static Tk_CustomOption offsetOption = { - (Tk_OptionParseProc *) TkOffsetParseProc, - TkOffsetPrintProc, - (ClientData) (TK_OFFSET_RELATIVE|TK_OFFSET_INDEX) +static const Tk_CustomOption offsetOption = { + TkOffsetParseProc, TkOffsetPrintProc, + INT2PTR(TK_OFFSET_RELATIVE|TK_OFFSET_INDEX) }; -static Tk_CustomOption pixelOption = { - (Tk_OptionParseProc *) TkPixelParseProc, - TkPixelPrintProc, (ClientData) NULL +static const Tk_CustomOption pixelOption = { + TkPixelParseProc, TkPixelPrintProc, NULL }; -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_CUSTOM, "-activedash", NULL, NULL, NULL, Tk_Offset(PolygonItem, outline.activeDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-activefill", NULL, NULL, - NULL, Tk_Offset(PolygonItem, activeFillColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(PolygonItem, activeFillColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-activeoutline", NULL, NULL, - NULL, Tk_Offset(PolygonItem, outline.activeColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(PolygonItem, outline.activeColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-activeoutlinestipple", NULL, NULL, NULL, Tk_Offset(PolygonItem, outline.activeStipple), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL, - NULL, Tk_Offset(PolygonItem, activeFillStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(PolygonItem, activeFillStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-activewidth", NULL, NULL, "0.0", Tk_Offset(PolygonItem, outline.activeWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, @@ -102,52 +95,52 @@ static Tk_ConfigSpec configSpecs[] = { TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_PIXELS, "-dashoffset", NULL, NULL, "0", Tk_Offset(PolygonItem, outline.offset), - TK_CONFIG_DONT_SET_DEFAULT}, + TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-disableddash", NULL, NULL, NULL, Tk_Offset(PolygonItem, outline.disabledDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL, - NULL, Tk_Offset(PolygonItem, disabledFillColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(PolygonItem, disabledFillColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-disabledoutline", NULL, NULL, NULL, Tk_Offset(PolygonItem, outline.disabledColor), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-disabledoutlinestipple", NULL, NULL, NULL, Tk_Offset(PolygonItem, outline.disabledStipple), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL, - NULL, Tk_Offset(PolygonItem, disabledFillStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(PolygonItem, disabledFillStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-disabledwidth", NULL, NULL, "0.0", Tk_Offset(PolygonItem, outline.disabledWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, {TK_CONFIG_COLOR, "-fill", NULL, NULL, - "black", Tk_Offset(PolygonItem, fillColor), TK_CONFIG_NULL_OK}, + "black", Tk_Offset(PolygonItem, fillColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_JOIN_STYLE, "-joinstyle", NULL, NULL, - "round", Tk_Offset(PolygonItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT}, + "round", Tk_Offset(PolygonItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-offset", NULL, NULL, "0,0", Tk_Offset(PolygonItem, tsoffset), TK_CONFIG_NULL_OK, &offsetOption}, {TK_CONFIG_COLOR, "-outline", NULL, NULL, - NULL, Tk_Offset(PolygonItem, outline.color), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(PolygonItem, outline.color), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-outlineoffset", NULL, NULL, "0,0", Tk_Offset(PolygonItem, outline.tsoffset), TK_CONFIG_NULL_OK, &offsetOption}, {TK_CONFIG_BITMAP, "-outlinestipple", NULL, NULL, - NULL, Tk_Offset(PolygonItem, outline.stipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(PolygonItem, outline.stipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-smooth", NULL, NULL, "0", Tk_Offset(PolygonItem, smooth), TK_CONFIG_DONT_SET_DEFAULT, &smoothOption}, {TK_CONFIG_INT, "-splinesteps", NULL, NULL, - "12", Tk_Offset(PolygonItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT}, + "12", Tk_Offset(PolygonItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-state", NULL, NULL, NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption}, {TK_CONFIG_BITMAP, "-stipple", NULL, NULL, - NULL, Tk_Offset(PolygonItem, fillStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(PolygonItem, fillStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-tags", NULL, NULL, NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, {TK_CONFIG_CUSTOM, "-width", NULL, NULL, "1.0", Tk_Offset(PolygonItem, outline.width), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -158,10 +151,10 @@ static void ComputePolygonBbox(Tk_Canvas canvas, PolygonItem *polyPtr); static int ConfigurePolygon(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, - Tcl_Obj *CONST objv[], int flags); + Tcl_Obj *const objv[], int flags); static int CreatePolygon(Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void DeletePolygon(Tk_Canvas canvas, Tk_Item *itemPtr, Display *display); static void DisplayPolygon(Tk_Canvas canvas, @@ -172,7 +165,7 @@ static int GetPolygonIndex(Tcl_Interp *interp, Tcl_Obj *obj, int *indexPtr); static int PolygonCoords(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void PolygonDeleteCoords(Tk_Canvas canvas, Tk_Item *itemPtr, int first, int last); static void PolygonInsert(Tk_Canvas canvas, @@ -203,18 +196,19 @@ Tk_ItemType tkPolygonType = { PolygonCoords, /* coordProc */ DeletePolygon, /* deleteProc */ DisplayPolygon, /* displayProc */ - TK_CONFIG_OBJS, /* flags */ + TK_CONFIG_OBJS | TK_MOVABLE_POINTS, /* flags */ PolygonToPoint, /* pointProc */ PolygonToArea, /* areaProc */ PolygonToPostscript, /* postscriptProc */ ScalePolygon, /* scaleProc */ TranslatePolygon, /* translateProc */ - (Tk_ItemIndexProc *) GetPolygonIndex,/* indexProc */ + GetPolygonIndex, /* indexProc */ NULL, /* icursorProc */ NULL, /* selectionProc */ - (Tk_ItemInsertProc *) PolygonInsert,/* insertProc */ + PolygonInsert, /* insertProc */ PolygonDeleteCoords, /* dTextProc */ NULL, /* nextPtr */ + NULL, 0, NULL, NULL }; /* @@ -251,13 +245,13 @@ CreatePolygon( Tk_Item *itemPtr, /* Record to hold new item; header has been * initialized by caller. */ int objc, /* Number of arguments in objv. */ - Tcl_Obj *CONST objv[]) /* Arguments describing polygon. */ + Tcl_Obj *const objv[]) /* Arguments describing polygon. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; int i; if (objc == 0) { - Tcl_Panic("canvas did not pass any coords\n"); + Tcl_Panic("canvas did not pass any coords"); } /* @@ -265,7 +259,7 @@ CreatePolygon( * errors during the the remainder of this function. */ - Tk_CreateOutline(&(polyPtr->outline)); + Tk_CreateOutline(&polyPtr->outline); polyPtr->numPoints = 0; polyPtr->pointsAllocated = 0; polyPtr->coordPtr = NULL; @@ -291,7 +285,8 @@ CreatePolygon( */ for (i = 0; i < objc; i++) { - char *arg = Tcl_GetString(objv[i]); + const char *arg = Tcl_GetString(objv[i]); + if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { break; } @@ -334,7 +329,7 @@ PolygonCoords( Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ - Tcl_Obj *CONST objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ + Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; int i, numPoints; @@ -361,50 +356,49 @@ PolygonCoords( } } if (objc & 1) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected an even number, got %d", - objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected an even number, got %d", + objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "POLYGON", NULL); return TCL_ERROR; - } else { - numPoints = objc/2; - if (polyPtr->pointsAllocated <= numPoints) { - if (polyPtr->coordPtr != NULL) { - ckfree((char *) polyPtr->coordPtr); - } - - /* - * One extra point gets allocated here, because we always add - * another point to close the polygon. - */ + } - polyPtr->coordPtr = (double *) ckalloc((unsigned) - (sizeof(double) * (objc+2))); - polyPtr->pointsAllocated = numPoints+1; - } - for (i = objc-1; i >= 0; i--) { - if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], - &polyPtr->coordPtr[i]) != TCL_OK) { - return TCL_ERROR; - } + numPoints = objc/2; + if (polyPtr->pointsAllocated <= numPoints) { + if (polyPtr->coordPtr != NULL) { + ckfree(polyPtr->coordPtr); } - polyPtr->numPoints = numPoints; - polyPtr->autoClosed = 0; /* - * Close the polygon if it isn't already closed. + * One extra point gets allocated here, because we always add + * another point to close the polygon. */ - if (objc>2 && ((polyPtr->coordPtr[objc-2] != polyPtr->coordPtr[0]) - || (polyPtr->coordPtr[objc-1] != polyPtr->coordPtr[1]))) { - polyPtr->autoClosed = 1; - polyPtr->numPoints++; - polyPtr->coordPtr[objc] = polyPtr->coordPtr[0]; - polyPtr->coordPtr[objc+1] = polyPtr->coordPtr[1]; + polyPtr->coordPtr = ckalloc(sizeof(double) * (objc+2)); + polyPtr->pointsAllocated = numPoints+1; + } + for (i = objc-1; i >= 0; i--) { + if (Tk_CanvasGetCoordFromObj(interp, canvas, objv[i], + &polyPtr->coordPtr[i]) != TCL_OK) { + return TCL_ERROR; } - ComputePolygonBbox(canvas, polyPtr); } + polyPtr->numPoints = numPoints; + polyPtr->autoClosed = 0; + + /* + * Close the polygon if it isn't already closed. + */ + + if (objc>2 && ((polyPtr->coordPtr[objc-2] != polyPtr->coordPtr[0]) + || (polyPtr->coordPtr[objc-1] != polyPtr->coordPtr[1]))) { + polyPtr->autoClosed = 1; + polyPtr->numPoints++; + polyPtr->coordPtr[objc] = polyPtr->coordPtr[0]; + polyPtr->coordPtr[objc+1] = polyPtr->coordPtr[1]; + } + + ComputePolygonBbox(canvas, polyPtr); return TCL_OK; } @@ -433,7 +427,7 @@ ConfigurePolygon( Tk_Canvas canvas, /* Canvas containing itemPtr. */ Tk_Item *itemPtr, /* Polygon item to reconfigure. */ int objc, /* Number of elements in objv. */ - Tcl_Obj *CONST objv[], /* Arguments describing things to configure. */ + Tcl_Obj *const objv[], /* Arguments describing things to configure. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; @@ -447,7 +441,7 @@ ConfigurePolygon( tkwin = Tk_CanvasTkwin(canvas); if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, - (CONST char **) objv, (char *) polyPtr, flags|TK_CONFIG_OBJS)) { + (const char **) objv, (char *) polyPtr, flags|TK_CONFIG_OBJS)) { return TCL_ERROR; } @@ -469,15 +463,15 @@ ConfigurePolygon( itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT; } - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } - if (state==TK_STATE_HIDDEN) { + if (state == TK_STATE_HIDDEN) { ComputePolygonBbox(canvas, polyPtr); return TCL_OK; } - mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &(polyPtr->outline)); + mask = Tk_ConfigOutlineGC(&gcValues, canvas, itemPtr, &polyPtr->outline); if (mask) { gcValues.cap_style = CapRound; gcValues.join_style = polyPtr->joinStyle; @@ -493,18 +487,18 @@ ConfigurePolygon( color = polyPtr->fillColor; stipple = polyPtr->fillStipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (polyPtr->activeFillColor!=NULL) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (polyPtr->activeFillColor != NULL) { color = polyPtr->activeFillColor; } - if (polyPtr->activeFillStipple!=None) { + if (polyPtr->activeFillStipple != None) { stipple = polyPtr->activeFillStipple; } - } else if (state==TK_STATE_DISABLED) { - if (polyPtr->disabledFillColor!=NULL) { + } else if (state == TK_STATE_DISABLED) { + if (polyPtr->disabledFillColor != NULL) { color = polyPtr->disabledFillColor; } - if (polyPtr->disabledFillStipple!=None) { + if (polyPtr->disabledFillStipple != None) { stipple = polyPtr->disabledFillStipple; } } @@ -524,7 +518,7 @@ ConfigurePolygon( * Mac OS X CG drawing needs access to the outline linewidth * even for fills (as linewidth controls antialiasing). */ - gcValues.line_width = polyPtr->outline.gc != None ? + gcValues.line_width = polyPtr->outline.gc != None ? polyPtr->outline.gc->line_width : 0; mask |= GCLineWidth; #endif @@ -574,9 +568,9 @@ DeletePolygon( { PolygonItem *polyPtr = (PolygonItem *) itemPtr; - Tk_DeleteOutline(display,&(polyPtr->outline)); + Tk_DeleteOutline(display, &polyPtr->outline); if (polyPtr->coordPtr != NULL) { - ckfree((char *) polyPtr->coordPtr); + ckfree(polyPtr->coordPtr); } if (polyPtr->fillColor != NULL) { Tk_FreeColor(polyPtr->fillColor); @@ -629,21 +623,22 @@ ComputePolygonBbox( Tk_State state = polyPtr->header.state; Tk_TSOffset *tsoffset; - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } width = polyPtr->outline.width; - if (polyPtr->coordPtr == NULL || (polyPtr->numPoints < 1) || (state==TK_STATE_HIDDEN)) { + if (polyPtr->coordPtr == NULL || (polyPtr->numPoints < 1) + || (state == TK_STATE_HIDDEN)) { polyPtr->header.x1 = polyPtr->header.x2 = - polyPtr->header.y1 = polyPtr->header.y2 = -1; + polyPtr->header.y1 = polyPtr->header.y2 = -1; return; } - if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)polyPtr) { - if (polyPtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == (Tk_Item *) polyPtr) { + if (polyPtr->outline.activeWidth > width) { width = polyPtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { - if (polyPtr->outline.disabledWidth>0.0) { + } else if (state == TK_STATE_DISABLED) { + if (polyPtr->outline.disabledWidth > 0.0) { width = polyPtr->outline.disabledWidth; } } @@ -669,6 +664,7 @@ ComputePolygonBbox( tsoffset = &polyPtr->tsoffset; if (tsoffset->flags & TK_OFFSET_INDEX) { int index = tsoffset->flags & ~TK_OFFSET_INDEX; + if (tsoffset->flags == INT_MAX) { index = (polyPtr->numPoints - polyPtr->autoClosed) * 2; if (index < 0) { @@ -676,7 +672,7 @@ ComputePolygonBbox( } } index %= (polyPtr->numPoints - polyPtr->autoClosed) * 2; - if (index <0) { + if (index < 0) { index += (polyPtr->numPoints - polyPtr->autoClosed) * 2; } tsoffset->xoffset = (int) (polyPtr->coordPtr[index] + 0.5); @@ -708,7 +704,7 @@ ComputePolygonBbox( index = (polyPtr->numPoints - 1) * 2; } index %= (polyPtr->numPoints - 1) * 2; - if (index <0) { + if (index < 0) { index += (polyPtr->numPoints - 1) * 2; } tsoffset->xoffset = (int) (polyPtr->coordPtr[index] + 0.5); @@ -717,21 +713,23 @@ ComputePolygonBbox( if (tsoffset->flags & TK_OFFSET_LEFT) { tsoffset->xoffset = polyPtr->header.x1; } else if (tsoffset->flags & TK_OFFSET_CENTER) { - tsoffset->xoffset = (polyPtr->header.x1 + polyPtr->header.x2)/2; + tsoffset->xoffset = + (polyPtr->header.x1 + polyPtr->header.x2) / 2; } else if (tsoffset->flags & TK_OFFSET_RIGHT) { tsoffset->xoffset = polyPtr->header.x2; } if (tsoffset->flags & TK_OFFSET_TOP) { tsoffset->yoffset = polyPtr->header.y1; } else if (tsoffset->flags & TK_OFFSET_MIDDLE) { - tsoffset->yoffset = (polyPtr->header.y1 + polyPtr->header.y2)/2; + tsoffset->yoffset = + (polyPtr->header.y1 + polyPtr->header.y2) / 2; } else if (tsoffset->flags & TK_OFFSET_BOTTOM) { tsoffset->yoffset = polyPtr->header.y2; } } } - i = (int) ((width+1.5)/2.0); + i = (int) ((width+1.5) / 2.0); polyPtr->header.x1 -= i; polyPtr->header.x2 += i; polyPtr->header.y1 -= i; @@ -748,19 +746,17 @@ ComputePolygonBbox( int j; coordPtr = polyPtr->coordPtr; - if (polyPtr->numPoints>3) { + if (polyPtr->numPoints > 3) { if (TkGetMiterPoints(coordPtr+2*(polyPtr->numPoints-2), - coordPtr, coordPtr+2, width, - miter, miter+2)) { + coordPtr, coordPtr+2, width, miter, miter+2)) { for (j = 0; j < 4; j += 2) { TkIncludePoint((Tk_Item *) polyPtr, miter+j); } } - } + } for (i = polyPtr->numPoints ; i >= 3; i--, coordPtr += 2) { - - if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4, - width, miter, miter+2)) { + if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4, width, + miter, miter+2)) { for (j = 0; j < 4; j += 2) { TkIncludePoint((Tk_Item *) polyPtr, miter+j); } @@ -827,7 +823,7 @@ TkFillPolygon( if (numPoints <= MAX_STATIC_POINTS) { pointPtr = staticPoints; } else { - pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint))); + pointPtr = ckalloc(numPoints * sizeof(XPoint)); } for (i=0, pPtr=pointPtr ; i<numPoints; i+=1, coordPtr+=2, pPtr++) { @@ -840,16 +836,16 @@ TkFillPolygon( * allocated. */ - if (gc != None && numPoints>3) { + if (gc != None && numPoints > 3) { XFillPolygon(display, drawable, gc, pointPtr, numPoints, Complex, CoordModeOrigin); } if (outlineGC != None) { - XDrawLines(display, drawable, outlineGC, pointPtr, - numPoints, CoordModeOrigin); + XDrawLines(display, drawable, outlineGC, pointPtr, numPoints, + CoordModeOrigin); } if (pointPtr != staticPoints) { - ckfree((char *) pointPtr); + ckfree(pointPtr); } } @@ -892,17 +888,17 @@ DisplayPolygon( } if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (polyPtr->outline.activeWidth>linewidth) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (polyPtr->outline.activeWidth > linewidth) { linewidth = polyPtr->outline.activeWidth; } if (polyPtr->activeFillStipple != None) { stipple = polyPtr->activeFillStipple; } - } else if (state==TK_STATE_DISABLED) { - if (polyPtr->outline.disabledWidth>0.0) { + } else if (state == TK_STATE_DISABLED) { + if (polyPtr->outline.disabledWidth > 0.0) { linewidth = polyPtr->outline.disabledWidth; } if (polyPtr->disabledFillStipple != None) { @@ -917,10 +913,11 @@ DisplayPolygon( if ((stipple != None) && (polyPtr->fillGC != None)) { Tk_TSOffset *tsoffset = &polyPtr->tsoffset; - int w=0; int h=0; + int w = 0, h = 0; int flags = tsoffset->flags; - if (!(flags & TK_OFFSET_INDEX) && (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE))) { + if (!(flags & TK_OFFSET_INDEX) + && (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE))) { Tk_SizeOfBitmap(display, stipple, &w, &h); if (flags & TK_OFFSET_CENTER) { w /= 2; @@ -939,20 +936,20 @@ DisplayPolygon( tsoffset->xoffset += w; tsoffset->yoffset += h; } - Tk_ChangeOutlineGC(canvas, itemPtr, &(polyPtr->outline)); + Tk_ChangeOutlineGC(canvas, itemPtr, &polyPtr->outline); - if(polyPtr->numPoints < 3) { - short x,y; + if (polyPtr->numPoints < 3) { + short x, y; int intLineWidth = (int) (linewidth + 0.5); if (intLineWidth < 1) { intLineWidth = 1; } Tk_CanvasDrawableCoords(canvas, polyPtr->coordPtr[0], - polyPtr->coordPtr[1], &x,&y); + polyPtr->coordPtr[1], &x, &y); XFillArc(display, drawable, polyPtr->outline.gc, x - intLineWidth/2, y - intLineWidth/2, - (unsigned int)intLineWidth+1, (unsigned int)intLineWidth+1, + (unsigned) intLineWidth+1, (unsigned) intLineWidth+1, 0, 64*360); } else if (!polyPtr->smooth || polyPtr->numPoints < 4) { TkFillPolygon(canvas, polyPtr->coordPtr, polyPtr->numPoints, @@ -972,8 +969,7 @@ DisplayPolygon( if (numPoints <= MAX_STATIC_POINTS) { pointPtr = staticPoints; } else { - pointPtr = (XPoint *) ckalloc((unsigned) - (numPoints * sizeof(XPoint))); + pointPtr = ckalloc(numPoints * sizeof(XPoint)); } numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr, polyPtr->numPoints, polyPtr->splineSteps, pointPtr, NULL); @@ -986,10 +982,10 @@ DisplayPolygon( numPoints, CoordModeOrigin); } if (pointPtr != staticPoints) { - ckfree((char *) pointPtr); + ckfree(pointPtr); } } - Tk_ResetOutlineGC(canvas, itemPtr, &(polyPtr->outline)); + Tk_ResetOutlineGC(canvas, itemPtr, &polyPtr->outline); if ((stipple != None) && (polyPtr->fillGC != None)) { XSetTSOrigin(display, polyPtr->fillGC, 0, 0); } @@ -1026,7 +1022,7 @@ PolygonInsert( Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } if (!obj || (Tcl_ListObjGetElements(NULL, obj, &objc, &objv) != TCL_OK) @@ -1034,21 +1030,20 @@ PolygonInsert( return; } length = 2*(polyPtr->numPoints - polyPtr->autoClosed); - while (beforeThis>length) { + while (beforeThis > length) { beforeThis -= length; } - while (beforeThis<0) { + while (beforeThis < 0) { beforeThis += length; } - newCoordPtr = (double *) - ckalloc(sizeof(double) * (unsigned)(length + 2 + objc)); + newCoordPtr = ckalloc(sizeof(double) * (length + 2 + objc)); for (i=0; i<beforeThis; i++) { newCoordPtr[i] = polyPtr->coordPtr[i]; } for (i=0; i<objc; i++) { if (Tcl_GetDoubleFromObj(NULL, objv[i], &newCoordPtr[i+beforeThis]) != TCL_OK){ - ckfree((char *) newCoordPtr); + ckfree(newCoordPtr); return; } } @@ -1057,7 +1052,7 @@ PolygonInsert( newCoordPtr[i+objc] = polyPtr->coordPtr[i]; } if (polyPtr->coordPtr) { - ckfree((char *) polyPtr->coordPtr); + ckfree(polyPtr->coordPtr); } length += objc; polyPtr->coordPtr = newCoordPtr; @@ -1084,7 +1079,7 @@ PolygonInsert( newCoordPtr[length] = newCoordPtr[0]; newCoordPtr[length+1] = newCoordPtr[1]; - if (((length-objc)>3) && (state != TK_STATE_HIDDEN)) { + if ((length-objc > 3) && (state != TK_STATE_HIDDEN)) { /* * This is some optimizing code that will result that only the part of * the polygon that changed (and the objects that are overlapping with @@ -1096,6 +1091,7 @@ PolygonInsert( double width; int j; + itemPtr->redraw_flags |= TK_ITEM_DONT_REDRAW; /* @@ -1107,10 +1103,11 @@ PolygonInsert( itemPtr->x1 = itemPtr->x2 = (int) polyPtr->coordPtr[beforeThis]; itemPtr->y1 = itemPtr->y2 = (int) polyPtr->coordPtr[beforeThis+1]; - beforeThis-=2; objc+=4; + beforeThis -= 2; + objc += 4; if (polyPtr->smooth) { - beforeThis-=2; - objc+=4; + beforeThis -= 2; + objc += 4; } /* @@ -1119,25 +1116,27 @@ PolygonInsert( for (i=beforeThis; i<beforeThis+objc; i+=2) { j = i; - if (j<0) { + if (j < 0) { j += length; - } else if (j>=length) { + } else if (j >= length) { j -= length; } TkIncludePoint(itemPtr, polyPtr->coordPtr+j); } width = polyPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (polyPtr->outline.activeWidth > width) { width = polyPtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { + } else if (state == TK_STATE_DISABLED) { if (polyPtr->outline.disabledWidth > 0.0) { width = polyPtr->outline.disabledWidth; } } - itemPtr->x1 -= (int) width; itemPtr->y1 -= (int) width; - itemPtr->x2 += (int) width; itemPtr->y2 += (int) width; + itemPtr->x1 -= (int) width; + itemPtr->y1 -= (int) width; + itemPtr->x2 += (int) width; + itemPtr->y2 += (int) width; Tk_CanvasEventuallyRedraw(canvas, itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2); } @@ -1173,16 +1172,16 @@ PolygonDeleteCoords( int count, i; int length = 2*(polyPtr->numPoints - polyPtr->autoClosed); - while (first>=length) { + while (first >= length) { first -= length; } - while (first<0) { + while (first < 0) { first += length; } - while (last>=length) { + while (last >= length) { last -= length; } - while (last<0) { + while (last < 0) { last += length; } @@ -1190,26 +1189,26 @@ PolygonDeleteCoords( last &= -2; count = last + 2 - first; - if (count<=0) { + if (count <= 0) { count += length; } if (count >= length) { polyPtr->numPoints = 0; if (polyPtr->coordPtr != NULL) { - ckfree((char *) polyPtr->coordPtr); + ckfree(polyPtr->coordPtr); polyPtr->coordPtr = NULL; } ComputePolygonBbox(canvas, polyPtr); return; } - if (last>=first) { - for(i=last+2; i<length; i++) { + if (last >= first) { + for (i=last+2; i<length; i++) { polyPtr->coordPtr[i-count] = polyPtr->coordPtr[i]; } } else { - for(i=last; i<=first; i++) { + for (i=last; i<=first; i++) { polyPtr->coordPtr[i-last] = polyPtr->coordPtr[i]; } } @@ -1262,15 +1261,15 @@ PolygonToPoint( bestDist = 1.0e36; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = polyPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (polyPtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (polyPtr->outline.activeWidth > width) { width = polyPtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { - if (polyPtr->outline.disabledWidth>0.0) { + } else if (state == TK_STATE_DISABLED) { + if (polyPtr->outline.disabledWidth > 0.0) { width = polyPtr->outline.disabledWidth; } } @@ -1281,26 +1280,23 @@ PolygonToPoint( * against which to do the check. */ - if ((polyPtr->smooth) && (polyPtr->numPoints>2)) { + if ((polyPtr->smooth) && (polyPtr->numPoints > 2)) { numPoints = polyPtr->smooth->coordProc(canvas, NULL, - polyPtr->numPoints, polyPtr->splineSteps, NULL, - NULL); + polyPtr->numPoints, polyPtr->splineSteps, NULL, NULL); if (numPoints <= MAX_STATIC_POINTS) { polyPoints = staticSpace; } else { - polyPoints = (double *) ckalloc((unsigned) - (2*numPoints*sizeof(double))); + polyPoints = ckalloc(2 * numPoints * sizeof(double)); } numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr, - polyPtr->numPoints, polyPtr->splineSteps, NULL, - polyPoints); + polyPtr->numPoints, polyPtr->splineSteps, NULL, polyPoints); } else { numPoints = polyPtr->numPoints; polyPoints = polyPtr->coordPtr; } bestDist = TkPolygonToPoint(polyPoints, numPoints, pointPtr); - if (bestDist<=0.0) { + if (bestDist <= 0.0) { goto donepoint; } if ((polyPtr->outline.gc != None) && (polyPtr->joinStyle == JoinRound)) { @@ -1350,16 +1346,16 @@ PolygonToPoint( */ if (count == numPoints) { - TkGetButtPoints(coordPtr+2, coordPtr, (double) width, - 0, poly, poly+2); + TkGetButtPoints(coordPtr+2, coordPtr, (double) width, 0, poly, + poly+2); } else if ((polyPtr->joinStyle == JoinMiter) && !changedMiterToBevel) { poly[0] = poly[6]; poly[1] = poly[7]; poly[2] = poly[4]; poly[3] = poly[5]; } else { - TkGetButtPoints(coordPtr+2, coordPtr, (double) width, 0, - poly, poly+2); + TkGetButtPoints(coordPtr+2, coordPtr, (double) width, 0, poly, + poly+2); /* * If this line uses beveled joints, then check the distance to a @@ -1382,8 +1378,8 @@ PolygonToPoint( } } if (count == 2) { - TkGetButtPoints(coordPtr, coordPtr+2, (double) width, - 0, poly+4, poly+6); + TkGetButtPoints(coordPtr, coordPtr+2, (double) width, 0, poly+4, + poly+6); } else if (polyPtr->joinStyle == JoinMiter) { if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4, (double) width, poly+4, poly+6) == 0) { @@ -1392,8 +1388,8 @@ PolygonToPoint( poly+4, poly+6); } } else { - TkGetButtPoints(coordPtr, coordPtr+2, (double) width, 0, - poly+4, poly+6); + TkGetButtPoints(coordPtr, coordPtr+2, (double) width, 0, poly+4, + poly+6); } poly[8] = poly[0]; poly[9] = poly[1]; @@ -1407,8 +1403,8 @@ PolygonToPoint( } donepoint: - if ((polyPoints != staticSpace) && polyPoints != polyPtr->coordPtr) { - ckfree((char *) polyPoints); + if (polyPoints != staticSpace && polyPoints != polyPtr->coordPtr) { + ckfree(polyPoints); } return bestDist; } @@ -1459,16 +1455,16 @@ PolygonToArea( Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = polyPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (polyPtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (polyPtr->outline.activeWidth > width) { width = polyPtr->outline.activeWidth; } - } else if (state==TK_STATE_DISABLED) { - if (polyPtr->outline.disabledWidth>0.0) { + } else if (state == TK_STATE_DISABLED) { + if (polyPtr->outline.disabledWidth > 0.0) { width = polyPtr->outline.disabledWidth; } } @@ -1476,9 +1472,9 @@ PolygonToArea( radius = width/2.0; inside = -1; - if ((state==TK_STATE_HIDDEN) || polyPtr->numPoints<2) { + if ((state == TK_STATE_HIDDEN) || polyPtr->numPoints < 2) { return -1; - } else if (polyPtr->numPoints <3) { + } else if (polyPtr->numPoints < 3) { double oval[4]; oval[0] = polyPtr->coordPtr[0]-radius; @@ -1499,8 +1495,7 @@ PolygonToArea( if (numPoints <= MAX_STATIC_POINTS) { polyPoints = staticSpace; } else { - polyPoints = (double *) - ckalloc((unsigned) (2*numPoints*sizeof(double))); + polyPoints = ckalloc(2 * numPoints * sizeof(double)); } numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr, polyPtr->numPoints, polyPtr->splineSteps, NULL, polyPoints); @@ -1516,7 +1511,7 @@ PolygonToArea( */ inside = TkPolygonToArea(polyPoints, numPoints, rectPtr); - if (inside==0) { + if (inside == 0) { goto donearea; } @@ -1585,8 +1580,8 @@ PolygonToArea( if (count == 2) { TkGetButtPoints(coordPtr, coordPtr+2, width, 0, poly+4, poly+6); } else if (polyPtr->joinStyle == JoinMiter) { - if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4, - width, poly+4, poly+6) == 0) { + if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4, width, + poly+4, poly+6) == 0) { changedMiterToBevel = 1; TkGetButtPoints(coordPtr, coordPtr+2, width,0, poly+4, poly+6); } @@ -1603,7 +1598,7 @@ PolygonToArea( donearea: if ((polyPoints != staticSpace) && (polyPoints != polyPtr->coordPtr)) { - ckfree((char *) polyPoints); + ckfree(polyPoints); } return inside; } @@ -1678,27 +1673,18 @@ GetPolygonIndex( int *indexPtr) /* Where to store converted index. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; - int length; - char *string = Tcl_GetStringFromObj(obj, &length); + const char *string = Tcl_GetString(obj); if (string[0] == 'e') { - if (strncmp(string, "end", (unsigned)length) == 0) { - *indexPtr = 2*(polyPtr->numPoints - polyPtr->autoClosed); - } else { - /* - * Some of the paths here leave messages in interp->result, so we - * have to clear it out before storing our own message. - */ - - badIndex: - Tcl_SetResult(interp, NULL, TCL_STATIC); - Tcl_AppendResult(interp, "bad index \"", string, "\"", NULL); - return TCL_ERROR; + if (strncmp(string, "end", obj->length) != 0) { + goto badIndex; } + *indexPtr = 2*(polyPtr->numPoints - polyPtr->autoClosed); } else if (string[0] == '@') { int i; - double x ,y, bestDist, dist, *coordPtr; - char *end, *p; + double x, y, bestDist, dist, *coordPtr; + char *end; + const char *p; p = string+1; x = strtod(p, &end); @@ -1713,9 +1699,9 @@ GetPolygonIndex( bestDist = 1.0e36; coordPtr = polyPtr->coordPtr; *indexPtr = 0; - for(i=0; i<(polyPtr->numPoints-1); i++) { + for (i=0; i<polyPtr->numPoints-1; i++) { dist = hypot(coordPtr[0] - x, coordPtr[1] - y); - if (dist<bestDist) { + if (dist < bestDist) { bestDist = dist; *indexPtr = 2*i; } @@ -1728,17 +1714,25 @@ GetPolygonIndex( goto badIndex; } *indexPtr &= -2; /* if odd, make it even */ - if (count) { - if (*indexPtr > 0) { - *indexPtr = ((*indexPtr - 2) % count) + 2; - } else { - *indexPtr = -((-(*indexPtr)) % count); - } - } else { + if (!count) { *indexPtr = 0; + } else if (*indexPtr > 0) { + *indexPtr = ((*indexPtr - 2) % count) + 2; + } else { + *indexPtr = -((-(*indexPtr)) % count); } } return TCL_OK; + + /* + * Some of the paths here leave messages in interp->result, so we have to + * clear it out before storing our own message. + */ + + badIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "POLY", NULL); + return TCL_ERROR; } /* @@ -1806,89 +1800,120 @@ PolygonToPostscript( * being created. */ { PolygonItem *polyPtr = (PolygonItem *) itemPtr; - char *style; + int style; XColor *color; XColor *fillColor; Pixmap stipple; Pixmap fillStipple; Tk_State state = itemPtr->state; double width; + Tcl_Obj *psObj; + Tcl_InterpState interpState; - if (polyPtr->numPoints<2 || polyPtr->coordPtr==NULL) { + if (polyPtr->numPoints < 2 || polyPtr->coordPtr == NULL) { return TCL_OK; } - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } width = polyPtr->outline.width; color = polyPtr->outline.color; stipple = polyPtr->fillStipple; fillColor = polyPtr->fillColor; fillStipple = polyPtr->fillStipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (polyPtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (polyPtr->outline.activeWidth > width) { width = polyPtr->outline.activeWidth; } - if (polyPtr->outline.activeColor!=NULL) { + if (polyPtr->outline.activeColor != NULL) { color = polyPtr->outline.activeColor; } - if (polyPtr->outline.activeStipple!=None) { + if (polyPtr->outline.activeStipple != None) { stipple = polyPtr->outline.activeStipple; } - if (polyPtr->activeFillColor!=NULL) { + if (polyPtr->activeFillColor != NULL) { fillColor = polyPtr->activeFillColor; } - if (polyPtr->activeFillStipple!=None) { + if (polyPtr->activeFillStipple != None) { fillStipple = polyPtr->activeFillStipple; } - } else if (state==TK_STATE_DISABLED) { - if (polyPtr->outline.disabledWidth>0.0) { + } else if (state == TK_STATE_DISABLED) { + if (polyPtr->outline.disabledWidth > 0.0) { width = polyPtr->outline.disabledWidth; } - if (polyPtr->outline.disabledColor!=NULL) { + if (polyPtr->outline.disabledColor != NULL) { color = polyPtr->outline.disabledColor; } - if (polyPtr->outline.disabledStipple!=None) { + if (polyPtr->outline.disabledStipple != None) { stipple = polyPtr->outline.disabledStipple; } - if (polyPtr->disabledFillColor!=NULL) { + if (polyPtr->disabledFillColor != NULL) { fillColor = polyPtr->disabledFillColor; } - if (polyPtr->disabledFillStipple!=None) { + if (polyPtr->disabledFillStipple != None) { fillStipple = polyPtr->disabledFillStipple; } } - if (polyPtr->numPoints==2) { - char string[128]; + + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + if (polyPtr->numPoints == 2) { if (color == NULL) { - return TCL_OK; + goto done; } - sprintf(string, "%.15g %.15g translate %.15g %.15g", - polyPtr->coordPtr[0], Tk_CanvasPsY(canvas, polyPtr->coordPtr[1]), + /* + * Create a point by using a small circle. (Printer pixels are too + * tiny to be used directly...) + */ + + Tcl_AppendPrintfToObj(psObj, + "matrix currentmatrix\n" /* save state */ + "%.15g %.15g translate " /* go to drawing location */ + "%.15g %.15g scale " /* scale the drawing */ + "1 0 moveto " /* correct for origin */ + "0 0 1 0 360 arc\n" /* make the circle */ + "setmatrix\n", /* restore state */ + polyPtr->coordPtr[0], + Tk_CanvasPsY(canvas, polyPtr->coordPtr[1]), width/2.0, width/2.0); - Tcl_AppendResult(interp, "matrix currentmatrix\n",string, - " scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", NULL); + + /* + * Color it in. + */ + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } - return TCL_OK; + goto done; } /* * Fill the area of the polygon. */ - if (fillColor != NULL && polyPtr->numPoints>3) { + if (fillColor != NULL && polyPtr->numPoints > 3) { + Tcl_ResetResult(interp); if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) { Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints); @@ -1897,18 +1922,24 @@ PolygonToPostscript( polyPtr->numPoints, polyPtr->splineSteps); } if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "eoclip ", NULL); + Tcl_AppendToObj(psObj, "eoclip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (color != NULL) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "eofill\n", NULL); + Tcl_AppendToObj(psObj, "eofill\n", -1); } } @@ -1917,6 +1948,7 @@ PolygonToPostscript( */ if (color != NULL) { + Tcl_ResetResult(interp); if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) { Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints); @@ -1924,21 +1956,38 @@ PolygonToPostscript( polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr, polyPtr->numPoints, polyPtr->splineSteps); } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (polyPtr->joinStyle == JoinRound) { - style = "1"; + style = 1; } else if (polyPtr->joinStyle == JoinBevel) { - style = "2"; + style = 2; } else { - style = "0"; + style = 0; } - Tcl_AppendResult(interp, style," setlinejoin 1 setlinecap\n", NULL); - if (Tk_CanvasPsOutline(canvas, itemPtr, - &(polyPtr->outline)) != TCL_OK) { - return TCL_ERROR; + Tcl_AppendPrintfToObj(psObj, "%d setlinejoin 1 setlinecap\n", style); + + Tcl_ResetResult(interp); + if (Tk_CanvasPsOutline(canvas, itemPtr, &polyPtr->outline) != TCL_OK){ + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } + + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index ac8f105..c6470dd 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -41,7 +41,6 @@ typedef struct TkColormapData { /* Hold color information for a window */ */ typedef struct TkPostscriptInfo { - Tk_Window tkwin; /* The canvas being printed. */ int x, y, width, height; /* Area to print, in canvas pixel * coordinates. */ int x2, y2; /* x+width and y+height. */ @@ -72,7 +71,7 @@ typedef struct TkPostscriptInfo { * NULL means return Postscript info as * result. Malloc'ed. */ char *channelName; /* If -channel is specified, the name of the - * channel to use. */ + * channel to use. */ Tcl_Channel chan; /* Open channel corresponding to fileName. */ Tcl_HashTable fontTable; /* Hash table containing names of all font * families used in output. The hash table @@ -81,7 +80,11 @@ typedef struct TkPostscriptInfo { * pre-pass that collects font information, so * the Postscript generated isn't relevant. */ int prolog; /* Non-zero means output should contain the - * prolog definitions in the header. */ + * standard prolog in the header. Generated in + * library/mkpsenc.tcl, stored in the variable + * ::tk::ps_preamable [sic]. */ + Tk_Window tkwin; /* Window to get font pixel/point transform + * from. */ } TkPostscriptInfo; /* @@ -89,40 +92,40 @@ typedef struct TkPostscriptInfo { * canvas "postscript" command and fill in TkPostscriptInfo structures. */ -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_STRING, "-colormap", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, colorVar), 0}, + "", Tk_Offset(TkPostscriptInfo, colorVar), 0, NULL}, {TK_CONFIG_STRING, "-colormode", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, colorMode), 0}, + "", Tk_Offset(TkPostscriptInfo, colorMode), 0, NULL}, {TK_CONFIG_STRING, "-file", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, fileName), 0}, + "", Tk_Offset(TkPostscriptInfo, fileName), 0, NULL}, {TK_CONFIG_STRING, "-channel", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, channelName), 0}, + "", Tk_Offset(TkPostscriptInfo, channelName), 0, NULL}, {TK_CONFIG_STRING, "-fontmap", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, fontVar), 0}, + "", Tk_Offset(TkPostscriptInfo, fontVar), 0, NULL}, {TK_CONFIG_PIXELS, "-height", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, height), 0}, + "", Tk_Offset(TkPostscriptInfo, height), 0, NULL}, {TK_CONFIG_ANCHOR, "-pageanchor", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0}, + "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0, NULL}, {TK_CONFIG_STRING, "-pageheight", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0}, + "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0, NULL}, {TK_CONFIG_STRING, "-pagewidth", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0}, + "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0, NULL}, {TK_CONFIG_STRING, "-pagex", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, pageXString), 0}, + "", Tk_Offset(TkPostscriptInfo, pageXString), 0, NULL}, {TK_CONFIG_STRING, "-pagey", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, pageYString), 0}, + "", Tk_Offset(TkPostscriptInfo, pageYString), 0, NULL}, {TK_CONFIG_BOOLEAN, "-prolog", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, prolog), 0}, + "", Tk_Offset(TkPostscriptInfo, prolog), 0, NULL}, {TK_CONFIG_BOOLEAN, "-rotate", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, rotate), 0}, + "", Tk_Offset(TkPostscriptInfo, rotate), 0, NULL}, {TK_CONFIG_PIXELS, "-width", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, width), 0}, + "", Tk_Offset(TkPostscriptInfo, width), 0, NULL}, {TK_CONFIG_PIXELS, "-x", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, x), 0}, + "", Tk_Offset(TkPostscriptInfo, x), 0, NULL}, {TK_CONFIG_PIXELS, "-y", NULL, NULL, - "", Tk_Offset(TkPostscriptInfo, y), 0}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + "", Tk_Offset(TkPostscriptInfo, y), 0, NULL}, + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -131,6 +134,10 @@ static Tk_ConfigSpec configSpecs[] = { static int GetPostscriptPoints(Tcl_Interp *interp, char *string, double *doublePtr); +static void PostscriptBitmap(Tk_Window tkwin, Pixmap bitmap, + int startX, int startY, int width, int height, + Tcl_Obj *psObj); +static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp); /* *-------------------------------------------------------------- @@ -156,7 +163,7 @@ TkCanvPostscriptCmd( TkCanvas *canvasPtr, /* Information about canvas widget. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. Caller has already parsed + const char **argv) /* Argument strings. Caller has already parsed * this command enough to know that argv[1] is * "postscript". */ { @@ -165,15 +172,15 @@ TkCanvPostscriptCmd( int result; Tk_Item *itemPtr; #define STRING_LENGTH 400 - char string[STRING_LENGTH+1]; - CONST char *p; + const char *p; time_t now; size_t length; Tk_Window tkwin = canvasPtr->tkwin; Tcl_HashSearch search; Tcl_HashEntry *hPtr; Tcl_DString buffer; - char psenccmd[] = "::tk::ensure_psenc_is_loaded"; + Tcl_Obj *preambleObj; + Tcl_Obj *psObj; int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area to be * marked up, measured in canvas units from * the positioning point on the page (reflects @@ -181,17 +188,31 @@ TkCanvPostscriptCmd( * only to stop compiler warnings. */ /* - * Initialize the data structure describing Postscript generation, then - * process all the arguments to fill the data structure in. + * Get the generic preamble. We only ever bother with the ASCII encoding; + * the others just make life too complicated and never actually worked as + * such. */ - result = Tcl_EvalEx(interp,psenccmd,-1,TCL_EVAL_GLOBAL); + result = Tcl_EvalEx(interp, "::tk::ensure_psenc_is_loaded", -1, 0); if (result != TCL_OK) { - return result; + return result; + } + preambleObj = Tcl_GetVar2Ex(interp, "::tk::ps_preamble", NULL, + TCL_LEAVE_ERR_MSG); + if (preambleObj == NULL) { + return TCL_ERROR; } + Tcl_IncrRefCount(preambleObj); + Tcl_ResetResult(interp); + psObj = Tcl_NewObj(); + + /* + * Initialize the data structure describing Postscript generation, then + * process all the arguments to fill the data structure in. + */ + oldInfoPtr = canvasPtr->psInfo; canvasPtr->psInfo = (Tk_PostscriptInfo) psInfoPtr; - psInfo.tkwin = canvasPtr->tkwin; psInfo.x = canvasPtr->xOrigin; psInfo.y = canvasPtr->yOrigin; psInfo.width = -1; @@ -214,6 +235,7 @@ TkCanvPostscriptCmd( psInfo.chan = NULL; psInfo.prepass = 0; psInfo.prolog = 1; + psInfo.tkwin = tkwin; Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS); result = Tk_ConfigureWidget(interp, tkwin, configSpecs, argc-2, argv+2, (char *) &psInfo, TK_CONFIG_ARGV_ONLY); @@ -304,35 +326,40 @@ TkCanvPostscriptCmd( } else if (strncmp(psInfo.colorMode, "color", length) == 0) { psInfo.colorLevel = 2; } else { - Tcl_AppendResult(interp, "bad color mode \"", psInfo.colorMode, - "\": must be monochrome, gray, or color", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad color mode \"%s\": must be monochrome, gray, or color", + psInfo.colorMode)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "COLORMODE", NULL); + result = TCL_ERROR; goto cleanup; } } if (psInfo.fileName != NULL) { - /* - * Check that -file and -channel are not both specified. - */ - - if (psInfo.channelName != NULL) { - Tcl_AppendResult(interp, "can't specify both -file", - " and -channel", NULL); - result = TCL_ERROR; - goto cleanup; - } - - /* - * Check that we are not in a safe interpreter. If we are, disallow - * the -file specification. - */ - - if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't specify -file in a", - " safe interpreter", NULL); - result = TCL_ERROR; - goto cleanup; - } + /* + * Check that -file and -channel are not both specified. + */ + + if (psInfo.channelName != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify both -file and -channel", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "USAGE", NULL); + result = TCL_ERROR; + goto cleanup; + } + + /* + * Check that we are not in a safe interpreter. If we are, disallow + * the -file specification. + */ + + if (Tcl_IsSafe(interp)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify -file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PS_FILE", NULL); + result = TCL_ERROR; + goto cleanup; + } p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer); if (p == NULL) { @@ -346,24 +373,26 @@ TkCanvPostscriptCmd( } if (psInfo.channelName != NULL) { - int mode; - - /* - * Check that the channel is found in this interpreter and that it is - * open for writing. - */ - - psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, &mode); - if (psInfo.chan == (Tcl_Channel) NULL) { - result = TCL_ERROR; - goto cleanup; - } - if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", psInfo.channelName, - "\" wasn't opened for writing", NULL); - result = TCL_ERROR; - goto cleanup; - } + int mode; + + /* + * Check that the channel is found in this interpreter and that it is + * open for writing. + */ + + psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, &mode); + if (psInfo.chan == (Tcl_Channel) NULL) { + result = TCL_ERROR; + goto cleanup; + } + if (!(mode & TCL_WRITABLE)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel \"%s\" wasn't opened for writing", + psInfo.channelName)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "UNWRITABLE",NULL); + result = TCL_ERROR; + goto cleanup; + } } /* @@ -384,7 +413,7 @@ TkCanvPostscriptCmd( if (itemPtr->typePtr->postscriptProc == NULL) { continue; } - result = (*itemPtr->typePtr->postscriptProc)(interp, + result = itemPtr->typePtr->postscriptProc(interp, (Tk_Canvas) canvasPtr, itemPtr, 1); Tcl_ResetResult(interp); if (result != TCL_OK) { @@ -394,6 +423,7 @@ TkCanvPostscriptCmd( * can happen later that don't happen now, so we still have to * check for errors later anyway). */ + break; } } @@ -404,24 +434,27 @@ TkCanvPostscriptCmd( */ if (psInfo.prolog) { - Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n", - "%%Creator: Tk Canvas Widget\n", NULL); + Tcl_AppendToObj(psObj, + "%!PS-Adobe-3.0 EPSF-3.0\n" + "%%Creator: Tk Canvas Widget\n", -1); + #ifdef HAVE_PW_GECOS if (!Tcl_IsSafe(interp)) { struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ - Tcl_AppendResult(interp, "%%For: ", - (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%For: %s\n", (pwPtr ? pwPtr->pw_gecos : "Unknown")); endpwent(); } #endif /* HAVE_PW_GECOS */ - Tcl_AppendResult(interp, "%%Title: Window ", Tk_PathName(tkwin), "\n", - NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%Title: Window %s\n", Tk_PathName(tkwin)); time(&now); - Tcl_AppendResult(interp, "%%CreationDate: ", - ctime(&now), NULL); /* INTL: Native. */ + Tcl_AppendPrintfToObj(psObj, + "%%%%CreationDate: %s", ctime(&now)); /* INTL: Native. */ if (!psInfo.rotate) { - sprintf(string, "%d %d %d %d", + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %d %d %d %d\n", (int) (psInfo.pageX + psInfo.scale*deltaX), (int) (psInfo.pageY + psInfo.scale*deltaY), (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width) @@ -429,51 +462,60 @@ TkCanvPostscriptCmd( (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height) + 1.0)); } else { - sprintf(string, "%d %d %d %d", + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %d %d %d %d\n", (int) (psInfo.pageX - psInfo.scale*(deltaY+psInfo.height)), (int) (psInfo.pageY + psInfo.scale*deltaX), (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0), (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width) + 1.0)); } - Tcl_AppendResult(interp, "%%BoundingBox: ", string, "\n", NULL); - Tcl_AppendResult(interp, "%%Pages: 1\n", - "%%DocumentData: Clean7Bit\n", NULL); - Tcl_AppendResult(interp, "%%Orientation: ", - psInfo.rotate ? "Landscape\n" : "Portrait\n", NULL); - p = "%%DocumentNeededResources: font "; + Tcl_AppendPrintfToObj(psObj, + "%%%%Pages: 1\n" + "%%%%DocumentData: Clean7Bit\n" + "%%%%Orientation: %s\n", + psInfo.rotate ? "Landscape" : "Portrait"); + p = "%%%%DocumentNeededResources: font %s\n"; for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(interp, p, - Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); - p = "%%+ font "; + Tcl_AppendPrintfToObj(psObj, p, + Tcl_GetHashKey(&psInfo.fontTable, hPtr)); + p = "%%%%+ font %s\n"; } - Tcl_AppendResult(interp, "%%EndComments\n\n", NULL); + Tcl_AppendToObj(psObj, "%%EndComments\n\n", -1); /* * Insert the prolog */ - Tcl_AppendResult(interp, Tcl_GetVar(interp,"::tk::ps_preamable", - TCL_GLOBAL_ONLY), NULL); + Tcl_AppendObjToObj(psObj, preambleObj); if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(canvasPtr->interp); + if (Tcl_WriteObj(psInfo.chan, psObj) == -1) { + channelWriteFailed: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "problem writing postscript data to channel: %s", + Tcl_PosixError(interp))); + result = TCL_ERROR; + goto cleanup; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); } /* * Document setup: set the color level and include fonts. */ - sprintf(string, "/CL %d def\n", psInfo.colorLevel); - Tcl_AppendResult(interp, "%%BeginSetup\n", string, NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%BeginSetup\n/CL %d def\n", psInfo.colorLevel); for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(interp, "%%IncludeResource: font ", - Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "%%%%IncludeResource: font %s\n", + (char *) Tcl_GetHashKey(&psInfo.fontTable, hPtr)); } - Tcl_AppendResult(interp, "%%EndSetup\n\n", NULL); + Tcl_AppendToObj(psObj, "%%EndSetup\n\n", -1); /* * Page setup: move to page positioning point, rotate if needed, set @@ -481,18 +523,19 @@ TkCanvPostscriptCmd( * region. */ - Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n", NULL); - sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendToObj(psObj, "%%Page: 1 1\nsave\n", -1); + Tcl_AppendPrintfToObj(psObj, + "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); if (psInfo.rotate) { - Tcl_AppendResult(interp, "90 rotate\n", NULL); + Tcl_AppendToObj(psObj, "90 rotate\n", -1); } - sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); - Tcl_AppendResult(interp, string, NULL); - sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY); - Tcl_AppendResult(interp, string, NULL); - sprintf(string, - "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g", + Tcl_AppendPrintfToObj(psObj, + "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); + Tcl_AppendPrintfToObj(psObj, + "%d %d translate\n", deltaX - psInfo.x, deltaY); + Tcl_AppendPrintfToObj(psObj, + "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g " + "lineto closepath clip newpath\n", psInfo.x, Tk_PostscriptY((double)psInfo.y, (Tk_PostscriptInfo)psInfoPtr), psInfo.x2, Tk_PostscriptY((double)psInfo.y, @@ -501,12 +544,13 @@ TkCanvPostscriptCmd( (Tk_PostscriptInfo)psInfoPtr), psInfo.x, Tk_PostscriptY((double)psInfo.y2, (Tk_PostscriptInfo)psInfoPtr)); - Tcl_AppendResult(interp, string, - " lineto closepath clip newpath\n", NULL); - } - if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(canvasPtr->interp); + if (psInfo.chan != NULL) { + if (Tcl_WriteObj(psInfo.chan, psObj) == -1) { + goto channelWriteFailed; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); + } } /* @@ -527,21 +571,27 @@ TkCanvPostscriptCmd( if (itemPtr->state == TK_STATE_HIDDEN) { continue; } - Tcl_AppendResult(interp, "gsave\n", NULL); - result = (*itemPtr->typePtr->postscriptProc)(interp, + + Tcl_ResetResult(interp); + result = itemPtr->typePtr->postscriptProc(interp, (Tk_Canvas) canvasPtr, itemPtr, 0); if (result != TCL_OK) { - char msg[64 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (generating Postscript for item %d)", - itemPtr->id); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (generating Postscript for item %d)", + itemPtr->id)); goto cleanup; } - Tcl_AppendResult(interp, "grestore\n", NULL); + + Tcl_AppendToObj(psObj, "gsave\n", -1); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(psObj, "grestore\n", -1); + if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(interp); + if (Tcl_WriteObj(psInfo.chan, psObj) == -1) { + goto channelWriteFailed; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); } } @@ -551,12 +601,22 @@ TkCanvPostscriptCmd( */ if (psInfo.prolog) { - Tcl_AppendResult(interp, "restore showpage\n\n", - "%%Trailer\nend\n%%EOF\n", NULL); + Tcl_AppendToObj(psObj, + "restore showpage\n\n" + "%%Trailer\n" + "end\n" + "%%EOF\n", -1); + + if (psInfo.chan != NULL) { + if (Tcl_WriteObj(psInfo.chan, psObj) == -1) { + goto channelWriteFailed; + } + } } - if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); - Tcl_ResetResult(canvasPtr->interp); + + if (psInfo.chan == NULL) { + Tcl_SetObjResult(interp, psObj); + psObj = Tcl_NewObj(); } /* @@ -592,13 +652,28 @@ TkCanvPostscriptCmd( Tcl_Close(interp, psInfo.chan); } if (psInfo.channelName != NULL) { - ckfree(psInfo.channelName); + ckfree(psInfo.channelName); } Tcl_DeleteHashTable(&psInfo.fontTable); canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr; + Tcl_DecrRefCount(preambleObj); + Tcl_DecrRefCount(psObj); return result; } +static inline Tcl_Obj * +GetPostscriptBuffer( + Tcl_Interp *interp) +{ + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + return psObj; +} + /* *-------------------------------------------------------------- * @@ -627,9 +702,7 @@ Tk_PostscriptColor( XColor *colorPtr) /* Information about color. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - int tmp; double red, green, blue; - char string[200]; if (psInfoPtr->prepass) { return TCL_OK; @@ -641,12 +714,12 @@ Tk_PostscriptColor( */ if (psInfoPtr->colorVar != NULL) { - CONST char *cmdString; - - cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, + const char *cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, Tk_NameOfColor(colorPtr), 0); + if (cmdString != NULL) { - Tcl_AppendResult(interp, cmdString, "\n", NULL); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%s\n", cmdString); return TCL_OK; } } @@ -663,15 +736,12 @@ Tk_PostscriptColor( * per color, but most diplays use at least 8 bits. */ - tmp = colorPtr->red; - red = ((double) (tmp >> 8))/255.0; - tmp = colorPtr->green; - green = ((double) (tmp >> 8))/255.0; - tmp = colorPtr->blue; - blue = ((double) (tmp >> 8))/255.0; - sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n", + red = ((double) (((int) colorPtr->red) >> 8))/255.0; + green = ((double) (((int) colorPtr->green) >> 8))/255.0; + blue = ((double) (((int) colorPtr->blue) >> 8))/255.0; + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%.3f %.3f %.3f setrgbcolor AdjustColor\n", red, green, blue); - Tcl_AppendResult(interp, string, NULL); return TCL_OK; } @@ -705,9 +775,9 @@ Tk_PostscriptFont( * be printed. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char pointString[TCL_INTEGER_SPACE]; Tcl_DString ds; int i, points; + const char *fontname; /* * First, look up the font's name in the font map, if there is one. If @@ -716,35 +786,31 @@ Tk_PostscriptFont( */ if (psInfoPtr->fontVar != NULL) { - CONST char *name = Tk_NameOfFont(tkfont); + const char *name = Tk_NameOfFont(tkfont); Tcl_Obj **objv; int objc; double size; Tcl_Obj *list = Tcl_GetVar2Ex(interp, psInfoPtr->fontVar, name, 0); if (list != NULL) { - CONST char *fontname; - if (Tcl_ListObjGetElements(interp, list, &objc, &objv) != TCL_OK || objc != 2 - || Tcl_GetString(objv[0])[0]=='\0' + || (fontname = Tcl_GetString(objv[0]))[0] == '\0' + || strchr(fontname, ' ') != NULL || Tcl_GetDoubleFromObj(interp, objv[1], &size) != TCL_OK || size <= 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad font map entry for \"", name, - "\": \"", Tcl_GetString(list), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad font map entry for \"%s\": \"%s\"", + name, Tcl_GetString(list))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "FONTMAP", + NULL); return TCL_ERROR; } - fontname = Tcl_GetString(objv[0]); - sprintf(pointString, "%d", (int)size); - - Tcl_AppendResult(interp, "/", fontname, " findfont ", - pointString, " scalefont ", NULL); - if (strncasecmp(fontname, "Symbol", 7) != 0) { - Tcl_AppendResult(interp, "ISOEncode ", NULL); - } - Tcl_AppendResult(interp, "setfont\n", NULL); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, (int) size, + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontname, &i); return TCL_OK; } @@ -756,13 +822,11 @@ Tk_PostscriptFont( Tcl_DStringInit(&ds); points = Tk_PostscriptFontName(tkfont, &ds); - sprintf(pointString, "%d", TkFontGetPoints(psInfoPtr->tkwin, points)); - Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ", - pointString, " scalefont ", NULL); - if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) { - Tcl_AppendResult(interp, "ISOEncode ", NULL); - } - Tcl_AppendResult(interp, "setfont\n", NULL); + fontname = Tcl_DStringValue(&ds); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, TkFontGetPoints(psInfoPtr->tkwin, points), + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i); Tcl_DStringFree(&ds); @@ -800,18 +864,32 @@ Tk_PostscriptBitmap( int width, int height) /* Height of rectangular region. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + PostscriptBitmap(tkwin, bitmap, startX, startY, width, height, + GetPostscriptBuffer(interp)); + return TCL_OK; +} + +static void +PostscriptBitmap( + Tk_Window tkwin, + Pixmap bitmap, /* Bitmap for which to generate Postscript. */ + int startX, int startY, /* Coordinates of upper-left corner of + * rectangular region to output. */ + int width, int height, /* Height of rectangular region. */ + Tcl_Obj *psObj) /* Where to append the postscript. */ +{ XImage *imagePtr; int charsInLine, x, y, lastX, lastY, value, mask; unsigned int totalWidth, totalHeight; - char string[100]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; - if (psInfoPtr->prepass) { - return TCL_OK; - } - /* * The following call should probably be a call to Tk_SizeOfBitmap * instead, but it seems that we are occasionally invoked by custom item @@ -825,7 +903,8 @@ Tk_PostscriptBitmap( (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0, totalWidth, totalHeight, 1, XYPixmap); - Tcl_AppendResult(interp, "<", NULL); + + Tcl_AppendToObj(psObj, "<", -1); mask = 0x80; value = 0; charsInLine = 0; @@ -838,28 +917,26 @@ Tk_PostscriptBitmap( } mask >>= 1; if (mask == 0) { - sprintf(string, "%02x", value); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendPrintfToObj(psObj, "%02x", value); mask = 0x80; value = 0; charsInLine += 2; if (charsInLine >= 60) { - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); charsInLine = 0; } } } if (mask != 0x80) { - sprintf(string, "%02x", value); - Tcl_AppendResult(interp, string, NULL); + Tcl_AppendPrintfToObj(psObj, "%02x", value); mask = 0x80; value = 0; charsInLine += 2; } } - Tcl_AppendResult(interp, ">", NULL); + Tcl_AppendToObj(psObj, ">", -1); + XDestroyImage(imagePtr); - return TCL_OK; } /* @@ -894,10 +971,10 @@ Tk_PostscriptStipple( { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int width, height; - char string[TCL_INTEGER_SPACE * 2]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -914,13 +991,11 @@ Tk_PostscriptStipple( XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot, (int *) &dummyX, (int *) &dummyY, (unsigned *) &width, (unsigned *) &height, &dummyBorderwidth, &dummyDepth); - sprintf(string, "%d %d ", width, height); - Tcl_AppendResult(interp, string, NULL); - if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0, - width, height) != TCL_OK) { - return TCL_ERROR; - } - Tcl_AppendResult(interp, " StippleFill\n", NULL); + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%d %d ", width, height); + PostscriptBitmap(tkwin, bitmap, 0, 0, width, height, psObj); + Tcl_AppendToObj(psObj, " StippleFill\n", -1); return TCL_OK; } @@ -980,19 +1055,19 @@ Tk_PostscriptPath( int numPoints) /* Number of points at *coordPtr. */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char buffer[200]; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return; } - sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], - Tk_PostscriptY(coordPtr[1], psInfo)); - Tcl_AppendResult(interp, buffer, NULL); + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g moveto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); for (numPoints--, coordPtr += 2; numPoints > 0; numPoints--, coordPtr += 2) { - sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], - Tk_PostscriptY(coordPtr[1], psInfo)); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); } } @@ -1063,7 +1138,8 @@ GetPostscriptPoints( return TCL_OK; error: - Tcl_AppendResult(interp, "bad distance \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "POINTS", NULL); return TCL_ERROR; } @@ -1092,7 +1168,7 @@ GetPostscriptPoints( *-------------------------------------------------------------- */ -#ifdef WIN32 +#ifdef _WIN32 #include <windows.h> /* @@ -1102,15 +1178,15 @@ GetPostscriptPoints( #define GetBValue(rgb) ((BYTE)((rgb)>>16)) */ -#else /* !WIN32 */ +#else /* !_WIN32 */ #define GetRValue(rgb) ((rgb & cdata->red_mask) >> cdata->red_shift) #define GetGValue(rgb) ((rgb & cdata->green_mask) >> cdata->green_shift) #define GetBValue(rgb) ((rgb & cdata->blue_mask) >> cdata->blue_shift) -#endif /* WIN32 */ +#endif /* _WIN32 */ -#if defined(WIN32) || defined(MAC_OSX_TK) +#if defined(_WIN32) || defined(MAC_OSX_TK) static void TkImageGetColor( TkColormapData *cdata, /* Colormap data */ @@ -1122,7 +1198,7 @@ TkImageGetColor( *green = (double) GetGValue(pixel) / 255.0; *blue = (double) GetBValue(pixel) / 255.0; } -#else /* ! (WIN32 || MAC_OSX_TK) */ +#else /* ! (_WIN32 || MAC_OSX_TK) */ static void TkImageGetColor( TkColormapData *cdata, /* Colormap data */ @@ -1144,7 +1220,7 @@ TkImageGetColor( *blue = cdata->colors[pixel].blue / 65535.0; } } -#endif /* WIN32 || MAC_OSX_TK */ +#endif /* _WIN32 || MAC_OSX_TK */ /* *-------------------------------------------------------------- @@ -1177,15 +1253,15 @@ TkPostscriptImage( int width, int height) /* Width and height of area */ { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; - char buffer[256]; int xx, yy, band, maxRows; double red, green, blue; - int bytesPerLine=0, maxWidth=0; + int bytesPerLine = 0, maxWidth = 0; int level = psInfoPtr->colorLevel; Colormap cmap; int i, ncolors; Visual *visual; TkColormapData cdata; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { return TCL_OK; @@ -1200,7 +1276,7 @@ TkPostscriptImage( */ ncolors = visual->map_entries; - cdata.colors = (XColor *) ckalloc(sizeof(XColor) * ncolors); + cdata.colors = ckalloc(sizeof(XColor) * ncolors); cdata.ncolors = ncolors; if (visual->class == DirectColor || visual->class == TrueColor) { @@ -1249,7 +1325,7 @@ TkPostscriptImage( * monochrome screen, use gray or monochrome mode instead. */ - if (!cdata.color && level == 2) { + if (!cdata.color && level >= 2) { level = 1; } @@ -1266,20 +1342,21 @@ TkPostscriptImage( switch (level) { case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break; case 1: bytesPerLine = width; maxWidth = 60000; break; - case 2: bytesPerLine = 3 * width; maxWidth = 20000; break; + default: bytesPerLine = 3 * width; maxWidth = 20000; break; } if (bytesPerLine > 60000) { Tcl_ResetResult(interp); - sprintf(buffer, - "Can't generate Postscript for images more than %d pixels wide", - maxWidth); - Tcl_AppendResult(interp, buffer, NULL); - ckfree((char *) cdata.colors); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't generate Postscript for images more than %d pixels wide", + maxWidth)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); + ckfree(cdata.colors); return TCL_ERROR; } maxRows = 60000 / bytesPerLine; + psObj = GetPostscriptBuffer(interp); for (band = height-1; band >= 0; band -= maxRows) { int rows = (band >= maxRows) ? maxRows : band + 1; @@ -1287,16 +1364,13 @@ TkPostscriptImage( switch (level) { case 0: - sprintf(buffer, "%d %d 1 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 1 matrix {\n<", width, rows); break; case 1: - sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); break; - case 2: - sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); - Tcl_AppendResult(interp, buffer, NULL); + default: + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); break; } for (yy = band; yy > band - rows; yy--) { @@ -1318,22 +1392,20 @@ TkPostscriptImage( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } - mask=0x80; - data=0x00; + mask = 0x80; + data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); - mask=0x80; - data=0x00; + Tcl_AppendPrintfToObj(psObj, "%02X", data); + mask = 0x80; + data = 0x00; } break; } @@ -1346,17 +1418,17 @@ TkPostscriptImage( for (xx = x; xx < x+width; xx ++) { TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), &red, &green, &blue); - sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 * + Tcl_AppendPrintfToObj(psObj, "%02X", + (int) floor(0.5 + 255.0 * (0.30 * red + 0.59 * green + 0.11 * blue))); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; - case 2: + default: /* * Finally, color mode. Here, just output the red, green, and * blue values directly. @@ -1365,15 +1437,14 @@ TkPostscriptImage( for (xx = x; xx < x+width; xx++) { TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), &red, &green, &blue); - sprintf(buffer, "%02X%02X%02X", + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", (int) floor(0.5 + 255.0 * red), (int) floor(0.5 + 255.0 * green), (int) floor(0.5 + 255.0 * blue)); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen > 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1381,15 +1452,13 @@ TkPostscriptImage( } switch (level) { case 0: case 1: - sprintf(buffer, ">\n} image\n"); break; - case 2: - sprintf(buffer, ">\n} false 3 colorimage\n"); break; + Tcl_AppendToObj(psObj, ">\n} image\n", -1); break; + default: + Tcl_AppendToObj(psObj, ">\n} false 3 colorimage\n", -1); break; } - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, "0 %d translate\n", rows); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "0 %d translate\n", rows); } - ckfree((char *) cdata.colors); + ckfree(cdata.colors); return TCL_OK; } @@ -1423,153 +1492,32 @@ Tk_PostscriptPhoto( { TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int colorLevel = psInfoPtr->colorLevel; - static int codeIncluded = 0; - + const char *displayOperation, *decode; unsigned char *pixelPtr; - char buffer[256], cspace[40], decode[40]; - int bpc; - int xx, yy, lineLen; + int bpc, xx, yy, lineLen, alpha; float red, green, blue; - int alpha; - int bytesPerLine=0, maxWidth=0; - + int bytesPerLine = 0, maxWidth = 0; unsigned char opaque = 255; unsigned char *alphaPtr; int alphaOffset, alphaPitch, alphaIncr; + Tcl_Obj *psObj; if (psInfoPtr->prepass) { - codeIncluded = 0; return TCL_OK; } - /* - * Define the "TkPhoto" function, which is a modified version of the - * original "transparentimage" function posted by ian@five-d.com (Ian - * Kemmish) to comp.lang.postscript. For a monochrome colorLevel this is a - * slightly different version that uses the imagemask command instead of - * image. - */ - - if (!codeIncluded && (colorLevel != 0)) { + if (colorLevel != 0) { /* * Color and gray-scale code. */ - codeIncluded = !0; - Tcl_AppendResult(interp, - "/TkPhoto { \n", - " gsave \n", - " 32 dict begin \n", - " /tinteger exch def \n", - " /transparent 1 string def \n", - " transparent 0 tinteger put \n", - " /olddict exch def \n", - " olddict /DataSource get dup type /filetype ne { \n", - " olddict /DataSource 3 -1 roll \n", - " 0 () /SubFileDecode filter put \n", - " } { \n", - " pop \n", - " } ifelse \n", - " /newdict olddict maxlength dict def \n", - " olddict newdict copy pop \n", - " /w newdict /Width get def \n", - " /crpp newdict /Decode get length 2 idiv def \n", - " /str w string def \n", - " /pix w crpp mul string def \n", - " /substrlen 2 w log 2 log div floor exp cvi def \n", - " /substrs [ \n", - " { \n", - " substrlen string \n", - " 0 1 substrlen 1 sub { \n", - " 1 index exch tinteger put \n", - " } for \n", - " /substrlen substrlen 2 idiv def \n", - " substrlen 0 eq {exit} if \n", - " } loop \n", - " ] def \n", - " /h newdict /Height get def \n", - " 1 w div 1 h div matrix scale \n", - " olddict /ImageMatrix get exch matrix concatmatrix \n", - " matrix invertmatrix concat \n", - " newdict /Height 1 put \n", - " newdict /DataSource pix put \n", - " /mat [w 0 0 h 0 0] def \n", - " newdict /ImageMatrix mat put \n", - " 0 1 h 1 sub { \n", - " mat 5 3 -1 roll neg put \n", - " olddict /DataSource get str readstring pop pop \n", - " /tail str def \n", - " /x 0 def \n", - " olddict /DataSource get pix readstring pop pop \n", - " { \n", - " tail transparent search dup /done exch not def \n", - " {exch pop exch pop} if \n", - " /w1 exch length def \n", - " w1 0 ne { \n", - " newdict /DataSource ", - " pix x crpp mul w1 crpp mul getinterval put \n", - " newdict /Width w1 put \n", - " mat 4 x neg put \n", - " /x x w1 add def \n", - " newdict image \n", - " /tail tail w1 tail length w1 sub getinterval def \n", - " } if \n", - " done {exit} if \n", - " tail substrs { \n", - " anchorsearch {pop} if \n", - " } forall \n", - " /tail exch def \n", - " tail length 0 eq {exit} if \n", - " /x w tail length sub def \n", - " } loop \n", - " } for \n", - " end \n", - " grestore \n", - "} bind def \n\n\n", NULL); - } else if (!codeIncluded && (colorLevel == 0)) { + displayOperation = "TkPhotoColor"; + } else { /* * Monochrome-only code */ - codeIncluded = !0; - Tcl_AppendResult(interp, - "/TkPhoto { \n", - " gsave \n", - " 32 dict begin \n", - " /dummyInteger exch def \n", - " /olddict exch def \n", - " olddict /DataSource get dup type /filetype ne { \n", - " olddict /DataSource 3 -1 roll \n", - " 0 () /SubFileDecode filter put \n", - " } { \n", - " pop \n", - " } ifelse \n", - " /newdict olddict maxlength dict def \n", - " olddict newdict copy pop \n", - " /w newdict /Width get def \n", - " /pix w 7 add 8 idiv string def \n", - " /h newdict /Height get def \n", - " 1 w div 1 h div matrix scale \n", - " olddict /ImageMatrix get exch matrix concatmatrix \n", - " matrix invertmatrix concat \n", - " newdict /Height 1 put \n", - " newdict /DataSource pix put \n", - " /mat [w 0 0 h 0 0] def \n", - " newdict /ImageMatrix mat put \n", - " 0 1 h 1 sub { \n", - " mat 5 3 -1 roll neg put \n", - " 0.000 0.000 0.000 setrgbcolor \n", - " olddict /DataSource get pix readstring pop pop \n", - " newdict /DataSource pix put \n", - " newdict imagemask \n", - " 1.000 1.000 1.000 setrgbcolor \n", - " olddict /DataSource get pix readstring pop pop \n", - " newdict /DataSource pix put \n", - " newdict imagemask \n", - " } for \n", - " end \n", - " grestore \n", - "} bind def \n\n\n", NULL); + displayOperation = "TkPhotoMono"; } /* @@ -1581,14 +1529,14 @@ Tk_PostscriptPhoto( switch (colorLevel) { case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break; case 1: bytesPerLine = width; maxWidth = 60000; break; - case 2: bytesPerLine = 3 * width; maxWidth = 20000; break; + default: bytesPerLine = 3 * width; maxWidth = 20000; break; } if (bytesPerLine > 60000) { Tcl_ResetResult(interp); - sprintf(buffer, - "Can't generate Postscript for images more than %d pixels wide", - maxWidth); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't generate Postscript for images more than %d pixels wide", + maxWidth)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); return TCL_ERROR; } @@ -1596,35 +1544,32 @@ Tk_PostscriptPhoto( * Set up the postscript code except for the image-data stream. */ + psObj = GetPostscriptBuffer(interp); switch (colorLevel) { case 0: - strcpy(cspace, "/DeviceGray"); - strcpy(decode, "[1 0]"); + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "1 0"; bpc = 1; break; case 1: - strcpy(cspace, "/DeviceGray"); - strcpy(decode, "[0 1]"); + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "0 1"; bpc = 8; break; default: - strcpy(cspace, "/DeviceRGB"); - strcpy(decode, "[0 1 0 1 0 1]"); + Tcl_AppendToObj(psObj, "/DeviceRGB setcolorspace\n\n", -1); + decode = "0 1 0 1 0 1"; bpc = 8; break; } - - Tcl_AppendResult(interp, cspace, " setcolorspace\n\n", NULL); - - sprintf(buffer, " /Width %d\n /Height %d\n /BitsPerComponent %d\n", - width, height, bpc); - Tcl_AppendResult(interp, "<<\n /ImageType 1\n", buffer, - " /DataSource currentfile /ASCIIHexDecode filter\n", NULL); - - sprintf(buffer, " /ImageMatrix [1 0 0 -1 0 %d]\n", height); - Tcl_AppendResult(interp, buffer, " /Decode ", decode, - "\n>>\n1 TkPhoto\n", NULL); + Tcl_AppendPrintfToObj(psObj, + "<<\n /ImageType 1\n" + " /Width %d\n /Height %d\n /BitsPerComponent %d\n" + " /DataSource currentfile\n /ASCIIHexDecode filter\n" + " /ImageMatrix [1 0 0 -1 0 %d]\n /Decode [%s]\n>>\n" + "1 %s\n", + width, height, bpc, height, decode, displayOperation); /* * Check the PhotoImageBlock information. We assume that: @@ -1684,20 +1629,18 @@ Tk_PostscriptPhoto( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); mask = 0x80; data = 0x00; } @@ -1725,20 +1668,18 @@ Tk_PostscriptPhoto( } mask >>= 1; if (mask == 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { - sprintf(buffer, "%02X", data); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", data); mask = 0x80; data = 0x00; } @@ -1753,12 +1694,11 @@ Tk_PostscriptPhoto( for (xx = 0; xx < width; xx ++) { alpha = *(alphaPtr + (yy * alphaPitch) + (xx * alphaIncr) + alphaOffset); - sprintf(buffer, "%02X", alpha | 0x01); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } @@ -1775,13 +1715,12 @@ Tk_PostscriptPhoto( green = pixelPtr[blockPtr->offset[1]]; blue = pixelPtr[blockPtr->offset[2]]; - sprintf(buffer, "%02X", (int) floor(0.5 + + Tcl_AppendPrintfToObj(psObj, "%02X", (int) floor(0.5 + ( 0.3086 * red + 0.6094 * green + 0.0820 * blue))); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; @@ -1795,12 +1734,11 @@ Tk_PostscriptPhoto( for (xx = 0; xx < width; xx ++) { alpha = *(alphaPtr + (yy * alphaPitch) + (xx * alphaIncr) + alphaOffset); - sprintf(buffer, "%02X", alpha | 0x01); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); lineLen += 2; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } @@ -1813,22 +1751,25 @@ Tk_PostscriptPhoto( pixelPtr = blockPtr->pixelPtr + (yy * blockPtr->pitch) + (xx * blockPtr->pixelSize); - sprintf(buffer, "%02X%02X%02X", + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", pixelPtr[blockPtr->offset[0]], pixelPtr[blockPtr->offset[1]], pixelPtr[blockPtr->offset[2]]); - Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen >= 60) { lineLen = 0; - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } } break; } } - Tcl_AppendResult(interp, ">\n", NULL); + /* + * The end-of-data marker. + */ + + Tcl_AppendToObj(psObj, ">\n", -1); return TCL_OK; } diff --git a/generic/tkCanvText.c b/generic/tkCanvText.c index 24c3c7f..eb8dfe3 100644 --- a/generic/tkCanvText.c +++ b/generic/tkCanvText.c @@ -10,7 +10,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <stdio.h> #include "tkInt.h" #include "tkCanvas.h" #include "default.h" @@ -55,6 +54,8 @@ typedef struct TextItem { * means no word-wrap. */ int underline; /* Index of character to put underline beneath * or -1 for no underlining. */ + double angle; /* What angle, in degrees, to draw the text + * at. */ /* * Fields whose values are derived from the current values of the @@ -64,70 +65,69 @@ typedef struct TextItem { int numChars; /* Length of text in characters. */ int numBytes; /* Length of text in bytes. */ Tk_TextLayout textLayout; /* Cached text layout information. */ - int leftEdge; /* Pixel location of the left edge of the text - * item; where the left border of the text - * layout is drawn. */ - int rightEdge; /* Pixel just to right of right edge of area - * of text item. Used for selecting up to end - * of line. */ + int actualWidth; /* Width of text as computed. Used to make + * selections of wrapped text display + * right. */ + double drawOrigin[2]; /* Where we start drawing from. */ GC gc; /* Graphics context for drawing text. */ GC selTextGC; /* Graphics context for selected text. */ GC cursorOffGC; /* If not None, this gives a graphics context * to use to draw the insertion cursor when * it's off. Used if the selection and * insertion cursor colors are the same. */ + double sine; /* Sine of angle field. */ + double cosine; /* Cosine of angle field. */ } TextItem; /* * Information used for parsing configuration specs: */ -static Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, (ClientData) 2 +static const Tk_CustomOption stateOption = { + TkStateParseProc, TkStatePrintProc, INT2PTR(2) }; -static Tk_CustomOption tagsOption = { - (Tk_OptionParseProc *) Tk_CanvasTagsParseProc, - Tk_CanvasTagsPrintProc, (ClientData) NULL +static const Tk_CustomOption tagsOption = { + Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL }; -static Tk_CustomOption offsetOption = { - (Tk_OptionParseProc *) TkOffsetParseProc, - TkOffsetPrintProc, (ClientData) (TK_OFFSET_RELATIVE) +static const Tk_CustomOption offsetOption = { + TkOffsetParseProc, TkOffsetPrintProc, INT2PTR(TK_OFFSET_RELATIVE) }; -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_COLOR, "-activefill", NULL, NULL, - NULL, Tk_Offset(TextItem, activeColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(TextItem, activeColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL, - NULL, Tk_Offset(TextItem, activeStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(TextItem, activeStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_ANCHOR, "-anchor", NULL, NULL, - "center", Tk_Offset(TextItem, anchor), TK_CONFIG_DONT_SET_DEFAULT}, + "center", Tk_Offset(TextItem, anchor), TK_CONFIG_DONT_SET_DEFAULT, NULL}, + {TK_CONFIG_DOUBLE, "-angle", NULL, NULL, + "0.0", Tk_Offset(TextItem, angle), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL, - NULL, Tk_Offset(TextItem, disabledColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(TextItem, disabledColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL, - NULL, Tk_Offset(TextItem, disabledStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(TextItem, disabledStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-fill", NULL, NULL, - "black", Tk_Offset(TextItem, color), TK_CONFIG_NULL_OK}, + "black", Tk_Offset(TextItem, color), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_FONT, "-font", NULL, NULL, - DEF_CANVTEXT_FONT, Tk_Offset(TextItem, tkfont), 0}, + DEF_CANVTEXT_FONT, Tk_Offset(TextItem, tkfont), 0, NULL}, {TK_CONFIG_JUSTIFY, "-justify", NULL, NULL, - "left", Tk_Offset(TextItem, justify), TK_CONFIG_DONT_SET_DEFAULT}, + "left", Tk_Offset(TextItem, justify), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-offset", NULL, NULL, "0,0", Tk_Offset(TextItem, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_CUSTOM, "-state", NULL, NULL, NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption}, {TK_CONFIG_BITMAP, "-stipple", NULL, NULL, - NULL, Tk_Offset(TextItem, stipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(TextItem, stipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-tags", NULL, NULL, NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, {TK_CONFIG_STRING, "-text", NULL, NULL, - "", Tk_Offset(TextItem, text), 0}, + "", Tk_Offset(TextItem, text), 0, NULL}, {TK_CONFIG_INT, "-underline", NULL, NULL, - "-1", Tk_Offset(TextItem, underline), 0}, + "-1", Tk_Offset(TextItem, underline), 0, NULL}, {TK_CONFIG_PIXELS, "-width", NULL, NULL, - "0", Tk_Offset(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + "0", Tk_Offset(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT, NULL}, + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -137,10 +137,10 @@ static Tk_ConfigSpec configSpecs[] = { static void ComputeTextBbox(Tk_Canvas canvas, TextItem *textPtr); static int ConfigureText(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int argc, - Tcl_Obj *CONST objv[], int flags); + Tcl_Obj *const objv[], int flags); static int CreateText(Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST objv[]); + int argc, Tcl_Obj *const objv[]); static void DeleteText(Tk_Canvas canvas, Tk_Item *itemPtr, Display *display); static void DisplayCanvText(Tk_Canvas canvas, @@ -159,11 +159,11 @@ static void SetTextCursor(Tk_Canvas canvas, Tk_Item *itemPtr, int index); static int TextCoords(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, - int argc, Tcl_Obj *CONST objv[]); + int argc, Tcl_Obj *const objv[]); static void TextDeleteChars(Tk_Canvas canvas, Tk_Item *itemPtr, int first, int last); static void TextInsert(Tk_Canvas canvas, - Tk_Item *itemPtr, int beforeThis, char *string); + Tk_Item *itemPtr, int beforeThis, Tcl_Obj *obj); static int TextToArea(Tk_Canvas canvas, Tk_Item *itemPtr, double *rectPtr); static double TextToPoint(Tk_Canvas canvas, @@ -193,13 +193,16 @@ Tk_ItemType tkTextType = { TextToPostscript, /* postscriptProc */ ScaleText, /* scaleProc */ TranslateText, /* translateProc */ - (Tk_ItemIndexProc *) GetTextIndex,/* indexProc */ + GetTextIndex, /* indexProc */ SetTextCursor, /* icursorProc */ GetSelText, /* selectionProc */ TextInsert, /* insertProc */ TextDeleteChars, /* dTextProc */ NULL, /* nextPtr */ + NULL, 0, NULL, NULL }; + +#define ROUND(d) ((int) floor((d) + 0.5)) /* *-------------------------------------------------------------- @@ -226,13 +229,13 @@ CreateText( Tk_Item *itemPtr, /* Record to hold new item; header has been * initialized by caller. */ int objc, /* Number of arguments in objv. */ - Tcl_Obj *CONST objv[]) /* Arguments describing rectangle. */ + Tcl_Obj *const objv[]) /* Arguments describing rectangle. */ { TextItem *textPtr = (TextItem *) itemPtr; int i; if (objc == 0) { - Tcl_Panic("canvas did not pass any coords\n"); + Tcl_Panic("canvas did not pass any coords"); } /* @@ -259,15 +262,18 @@ CreateText( textPtr->text = NULL; textPtr->width = 0; textPtr->underline = -1; + textPtr->angle = 0.0; textPtr->numChars = 0; textPtr->numBytes = 0; textPtr->textLayout = NULL; - textPtr->leftEdge = 0; - textPtr->rightEdge = 0; + textPtr->actualWidth = 0; + textPtr->drawOrigin[0] = textPtr->drawOrigin[1] = 0.0; textPtr->gc = None; textPtr->selTextGC = None; textPtr->cursorOffGC = None; + textPtr->sine = 0.0; + textPtr->cosine = 1.0; /* * Process the arguments to fill in the item record. Only 1 (list) or 2 (x @@ -277,7 +283,7 @@ CreateText( if (objc == 1) { i = 1; } else { - char *arg = Tcl_GetString(objv[1]); + const char *arg = Tcl_GetString(objv[1]); i = 2; if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { @@ -320,45 +326,44 @@ TextCoords( Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ - Tcl_Obj *CONST objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ + Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { TextItem *textPtr = (TextItem *) itemPtr; if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(textPtr->x); + Tcl_ListObjAppendElement(interp, obj, subobj); subobj = Tcl_NewDoubleObj(textPtr->y); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); - } else if (objc < 3) { - if (objc==1) { - if (Tcl_ListObjGetElements(interp, objv[0], &objc, - (Tcl_Obj ***) &objv) != TCL_OK) { - return TCL_ERROR; - } else if (objc != 2) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_ERROR; - } - } - if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], - &textPtr->x) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], - &textPtr->y) != TCL_OK)) { + return TCL_OK; + } else if (objc > 2) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL); + return TCL_ERROR; + } + + if (objc == 1) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, + (Tcl_Obj ***) &objv) != TCL_OK) { + return TCL_ERROR; + } else if (objc != 2) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL); return TCL_ERROR; } - ComputeTextBbox(canvas, textPtr); - } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + } + if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], + &textPtr->x) != TCL_OK) + || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], + &textPtr->y) != TCL_OK)) { return TCL_ERROR; } + ComputeTextBbox(canvas, textPtr); return TCL_OK; } @@ -387,7 +392,7 @@ ConfigureText( Tk_Canvas canvas, /* Canvas containing itemPtr. */ Tk_Item *itemPtr, /* Rectangle item to reconfigure. */ int objc, /* Number of elements in objv. */ - Tcl_Obj *CONST objv[], /* Arguments describing things to configure. */ + Tcl_Obj *const objv[], /* Arguments describing things to configure. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { TextItem *textPtr = (TextItem *) itemPtr; @@ -403,7 +408,7 @@ ConfigureText( tkwin = Tk_CanvasTkwin(canvas); if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, - (CONST char **) objv, (char *) textPtr, flags|TK_CONFIG_OBJS)) { + (const char **) objv, (char *) textPtr, flags|TK_CONFIG_OBJS)) { return TCL_ERROR; } @@ -420,24 +425,24 @@ ConfigureText( itemPtr->redraw_flags &= ~TK_ITEM_STATE_DEPENDANT; } - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } color = textPtr->color; stipple = textPtr->stipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (textPtr->activeColor!=NULL) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (textPtr->activeColor != NULL) { color = textPtr->activeColor; } - if (textPtr->activeStipple!=None) { + if (textPtr->activeStipple != None) { stipple = textPtr->activeStipple; } - } else if (state==TK_STATE_DISABLED) { - if (textPtr->disabledColor!=NULL) { + } else if (state == TK_STATE_DISABLED) { + if (textPtr->disabledColor != NULL) { color = textPtr->disabledColor; } - if (textPtr->disabledStipple!=None) { + if (textPtr->disabledStipple != None) { stipple = textPtr->disabledStipple; } } @@ -493,7 +498,6 @@ ConfigureText( } textPtr->cursorOffGC = newGC; - /* * If the text was changed, move the selection and insertion indices to * keep them inside the item. @@ -519,6 +523,22 @@ ConfigureText( textPtr->insertPos = textPtr->numChars; } + /* + * Restrict so that 0.0 <= angle < 360.0, and then recompute the cached + * sine and cosine of the angle. Note that fmod() can produce negative + * results, and we try to avoid negative zero as well. + */ + + textPtr->angle = fmod(textPtr->angle, 360.0); + if (textPtr->angle < 0.0) { + textPtr->angle += 360.0; + } + if (textPtr->angle == 0.0) { + textPtr->angle = 0.0; + } + textPtr->sine = sin(textPtr->angle * PI/180.0); + textPtr->cosine = cos(textPtr->angle * PI/180.0); + ComputeTextBbox(canvas, textPtr); return TCL_OK; } @@ -609,11 +629,12 @@ ComputeTextBbox( TextItem *textPtr) /* Item whose bbox is to be recomputed. */ { Tk_CanvasTextInfo *textInfoPtr; - int leftX, topY, width, height, fudge; + int leftX, topY, width, height, fudge, i; Tk_State state = textPtr->header.state; + double x[4], y[4], dx[4], dy[4], sinA, cosA, tmp; - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } Tk_FreeTextLayout(textPtr->textLayout); @@ -630,8 +651,11 @@ ComputeTextBbox( * bounding box for the text item. */ - leftX = (int) floor(textPtr->x + 0.5); - topY = (int) floor(textPtr->y + 0.5); + leftX = ROUND(textPtr->x); + topY = ROUND(textPtr->y); + for (i=0 ; i<4 ; i++) { + dx[i] = dy[i] = 0.0; + } switch (textPtr->anchor) { case TK_ANCHOR_NW: case TK_ANCHOR_N: @@ -642,12 +666,18 @@ ComputeTextBbox( case TK_ANCHOR_CENTER: case TK_ANCHOR_E: topY -= height / 2; + for (i=0 ; i<4 ; i++) { + dy[i] = -height / 2; + } break; case TK_ANCHOR_SW: case TK_ANCHOR_S: case TK_ANCHOR_SE: topY -= height; + for (i=0 ; i<4 ; i++) { + dy[i] = -height; + } break; } switch (textPtr->anchor) { @@ -660,17 +690,27 @@ ComputeTextBbox( case TK_ANCHOR_CENTER: case TK_ANCHOR_S: leftX -= width / 2; + for (i=0 ; i<4 ; i++) { + dx[i] = -width / 2; + } break; case TK_ANCHOR_NE: case TK_ANCHOR_E: case TK_ANCHOR_SE: leftX -= width; + for (i=0 ; i<4 ; i++) { + dx[i] = -width; + } break; } - textPtr->leftEdge = leftX; - textPtr->rightEdge = leftX + width; + textPtr->actualWidth = width; + + sinA = textPtr->sine; + cosA = textPtr->cosine; + textPtr->drawOrigin[0] = textPtr->x + dx[0]*cosA + dy[0]*sinA; + textPtr->drawOrigin[1] = textPtr->y + dy[0]*cosA - dx[0]*sinA; /* * Last of all, update the bounding box for the item. The item's bounding @@ -683,10 +723,50 @@ ComputeTextBbox( if (textInfoPtr->selBorderWidth > fudge) { fudge = textInfoPtr->selBorderWidth; } - textPtr->header.x1 = leftX - fudge; - textPtr->header.y1 = topY; - textPtr->header.x2 = leftX + width + fudge; - textPtr->header.y2 = topY + height; + + /* + * Apply the rotation before computing the bounding box. + */ + + dx[0] -= fudge; + dx[1] += width + fudge; + dx[2] += width + fudge; + dy[2] += height; + dx[3] -= fudge; + dy[3] += height; + for (i=0 ; i<4 ; i++) { + x[i] = textPtr->x + dx[i] * cosA + dy[i] * sinA; + y[i] = textPtr->y + dy[i] * cosA - dx[i] * sinA; + } + + /* + * Convert to a rectilinear bounding box. + */ + + for (i=1,tmp=x[0] ; i<4 ; i++) { + if (x[i] < tmp) { + tmp = x[i]; + } + } + textPtr->header.x1 = ROUND(tmp); + for (i=1,tmp=y[0] ; i<4 ; i++) { + if (y[i] < tmp) { + tmp = y[i]; + } + } + textPtr->header.y1 = ROUND(tmp); + for (i=1,tmp=x[0] ; i<4 ; i++) { + if (x[i] > tmp) { + tmp = x[i]; + } + } + textPtr->header.x2 = ROUND(tmp); + for (i=1,tmp=y[0] ; i<4 ; i++) { + if (y[i] > tmp) { + tmp = y[i]; + } + } + textPtr->header.y2 = ROUND(tmp); } /* @@ -726,16 +806,16 @@ DisplayCanvText( textPtr = (TextItem *) itemPtr; textInfoPtr = textPtr->textInfoPtr; - if(state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + if (state == TK_STATE_NULL) { + state = Canvas(canvas)->canvas_state; } stipple = textPtr->stipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (textPtr->activeStipple!=None) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (textPtr->activeStipple != None) { stipple = textPtr->activeStipple; } - } else if (state==TK_STATE_DISABLED) { - if (textPtr->disabledStipple!=None) { + } else if (state == TK_STATE_DISABLED) { + if (textPtr->disabledStipple != None) { stipple = textPtr->disabledStipple; } } @@ -756,6 +836,8 @@ DisplayCanvText( selFirstChar = -1; selLastChar = 0; /* lint. */ + Tk_CanvasDrawableCoords(canvas, textPtr->drawOrigin[0], + textPtr->drawOrigin[1], &drawableX, &drawableY); if (textInfoPtr->selItemPtr == itemPtr) { selFirstChar = textInfoPtr->selectFirst; @@ -786,20 +868,30 @@ DisplayCanvText( x = xFirst; height = hFirst; for (y = yFirst ; y <= yLast; y += height) { + int dx1, dy1, dx2, dy2; + double s = textPtr->sine, c = textPtr->cosine; + XPoint points[4]; + if (y == yLast) { width = xLast + wLast - x; } else { - width = textPtr->rightEdge - textPtr->leftEdge - x; + width = textPtr->actualWidth - x; } - Tk_CanvasDrawableCoords(canvas, - (double) (textPtr->leftEdge + x - - textInfoPtr->selBorderWidth), - (double) (textPtr->header.y1 + y), - &drawableX, &drawableY); - Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable, - textInfoPtr->selBorder, drawableX, drawableY, - width + 2 * textInfoPtr->selBorderWidth, - height, textInfoPtr->selBorderWidth, TK_RELIEF_RAISED); + dx1 = x - textInfoPtr->selBorderWidth; + dy1 = y; + dx2 = width + 2 * textInfoPtr->selBorderWidth; + dy2 = height; + points[0].x = (short)(drawableX + dx1*c + dy1*s); + points[0].y = (short)(drawableY + dy1*c - dx1*s); + points[1].x = (short)(drawableX + (dx1+dx2)*c + dy1*s); + points[1].y = (short)(drawableY + dy1*c - (dx1+dx2)*s); + points[2].x = (short)(drawableX + (dx1+dx2)*c + (dy1+dy2)*s); + points[2].y = (short)(drawableY + (dy1+dy2)*c - (dx1+dx2)*s); + points[3].x = (short)(drawableX + dx1*c + (dy1+dy2)*s); + points[3].y = (short)(drawableY + (dy1+dy2)*c - dx1*s); + Tk_Fill3DPolygon(Tk_CanvasTkwin(canvas), drawable, + textInfoPtr->selBorder, points, 4, + textInfoPtr->selBorderWidth, TK_RELIEF_RAISED); x = 0; } } @@ -817,18 +909,28 @@ DisplayCanvText( if ((textInfoPtr->focusItemPtr == itemPtr) && (textInfoPtr->gotFocus)) { if (Tk_CharBbox(textPtr->textLayout, textPtr->insertPos, &x, &y, NULL, &height)) { - Tk_CanvasDrawableCoords(canvas, - (double) (textPtr->leftEdge + x - - (textInfoPtr->insertWidth / 2)), - (double) (textPtr->header.y1 + y), - &drawableX, &drawableY); - Tk_SetCaretPos(Tk_CanvasTkwin(canvas), drawableX, drawableY, + int dx1, dy1, dx2, dy2; + double s = textPtr->sine, c = textPtr->cosine; + XPoint points[4]; + + dx1 = x - (textInfoPtr->insertWidth / 2); + dy1 = y; + dx2 = textInfoPtr->insertWidth; + dy2 = height; + points[0].x = (short)(drawableX + dx1*c + dy1*s); + points[0].y = (short)(drawableY + dy1*c - dx1*s); + points[1].x = (short)(drawableX + (dx1+dx2)*c + dy1*s); + points[1].y = (short)(drawableY + dy1*c - (dx1+dx2)*s); + points[2].x = (short)(drawableX + (dx1+dx2)*c + (dy1+dy2)*s); + points[2].y = (short)(drawableY + (dy1+dy2)*c - (dx1+dx2)*s); + points[3].x = (short)(drawableX + dx1*c + (dy1+dy2)*s); + points[3].y = (short)(drawableY + (dy1+dy2)*c - dx1*s); + + Tk_SetCaretPos(Tk_CanvasTkwin(canvas), points[0].x, points[0].y, height); if (textInfoPtr->cursorOn) { - Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable, - textInfoPtr->insertBorder, - drawableX, drawableY, - textInfoPtr->insertWidth, height, + Tk_Fill3DPolygon(Tk_CanvasTkwin(canvas), drawable, + textInfoPtr->insertBorder, points, 4, textInfoPtr->insertBorderWidth, TK_RELIEF_RAISED); } else if (textPtr->cursorOffGC != None) { /* @@ -838,10 +940,8 @@ DisplayCanvText( * where both may be drawn in the same color. */ - XFillRectangle(display, drawable, textPtr->cursorOffGC, - drawableX, drawableY, - (unsigned) textInfoPtr->insertWidth, - (unsigned) height); + XFillPolygon(display, drawable, textPtr->cursorOffGC, + points, 4, Convex, CoordModeOrigin); } } } @@ -856,23 +956,24 @@ DisplayCanvText( * anti-aliasing colors would blend together. */ - Tk_CanvasDrawableCoords(canvas, (double) textPtr->leftEdge, - (double) textPtr->header.y1, &drawableX, &drawableY); - if ((selFirstChar >= 0) && (textPtr->selTextGC != textPtr->gc)) { - Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout, - drawableX, drawableY, 0, selFirstChar); - Tk_DrawTextLayout(display, drawable, textPtr->selTextGC, - textPtr->textLayout, drawableX, drawableY, selFirstChar, - selLastChar + 1); - Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout, - drawableX, drawableY, selLastChar + 1, -1); + TkDrawAngledTextLayout(display, drawable, textPtr->gc, + textPtr->textLayout, drawableX, drawableY, textPtr->angle, + 0, selFirstChar); + TkDrawAngledTextLayout(display, drawable, textPtr->selTextGC, + textPtr->textLayout, drawableX, drawableY, textPtr->angle, + selFirstChar, selLastChar + 1); + TkDrawAngledTextLayout(display, drawable, textPtr->gc, + textPtr->textLayout, drawableX, drawableY, textPtr->angle, + selLastChar + 1, -1); } else { - Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout, - drawableX, drawableY, 0, -1); + TkDrawAngledTextLayout(display, drawable, textPtr->gc, + textPtr->textLayout, drawableX, drawableY, textPtr->angle, + 0, -1); } - Tk_UnderlineTextLayout(display, drawable, textPtr->gc, textPtr->textLayout, - drawableX, drawableY, textPtr->underline); + TkUnderlineAngledTextLayout(display, drawable, textPtr->gc, + textPtr->textLayout, drawableX, drawableY, textPtr->angle, + textPtr->underline); if (stipple != None) { XSetTSOrigin(display, textPtr->gc, 0, 0); @@ -880,7 +981,7 @@ DisplayCanvText( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * TextInsert -- * @@ -893,7 +994,7 @@ DisplayCanvText( * The text in the given item is modified. The cursor and selection * positions are also modified to reflect the insertion. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void @@ -902,14 +1003,15 @@ TextInsert( Tk_Item *itemPtr, /* Text item to be modified. */ int index, /* Character index before which string is to * be inserted. */ - char *string) /* New characters to be inserted. */ + Tcl_Obj *obj) /* New characters to be inserted. */ { TextItem *textPtr = (TextItem *) itemPtr; int byteIndex, byteCount, charsAdded; char *newStr, *text; + const char *string; Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; - string = Tcl_GetStringFromObj((Tcl_Obj *) string, &byteCount); + string = Tcl_GetStringFromObj(obj, &byteCount); text = textPtr->text; @@ -925,7 +1027,7 @@ TextInsert( return; } - newStr = (char *) ckalloc((unsigned) textPtr->numBytes + byteCount + 1); + newStr = ckalloc(textPtr->numBytes + byteCount + 1); memcpy(newStr, text, (size_t) byteIndex); strcpy(newStr + byteIndex, string); strcpy(newStr + byteIndex + byteCount, text + byteIndex); @@ -1006,7 +1108,7 @@ TextDeleteChars( byteCount = Tcl_UtfAtIndex(text + byteIndex, charsRemoved) - (text + byteIndex); - newStr = (char *) ckalloc((unsigned) (textPtr->numBytes + 1 - byteCount)); + newStr = ckalloc(textPtr->numBytes + 1 - byteCount); memcpy(newStr, text, (size_t) byteIndex); strcpy(newStr + byteIndex, text + byteIndex + byteCount); @@ -1082,15 +1184,17 @@ TextToPoint( { TextItem *textPtr; Tk_State state = itemPtr->state; - double value; + double value, px, py; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } textPtr = (TextItem *) itemPtr; + px = pointPtr[0] - textPtr->drawOrigin[0]; + py = pointPtr[1] - textPtr->drawOrigin[1]; value = (double) Tk_DistanceToTextLayout(textPtr->textLayout, - (int) pointPtr[0] - textPtr->leftEdge, - (int) pointPtr[1] - textPtr->header.y1); + (int) (px*textPtr->cosine - py*textPtr->sine), + (int) (py*textPtr->cosine + px*textPtr->sine)); if ((state == TK_STATE_HIDDEN) || (textPtr->color == NULL) || (textPtr->text == NULL) || (*textPtr->text == 0)) { @@ -1130,15 +1234,16 @@ TextToArea( Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } textPtr = (TextItem *) itemPtr; - return Tk_IntersectTextLayout(textPtr->textLayout, - (int) (rectPtr[0] + 0.5) - textPtr->leftEdge, - (int) (rectPtr[1] + 0.5) - textPtr->header.y1, + return TkIntersectAngledTextLayout(textPtr->textLayout, + (int) ((rectPtr[0] + 0.5) - textPtr->drawOrigin[0]), + (int) ((rectPtr[1] + 0.5) - textPtr->drawOrigin[1]), (int) (rectPtr[2] - rectPtr[0] + 0.5), - (int) (rectPtr[3] - rectPtr[1] + 0.5)); + (int) (rectPtr[3] - rectPtr[1] + 0.5), + textPtr->angle); } /* @@ -1242,7 +1347,7 @@ GetTextIndex( int c; TkCanvas *canvasPtr = (TkCanvas *) canvas; Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; - char *string = Tcl_GetStringFromObj(obj, &length); + const char *string = Tcl_GetStringFromObj(obj, &length); c = string[0]; @@ -1254,21 +1359,26 @@ GetTextIndex( } else if ((c == 's') && (length >= 5) && (strncmp(string, "sel.first", (unsigned) length) == 0)) { if (textInfoPtr->selItemPtr != itemPtr) { - Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "selection isn't in item", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL); return TCL_ERROR; } *indexPtr = textInfoPtr->selectFirst; } else if ((c == 's') && (length >= 5) && (strncmp(string, "sel.last", (unsigned) length) == 0)) { if (textInfoPtr->selItemPtr != itemPtr) { - Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "selection isn't in item", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "UNSELECTED", NULL); return TCL_ERROR; } *indexPtr = textInfoPtr->selectLast; } else if (c == '@') { int x, y; - double tmp; - char *end, *p; + double tmp, c = textPtr->cosine, s = textPtr->sine; + char *end; + const char *p; p = string+1; tmp = strtod(p, &end); @@ -1282,11 +1392,12 @@ GetTextIndex( goto badIndex; } y = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5); + x += canvasPtr->scrollX1 - (int) textPtr->drawOrigin[0]; + y += canvasPtr->scrollY1 - (int) textPtr->drawOrigin[1]; *indexPtr = Tk_PointToChar(textPtr->textLayout, - x + canvasPtr->scrollX1 - textPtr->leftEdge, - y + canvasPtr->scrollY1 - textPtr->header.y1); + (int) (x*c - y*s), (int) (y*c + x*s)); } else if (Tcl_GetIntFromObj(NULL, obj, indexPtr) == TCL_OK) { - if (*indexPtr < 0){ + if (*indexPtr < 0) { *indexPtr = 0; } else if (*indexPtr > textPtr->numChars) { *indexPtr = textPtr->numChars; @@ -1298,8 +1409,8 @@ GetTextIndex( */ badIndex: - Tcl_SetResult(interp, NULL, TCL_STATIC); - Tcl_AppendResult(interp, "bad index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM_INDEX", "TEXT", NULL); return TCL_ERROR; } return TCL_OK; @@ -1375,7 +1486,7 @@ GetSelText( TextItem *textPtr = (TextItem *) itemPtr; int byteCount; char *text; - CONST char *selStart, *selEnd; + const char *selStart, *selEnd; Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr; if ((textInfoPtr->selectFirst < 0) || @@ -1427,59 +1538,73 @@ TextToPostscript( * being created. */ { TextItem *textPtr = (TextItem *) itemPtr; - int x, y; + double x, y; Tk_FontMetrics fm; - char *justify; - char buffer[500]; + const char *justify; XColor *color; Pixmap stipple; Tk_State state = itemPtr->state; + Tcl_Obj *psObj; + Tcl_InterpState interpState; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } color = textPtr->color; stipple = textPtr->stipple; if (state == TK_STATE_HIDDEN || textPtr->color == NULL || textPtr->text == NULL || *textPtr->text == 0) { return TCL_OK; - } else if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (textPtr->activeColor!=NULL) { + } else if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (textPtr->activeColor != NULL) { color = textPtr->activeColor; } - if (textPtr->activeStipple!=None) { + if (textPtr->activeStipple != None) { stipple = textPtr->activeStipple; } - } else if (state==TK_STATE_DISABLED) { - if (textPtr->disabledColor!=NULL) { + } else if (state == TK_STATE_DISABLED) { + if (textPtr->disabledColor != NULL) { color = textPtr->disabledColor; } - if (textPtr->disabledStipple!=None) { + if (textPtr->disabledStipple != None) { stipple = textPtr->disabledStipple; } } + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* + * Generate postscript. + */ + + Tcl_ResetResult(interp); if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (prepass != 0) { - return TCL_OK; + goto done; } + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (stipple != None) { - Tcl_AppendResult(interp, "/StippleText {\n ", NULL); + Tcl_ResetResult(interp); Tk_CanvasPsStipple(interp, canvas, stipple); - Tcl_AppendResult(interp, "} bind def\n", NULL); + Tcl_AppendPrintfToObj(psObj, "/StippleText {\n %s} bind def\n", + Tcl_GetString(Tcl_GetObjResult(interp))); } - sprintf(buffer, "%.15g %.15g [\n", textPtr->x, - Tk_CanvasPsY(canvas, textPtr->y)); - Tcl_AppendResult(interp, buffer, NULL); - - Tk_TextLayoutToPostscript(interp, textPtr->textLayout); - x = 0; y = 0; justify = NULL; /* lint. */ switch (textPtr->anchor) { case TK_ANCHOR_NW: x = 0; y = 0; break; @@ -1499,17 +1624,31 @@ TextToPostscript( } Tk_GetFontMetrics(textPtr->tkfont, &fm); - sprintf(buffer, "] %d ", fm.linespace); - Tcl_AppendResult(interp, buffer, NULL); - Tcl_PrintDouble(NULL, x / -2.0, buffer); - Tcl_AppendResult(interp, buffer, NULL); - Tcl_PrintDouble(NULL, y / 2.0, buffer); - Tcl_AppendResult(interp, " ", buffer, NULL); - sprintf(buffer, " %s %s DrawText\n", - justify, ((stipple == None) ? "false" : "true")); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g %.15g [\n", + textPtr->angle, textPtr->x, Tk_CanvasPsY(canvas, textPtr->y)); + Tcl_ResetResult(interp); + Tk_TextLayoutToPostscript(interp, textPtr->textLayout); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendPrintfToObj(psObj, + "] %d %g %g %s %s DrawText\n", + fm.linespace, x / -2.0, y / 2.0, justify, + ((stipple == None) ? "false" : "true")); + + /* + * Plug the accumulated postscript back into the result. + */ + + done: + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkCanvUtil.c b/generic/tkCanvUtil.c index b4d0c3b..cbbc2b4 100644 --- a/generic/tkCanvUtil.c +++ b/generic/tkCanvUtil.c @@ -25,13 +25,13 @@ typedef struct SmoothAssocData { * option. */ } SmoothAssocData; -Tk_SmoothMethod tkBezierSmoothMethod = { +const Tk_SmoothMethod tkBezierSmoothMethod = { "true", TkMakeBezierCurve, (void (*) (Tcl_Interp *interp, Tk_Canvas canvas, double *coordPtr, int numPoints, int numSteps)) TkMakeBezierPostscript, }; -static Tk_SmoothMethod tkRawSmoothMethod = { +static const Tk_SmoothMethod tkRawSmoothMethod = { "raw", TkMakeRawCurve, (void (*) (Tcl_Interp *interp, Tk_Canvas canvas, double *coordPtr, @@ -45,13 +45,27 @@ static Tk_SmoothMethod tkRawSmoothMethod = { static void SmoothMethodCleanupProc(ClientData clientData, Tcl_Interp *interp); static SmoothAssocData *InitSmoothMethods(Tcl_Interp *interp); -static int DashConvert(char *l, CONST char *p, int n, +static int DashConvert(char *l, const char *p, int n, double width); static void TranslateAndAppendCoords(TkCanvas *canvPtr, double x, double y, XPoint *outArr, int numOut); +static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp); #define ABS(a) ((a>=0)?(a):(-(a))) +static inline Tcl_Obj * +GetPostscriptBuffer( + Tcl_Interp *interp) +{ + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + return psObj; +} + /* *---------------------------------------------------------------------- * @@ -73,8 +87,7 @@ Tk_Window Tk_CanvasTkwin( Tk_Canvas canvas) /* Token for the canvas. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; - return canvasPtr->tkwin; + return Canvas(canvas)->tkwin; } /* @@ -106,10 +119,9 @@ Tk_CanvasDrawableCoords( short *drawableXPtr, /* Screen coordinates are stored here. */ short *drawableYPtr) { - TkCanvas *canvasPtr = (TkCanvas *) canvas; double tmp; - tmp = x - canvasPtr->drawableXOrigin; + tmp = x - Canvas(canvas)->drawableXOrigin; if (tmp > 0) { tmp += 0.5; } else { @@ -123,7 +135,7 @@ Tk_CanvasDrawableCoords( *drawableXPtr = (short) tmp; } - tmp = y - canvasPtr->drawableYOrigin; + tmp = y - Canvas(canvas)->drawableYOrigin; if (tmp > 0) { tmp += 0.5; } else { @@ -166,10 +178,9 @@ Tk_CanvasWindowCoords( short *screenXPtr, /* Screen coordinates are stored here. */ short *screenYPtr) { - TkCanvas *canvasPtr = (TkCanvas *) canvas; double tmp; - tmp = x - canvasPtr->xOrigin; + tmp = x - Canvas(canvas)->xOrigin; if (tmp > 0) { tmp += 0.5; } else { @@ -183,7 +194,7 @@ Tk_CanvasWindowCoords( *screenXPtr = (short) tmp; } - tmp = y - canvasPtr->yOrigin; + tmp = y - Canvas(canvas)->yOrigin; if (tmp > 0) { tmp += 0.5; } else { @@ -222,17 +233,15 @@ int Tk_CanvasGetCoord( Tcl_Interp *interp, /* Interpreter for error reporting. */ Tk_Canvas canvas, /* Canvas to which coordinate applies. */ - CONST char *string, /* Describes coordinate (any screen coordinate + const char *string, /* Describes coordinate (any screen coordinate * form may be used here). */ double *doublePtr) /* Place to store converted coordinate. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; - - if (Tk_GetScreenMM(canvasPtr->interp, canvasPtr->tkwin, string, + if (Tk_GetScreenMM(Canvas(canvas)->interp, Canvas(canvas)->tkwin, string, doublePtr) != TCL_OK) { return TCL_ERROR; } - *doublePtr *= canvasPtr->pixelsPerMM; + *doublePtr *= Canvas(canvas)->pixelsPerMM; return TCL_OK; } @@ -264,9 +273,7 @@ Tk_CanvasGetCoordFromObj( * form may be used here). */ double *doublePtr) /* Place to store converted coordinate. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; - - return Tk_GetDoublePixelsFromObj(canvasPtr->interp, canvasPtr->tkwin, obj, doublePtr); + return Tk_GetDoublePixelsFromObj(Canvas(canvas)->interp, Canvas(canvas)->tkwin, obj, doublePtr); } /* @@ -294,10 +301,9 @@ Tk_CanvasSetStippleOrigin( * to draw a stippled pattern as part of * redisplaying the canvas. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; - - XSetTSOrigin(canvasPtr->display, gc, -canvasPtr->drawableXOrigin, - -canvasPtr->drawableYOrigin); + XSetTSOrigin(Canvas(canvas)->display, gc, + -Canvas(canvas)->drawableXOrigin, + -Canvas(canvas)->drawableYOrigin); } /* @@ -326,7 +332,7 @@ Tk_CanvasSetOffset( * redisplaying the canvas. */ Tk_TSOffset *offset) /* Offset (may be NULL pointer)*/ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; + register TkCanvas *canvasPtr = Canvas(canvas); int flags = 0; int x = - canvasPtr->drawableXOrigin; int y = - canvasPtr->drawableYOrigin; @@ -370,7 +376,7 @@ Tk_CanvasTextInfo * Tk_CanvasGetTextInfo( Tk_Canvas canvas) /* Token for the canvas widget. */ { - return &((TkCanvas *) canvas)->textInfo; + return &Canvas(canvas)->textInfo; } /* @@ -396,13 +402,13 @@ Tk_CanvasTagsParseProc( ClientData clientData, /* Not used.*/ Tcl_Interp *interp, /* Used for reporting errors. */ Tk_Window tkwin, /* Window containing canvas widget. */ - CONST char *value, /* Value of option (list of tag names). */ + const char *value, /* Value of option (list of tag names). */ char *widgRec, /* Pointer to record for item. */ int offset) /* Offset into item (ignored). */ { register Tk_Item *itemPtr = (Tk_Item *) widgRec; int argc, i; - CONST char **argv; + const char **argv; Tk_Uid *newPtr; /* @@ -418,12 +424,12 @@ Tk_CanvasTagsParseProc( */ if (itemPtr->tagSpace < argc) { - newPtr = (Tk_Uid *) ckalloc((unsigned) (argc * sizeof(Tk_Uid))); + newPtr = ckalloc(argc * sizeof(Tk_Uid)); for (i = itemPtr->numTags-1; i >= 0; i--) { newPtr[i] = itemPtr->tagPtr[i]; } if (itemPtr->tagPtr != itemPtr->staticTagSpace) { - ckfree((char *) itemPtr->tagPtr); + ckfree(itemPtr->tagPtr); } itemPtr->tagPtr = newPtr; itemPtr->tagSpace = argc; @@ -432,7 +438,7 @@ Tk_CanvasTagsParseProc( for (i = 0; i < argc; i++) { itemPtr->tagPtr[i] = Tk_GetUid(argv[i]); } - ckfree((char *) argv); + ckfree(argv); return TCL_OK; } @@ -458,7 +464,7 @@ Tk_CanvasTagsParseProc( *-------------------------------------------------------------- */ -char * +const char * Tk_CanvasTagsPrintProc( ClientData clientData, /* Ignored. */ Tk_Window tkwin, /* Window containing canvas widget. */ @@ -476,10 +482,10 @@ Tk_CanvasTagsPrintProc( } if (itemPtr->numTags == 1) { *freeProcPtr = NULL; - return (char *) itemPtr->tagPtr[0]; + return (const char *) itemPtr->tagPtr[0]; } *freeProcPtr = TCL_DYNAMIC; - return Tcl_Merge(itemPtr->numTags, (CONST char **) itemPtr->tagPtr); + return Tcl_Merge(itemPtr->numTags, (const char **) itemPtr->tagPtr); } /* @@ -505,11 +511,11 @@ TkCanvasDashParseProc( ClientData clientData, /* Not used.*/ Tcl_Interp *interp, /* Used for reporting errors. */ Tk_Window tkwin, /* Window containing canvas widget. */ - CONST char *value, /* Value of option. */ + const char *value, /* Value of option. */ char *widgRec, /* Pointer to record for item. */ int offset) /* Offset into item. */ { - return Tk_GetDash(interp, value, (Tk_Dash *)(widgRec+offset)); + return Tk_GetDash(interp, value, (Tk_Dash *) (widgRec+offset)); } /* @@ -534,7 +540,7 @@ TkCanvasDashParseProc( *-------------------------------------------------------------- */ -char * +const char * TkCanvasDashPrintProc( ClientData clientData, /* Ignored. */ Tk_Window tkwin, /* Window containing canvas widget. */ @@ -545,14 +551,13 @@ TkCanvasDashPrintProc( * for return string. */ { Tk_Dash *dash = (Tk_Dash *) (widgRec+offset); - char *buffer; - char *p; + char *buffer, *p; int i = dash->number; if (i < 0) { i = -i; *freeProcPtr = TCL_DYNAMIC; - buffer = (char *) ckalloc((unsigned int) (i+1)); + buffer = ckalloc(i + 1); p = (i > (int)sizeof(char *)) ? dash->pattern.pt : dash->pattern.array; memcpy(buffer, p, (unsigned int) i); buffer[i] = 0; @@ -561,12 +566,12 @@ TkCanvasDashPrintProc( *freeProcPtr = NULL; return ""; } - buffer = (char *)ckalloc((unsigned int) (4*i)); + buffer = ckalloc(4 * i); *freeProcPtr = TCL_DYNAMIC; p = (i > (int)sizeof(char *)) ? dash->pattern.pt : dash->pattern.array; sprintf(buffer, "%d", *p++ & 0xff); - while(--i) { + while (--i) { sprintf(buffer+strlen(buffer), " %d", *p++ & 0xff); } return buffer; @@ -597,21 +602,18 @@ InitSmoothMethods( { SmoothAssocData *methods, *ptr; - methods = (SmoothAssocData *) ckalloc(sizeof(SmoothAssocData)); + methods = ckalloc(sizeof(SmoothAssocData)); methods->smooth.name = tkRawSmoothMethod.name; methods->smooth.coordProc = tkRawSmoothMethod.coordProc; methods->smooth.postscriptProc = tkRawSmoothMethod.postscriptProc; - methods->nextPtr = (SmoothAssocData *) ckalloc(sizeof(SmoothAssocData)); - - ptr = methods->nextPtr; + ptr = methods->nextPtr = ckalloc(sizeof(SmoothAssocData)); ptr->smooth.name = tkBezierSmoothMethod.name; ptr->smooth.coordProc = tkBezierSmoothMethod.coordProc; ptr->smooth.postscriptProc = tkBezierSmoothMethod.postscriptProc; ptr->nextPtr = NULL; - Tcl_SetAssocData(interp, "smoothMethod", SmoothMethodCleanupProc, - (ClientData) methods); + Tcl_SetAssocData(interp, "smoothMethod", SmoothMethodCleanupProc,methods); return methods; } @@ -636,11 +638,10 @@ InitSmoothMethods( void Tk_CreateSmoothMethod( Tcl_Interp *interp, - Tk_SmoothMethod *smooth) + const Tk_SmoothMethod *smooth) { SmoothAssocData *methods, *typePtr2, *prevPtr, *ptr; - methods = (SmoothAssocData *) Tcl_GetAssocData(interp, "smoothMethod", - NULL); + methods = Tcl_GetAssocData(interp, "smoothMethod", NULL); /* * Initialize if we were not previously initialized. @@ -662,17 +663,16 @@ Tk_CreateSmoothMethod( } else { prevPtr->nextPtr = typePtr2->nextPtr; } - ckfree((char *) typePtr2); + ckfree(typePtr2); break; } } - ptr = (SmoothAssocData *) ckalloc(sizeof(SmoothAssocData)); + ptr = ckalloc(sizeof(SmoothAssocData)); ptr->smooth.name = smooth->name; ptr->smooth.coordProc = smooth->coordProc; ptr->smooth.postscriptProc = smooth->postscriptProc; ptr->nextPtr = methods; - Tcl_SetAssocData(interp, "smoothMethod", SmoothMethodCleanupProc, - (ClientData) ptr); + Tcl_SetAssocData(interp, "smoothMethod", SmoothMethodCleanupProc, ptr); } /* @@ -698,11 +698,12 @@ SmoothMethodCleanupProc( * interpreter. */ Tcl_Interp *interp) /* Interpreter that is being deleted. */ { - SmoothAssocData *ptr, *methods = (SmoothAssocData *) clientData; + SmoothAssocData *ptr, *methods = clientData; while (methods != NULL) { - methods = (ptr = methods)->nextPtr; - ckfree((char *) ptr); + ptr = methods; + methods = methods->nextPtr; + ckfree(ptr); } } /* @@ -725,16 +726,16 @@ SmoothMethodCleanupProc( int TkSmoothParseProc( - ClientData clientData, /* some flags.*/ + ClientData clientData, /* Ignored. */ Tcl_Interp *interp, /* Used for reporting errors. */ Tk_Window tkwin, /* Window containing canvas widget. */ - CONST char *value, /* Value of option. */ + const char *value, /* Value of option. */ char *widgRec, /* Pointer to record for item. */ int offset) /* Offset into item. */ { - register Tk_SmoothMethod **smoothPtr = - (Tk_SmoothMethod **) (widgRec + offset); - Tk_SmoothMethod *smooth = NULL; + register const Tk_SmoothMethod **smoothPtr = + (const Tk_SmoothMethod **) (widgRec + offset); + const Tk_SmoothMethod *smooth = NULL; int b; size_t length; SmoothAssocData *methods; @@ -744,8 +745,7 @@ TkSmoothParseProc( return TCL_OK; } length = strlen(value); - methods = (SmoothAssocData *) Tcl_GetAssocData(interp, "smoothMethod", - NULL); + methods = Tcl_GetAssocData(interp, "smoothMethod", NULL); /* * Not initialized yet; fix that now. @@ -770,8 +770,10 @@ TkSmoothParseProc( while (methods != NULL) { if (strncmp(value, methods->smooth.name, length) == 0) { if (smooth != NULL) { - Tcl_AppendResult(interp, "ambiguous smooth method \"", value, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous smooth method \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "SMOOTH", value, + NULL); return TCL_ERROR; } smooth = &methods->smooth; @@ -814,7 +816,7 @@ TkSmoothParseProc( *-------------------------------------------------------------- */ -char * +const char * TkSmoothPrintProc( ClientData clientData, /* Ignored. */ Tk_Window tkwin, /* Window containing canvas widget. */ @@ -824,10 +826,10 @@ TkSmoothPrintProc( * information about how to reclaim storage * for return string. */ { - register Tk_SmoothMethod **smoothPtr = - (Tk_SmoothMethod **) (widgRec + offset); + register const Tk_SmoothMethod *smoothPtr = + * (Tk_SmoothMethod **) (widgRec + offset); - return (*smoothPtr) ? (*smoothPtr)->name : "0"; + return smoothPtr ? smoothPtr->name : "0"; } /* *-------------------------------------------------------------- @@ -850,15 +852,15 @@ TkSmoothPrintProc( int Tk_GetDash( Tcl_Interp *interp, /* Used for error reporting. */ - CONST char *value, /* Textual specification of dash list. */ + const char *value, /* Textual specification of dash list. */ Tk_Dash *dash) /* Pointer to record in which to store dash * information. */ { int argc, i; - CONST char **largv, **argv = NULL; + const char **largv, **argv = NULL; char *pt; - if ((value==NULL) || (*value==0) ) { + if ((value == NULL) || (*value == '\0')) { dash->number = 0; return TCL_OK; } @@ -870,17 +872,16 @@ Tk_GetDash( switch (*value) { case '.': case ',': case '-': case '_': i = DashConvert(NULL, value, -1, 0.0); - if (i>0) { - i = strlen(value); - } else { + if (i <= 0) { goto badDashList; } - if (i > (int)sizeof(char *)) { - dash->pattern.pt = pt = (char *) ckalloc(strlen(value)); + i = strlen(value); + if (i > (int) sizeof(char *)) { + dash->pattern.pt = pt = ckalloc(strlen(value)); } else { pt = dash->pattern.array; } - memcpy(pt,value, (unsigned int) i); + memcpy(pt, value, (unsigned) i); dash->number = -i; return TCL_OK; } @@ -890,23 +891,23 @@ Tk_GetDash( goto badDashList; } - if ((unsigned int)ABS(dash->number) > sizeof(char *)) { - ckfree((char *) dash->pattern.pt); + if ((unsigned) ABS(dash->number) > sizeof(char *)) { + ckfree(dash->pattern.pt); } - if (argc > (int)sizeof(char *)) { - dash->pattern.pt = pt = (char *) ckalloc((unsigned int) argc); + if (argc > (int) sizeof(char *)) { + dash->pattern.pt = pt = ckalloc(argc); } else { pt = dash->pattern.array; } dash->number = argc; largv = argv; - while (argc>0) { + while (argc > 0) { if (Tcl_GetInt(interp, *largv, &i) != TCL_OK || i < 1 || i>255) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "expected integer in the range 1..255 but got \"", - *largv, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer in the range 1..255 but got \"%s\"", + *largv)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DASH", NULL); goto syntaxError; } *pt++ = i; @@ -915,7 +916,7 @@ Tk_GetDash( } if (argv != NULL) { - ckfree((char *) argv); + ckfree(argv); } return TCL_OK; @@ -924,15 +925,16 @@ Tk_GetDash( */ badDashList: - Tcl_AppendResult(interp, "bad dash list \"", value, - "\": must be a list of integers or a format like \"-..\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad dash list \"%s\": must be a list of integers or a format like \"-..\"", + value)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DASH", NULL); syntaxError: if (argv != NULL) { - ckfree((char *) argv); + ckfree(argv); } - if ((unsigned int)ABS(dash->number) > sizeof(char *)) { - ckfree((char *) dash->pattern.pt); + if ((unsigned) ABS(dash->number) > sizeof(char *)) { + ckfree(dash->pattern.pt); } dash->number = 0; return TCL_ERROR; @@ -1003,14 +1005,14 @@ Tk_DeleteOutline( if (outline->gc != None) { Tk_FreeGC(display, outline->gc); } - if ((unsigned int)ABS(outline->dash.number) > sizeof(char *)) { - ckfree((char *) outline->dash.pattern.pt); + if ((unsigned) ABS(outline->dash.number) > sizeof(char *)) { + ckfree(outline->dash.pattern.pt); } - if ((unsigned int)ABS(outline->activeDash.number) > sizeof(char *)) { - ckfree((char *) outline->activeDash.pattern.pt); + if ((unsigned) ABS(outline->activeDash.number) > sizeof(char *)) { + ckfree(outline->activeDash.pattern.pt); } - if ((unsigned int)ABS(outline->disabledDash.number) > sizeof(char *)) { - ckfree((char *) outline->disabledDash.pattern.pt); + if ((unsigned) ABS(outline->disabledDash.number) > sizeof(char *)) { + ckfree(outline->disabledDash.pattern.pt); } if (outline->color != NULL) { Tk_FreeColor(outline->color); @@ -1087,9 +1089,9 @@ Tk_ConfigOutlineGC( color = outline->color; stipple = outline->stipple; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } - if (((TkCanvas *)canvas)->currentItemPtr == item) { + if (Canvas(canvas)->currentItemPtr == item) { if (outline->activeWidth>width) { width = outline->activeWidth; } @@ -1168,7 +1170,7 @@ Tk_ChangeOutlineGC( Tk_Item *item, Tk_Outline *outline) { - CONST char *p; + const char *p; double width; Tk_Dash *dash; XColor *color; @@ -1183,9 +1185,9 @@ Tk_ChangeOutlineGC( color = outline->color; stipple = outline->stipple; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } - if (((TkCanvas *)canvas)->currentItemPtr == item) { + if (Canvas(canvas)->currentItemPtr == item) { if (outline->activeWidth > width) { width = outline->activeWidth; } @@ -1222,25 +1224,25 @@ Tk_ChangeOutlineGC( int i = -dash->number; p = (i > (int)sizeof(char *)) ? dash->pattern.pt : dash->pattern.array; - q = (char *) ckalloc(2*(unsigned int)i); + q = ckalloc(2 * i); i = DashConvert(q, p, i, width); - XSetDashes(((TkCanvas *)canvas)->display, outline->gc, - outline->offset, q, i); + XSetDashes(Canvas(canvas)->display, outline->gc, outline->offset, q,i); ckfree(q); } else if (dash->number>2 || (dash->number==2 && (dash->pattern.array[0]!=dash->pattern.array[1]))) { - p = (dash->number > (int)sizeof(char *)) + p = (dash->number > (int) sizeof(char *)) ? dash->pattern.pt : dash->pattern.array; - XSetDashes(((TkCanvas *)canvas)->display, outline->gc, - outline->offset, p, dash->number); + XSetDashes(Canvas(canvas)->display, outline->gc, outline->offset, p, + dash->number); } if (stipple!=None) { - int w=0; int h=0; + int w = 0; int h = 0; Tk_TSOffset *tsoffset = &outline->tsoffset; int flags = tsoffset->flags; + if (!(flags & TK_OFFSET_INDEX) && (flags & (TK_OFFSET_CENTER|TK_OFFSET_MIDDLE))) { - Tk_SizeOfBitmap(((TkCanvas *)canvas)->display, stipple, &w, &h); + Tk_SizeOfBitmap(Canvas(canvas)->display, stipple, &w, &h); if (flags & TK_OFFSET_CENTER) { w /= 2; } else { @@ -1268,9 +1270,9 @@ Tk_ChangeOutlineGC( * * Tk_ResetOutlineGC * - * Restores the GC to the situation before Tk_ChangeDashGC() was called. - * This function should be called just after the dashed item is drawn, - * because the GC is supposed to be read-only. + * Restores the GC to the situation before Tk_ChangeOutlineGC() was + * called. This function should be called just after the dashed item is + * drawn, because the GC is supposed to be read-only. * * Results: * 1 if there is a stipple pattern, and 0 otherwise. @@ -1302,9 +1304,9 @@ Tk_ResetOutlineGC( color = outline->color; stipple = outline->stipple; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } - if (((TkCanvas *)canvas)->currentItemPtr == item) { + if (Canvas(canvas)->currentItemPtr == item) { if (outline->activeWidth>width) { width = outline->activeWidth; } @@ -1338,16 +1340,16 @@ Tk_ResetOutlineGC( if ((dash->number > 2) || (dash->number < -1) || (dash->number==2 && (dash->pattern.array[0] != dash->pattern.array[1])) || ((dash->number == -1) && (dash->pattern.array[0] != ','))) { - if (dash->number > 0) { + if (dash->number > 0) { dashList = dash->pattern.array[0]; } else { dashList = (char) (4 * width + 0.5); } - XSetDashes(((TkCanvas *)canvas)->display, outline->gc, - outline->offset, &dashList , 1); + XSetDashes(Canvas(canvas)->display, outline->gc, outline->offset, + &dashList , 1); } if (stipple != None) { - XSetTSOrigin(((TkCanvas *)canvas)->display, outline->gc, 0, 0); + XSetTSOrigin(Canvas(canvas)->display, outline->gc, 0, 0); return 1; } return 0; @@ -1377,33 +1379,27 @@ Tk_CanvasPsOutline( Tk_Item *item, Tk_Outline *outline) { - char string[41]; char pattern[11]; int i; - char *ptr; - char *str = string; - char *lptr = pattern; - Tcl_Interp *interp = ((TkCanvas *)canvas)->interp; - double width; - Tk_Dash *dash; - XColor *color; - Pixmap stipple; + char *ptr, *lptr = pattern; + Tcl_Interp *interp = Canvas(canvas)->interp; + double width = outline->width; + Tk_Dash *dash = &outline->dash; + XColor *color = outline->color; + Pixmap stipple = outline->stipple; Tk_State state = item->state; + Tcl_Obj *psObj = GetPostscriptBuffer(interp); - width = outline->width; - dash = &(outline->dash); - color = outline->color; - stipple = outline->stipple; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } - if (((TkCanvas *)canvas)->currentItemPtr == item) { + if (Canvas(canvas)->currentItemPtr == item) { if (outline->activeWidth > width) { width = outline->activeWidth; } if (outline->activeDash.number > 0) { - dash = &(outline->activeDash); + dash = &outline->activeDash; } if (outline->activeColor != NULL) { color = outline->activeColor; @@ -1416,7 +1412,7 @@ Tk_CanvasPsOutline( width = outline->disabledWidth; } if (outline->disabledDash.number > 0) { - dash = &(outline->disabledDash); + dash = &outline->disabledDash; } if (outline->disabledColor != NULL) { color = outline->disabledColor; @@ -1425,66 +1421,65 @@ Tk_CanvasPsOutline( stipple = outline->disabledStipple; } } - sprintf(string, "%.15g setlinewidth\n", width); - Tcl_AppendResult(interp, string, NULL); - if (dash->number > 10) { - str = (char *)ckalloc((unsigned int) (1 + 4*dash->number)); - } else if (dash->number < -5) { - str = (char *)ckalloc((unsigned int) (1 - 8*dash->number)); - lptr = (char *)ckalloc((unsigned int) (1 - 2*dash->number)); - } - ptr = ((unsigned int)ABS(dash->number) > sizeof(char *)) ? + Tcl_AppendPrintfToObj(psObj, "%.15g setlinewidth\n", width); + + ptr = ((unsigned) ABS(dash->number) > sizeof(char *)) ? dash->pattern.pt : dash->pattern.array; + Tcl_AppendToObj(psObj, "[", -1); if (dash->number > 0) { - char *ptr0 = ptr; + Tcl_Obj *converted; + char *p = ptr; - sprintf(str, "[%d", *ptr++ & 0xff); - i = dash->number-1; - while (i--) { - sprintf(str+strlen(str), " %d", *ptr++ & 0xff); + converted = Tcl_ObjPrintf("%d", *p++ & 0xff); + for (i = dash->number-1 ; i>0 ; i--) { + Tcl_AppendPrintfToObj(converted, " %d", *p++ & 0xff); } - Tcl_AppendResult(interp, str, NULL); - if (dash->number&1) { - Tcl_AppendResult(interp, " ", str+1, NULL); + Tcl_AppendObjToObj(psObj, converted); + if (dash->number & 1) { + Tcl_AppendToObj(psObj, " ", -1); + Tcl_AppendObjToObj(psObj, converted); } - sprintf(str, "] %d setdash\n", outline->offset); - Tcl_AppendResult(interp, str, NULL); - ptr = ptr0; + Tcl_DecrRefCount(converted); + Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset); } else if (dash->number < 0) { - if ((i = DashConvert(lptr, ptr, -dash->number, width)) != 0) { - char *lptr0 = lptr; + if (dash->number < -5) { + lptr = ckalloc(1 - 2*dash->number); + } + i = DashConvert(lptr, ptr, -dash->number, width); + if (i > 0) { + char *p = lptr; - sprintf(str, "[%d", *lptr++ & 0xff); - while (--i) { - sprintf(str+strlen(str), " %d", *lptr++ & 0xff); + Tcl_AppendPrintfToObj(psObj, "%d", *p++ & 0xff); + for (; --i>0 ;) { + Tcl_AppendPrintfToObj(psObj, " %d", *p++ & 0xff); } - Tcl_AppendResult(interp, str, NULL); - sprintf(str, "] %d setdash\n", outline->offset); - Tcl_AppendResult(interp, str, NULL); - lptr = lptr0; + Tcl_AppendPrintfToObj(psObj, "] %d setdash\n", outline->offset); } else { - Tcl_AppendResult(interp, "[] 0 setdash\n", NULL); + Tcl_AppendToObj(psObj, "] 0 setdash\n", -1); + } + if (lptr != pattern) { + ckfree(lptr); } } else { - Tcl_AppendResult(interp, "[] 0 setdash\n", NULL); - } - if (str != string) { - ckfree(str); - } - if (lptr != pattern) { - ckfree(lptr); + Tcl_AppendToObj(psObj, "] 0 setdash\n", -1); } + if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) { return TCL_ERROR; } + + /* + * Note that psObj might hold an invalid reference now. + */ + if (stipple != None) { - Tcl_AppendResult(interp, "StrokeClip ", NULL); + Tcl_AppendToObj(GetPostscriptBuffer(interp), "StrokeClip ", -1); if (Tk_CanvasPsStipple(interp, canvas, stipple) != TCL_OK) { return TCL_ERROR; } } else { - Tcl_AppendResult(interp, "stroke\n", NULL); + Tcl_AppendToObj(GetPostscriptBuffer(interp), "stroke\n", -1); } return TCL_OK; @@ -1512,7 +1507,7 @@ static int DashConvert( char *l, /* Must be at least 2*n chars long, or NULL to * indicate "just check syntax". */ - CONST char *p, /* String to parse. */ + const char *p, /* String to parse. */ int n, /* Length of string to parse, or -1 to * indicate that strlen() should be used. */ double width) /* Width of line. */ @@ -1520,7 +1515,7 @@ DashConvert( int result = 0; int size, intWidth; - if (n<0) { + if (n < 0) { n = strlen(p); } intWidth = (int) (width + 0.5); @@ -1660,10 +1655,6 @@ TkCanvTranslatePath( double *a, *b, *t; /* Pointers to parts of the temporary * storage */ int i, j; /* Loop counters */ -#ifndef NDEBUG - int maxOutput; /* Maximum number of outputs that we will - * allow */ -#endif double limit[4]; /* Boundries at which clipping occurs */ double staticSpace[480]; /* Temp space from the stack */ @@ -1704,7 +1695,7 @@ TkCanvTranslatePath( double x, y; x = coordArr[i*2]; - y = coordArr[i*2+1]; + y = coordArr[i*2 + 1]; if (x<lft || x>rgh || y<top || y>btm) { break; } @@ -1722,10 +1713,10 @@ TkCanvTranslatePath( * b[]. Initialize a[] to be equal to coordArr[]. */ - if (numVertex*12 <= (int)(sizeof(staticSpace)/sizeof(staticSpace[0]))) { + if (numVertex*12 <= (int) (sizeof(staticSpace) / sizeof(double))) { tempArr = staticSpace; } else { - tempArr = (double *)ckalloc(numVertex*12*sizeof(tempArr[0])); + tempArr = ckalloc(numVertex * 12 * sizeof(double)); } for (i=0; i<numVertex*2; i++){ tempArr[i] = coordArr[i]; @@ -1758,12 +1749,9 @@ TkCanvTranslatePath( * This is the loop that makes the four passes through the data. */ -#ifndef NDEBUG - maxOutput = numVertex*3; -#endif - for (j=0; j<4; j++){ + for (j=0; j<4; j++) { double xClip = limit[j]; - int inside = a[0]<xClip; + int inside = a[0] < xClip; double priorY = a[1]; numOutput = 0; @@ -1772,9 +1760,9 @@ TkCanvTranslatePath( * rotated by 90 degrees clockwise. */ - for (i=0; i<numVertex; i++){ + for (i=0; i<numVertex; i++) { double x = a[i*2]; - double y = a[i*2+1]; + double y = a[i*2 + 1]; if (x >= xClip) { /* @@ -1792,13 +1780,13 @@ TkCanvTranslatePath( double x0, y0, yN; assert(i > 0); - x0 = a[i*2-2]; - y0 = a[i*2-1]; + x0 = a[i*2 - 2]; + y0 = a[i*2 - 1]; yN = y0 + (y - y0)*(xClip-x0)/(x-x0); b[numOutput*2] = -yN; - b[numOutput*2+1] = xClip; + b[numOutput*2 + 1] = xClip; numOutput++; - assert(numOutput <= maxOutput); + assert(numOutput <= numVertex*3); priorY = yN; inside = 0; } else if (i == 0) { @@ -1817,8 +1805,10 @@ TkCanvTranslatePath( /* * The current vertex is to the left of xClip */ + if (!inside) { - /* If the current vertex is on the left of xClip and one + /* + * If the current vertex is on the left of xClip and one * or more prior vertices where to the right, then we have * to draw a line segment along xClip that extends from * the spot where we first crossed from left to right to @@ -1828,21 +1818,21 @@ TkCanvTranslatePath( double x0, y0, yN; assert(i > 0); - x0 = a[i*2-2]; - y0 = a[i*2-1]; + x0 = a[i*2 - 2]; + y0 = a[i*2 - 1]; yN = y0 + (y - y0)*(xClip-x0)/(x-x0); if (yN != priorY) { b[numOutput*2] = -yN; - b[numOutput*2+1] = xClip; + b[numOutput*2 + 1] = xClip; numOutput++; - assert(numOutput <= maxOutput); + assert(numOutput <= numVertex*3); } inside = 1; } b[numOutput*2] = -y; - b[numOutput*2+1] = x; + b[numOutput*2 + 1] = x; numOutput++; - assert(numOutput <= maxOutput); + assert(numOutput <= numVertex*3); } } @@ -1861,11 +1851,11 @@ TkCanvTranslatePath( * XPoints and translate the origin for the drawable. */ - for (i=0; i<numVertex; i++){ + for (i=0; i<numVertex; i++) { TranslateAndAppendCoords(canvPtr, a[i*2], a[i*2+1], outArr, i); } if (tempArr != staticSpace) { - ckfree((char *) tempArr); + ckfree(tempArr); } return numOutput; } diff --git a/generic/tkCanvWind.c b/generic/tkCanvWind.c index b62859c..f73546f 100644 --- a/generic/tkCanvWind.c +++ b/generic/tkCanvWind.c @@ -10,7 +10,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <stdio.h> #include "tkInt.h" #include "tkCanvas.h" @@ -38,29 +37,27 @@ typedef struct WindowItem { * Information used for parsing configuration specs: */ -static Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, (ClientData) 2 +static const Tk_CustomOption stateOption = { + TkStateParseProc, TkStatePrintProc, INT2PTR(2) }; -static Tk_CustomOption tagsOption = { - (Tk_OptionParseProc *) Tk_CanvasTagsParseProc, - Tk_CanvasTagsPrintProc, (ClientData) NULL +static const Tk_CustomOption tagsOption = { + Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL }; -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_ANCHOR, "-anchor", NULL, NULL, - "center", Tk_Offset(WindowItem, anchor), TK_CONFIG_DONT_SET_DEFAULT}, + "center", Tk_Offset(WindowItem, anchor), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_PIXELS, "-height", NULL, NULL, - "0", Tk_Offset(WindowItem, height), TK_CONFIG_DONT_SET_DEFAULT}, + "0", Tk_Offset(WindowItem, height), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-state", NULL, NULL, NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, &stateOption}, {TK_CONFIG_CUSTOM, "-tags", NULL, NULL, NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, {TK_CONFIG_PIXELS, "-width", NULL, NULL, - "0", Tk_Offset(WindowItem, width), TK_CONFIG_DONT_SET_DEFAULT}, + "0", Tk_Offset(WindowItem, width), TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_WINDOW, "-window", NULL, NULL, - NULL, Tk_Offset(WindowItem, tkwin), TK_CONFIG_NULL_OK}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + NULL, Tk_Offset(WindowItem, tkwin), TK_CONFIG_NULL_OK, NULL}, + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -71,10 +68,10 @@ static void ComputeWindowBbox(Tk_Canvas canvas, WindowItem *winItemPtr); static int ConfigureWinItem(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, - Tcl_Obj *CONST objv[], int flags); + Tcl_Obj *const objv[], int flags); static int CreateWinItem(Tcl_Interp *interp, Tk_Canvas canvas, struct Tk_Item *itemPtr, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void DeleteWinItem(Tk_Canvas canvas, Tk_Item *itemPtr, Display *display); static void DisplayWinItem(Tk_Canvas canvas, @@ -87,7 +84,7 @@ static void TranslateWinItem(Tk_Canvas canvas, Tk_Item *itemPtr, double deltaX, double deltaY); static int WinItemCoords(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static void WinItemLostSlaveProc(ClientData clientData, Tk_Window tkwin); static void WinItemRequestProc(ClientData clientData, @@ -133,6 +130,7 @@ Tk_ItemType tkWindowType = { NULL, /* insertProc */ NULL, /* dTextProc */ NULL, /* nextPtr */ + NULL, 0, NULL, NULL }; /* @@ -172,13 +170,13 @@ CreateWinItem( Tk_Item *itemPtr, /* Record to hold new item; header has been * initialized by caller. */ int objc, /* Number of arguments in objv. */ - Tcl_Obj *CONST objv[]) /* Arguments describing window. */ + Tcl_Obj *const objv[]) /* Arguments describing window. */ { WindowItem *winItemPtr = (WindowItem *) itemPtr; int i; if (objc == 0) { - Tcl_Panic("canvas did not pass any coords\n"); + Tcl_Panic("canvas did not pass any coords"); } /* @@ -199,7 +197,8 @@ CreateWinItem( if (objc == 1) { i = 1; } else { - char *arg = Tcl_GetString(objv[1]); + const char *arg = Tcl_GetString(objv[1]); + i = 2; if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { i = 1; @@ -242,27 +241,26 @@ WinItemCoords( Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ - Tcl_Obj *CONST objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ + Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { WindowItem *winItemPtr = (WindowItem *) itemPtr; if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - Tcl_Obj *subobj = Tcl_NewDoubleObj(winItemPtr->x); - Tcl_ListObjAppendElement(interp, obj, subobj); - subobj = Tcl_NewDoubleObj(winItemPtr->y); - Tcl_ListObjAppendElement(interp, obj, subobj); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *objs[2]; + + objs[0] = Tcl_NewDoubleObj(winItemPtr->x); + objs[1] = Tcl_NewDoubleObj(winItemPtr->y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs)); } else if (objc < 3) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "WINDOW", + NULL); return TCL_ERROR; } } @@ -273,10 +271,9 @@ WinItemCoords( } ComputeWindowBbox(canvas, winItemPtr); } else { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 2, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "WINDOW", NULL); return TCL_ERROR; } return TCL_OK; @@ -306,7 +303,7 @@ ConfigureWinItem( Tk_Canvas canvas, /* Canvas containing itemPtr. */ Tk_Item *itemPtr, /* Window item to reconfigure. */ int objc, /* Number of elements in objv. */ - Tcl_Obj *CONST objv[], /* Arguments describing things to configure. */ + Tcl_Obj *const objv[], /* Arguments describing things to configure. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { WindowItem *winItemPtr = (WindowItem *) itemPtr; @@ -316,7 +313,7 @@ ConfigureWinItem( oldWindow = winItemPtr->tkwin; canvasTkwin = Tk_CanvasTkwin(canvas); if (TCL_OK != Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, objc, - (CONST char **) objv, (char *) winItemPtr, flags|TK_CONFIG_OBJS)) { + (const char **) objv, (char *) winItemPtr, flags|TK_CONFIG_OBJS)) { return TCL_ERROR; } @@ -327,8 +324,8 @@ ConfigureWinItem( if (oldWindow != winItemPtr->tkwin) { if (oldWindow != NULL) { Tk_DeleteEventHandler(oldWindow, StructureNotifyMask, - WinItemStructureProc, (ClientData) winItemPtr); - Tk_ManageGeometry(oldWindow, NULL, (ClientData) NULL); + WinItemStructureProc, winItemPtr); + Tk_ManageGeometry(oldWindow, NULL, NULL); Tk_UnmaintainGeometry(oldWindow, canvasTkwin); Tk_UnmapWindow(oldWindow); } @@ -343,30 +340,23 @@ ConfigureWinItem( */ parent = Tk_Parent(winItemPtr->tkwin); - for (ancestor = canvasTkwin; ; - ancestor = Tk_Parent(ancestor)) { + for (ancestor = canvasTkwin ;; ancestor = Tk_Parent(ancestor)) { if (ancestor == parent) { break; } - if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_HIERARCHY) { - badWindow: - Tcl_AppendResult(interp, "can't use ", - Tk_PathName(winItemPtr->tkwin), - " in a window item of this canvas", NULL); - winItemPtr->tkwin = NULL; - return TCL_ERROR; + if (((Tk_FakeWin *) ancestor)->flags & TK_TOP_HIERARCHY) { + goto badWindow; } } - if (((Tk_FakeWin *) (winItemPtr->tkwin))->flags & TK_TOP_HIERARCHY) { + if (((Tk_FakeWin *) winItemPtr->tkwin)->flags & TK_TOP_HIERARCHY){ goto badWindow; } if (winItemPtr->tkwin == canvasTkwin) { goto badWindow; } Tk_CreateEventHandler(winItemPtr->tkwin, StructureNotifyMask, - WinItemStructureProc, (ClientData) winItemPtr); - Tk_ManageGeometry(winItemPtr->tkwin, &canvasGeomType, - (ClientData) winItemPtr); + WinItemStructureProc, winItemPtr); + Tk_ManageGeometry(winItemPtr->tkwin, &canvasGeomType, winItemPtr); } } if ((winItemPtr->tkwin != NULL) @@ -379,8 +369,15 @@ ConfigureWinItem( } ComputeWindowBbox(canvas, winItemPtr); - return TCL_OK; + + badWindow: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s in a window item of this canvas", + Tk_PathName(winItemPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); + winItemPtr->tkwin = NULL; + return TCL_ERROR; } /* @@ -411,9 +408,8 @@ DeleteWinItem( if (winItemPtr->tkwin != NULL) { Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask, - WinItemStructureProc, (ClientData) winItemPtr); - Tk_ManageGeometry(winItemPtr->tkwin, NULL, - (ClientData) NULL); + WinItemStructureProc, winItemPtr); + Tk_ManageGeometry(winItemPtr->tkwin, NULL, NULL); if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) { Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin); } @@ -451,7 +447,7 @@ ComputeWindowBbox( y = (int) (winItemPtr->y + ((winItemPtr->y >= 0) ? 0.5 : - 0.5)); if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } if ((winItemPtr->tkwin == NULL) || (state == TK_STATE_HIDDEN)) { /* @@ -576,7 +572,7 @@ DisplayWinItem( return; } if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } /* @@ -757,8 +753,7 @@ xerrorhandler( { return 0; } -#endif - +#endif /* X_GetImage */ /* *-------------------------------------------------------------- @@ -788,8 +783,7 @@ WinItemToPostscript( * information; 0 means final Postscript is * being created. */ { - WindowItem *winItemPtr = (WindowItem *)itemPtr; - + WindowItem *winItemPtr = (WindowItem *) itemPtr; double x, y; int width, height; Tk_Window tkwin = winItemPtr->tkwin; @@ -832,45 +826,44 @@ CanvasPsWindow( double x, double y, /* origin of window. */ int width, int height) /* width/height of window. */ { - char buffer[256]; XImage *ximage; int result; - Tcl_DString buffer1, buffer2; #ifdef X_GetImage Tk_ErrorHandler handle; #endif + Tcl_Obj *cmdObj, *psObj; + Tcl_InterpState interpState = Tcl_SaveInterpState(interp, TCL_OK); - sprintf(buffer, "\n%%%% %s item (%s, %d x %d)\n%.15g %.15g translate\n", + /* + * Locate the subwindow within the wider window. + */ + + psObj = Tcl_ObjPrintf( + "\n%%%% %s item (%s, %d x %d)\n" /* Comment */ + "%.15g %.15g translate\n", /* Position */ Tk_Class(tkwin), Tk_PathName(tkwin), width, height, x, y); - Tcl_AppendResult(interp, buffer, NULL); /* * First try if the widget has its own "postscript" command. If it exists, * this will produce much better postscript than when a pixmap is used. */ - Tcl_DStringInit(&buffer1); - Tcl_DStringInit(&buffer2); - Tcl_DStringGetResult(interp, &buffer2); - sprintf(buffer, "%s postscript -prolog 0\n", Tk_PathName(tkwin)); - result = Tcl_Eval(interp, buffer); - Tcl_DStringGetResult(interp, &buffer1); - Tcl_DStringResult(interp, &buffer2); - Tcl_DStringFree(&buffer2); + Tcl_ResetResult(interp); + cmdObj = Tcl_ObjPrintf("%s postscript -prolog 0", Tk_PathName(tkwin)); + Tcl_IncrRefCount(cmdObj); + result = Tcl_EvalObjEx(interp, cmdObj, 0); + Tcl_DecrRefCount(cmdObj); if (result == TCL_OK) { - Tcl_AppendResult(interp, "50 dict begin\nsave\ngsave\n", NULL); - sprintf(buffer, "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d", - height, width, height, width); - Tcl_AppendResult(interp, buffer, NULL); - Tcl_AppendResult(interp, " 0 rlineto closepath\n", + Tcl_AppendPrintfToObj(psObj, + "50 dict begin\nsave\ngsave\n" + "0 %d moveto %d 0 rlineto 0 -%d rlineto -%d 0 rlineto closepath\n" "1.000 1.000 1.000 setrgbcolor AdjustColor\nfill\ngrestore\n", - Tcl_DStringValue(&buffer1), "\nrestore\nend\n\n\n", NULL); - Tcl_DStringFree(&buffer1); - - return result; + height, width, height, width); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(psObj, "\nrestore\nend\n\n\n", -1); + goto done; } - Tcl_DStringFree(&buffer1); /* * If the window is off the screen it will generate a BadMatch/XError. We @@ -879,7 +872,7 @@ CanvasPsWindow( #ifdef X_GetImage handle = Tk_CreateErrorHandler(Tk_Display(tkwin), BadMatch, - X_GetImage, -1, xerrorhandler, (ClientData) tkwin); + X_GetImage, -1, xerrorhandler, tkwin); #endif /* @@ -888,20 +881,34 @@ CanvasPsWindow( */ ximage = XGetImage(Tk_Display(tkwin), Tk_WindowId(tkwin), 0, 0, - (unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap); + (unsigned) width, (unsigned) height, AllPlanes, ZPixmap); #ifdef X_GetImage Tk_DeleteErrorHandler(handle); #endif if (ximage == NULL) { - return TCL_OK; + result = TCL_OK; + } else { + Tcl_ResetResult(interp); + result = TkPostscriptImage(interp, tkwin, Canvas(canvas)->psInfo, + ximage, 0, 0, width, height); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + XDestroyImage(ximage); } - result = TkPostscriptImage(interp, tkwin, - ((TkCanvas *)canvas)->psInfo, ximage, 0, 0, width, height); + /* + * Plug the accumulated postscript back into the result. + */ - XDestroyImage(ximage); + done: + if (result == TCL_OK) { + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + } else { + Tcl_DiscardInterpState(interpState); + } + Tcl_DecrRefCount(psObj); return result; } @@ -1000,7 +1007,7 @@ WinItemStructureProc( ClientData clientData, /* Pointer to record describing window item. */ XEvent *eventPtr) /* Describes what just happened. */ { - WindowItem *winItemPtr = (WindowItem *) clientData; + WindowItem *winItemPtr = clientData; if (eventPtr->type == DestroyNotify) { winItemPtr->tkwin = NULL; @@ -1030,7 +1037,7 @@ WinItemRequestProc( ClientData clientData, /* Pointer to record for window item. */ Tk_Window tkwin) /* Window that changed its desired size. */ { - WindowItem *winItemPtr = (WindowItem *) clientData; + WindowItem *winItemPtr = clientData; ComputeWindowBbox(winItemPtr->canvas, winItemPtr); @@ -1067,11 +1074,11 @@ WinItemLostSlaveProc( * was stolen away. */ Tk_Window tkwin) /* Tk's handle for the slave window. */ { - WindowItem *winItemPtr = (WindowItem *) clientData; + WindowItem *winItemPtr = clientData; Tk_Window canvasTkwin = Tk_CanvasTkwin(winItemPtr->canvas); Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask, - WinItemStructureProc, (ClientData) winItemPtr); + WinItemStructureProc, winItemPtr); if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) { Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin); } diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c index 8ebe9ba..9c4d60a 100644 --- a/generic/tkCanvas.c +++ b/generic/tkCanvas.c @@ -75,7 +75,7 @@ typedef struct TagSearch { * return NULL. */ int type; /* Search type (see #defs below) */ int id; /* Item id for searches by id */ - char *string; /* Tag expression string */ + const char *string; /* Tag expression string */ int stringIndex; /* Current position in string scan */ int stringLength; /* Length of tag expression string */ char *rewritebuffer; /* Tag string (after removing escapes) */ @@ -100,112 +100,109 @@ typedef struct TagSearch { * Custom option for handling "-state" and "-offset" */ -static Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, - (ClientData) NULL /* only "normal" and "disabled" */ +static const Tk_CustomOption stateOption = { + TkStateParseProc, TkStatePrintProc, + NULL /* Only "normal" and "disabled". */ }; -static Tk_CustomOption offsetOption = { - (Tk_OptionParseProc *) TkOffsetParseProc, - TkOffsetPrintProc, - (ClientData) TK_OFFSET_RELATIVE +static const Tk_CustomOption offsetOption = { + TkOffsetParseProc, TkOffsetPrintProc, INT2PTR(TK_OFFSET_RELATIVE) }; /* * Information used for argv parsing. */ -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_BORDER, "-background", "background", "Background", DEF_CANVAS_BG_COLOR, Tk_Offset(TkCanvas, bgBorder), - TK_CONFIG_COLOR_ONLY}, + TK_CONFIG_COLOR_ONLY, NULL}, {TK_CONFIG_BORDER, "-background", "background", "Background", DEF_CANVAS_BG_MONO, Tk_Offset(TkCanvas, bgBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", NULL, NULL, 0, 0}, - {TK_CONFIG_SYNONYM, "-bg", "background", NULL, NULL, 0, 0}, + TK_CONFIG_MONO_ONLY, NULL}, + {TK_CONFIG_SYNONYM, "-bd", "borderWidth", NULL, NULL, 0, 0, NULL}, + {TK_CONFIG_SYNONYM, "-bg", "background", NULL, NULL, 0, 0, NULL}, {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_CANVAS_BORDER_WIDTH, Tk_Offset(TkCanvas, borderWidth), 0}, + DEF_CANVAS_BORDER_WIDTH, Tk_Offset(TkCanvas, borderWidth), 0, NULL}, {TK_CONFIG_DOUBLE, "-closeenough", "closeEnough", "CloseEnough", - DEF_CANVAS_CLOSE_ENOUGH, Tk_Offset(TkCanvas, closeEnough), 0}, + DEF_CANVAS_CLOSE_ENOUGH, Tk_Offset(TkCanvas, closeEnough), 0, NULL}, {TK_CONFIG_BOOLEAN, "-confine", "confine", "Confine", - DEF_CANVAS_CONFINE, Tk_Offset(TkCanvas, confine), 0}, + DEF_CANVAS_CONFINE, Tk_Offset(TkCanvas, confine), 0, NULL}, {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_CANVAS_CURSOR, Tk_Offset(TkCanvas, cursor), TK_CONFIG_NULL_OK}, + DEF_CANVAS_CURSOR, Tk_Offset(TkCanvas, cursor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_PIXELS, "-height", "height", "Height", - DEF_CANVAS_HEIGHT, Tk_Offset(TkCanvas, height), 0}, + DEF_CANVAS_HEIGHT, Tk_Offset(TkCanvas, height), 0, NULL}, {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", "HighlightBackground", DEF_CANVAS_HIGHLIGHT_BG, - Tk_Offset(TkCanvas, highlightBgColorPtr), 0}, + Tk_Offset(TkCanvas, highlightBgColorPtr), 0, NULL}, {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", - DEF_CANVAS_HIGHLIGHT, Tk_Offset(TkCanvas, highlightColorPtr), 0}, + DEF_CANVAS_HIGHLIGHT, Tk_Offset(TkCanvas, highlightColorPtr), 0, NULL}, {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", "HighlightThickness", - DEF_CANVAS_HIGHLIGHT_WIDTH, Tk_Offset(TkCanvas, highlightWidth), 0}, + DEF_CANVAS_HIGHLIGHT_WIDTH, Tk_Offset(TkCanvas, highlightWidth), 0, NULL}, {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground", - DEF_CANVAS_INSERT_BG, Tk_Offset(TkCanvas, textInfo.insertBorder), 0}, + DEF_CANVAS_INSERT_BG, Tk_Offset(TkCanvas, textInfo.insertBorder), 0, NULL}, {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth", DEF_CANVAS_INSERT_BD_COLOR, - Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_COLOR_ONLY}, + Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_COLOR_ONLY, NULL}, {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth", DEF_CANVAS_INSERT_BD_MONO, - Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_MONO_ONLY}, + Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_MONO_ONLY, NULL}, {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime", - DEF_CANVAS_INSERT_OFF_TIME, Tk_Offset(TkCanvas, insertOffTime), 0}, + DEF_CANVAS_INSERT_OFF_TIME, Tk_Offset(TkCanvas, insertOffTime), 0, NULL}, {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime", - DEF_CANVAS_INSERT_ON_TIME, Tk_Offset(TkCanvas, insertOnTime), 0}, + DEF_CANVAS_INSERT_ON_TIME, Tk_Offset(TkCanvas, insertOnTime), 0, NULL}, {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", - DEF_CANVAS_INSERT_WIDTH, Tk_Offset(TkCanvas, textInfo.insertWidth), 0}, + DEF_CANVAS_INSERT_WIDTH, Tk_Offset(TkCanvas, textInfo.insertWidth), 0, NULL}, {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", Tk_Offset(TkCanvas, tsoffset),TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_CANVAS_RELIEF, Tk_Offset(TkCanvas, relief), 0}, + DEF_CANVAS_RELIEF, Tk_Offset(TkCanvas, relief), 0, NULL}, {TK_CONFIG_STRING, "-scrollregion", "scrollRegion", "ScrollRegion", DEF_CANVAS_SCROLL_REGION, Tk_Offset(TkCanvas, regionString), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground", DEF_CANVAS_SELECT_COLOR, Tk_Offset(TkCanvas, textInfo.selBorder), - TK_CONFIG_COLOR_ONLY}, + TK_CONFIG_COLOR_ONLY, NULL}, {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground", DEF_CANVAS_SELECT_MONO, Tk_Offset(TkCanvas, textInfo.selBorder), - TK_CONFIG_MONO_ONLY}, + TK_CONFIG_MONO_ONLY, NULL}, {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", DEF_CANVAS_SELECT_BD_COLOR, - Tk_Offset(TkCanvas, textInfo.selBorderWidth), TK_CONFIG_COLOR_ONLY}, + Tk_Offset(TkCanvas, textInfo.selBorderWidth), TK_CONFIG_COLOR_ONLY, NULL}, {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", DEF_CANVAS_SELECT_BD_MONO, Tk_Offset(TkCanvas, textInfo.selBorderWidth), - TK_CONFIG_MONO_ONLY}, + TK_CONFIG_MONO_ONLY, NULL}, {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", DEF_CANVAS_SELECT_FG_COLOR, Tk_Offset(TkCanvas, textInfo.selFgColorPtr), - TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK}, + TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background", DEF_CANVAS_SELECT_FG_MONO, Tk_Offset(TkCanvas, textInfo.selFgColorPtr), - TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK}, + TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-state", "state", "State", "normal", Tk_Offset(TkCanvas, canvas_state), TK_CONFIG_DONT_SET_DEFAULT, &stateOption}, {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_CANVAS_TAKE_FOCUS, Tk_Offset(TkCanvas, takeFocus), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_PIXELS, "-width", "width", "Width", - DEF_CANVAS_WIDTH, Tk_Offset(TkCanvas, width), 0}, + DEF_CANVAS_WIDTH, Tk_Offset(TkCanvas, width), 0, NULL}, {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", DEF_CANVAS_X_SCROLL_CMD, Tk_Offset(TkCanvas, xScrollCmd), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_PIXELS, "-xscrollincrement", "xScrollIncrement", "ScrollIncrement", DEF_CANVAS_X_SCROLL_INCREMENT, Tk_Offset(TkCanvas, xScrollIncrement), - 0}, + 0, NULL}, {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand", DEF_CANVAS_Y_SCROLL_CMD, Tk_Offset(TkCanvas, yScrollCmd), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_PIXELS, "-yscrollincrement", "yScrollIncrement", "ScrollIncrement", DEF_CANVAS_Y_SCROLL_INCREMENT, Tk_Offset(TkCanvas, yScrollIncrement), - 0}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + 0, NULL}, + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -213,8 +210,9 @@ static Tk_ConfigSpec configSpecs[] = { * protected by typeListMutex. */ -static Tk_ItemType *typeList = NULL; /* NULL means initialization hasn't - * been done yet. */ +static Tk_ItemType *typeList = NULL; + /* NULL means initialization hasn't been done + * yet. */ TCL_DECLARE_MUTEX(typeListMutex) #ifndef USE_OLD_TAG_SEARCH @@ -264,32 +262,31 @@ static void CanvasSetOrigin(TkCanvas *canvasPtr, static void CanvasUpdateScrollbars(TkCanvas *canvasPtr); static int CanvasWidgetCmd(ClientData clientData, Tcl_Interp *interp, int argc, - Tcl_Obj *CONST *argv); -static void CanvasWorldChanged( - ClientData instanceData); + Tcl_Obj *const *argv); +static void CanvasWorldChanged(ClientData instanceData); static int ConfigureCanvas(Tcl_Interp *interp, TkCanvas *canvasPtr, int argc, - Tcl_Obj *CONST *argv, int flags); + Tcl_Obj *const *argv, int flags); static void DestroyCanvas(char *memPtr); static void DisplayCanvas(ClientData clientData); -static void DoItem(Tcl_Interp *interp, +static void DoItem(Tcl_Obj *accumObj, Tk_Item *itemPtr, Tk_Uid tag); -static void EventuallyRedrawItem(Tk_Canvas canvas, +static void EventuallyRedrawItem(TkCanvas *canvasPtr, Tk_Item *itemPtr); #ifdef USE_OLD_TAG_SEARCH static int FindItems(Tcl_Interp *interp, TkCanvas *canvasPtr, - int argc, Tcl_Obj *CONST *argv, + int argc, Tcl_Obj *const *argv, Tcl_Obj *newTagObj, int first); #else /* USE_OLD_TAG_SEARCH */ static int FindItems(Tcl_Interp *interp, TkCanvas *canvasPtr, - int argc, Tcl_Obj *CONST *argv, + int argc, Tcl_Obj *const *argv, Tcl_Obj *newTagObj, int first, TagSearch **searchPtrPtr); #endif /* USE_OLD_TAG_SEARCH */ static int FindArea(Tcl_Interp *interp, TkCanvas *canvasPtr, - Tcl_Obj *CONST *argv, Tk_Uid uid, int enclosed); + Tcl_Obj *const *argv, Tk_Uid uid, int enclosed); static double GridAlign(double coord, double spacing); -static CONST char** TkGetStringsFromObjs(int argc, Tcl_Obj *CONST *objv); +static const char** TkGetStringsFromObjs(int argc, Tcl_Obj *const *objv); static void InitCanvas(void); #ifdef USE_OLD_TAG_SEARCH static Tk_Item * NextItem(TagSearch *searchPtr); @@ -323,9 +320,11 @@ static Tk_Item * TagSearchNext(TagSearch *searchPtr); * that can be invoked from generic window code. */ -static Tk_ClassProcs canvasClass = { +static const Tk_ClassProcs canvasClass = { sizeof(Tk_ClassProcs), /* size */ CanvasWorldChanged, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -334,10 +333,14 @@ static Tk_ClassProcs canvasClass = { #ifdef USE_OLD_TAG_SEARCH #define FIRST_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \ - (itemPtr) = StartTagSearch(canvasPtr,(objPtr),&search) + itemPtr = StartTagSearch(canvasPtr,(objPtr),&search) #define FOR_EVERY_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \ - for ((itemPtr) = StartTagSearch(canvasPtr, (objPtr), &search); \ - (itemPtr) != NULL; (itemPtr) = NextItem(&search)) + for (itemPtr = StartTagSearch(canvasPtr, (objPtr), &search); \ + itemPtr != NULL; itemPtr = NextItem(&search)) +#define FIND_ITEMS(objPtr, n) \ + FindItems(interp, canvasPtr, objc, objv, (objPtr), (n)) +#define RELINK_ITEMS(objPtr, itemPtr) \ + RelinkItems(canvasPtr, (objPtr), (itemPtr)) #else /* USE_OLD_TAG_SEARCH */ #define FIRST_CANVAS_ITEM_MATCHING(objPtr,searchPtrPtr,errorExitClause) \ if ((result=TagSearchScan(canvasPtr,(objPtr),(searchPtrPtr))) != TCL_OK){ \ @@ -350,8 +353,266 @@ static Tk_ClassProcs canvasClass = { } \ for (itemPtr = TagSearchFirst(*(searchPtrPtr)); \ itemPtr != NULL; itemPtr = TagSearchNext(*(searchPtrPtr))) +#define FIND_ITEMS(objPtr, n) \ + FindItems(interp, canvasPtr, objc, objv, (objPtr), (n), &searchPtr) +#define RELINK_ITEMS(objPtr, itemPtr) \ + result = RelinkItems(canvasPtr, (objPtr), (itemPtr), &searchPtr) #endif /* USE_OLD_TAG_SEARCH */ + +/* + * ---------------------------------------------------------------------- + * + * AlwaysRedraw, ItemConfigure, ItemCoords, etc. -- + * + * Helper functions that make access to canvas item functions simpler. + * Note that these are all inline functions. + * + * ---------------------------------------------------------------------- + */ + +static inline int +AlwaysRedraw( + Tk_Item *itemPtr) +{ + return itemPtr->typePtr->alwaysRedraw & 1; +} + +static inline int +ItemConfigure( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_Interp *interp = canvasPtr->interp; + int result; + + if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { + result = itemPtr->typePtr->configProc(interp, (Tk_Canvas) canvasPtr, + itemPtr, objc, objv, TK_CONFIG_ARGV_ONLY); + } else { + const char **args = TkGetStringsFromObjs(objc, objv); + + result = itemPtr->typePtr->configProc(interp, (Tk_Canvas) canvasPtr, + itemPtr, objc, (Tcl_Obj **) args, TK_CONFIG_ARGV_ONLY); + if (args != NULL) { + ckfree(args); + } + } + return result; +} + +static inline int +ItemConfigInfo( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + Tcl_Obj *fieldName) +{ + return Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin, + itemPtr->typePtr->configSpecs, (char *) itemPtr, + (fieldName ? Tcl_GetString(fieldName) : NULL), 0); +} + +static inline int +ItemConfigValue( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + Tcl_Obj *fieldName) +{ + return Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin, + itemPtr->typePtr->configSpecs, (char *) itemPtr, + Tcl_GetString(fieldName), 0); +} +static inline int +ItemCoords( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_Interp *interp = canvasPtr->interp; + int result; + + if (itemPtr->typePtr->coordProc == NULL) { + result = TCL_OK; + } else if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { + result = itemPtr->typePtr->coordProc(interp, (Tk_Canvas) canvasPtr, + itemPtr, objc, objv); + } else { + const char **args = TkGetStringsFromObjs(objc, objv); + + result = itemPtr->typePtr->coordProc(interp, (Tk_Canvas) canvasPtr, + itemPtr, objc, (Tcl_Obj **) args); + if (args != NULL) { + ckfree(args); + } + } + return result; +} + +static inline int +ItemCreate( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, /* Warning: incomplete! typePtr field must be + * set by this point. */ + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_Interp *interp = canvasPtr->interp; + int result; + + if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { + result = itemPtr->typePtr->createProc(interp, (Tk_Canvas) canvasPtr, + itemPtr, objc-3, objv+3); + } else { + const char **args = TkGetStringsFromObjs(objc-3, objv+3); + + result = itemPtr->typePtr->createProc(interp, (Tk_Canvas) canvasPtr, + itemPtr, objc-3, (Tcl_Obj **) args); + if (args != NULL) { + ckfree(args); + } + } + return result; +} + +static inline void +ItemCursor( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + int index) +{ + itemPtr->typePtr->icursorProc((Tk_Canvas) canvasPtr, itemPtr, index); +} + +static inline void +ItemDelChars( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + int first, + int last) +{ + itemPtr->typePtr->dCharsProc((Tk_Canvas) canvasPtr, itemPtr, first, last); +} + +static inline void +ItemDelete( + TkCanvas *canvasPtr, + Tk_Item *itemPtr) +{ + itemPtr->typePtr->deleteProc((Tk_Canvas) canvasPtr, itemPtr, + canvasPtr->display); +} + +static inline void +ItemDisplay( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + Pixmap pixmap, + int screenX1, int screenY1, + int width, int height) +{ + itemPtr->typePtr->displayProc((Tk_Canvas) canvasPtr, itemPtr, + canvasPtr->display, pixmap, screenX1, screenY1, width, height); +} + +static inline int +ItemIndex( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + Tcl_Obj *objPtr, + int *indexPtr) +{ + Tcl_Interp *interp = canvasPtr->interp; + + if (itemPtr->typePtr->indexProc == NULL) { + return TCL_OK; + } else if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { + return itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr, + itemPtr, objPtr, indexPtr); + } else { + return itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr, + itemPtr, (Tcl_Obj *) Tcl_GetString(objPtr), indexPtr); + } +} + +static inline void +ItemInsert( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + int beforeThis, + Tcl_Obj *toInsert) +{ + if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { + itemPtr->typePtr->insertProc((Tk_Canvas) canvasPtr, itemPtr, + beforeThis, toInsert); + } else { + itemPtr->typePtr->insertProc((Tk_Canvas) canvasPtr, itemPtr, + beforeThis, (Tcl_Obj *) Tcl_GetString(toInsert)); + } +} + +static inline int +ItemOverlap( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + double rect[]) +{ + return itemPtr->typePtr->areaProc((Tk_Canvas) canvasPtr, itemPtr, rect); +} + +static inline double +ItemPoint( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + double coords[], + double halo) +{ + double dist; + + dist = itemPtr->typePtr->pointProc((Tk_Canvas) canvasPtr, itemPtr, + coords) - halo; + return (dist < 0.0) ? 0.0 : dist; +} + +static inline void +ItemScale( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + double xOrigin, double yOrigin, + double xScale, double yScale) +{ + itemPtr->typePtr->scaleProc((Tk_Canvas) canvasPtr, itemPtr, + xOrigin, yOrigin, xScale, yScale); +} + +static inline int +ItemSelection( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + int offset, + char *buffer, + int maxBytes) +{ + if (itemPtr == NULL || itemPtr->typePtr->selectionProc == NULL) { + return -1; + } + + return itemPtr->typePtr->selectionProc((Tk_Canvas) canvasPtr, itemPtr, + offset, buffer, maxBytes); +} + +static inline void +ItemTranslate( + TkCanvas *canvasPtr, + Tk_Item *itemPtr, + double xDelta, + double yDelta) +{ + itemPtr->typePtr->translateProc((Tk_Canvas) canvasPtr, itemPtr, + xDelta, yDelta); +} /* *-------------------------------------------------------------- @@ -375,9 +636,9 @@ Tk_CanvasObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - Tcl_Obj *CONST argv[]) /* Argument objects. */ + Tcl_Obj *const argv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = clientData; TkCanvas *canvasPtr; Tk_Window newWin; @@ -386,7 +647,7 @@ Tk_CanvasObjCmd( } if (argc < 2) { - Tcl_WrongNumArgs(interp, 1, argv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, argv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -401,13 +662,13 @@ Tk_CanvasObjCmd( * pointers). */ - canvasPtr = (TkCanvas *) ckalloc(sizeof(TkCanvas)); + canvasPtr = ckalloc(sizeof(TkCanvas)); canvasPtr->tkwin = newWin; canvasPtr->display = Tk_Display(newWin); canvasPtr->interp = interp; canvasPtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd, - (ClientData) canvasPtr, CanvasCmdDeletedProc); + Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd, canvasPtr, + CanvasCmdDeletedProc); canvasPtr->firstItemPtr = NULL; canvasPtr->lastItemPtr = NULL; canvasPtr->borderWidth = 0; @@ -480,21 +741,21 @@ Tk_CanvasObjCmd( Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS); Tk_SetClass(canvasPtr->tkwin, "Canvas"); - Tk_SetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr); + Tk_SetClassProcs(canvasPtr->tkwin, &canvasClass, canvasPtr); Tk_CreateEventHandler(canvasPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - CanvasEventProc, (ClientData) canvasPtr); + CanvasEventProc, canvasPtr); Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask |ButtonPressMask|ButtonReleaseMask|EnterWindowMask |LeaveWindowMask|PointerMotionMask|VirtualEventMask, - CanvasBindProc, (ClientData) canvasPtr); + CanvasBindProc, canvasPtr); Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING, - CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING); + CanvasFetchSelection, canvasPtr, XA_STRING); if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) { goto error; } - Tcl_SetResult(interp, Tk_PathName(canvasPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(canvasPtr->tkwin)); return TCL_OK; error: @@ -525,9 +786,9 @@ CanvasWidgetCmd( ClientData clientData, /* Information about canvas widget. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - TkCanvas *canvasPtr = (TkCanvas *) clientData; + TkCanvas *canvasPtr = clientData; int c, result; Tk_Item *itemPtr = NULL; /* Initialization needed only to prevent * compiler warning. */ @@ -539,15 +800,16 @@ CanvasWidgetCmd( #endif /* USE_OLD_TAG_SEARCH */ int index; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "addtag", "bbox", "bind", "canvasx", "canvasy", "cget", "configure", "coords", "create", "dchars", "delete", "dtag", "find", "focus", "gettags", "icursor", - "index", "insert", "itemcget", "itemconfigure", - "lower", "move", "postscript", "raise", - "scale", "scan", "select", "type", - "xview", "yview", + "imove", "index", "insert", "itemcget", + "itemconfigure", + "lower", "move", "moveto", "postscript", + "raise", "rchars", "scale", "scan", + "select", "type", "xview", "yview", NULL }; enum options { @@ -555,35 +817,32 @@ CanvasWidgetCmd( CANV_CANVASY, CANV_CGET, CANV_CONFIGURE, CANV_COORDS, CANV_CREATE, CANV_DCHARS, CANV_DELETE, CANV_DTAG, CANV_FIND, CANV_FOCUS, CANV_GETTAGS, CANV_ICURSOR, - CANV_INDEX, CANV_INSERT, CANV_ITEMCGET, CANV_ITEMCONFIGURE, - CANV_LOWER, CANV_MOVE, CANV_POSTSCRIPT,CANV_RAISE, - CANV_SCALE, CANV_SCAN, CANV_SELECT, CANV_TYPE, - CANV_XVIEW, CANV_YVIEW + CANV_IMOVE, CANV_INDEX, CANV_INSERT, CANV_ITEMCGET, + CANV_ITEMCONFIGURE, + CANV_LOWER, CANV_MOVE, CANV_MOVETO, CANV_POSTSCRIPT, + CANV_RAISE, CANV_RCHARS, CANV_SCALE, CANV_SCAN, + CANV_SELECT, CANV_TYPE, CANV_XVIEW, CANV_YVIEW }; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } - Tcl_Preserve((ClientData) canvasPtr); + Tcl_Preserve(canvasPtr); result = TCL_OK; switch ((enum options) index) { case CANV_ADDTAG: if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "tag searchCommand ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "tag searchCommand ?arg ...?"); result = TCL_ERROR; goto done; } -#ifdef USE_OLD_TAG_SEARCH - result = FindItems(interp, canvasPtr, objc, objv, objv[2], 3); -#else /* USE_OLD_TAG_SEARCH */ - result = FindItems(interp, canvasPtr, objc, objv, objv[2], 3, &searchPtr); -#endif /* USE_OLD_TAG_SEARCH */ + result = FIND_ITEMS(objv[2], 3); break; case CANV_BBOX: { @@ -627,10 +886,13 @@ CanvasWidgetCmd( } } if (gotAny) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *resultObjs[4]; - sprintf(buf, "%d %d %d %d", x1, y1, x2, y2); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + resultObjs[0] = Tcl_NewIntObj(x1); + resultObjs[1] = Tcl_NewIntObj(y1); + resultObjs[2] = Tcl_NewIntObj(x2); + resultObjs[3] = Tcl_NewIntObj(y2); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, resultObjs)); } break; } @@ -648,7 +910,7 @@ CanvasWidgetCmd( * tag). */ - object = 0; + object = NULL; #ifdef USE_OLD_TAG_SEARCH if (isdigit(UCHAR(Tcl_GetString(objv[2])[0]))) { int id; @@ -661,19 +923,21 @@ CanvasWidgetCmd( } entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id); if (entryPtr != NULL) { - itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr); - object = (ClientData) itemPtr; + itemPtr = Tcl_GetHashValue(entryPtr); + object = itemPtr; } - if (object == 0) { - Tcl_AppendResult(interp, "item \"", Tcl_GetString(objv[2]), - "\" doesn't exist", NULL); + if (object == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item \"%s\" doesn't exist", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM", + Tcl_GetString(objv[2]), NULL); result = TCL_ERROR; goto done; } } else { - bindByTag: - object = (ClientData) Tk_GetUid(Tcl_GetString(objv[2])); + bindByTag: + object = Tk_GetUid(Tcl_GetString(objv[2])); } #else /* USE_OLD_TAG_SEARCH */ result = TagSearchScan(canvasPtr, objv[2], &searchPtr); @@ -686,13 +950,15 @@ CanvasWidgetCmd( entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) INT2PTR(searchPtr->id)); if (entryPtr != NULL) { - itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr); - object = (ClientData) itemPtr; + itemPtr = Tcl_GetHashValue(entryPtr); + object = itemPtr; } if (object == 0) { - Tcl_AppendResult(interp, "item \"", Tcl_GetString(objv[2]), - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item \"%s\" doesn't exist", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM", + Tcl_GetString(objv[2]), NULL); result = TCL_ERROR; goto done; } @@ -712,7 +978,7 @@ CanvasWidgetCmd( if (objc == 5) { int append = 0; unsigned long mask; - char* argv4 = Tcl_GetString(objv[4]); + const char *argv4 = Tcl_GetString(objv[4]); if (argv4[0] == 0) { result = Tk_DeleteBinding(interp, canvasPtr->bindingTable, @@ -768,22 +1034,20 @@ CanvasWidgetCmd( |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { Tk_DeleteBinding(interp, canvasPtr->bindingTable, object, Tcl_GetString(objv[3])); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "requested illegal events; ", - "only key, button, motion, enter, leave, and virtual ", - "events may be used", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "requested illegal events; only key, button, motion," + " enter, leave, and virtual events may be used", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_EVENTS", NULL); result = TCL_ERROR; goto done; } } else if (objc == 4) { - CONST char *command; + const char *command; command = Tk_GetBinding(interp, canvasPtr->bindingTable, object, Tcl_GetString(objv[3])); if (command == NULL) { - CONST char *string; - - string = Tcl_GetStringResult(interp); + const char *string = Tcl_GetString(Tcl_GetObjResult(interp)); /* * Ignore missing binding errors. This is a special hack that @@ -794,11 +1058,10 @@ CanvasWidgetCmd( if (string[0] != '\0') { result = TCL_ERROR; goto done; - } else { - Tcl_ResetResult(interp); } + Tcl_ResetResult(interp); } else { - Tcl_SetResult(interp, (char *) command, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); } } else { Tk_GetAllBindings(interp, canvasPtr->bindingTable, object); @@ -808,20 +1071,20 @@ CanvasWidgetCmd( case CANV_CANVASX: { int x; double grid; - char buf[TCL_DOUBLE_SPACE]; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "screenx ?gridspacing?"); result = TCL_ERROR; goto done; } - if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, objv[2], &x) != TCL_OK) { + if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, objv[2], + &x) != TCL_OK) { result = TCL_ERROR; goto done; } if (objc == 4) { - if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[3], - &grid) != TCL_OK) { + if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, + objv[3], &grid) != TCL_OK) { result = TCL_ERROR; goto done; } @@ -829,21 +1092,20 @@ CanvasWidgetCmd( grid = 0.0; } x += canvasPtr->xOrigin; - Tcl_PrintDouble(interp, GridAlign((double) x, grid), buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(GridAlign((double)x,grid))); break; } case CANV_CANVASY: { int y; double grid; - char buf[TCL_DOUBLE_SPACE]; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "screeny ?gridspacing?"); result = TCL_ERROR; goto done; } - if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, objv[2], &y) != TCL_OK) { + if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, objv[2], + &y) != TCL_OK) { result = TCL_ERROR; goto done; } @@ -857,8 +1119,7 @@ CanvasWidgetCmd( grid = 0.0; } y += canvasPtr->yOrigin; - Tcl_PrintDouble(interp, GridAlign((double) y, grid), buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(GridAlign((double)y,grid))); break; } case CANV_CGET: @@ -891,78 +1152,152 @@ CanvasWidgetCmd( FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done); if (itemPtr != NULL) { if (objc != 3) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); - } - if (itemPtr->typePtr->coordProc != NULL) { - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - result = (*itemPtr->typePtr->coordProc)(interp, - (Tk_Canvas) canvasPtr, itemPtr, objc-3, objv+3); - } else { - CONST char **args = TkGetStringsFromObjs(objc-3, objv+3); - result = (*itemPtr->typePtr->coordProc)(interp, - (Tk_Canvas) canvasPtr, itemPtr, objc-3, - (Tcl_Obj **) args); - if (args != NULL) { - ckfree((char *) args); - } - } + EventuallyRedrawItem(canvasPtr, itemPtr); } + result = ItemCoords(canvasPtr, itemPtr, objc-3, objv+3); if (objc != 3) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); + } + } + break; + case CANV_IMOVE: { + double ignored; + Tcl_Obj *tmpObj; + + if (objc != 6) { + Tcl_WrongNumArgs(interp, 2, objv, "tagOrId index x y"); + result = TCL_ERROR; + goto done; + } + if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, + objv[4], &ignored) != TCL_OK + || Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, + objv[5], &ignored) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + + /* + * Make a temporary object here that we can reuse for all the + * modifications in the loop. + */ + + tmpObj = Tcl_NewListObj(2, objv+4); + + FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto doneImove) { + int index; + int x1,x2,y1,y2; + int dontRedraw1,dontRedraw2; + + /* + * The TK_MOVABLE_POINTS flag should only be set for types that + * support the same semantics of index, dChars and insert methods + * as lines and canvases. + */ + + if (itemPtr == NULL || + !(itemPtr->typePtr->alwaysRedraw & TK_MOVABLE_POINTS)) { + continue; + } + + result = ItemIndex(canvasPtr, itemPtr, objv[3], &index); + if (result != TCL_OK) { + break; } + + /* + * Redraw both item's old and new areas: it's possible that a + * replace could result in a new area larger than the old area. + * Except if the dCharsProc or insertProc sets the + * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done. + */ + + x1 = itemPtr->x1; y1 = itemPtr->y1; + x2 = itemPtr->x2; y2 = itemPtr->y2; + + itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW; + ItemDelChars(canvasPtr, itemPtr, index, index); + dontRedraw1=itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW; + + itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW; + ItemInsert(canvasPtr, itemPtr, index, tmpObj); + dontRedraw2=itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW; + + if (!(dontRedraw1 && dontRedraw2)) { + Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + x1, y1, x2, y2); + EventuallyRedrawItem(canvasPtr, itemPtr); + } + itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW; } + + doneImove: + Tcl_DecrRefCount(tmpObj); break; + } case CANV_CREATE: { Tk_ItemType *typePtr; Tk_ItemType *matchPtr = NULL; Tk_Item *itemPtr; - char buf[TCL_INTEGER_SPACE]; int isNew = 0; Tcl_HashEntry *entryPtr; - char *arg; - int length; + const char *arg; + size_t length; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "type coords ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "type coords ?arg ...?"); result = TCL_ERROR; goto done; } - arg = Tcl_GetStringFromObj(objv[2], &length); + arg = Tcl_GetString(objv[2]); + length = objv[2]->length; c = arg[0]; + + /* + * Lock because the list of types is a global resource that could be + * updated by another thread. That's fairly unlikely, but not + * impossible. + */ + Tcl_MutexLock(&typeListMutex); - for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr) { + for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr){ if ((c == typePtr->name[0]) - && (strncmp(arg, typePtr->name, (unsigned)length) == 0)) { + && (!strncmp(arg, typePtr->name, length))) { if (matchPtr != NULL) { Tcl_MutexUnlock(&typeListMutex); - badType: - Tcl_AppendResult(interp, - "unknown or ambiguous item type \"",arg,"\"",NULL); - result = TCL_ERROR; - goto done; + goto badType; } matchPtr = typePtr; } } + /* - * Can unlock now because we no longer look at the fields of - * the matched item type that are potentially modified by - * other threads. + * Can unlock now because we no longer look at the fields of the + * matched item type that are potentially modified by other threads. */ + Tcl_MutexUnlock(&typeListMutex); if (matchPtr == NULL) { - goto badType; + badType: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown or ambiguous item type \"%s\"", arg)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "CANVAS_ITEM_TYPE", arg, + NULL); + result = TCL_ERROR; + goto done; } if (objc < 4) { /* * Allow more specific error return. */ - Tcl_WrongNumArgs(interp, 3, objv, "coords ?arg arg ...?"); + + Tcl_WrongNumArgs(interp, 3, objv, "coords ?arg ...?"); result = TCL_ERROR; goto done; } + typePtr = matchPtr; - itemPtr = (Tk_Item *) ckalloc((unsigned) typePtr->itemSize); + itemPtr = ckalloc(typePtr->itemSize); itemPtr->id = canvasPtr->nextId; canvasPtr->nextId++; itemPtr->tagPtr = itemPtr->staticTagSpace; @@ -971,22 +1306,13 @@ CanvasWidgetCmd( itemPtr->typePtr = typePtr; itemPtr->state = TK_STATE_NULL; itemPtr->redraw_flags = 0; - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr, - itemPtr, objc-3, objv+3); - } else { - CONST char **args = TkGetStringsFromObjs(objc-3, objv+3); - result = (*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr, - itemPtr, objc-3, (Tcl_Obj **) args); - if (args != NULL) { - ckfree((char *) args); - } - } - if (result != TCL_OK) { - ckfree((char *) itemPtr); + + if (ItemCreate(canvasPtr, itemPtr, objc, objv) != TCL_OK) { + ckfree(itemPtr); result = TCL_ERROR; goto done; } + itemPtr->nextPtr = NULL; entryPtr = Tcl_CreateHashEntry(&canvasPtr->idTable, (char *) INT2PTR(itemPtr->id), &isNew); @@ -1001,10 +1327,9 @@ CanvasWidgetCmd( } canvasPtr->lastItemPtr = itemPtr; itemPtr->redraw_flags |= FORCE_REDRAW; - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); canvasPtr->flags |= REPICK_NEEDED; - sprintf(buf, "%d", itemPtr->id); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewIntObj(itemPtr->id)); break; } case CANV_DCHARS: { @@ -1021,28 +1346,12 @@ CanvasWidgetCmd( || (itemPtr->typePtr->dCharsProc == NULL)) { continue; } - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, (char *) objv[3], - &first); - } else { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, Tcl_GetString(objv[3]), - &first); - } + result = ItemIndex(canvasPtr, itemPtr, objv[3], &first); if (result != TCL_OK) { goto done; } if (objc == 5) { - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, (char *) objv[4], - &last); - } else { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, - Tcl_GetString(objv[4]), &last); - } + result = ItemIndex(canvasPtr, itemPtr, objv[4], &last); if (result != TCL_OK) { goto done; } @@ -1060,12 +1369,11 @@ CanvasWidgetCmd( x1 = itemPtr->x1; y1 = itemPtr->y1; x2 = itemPtr->x2; y2 = itemPtr->y2; itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW; - (*itemPtr->typePtr->dCharsProc)((Tk_Canvas) canvasPtr, - itemPtr, first, last); + ItemDelChars(canvasPtr, itemPtr, first, last); if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) { Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, x1, y1, x2, y2); - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); } itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW; } @@ -1077,15 +1385,13 @@ CanvasWidgetCmd( for (i = 2; i < objc; i++) { FOR_EVERY_CANVAS_ITEM_MATCHING(objv[i], &searchPtr, goto done) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); if (canvasPtr->bindingTable != NULL) { - Tk_DeleteAllBindings(canvasPtr->bindingTable, - (ClientData) itemPtr); + Tk_DeleteAllBindings(canvasPtr->bindingTable, itemPtr); } - (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr, - canvasPtr->display); + ItemDelete(canvasPtr, itemPtr); if (itemPtr->tagPtr != itemPtr->staticTagSpace) { - ckfree((char *) itemPtr->tagPtr); + ckfree(itemPtr->tagPtr); } entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) INT2PTR(itemPtr->id)); @@ -1105,7 +1411,7 @@ CanvasWidgetCmd( if (canvasPtr->lastItemPtr == itemPtr) { canvasPtr->lastItemPtr = itemPtr->prevPtr; } - ckfree((char *) itemPtr); + ckfree(itemPtr); if (itemPtr == canvasPtr->currentItemPtr) { canvasPtr->currentItemPtr = NULL; canvasPtr->flags |= REPICK_NEEDED; @@ -1154,16 +1460,11 @@ CanvasWidgetCmd( } case CANV_FIND: if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "searchCommand ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "searchCommand ?arg ...?"); result = TCL_ERROR; goto done; } -#ifdef USE_OLD_TAG_SEARCH - result = FindItems(interp, canvasPtr, objc, objv, NULL, 2); -#else /* USE_OLD_TAG_SEARCH */ - result = FindItems(interp, canvasPtr, objc, objv, NULL, 2, - &searchPtr); -#endif /* USE_OLD_TAG_SEARCH */ + result = FIND_ITEMS(NULL, 2); break; case CANV_FOCUS: if (objc > 3) { @@ -1174,15 +1475,12 @@ CanvasWidgetCmd( itemPtr = canvasPtr->textInfo.focusItemPtr; if (objc == 2) { if (itemPtr != NULL) { - char buf[TCL_INTEGER_SPACE]; - - sprintf(buf, "%d", itemPtr->id); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewIntObj(itemPtr->id)); } goto done; } - if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + if (canvasPtr->textInfo.gotFocus) { + EventuallyRedrawItem(canvasPtr, itemPtr); } if (Tcl_GetString(objv[2])[0] == 0) { canvasPtr->textInfo.focusItemPtr = NULL; @@ -1198,7 +1496,7 @@ CanvasWidgetCmd( } canvasPtr->textInfo.focusItemPtr = itemPtr; if (canvasPtr->textInfo.gotFocus) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); } break; case CANV_GETTAGS: @@ -1210,9 +1508,13 @@ CanvasWidgetCmd( FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done); if (itemPtr != NULL) { int i; + Tcl_Obj *resultObj = Tcl_NewObj(); + for (i = 0; i < itemPtr->numTags; i++) { - Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(itemPtr->tagPtr[i], -1)); } + Tcl_SetObjResult(interp, resultObj); } break; case CANV_ICURSOR: { @@ -1228,30 +1530,20 @@ CanvasWidgetCmd( || (itemPtr->typePtr->icursorProc == NULL)) { goto done; } - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, (char *) objv[3], - &index); - } else { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, Tcl_GetString(objv[3]), - &index); - } + result = ItemIndex(canvasPtr, itemPtr, objv[3], &index); if (result != TCL_OK) { goto done; } - (*itemPtr->typePtr->icursorProc)((Tk_Canvas) canvasPtr, itemPtr, - index); + ItemCursor(canvasPtr, itemPtr, index); if ((itemPtr == canvasPtr->textInfo.focusItemPtr) && (canvasPtr->textInfo.cursorOn)) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); } } break; } case CANV_INDEX: { int index; - char buf[TCL_INTEGER_SPACE]; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "tagOrId string"); @@ -1264,23 +1556,18 @@ CanvasWidgetCmd( } } if (itemPtr == NULL) { - Tcl_AppendResult(interp, "can't find an indexable item \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find an indexable item \"%s\"", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "INDEXABLE_ITEM", NULL); result = TCL_ERROR; goto done; } - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr, - itemPtr, (char *) objv[3], &index); - } else { - result = itemPtr->typePtr->indexProc(interp, (Tk_Canvas) canvasPtr, - itemPtr, Tcl_GetString(objv[3]), &index); - } + result = ItemIndex(canvasPtr, itemPtr, objv[3], &index); if (result != TCL_OK) { goto done; } - sprintf(buf, "%d", index); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); break; } case CANV_INSERT: { @@ -1297,15 +1584,7 @@ CanvasWidgetCmd( || (itemPtr->typePtr->insertProc == NULL)) { continue; } - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, (char *) objv[3], - &beforeThis); - } else { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, Tcl_GetString(objv[3]), - &beforeThis); - } + result = ItemIndex(canvasPtr, itemPtr, objv[3], &beforeThis); if (result != TCL_OK) { goto done; } @@ -1320,17 +1599,11 @@ CanvasWidgetCmd( x1 = itemPtr->x1; y1 = itemPtr->y1; x2 = itemPtr->x2; y2 = itemPtr->y2; itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW; - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr, - itemPtr, beforeThis, (char *) objv[4]); - } else { - (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr, - itemPtr, beforeThis, Tcl_GetString(objv[4])); - } + ItemInsert(canvasPtr, itemPtr, beforeThis, objv[4]); if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) { Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, x1, y1, x2, y2); - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); } itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW; } @@ -1344,42 +1617,24 @@ CanvasWidgetCmd( } FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done); if (itemPtr != NULL) { - result = Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin, - itemPtr->typePtr->configSpecs, (char *) itemPtr, - Tcl_GetString(objv[3]), 0); + result = ItemConfigValue(canvasPtr, itemPtr, objv[3]); } break; case CANV_ITEMCONFIGURE: if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "tagOrId ?option value ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "tagOrId ?-option value ...?"); result = TCL_ERROR; goto done; } FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) { if (objc == 3) { - result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin, - itemPtr->typePtr->configSpecs, (char *) itemPtr, - NULL, 0); + result = ItemConfigInfo(canvasPtr, itemPtr, NULL); } else if (objc == 4) { - result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin, - itemPtr->typePtr->configSpecs, (char *) itemPtr, - Tcl_GetString(objv[3]), 0); + result = ItemConfigInfo(canvasPtr, itemPtr, objv[3]); } else { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - result = (*itemPtr->typePtr->configProc)(interp, - (Tk_Canvas) canvasPtr, itemPtr, objc-3, objv+3, - TK_CONFIG_ARGV_ONLY); - } else { - CONST char **args = TkGetStringsFromObjs(objc-3, objv+3); - result = (*itemPtr->typePtr->configProc)(interp, - (Tk_Canvas) canvasPtr, itemPtr, objc-3, - (Tcl_Obj **) args, TK_CONFIG_ARGV_ONLY); - if (args != NULL) { - ckfree((char *) args); - } - } - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); + result = ItemConfigure(canvasPtr, itemPtr, objc-3, objv+3); + EventuallyRedrawItem(canvasPtr, itemPtr); canvasPtr->flags |= REPICK_NEEDED; } if ((result != TCL_OK) || (objc < 5)) { @@ -1405,18 +1660,16 @@ CanvasWidgetCmd( } else { FIRST_CANVAS_ITEM_MATCHING(objv[3], &searchPtr, goto done); if (itemPtr == NULL) { - Tcl_AppendResult(interp, "tag \"", Tcl_GetString(objv[3]), - "\" doesn't match any items", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tagOrId \"%s\" doesn't match any items", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM", NULL); result = TCL_ERROR; goto done; } itemPtr = itemPtr->prevPtr; } -#ifdef USE_OLD_TAG_SEARCH - RelinkItems(canvasPtr, objv[2], itemPtr); -#else /* USE_OLD_TAG_SEARCH */ - result = RelinkItems(canvasPtr, objv[2], itemPtr, &searchPtr); -#endif /* USE_OLD_TAG_SEARCH */ + RELINK_ITEMS(objv[2], itemPtr); break; } case CANV_MOVE: { @@ -1434,20 +1687,82 @@ CanvasWidgetCmd( goto done; } FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); - (void) (*itemPtr->typePtr->translateProc)((Tk_Canvas) canvasPtr, - itemPtr, xAmount, yAmount); - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); + ItemTranslate(canvasPtr, itemPtr, xAmount, yAmount); + EventuallyRedrawItem(canvasPtr, itemPtr); canvasPtr->flags |= REPICK_NEEDED; } break; } + case CANV_MOVETO: { + int xBlank, yBlank; + double xAmount, yAmount; + double oldX = 0, oldY = 0, newX, newY; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "tagOrId x y"); + result = TCL_ERROR; + goto done; + } + + xBlank = 0; + if (Tcl_GetString(objv[3])[0] == '\0') { + xBlank = 1; + } else if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, + objv[3], &newX) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + + yBlank = 0; + if (Tcl_GetString(objv[4])[0] == '\0') { + yBlank = 1; + } else if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, + objv[4], &newY) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + + FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done); + if (itemPtr != NULL) { + oldX = itemPtr->x1; + oldY = itemPtr->y1; + + /* + * Calculate the displacement. + */ + + if (xBlank) { + xAmount = 0; + } else { + xAmount = newX - oldX; + } + + if (yBlank) { + yAmount = 0; + } else { + yAmount = newY - oldY; + } + + /* + * Move the object(s). + */ + + FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) { + EventuallyRedrawItem(canvasPtr, itemPtr); + ItemTranslate(canvasPtr, itemPtr, xAmount, yAmount); + EventuallyRedrawItem(canvasPtr, itemPtr); + canvasPtr->flags |= REPICK_NEEDED; + } + } + break; + } case CANV_POSTSCRIPT: { - CONST char **args = TkGetStringsFromObjs(objc, objv); + const char **args = TkGetStringsFromObjs(objc, objv); result = TkCanvPostscriptCmd(canvasPtr, interp, objc, args); if (args != NULL) { - ckfree((char *) args); + ckfree(args); } break; } @@ -1472,24 +1787,70 @@ CanvasWidgetCmd( prevPtr = itemPtr; } if (prevPtr == NULL) { - Tcl_AppendResult(interp, "tagOrId \"", Tcl_GetString(objv[3]), - "\" doesn't match any items", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tagOrId \"%s\" doesn't match any items", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "ITEM", NULL); result = TCL_ERROR; goto done; } } -#ifdef USE_OLD_TAG_SEARCH - RelinkItems(canvasPtr, objv[2], prevPtr); -#else /* USE_OLD_TAG_SEARCH */ - result = RelinkItems(canvasPtr, objv[2], prevPtr, &searchPtr); -#endif /* USE_OLD_TAG_SEARCH */ + RELINK_ITEMS(objv[2], prevPtr); + break; + } + case CANV_RCHARS: { + int first, last; + int x1,x2,y1,y2; + + if (objc != 6) { + Tcl_WrongNumArgs(interp, 2, objv, "tagOrId first last string"); + result = TCL_ERROR; + goto done; + } + FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) { + if ((itemPtr->typePtr->indexProc == NULL) + || (itemPtr->typePtr->dCharsProc == NULL) + || (itemPtr->typePtr->insertProc == NULL)) { + continue; + } + result = ItemIndex(canvasPtr, itemPtr, objv[3], &first); + if (result != TCL_OK) { + goto done; + } + result = ItemIndex(canvasPtr, itemPtr, objv[4], &last); + if (result != TCL_OK) { + goto done; + } + + /* + * Redraw both item's old and new areas: it's possible that a + * replace could result in a new area larger than the old area. + * Except if the dCharsProc or insertProc sets the + * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done. + */ + + x1 = itemPtr->x1; y1 = itemPtr->y1; + x2 = itemPtr->x2; y2 = itemPtr->y2; + itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW; + + ItemDelChars(canvasPtr, itemPtr, first, last); + ItemInsert(canvasPtr, itemPtr, first, objv[5]); + + if (!(itemPtr->redraw_flags & TK_ITEM_DONT_REDRAW)) { + Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, + x1, y1, x2, y2); + EventuallyRedrawItem(canvasPtr, itemPtr); + } + itemPtr->redraw_flags &= ~TK_ITEM_DONT_REDRAW; + } break; } case CANV_SCALE: { double xOrigin, yOrigin, xScale, yScale; if (objc != 7) { - Tcl_WrongNumArgs(interp, 2, objv, "tagOrId xOrigin yOrigin xScale yScale"); + Tcl_WrongNumArgs(interp, 2, objv, + "tagOrId xOrigin yOrigin xScale yScale"); result = TCL_ERROR; goto done; } @@ -1497,28 +1858,29 @@ CanvasWidgetCmd( objv[3], &xOrigin) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[4], &yOrigin) != TCL_OK) - || (Tcl_GetDoubleFromObj(interp, objv[5], &xScale) != TCL_OK) - || (Tcl_GetDoubleFromObj(interp, objv[6], &yScale) != TCL_OK)) { + || (Tcl_GetDoubleFromObj(interp, objv[5], &xScale)!=TCL_OK) + || (Tcl_GetDoubleFromObj(interp, objv[6], &yScale)!=TCL_OK)) { result = TCL_ERROR; goto done; } if ((xScale == 0.0) || (yScale == 0.0)) { - Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "scale factor cannot be zero", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "BAD_SCALE", NULL); result = TCL_ERROR; goto done; } FOR_EVERY_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); - (void) (*itemPtr->typePtr->scaleProc)((Tk_Canvas) canvasPtr, - itemPtr, xOrigin, yOrigin, xScale, yScale); - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); + ItemScale(canvasPtr, itemPtr, xOrigin, yOrigin, xScale, yScale); + EventuallyRedrawItem(canvasPtr, itemPtr); canvasPtr->flags |= REPICK_NEEDED; } break; } case CANV_SCAN: { int x, y, gain = 10; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "mark", "dragto", NULL }; @@ -1562,7 +1924,7 @@ CanvasWidgetCmd( } case CANV_SELECT: { int index, optionindex; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "adjust", "clear", "from", "item", "to", NULL }; enum options { @@ -1582,23 +1944,17 @@ CanvasWidgetCmd( } } if (itemPtr == NULL) { - Tcl_AppendResult(interp, - "can't find an indexable and selectable item \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't find an indexable and selectable item \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SELECTABLE_ITEM", + NULL); result = TCL_ERROR; goto done; } } if (objc == 5) { - if (itemPtr->typePtr->alwaysRedraw & TK_CONFIG_OBJS) { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, (char *) objv[4], - &index); - } else { - result = itemPtr->typePtr->indexProc(interp, - (Tk_Canvas) canvasPtr, itemPtr, Tcl_GetString(objv[4]), - &index); - } + result = ItemIndex(canvasPtr, itemPtr, objv[4], &index); if (result != TCL_OK) { goto done; } @@ -1633,12 +1989,8 @@ CanvasWidgetCmd( result = TCL_ERROR; goto done; } - if (canvasPtr->textInfo.selItemPtr != NULL) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, - canvasPtr->textInfo.selItemPtr); - canvasPtr->textInfo.selItemPtr = NULL; - } - goto done; + EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.selItemPtr); + canvasPtr->textInfo.selItemPtr = NULL; break; case CANV_FROM: if (objc != 5) { @@ -1679,14 +2031,16 @@ CanvasWidgetCmd( } FIRST_CANVAS_ITEM_MATCHING(objv[2], &searchPtr, goto done); if (itemPtr != NULL) { - Tcl_SetResult(interp, itemPtr->typePtr->name, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(itemPtr->typePtr->name, -1)); } break; case CANV_XVIEW: { int count, type; - int newX = 0; /* Initialization needed only to prevent - * gcc warnings. */ + int newX = 0; /* Initialization needed only to prevent gcc + * warnings. */ double fraction; + const char **args; if (objc == 2) { Tcl_SetObjResult(interp, ScrollFractions( @@ -1694,45 +2048,45 @@ CanvasWidgetCmd( canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset, canvasPtr->scrollX1, canvasPtr->scrollX2)); - } else { - CONST char **args = TkGetStringsFromObjs(objc, objv); - type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); - if (args != NULL) { - ckfree((char *) args); - } - switch (type) { - case TK_SCROLL_ERROR: - result = TCL_ERROR; - goto done; - case TK_SCROLL_MOVETO: - newX = canvasPtr->scrollX1 - canvasPtr->inset - + (int) (fraction * (canvasPtr->scrollX2 - - canvasPtr->scrollX1) + 0.5); - break; - case TK_SCROLL_PAGES: - newX = (int) (canvasPtr->xOrigin + count * .9 + break; + } + + args = TkGetStringsFromObjs(objc, objv); + type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); + if (args != NULL) { + ckfree(args); + } + switch (type) { + case TK_SCROLL_ERROR: + result = TCL_ERROR; + goto done; + case TK_SCROLL_MOVETO: + newX = canvasPtr->scrollX1 - canvasPtr->inset + + (int) (fraction * (canvasPtr->scrollX2 + - canvasPtr->scrollX1) + 0.5); + break; + case TK_SCROLL_PAGES: + newX = (int) (canvasPtr->xOrigin + count * .9 + * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset)); + break; + case TK_SCROLL_UNITS: + if (canvasPtr->xScrollIncrement > 0) { + newX = canvasPtr->xOrigin + count*canvasPtr->xScrollIncrement; + } else { + newX = (int) (canvasPtr->xOrigin + count * .1 * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset)); - break; - case TK_SCROLL_UNITS: - if (canvasPtr->xScrollIncrement > 0) { - newX = canvasPtr->xOrigin - + count*canvasPtr->xScrollIncrement; - } else { - newX = (int) (canvasPtr->xOrigin + count * .1 - * (Tk_Width(canvasPtr->tkwin) - - 2*canvasPtr->inset)); - } - break; } - CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin); + break; } + CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin); break; } case CANV_YVIEW: { int count, type; - int newY = 0; /* Initialization needed only to prevent - * gcc warnings. */ + int newY = 0; /* Initialization needed only to prevent gcc + * warnings. */ double fraction; + const char **args; if (objc == 2) { Tcl_SetObjResult(interp, ScrollFractions( @@ -1740,39 +2094,36 @@ CanvasWidgetCmd( canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset, canvasPtr->scrollY1, canvasPtr->scrollY2)); - } else { - CONST char **args = TkGetStringsFromObjs(objc, objv); - type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); - if (args != NULL) { - ckfree((char *) args); - } - switch (type) { - case TK_SCROLL_ERROR: - result = TCL_ERROR; - goto done; - case TK_SCROLL_MOVETO: - newY = canvasPtr->scrollY1 - canvasPtr->inset - + (int) (fraction*(canvasPtr->scrollY2 - - canvasPtr->scrollY1) + 0.5); - break; - case TK_SCROLL_PAGES: - newY = (int) (canvasPtr->yOrigin + count * .9 - * (Tk_Height(canvasPtr->tkwin) - - 2*canvasPtr->inset)); - break; - case TK_SCROLL_UNITS: - if (canvasPtr->yScrollIncrement > 0) { - newY = canvasPtr->yOrigin - + count*canvasPtr->yScrollIncrement; - } else { - newY = (int) (canvasPtr->yOrigin + count * .1 - * (Tk_Height(canvasPtr->tkwin) - - 2*canvasPtr->inset)); - } - break; + break; + } + + args = TkGetStringsFromObjs(objc, objv); + type = Tk_GetScrollInfo(interp, objc, args, &fraction, &count); + if (args != NULL) { + ckfree(args); + } + switch (type) { + case TK_SCROLL_ERROR: + result = TCL_ERROR; + goto done; + case TK_SCROLL_MOVETO: + newY = canvasPtr->scrollY1 - canvasPtr->inset + (int) ( + fraction*(canvasPtr->scrollY2-canvasPtr->scrollY1) + 0.5); + break; + case TK_SCROLL_PAGES: + newY = (int) (canvasPtr->yOrigin + count * .9 + * (Tk_Height(canvasPtr->tkwin) - 2*canvasPtr->inset)); + break; + case TK_SCROLL_UNITS: + if (canvasPtr->yScrollIncrement > 0) { + newY = canvasPtr->yOrigin + count*canvasPtr->yScrollIncrement; + } else { + newY = (int) (canvasPtr->yOrigin + count * .1 + * (Tk_Height(canvasPtr->tkwin) - 2*canvasPtr->inset)); } - CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY); + break; } + CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY); break; } } @@ -1781,7 +2132,7 @@ CanvasWidgetCmd( #ifndef USE_OLD_TAG_SEARCH TagSearchDestroy(searchPtr); #endif /* not USE_OLD_TAG_SEARCH */ - Tcl_Release((ClientData) canvasPtr); + Tcl_Release(canvasPtr); return result; } @@ -1820,12 +2171,11 @@ DestroyCanvas( for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = canvasPtr->firstItemPtr) { canvasPtr->firstItemPtr = itemPtr->nextPtr; - (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr, - canvasPtr->display); + ItemDelete(canvasPtr, itemPtr); if (itemPtr->tagPtr != itemPtr->staticTagSpace) { - ckfree((char *) itemPtr->tagPtr); + ckfree(itemPtr->tagPtr); } - ckfree((char *) itemPtr); + ckfree(itemPtr); } /* @@ -1851,7 +2201,7 @@ DestroyCanvas( } Tk_FreeOptions(configSpecs, (char *) canvasPtr, canvasPtr->display, 0); canvasPtr->tkwin = NULL; - ckfree((char *) canvasPtr); + ckfree(canvasPtr); } /* @@ -1880,7 +2230,7 @@ ConfigureCanvas( TkCanvas *canvasPtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in objv. */ - Tcl_Obj *CONST objv[], /* Argument objects. */ + Tcl_Obj *const objv[], /* Argument objects. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { XGCValues gcValues; @@ -1888,7 +2238,7 @@ ConfigureCanvas( Tk_State old_canvas_state=canvasPtr->canvas_state; if (Tk_ConfigureWidget(interp, canvasPtr->tkwin, configSpecs, - objc, (CONST char **) objv, (char *) canvasPtr, + objc, (const char **) objv, (char *) canvasPtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } @@ -1936,7 +2286,7 @@ ConfigureCanvas( } } - /* + /* * Reset the desired dimensions for the window. */ @@ -1962,18 +2312,19 @@ ConfigureCanvas( canvasPtr->scrollY2 = 0; if (canvasPtr->regionString != NULL) { int argc2; - CONST char **argv2; + const char **argv2; if (Tcl_SplitList(canvasPtr->interp, canvasPtr->regionString, &argc2, &argv2) != TCL_OK) { return TCL_ERROR; } if (argc2 != 4) { - Tcl_AppendResult(interp, "bad scrollRegion \"", - canvasPtr->regionString, "\"", NULL); - badRegion: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scrollRegion \"%s\"", canvasPtr->regionString)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SCROLL_REGION", NULL); + badRegion: ckfree(canvasPtr->regionString); - ckfree((char *) argv2); + ckfree(argv2); canvasPtr->regionString = NULL; return TCL_ERROR; } @@ -1987,7 +2338,7 @@ ConfigureCanvas( argv2[3], &canvasPtr->scrollY2) != TCL_OK)) { goto badRegion; } - ckfree((char *) argv2); + ckfree(argv2); } flags = canvasPtr->tsoffset.flags; @@ -2021,7 +2372,7 @@ ConfigureCanvas( } /* - *--------------------------------------------------------------------------- + *---------------------------------------------------------------------- * * CanvasWorldChanged -- * @@ -2037,24 +2388,19 @@ ConfigureCanvas( * side effect of causing all the items to recompute their geometry and * to be redisplayed. * - *--------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void CanvasWorldChanged( ClientData instanceData) /* Information about widget. */ { - TkCanvas *canvasPtr; + TkCanvas *canvasPtr = instanceData; Tk_Item *itemPtr; - int result; - canvasPtr = (TkCanvas *) instanceData; itemPtr = canvasPtr->firstItemPtr; for ( ; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { - result = (*itemPtr->typePtr->configProc)(canvasPtr->interp, - (Tk_Canvas) canvasPtr, itemPtr, 0, NULL, - TK_CONFIG_ARGV_ONLY); - if (result != TCL_OK) { + if (ItemConfigure(canvasPtr, itemPtr, 0, NULL) != TCL_OK) { Tcl_ResetResult(canvasPtr->interp); } } @@ -2066,7 +2412,7 @@ CanvasWorldChanged( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DisplayCanvas -- * @@ -2080,14 +2426,14 @@ CanvasWorldChanged( * Side effects: * Information appears on the screen. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void DisplayCanvas( ClientData clientData) /* Information about widget. */ { - TkCanvas *canvasPtr = (TkCanvas *) clientData; + TkCanvas *canvasPtr = clientData; Tk_Window tkwin = canvasPtr->tkwin; Tk_Item *itemPtr; Pixmap pixmap; @@ -2120,11 +2466,11 @@ DisplayCanvas( */ while (canvasPtr->flags & REPICK_NEEDED) { - Tcl_Preserve((ClientData) canvasPtr); + Tcl_Preserve(canvasPtr); canvasPtr->flags &= ~REPICK_NEEDED; PickCurrentItem(canvasPtr, &canvasPtr->pickEvent); tkwin = canvasPtr->tkwin; - Tcl_Release((ClientData) canvasPtr); + Tcl_Release(canvasPtr); if (tkwin == NULL) { return; } @@ -2137,13 +2483,14 @@ DisplayCanvas( */ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; - itemPtr = itemPtr->nextPtr) { + itemPtr = itemPtr->nextPtr) { if (itemPtr->redraw_flags & FORCE_REDRAW) { itemPtr->redraw_flags &= ~FORCE_REDRAW; - EventuallyRedrawItem((Tk_Canvas)canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); itemPtr->redraw_flags &= ~FORCE_REDRAW; } } + /* * Compute the intersection between the area that needs redrawing and the * area that's visible on the screen. @@ -2241,7 +2588,7 @@ DisplayCanvas( || (itemPtr->y1 >= screenY2) || (itemPtr->x2 < screenX1) || (itemPtr->y2 < screenY1)) { - if (!(itemPtr->typePtr->alwaysRedraw & 1) + if (!AlwaysRedraw(itemPtr) || (itemPtr->x1 >= canvasPtr->redrawX2) || (itemPtr->y1 >= canvasPtr->redrawY2) || (itemPtr->x2 < canvasPtr->redrawX1) @@ -2250,12 +2597,11 @@ DisplayCanvas( } } if (itemPtr->state == TK_STATE_HIDDEN || - (itemPtr->state == TK_STATE_NULL && - canvasPtr->canvas_state == TK_STATE_HIDDEN)) { + (itemPtr->state == TK_STATE_NULL && + canvasPtr->canvas_state == TK_STATE_HIDDEN)) { continue; } - (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, itemPtr, - canvasPtr->display, pixmap, screenX1, screenY1, width, + ItemDisplay(canvasPtr, itemPtr, pixmap, screenX1, screenY1, width, height); } @@ -2319,7 +2665,7 @@ DisplayCanvas( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * CanvasEventProc -- * @@ -2330,10 +2676,10 @@ DisplayCanvas( * None. * * Side effects: - * When the window gets deleted, internal structures get cleaned up. - * When it gets exposed, it is redisplayed. + * When the window gets deleted, internal structures get cleaned up. When + * it gets exposed, it is redisplayed. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void @@ -2341,7 +2687,7 @@ CanvasEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - TkCanvas *canvasPtr = (TkCanvas *) clientData; + TkCanvas *canvasPtr = clientData; if (eventPtr->type == Expose) { int x, y; @@ -2366,10 +2712,9 @@ CanvasEventProc( canvasPtr->widgetCmd); } if (canvasPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr); + Tcl_CancelIdleCall(DisplayCanvas, canvasPtr); } - Tcl_EventuallyFree((ClientData) canvasPtr, - (Tcl_FreeProc *) DestroyCanvas); + Tcl_EventuallyFree(canvasPtr, (Tcl_FreeProc *) DestroyCanvas); } else if (eventPtr->type == ConfigureNotify) { canvasPtr->flags |= UPDATE_SCROLLBARS; @@ -2403,9 +2748,8 @@ CanvasEventProc( for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { - if (itemPtr->typePtr->alwaysRedraw & 1) { - (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, - itemPtr, canvasPtr->display, None, 0, 0, 0, 0); + if (AlwaysRedraw(itemPtr)) { + ItemDisplay(canvasPtr, itemPtr, None, 0, 0, 0, 0); } } } @@ -2433,7 +2777,7 @@ static void CanvasCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - TkCanvas *canvasPtr = (TkCanvas *) clientData; + TkCanvas *canvasPtr = clientData; Tk_Window tkwin = canvasPtr->tkwin; /* @@ -2450,7 +2794,7 @@ CanvasCmdDeletedProc( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Tk_CanvasEventuallyRedraw -- * @@ -2463,7 +2807,7 @@ CanvasCmdDeletedProc( * Side effects: * The screen will eventually be refreshed. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ void @@ -2474,7 +2818,7 @@ Tk_CanvasEventuallyRedraw( int x2, int y2) /* Lower right corner of area to redraw. * Pixels on edge are not redrawn. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; + TkCanvas *canvasPtr = Canvas(canvas); /* * If tkwin is NULL, the canvas has been destroyed, so we can't really @@ -2512,13 +2856,13 @@ Tk_CanvasEventuallyRedraw( canvasPtr->flags |= BBOX_NOT_EMPTY; } if (!(canvasPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr); + Tcl_DoWhenIdle(DisplayCanvas, canvasPtr); canvasPtr->flags |= REDRAW_PENDING; } } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * EventuallyRedrawItem -- * @@ -2531,21 +2875,24 @@ Tk_CanvasEventuallyRedraw( * Side effects: * The screen will eventually be refreshed. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void EventuallyRedrawItem( - Tk_Canvas canvas, /* Information about widget. */ - Tk_Item *itemPtr) /* Item to be redrawn. */ + TkCanvas *canvasPtr, /* Information about widget. */ + Tk_Item *itemPtr) /* Item to be redrawn. May be NULL, in which + * case nothing happens. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; + if (itemPtr == NULL) { + return; + } if ((itemPtr->x1 >= itemPtr->x2) || (itemPtr->y1 >= itemPtr->y2) || (itemPtr->x2 < canvasPtr->xOrigin) || (itemPtr->y2 < canvasPtr->yOrigin) || - (itemPtr->x1 >= canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)) || - (itemPtr->y1 >= canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin))) { - if (!(itemPtr->typePtr->alwaysRedraw & 1)) { + (itemPtr->x1 >= canvasPtr->xOrigin+Tk_Width(canvasPtr->tkwin)) || + (itemPtr->y1 >= canvasPtr->yOrigin+Tk_Height(canvasPtr->tkwin))) { + if (!AlwaysRedraw(itemPtr)) { return; } } @@ -2573,13 +2920,13 @@ EventuallyRedrawItem( itemPtr->redraw_flags |= FORCE_REDRAW; } if (!(canvasPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr); + Tcl_DoWhenIdle(DisplayCanvas, canvasPtr); canvasPtr->flags |= REDRAW_PENDING; } } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Tk_CreateItemType -- * @@ -2595,7 +2942,7 @@ EventuallyRedrawItem( * commands). If there was already a type with the same name as in * typePtr, it is replaced with the new type. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ void @@ -2735,11 +3082,8 @@ StartTagSearch( Tk_Uid uid; char *tag = Tcl_GetString(tagObj); int count; - TkWindow *tkwin; - TkDisplay *dispPtr; - - tkwin = (TkWindow *) canvasPtr->tkwin; - dispPtr = tkwin->dispPtr; + TkWindow *tkwin = (TkWindow *) canvasPtr->tkwin; + TkDisplay *dispPtr = tkwin->dispPtr; /* * Initialize the search. @@ -2767,9 +3111,9 @@ StartTagSearch( if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL) || (lastPtr->nextPtr != itemPtr)) { dispPtr->numSlowSearches++; - entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id); + entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char*) id); if (entryPtr != NULL) { - itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr); + itemPtr = Tcl_GetHashValue(entryPtr); lastPtr = itemPtr->prevPtr; } else { lastPtr = itemPtr = NULL; @@ -2925,7 +3269,7 @@ NextItem( static SearchUids * GetStaticUids(void) { - SearchUids *searchUids = (SearchUids *) + SearchUids *searchUids = Tcl_GetThreadData(&dataKey, sizeof(SearchUids)); if (searchUids->allUid == NULL) { @@ -2961,10 +3305,10 @@ static void TagSearchExprInit( TagSearchExpr **exprPtrPtr) { - TagSearchExpr* expr = *exprPtrPtr; + TagSearchExpr *expr = *exprPtrPtr; - if (! expr) { - expr = (TagSearchExpr *) ckalloc(sizeof(TagSearchExpr)); + if (expr == NULL) { + expr = ckalloc(sizeof(TagSearchExpr)); expr->allocated = 0; expr->uids = NULL; expr->next = NULL; @@ -2993,11 +3337,11 @@ static void TagSearchExprDestroy( TagSearchExpr *expr) { - if (expr) { + if (expr != NULL) { if (expr->uids) { - ckfree((char *)expr->uids); + ckfree(expr->uids); } - ckfree((char *)expr); + ckfree(expr); } } @@ -3030,7 +3374,7 @@ TagSearchScan( TagSearch **searchPtrPtr) /* Record describing tag search; will be * initialized here. */ { - char *tag = Tcl_GetString(tagObj); + const char *tag = Tcl_GetString(tagObj); int i; TagSearch *searchPtr; @@ -3038,14 +3382,14 @@ TagSearchScan( * Initialize the search. */ - if (*searchPtrPtr) { + if (*searchPtrPtr != NULL) { searchPtr = *searchPtrPtr; } else { /* * Allocate primary search struct on first call. */ - *searchPtrPtr = searchPtr = (TagSearch *) ckalloc(sizeof(TagSearch)); + *searchPtrPtr = searchPtr = ckalloc(sizeof(TagSearch)); searchPtr->expr = NULL; /* @@ -3055,7 +3399,7 @@ TagSearchScan( searchPtr->rewritebufferAllocated = 100; searchPtr->rewritebuffer = ckalloc(searchPtr->rewritebufferAllocated); } - TagSearchExprInit(&(searchPtr->expr)); + TagSearchExprInit(&searchPtr->expr); /* * How long is the tagOrId? @@ -3067,7 +3411,7 @@ TagSearchScan( * Make sure there is enough buffer to hold rewritten tags. */ - if ((unsigned int)searchPtr->stringLength >= + if ((unsigned) searchPtr->stringLength >= searchPtr->rewritebufferAllocated) { searchPtr->rewritebufferAllocated = searchPtr->stringLength + 100; searchPtr->rewritebuffer = @@ -3105,6 +3449,7 @@ TagSearchScan( * kept forever, but this should be thought of as a cache rather than as a * memory leak. */ + searchPtr->expr->uid = Tk_GetUid(tag); /* @@ -3116,8 +3461,8 @@ TagSearchScan( } /* - * Pre-scan tag for at least one unquoted "&&" "||" "^" "!" - * if not found then use string as simple tag + * Pre-scan tag for at least one unquoted "&&" "||" "^" "!"; if not found + * then use string as simple tag. */ for (i = 0; i < searchPtr->stringLength ; i++) { @@ -3194,12 +3539,12 @@ TagSearchScan( static void TagSearchDestroy( - TagSearch *searchPtr) /* Record describing tag search */ + TagSearch *searchPtr) /* Record describing tag search. */ { if (searchPtr) { TagSearchExprDestroy(searchPtr->expr); - ckfree((char *)searchPtr->rewritebuffer); - ckfree((char *)searchPtr); + ckfree(searchPtr->rewritebuffer); + ckfree(searchPtr); } } @@ -3225,15 +3570,15 @@ TagSearchDestroy( static int TagSearchScanExpr( Tcl_Interp *interp, /* Current interpreter. */ - TagSearch *searchPtr, /* Search data */ - TagSearchExpr *expr) /* compiled expression result */ + TagSearch *searchPtr, /* Search data. */ + TagSearchExpr *expr) /* Compiled expression result. */ { int looking_for_tag; /* When true, scanner expects next char(s) to - * be a tag, else operand expected */ - int found_tag; /* One or more tags found */ - int found_endquote; /* For quoted tag string parsing */ - int negate_result; /* Pending negation of next tag value */ - char *tag; /* Tag from tag expression string */ + * be a tag, else operand expected. */ + int found_tag; /* One or more tags found. */ + int found_endquote; /* For quoted tag string parsing. */ + int negate_result; /* Pending negation of next tag value. */ + char *tag; /* Tag from tag expression string. */ char c; SearchUids *searchUids; /* Collection of uids for basic search * expression terms. */ @@ -3252,36 +3597,34 @@ TagSearchScanExpr( if (expr->index >= expr->allocated-1) { expr->allocated += 15; if (expr->uids) { - expr->uids = (Tk_Uid *) - ckrealloc((char *)(expr->uids), - (expr->allocated)*sizeof(Tk_Uid)); + expr->uids = ckrealloc(expr->uids, + expr->allocated * sizeof(Tk_Uid)); } else { - expr->uids = (Tk_Uid *) - ckalloc((expr->allocated)*sizeof(Tk_Uid)); + expr->uids = ckalloc(expr->allocated * sizeof(Tk_Uid)); } } if (looking_for_tag) { - switch (c) { - case ' ': /* ignore unquoted whitespace */ + case ' ': /* Ignore unquoted whitespace */ case '\t': case '\n': case '\r': break; - case '!': /* negate next tag or subexpr */ + case '!': /* Negate next tag or subexpr */ if (looking_for_tag > 1) { - Tcl_AppendResult(interp, - "Too many '!' in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "too many '!' in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "COMPLEXITY", NULL); return TCL_ERROR; } looking_for_tag++; negate_result = 1; break; - case '(': /* scan (negated) subexpr recursively */ + case '(': /* Scan (negated) subexpr recursively */ if (negate_result) { expr->uids[expr->index++] = searchUids->negparenUid; negate_result = 0; @@ -3300,7 +3643,7 @@ TagSearchScanExpr( found_tag = 1; break; - case '"': /* quoted tag string */ + case '"': /* Quoted tag string */ if (negate_result) { expr->uids[expr->index++] = searchUids->negtagvalUid; negate_result = 0; @@ -3320,16 +3663,19 @@ TagSearchScanExpr( } *tag++ = c; } - if (! found_endquote) { - Tcl_AppendResult(interp, - "Missing endquote in tag search expression", - NULL); + if (!found_endquote) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing endquote in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "ENDQUOTE", NULL); return TCL_ERROR; } - if (! (tag - searchPtr->rewritebuffer)) { - Tcl_AppendResult(interp, - "Null quoted tag string in tag search expression", - NULL); + if (!(tag - searchPtr->rewritebuffer)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "null quoted tag string in tag search expression", + -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "EMPTY", NULL); return TCL_ERROR; } *tag++ = '\0'; @@ -3339,16 +3685,17 @@ TagSearchScanExpr( found_tag = 1; break; - case '&': /* illegal chars when looking for tag */ + case '&': /* Illegal chars when looking for tag */ case '|': case '^': case ')': - Tcl_AppendResult(interp, - "Unexpected operator in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected operator in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "UNEXPECTED", NULL); return TCL_ERROR; - default: /* unquoted tag string */ + default: /* Unquoted tag string */ if (negate_result) { expr->uids[expr->index++] = searchUids->negtagvalUid; negate_result = 0; @@ -3395,50 +3742,54 @@ TagSearchScanExpr( found_tag = 1; } - } else { /* ! looking_for_tag */ + } else { /* ! looking_for_tag */ switch (c) { - case ' ': /* ignore whitespace */ + case ' ': /* Ignore whitespace */ case '\t': case '\n': case '\r': break; - case '&': /* AND operator */ + case '&': /* AND operator */ c = searchPtr->string[searchPtr->stringIndex++]; if (c != '&') { - Tcl_AppendResult(interp, - "Singleton '&' in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "singleton '&' in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "INCOMPLETE_OP", NULL); return TCL_ERROR; } expr->uids[expr->index++] = searchUids->andUid; looking_for_tag = 1; break; - case '|': /* OR operator */ + case '|': /* OR operator */ c = searchPtr->string[searchPtr->stringIndex++]; if (c != '|') { - Tcl_AppendResult(interp, - "Singleton '|' in tag search expression", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "singleton '|' in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", + "INCOMPLETE_OP", NULL); return TCL_ERROR; } expr->uids[expr->index++] = searchUids->orUid; looking_for_tag = 1; break; - case '^' : /* XOR operator */ + case '^': /* XOR operator */ expr->uids[expr->index++] = searchUids->xorUid; looking_for_tag = 1; break; - case ')' : /* end subexpression */ + case ')': /* End subexpression */ expr->uids[expr->index++] = searchUids->endparenUid; goto breakwhile; - default: /* syntax error */ - Tcl_AppendResult(interp, - "Invalid boolean operator in tag search expression", + default: /* syntax error */ + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid boolean operator in tag search expression", + -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "BAD_OP", NULL); return TCL_ERROR; } @@ -3446,10 +3797,12 @@ TagSearchScanExpr( } breakwhile: - if (found_tag && ! looking_for_tag) { + if (found_tag && !looking_for_tag) { return TCL_OK; } - Tcl_AppendResult(interp, "Missing tag in tag search expression", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing tag in tag search expression", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "SEARCH", "NO_TAG", NULL); return TCL_ERROR; } @@ -3486,7 +3839,7 @@ TagSearchEvalExpr( * expression terms. */ searchUids = GetStaticUids(); - result = 0; /* just to keep the compiler quiet */ + result = 0; /* Just to keep the compiler quiet. */ negate_result = 0; looking_for_tag = 1; @@ -3521,7 +3874,7 @@ TagSearchEvalExpr( result = 0; /* - * set result 1 if tag is found in item's tags + * set result 1 if tag is found in item's tags. */ for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags; @@ -3534,30 +3887,26 @@ TagSearchEvalExpr( } else if (uid == searchUids->parenUid) { /* - * Evaluate subexpressions with recursion + * Evaluate subexpressions with recursion. */ result = TagSearchEvalExpr(expr, itemPtr); } else if (uid == searchUids->negparenUid) { - negate_result = ! negate_result; + negate_result = !negate_result; /* - * Evaluate subexpressions with recursion + * Evaluate subexpressions with recursion. */ result = TagSearchEvalExpr(expr, itemPtr); -/* - * } else { - * assert(0); - */ } if (negate_result) { result = ! result; negate_result = 0; } looking_for_tag = 0; - } else { /* ! looking_for_tag */ + } else { /* ! looking_for_tag */ if (((uid == searchUids->andUid) && (!result)) || ((uid == searchUids->orUid) && result)) { /* @@ -3599,16 +3948,12 @@ TagSearchEvalExpr( } else if (uid == searchUids->endparenUid) { return result; -/* - * } else { - * assert(0); - */ } looking_for_tag = 1; } } /* - * assert(! looking_for_tag); + * assert(!looking_for_tag); */ return result; } @@ -3667,7 +4012,7 @@ TagSearchFirst( entryPtr = Tcl_FindHashEntry(&searchPtr->canvasPtr->idTable, (char *) INT2PTR(searchPtr->id)); if (entryPtr != NULL) { - itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr); + itemPtr = Tcl_GetHashValue(entryPtr); lastPtr = itemPtr->prevPtr; } else { lastPtr = itemPtr = NULL; @@ -3697,7 +4042,7 @@ TagSearchFirst( uid = searchPtr->expr->uid; for (lastPtr = NULL, itemPtr = searchPtr->canvasPtr->firstItemPtr; - itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) { + itemPtr != NULL; lastPtr=itemPtr, itemPtr=itemPtr->nextPtr) { for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags; count > 0; tagPtr++, count--) { if (*tagPtr == uid) { @@ -3708,7 +4053,6 @@ TagSearchFirst( } } } else { - /* * None of the above. Search for an item matching the tag expression. */ @@ -3839,23 +4183,23 @@ TagSearchNext( * DoItem -- * * This is a utility function called by FindItems. It either adds - * itemPtr's id to the result forming in interp, or it adds a new tag to + * itemPtr's id to the list being constructed, or it adds a new tag to * itemPtr, depending on the value of tag. * * Results: * None. * * Side effects: - * If tag is NULL then itemPtr's id is added as a list element to the - * interp's result; otherwise tag is added to itemPtr's list of tags. + * If tag is NULL then itemPtr's id is added as an element to the + * supplied object; otherwise tag is added to itemPtr's list of tags. * *-------------------------------------------------------------- */ static void DoItem( - Tcl_Interp *interp, /* Interpreter in which to (possibly) record - * item id. */ + Tcl_Obj *accumObj, /* Object in which to (possibly) record item + * id. */ Tk_Item *itemPtr, /* Item to (possibly) modify. */ Tk_Uid tag) /* Tag to add to those already present for * item, or NULL. */ @@ -3868,10 +4212,7 @@ DoItem( */ if (tag == NULL) { - char msg[TCL_INTEGER_SPACE]; - - sprintf(msg, "%d", itemPtr->id); - Tcl_AppendElement(interp, msg); + Tcl_ListObjAppendElement(NULL, accumObj, Tcl_NewIntObj(itemPtr->id)); return; } @@ -3890,12 +4231,11 @@ DoItem( Tk_Uid *newTagPtr; itemPtr->tagSpace += 5; - newTagPtr = (Tk_Uid *) - ckalloc((unsigned) (itemPtr->tagSpace * sizeof(Tk_Uid))); + newTagPtr = ckalloc(itemPtr->tagSpace * sizeof(Tk_Uid)); memcpy((void *) newTagPtr, itemPtr->tagPtr, itemPtr->numTags * sizeof(Tk_Uid)); if (itemPtr->tagPtr != itemPtr->staticTagSpace) { - ckfree((char *) itemPtr->tagPtr); + ckfree(itemPtr->tagPtr); } itemPtr->tagPtr = newTagPtr; tagPtr = &itemPtr->tagPtr[itemPtr->numTags]; @@ -3938,7 +4278,7 @@ FindItems( TkCanvas *canvasPtr, /* Canvas whose items are to be searched. */ int objc, /* Number of entries in argv. Must be greater * than zero. */ - Tcl_Obj *CONST *objv, /* Arguments that describe what items to + Tcl_Obj *const *objv, /* Arguments that describe what items to * search for (see user doc on "find" and * "addtag" options). */ Tcl_Obj *newTag, /* If non-NULL, gives new tag to set on all @@ -3959,7 +4299,8 @@ FindItems( Tk_Item *itemPtr; Tk_Uid uid; int index, result; - static CONST char *optionStrings[] = { + Tcl_Obj *resultObj; + static const char *const optionStrings[] = { "above", "all", "below", "closest", "enclosed", "overlapping", "withtag", NULL }; @@ -3990,7 +4331,9 @@ FindItems( lastPtr = itemPtr; } if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) { - DoItem(interp, lastPtr->nextPtr, uid); + resultObj = Tcl_NewObj(); + DoItem(resultObj, lastPtr->nextPtr, uid); + Tcl_SetObjResult(interp, resultObj); } break; } @@ -4000,10 +4343,12 @@ FindItems( return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { - DoItem(interp, itemPtr, uid); + DoItem(resultObj, itemPtr, uid); } + Tcl_SetObjResult(interp, resultObj); break; case CANV_BELOW: @@ -4013,10 +4358,10 @@ FindItems( } FIRST_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr, return TCL_ERROR); - if (itemPtr != NULL) { - if (itemPtr->prevPtr != NULL) { - DoItem(interp, itemPtr->prevPtr, uid); - } + if ((itemPtr != NULL) && (itemPtr->prevPtr != NULL)) { + resultObj = Tcl_NewObj(); + DoItem(resultObj, itemPtr->prevPtr, uid); + Tcl_SetObjResult(interp, resultObj); } break; case CANV_CLOSEST: { @@ -4029,19 +4374,20 @@ FindItems( Tcl_WrongNumArgs(interp, first+1, objv, "x y ?halo? ?start?"); return TCL_ERROR; } - if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[first+1], - &coords[0]) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, - (Tk_Canvas) canvasPtr, objv[first+2], &coords[1]) != TCL_OK)) { + if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, + objv[first+1], &coords[0]) != TCL_OK + || Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, + objv[first+2], &coords[1]) != TCL_OK) { return TCL_ERROR; } if (objc > first+3) { - if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[first+3], - &halo) != TCL_OK) { + if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, + objv[first+3], &halo) != TCL_OK) { return TCL_ERROR; } if (halo < 0.0) { - Tcl_AppendResult(interp, "can't have negative halo value \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't have negative halo value \"%f\"", halo)); return TCL_ERROR; } } else { @@ -4078,11 +4424,7 @@ FindItems( if (itemPtr == NULL) { return TCL_OK; } - closestDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr, - itemPtr, coords) - halo; - if (closestDist < 0.0) { - closestDist = 0.0; - } + closestDist = ItemPoint(canvasPtr, itemPtr, coords, halo); while (1) { double newDist; @@ -4109,7 +4451,9 @@ FindItems( itemPtr = canvasPtr->firstItemPtr; } if (itemPtr == startPtr) { - DoItem(interp, closestPtr, uid); + resultObj = Tcl_NewObj(); + DoItem(resultObj, closestPtr, uid); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (itemPtr->state == TK_STATE_HIDDEN || @@ -4121,11 +4465,7 @@ FindItems( || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) { continue; } - newDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr, - itemPtr, coords) - halo; - if (newDist < 0.0) { - newDist = 0.0; - } + newDist = ItemPoint(canvasPtr, itemPtr, coords, halo); if (newDist <= closestDist) { closestDist = newDist; break; @@ -4151,10 +4491,16 @@ FindItems( Tcl_WrongNumArgs(interp, first+1, objv, "tagOrId"); return TCL_ERROR; } + resultObj = Tcl_NewObj(); FOR_EVERY_CANVAS_ITEM_MATCHING(objv[first+1], searchPtrPtr, - return TCL_ERROR) { - DoItem(interp, itemPtr, uid); + goto badWithTagSearch) { + DoItem(resultObj, itemPtr, uid); } + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; + badWithTagSearch: + Tcl_DecrRefCount(resultObj); + return TCL_ERROR; } return TCL_OK; } @@ -4186,7 +4532,7 @@ FindArea( Tcl_Interp *interp, /* Interpreter for error reporting and result * storing. */ TkCanvas *canvasPtr, /* Canvas whose items are to be searched. */ - Tcl_Obj *CONST *objv, /* Array of four arguments that give the + Tcl_Obj *const *objv, /* Array of four arguments that give the * coordinates of the rectangular area to * search. */ Tk_Uid uid, /* If non-NULL, gives new tag to set on all @@ -4199,14 +4545,15 @@ FindArea( double rect[4], tmp; int x1, y1, x2, y2; Tk_Item *itemPtr; + Tcl_Obj *resultObj; if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[0], &rect[0]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[1], + || (Tk_CanvasGetCoordFromObj(interp,(Tk_Canvas)canvasPtr,objv[1], &rect[1]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[2], + || (Tk_CanvasGetCoordFromObj(interp,(Tk_Canvas)canvasPtr,objv[2], &rect[2]) != TCL_OK) - || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, objv[3], + || (Tk_CanvasGetCoordFromObj(interp,(Tk_Canvas)canvasPtr,objv[3], &rect[3]) != TCL_OK)) { return TCL_ERROR; } @@ -4222,25 +4569,27 @@ FindArea( * item-specific code except for items that are close. */ - x1 = (int) (rect[0]-1.0); - y1 = (int) (rect[1]-1.0); - x2 = (int) (rect[2]+1.0); - y2 = (int) (rect[3]+1.0); + x1 = (int) (rect[0] - 1.0); + y1 = (int) (rect[1] - 1.0); + x2 = (int) (rect[2] + 1.0); + y2 = (int) (rect[3] + 1.0); + resultObj = Tcl_NewObj(); for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { - if (itemPtr->state == TK_STATE_HIDDEN || (itemPtr->state == TK_STATE_NULL && - canvasPtr->canvas_state == TK_STATE_HIDDEN)) { + if (itemPtr->state == TK_STATE_HIDDEN || + (itemPtr->state == TK_STATE_NULL + && canvasPtr->canvas_state == TK_STATE_HIDDEN)) { continue; } if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1) || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) { continue; } - if ((*itemPtr->typePtr->areaProc)((Tk_Canvas) canvasPtr, itemPtr, rect) - >= enclosed) { - DoItem(interp, itemPtr, uid); + if (ItemOverlap(canvasPtr, itemPtr, rect) >= enclosed) { + DoItem(resultObj, itemPtr, uid); } } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -4329,7 +4678,7 @@ RelinkItems( lastMovePtr->nextPtr = itemPtr; } lastMovePtr = itemPtr; - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); canvasPtr->flags |= REPICK_NEEDED; } @@ -4392,9 +4741,10 @@ CanvasBindProc( ClientData clientData, /* Pointer to canvas structure. */ XEvent *eventPtr) /* Pointer to X event that just happened. */ { - TkCanvas *canvasPtr = (TkCanvas *) clientData; + TkCanvas *canvasPtr = clientData; + int mask; - Tcl_Preserve((ClientData) canvasPtr); + Tcl_Preserve(canvasPtr); /* * This code below keeps track of the current modifier state in @@ -4402,9 +4752,9 @@ CanvasBindProc( * current item while buttons are down. */ - if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) { - int mask; - + switch (eventPtr->type) { + case ButtonPress: + case ButtonRelease: switch (eventPtr->xbutton.button) { case Button1: mask = Button1Mask; @@ -4458,20 +4808,21 @@ CanvasBindProc( PickCurrentItem(canvasPtr, eventPtr); eventPtr->xbutton.state ^= mask; } - goto done; - } else if ((eventPtr->type == EnterNotify) - || (eventPtr->type == LeaveNotify)) { + break; + case EnterNotify: + case LeaveNotify: canvasPtr->state = eventPtr->xcrossing.state; PickCurrentItem(canvasPtr, eventPtr); - goto done; - } else if (eventPtr->type == MotionNotify) { + break; + case MotionNotify: canvasPtr->state = eventPtr->xmotion.state; PickCurrentItem(canvasPtr, eventPtr); + /* fallthrough */ + default: + CanvasDoEvent(canvasPtr, eventPtr); } - CanvasDoEvent(canvasPtr, eventPtr); - done: - Tcl_Release((ClientData) canvasPtr); + Tcl_Release(canvasPtr); } /* @@ -4553,11 +4904,11 @@ PickCurrentItem( canvasPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root; canvasPtr->pickEvent.xcrossing.mode = NotifyNormal; canvasPtr->pickEvent.xcrossing.detail = NotifyNonlinear; - canvasPtr->pickEvent.xcrossing.same_screen - = eventPtr->xmotion.same_screen; + canvasPtr->pickEvent.xcrossing.same_screen = + eventPtr->xmotion.same_screen; canvasPtr->pickEvent.xcrossing.focus = False; canvasPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state; - } else { + } else { canvasPtr->pickEvent = *eventPtr; } } @@ -4589,7 +4940,7 @@ PickCurrentItem( if ((canvasPtr->newCurrentPtr == canvasPtr->currentItemPtr) && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) { /* - * Nothing to do: the current item hasn't changed. + * Nothing to do: the current item hasn't changed. */ return; @@ -4652,7 +5003,7 @@ PickCurrentItem( * deleted. */ } - if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr) && buttonDown) { + if ((canvasPtr->newCurrentPtr!=canvasPtr->currentItemPtr) && buttonDown) { canvasPtr->flags |= LEFT_GRABBED_ITEM; return; } @@ -4668,10 +5019,8 @@ PickCurrentItem( canvasPtr->currentItemPtr = canvasPtr->newCurrentPtr; if (prevItemPtr != NULL && prevItemPtr != canvasPtr->currentItemPtr && (prevItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT)) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, prevItemPtr); - (*prevItemPtr->typePtr->configProc)(canvasPtr->interp, - (Tk_Canvas) canvasPtr, prevItemPtr, 0, NULL, - TK_CONFIG_ARGV_ONLY); + EventuallyRedrawItem(canvasPtr, prevItemPtr); + ItemConfigure(canvasPtr, prevItemPtr, 0, NULL); } if (canvasPtr->currentItemPtr != NULL) { XEvent event; @@ -4680,14 +5029,11 @@ PickCurrentItem( DoItem(NULL, canvasPtr->currentItemPtr, Tk_GetUid("current")); #else /* USE_OLD_TAG_SEARCH */ DoItem(NULL, canvasPtr->currentItemPtr, searchUids->currentUid); -#endif /* USE_OLD_TAG_SEA */ - if ((canvasPtr->currentItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT && - prevItemPtr != canvasPtr->currentItemPtr)) { - (*canvasPtr->currentItemPtr->typePtr->configProc)(canvasPtr->interp, - (Tk_Canvas) canvasPtr, canvasPtr->currentItemPtr, 0, NULL, - TK_CONFIG_ARGV_ONLY); - EventuallyRedrawItem((Tk_Canvas) canvasPtr, - canvasPtr->currentItemPtr); +#endif /* USE_OLD_TAG_SEARCH */ + if ((canvasPtr->currentItemPtr->redraw_flags & TK_ITEM_STATE_DEPENDANT + && prevItemPtr != canvasPtr->currentItemPtr)) { + ItemConfigure(canvasPtr, canvasPtr->currentItemPtr, 0, NULL); + EventuallyRedrawItem(canvasPtr, canvasPtr->currentItemPtr); } event = canvasPtr->pickEvent; event.type = EnterNotify; @@ -4733,8 +5079,10 @@ CanvasFindClosest( bestPtr = NULL; for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; itemPtr = itemPtr->nextPtr) { - if (itemPtr->state == TK_STATE_HIDDEN || itemPtr->state==TK_STATE_DISABLED || - (itemPtr->state == TK_STATE_NULL && (canvasPtr->canvas_state == TK_STATE_HIDDEN || + if (itemPtr->state == TK_STATE_HIDDEN || + itemPtr->state==TK_STATE_DISABLED || + (itemPtr->state == TK_STATE_NULL && + (canvasPtr->canvas_state == TK_STATE_HIDDEN || canvasPtr->canvas_state == TK_STATE_DISABLED))) { continue; } @@ -4742,8 +5090,7 @@ CanvasFindClosest( || (itemPtr->y1 > y2) || (itemPtr->y2 < y1)) { continue; } - if ((*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr, - itemPtr, coords) <= canvasPtr->closeEnough) { + if (ItemPoint(canvasPtr,itemPtr,coords,0) <= canvasPtr->closeEnough) { bestPtr = itemPtr; } } @@ -4840,8 +5187,7 @@ CanvasDoEvent( if (numObjects <= NUM_STATIC) { objectPtr = staticObjects; } else { - objectPtr = (ClientData *) ckalloc((unsigned) - (numObjects * sizeof(ClientData))); + objectPtr = ckalloc(numObjects * sizeof(ClientData)); } #ifdef USE_OLD_TAG_SEARCH objectPtr[0] = (ClientData) Tk_GetUid("all"); @@ -4851,7 +5197,7 @@ CanvasDoEvent( for (i = itemPtr->numTags-1; i >= 0; i--) { objectPtr[i+1] = (ClientData) itemPtr->tagPtr[i]; } - objectPtr[itemPtr->numTags+1] = (ClientData) itemPtr; + objectPtr[itemPtr->numTags+1] = itemPtr; #ifndef USE_OLD_TAG_SEARCH /* @@ -4878,7 +5224,7 @@ CanvasDoEvent( numObjects, objectPtr); } if (objectPtr != staticObjects) { - ckfree((char *) objectPtr); + ckfree(objectPtr); } } @@ -4904,7 +5250,7 @@ static void CanvasBlinkProc( ClientData clientData) /* Pointer to record describing entry. */ { - TkCanvas *canvasPtr = (TkCanvas *) clientData; + TkCanvas *canvasPtr = clientData; if (!canvasPtr->textInfo.gotFocus || (canvasPtr->insertOffTime == 0)) { return; @@ -4912,18 +5258,13 @@ CanvasBlinkProc( if (canvasPtr->textInfo.cursorOn) { canvasPtr->textInfo.cursorOn = 0; canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - canvasPtr->insertOffTime, CanvasBlinkProc, - (ClientData) canvasPtr); + canvasPtr->insertOffTime, CanvasBlinkProc, canvasPtr); } else { canvasPtr->textInfo.cursorOn = 1; canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - canvasPtr->insertOnTime, CanvasBlinkProc, - (ClientData) canvasPtr); - } - if (canvasPtr->textInfo.focusItemPtr != NULL) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, - canvasPtr->textInfo.focusItemPtr); + canvasPtr->insertOnTime, CanvasBlinkProc, canvasPtr); } + EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.focusItemPtr); } /* @@ -4956,22 +5297,18 @@ CanvasFocusProc( canvasPtr->textInfo.cursorOn = 1; if (canvasPtr->insertOffTime != 0) { canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - canvasPtr->insertOffTime, CanvasBlinkProc, - (ClientData) canvasPtr); + canvasPtr->insertOffTime, CanvasBlinkProc, canvasPtr); } } else { canvasPtr->textInfo.gotFocus = 0; canvasPtr->textInfo.cursorOn = 0; canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL; } - if (canvasPtr->textInfo.focusItemPtr != NULL) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, - canvasPtr->textInfo.focusItemPtr); - } + EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.focusItemPtr); if (canvasPtr->highlightWidth > 0) { canvasPtr->flags |= REDRAW_BORDERS; if (!(canvasPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr); + Tcl_DoWhenIdle(DisplayCanvas, canvasPtr); canvasPtr->flags |= REDRAW_PENDING; } } @@ -5014,10 +5351,9 @@ CanvasSelectTo( if (canvasPtr->textInfo.selItemPtr == NULL) { Tk_OwnSelection(canvasPtr->tkwin, XA_PRIMARY, CanvasLostSelection, - (ClientData) canvasPtr); + canvasPtr); } else if (canvasPtr->textInfo.selItemPtr != itemPtr) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, - canvasPtr->textInfo.selItemPtr); + EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.selItemPtr); } canvasPtr->textInfo.selItemPtr = itemPtr; @@ -5035,7 +5371,7 @@ CanvasSelectTo( if ((canvasPtr->textInfo.selectFirst != oldFirst) || (canvasPtr->textInfo.selectLast != oldLast) || (itemPtr != oldSelPtr)) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr); + EventuallyRedrawItem(canvasPtr, itemPtr); } } @@ -5070,16 +5406,9 @@ CanvasFetchSelection( * not including terminating NULL * character. */ { - TkCanvas *canvasPtr = (TkCanvas *) clientData; + TkCanvas *canvasPtr = clientData; - if (canvasPtr->textInfo.selItemPtr == NULL) { - return -1; - } - if (canvasPtr->textInfo.selItemPtr->typePtr->selectionProc == NULL) { - return -1; - } - return (*canvasPtr->textInfo.selItemPtr->typePtr->selectionProc)( - (Tk_Canvas) canvasPtr, canvasPtr->textInfo.selItemPtr, offset, + return ItemSelection(canvasPtr, canvasPtr->textInfo.selItemPtr, offset, buffer, maxBytes); } @@ -5105,12 +5434,9 @@ static void CanvasLostSelection( ClientData clientData) /* Information about entry widget. */ { - TkCanvas *canvasPtr = (TkCanvas *) clientData; + TkCanvas *canvasPtr = clientData; - if (canvasPtr->textInfo.selItemPtr != NULL) { - EventuallyRedrawItem((Tk_Canvas) canvasPtr, - canvasPtr->textInfo.selItemPtr); - } + EventuallyRedrawItem(canvasPtr, canvasPtr->textInfo.selItemPtr); canvasPtr->textInfo.selItemPtr = NULL; } @@ -5227,6 +5553,7 @@ CanvasUpdateScrollbars( int xOrigin, yOrigin, inset, width, height; int scrollX1, scrollX2, scrollY1, scrollY2; char *xScrollCmd, *yScrollCmd; + Tcl_DString buf; /* * Save all the relevant values from the canvasPtr, because it might be @@ -5234,14 +5561,14 @@ CanvasUpdateScrollbars( */ interp = canvasPtr->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); xScrollCmd = canvasPtr->xScrollCmd; if (xScrollCmd != NULL) { - Tcl_Preserve((ClientData) xScrollCmd); + Tcl_Preserve(xScrollCmd); } yScrollCmd = canvasPtr->yScrollCmd; if (yScrollCmd != NULL) { - Tcl_Preserve((ClientData) yScrollCmd); + Tcl_Preserve(yScrollCmd); } xOrigin = canvasPtr->xOrigin; yOrigin = canvasPtr->yOrigin; @@ -5256,29 +5583,39 @@ CanvasUpdateScrollbars( if (canvasPtr->xScrollCmd != NULL) { Tcl_Obj *fractions = ScrollFractions(xOrigin + inset, xOrigin + width - inset, scrollX1, scrollX2); - result = Tcl_VarEval(interp, xScrollCmd, " ", Tcl_GetString(fractions), - NULL); + + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, xScrollCmd, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, Tcl_GetString(fractions), -1); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); Tcl_DecrRefCount(fractions); if (result != TCL_OK) { - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_ResetResult(interp); - Tcl_Release((ClientData) xScrollCmd); + Tcl_Release(xScrollCmd); } if (yScrollCmd != NULL) { Tcl_Obj *fractions = ScrollFractions(yOrigin + inset, yOrigin + height - inset, scrollY1, scrollY2); - result = Tcl_VarEval(interp, yScrollCmd, " ", Tcl_GetString(fractions), - NULL); + + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, yScrollCmd, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, Tcl_GetString(fractions), -1); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); Tcl_DecrRefCount(fractions); if (result != TCL_OK) { - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_ResetResult(interp); - Tcl_Release((ClientData) yScrollCmd); + Tcl_Release(yScrollCmd); } - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } /* @@ -5344,11 +5681,11 @@ CanvasSetOrigin( * Adjust the origin if necessary to keep as much as possible of the * canvas in the view. The variables left, right, etc. keep track of how * much extra space there is on each side of the view before it will stick - * out past the scroll region. If one side sticks out past the edge of - * the scroll region, adjust the view to bring that side back to the edge - * of the scrollregion (but don't move it so much that the other side - * sticks out now). If scroll increments are in effect, be sure to adjust - * only by full increments. + * out past the scroll region. If one side sticks out past the edge of the + * scroll region, adjust the view to bring that side back to the edge of + * the scrollregion (but don't move it so much that the other side sticks + * out now). If scroll increments are in effect, be sure to adjust only by + * full increments. */ if ((canvasPtr->confine) && (canvasPtr->regionString != NULL)) { @@ -5427,17 +5764,18 @@ CanvasSetOrigin( */ /* ARGSUSED */ -static CONST char ** +static const char ** TkGetStringsFromObjs( int objc, - Tcl_Obj *CONST objv[]) + Tcl_Obj *const objv[]) { register int i; - CONST char **argv; + const char **argv; + if (objc <= 0) { return NULL; } - argv = (CONST char **) ckalloc((objc+1) * sizeof(char *)); + argv = ckalloc((objc+1) * sizeof(char *)); for (i = 0; i < objc; i++) { argv[i] = Tcl_GetString(objv[i]); } @@ -5473,8 +5811,7 @@ Tk_CanvasPsColor( Tk_Canvas canvas, /* Information about canvas. */ XColor *colorPtr) /* Information about color. */ { - return Tk_PostscriptColor(interp, ((TkCanvas *) canvas)->psInfo, - colorPtr); + return Tk_PostscriptColor(interp, Canvas(canvas)->psInfo, colorPtr); } /* @@ -5507,7 +5844,7 @@ Tk_CanvasPsFont( Tk_Font tkfont) /* Information about font in which text is to * be printed. */ { - return Tk_PostscriptFont(interp, ((TkCanvas *) canvas)->psInfo, tkfont); + return Tk_PostscriptFont(interp, Canvas(canvas)->psInfo, tkfont); } /* @@ -5540,9 +5877,8 @@ Tk_CanvasPsBitmap( * rectangular region to output. */ int width, int height) /* Size of rectangular region. */ { - return Tk_PostscriptBitmap(interp, ((TkCanvas *) canvas)->tkwin, - ((TkCanvas *) canvas)->psInfo, bitmap, startX, startY, - width, height); + return Tk_PostscriptBitmap(interp, Canvas(canvas)->tkwin, + Canvas(canvas)->psInfo, bitmap, startX, startY, width, height); } /* @@ -5574,8 +5910,8 @@ Tk_CanvasPsStipple( Tk_Canvas canvas, /* Information about canvas. */ Pixmap bitmap) /* Bitmap to use for stippling. */ { - return Tk_PostscriptStipple(interp, ((TkCanvas *) canvas)->tkwin, - ((TkCanvas *) canvas)->psInfo, bitmap); + return Tk_PostscriptStipple(interp, Canvas(canvas)->tkwin, + Canvas(canvas)->psInfo, bitmap); } /* @@ -5601,7 +5937,7 @@ Tk_CanvasPsY( * is being generated. */ double y) /* Y-coordinate in canvas coords. */ { - return Tk_PostscriptY(y, ((TkCanvas *) canvas)->psInfo); + return Tk_PostscriptY(y, Canvas(canvas)->psInfo); } /* @@ -5631,8 +5967,7 @@ Tk_CanvasPsPath( * coordinates giving points for path. */ int numPoints) /* Number of points at *coordPtr. */ { - Tk_PostscriptPath(interp, ((TkCanvas *) canvas)->psInfo, - coordPtr, numPoints); + Tk_PostscriptPath(interp, Canvas(canvas)->psInfo, coordPtr, numPoints); } /* diff --git a/generic/tkCanvas.h b/generic/tkCanvas.h index d009cfa..b8b1b46 100644 --- a/generic/tkCanvas.h +++ b/generic/tkCanvas.h @@ -291,7 +291,7 @@ typedef struct TkCanvas { */ MODULE_SCOPE int TkCanvPostscriptCmd(TkCanvas *canvasPtr, - Tcl_Interp *interp, int argc, CONST char **argv); + Tcl_Interp *interp, int argc, const char **argv); MODULE_SCOPE int TkCanvTranslatePath(TkCanvas *canvPtr, int numVertex, double *coordPtr, int closed, XPoint *outPtr); @@ -303,4 +303,10 @@ MODULE_SCOPE Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType; MODULE_SCOPE Tk_ItemType tkOvalType, tkPolygonType; MODULE_SCOPE Tk_ItemType tkRectangleType, tkTextType, tkWindowType; +/* + * Convenience macro. + */ + +#define Canvas(canvas) ((TkCanvas *) (canvas)) + #endif /* _TKCANVAS */ diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c index c6748a1..b902625 100644 --- a/generic/tkClipboard.c +++ b/generic/tkClipboard.c @@ -27,7 +27,7 @@ static int ClipboardWindowHandler(ClientData clientData, int offset, char *buffer, int maxBytes); static void ClipboardLostSel(ClientData clientData); static int ClipboardGetProc(ClientData clientData, - Tcl_Interp *interp, char *portion); + Tcl_Interp *interp, const char *portion); /* *---------------------------------------------------------------------- @@ -56,7 +56,7 @@ ClipboardHandler( char *buffer, /* Place to store converted selection. */ int maxBytes) /* Maximum # of bytes to store at buffer. */ { - TkClipboardTarget *targetPtr = (TkClipboardTarget*) clientData; + TkClipboardTarget *targetPtr = clientData; TkClipboardBuffer *cbPtr; char *srcPtr, *destPtr; size_t count = 0; @@ -134,9 +134,9 @@ ClipboardAppHandler( char *buffer, /* Place to store converted selection. */ int maxBytes) /* Maximum # of bytes to store at buffer. */ { - TkDisplay *dispPtr = (TkDisplay *) clientData; + TkDisplay *dispPtr = clientData; size_t length; - CONST char *p; + const char *p; p = dispPtr->clipboardAppPtr->winPtr->nameUid; length = strlen(p); @@ -205,7 +205,7 @@ static void ClipboardLostSel( ClientData clientData) /* Pointer to TkDisplay structure. */ { - TkDisplay *dispPtr = (TkDisplay*) clientData; + TkDisplay *dispPtr = clientData; dispPtr->clipboardActive = 0; } @@ -267,12 +267,12 @@ Tk_ClipboardClear( cbPtr = nextCbPtr) { ckfree(cbPtr->buffer); nextCbPtr = cbPtr->nextPtr; - ckfree((char *) cbPtr); + ckfree(cbPtr); } nextTargetPtr = targetPtr->nextPtr; Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom, targetPtr->type); - ckfree((char *) targetPtr); + ckfree(targetPtr); } dispPtr->clipTargetPtr = NULL; @@ -282,7 +282,7 @@ Tk_ClipboardClear( if (!dispPtr->clipboardActive) { Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom, - ClipboardLostSel, (ClientData) dispPtr); + ClipboardLostSel, dispPtr); dispPtr->clipboardActive = 1; } dispPtr->clipboardAppPtr = winPtr->mainPtr; @@ -324,7 +324,7 @@ Tk_ClipboardAppend( * clipboard item, e.g. STRING or LENGTH. */ Atom format, /* Format in which the selection information * should be returned to the requestor. */ - char* buffer) /* NULL terminated string containing the data + const char *buffer) /* NULL terminated string containing the data * to be added to the clipboard. */ { TkWindow *winPtr = (TkWindow *) tkwin; @@ -341,7 +341,7 @@ Tk_ClipboardAppend( Tk_ClipboardClear(interp, tkwin); } else if (!dispPtr->clipboardActive) { Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom, - ClipboardLostSel, (ClientData) dispPtr); + ClipboardLostSel, dispPtr); dispPtr->clipboardActive = 1; } @@ -358,19 +358,21 @@ Tk_ClipboardAppend( } } if (targetPtr == NULL) { - targetPtr = (TkClipboardTarget*) ckalloc(sizeof(TkClipboardTarget)); + targetPtr = ckalloc(sizeof(TkClipboardTarget)); targetPtr->type = type; targetPtr->format = format; targetPtr->firstBufferPtr = targetPtr->lastBufferPtr = NULL; targetPtr->nextPtr = dispPtr->clipTargetPtr; dispPtr->clipTargetPtr = targetPtr; Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom, - type, ClipboardHandler, (ClientData) targetPtr, format); + type, ClipboardHandler, targetPtr, format); } else if (targetPtr->format != format) { - Tcl_AppendResult(interp, "format \"", Tk_GetAtomName(tkwin, format), - "\" does not match current format \"", - Tk_GetAtomName(tkwin, targetPtr->format),"\" for ", - Tk_GetAtomName(tkwin, type), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "format \"%s\" does not match current format \"%s\" for %s", + Tk_GetAtomName(tkwin, format), + Tk_GetAtomName(tkwin, targetPtr->format), + Tk_GetAtomName(tkwin, type))); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "FORMAT_MISMATCH", NULL); return TCL_ERROR; } @@ -378,7 +380,7 @@ Tk_ClipboardAppend( * Append a new buffer to the buffer chain. */ - cbPtr = (TkClipboardBuffer*) ckalloc(sizeof(TkClipboardBuffer)); + cbPtr = ckalloc(sizeof(TkClipboardBuffer)); cbPtr->nextPtr = NULL; if (targetPtr->lastBufferPtr != NULL) { targetPtr->lastBufferPtr->nextPtr = cbPtr; @@ -388,10 +390,10 @@ Tk_ClipboardAppend( targetPtr->lastBufferPtr = cbPtr; cbPtr->length = strlen(buffer); - cbPtr->buffer = (char *) ckalloc((unsigned) (cbPtr->length + 1)); + cbPtr->buffer = ckalloc(cbPtr->length + 1); strcpy(cbPtr->buffer, buffer); - TkSelUpdateClipboard((TkWindow*)(dispPtr->clipWindow), targetPtr); + TkSelUpdateClipboard((TkWindow *) dispPtr->clipWindow, targetPtr); return TCL_OK; } @@ -418,17 +420,17 @@ Tk_ClipboardObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument strings. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { Tk_Window tkwin = (Tk_Window) clientData; - char *path = NULL; + const char *path = NULL; Atom selection; - static CONST char *optionStrings[] = { "append", "clear", "get", NULL }; + static const char *const optionStrings[] = { "append", "clear", "get", NULL }; enum options { CLIPBOARD_APPEND, CLIPBOARD_CLEAR, CLIPBOARD_GET }; int index, i; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } @@ -440,10 +442,10 @@ Tk_ClipboardObjCmd( switch ((enum options) index) { case CLIPBOARD_APPEND: { Atom target, format; - char *targetName = NULL; - char *formatName = NULL; - char *string; - static CONST char *appendOptionStrings[] = { + const char *targetName = NULL; + const char *formatName = NULL; + const char *string; + static const char *const appendOptionStrings[] = { "-displayof", "-format", "-type", NULL }; enum appendOptions { APPEND_DISPLAYOF, APPEND_FORMAT, APPEND_TYPE }; @@ -474,8 +476,9 @@ Tk_ClipboardObjCmd( i++; if (i >= objc) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL); return TCL_ERROR; } switch ((enum appendOptions) subIndex) { @@ -491,7 +494,7 @@ Tk_ClipboardObjCmd( } } if (objc - i != 1) { - Tcl_WrongNumArgs(interp, 2, objv, "?options? data"); + Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? data"); return TCL_ERROR; } if (path != NULL) { @@ -514,7 +517,7 @@ Tk_ClipboardObjCmd( Tcl_GetString(objv[i])); } case CLIPBOARD_CLEAR: { - static CONST char *clearOptionStrings[] = { "-displayof", NULL }; + static const char *const clearOptionStrings[] = { "-displayof", NULL }; enum clearOptions { CLEAR_DISPLAYOF }; int subIndex; @@ -542,11 +545,11 @@ Tk_ClipboardObjCmd( } case CLIPBOARD_GET: { Atom target; - char *targetName = NULL; + const char *targetName = NULL; Tcl_DString selBytes; int result; - char *string; - static CONST char *getOptionStrings[] = { + const char *string; + static const char *const getOptionStrings[] = { "-displayof", "-type", NULL }; enum getOptions { APPEND_DISPLAYOF, APPEND_TYPE }; @@ -563,8 +566,9 @@ Tk_ClipboardObjCmd( } i++; if (i >= objc) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "CLIPBOARD", "VALUE", NULL); return TCL_ERROR; } switch ((enum getOptions) subIndex) { @@ -585,7 +589,7 @@ Tk_ClipboardObjCmd( selection = Tk_InternAtom(tkwin, "CLIPBOARD"); if (objc - i > 1) { - Tcl_WrongNumArgs(interp, 2, objv, "?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?"); return TCL_ERROR; } else if (objc - i == 1) { target = Tk_InternAtom(tkwin, Tcl_GetString(objv[i])); @@ -597,7 +601,7 @@ Tk_ClipboardObjCmd( Tcl_DStringInit(&selBytes); result = Tk_GetSelection(interp, tkwin, selection, target, - ClipboardGetProc, (ClientData) &selBytes); + ClipboardGetProc, &selBytes); if (result == TCL_OK) { Tcl_DStringResult(interp, &selBytes); } else { @@ -647,8 +651,9 @@ TkClipInit( dispPtr->clipWindow = (Tk_Window) TkAllocWindow(dispPtr, DefaultScreen(dispPtr->display), NULL); - Tcl_Preserve((ClientData) dispPtr->clipWindow); - ((TkWindow *) dispPtr->clipWindow)->flags |= TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; + Tcl_Preserve(dispPtr->clipWindow); + ((TkWindow *) dispPtr->clipWindow)->flags |= + TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; TkWmNewWindow((TkWindow *) dispPtr->clipWindow); atts.override_redirect = True; Tk_ChangeWindowAttributes(dispPtr->clipWindow, CWOverrideRedirect, &atts); @@ -670,11 +675,9 @@ TkClipInit( */ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom, - dispPtr->applicationAtom, ClipboardAppHandler, - (ClientData) dispPtr, XA_STRING); + dispPtr->applicationAtom, ClipboardAppHandler, dispPtr,XA_STRING); Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom, - dispPtr->windowAtom, ClipboardWindowHandler, - (ClientData) dispPtr, XA_STRING); + dispPtr->windowAtom, ClipboardWindowHandler, dispPtr, XA_STRING); return TCL_OK; } @@ -703,12 +706,11 @@ ClipboardGetProc( * selection. */ Tcl_Interp *interp, /* Interpreter used for error reporting (not * used). */ - char *portion) /* New information to be appended. */ + const char *portion) /* New information to be appended. */ { Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1); return TCL_OK; } - /* * Local Variables: diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 2010b6e..6196b17 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -14,7 +14,7 @@ #include "tkInt.h" -#if defined(WIN32) +#if defined(_WIN32) #include "tkWinInt.h" #elif defined(MAC_OSX_TK) #include "tkMacOSXInt.h" @@ -34,6 +34,42 @@ static void WaitVisibilityProc(ClientData clientData, XEvent *eventPtr); static void WaitWindowProc(ClientData clientData, XEvent *eventPtr); +static int AppnameCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv); +static int CaretCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv); +static int InactiveCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv); +static int ScalingCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv); +static int UseinputmethodsCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); +static int WindowingsystemCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); + +#if defined(_WIN32) || defined(MAC_OSX_TK) +MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[]; +#else +#define tkFontchooserEnsemble NULL +#endif + +/* + * Table of tk subcommand names and implementations. + */ + +static const TkEnsemble tkCmdMap[] = { + {"appname", AppnameCmd, NULL }, + {"busy", Tk_BusyObjCmd, NULL }, + {"caret", CaretCmd, NULL }, + {"inactive", InactiveCmd, NULL }, + {"scaling", ScalingCmd, NULL }, + {"useinputmethods", UseinputmethodsCmd, NULL }, + {"windowingsystem", WindowingsystemCmd, NULL }, + {"fontchooser", NULL, tkFontchooserEnsemble}, + {NULL, NULL, NULL} +}; /* *---------------------------------------------------------------------- @@ -59,11 +95,11 @@ Tk_BellObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *bellOptions[] = { + static const char *const bellOptions[] = { "-displayof", "-nice", NULL }; enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE }; - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = clientData; int i, index, nice = 0; if (objc > 4) { @@ -73,8 +109,8 @@ Tk_BellObjCmd( } for (i = 1; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], bellOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], bellOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { @@ -124,10 +160,10 @@ Tk_BindObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = clientData; TkWindow *winPtr; ClientData object; - char *string; + const char *string; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?"); @@ -148,7 +184,7 @@ Tk_BindObjCmd( } object = (ClientData) winPtr->pathName; } else { - winPtr = (TkWindow *) clientData; + winPtr = clientData; object = (ClientData) Tk_GetUid(string); } @@ -162,9 +198,8 @@ Tk_BindObjCmd( if (objc == 4) { int append = 0; unsigned long mask; - char *sequence, *script; - sequence = Tcl_GetString(objv[2]); - script = Tcl_GetString(objv[3]); + const char *sequence = Tcl_GetString(objv[2]); + const char *script = Tcl_GetString(objv[3]); /* * If the script is null, just delete the binding. @@ -198,7 +233,7 @@ Tk_BindObjCmd( Tcl_ResetResult(interp); return TCL_OK; } - Tcl_SetResult(interp, (char *) command, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); } else { Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object); } @@ -247,8 +282,7 @@ TkBindEventProc( */ if (winPtr->numTags > MAX_OBJS) { - objPtr = (ClientData *) ckalloc((unsigned) - (winPtr->numTags * sizeof(ClientData))); + objPtr = ckalloc(winPtr->numTags * sizeof(ClientData)); } for (i = 0; i < winPtr->numTags; i++) { p = winPtr->tagPtr[i]; @@ -282,7 +316,7 @@ TkBindEventProc( Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr, count, objPtr); if (objPtr != objects) { - ckfree((char *) objPtr); + ckfree(objPtr); } } @@ -310,10 +344,10 @@ Tk_BindtagsObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = clientData; TkWindow *winPtr, *winPtr2; int i, length; - char *p; + const char *p; Tcl_Obj *listPtr, **tags; if ((objc < 2) || (objc > 3)) { @@ -328,24 +362,24 @@ Tk_BindtagsObjCmd( if (objc == 2) { listPtr = Tcl_NewObj(); if (winPtr->numTags == 0) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr->pathName, -1)); - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr->classUid, -1)); winPtr2 = winPtr; while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) { winPtr2 = winPtr2->parentPtr; } if ((winPtr != winPtr2) && (winPtr2 != NULL)) { - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(winPtr2->pathName, -1)); } - Tcl_ListObjAppendElement(interp, listPtr, + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj("all", -1)); } else { for (i = 0; i < winPtr->numTags; i++) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1)); + Tcl_ListObjAppendElement(NULL, listPtr, + Tcl_NewStringObj((char *) winPtr->tagPtr[i], -1)); } } Tcl_SetObjResult(interp, listPtr); @@ -362,8 +396,7 @@ Tk_BindtagsObjCmd( } winPtr->numTags = length; - winPtr->tagPtr = (ClientData *) ckalloc((unsigned) - (length * sizeof(ClientData))); + winPtr->tagPtr = ckalloc(length * sizeof(ClientData)); for (i = 0; i < length; i++) { p = Tcl_GetString(tags[i]); if (p[0] == '.') { @@ -376,7 +409,7 @@ Tk_BindtagsObjCmd( * is one. */ - copy = (char *) ckalloc((unsigned) (strlen(p) + 1)); + copy = ckalloc(strlen(p) + 1); strcpy(copy, p); winPtr->tagPtr[i] = (ClientData) copy; } else { @@ -422,7 +455,7 @@ TkFreeBindingTags( ckfree((char *)p); } } - ckfree((char *) winPtr->tagPtr); + ckfree(winPtr->tagPtr); winPtr->numTags = 0; winPtr->tagPtr = NULL; } @@ -452,7 +485,7 @@ Tk_DestroyObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window window; - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = clientData; int i; for (i = 1; i < objc; i++) { @@ -499,7 +532,7 @@ Tk_LowerObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window mainwin = (Tk_Window) clientData; + Tk_Window mainwin = clientData; Tk_Window tkwin, other; if ((objc != 2) && (objc != 3)) { @@ -520,9 +553,15 @@ Tk_LowerObjCmd( } } if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) { - Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]), - "\" below \"", (other ? Tcl_GetString(objv[2]) : ""), - "\"", NULL); + if (other) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't lower \"%s\" below \"%s\"", + Tcl_GetString(objv[1]), Tcl_GetString(objv[2]))); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't lower \"%s\" to bottom", Tcl_GetString(objv[1]))); + } + Tcl_SetErrorCode(interp, "TK", "RESTACK", "LOWER", NULL); return TCL_ERROR; } return TCL_OK; @@ -553,7 +592,7 @@ Tk_RaiseObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window mainwin = (Tk_Window) clientData; + Tk_Window mainwin = clientData; Tk_Window tkwin, other; if ((objc != 2) && (objc != 3)) { @@ -574,21 +613,56 @@ Tk_RaiseObjCmd( } } if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) { - Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]), - "\" above \"", (other ? Tcl_GetString(objv[2]) : ""), - "\"", NULL); + if (other) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't raise \"%s\" above \"%s\"", + Tcl_GetString(objv[1]), Tcl_GetString(objv[2]))); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't raise \"%s\" to top", Tcl_GetString(objv[1]))); + } + Tcl_SetErrorCode(interp, "TK", "RESTACK", "RAISE", NULL); return TCL_ERROR; } return TCL_OK; } /* + * ---------------------------------------------------------------------- + * + * TkInitTkCmd -- + * + * Set up the tk ensemble. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + * ---------------------------------------------------------------------- + */ + +int +TkInitTkCmd( + Tcl_Interp *interp, + ClientData clientData) +{ + TkMakeEnsemble(interp, "::", "tk", clientData, tkCmdMap); +#if defined(_WIN32) || defined(MAC_OSX_TK) + TkInitFontchooser(interp, clientData); +#endif + return TCL_OK; +} + +/* *---------------------------------------------------------------------- * - * Tk_TkObjCmd -- + * AppnameCmd, CaretCmd, ScalingCmd, UseinputmethodsCmd, + * WindowingsystemCmd, InactiveCmd -- * - * This function is invoked to process the "tk" Tcl command. See the user - * documentation for details on what it does. + * These functions are invoked to process the "tk" ensemble subcommands. + * See the user documentation for details on what they do. * * Results: * A standard Tcl result. @@ -600,286 +674,299 @@ Tk_RaiseObjCmd( */ int -Tk_TkObjCmd( +AppnameCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + Tk_Window tkwin = clientData; + TkWindow *winPtr; + const char *string; + + if (Tcl_IsSafe(interp)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "appname not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "APPLICATION", NULL); + return TCL_ERROR; + } + + winPtr = (TkWindow *) tkwin; + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?newName?"); + return TCL_ERROR; + } + if (objc == 2) { + string = Tcl_GetString(objv[1]); + winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string)); + } + Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1)); + return TCL_OK; +} + +int +CaretCmd( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tk_Window tkwin = clientData; int index; - Tk_Window tkwin; - static const char *optionStrings[] = { - "appname", "caret", "scaling", "useinputmethods", - "windowingsystem", "inactive", NULL + Tcl_Obj *objPtr; + TkCaret *caretPtr; + Tk_Window window; + static const char *const caretStrings[] = { + "-x", "-y", "-height", NULL }; - enum options { - TK_APPNAME, TK_CARET, TK_SCALING, TK_USE_IM, - TK_WINDOWINGSYSTEM, TK_INACTIVE + enum caretOptions { + TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT }; - tkwin = (Tk_Window) clientData; - - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); + if ((objc < 2) || ((objc > 3) && !!(objc & 1))) { + Tcl_WrongNumArgs(interp, 1, objv, + "window ?-x x? ?-y y? ?-height height?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + window = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), tkwin); + if (window == NULL) { return TCL_ERROR; } + caretPtr = &(((TkWindow *) window)->dispPtr->caret); + if (objc == 2) { + /* + * Return all the current values + */ - switch ((enum options) index) { - case TK_APPNAME: { - TkWindow *winPtr; - char *string; - - if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "appname not accessible in a safe interpreter", - TCL_STATIC); - return TCL_ERROR; - } + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("-height", 7)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewIntObj(caretPtr->height)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("-x", 2)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewIntObj(caretPtr->x)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("-y", 2)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewIntObj(caretPtr->y)); + Tcl_SetObjResult(interp, objPtr); + } else if (objc == 3) { + int value; - winPtr = (TkWindow *) tkwin; + /* + * Return the current value of the selected option + */ - if (objc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?newName?"); + if (Tcl_GetIndexFromObj(interp, objv[2], caretStrings, + "caret option", 0, &index) != TCL_OK) { return TCL_ERROR; } - if (objc == 3) { - string = Tcl_GetString(objv[2]); - winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string)); + if (index == TK_CARET_X) { + value = caretPtr->x; + } else if (index == TK_CARET_Y) { + value = caretPtr->y; + } else /* if (index == TK_CARET_HEIGHT) -- last case */ { + value = caretPtr->height; } - Tcl_AppendResult(interp, winPtr->nameUid, NULL); - break; - } - case TK_CARET: { - Tcl_Obj *objPtr; - TkCaret *caretPtr; - Tk_Window window; - static const char *caretStrings[] = { - "-x", "-y", "-height", NULL - }; - enum caretOptions { - TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT - }; - - if ((objc < 3) || ((objc > 4) && !(objc & 1))) { - Tcl_WrongNumArgs(interp, 2, objv, - "window ?-x x? ?-y y? ?-height height?"); - return TCL_ERROR; - } - window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); - if (window == NULL) { - return TCL_ERROR; - } - caretPtr = &(((TkWindow *) window)->dispPtr->caret); - if (objc == 3) { - /* - * Return all the current values - */ - - objPtr = Tcl_NewObj(); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("-height", 7)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewIntObj(caretPtr->height)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("-x", 2)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewIntObj(caretPtr->x)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("-y", 2)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewIntObj(caretPtr->y)); - Tcl_SetObjResult(interp, objPtr); - } else if (objc == 4) { - int value; - - /* - * Return the current value of the selected option - */ + Tcl_SetObjResult(interp, Tcl_NewIntObj(value)); + } else { + int i, value, x = 0, y = 0, height = -1; - if (Tcl_GetIndexFromObj(interp, objv[3], caretStrings, - "caret option", 0, &index) != TCL_OK) { + for (i = 2; i < objc; i += 2) { + if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings, + "caret option", 0, &index) != TCL_OK) || + Tcl_GetIntFromObj(interp,objv[i+1],&value) != TCL_OK) { return TCL_ERROR; } if (index == TK_CARET_X) { - value = caretPtr->x; + x = value; } else if (index == TK_CARET_Y) { - value = caretPtr->y; + y = value; } else /* if (index == TK_CARET_HEIGHT) -- last case */ { - value = caretPtr->height; - } - Tcl_SetIntObj(Tcl_GetObjResult(interp), value); - } else { - int i, value, x = 0, y = 0, height = -1; - - for (i = 3; i < objc; i += 2) { - if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings, - "caret option", 0, &index) != TCL_OK) || - Tcl_GetIntFromObj(interp,objv[i+1],&value) != TCL_OK) { - return TCL_ERROR; - } - if (index == TK_CARET_X) { - x = value; - } else if (index == TK_CARET_Y) { - y = value; - } else /* if (index == TK_CARET_HEIGHT) -- last case */ { - height = value; - } - } - if (height < 0) { - height = Tk_Height(window); + height = value; } - Tk_SetCaretPos(window, x, y, height); } - break; + if (height < 0) { + height = Tk_Height(window); + } + Tk_SetCaretPos(window, x, y, height); + } + return TCL_OK; +} + +int +ScalingCmd( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tk_Window tkwin = clientData; + Screen *screenPtr; + int skip, width, height; + double d; + + if (Tcl_IsSafe(interp)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "scaling not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "SCALING", NULL); + return TCL_ERROR; } - case TK_SCALING: { - Screen *screenPtr; - int skip, width, height; - double d; - if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "scaling not accessible in a safe interpreter", - TCL_STATIC); + skip = TkGetDisplayOf(interp, objc - 1, objv + 1, &tkwin); + if (skip < 0) { + return TCL_ERROR; + } + screenPtr = Tk_Screen(tkwin); + if (objc - skip == 1) { + d = 25.4 / 72; + d *= WidthOfScreen(screenPtr); + d /= WidthMMOfScreen(screenPtr); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(d)); + } else if (objc - skip == 2) { + if (Tcl_GetDoubleFromObj(interp, objv[1+skip], &d) != TCL_OK) { return TCL_ERROR; } - - skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); - if (skip < 0) { - return TCL_ERROR; + d = (25.4 / 72) / d; + width = (int) (d * WidthOfScreen(screenPtr) + 0.5); + if (width <= 0) { + width = 1; } - screenPtr = Tk_Screen(tkwin); - if (objc - skip == 2) { - d = 25.4 / 72; - d *= WidthOfScreen(screenPtr); - d /= WidthMMOfScreen(screenPtr); - Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d); - } else if (objc - skip == 3) { - if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) { - return TCL_ERROR; - } - d = (25.4 / 72) / d; - width = (int) (d * WidthOfScreen(screenPtr) + 0.5); - if (width <= 0) { - width = 1; - } - height = (int) (d * HeightOfScreen(screenPtr) + 0.5); - if (height <= 0) { - height = 1; - } - WidthMMOfScreen(screenPtr) = width; - HeightMMOfScreen(screenPtr) = height; - } else { - Tcl_WrongNumArgs(interp, 2, objv, - "?-displayof window? ?factor?"); - return TCL_ERROR; + height = (int) (d * HeightOfScreen(screenPtr) + 0.5); + if (height <= 0) { + height = 1; } - break; + WidthMMOfScreen(screenPtr) = width; + HeightMMOfScreen(screenPtr) = height; + } else { + Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?factor?"); + return TCL_ERROR; } - case TK_USE_IM: { - TkDisplay *dispPtr; - int skip; + return TCL_OK; +} - if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "useinputmethods not accessible in a safe interpreter", - TCL_STATIC); - return TCL_ERROR; - } +int +UseinputmethodsCmd( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tk_Window tkwin = clientData; + TkDisplay *dispPtr; + int skip; - skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin); - if (skip < 0) { - return TCL_ERROR; - } - dispPtr = ((TkWindow *) tkwin)->dispPtr; - if ((objc - skip) == 3) { - /* - * In the case where TK_USE_INPUT_METHODS is not defined, this - * will be ignored and we will always return 0. That will indicate - * to the user that input methods are just not available. - */ + if (Tcl_IsSafe(interp)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "useinputmethods not accessible in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "INPUT_METHODS", NULL); + return TCL_ERROR; + } - int boolVal; + skip = TkGetDisplayOf(interp, objc-1, objv+1, &tkwin); + if (skip < 0) { + return TCL_ERROR; + } + dispPtr = ((TkWindow *) tkwin)->dispPtr; + if ((objc - skip) == 2) { + /* + * In the case where TK_USE_INPUT_METHODS is not defined, this + * will be ignored and we will always return 0. That will indicate + * to the user that input methods are just not available. + */ - if (Tcl_GetBooleanFromObj(interp, objv[2+skip], - &boolVal) != TCL_OK) { - return TCL_ERROR; - } -#ifdef TK_USE_INPUT_METHODS - if (boolVal) { - dispPtr->flags |= TK_DISPLAY_USE_IM; - } else { - dispPtr->flags &= ~TK_DISPLAY_USE_IM; - } -#endif /* TK_USE_INPUT_METHODS */ - } else if ((objc - skip) != 2) { - Tcl_WrongNumArgs(interp, 2, objv, - "?-displayof window? ?boolean?"); + int boolVal; + + if (Tcl_GetBooleanFromObj(interp, objv[1+skip], + &boolVal) != TCL_OK) { return TCL_ERROR; } - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), - (int) (dispPtr->flags & TK_DISPLAY_USE_IM)); - break; +#ifdef TK_USE_INPUT_METHODS + if (boolVal) { + dispPtr->flags |= TK_DISPLAY_USE_IM; + } else { + dispPtr->flags &= ~TK_DISPLAY_USE_IM; + } +#endif /* TK_USE_INPUT_METHODS */ + } else if ((objc - skip) != 1) { + Tcl_WrongNumArgs(interp, 1, objv, + "?-displayof window? ?boolean?"); + return TCL_ERROR; } - case TK_WINDOWINGSYSTEM: { - const char *windowingsystem; + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_USE_IM)); + return TCL_OK; +} - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } -#if defined(WIN32) - windowingsystem = "win32"; +int +WindowingsystemCmd( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + const char *windowingsystem; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } +#if defined(_WIN32) + windowingsystem = "win32"; #elif defined(MAC_OSX_TK) - windowingsystem = "aqua"; + windowingsystem = "aqua"; #else - windowingsystem = "x11"; + windowingsystem = "x11"; #endif - Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1); - break; - } - case TK_INACTIVE: { - int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); + Tcl_SetObjResult(interp, Tcl_NewStringObj(windowingsystem, -1)); + return TCL_OK; +} - if (skip < 0) { +int +InactiveCmd( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tk_Window tkwin = clientData; + int skip = TkGetDisplayOf(interp, objc - 1, objv + 1, &tkwin); + + if (skip < 0) { + return TCL_ERROR; + } + if (objc - skip == 1) { + long inactive; + + inactive = (Tcl_IsSafe(interp) ? -1 : + Tk_GetUserInactiveTime(Tk_Display(tkwin))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive)); + } else if (objc - skip == 2) { + const char *string; + + string = Tcl_GetString(objv[objc-1]); + if (strcmp(string, "reset") != 0) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": must be reset", string)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", + string, NULL); return TCL_ERROR; } - if (objc - skip == 2) { - long inactive; - - inactive = (Tcl_IsSafe(interp) ? -1 : - Tk_GetUserInactiveTime(Tk_Display(tkwin))); - Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive)); - - } else if (objc - skip == 3) { - char *string; - - string = Tcl_GetString(objv[objc-1]); - if (strcmp(string, "reset") != 0) { - Tcl_Obj *msg = Tcl_NewStringObj("bad option \"", -1); - - Tcl_AppendStringsToObj(msg, string, "\": must be reset", NULL); - Tcl_SetObjResult(interp, msg); - return TCL_ERROR; - } - if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "resetting the user inactivity timer " - "is not allowed in a safe interpreter", TCL_STATIC); - return TCL_ERROR; - } - Tk_ResetUserInactiveTime(Tk_Display(tkwin)); - Tcl_ResetResult(interp); - } else { - Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? ?reset?"); + if (Tcl_IsSafe(interp)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "resetting the user inactivity timer " + "is not allowed in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "INACTIVITY_TIMER", NULL); return TCL_ERROR; } - break; - } + Tk_ResetUserInactiveTime(Tk_Display(tkwin)); + Tcl_ResetResult(interp); + } else { + Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?reset?"); + return TCL_ERROR; } return TCL_OK; } @@ -909,9 +996,10 @@ Tk_TkwaitObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = clientData; int done, index; - static const char *optionStrings[] = { + int code = TCL_OK; + static const char *const optionStrings[] = { "variable", "visibility", "window", NULL }; enum options { @@ -930,18 +1018,22 @@ Tk_TkwaitObjCmd( switch ((enum options) index) { case TKWAIT_VARIABLE: - if (Tcl_TraceVar(interp, Tcl_GetString(objv[2]), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - WaitVariableProc, (ClientData) &done) != TCL_OK) { + if (Tcl_TraceVar2(interp, Tcl_GetString(objv[2]), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + WaitVariableProc, &done) != TCL_OK) { return TCL_ERROR; } 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]), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - WaitVariableProc, (ClientData) &done); + Tcl_UntraceVar2(interp, Tcl_GetString(objv[2]), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + WaitVariableProc, &done); break; case TKWAIT_VISIBILITY: { @@ -953,25 +1045,31 @@ Tk_TkwaitObjCmd( } Tk_CreateEventHandler(window, VisibilityChangeMask|StructureNotifyMask, - WaitVisibilityProc, (ClientData) &done); + WaitVisibilityProc, &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. */ Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]), - "\" was deleted before its visibility changed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" was deleted before its visibility changed", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "WAIT", "PREMATURE", NULL); return TCL_ERROR; } Tk_DeleteEventHandler(window, VisibilityChangeMask|StructureNotifyMask, - WaitVisibilityProc, (ClientData) &done); + WaitVisibilityProc, &done); break; } @@ -983,28 +1081,40 @@ Tk_TkwaitObjCmd( return TCL_ERROR; } Tk_CreateEventHandler(window, StructureNotifyMask, - WaitWindowProc, (ClientData) &done); + WaitWindowProc, &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 */ @@ -1016,7 +1126,7 @@ WaitVariableProc( const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - int *donePtr = (int *) clientData; + int *donePtr = clientData; *donePtr = 1; return NULL; @@ -1028,12 +1138,11 @@ WaitVisibilityProc( ClientData clientData, /* Pointer to integer to set to 1. */ XEvent *eventPtr) /* Information about event (not used). */ { - int *donePtr = (int *) clientData; + int *donePtr = clientData; if (eventPtr->type == VisibilityNotify) { *donePtr = 1; - } - if (eventPtr->type == DestroyNotify) { + } else if (eventPtr->type == DestroyNotify) { *donePtr = 2; } } @@ -1043,7 +1152,7 @@ WaitWindowProc( ClientData clientData, /* Pointer to integer to set to 1. */ XEvent *eventPtr) /* Information about event. */ { - int *donePtr = (int *) clientData; + int *donePtr = clientData; if (eventPtr->type == DestroyNotify) { *donePtr = 1; @@ -1075,9 +1184,10 @@ Tk_UpdateObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *updateOptions[] = {"idletasks", NULL}; + static const char *const updateOptions[] = {"idletasks", NULL}; int flags, index; TkDisplay *dispPtr; + int code = TCL_OK; if (objc == 1) { flags = TCL_DONT_WAIT; @@ -1102,12 +1212,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; } @@ -1115,11 +1248,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; } /* @@ -1147,10 +1283,9 @@ Tk_WinfoObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int index, x, y, width, height, useX, useY, class, skip; - char *string; + const char *string; TkWindow *winPtr; - Tk_Window tkwin; - Tcl_Obj *resultPtr; + Tk_Window tkwin = clientData; static const TkStateMap visualMap[] = { {PseudoColor, "pseudocolor"}, @@ -1161,7 +1296,7 @@ Tk_WinfoObjCmd( {StaticGray, "staticgray"}, {-1, NULL} }; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "cells", "children", "class", "colormapfull", "depth", "geometry", "height", "id", "ismapped", "manager", "name", "parent", @@ -1200,8 +1335,6 @@ Tk_WinfoObjCmd( WIN_VISUALSAVAILABLE }; - tkwin = (Tk_Window) clientData; - if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; @@ -1223,14 +1356,14 @@ Tk_WinfoObjCmd( } } winPtr = (TkWindow *) tkwin; - resultPtr = Tcl_GetObjResult(interp); switch ((enum options) index) { case WIN_CELLS: - Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries); + Tcl_SetObjResult(interp, + Tcl_NewIntObj(Tk_Visual(tkwin)->map_entries)); break; case WIN_CHILDREN: { - Tcl_Obj *strPtr; + Tcl_Obj *strPtr, *resultPtr = Tcl_NewObj(); winPtr = winPtr->childList; for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) { @@ -1239,57 +1372,50 @@ Tk_WinfoObjCmd( Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } } + Tcl_SetObjResult(interp, resultPtr); break; } case WIN_CLASS: - Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Class(tkwin), -1)); break; case WIN_COLORMAPFULL: - Tcl_SetBooleanObj(resultPtr, - TkpCmapStressed(tkwin, Tk_Colormap(tkwin))); + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(TkpCmapStressed(tkwin,Tk_Colormap(tkwin)))); break; case WIN_DEPTH: - Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Depth(tkwin))); break; - case WIN_GEOMETRY: { - char buf[16 + TCL_INTEGER_SPACE * 4]; - - sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin), - Tk_X(tkwin), Tk_Y(tkwin)); - Tcl_SetStringObj(resultPtr, buf, -1); + case WIN_GEOMETRY: + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d+%d+%d", + Tk_Width(tkwin), Tk_Height(tkwin), Tk_X(tkwin), Tk_Y(tkwin))); break; - } case WIN_HEIGHT: - Tcl_SetIntObj(resultPtr, Tk_Height(tkwin)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Height(tkwin))); break; case WIN_ID: { char buf[TCL_INTEGER_SPACE]; Tk_MakeWindowExist(tkwin); TkpPrintWindowId(buf, Tk_WindowId(tkwin)); - - /* - * interp result may have changed, refetch it - */ - - resultPtr = Tcl_GetObjResult(interp); - Tcl_SetStringObj(resultPtr, buf, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); break; } case WIN_ISMAPPED: - Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tk_IsMapped(tkwin))); break; case WIN_MANAGER: if (winPtr->geomMgrPtr != NULL) { - Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(winPtr->geomMgrPtr->name, -1)); } break; case WIN_NAME: - Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_Name(tkwin), -1)); break; case WIN_PARENT: if (winPtr->parentPtr != NULL) { - Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(winPtr->parentPtr->pathName, -1)); } break; case WIN_POINTERX: @@ -1313,54 +1439,58 @@ Tk_WinfoObjCmd( TkGetPointerCoords((Tk_Window) winPtr, &x, &y); } if (useX & useY) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *xyObj[2]; - sprintf(buf, "%d %d", x, y); - Tcl_SetStringObj(resultPtr, buf, -1); + xyObj[0] = Tcl_NewIntObj(x); + xyObj[1] = Tcl_NewIntObj(y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, xyObj)); } else if (useX) { - Tcl_SetIntObj(resultPtr, x); + Tcl_SetObjResult(interp, Tcl_NewIntObj(x)); } else { - Tcl_SetIntObj(resultPtr, y); + Tcl_SetObjResult(interp, Tcl_NewIntObj(y)); } break; case WIN_REQHEIGHT: - Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqHeight(tkwin))); break; case WIN_REQWIDTH: - Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqWidth(tkwin))); break; case WIN_ROOTX: Tk_GetRootCoords(tkwin, &x, &y); - Tcl_SetIntObj(resultPtr, x); + Tcl_SetObjResult(interp, Tcl_NewIntObj(x)); break; case WIN_ROOTY: Tk_GetRootCoords(tkwin, &x, &y); - Tcl_SetIntObj(resultPtr, y); + Tcl_SetObjResult(interp, Tcl_NewIntObj(y)); break; - case WIN_SCREEN: { - char buf[TCL_INTEGER_SPACE]; - - sprintf(buf, "%d", Tk_ScreenNumber(tkwin)); - Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin),".",buf, NULL); + case WIN_SCREEN: + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s.%d", + Tk_DisplayName(tkwin), Tk_ScreenNumber(tkwin))); break; - } case WIN_SCREENCELLS: - Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin))); + Tcl_SetObjResult(interp, + Tcl_NewIntObj(CellsOfScreen(Tk_Screen(tkwin)))); break; case WIN_SCREENDEPTH: - Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin))); + Tcl_SetObjResult(interp, + Tcl_NewIntObj(DefaultDepthOfScreen(Tk_Screen(tkwin)))); break; case WIN_SCREENHEIGHT: - Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin))); + Tcl_SetObjResult(interp, + Tcl_NewIntObj(HeightOfScreen(Tk_Screen(tkwin)))); break; case WIN_SCREENWIDTH: - Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin))); + Tcl_SetObjResult(interp, + Tcl_NewIntObj(WidthOfScreen(Tk_Screen(tkwin)))); break; case WIN_SCREENMMHEIGHT: - Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin))); + Tcl_SetObjResult(interp, + Tcl_NewIntObj(HeightMMOfScreen(Tk_Screen(tkwin)))); break; case WIN_SCREENMMWIDTH: - Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin))); + Tcl_SetObjResult(interp, + Tcl_NewIntObj(WidthMMOfScreen(Tk_Screen(tkwin)))); break; case WIN_SCREENVISUAL: class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class; @@ -1371,7 +1501,7 @@ Tk_WinfoObjCmd( case WIN_TOPLEVEL: winPtr = GetTopHierarchy(tkwin); if (winPtr != NULL) { - Tcl_SetStringObj(resultPtr, winPtr->pathName, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->pathName, -1)); } break; case WIN_VIEWABLE: { @@ -1387,7 +1517,7 @@ Tk_WinfoObjCmd( } } - Tcl_SetBooleanObj(resultPtr, viewable); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(viewable)); break; } case WIN_VISUAL: @@ -1398,40 +1528,36 @@ Tk_WinfoObjCmd( if (string == NULL) { string = "unknown"; } - Tcl_SetStringObj(resultPtr, string, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(string, -1)); break; - case WIN_VISUALID: { - char buf[TCL_INTEGER_SPACE]; - - sprintf(buf, "0x%x", - (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin))); - Tcl_SetStringObj(resultPtr, buf, -1); + case WIN_VISUALID: + Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned) + XVisualIDFromVisual(Tk_Visual(tkwin)))); break; - } case WIN_VROOTHEIGHT: Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_SetIntObj(resultPtr, height); + Tcl_SetObjResult(interp, Tcl_NewIntObj(height)); break; case WIN_VROOTWIDTH: Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_SetIntObj(resultPtr, width); + Tcl_SetObjResult(interp, Tcl_NewIntObj(width)); break; case WIN_VROOTX: Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_SetIntObj(resultPtr, x); + Tcl_SetObjResult(interp, Tcl_NewIntObj(x)); break; case WIN_VROOTY: Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height); - Tcl_SetIntObj(resultPtr, y); + Tcl_SetObjResult(interp, Tcl_NewIntObj(y)); break; case WIN_WIDTH: - Tcl_SetIntObj(resultPtr, Tk_Width(tkwin)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Width(tkwin))); break; case WIN_X: - Tcl_SetIntObj(resultPtr, Tk_X(tkwin)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_X(tkwin))); break; case WIN_Y: - Tcl_SetIntObj(resultPtr, Tk_Y(tkwin)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Y(tkwin))); break; /* @@ -1449,7 +1575,8 @@ Tk_WinfoObjCmd( } objv += skip; string = Tcl_GetString(objv[2]); - Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string)); + Tcl_SetObjResult(interp, + Tcl_NewLongObj((long) Tk_InternAtom(tkwin, string))); break; case WIN_ATOMNAME: { const char *name; @@ -1469,12 +1596,13 @@ Tk_WinfoObjCmd( } name = Tk_GetAtomName(tkwin, (Atom) id); if (strcmp(name, "?bad atom?") == 0) { - string = Tcl_GetString(objv[2]); - Tcl_AppendStringsToObj(resultPtr, - "no atom exists with id \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no atom exists with id \"%s\"", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "ATOM", + Tcl_GetString(objv[2]), NULL); return TCL_ERROR; } - Tcl_SetStringObj(resultPtr, name, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); break; } case WIN_CONTAINING: @@ -1498,7 +1626,7 @@ Tk_WinfoObjCmd( } tkwin = Tk_CoordsToWindow(x, y, tkwin); if (tkwin != NULL) { - Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1)); } break; case WIN_INTERPS: @@ -1526,11 +1654,13 @@ Tk_WinfoObjCmd( if (TkpScanWindowId(interp, string, &id) != TCL_OK) { return TCL_ERROR; } - winPtr = (TkWindow *)Tk_IdToWindow(Tk_Display(tkwin), id); + winPtr = (TkWindow *) Tk_IdToWindow(Tk_Display(tkwin), id); if ((winPtr == NULL) || (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { - Tcl_AppendStringsToObj(resultPtr, "window id \"", string, - "\" doesn't exist in this application", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window id \"%s\" doesn't exist in this application", + string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", string, NULL); return TCL_ERROR; } @@ -1542,7 +1672,7 @@ Tk_WinfoObjCmd( tkwin = (Tk_Window) winPtr; if (Tk_PathName(tkwin) != NULL) { - Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin),-1)); } break; } @@ -1561,13 +1691,12 @@ Tk_WinfoObjCmd( string = Tcl_GetString(objv[2]); winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin); Tcl_ResetResult(interp); - resultPtr = Tcl_GetObjResult(interp); alive = 1; if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) { alive = 0; } - Tcl_SetBooleanObj(resultPtr, alive); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(alive)); break; } case WIN_FPIXELS: { @@ -1577,9 +1706,7 @@ Tk_WinfoObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "window number"); return TCL_ERROR; } - string = Tcl_GetString(objv[2]); - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { + if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) { return TCL_ERROR; } string = Tcl_GetString(objv[3]); @@ -1588,7 +1715,7 @@ Tk_WinfoObjCmd( } pixels = mm * WidthOfScreen(Tk_Screen(tkwin)) / WidthMMOfScreen(Tk_Screen(tkwin)); - Tcl_SetDoubleObj(resultPtr, pixels); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(pixels)); break; } case WIN_PIXELS: { @@ -1598,47 +1725,40 @@ Tk_WinfoObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "window number"); return TCL_ERROR; } - string = Tcl_GetString(objv[2]); - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { + if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) { return TCL_ERROR; } string = Tcl_GetString(objv[3]); if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) { return TCL_ERROR; } - Tcl_SetIntObj(resultPtr, pixels); + Tcl_SetObjResult(interp, Tcl_NewIntObj(pixels)); break; } case WIN_RGB: { XColor *colorPtr; - char buf[TCL_INTEGER_SPACE * 3]; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "window colorName"); return TCL_ERROR; } - string = Tcl_GetString(objv[2]); - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { + if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) { return TCL_ERROR; } - string = Tcl_GetString(objv[3]); - colorPtr = Tk_GetColor(interp, tkwin, string); + colorPtr = Tk_GetColor(interp, tkwin, Tcl_GetString(objv[3])); if (colorPtr == NULL) { return TCL_ERROR; } - sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green, - colorPtr->blue); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%d %d %d", + colorPtr->red, colorPtr->green, colorPtr->blue)); Tk_FreeColor(colorPtr); - Tcl_SetStringObj(resultPtr, buf, -1); break; } case WIN_VISUALSAVAILABLE: { XVisualInfo template, *visInfoPtr; int count, i; int includeVisualId; - Tcl_Obj *strPtr; + Tcl_Obj *strPtr, *resultPtr; char buf[16 + TCL_INTEGER_SPACE]; char visualIdString[TCL_INTEGER_SPACE]; @@ -1652,9 +1772,7 @@ Tk_WinfoObjCmd( return TCL_ERROR; } - string = Tcl_GetString(objv[2]); - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { + if (TkGetWindowFromObj(interp, tkwin, objv[2], &tkwin) != TCL_OK) { return TCL_ERROR; } @@ -1662,10 +1780,12 @@ Tk_WinfoObjCmd( visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask, &template, &count); if (visInfoPtr == NULL) { - Tcl_SetStringObj(resultPtr, - "can't find any visuals for screen", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find any visuals for screen", -1)); + Tcl_SetErrorCode(interp, "TK", "VISUAL", "NONE", NULL); return TCL_ERROR; } + resultPtr = Tcl_NewObj(); for (i = 0; i < count; i++) { string = TkFindStateString(visualMap, visInfoPtr[i].class); if (string == NULL) { @@ -1675,12 +1795,13 @@ Tk_WinfoObjCmd( } if (includeVisualId) { sprintf(visualIdString, " 0x%x", - (unsigned int) visInfoPtr[i].visualid); + (unsigned) visInfoPtr[i].visualid); strcat(buf, visualIdString); } strPtr = Tcl_NewStringObj(buf, -1); Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } + Tcl_SetObjResult(interp, resultPtr); XFree((char *) visInfoPtr); break; } @@ -1717,7 +1838,7 @@ Tk_WmObjCmd( Tk_Window tkwin; TkWindow *winPtr; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "aspect", "client", "command", "deiconify", "focusmodel", "frame", "geometry", "grid", "group", "iconbitmap", "iconify", "iconmask", @@ -1756,8 +1877,8 @@ Tk_WmObjCmd( return TCL_ERROR; } if (objc == 2) { - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_WM_TRACING)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + dispPtr->flags & TK_DISPLAY_WM_TRACING)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { @@ -1782,8 +1903,10 @@ Tk_WmObjCmd( return TCL_ERROR; } if (!(winPtr->flags & TK_TOP_LEVEL)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -1897,7 +2020,7 @@ Tk_WmObjCmd( updateGeom: if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } return TCL_OK; @@ -1944,7 +2067,7 @@ TkGetDisplayOf( * unmodified if "-displayof" argument was not * present. */ { - char *string; + const char *string; int length; if (objc < 1) { @@ -1954,8 +2077,9 @@ TkGetDisplayOf( if ((length >= 2) && (strncmp(string, "-displayof", (unsigned) length) == 0)) { if (objc < 2) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - "value for \"-displayof\" missing", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-displayof\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_VALUE", "DISPLAYOF", NULL); return -1; } *tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr); @@ -1970,7 +2094,7 @@ TkGetDisplayOf( /* *---------------------------------------------------------------------- * - * TkDeadAppCmd -- + * TkDeadAppObjCmd -- * * If an application has been deleted then all Tk commands will be * re-bound to this function. @@ -1987,14 +2111,15 @@ TkGetDisplayOf( /* ARGSUSED */ int -TkDeadAppCmd( +TkDeadAppObjCmd( ClientData clientData, /* Dummy. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { - Tcl_AppendResult(interp, "can't invoke \"", argv[0], - "\" command: application has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't invoke \"%s\" command: application has been destroyed", + Tcl_GetString(objv[0]))); return TCL_ERROR; } diff --git a/generic/tkColor.c b/generic/tkColor.c index 76d0baa..9abb448 100644 --- a/generic/tkColor.c +++ b/generic/tkColor.c @@ -42,6 +42,7 @@ static Tcl_ThreadDataKey dataKey; static void ColorInit(TkDisplay *dispPtr); static void DupColorObjProc(Tcl_Obj *srcObjPtr,Tcl_Obj *dupObjPtr); +static void FreeColorObj(Tcl_Obj *objPtr); static void FreeColorObjProc(Tcl_Obj *objPtr); static void InitColorObj(Tcl_Obj *objPtr); @@ -51,7 +52,7 @@ static void InitColorObj(Tcl_Obj *objPtr); * of the Tcl_Obj points to a TkColor object. */ -Tcl_ObjType tkColorObjType = { +const Tcl_ObjType tkColorObjType = { "color", /* name */ FreeColorObjProc, /* freeIntRepProc */ DupColorObjProc, /* dupIntRepProc */ @@ -111,7 +112,7 @@ Tk_AllocColorFromObj( * longer in use. Clear the reference. */ - FreeColorObjProc(objPtr); + FreeColorObj(objPtr); tkColPtr = NULL; } else if ((Tk_Screen(tkwin) == tkColPtr->screen) && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { @@ -129,14 +130,14 @@ Tk_AllocColorFromObj( if (tkColPtr != NULL) { TkColor *firstColorPtr = Tcl_GetHashValue(tkColPtr->hashPtr); - FreeColorObjProc(objPtr); + FreeColorObj(objPtr); for (tkColPtr = firstColorPtr; tkColPtr != NULL; tkColPtr = tkColPtr->nextPtr) { if ((Tk_Screen(tkwin) == tkColPtr->screen) && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { tkColPtr->resourceRefCount++; tkColPtr->objRefCount++; - objPtr->internalRep.twoPtrValue.ptr1 = (void *) tkColPtr; + objPtr->internalRep.twoPtrValue.ptr1 = tkColPtr; return (XColor *) tkColPtr; } } @@ -147,7 +148,7 @@ Tk_AllocColorFromObj( */ tkColPtr = (TkColor *) Tk_GetColor(interp, tkwin, Tcl_GetString(objPtr)); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) tkColPtr; + objPtr->internalRep.twoPtrValue.ptr1 = tkColPtr; if (tkColPtr != NULL) { tkColPtr->objRefCount++; } @@ -223,11 +224,13 @@ Tk_GetColor( if (tkColPtr == NULL) { if (interp != NULL) { if (*name == '#') { - Tcl_AppendResult(interp, "invalid color name \"", name, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); } else { - Tcl_AppendResult(interp, "unknown color name \"", name, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color name \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "COLOR", name, NULL); } } if (isNew) { @@ -356,7 +359,7 @@ Tk_GetColorByValue( *-------------------------------------------------------------- */ -CONST char * +const char * Tk_NameOfColor( XColor *colorPtr) /* Color whose name is desired. */ { @@ -365,11 +368,30 @@ Tk_NameOfColor( if (tkColPtr->magic==COLOR_MAGIC && tkColPtr->type==TK_COLOR_BY_NAME) { return tkColPtr->hashPtr->key.string; } else { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red, colorPtr->green, colorPtr->blue); + + /* + * If the string has the form #RSRSTUTUVWVW (where equal letters + * denote equal hexdigits) then this is equivalent to #RSTUVW. Then + * output the shorter form. + */ + + if ((tsdPtr->rgbString[1] == tsdPtr->rgbString[3]) + && (tsdPtr->rgbString[2] == tsdPtr->rgbString[4]) + && (tsdPtr->rgbString[5] == tsdPtr->rgbString[7]) + && (tsdPtr->rgbString[6] == tsdPtr->rgbString[8]) + && (tsdPtr->rgbString[9] == tsdPtr->rgbString[11]) + && (tsdPtr->rgbString[10] == tsdPtr->rgbString[12])) { + tsdPtr->rgbString[3] = tsdPtr->rgbString[5]; + tsdPtr->rgbString[4] = tsdPtr->rgbString[6]; + tsdPtr->rgbString[5] = tsdPtr->rgbString[9]; + tsdPtr->rgbString[6] = tsdPtr->rgbString[10]; + tsdPtr->rgbString[7] = '\0'; + } return tsdPtr->rgbString; } } @@ -496,7 +518,7 @@ Tk_FreeColor( */ if (tkColPtr->objRefCount == 0) { - ckfree((char *) tkColPtr); + ckfree(tkColPtr); } } @@ -528,13 +550,13 @@ Tk_FreeColorFromObj( Tcl_Obj *objPtr) /* The Tcl_Obj * to be freed. */ { Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr)); - FreeColorObjProc(objPtr); + FreeColorObj(objPtr); } /* *--------------------------------------------------------------------------- * - * FreeColorObjProc -- + * FreeColorObjProc, FreeColorObj -- * * This proc is called to release an object reference to a color. Called * when the object's internal rep is released or when the cached tkColPtr @@ -554,13 +576,21 @@ static void FreeColorObjProc( Tcl_Obj *objPtr) /* The object we are releasing. */ { - TkColor *tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; + FreeColorObj(objPtr); + objPtr->typePtr = NULL; +} + +static void +FreeColorObj( + Tcl_Obj *objPtr) /* The object we are releasing. */ +{ + TkColor *tkColPtr = objPtr->internalRep.twoPtrValue.ptr1; if (tkColPtr != NULL) { tkColPtr->objRefCount--; if ((tkColPtr->objRefCount == 0) && (tkColPtr->resourceRefCount == 0)) { - ckfree((char *) tkColPtr); + ckfree(tkColPtr); } objPtr->internalRep.twoPtrValue.ptr1 = NULL; } @@ -589,10 +619,10 @@ DupColorObjProc( Tcl_Obj *srcObjPtr, /* The object we are copying from. */ Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { - TkColor *tkColPtr = (TkColor *) srcObjPtr->internalRep.twoPtrValue.ptr1; + TkColor *tkColPtr = srcObjPtr->internalRep.twoPtrValue.ptr1; dupObjPtr->typePtr = srcObjPtr->typePtr; - dupObjPtr->internalRep.twoPtrValue.ptr1 = (void *) tkColPtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = tkColPtr; if (tkColPtr != NULL) { tkColPtr->objRefCount++; @@ -639,7 +669,7 @@ Tk_GetColorFromObj( * map. If it is, we are done. */ - tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; + tkColPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((tkColPtr != NULL) && (tkColPtr->resourceRefCount > 0) && (Tk_Screen(tkwin) == tkColPtr->screen) @@ -669,8 +699,8 @@ Tk_GetColorFromObj( (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) { if ((Tk_Screen(tkwin) == tkColPtr->screen) && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { - FreeColorObjProc(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) tkColPtr; + FreeColorObj(objPtr); + objPtr->internalRep.twoPtrValue.ptr1 = tkColPtr; tkColPtr->objRefCount++; return (XColor *) tkColPtr; } @@ -715,7 +745,7 @@ InitColorObj( Tcl_GetString(objPtr); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &tkColorObjType; objPtr->internalRep.twoPtrValue.ptr1 = NULL; @@ -772,7 +802,7 @@ Tcl_Obj * TkDebugColor( Tk_Window tkwin, /* The window in which the color will be used * (not currently used). */ - char *name) /* Name of the desired color. */ + const char *name) /* Name of the desired color. */ { Tcl_HashEntry *hashPtr; Tcl_Obj *resultPtr; @@ -799,30 +829,30 @@ TkDebugColor( return resultPtr; } -#ifndef __WIN32__ +#ifndef _WIN32 /* This function is not necessary for Win32, * since XParseColor already does the right thing */ #undef XParseColor -CONST char *CONST tkWebColors[20] = { +const char *const tkWebColors[20] = { /* 'a' */ "qua\0#0000ffffffff", /* 'b' */ NULL, /* 'c' */ "rimson\0#dcdc14143c3c", /* 'd' */ NULL, /* 'e' */ NULL, /* 'f' */ "uchsia\0#ffff0000ffff", - /* 'g' */ NULL, + /* 'g' */ "reen\0#000080800000", /* 'h' */ NULL, /* 'i' */ "ndigo\0#4b4b00008282", /* 'j' */ NULL, /* 'k' */ NULL, /* 'l' */ "ime\0#0000ffff0000", - /* 'm' */ NULL, + /* 'm' */ "aroon\0#808000000000", /* 'n' */ NULL, /* 'o' */ "live\0#808080800000", - /* 'p' */ NULL, + /* 'p' */ "urple\0#808000008080", /* 'q' */ NULL, /* 'r' */ NULL, /* 's' */ "ilver\0#c0c0c0c0c0c0", @@ -883,25 +913,31 @@ TkParseColor( } goto done; } else if (((*name - 'A') & 0xdf) < sizeof(tkWebColors)/sizeof(tkWebColors[0])) { - const char *p = tkWebColors[((*name - 'A') & 0x1f)]; - if (p) { - const char *q = name; - while (!((*p - *(++q)) & 0xdf)) { - if (!*p++) { - name = p; - goto done; + if (!((name[0] - 'G') & 0xdf) && !((name[1] - 'R') & 0xdf) + && !((name[2] - 'A') & 0xdb) && !((name[3] - 'Y') & 0xdf) + && !name[4]) { + name = "#808080808080"; + goto done; + } else { + const char *p = tkWebColors[((*name - 'A') & 0x1f)]; + if (p) { + const char *q = name; + while (!((*p - *(++q)) & 0xdf)) { + if (!*p++) { + name = p; + goto done; + } } } } } if (strlen(name) > 99) { - /* Don't bother to parse this. [Bug 2809525]*/ return 0; } done: return XParseColor(display, map, name, color); } -#endif /* __WIN32__ */ +#endif /* _WIN32 */ /* * Local Variables: * mode: c diff --git a/generic/tkColor.h b/generic/tkColor.h index d4679cf..05ef295 100644 --- a/generic/tkColor.h +++ b/generic/tkColor.h @@ -12,12 +12,7 @@ #ifndef _TKCOLOR #define _TKCOLOR -#include <tkInt.h> - -#ifdef BUILD_tk -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT -#endif +#include "tkInt.h" /* * One of the following data structures is used to keep track of each color @@ -77,7 +72,4 @@ MODULE_SCOPE void TkpFreeColor(TkColor *tkColPtr); MODULE_SCOPE TkColor * TkpGetColor(Tk_Window tkwin, Tk_Uid name); MODULE_SCOPE TkColor * TkpGetColorByValue(Tk_Window tkwin, XColor *colorPtr); -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TKCOLOR */ diff --git a/generic/tkConfig.c b/generic/tkConfig.c index f2eaa33..9c159e6 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -27,11 +27,16 @@ #include "tkFont.h" /* - * The following definition is an AssocData key used to keep track of all of - * the option tables that have been created for an interpreter. + * The following definition keeps track of all of + * the option tables that have been created for a thread. */ -#define OPTION_HASH_KEY "TkOptionTable" +typedef struct ThreadSpecificData { + int initialized; /* 0 means table below needs initializing. */ + Tcl_HashTable hashTable; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + /* * The following two structures are used along with Tk_OptionSpec structures @@ -63,7 +68,7 @@ typedef struct TkOption { struct TkOption *synonymPtr; /* For synonym options, this points to the * master entry. */ - struct Tk_ObjCustomOption *custom; + const struct Tk_ObjCustomOption *custom; /* For TK_OPTION_CUSTOM. */ } extra; int flags; /* Miscellaneous flag values; see below for @@ -113,8 +118,6 @@ typedef struct OptionTable { static int DoObjConfig(Tcl_Interp *interp, char *recordPtr, Option *optionPtr, Tcl_Obj *valuePtr, Tk_Window tkwin, Tk_SavedOption *savePtr); -static void DestroyOptionHashTable(ClientData clientData, - Tcl_Interp *interp); static void FreeResources(Option *optionPtr, Tcl_Obj *objPtr, char *internalPtr, Tk_Window tkwin); static Tcl_Obj * GetConfigList(char *recordPtr, @@ -125,7 +128,8 @@ static Option * GetOption(const char *name, OptionTable *tablePtr); static Option * GetOptionFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, OptionTable *tablePtr); static int ObjectIsEmpty(Tcl_Obj *objPtr); -static int SetOptionFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void FreeOptionInternalRep(Tcl_Obj *objPtr); +static void DupOptionInternalRep(Tcl_Obj *, Tcl_Obj *); /* * The structure below defines an object type that is used to cache the result @@ -134,12 +138,12 @@ static int SetOptionFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); * the internalPtr2 field points to the entry that matched. */ -Tcl_ObjType tkOptionObjType = { +static const Tcl_ObjType optionObjType = { "option", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ + FreeOptionInternalRep, /* freeIntRepProc */ + DupOptionInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetOptionFromAny /* setFromAnyProc */ + NULL /* setFromAnyProc */ }; /* @@ -168,31 +172,26 @@ Tk_CreateOptionTable( /* Static information about the configuration * options. */ { - Tcl_HashTable *hashTablePtr; Tcl_HashEntry *hashEntryPtr; int newEntry; OptionTable *tablePtr; const Tk_OptionSpec *specPtr, *specPtr2; Option *optionPtr; int numOptions, i; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* - * We use an AssocData value in the interpreter to keep a hash table of - * all the option tables we've created for this application. This is used - * for two purposes. First, it allows us to share the tables (e.g. in - * several chains) and second, we use the deletion callback for the - * AssocData to delete all the option tables when the interpreter is - * deleted. The code below finds the hash table or creates a new one if it + * We use an TSD in the thread to keep a hash table of + * all the option tables we've created for this application. This is + * used for allowing us to share the tables (e.g. in several chains). + * The code below finds the hash table or creates a new one if it * doesn't already exist. */ - hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY, - NULL); - if (hashTablePtr == NULL) { - hashTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); - Tcl_InitHashTable(hashTablePtr, TCL_ONE_WORD_KEYS); - Tcl_SetAssocData(interp, OPTION_HASH_KEY, DestroyOptionHashTable, - (ClientData) hashTablePtr); + if (!tsdPtr->initialized) { + Tcl_InitHashTable(&tsdPtr->hashTable, TCL_ONE_WORD_KEYS); + tsdPtr->initialized = 1; } /* @@ -200,10 +199,10 @@ Tk_CreateOptionTable( * reuse the existing table. */ - hashEntryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) templatePtr, + hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->hashTable, (char *) templatePtr, &newEntry); if (!newEntry) { - tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr); + tablePtr = Tcl_GetHashValue(hashEntryPtr); tablePtr->refCount++; return (Tk_OptionTable) tablePtr; } @@ -217,8 +216,7 @@ Tk_CreateOptionTable( for (specPtr = templatePtr; specPtr->type != TK_OPTION_END; specPtr++) { numOptions++; } - tablePtr = (OptionTable *) (ckalloc(sizeof(OptionTable) - + (numOptions * sizeof(Option)))); + tablePtr = ckalloc(sizeof(OptionTable) + (numOptions * sizeof(Option))); tablePtr->refCount = 1; tablePtr->hashEntryPtr = hashEntryPtr; tablePtr->nextPtr = NULL; @@ -268,7 +266,7 @@ Tk_CreateOptionTable( || (specPtr->type == TK_OPTION_BORDER)) && (specPtr->clientData != NULL)) { optionPtr->extra.monoColorPtr = - Tcl_NewStringObj((char *) specPtr->clientData, -1); + Tcl_NewStringObj(specPtr->clientData, -1); Tcl_IncrRefCount(optionPtr->extra.monoColorPtr); } @@ -276,8 +274,8 @@ Tk_CreateOptionTable( /* * Get the custom parsing, etc., functions. */ - optionPtr->extra.custom = - (Tk_ObjCustomOption *) specPtr->clientData; + + optionPtr->extra.custom = specPtr->clientData; } } if (((specPtr->type == TK_OPTION_STRING) @@ -301,8 +299,8 @@ Tk_CreateOptionTable( */ if (specPtr->clientData != NULL) { - tablePtr->nextPtr = (OptionTable *) Tk_CreateOptionTable(interp, - (Tk_OptionSpec *) specPtr->clientData); + tablePtr->nextPtr = (OptionTable *) + Tk_CreateOptionTable(interp, specPtr->clientData); } return (Tk_OptionTable) tablePtr; @@ -355,60 +353,7 @@ Tk_DeleteOptionTable( } } Tcl_DeleteHashEntry(tablePtr->hashEntryPtr); - ckfree((char *) tablePtr); -} - -/* - *---------------------------------------------------------------------- - * - * DestroyOptionHashTable -- - * - * This function is the deletion callback associated with the AssocData - * entry created by Tk_CreateOptionTable. It is invoked when an - * interpreter is deleted, and deletes all of the option tables - * associated with that interpreter. - * - * Results: - * None. - * - * Side effects: - * The option hash table is destroyed along with all of the OptionTable - * structures that it refers to. - * - *---------------------------------------------------------------------- - */ - -static void -DestroyOptionHashTable( - ClientData clientData, /* The hash table we are destroying */ - Tcl_Interp *interp) /* The interpreter we are destroying */ -{ - Tcl_HashTable *hashTablePtr = (Tcl_HashTable *) clientData; - Tcl_HashSearch search; - Tcl_HashEntry *hashEntryPtr; - OptionTable *tablePtr; - - for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search); - hashEntryPtr != NULL; - hashEntryPtr = Tcl_NextHashEntry(&search)) { - tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr); - - /* - * The following statements do two tricky things: - * 1. They ensure that the option table is deleted, even if there are - * outstanding references to it. - * 2. They ensure that Tk_DeleteOptionTable doesn't delete other - * tables chained from this one; we'll do it when we come across - * the hash table entry for the chained table (in fact, the chained - * table may already have been deleted). - */ - - tablePtr->refCount = 1; - tablePtr->nextPtr = NULL; - Tk_DeleteOptionTable((Tk_OptionTable) tablePtr); - } - Tcl_DeleteHashTable(hashTablePtr); - ckfree((char *) hashTablePtr); + ckfree(tablePtr); } /* @@ -710,7 +655,8 @@ DoObjConfig( break; } case TK_OPTION_STRING: { - char *newStr, *value; + char *newStr; + const char *value; int length; if (nullOK && ObjectIsEmpty(valuePtr)) { @@ -719,7 +665,7 @@ DoObjConfig( if (internalPtr != NULL) { if (valuePtr != NULL) { value = Tcl_GetStringFromObj(valuePtr, &length); - newStr = ckalloc((unsigned) (length + 1)); + newStr = ckalloc(length + 1); strcpy(newStr, value); } else { newStr = NULL; @@ -732,8 +678,8 @@ DoObjConfig( case TK_OPTION_STRING_TABLE: { int newValue; - if (Tcl_GetIndexFromObj(interp, valuePtr, - (const char **) optionPtr->specPtr->clientData, + if (Tcl_GetIndexFromObjStruct(interp, valuePtr, + optionPtr->specPtr->clientData, sizeof(char *), optionPtr->specPtr->optionName+1, 0, &newValue) != TCL_OK) { return TCL_ERROR; } @@ -930,7 +876,7 @@ DoObjConfig( break; } case TK_OPTION_CUSTOM: { - Tk_ObjCustomOption *custom = optionPtr->extra.custom; + const Tk_ObjCustomOption *custom = optionPtr->extra.custom; if (custom->setProc(custom->clientData, interp, tkwin, &valuePtr, recordPtr, optionPtr->specPtr->internalOffset, @@ -940,16 +886,13 @@ DoObjConfig( break; } - { - char buf[40+TCL_INTEGER_SPACE]; - default: - sprintf(buf, "bad config table: unknown type %d", - optionPtr->specPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad config table: unknown type %d", + optionPtr->specPtr->type)); + Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL); return TCL_ERROR; } - } /* * Release resources associated with the old value, if we're not returning @@ -1002,7 +945,7 @@ ObjectIsEmpty( if (objPtr->bytes != NULL) { return (objPtr->length == 0); } - Tcl_GetStringFromObj(objPtr, &length); + (void)Tcl_GetStringFromObj(objPtr, &length); return (length == 0); } @@ -1121,13 +1064,13 @@ GetOptionFromObj( OptionTable *tablePtr) /* Table in which to look up objPtr. */ { Option *bestPtr; - char *name; + const char *name; /* * First, check to see if the object already has the answer cached. */ - if (objPtr->typePtr == &tkOptionObjType) { + if (objPtr->typePtr == &optionObjType) { if (objPtr->internalRep.twoPtrValue.ptr1 == (void *) tablePtr) { return (Option *) objPtr->internalRep.twoPtrValue.ptr2; } @@ -1149,12 +1092,15 @@ GetOptionFromObj( } objPtr->internalRep.twoPtrValue.ptr1 = (void *) tablePtr; objPtr->internalRep.twoPtrValue.ptr2 = (void *) bestPtr; - objPtr->typePtr = &tkOptionObjType; + objPtr->typePtr = &optionObjType; + tablePtr->refCount++; return bestPtr; error: if (interp != NULL) { - Tcl_AppendResult(interp, "unknown option \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", name, NULL); } return NULL; } @@ -1199,32 +1145,55 @@ TkGetOptionSpec( /* *---------------------------------------------------------------------- * - * SetOptionFromAny -- + * FreeOptionInternalRep -- * - * This function is called to convert a Tcl object to option internal - * form. However, this doesn't make sense (need to have a table of - * options in order to do the conversion) so the function always - * generates an error. + * Part of the option Tcl object type implementation. Frees the storage + * associated with a option object's internal representation unless it + * is still in use. * * Results: - * The return value is always TCL_ERROR, and an error message is left in - * interp's result if interp isn't NULL. + * None. * * Side effects: - * None. + * The option object's internal rep is marked invalid and its memory + * gets freed unless it is still in use somewhere. In that case the + * cleanup is delayed until the last reference goes away. * *---------------------------------------------------------------------- */ -static int -SetOptionFromAny( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ +static void +FreeOptionInternalRep( + register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "can't convert value to option except via GetOptionFromObj API", - -1); - return TCL_ERROR; + register Tk_OptionTable tablePtr = (Tk_OptionTable) objPtr->internalRep.twoPtrValue.ptr1; + + Tk_DeleteOptionTable(tablePtr); + objPtr->typePtr = NULL; + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; +} + +/* + *--------------------------------------------------------------------------- + * + * DupOptionInternalRep -- + * + * When a cached option object is duplicated, this is called to update the + * internal reps. + * + *--------------------------------------------------------------------------- + */ + +static void +DupOptionInternalRep( + Tcl_Obj *srcObjPtr, /* The object we are copying from. */ + Tcl_Obj *dupObjPtr) /* The object we are copying to. */ +{ + register OptionTable *tablePtr = (OptionTable *) srcObjPtr->internalRep.twoPtrValue.ptr1; + tablePtr->refCount++; + dupObjPtr->typePtr = srcObjPtr->typePtr; + dupObjPtr->internalRep = srcObjPtr->internalRep; } /* @@ -1304,9 +1273,10 @@ Tk_SetOptions( if (objc < 2) { if (interp != NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "value for \"", Tcl_GetStringFromObj(*objv, NULL), - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", + Tcl_GetString(*objv))); + Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); goto error; } } @@ -1317,7 +1287,7 @@ Tk_SetOptions( * more space. */ - newSavePtr = (Tk_SavedOptions *) ckalloc(sizeof(Tk_SavedOptions)); + newSavePtr = ckalloc(sizeof(Tk_SavedOptions)); newSavePtr->recordPtr = recordPtr; newSavePtr->tkwin = tkwin; newSavePtr->numItems = 0; @@ -1328,11 +1298,9 @@ Tk_SetOptions( if (DoObjConfig(interp, recordPtr, optionPtr, objv[1], tkwin, (savePtr != NULL) ? &lastSavePtr->items[lastSavePtr->numItems] : NULL) != TCL_OK) { - char msg[100]; - - sprintf(msg, "\n (processing \"%.40s\" option)", - Tcl_GetStringFromObj(*objv, NULL)); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (processing \"%.40s\" option)", + Tcl_GetString(*objv))); goto error; } if (savePtr != NULL) { @@ -1393,7 +1361,7 @@ Tk_RestoreSavedOptions( if (savePtr->nextPtr != NULL) { Tk_RestoreSavedOptions(savePtr->nextPtr); - ckfree((char *) savePtr->nextPtr); + ckfree(savePtr->nextPtr); savePtr->nextPtr = NULL; } for (i = savePtr->numItems - 1; i >= 0; i--) { @@ -1433,6 +1401,7 @@ Tk_RestoreSavedOptions( if (specPtr->internalOffset >= 0) { register char *ptr = (char *) &savePtr->items[i].internalForm; + CLANG_ASSERT(internalPtr); switch (specPtr->type) { case TK_OPTION_BOOLEAN: *((int *) internalPtr) = *((int *) ptr); @@ -1484,7 +1453,7 @@ Tk_RestoreSavedOptions( *((Tk_Window *) internalPtr) = *((Tk_Window *) ptr); break; case TK_OPTION_CUSTOM: { - Tk_ObjCustomOption *custom = optionPtr->extra.custom; + const Tk_ObjCustomOption *custom = optionPtr->extra.custom; if (custom->restoreProc != NULL) { custom->restoreProc(custom->clientData, savePtr->tkwin, @@ -1527,7 +1496,7 @@ Tk_FreeSavedOptions( if (savePtr->nextPtr != NULL) { Tk_FreeSavedOptions(savePtr->nextPtr); - ckfree((char *) savePtr->nextPtr); + ckfree(savePtr->nextPtr); } for (count = savePtr->numItems, savedOptionPtr = &savePtr->items[savePtr->numItems-1]; @@ -1709,7 +1678,7 @@ FreeResources( } break; case TK_OPTION_CUSTOM: { - Tk_ObjCustomOption *custom = optionPtr->extra.custom; + const Tk_ObjCustomOption *custom = optionPtr->extra.custom; if (internalFormExists && custom->freeProc != NULL) { custom->freeProc(custom->clientData, tkwin, internalPtr); } @@ -1729,7 +1698,6 @@ FreeResources( * single option or all the configuration options in a table. * * Results: - * This function normally returns a pointer to an object. If namePtr * isn't NULL, then the result object is a list with five elements: the * option's name, its database name, database class, default value, and @@ -2000,7 +1968,7 @@ GetObjectForOption( break; } case TK_OPTION_CUSTOM: { - Tk_ObjCustomOption *custom = optionPtr->extra.custom; + const Tk_ObjCustomOption *custom = optionPtr->extra.custom; objPtr = custom->getProc(custom->clientData, tkwin, recordPtr, optionPtr->specPtr->internalOffset); @@ -2106,15 +2074,14 @@ TkDebugConfig( * interpreter anymore. */ { OptionTable *tablePtr = (OptionTable *) table; - Tcl_HashTable *hashTablePtr; Tcl_HashEntry *hashEntryPtr; Tcl_HashSearch search; Tcl_Obj *objPtr; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); objPtr = Tcl_NewObj(); - hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY, - NULL); - if (hashTablePtr == NULL) { + if (!tablePtr || !tsdPtr->initialized) { return objPtr; } @@ -2123,7 +2090,7 @@ TkDebugConfig( * want still is valid. */ - for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search); + for (hashEntryPtr = Tcl_FirstHashEntry(&tsdPtr->hashTable, &search); hashEntryPtr != NULL; hashEntryPtr = Tcl_NextHashEntry(&search)) { if (tablePtr == (OptionTable *) Tcl_GetHashValue(hashEntryPtr)) { diff --git a/generic/tkConsole.c b/generic/tkConsole.c index 2cd2632..8bfbe9b 100644 --- a/generic/tkConsole.c +++ b/generic/tkConsole.c @@ -11,7 +11,7 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tk.h" +#include "tkInt.h" /* * Each console is associated with an instance of the ConsoleInfo struct. @@ -46,25 +46,25 @@ typedef struct ChannelData { static int ConsoleClose(ClientData instanceData, Tcl_Interp *interp); static void ConsoleDeleteProc(ClientData clientData); static void ConsoleEventProc(ClientData clientData, XEvent *eventPtr); -static int ConsoleHandle(ClientData instanceData, - int direction, ClientData *handlePtr); -static int ConsoleInput(ClientData instanceData, - char *buf, int toRead, int *errorCode); +static int ConsoleHandle(ClientData instanceData, int direction, + ClientData *handlePtr); +static int ConsoleInput(ClientData instanceData, char *buf, int toRead, + int *errorCode); static int ConsoleObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); -static int ConsoleOutput(ClientData instanceData, - CONST char *buf, int toWrite, int *errorCode); + int objc, Tcl_Obj *const objv[]); +static int ConsoleOutput(ClientData instanceData, const char *buf, + int toWrite, int *errorCode); static void ConsoleWatch(ClientData instanceData, int mask); static void DeleteConsoleInterp(ClientData clientData); static void InterpDeleteProc(ClientData clientData, Tcl_Interp *interp); static int InterpreterObjCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); /* * This structure describes the channel type structure for file based IO: */ -static Tcl_ChannelType consoleChannelType = { +static const Tcl_ChannelType consoleChannelType = { "console", /* Type name. */ TCL_CHANNEL_VERSION_4, /* v4 channel */ ConsoleClose, /* Close proc. */ @@ -84,7 +84,7 @@ static Tcl_ChannelType consoleChannelType = { NULL }; -#ifdef __WIN32__ +#ifdef _WIN32 #include <windows.h> /* @@ -166,7 +166,7 @@ ShouldUseConsoleChannel( */ if (fileType == FILE_TYPE_CHAR) { - dcb.DCBlength = sizeof( DCB ) ; + dcb.DCBlength = sizeof(DCB); if (!GetConsoleMode(handle, &consoleParams) && !GetCommState(handle, &dcb)) { /* @@ -223,13 +223,16 @@ Tk_InitConsoleChannels( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { return; } - consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int)sizeof(int)); + consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int) sizeof(int)); if (*consoleInitPtr) { - /* We've already initialized console channels in this thread. */ + /* + * We've already initialized console channels in this thread. + */ + return; } *consoleInitPtr = 1; @@ -240,74 +243,69 @@ Tk_InitConsoleChannels( if (!(doIn || doOut || doErr)) { /* - * No std channels should be tied to the console; - * Thus, no need to create the console + * No std channels should be tied to the console; thus, no need to + * create the console. */ + return; } /* - * At least one std channel wants to be tied to the console, - * so create the interp for it to live in. + * At least one std channel wants to be tied to the console, so create the + * interp for it to live in. */ - info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo)); + info = ckalloc(sizeof(ConsoleInfo)); info->consoleInterp = NULL; info->interp = NULL; info->refCount = 0; if (doIn) { - ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData)); + ChannelData *data = ckalloc(sizeof(ChannelData)); + data->info = info; data->info->refCount++; data->type = TCL_STDIN; consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0", - (ClientData) data, TCL_READABLE); + data, TCL_READABLE); if (consoleChannel != NULL) { - Tcl_SetChannelOption(NULL, consoleChannel, - "-translation", "lf"); - Tcl_SetChannelOption(NULL, consoleChannel, - "-buffering", "none"); - Tcl_SetChannelOption(NULL, consoleChannel, - "-encoding", "utf-8"); + Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf"); + Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none"); + Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8"); } Tcl_SetStdChannel(consoleChannel, TCL_STDIN); Tcl_RegisterChannel(NULL, consoleChannel); } if (doOut) { - ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData)); + ChannelData *data = ckalloc(sizeof(ChannelData)); + data->info = info; data->info->refCount++; data->type = TCL_STDOUT; consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1", - (ClientData) data, TCL_WRITABLE); + data, TCL_WRITABLE); if (consoleChannel != NULL) { - Tcl_SetChannelOption(NULL, consoleChannel, - "-translation", "lf"); - Tcl_SetChannelOption(NULL, consoleChannel, - "-buffering", "none"); - Tcl_SetChannelOption(NULL, consoleChannel, - "-encoding", "utf-8"); + Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf"); + Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none"); + Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8"); } Tcl_SetStdChannel(consoleChannel, TCL_STDOUT); Tcl_RegisterChannel(NULL, consoleChannel); } if (doErr) { - ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData)); + ChannelData *data = ckalloc(sizeof(ChannelData)); + data->info = info; data->info->refCount++; data->type = TCL_STDERR; consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2", - (ClientData) data, TCL_WRITABLE); + data, TCL_WRITABLE); if (consoleChannel != NULL) { - Tcl_SetChannelOption(NULL, consoleChannel, - "-translation", "lf"); - Tcl_SetChannelOption(NULL, consoleChannel, - "-buffering", "none"); - Tcl_SetChannelOption(NULL, consoleChannel, - "-encoding", "utf-8"); + Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf"); + Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none"); + Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8"); } Tcl_SetStdChannel(consoleChannel, TCL_STDERR); Tcl_RegisterChannel(NULL, consoleChannel); @@ -368,55 +366,60 @@ Tk_CreateConsoleWindow( } if (haveConsoleChannel) { - ChannelData *data = (ChannelData *)Tcl_GetChannelInstanceData(chan); + ChannelData *data = (ChannelData *) Tcl_GetChannelInstanceData(chan); info = data->info; if (info->consoleInterp) { - /* New ConsoleInfo for a new console window */ - info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo)); + /* + * New ConsoleInfo for a new console window. + */ + + info = ckalloc(sizeof(ConsoleInfo)); info->refCount = 0; - /* Update any console channels to make use of the new console */ + /* + * Update any console channels to make use of the new console. + */ + if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN)) == &consoleChannelType) { - data = (ChannelData *)Tcl_GetChannelInstanceData(chan); + data = (ChannelData *) Tcl_GetChannelInstanceData(chan); data->info->refCount--; data->info = info; data->info->refCount++; } if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT)) == &consoleChannelType) { - data = (ChannelData *)Tcl_GetChannelInstanceData(chan); + data = (ChannelData *) Tcl_GetChannelInstanceData(chan); data->info->refCount--; data->info = info; data->info->refCount++; } if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR)) == &consoleChannelType) { - data = (ChannelData *)Tcl_GetChannelInstanceData(chan); + data = (ChannelData *) Tcl_GetChannelInstanceData(chan); data->info->refCount--; data->info = info; data->info->refCount++; } } } else { - info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo)); + info = ckalloc(sizeof(ConsoleInfo)); info->refCount = 0; } info->consoleInterp = consoleInterp; info->interp = interp; - Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, (ClientData) info); + Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info); info->refCount++; - Tcl_CreateThreadExitHandler(DeleteConsoleInterp, - (ClientData) consoleInterp); + Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp); /* * Add console commands to the interp */ - token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, - (ClientData) info, ConsoleDeleteProc); + token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, info, + ConsoleDeleteProc); info->refCount++; /* @@ -425,16 +428,16 @@ Tk_CreateConsoleWindow( * handler takes care of us. */ Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd, - (ClientData) info, NULL); + info, NULL); mainWindow = Tk_MainWindow(interp); if (mainWindow) { Tk_CreateEventHandler(mainWindow, StructureNotifyMask, - ConsoleEventProc, (ClientData) info); + ConsoleEventProc, info); info->refCount++; } - Tcl_Preserve((ClientData) consoleInterp); + Tcl_Preserve(consoleInterp); result = Tcl_EvalEx(consoleInterp, "source $tk_library/console.tcl", -1, TCL_EVAL_GLOBAL); if (result == TCL_ERROR) { @@ -442,22 +445,22 @@ Tk_CreateConsoleWindow( Tcl_GetReturnOptions(consoleInterp, result)); Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp)); } - Tcl_Release((ClientData) consoleInterp); + Tcl_Release(consoleInterp); if (result == TCL_ERROR) { Tcl_DeleteCommandFromToken(interp, token); mainWindow = Tk_MainWindow(interp); if (mainWindow) { Tk_DeleteEventHandler(mainWindow, StructureNotifyMask, - ConsoleEventProc, (ClientData) info); + ConsoleEventProc, info); if (--info->refCount <= 0) { - ckfree((char *) info); + ckfree(info); } } goto error; } return TCL_OK; - error: + error: Tcl_AddErrorInfo(interp, "\n (creating console window)"); if (!Tcl_InterpDeleted(consoleInterp)) { Tcl_DeleteInterp(consoleInterp); @@ -486,11 +489,11 @@ Tk_CreateConsoleWindow( static int ConsoleOutput( ClientData instanceData, /* Indicates which device to use. */ - CONST char *buf, /* The data buffer. */ + const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ { - ChannelData *data = (ChannelData *)instanceData; + ChannelData *data = instanceData; ConsoleInfo *info = data->info; *errorCode = 0; @@ -509,7 +512,7 @@ ConsoleOutput( * Assumption is utf-8 Tcl_Encoding is reliably present. */ - CONST char *bytes + const char *bytes = Tcl_ExternalToUtfDString(utf8, buf, toWrite, &ds); int numBytes = Tcl_DStringLength(&ds); Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1); @@ -585,16 +588,19 @@ ConsoleClose( ClientData instanceData, /* Unused. */ Tcl_Interp *interp) /* Unused. */ { - ChannelData *data = (ChannelData *)instanceData; + ChannelData *data = instanceData; ConsoleInfo *info = data->info; if (info) { if (--info->refCount <= 0) { - /* Assuming the Tcl_Interp * fields must already be NULL */ - ckfree((char *) info); + /* + * Assuming the Tcl_Interp * fields must already be NULL. + */ + + ckfree(info); } } - ckfree((char *) data); + ckfree(data); return 0; } @@ -677,21 +683,22 @@ ConsoleObjCmd( ClientData clientData, /* Access to the console interp */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ - Tcl_Obj *CONST objv[]) /* Argument objects */ + Tcl_Obj *const objv[]) /* Argument objects */ { int index, result; - static CONST char *options[] = {"eval", "hide", "show", "title", NULL}; + static const char *const options[] = { + "eval", "hide", "show", "title", NULL}; enum option {CON_EVAL, CON_HIDE, CON_SHOW, CON_TITLE}; Tcl_Obj *cmd = NULL; - ConsoleInfo *info = (ConsoleInfo *) clientData; + ConsoleInfo *info = clientData; Tcl_Interp *consoleInterp = info->consoleInterp; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -727,18 +734,22 @@ ConsoleObjCmd( Tcl_ListObjAppendElement(NULL, cmd, objv[2]); } break; + default: + CLANG_ASSERT(0); } Tcl_IncrRefCount(cmd); if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) { - Tcl_Preserve((ClientData) consoleInterp); + Tcl_Preserve(consoleInterp); result = Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL); Tcl_SetReturnOptions(interp, Tcl_GetReturnOptions(consoleInterp, result)); Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp)); - Tcl_Release((ClientData) consoleInterp); + Tcl_Release(consoleInterp); } else { - Tcl_AppendResult(interp, "no active console interp", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no active console interp", -1)); + Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NONE", NULL); result = TCL_ERROR; } Tcl_DecrRefCount(cmd); @@ -764,20 +775,20 @@ InterpreterObjCmd( ClientData clientData, /* */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ - Tcl_Obj *CONST objv[]) /* Argument objects */ + Tcl_Obj *const objv[]) /* Argument objects */ { int index, result = TCL_OK; - static CONST char *options[] = {"eval", "record", NULL}; + static const char *const options[] = {"eval", "record", NULL}; enum option {OTHER_EVAL, OTHER_RECORD}; - ConsoleInfo *info = (ConsoleInfo *) clientData; + ConsoleInfo *info = clientData; Tcl_Interp *otherInterp = info->interp; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option arg"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -787,32 +798,38 @@ InterpreterObjCmd( } if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) { - Tcl_AppendResult(interp, "no active master interp", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no active master interp", -1)); + Tcl_SetErrorCode(interp, "TK", "CONSOLE", "NO_INTERP", NULL); return TCL_ERROR; } - Tcl_Preserve((ClientData) otherInterp); + Tcl_Preserve(otherInterp); switch ((enum option) index) { case OTHER_EVAL: result = Tcl_EvalObjEx(otherInterp, objv[2], TCL_EVAL_GLOBAL); + /* * TODO: Should exceptions be filtered here? */ + Tcl_SetReturnOptions(interp, Tcl_GetReturnOptions(otherInterp, result)); Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp)); break; case OTHER_RECORD: Tcl_RecordAndEvalObj(otherInterp, objv[2], TCL_EVAL_GLOBAL); + /* - * By not setting result, we discard any exceptions or errors here - * and always return TCL_OK. All the caller wants is the - * interp result to display, whether that's result or error message. + * By not setting result, we discard any exceptions or errors here and + * always return TCL_OK. All the caller wants is the interp result to + * display, whether that's result or error message. */ + Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp)); break; } - Tcl_Release((ClientData) otherInterp); + Tcl_Release(otherInterp); return result; } @@ -821,8 +838,8 @@ InterpreterObjCmd( * * DeleteConsoleInterp -- * - * Thread exit handler to destroy a console interp when the - * thread it lives in gets torn down. + * Thread exit handler to destroy a console interp when the thread it + * lives in gets torn down. * *---------------------------------------------------------------------- */ @@ -831,7 +848,8 @@ static void DeleteConsoleInterp( ClientData clientData) { - Tcl_Interp *interp = (Tcl_Interp *)clientData; + Tcl_Interp *interp = clientData; + Tcl_DeleteInterp(interp); } @@ -840,8 +858,8 @@ DeleteConsoleInterp( * * InterpDeleteProc -- * - * React when the interp in which the console is displayed is deleted - * for any reason. + * React when the interp in which the console is displayed is deleted for + * any reason. * * Results: * None. @@ -857,15 +875,14 @@ InterpDeleteProc( ClientData clientData, Tcl_Interp *interp) { - ConsoleInfo *info = (ConsoleInfo *) clientData; + ConsoleInfo *info = clientData; if (info->consoleInterp == interp) { - Tcl_DeleteThreadExitHandler(DeleteConsoleInterp, - (ClientData) info->consoleInterp); + Tcl_DeleteThreadExitHandler(DeleteConsoleInterp, info->consoleInterp); info->consoleInterp = NULL; } if (--info->refCount <= 0) { - ckfree((char *) info); + ckfree(info); } } @@ -890,13 +907,13 @@ static void ConsoleDeleteProc( ClientData clientData) { - ConsoleInfo *info = (ConsoleInfo *) clientData; + ConsoleInfo *info = clientData; if (info->consoleInterp) { Tcl_DeleteInterp(info->consoleInterp); } if (--info->refCount <= 0) { - ckfree((char *) info); + ckfree(info); } } @@ -925,7 +942,7 @@ ConsoleEventProc( XEvent *eventPtr) { if (eventPtr->type == DestroyNotify) { - ConsoleInfo *info = (ConsoleInfo *) clientData; + ConsoleInfo *info = clientData; Tcl_Interp *consoleInterp = info->consoleInterp; if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) { @@ -933,7 +950,7 @@ ConsoleEventProc( } if (--info->refCount <= 0) { - ckfree((char *) info); + ckfree(info); } } } diff --git a/generic/tkCursor.c b/generic/tkCursor.c index 410aea9..6b2d5f4 100644 --- a/generic/tkCursor.c +++ b/generic/tkCursor.c @@ -23,8 +23,8 @@ */ typedef struct { - CONST char *source; /* Cursor bits. */ - CONST char *mask; /* Mask bits. */ + const char *source; /* Cursor bits. */ + const char *mask; /* Mask bits. */ int width, height; /* Dimensions of cursor (and data and * mask). */ int xHot, yHot; /* Location of cursor hot-spot. */ @@ -40,9 +40,10 @@ static void CursorInit(TkDisplay *dispPtr); static void DupCursorObjProc(Tcl_Obj *srcObjPtr, Tcl_Obj *dupObjPtr); static void FreeCursor(TkCursor *cursorPtr); +static void FreeCursorObj(Tcl_Obj *objPtr); static void FreeCursorObjProc(Tcl_Obj *objPtr); -static TkCursor * TkcGetCursor(Tcl_Interp *interp, - Tk_Window tkwin, CONST char *name); +static TkCursor * TkcGetCursor(Tcl_Interp *interp, Tk_Window tkwin, + const char *name); static TkCursor * GetCursorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); static void InitCursorObj(Tcl_Obj *objPtr); @@ -54,7 +55,7 @@ static void InitCursorObj(Tcl_Obj *objPtr); * option is set. */ -Tcl_ObjType tkCursorObjType = { +Tcl_ObjType const tkCursorObjType = { "cursor", /* name */ FreeCursorObjProc, /* freeIntRepProc */ DupCursorObjProc, /* dupIntRepProc */ @@ -99,7 +100,7 @@ Tk_AllocCursorFromObj( if (objPtr->typePtr != &tkCursorObjType) { InitCursorObj(objPtr); } - cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; + cursorPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * If the object currently points to a TkCursor, see if it's the one we @@ -113,7 +114,7 @@ Tk_AllocCursorFromObj( * longer in use. Clear the reference. */ - FreeCursorObjProc(objPtr); + FreeCursorObj(objPtr); cursorPtr = NULL; } else if (Tk_Display(tkwin) == cursorPtr->display) { cursorPtr->resourceRefCount++; @@ -128,15 +129,15 @@ Tk_AllocCursorFromObj( */ if (cursorPtr != NULL) { - TkCursor *firstCursorPtr = (TkCursor *) - Tcl_GetHashValue(cursorPtr->hashPtr); - FreeCursorObjProc(objPtr); + TkCursor *firstCursorPtr = Tcl_GetHashValue(cursorPtr->hashPtr); + + FreeCursorObj(objPtr); for (cursorPtr = firstCursorPtr; cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) { if (Tk_Display(tkwin) == cursorPtr->display) { cursorPtr->resourceRefCount++; cursorPtr->objRefCount++; - objPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr; + objPtr->internalRep.twoPtrValue.ptr1 = cursorPtr; return cursorPtr->cursor; } } @@ -147,7 +148,7 @@ Tk_AllocCursorFromObj( */ cursorPtr = TkcGetCursor(interp, tkwin, Tcl_GetString(objPtr)); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr; + objPtr->internalRep.twoPtrValue.ptr1 = cursorPtr; if (cursorPtr == NULL) { return None; } @@ -187,6 +188,7 @@ Tk_GetCursor( * details on legal syntax. */ { TkCursor *cursorPtr = TkcGetCursor(interp, tkwin, string); + if (cursorPtr == NULL) { return None; } @@ -223,7 +225,7 @@ static TkCursor * TkcGetCursor( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tk_Window tkwin, /* Window in which cursor will be used. */ - CONST char *string) /* Description of cursor. See manual entry for + const char *string) /* Description of cursor. See manual entry for * details on legal syntax. */ { Tcl_HashEntry *nameHashPtr; @@ -237,9 +239,9 @@ TkcGetCursor( } nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable, - string, &isNew); + string, &isNew); if (!isNew) { - existingCursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr); + existingCursorPtr = Tcl_GetHashValue(nameHashPtr); for (cursorPtr = existingCursorPtr; cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) { if (Tk_Display(tkwin) == cursorPtr->display) { @@ -271,7 +273,7 @@ TkcGetCursor( cursorPtr->hashPtr = nameHashPtr; cursorPtr->nextPtr = existingCursorPtr; cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, - (char *) cursorPtr->cursor, &isNew); + (char *) cursorPtr->cursor, &isNew); if (!isNew) { Tcl_Panic("cursor already registered in Tk_GetCursor"); } @@ -309,8 +311,8 @@ Tk_Cursor Tk_GetCursorFromData( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tk_Window tkwin, /* Window in which cursor will be used. */ - CONST char *source, /* Bitmap data for cursor shape. */ - CONST char *mask, /* Bitmap data for cursor mask. */ + const char *source, /* Bitmap data for cursor shape. */ + const char *mask, /* Bitmap data for cursor mask. */ int width, int height, /* Dimensions of cursor. */ int xHot, int yHot, /* Location of hot-spot in cursor. */ Tk_Uid fg, /* Foreground color for cursor. */ @@ -337,9 +339,9 @@ Tk_GetCursorFromData( dataKey.bg = bg; dataKey.display = Tk_Display(tkwin); dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable, - (char *) &dataKey, &isNew); + (char *) &dataKey, &isNew); if (!isNew) { - cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr); + cursorPtr = Tcl_GetHashValue(dataHashPtr); cursorPtr->resourceRefCount++; return cursorPtr->cursor; } @@ -350,11 +352,15 @@ Tk_GetCursorFromData( */ if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", fg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", fg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL); goto error; } if (TkParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", bg, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", bg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", "COLOR", NULL); goto error; } @@ -370,7 +376,7 @@ Tk_GetCursorFromData( cursorPtr->hashPtr = dataHashPtr; cursorPtr->objRefCount = 0; cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, - (char *) cursorPtr->cursor, &isNew); + (char *) cursorPtr->cursor, &isNew); cursorPtr->nextPtr = NULL; if (!isNew) { @@ -405,7 +411,7 @@ Tk_GetCursorFromData( *-------------------------------------------------------------- */ -CONST char * +const char * Tk_NameOfCursor( Display *display, /* Display for which cursor was allocated. */ Tk_Cursor cursor) /* Identifier for cursor whose name is @@ -426,7 +432,7 @@ Tk_NameOfCursor( if (idHashPtr == NULL) { goto printid; } - cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr); + cursorPtr = Tcl_GetHashValue(idHashPtr); if (cursorPtr->otherTable != &dispPtr->cursorNameTable) { goto printid; } @@ -463,7 +469,7 @@ FreeCursor( } Tcl_DeleteHashEntry(cursorPtr->idHashPtr); - prevPtr = (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr); + prevPtr = Tcl_GetHashValue(cursorPtr->hashPtr); if (prevPtr == cursorPtr) { if (cursorPtr->nextPtr == NULL) { Tcl_DeleteHashEntry(cursorPtr->hashPtr); @@ -478,7 +484,7 @@ FreeCursor( } TkpFreeCursor(cursorPtr); if (cursorPtr->objRefCount == 0) { - ckfree((char *) cursorPtr); + ckfree(cursorPtr); } } @@ -516,7 +522,7 @@ Tk_FreeCursor( if (idHashPtr == NULL) { Tcl_Panic("Tk_FreeCursor received unknown cursor argument"); } - FreeCursor((TkCursor *) Tcl_GetHashValue(idHashPtr)); + FreeCursor(Tcl_GetHashValue(idHashPtr)); } /* @@ -547,13 +553,13 @@ Tk_FreeCursorFromObj( Tcl_Obj *objPtr) /* The Tcl_Obj * to be freed. */ { FreeCursor(GetCursorFromObj(tkwin, objPtr)); - FreeCursorObjProc(objPtr); + FreeCursorObj(objPtr); } /* *--------------------------------------------------------------------------- * - * FreeCursorFromObjProc -- + * FreeCursorObjProc, FreeCursorObj -- * * This proc is called to release an object reference to a cursor. * Called when the object's internal rep is released or when the cached @@ -573,13 +579,21 @@ static void FreeCursorObjProc( Tcl_Obj *objPtr) /* The object we are releasing. */ { - TkCursor *cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; + FreeCursorObj(objPtr); + objPtr->typePtr = NULL; +} + +static void +FreeCursorObj( + Tcl_Obj *objPtr) /* The object we are releasing. */ +{ + TkCursor *cursorPtr = objPtr->internalRep.twoPtrValue.ptr1; if (cursorPtr != NULL) { cursorPtr->objRefCount--; if ((cursorPtr->objRefCount == 0) && (cursorPtr->resourceRefCount == 0)) { - ckfree((char *) cursorPtr); + ckfree(cursorPtr); } objPtr->internalRep.twoPtrValue.ptr1 = NULL; } @@ -608,10 +622,10 @@ DupCursorObjProc( Tcl_Obj *srcObjPtr, /* The object we are copying from. */ Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { - TkCursor *cursorPtr = (TkCursor *) srcObjPtr->internalRep.twoPtrValue.ptr1; + TkCursor *cursorPtr = srcObjPtr->internalRep.twoPtrValue.ptr1; dupObjPtr->typePtr = srcObjPtr->typePtr; - dupObjPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = cursorPtr; if (cursorPtr != NULL) { cursorPtr->objRefCount++; @@ -693,7 +707,7 @@ GetCursorFromObj( * cached is the one that is needed. */ - cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; + cursorPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((cursorPtr != NULL) && (Tk_Display(tkwin) == cursorPtr->display)) { return cursorPtr; } @@ -708,11 +722,11 @@ GetCursorFromObj( if (hashPtr == NULL) { goto error; } - for (cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr); + for (cursorPtr = Tcl_GetHashValue(hashPtr); cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) { if (Tk_Display(tkwin) == cursorPtr->display) { - FreeCursorObjProc(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr; + FreeCursorObj(objPtr); + objPtr->internalRep.twoPtrValue.ptr1 = cursorPtr; cursorPtr->objRefCount++; return cursorPtr; } @@ -757,7 +771,7 @@ InitCursorObj( Tcl_GetString(objPtr); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &tkCursorObjType; objPtr->internalRep.twoPtrValue.ptr1 = NULL; @@ -830,7 +844,7 @@ Tcl_Obj * TkDebugCursor( Tk_Window tkwin, /* The window in which the cursor will be used * (not currently used). */ - char *name) /* Name of the desired color. */ + const char *name) /* Name of the desired color. */ { TkCursor *cursorPtr; Tcl_HashEntry *hashPtr; @@ -843,7 +857,7 @@ TkDebugCursor( resultPtr = Tcl_NewObj(); hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name); if (hashPtr != NULL) { - cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr); + cursorPtr = Tcl_GetHashValue(hashPtr); if (cursorPtr == NULL) { Tcl_Panic("TkDebugCursor found empty hash table entry"); } diff --git a/generic/tkDecls.h b/generic/tkDecls.h index 00a3dde..64c32cd 100644 --- a/generic/tkDecls.h +++ b/generic/tkDecls.h @@ -33,1679 +33,859 @@ extern "C" { * Exported function declarations: */ -#ifndef Tk_MainLoop_TCL_DECLARED -#define Tk_MainLoop_TCL_DECLARED /* 0 */ EXTERN void Tk_MainLoop(void); -#endif -#ifndef Tk_3DBorderColor_TCL_DECLARED -#define Tk_3DBorderColor_TCL_DECLARED /* 1 */ EXTERN XColor * Tk_3DBorderColor(Tk_3DBorder border); -#endif -#ifndef Tk_3DBorderGC_TCL_DECLARED -#define Tk_3DBorderGC_TCL_DECLARED /* 2 */ EXTERN GC Tk_3DBorderGC(Tk_Window tkwin, Tk_3DBorder border, int which); -#endif -#ifndef Tk_3DHorizontalBevel_TCL_DECLARED -#define Tk_3DHorizontalBevel_TCL_DECLARED /* 3 */ EXTERN void Tk_3DHorizontalBevel(Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftIn, int rightIn, int topBevel, int relief); -#endif -#ifndef Tk_3DVerticalBevel_TCL_DECLARED -#define Tk_3DVerticalBevel_TCL_DECLARED /* 4 */ EXTERN void Tk_3DVerticalBevel(Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftBevel, int relief); -#endif -#ifndef Tk_AddOption_TCL_DECLARED -#define Tk_AddOption_TCL_DECLARED /* 5 */ -EXTERN void Tk_AddOption(Tk_Window tkwin, CONST char *name, - CONST char *value, int priority); -#endif -#ifndef Tk_BindEvent_TCL_DECLARED -#define Tk_BindEvent_TCL_DECLARED +EXTERN void Tk_AddOption(Tk_Window tkwin, const char *name, + const char *value, int priority); /* 6 */ EXTERN void Tk_BindEvent(Tk_BindingTable bindingTable, XEvent *eventPtr, Tk_Window tkwin, int numObjects, ClientData *objectPtr); -#endif -#ifndef Tk_CanvasDrawableCoords_TCL_DECLARED -#define Tk_CanvasDrawableCoords_TCL_DECLARED /* 7 */ EXTERN void Tk_CanvasDrawableCoords(Tk_Canvas canvas, double x, double y, short *drawableXPtr, short *drawableYPtr); -#endif -#ifndef Tk_CanvasEventuallyRedraw_TCL_DECLARED -#define Tk_CanvasEventuallyRedraw_TCL_DECLARED /* 8 */ EXTERN void Tk_CanvasEventuallyRedraw(Tk_Canvas canvas, int x1, int y1, int x2, int y2); -#endif -#ifndef Tk_CanvasGetCoord_TCL_DECLARED -#define Tk_CanvasGetCoord_TCL_DECLARED /* 9 */ EXTERN int Tk_CanvasGetCoord(Tcl_Interp *interp, - Tk_Canvas canvas, CONST char *str, + Tk_Canvas canvas, const char *str, double *doublePtr); -#endif -#ifndef Tk_CanvasGetTextInfo_TCL_DECLARED -#define Tk_CanvasGetTextInfo_TCL_DECLARED /* 10 */ EXTERN Tk_CanvasTextInfo * Tk_CanvasGetTextInfo(Tk_Canvas canvas); -#endif -#ifndef Tk_CanvasPsBitmap_TCL_DECLARED -#define Tk_CanvasPsBitmap_TCL_DECLARED /* 11 */ EXTERN int Tk_CanvasPsBitmap(Tcl_Interp *interp, Tk_Canvas canvas, Pixmap bitmap, int x, int y, int width, int height); -#endif -#ifndef Tk_CanvasPsColor_TCL_DECLARED -#define Tk_CanvasPsColor_TCL_DECLARED /* 12 */ EXTERN int Tk_CanvasPsColor(Tcl_Interp *interp, Tk_Canvas canvas, XColor *colorPtr); -#endif -#ifndef Tk_CanvasPsFont_TCL_DECLARED -#define Tk_CanvasPsFont_TCL_DECLARED /* 13 */ EXTERN int Tk_CanvasPsFont(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Font font); -#endif -#ifndef Tk_CanvasPsPath_TCL_DECLARED -#define Tk_CanvasPsPath_TCL_DECLARED /* 14 */ EXTERN void Tk_CanvasPsPath(Tcl_Interp *interp, Tk_Canvas canvas, double *coordPtr, int numPoints); -#endif -#ifndef Tk_CanvasPsStipple_TCL_DECLARED -#define Tk_CanvasPsStipple_TCL_DECLARED /* 15 */ EXTERN int Tk_CanvasPsStipple(Tcl_Interp *interp, Tk_Canvas canvas, Pixmap bitmap); -#endif -#ifndef Tk_CanvasPsY_TCL_DECLARED -#define Tk_CanvasPsY_TCL_DECLARED /* 16 */ EXTERN double Tk_CanvasPsY(Tk_Canvas canvas, double y); -#endif -#ifndef Tk_CanvasSetStippleOrigin_TCL_DECLARED -#define Tk_CanvasSetStippleOrigin_TCL_DECLARED /* 17 */ EXTERN void Tk_CanvasSetStippleOrigin(Tk_Canvas canvas, GC gc); -#endif -#ifndef Tk_CanvasTagsParseProc_TCL_DECLARED -#define Tk_CanvasTagsParseProc_TCL_DECLARED /* 18 */ EXTERN int Tk_CanvasTagsParseProc(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *widgRec, int offset); -#endif -#ifndef Tk_CanvasTagsPrintProc_TCL_DECLARED -#define Tk_CanvasTagsPrintProc_TCL_DECLARED + const char *value, char *widgRec, int offset); /* 19 */ -EXTERN char * Tk_CanvasTagsPrintProc(ClientData clientData, +EXTERN CONST86 char * Tk_CanvasTagsPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); -#endif -#ifndef Tk_CanvasTkwin_TCL_DECLARED -#define Tk_CanvasTkwin_TCL_DECLARED /* 20 */ EXTERN Tk_Window Tk_CanvasTkwin(Tk_Canvas canvas); -#endif -#ifndef Tk_CanvasWindowCoords_TCL_DECLARED -#define Tk_CanvasWindowCoords_TCL_DECLARED /* 21 */ EXTERN void Tk_CanvasWindowCoords(Tk_Canvas canvas, double x, double y, short *screenXPtr, short *screenYPtr); -#endif -#ifndef Tk_ChangeWindowAttributes_TCL_DECLARED -#define Tk_ChangeWindowAttributes_TCL_DECLARED /* 22 */ EXTERN void Tk_ChangeWindowAttributes(Tk_Window tkwin, unsigned long valueMask, XSetWindowAttributes *attsPtr); -#endif -#ifndef Tk_CharBbox_TCL_DECLARED -#define Tk_CharBbox_TCL_DECLARED /* 23 */ EXTERN int Tk_CharBbox(Tk_TextLayout layout, int index, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr); -#endif -#ifndef Tk_ClearSelection_TCL_DECLARED -#define Tk_ClearSelection_TCL_DECLARED /* 24 */ EXTERN void Tk_ClearSelection(Tk_Window tkwin, Atom selection); -#endif -#ifndef Tk_ClipboardAppend_TCL_DECLARED -#define Tk_ClipboardAppend_TCL_DECLARED /* 25 */ EXTERN int Tk_ClipboardAppend(Tcl_Interp *interp, Tk_Window tkwin, Atom target, Atom format, - char *buffer); -#endif -#ifndef Tk_ClipboardClear_TCL_DECLARED -#define Tk_ClipboardClear_TCL_DECLARED + const char *buffer); /* 26 */ EXTERN int Tk_ClipboardClear(Tcl_Interp *interp, Tk_Window tkwin); -#endif -#ifndef Tk_ConfigureInfo_TCL_DECLARED -#define Tk_ConfigureInfo_TCL_DECLARED /* 27 */ EXTERN int Tk_ConfigureInfo(Tcl_Interp *interp, Tk_Window tkwin, - Tk_ConfigSpec *specs, char *widgRec, - CONST char *argvName, int flags); -#endif -#ifndef Tk_ConfigureValue_TCL_DECLARED -#define Tk_ConfigureValue_TCL_DECLARED + const Tk_ConfigSpec *specs, char *widgRec, + const char *argvName, int flags); /* 28 */ EXTERN int Tk_ConfigureValue(Tcl_Interp *interp, - Tk_Window tkwin, Tk_ConfigSpec *specs, - char *widgRec, CONST char *argvName, + Tk_Window tkwin, const Tk_ConfigSpec *specs, + char *widgRec, const char *argvName, int flags); -#endif -#ifndef Tk_ConfigureWidget_TCL_DECLARED -#define Tk_ConfigureWidget_TCL_DECLARED /* 29 */ EXTERN int Tk_ConfigureWidget(Tcl_Interp *interp, - Tk_Window tkwin, Tk_ConfigSpec *specs, + Tk_Window tkwin, const Tk_ConfigSpec *specs, int argc, CONST84 char **argv, char *widgRec, int flags); -#endif -#ifndef Tk_ConfigureWindow_TCL_DECLARED -#define Tk_ConfigureWindow_TCL_DECLARED /* 30 */ EXTERN void Tk_ConfigureWindow(Tk_Window tkwin, unsigned int valueMask, XWindowChanges *valuePtr); -#endif -#ifndef Tk_ComputeTextLayout_TCL_DECLARED -#define Tk_ComputeTextLayout_TCL_DECLARED /* 31 */ -EXTERN Tk_TextLayout Tk_ComputeTextLayout(Tk_Font font, CONST char *str, +EXTERN Tk_TextLayout Tk_ComputeTextLayout(Tk_Font font, const char *str, int numChars, int wrapLength, Tk_Justify justify, int flags, int *widthPtr, int *heightPtr); -#endif -#ifndef Tk_CoordsToWindow_TCL_DECLARED -#define Tk_CoordsToWindow_TCL_DECLARED /* 32 */ EXTERN Tk_Window Tk_CoordsToWindow(int rootX, int rootY, Tk_Window tkwin); -#endif -#ifndef Tk_CreateBinding_TCL_DECLARED -#define Tk_CreateBinding_TCL_DECLARED /* 33 */ EXTERN unsigned long Tk_CreateBinding(Tcl_Interp *interp, Tk_BindingTable bindingTable, - ClientData object, CONST char *eventStr, - CONST char *command, int append); -#endif -#ifndef Tk_CreateBindingTable_TCL_DECLARED -#define Tk_CreateBindingTable_TCL_DECLARED + ClientData object, const char *eventStr, + const char *script, int append); /* 34 */ EXTERN Tk_BindingTable Tk_CreateBindingTable(Tcl_Interp *interp); -#endif -#ifndef Tk_CreateErrorHandler_TCL_DECLARED -#define Tk_CreateErrorHandler_TCL_DECLARED /* 35 */ EXTERN Tk_ErrorHandler Tk_CreateErrorHandler(Display *display, int errNum, int request, int minorCode, Tk_ErrorProc *errorProc, ClientData clientData); -#endif -#ifndef Tk_CreateEventHandler_TCL_DECLARED -#define Tk_CreateEventHandler_TCL_DECLARED /* 36 */ EXTERN void Tk_CreateEventHandler(Tk_Window token, unsigned long mask, Tk_EventProc *proc, ClientData clientData); -#endif -#ifndef Tk_CreateGenericHandler_TCL_DECLARED -#define Tk_CreateGenericHandler_TCL_DECLARED /* 37 */ EXTERN void Tk_CreateGenericHandler(Tk_GenericProc *proc, ClientData clientData); -#endif -#ifndef Tk_CreateImageType_TCL_DECLARED -#define Tk_CreateImageType_TCL_DECLARED /* 38 */ -EXTERN void Tk_CreateImageType(Tk_ImageType *typePtr); -#endif -#ifndef Tk_CreateItemType_TCL_DECLARED -#define Tk_CreateItemType_TCL_DECLARED +EXTERN void Tk_CreateImageType(const Tk_ImageType *typePtr); /* 39 */ EXTERN void Tk_CreateItemType(Tk_ItemType *typePtr); -#endif -#ifndef Tk_CreatePhotoImageFormat_TCL_DECLARED -#define Tk_CreatePhotoImageFormat_TCL_DECLARED /* 40 */ EXTERN void Tk_CreatePhotoImageFormat( - Tk_PhotoImageFormat *formatPtr); -#endif -#ifndef Tk_CreateSelHandler_TCL_DECLARED -#define Tk_CreateSelHandler_TCL_DECLARED + const Tk_PhotoImageFormat *formatPtr); /* 41 */ EXTERN void Tk_CreateSelHandler(Tk_Window tkwin, Atom selection, Atom target, Tk_SelectionProc *proc, ClientData clientData, Atom format); -#endif -#ifndef Tk_CreateWindow_TCL_DECLARED -#define Tk_CreateWindow_TCL_DECLARED /* 42 */ EXTERN Tk_Window Tk_CreateWindow(Tcl_Interp *interp, Tk_Window parent, - CONST char *name, CONST char *screenName); -#endif -#ifndef Tk_CreateWindowFromPath_TCL_DECLARED -#define Tk_CreateWindowFromPath_TCL_DECLARED + const char *name, const char *screenName); /* 43 */ EXTERN Tk_Window Tk_CreateWindowFromPath(Tcl_Interp *interp, - Tk_Window tkwin, CONST char *pathName, - CONST char *screenName); -#endif -#ifndef Tk_DefineBitmap_TCL_DECLARED -#define Tk_DefineBitmap_TCL_DECLARED + Tk_Window tkwin, const char *pathName, + const char *screenName); /* 44 */ -EXTERN int Tk_DefineBitmap(Tcl_Interp *interp, CONST char *name, - CONST char *source, int width, int height); -#endif -#ifndef Tk_DefineCursor_TCL_DECLARED -#define Tk_DefineCursor_TCL_DECLARED +EXTERN int Tk_DefineBitmap(Tcl_Interp *interp, const char *name, + const void *source, int width, int height); /* 45 */ EXTERN void Tk_DefineCursor(Tk_Window window, Tk_Cursor cursor); -#endif -#ifndef Tk_DeleteAllBindings_TCL_DECLARED -#define Tk_DeleteAllBindings_TCL_DECLARED /* 46 */ EXTERN void Tk_DeleteAllBindings(Tk_BindingTable bindingTable, ClientData object); -#endif -#ifndef Tk_DeleteBinding_TCL_DECLARED -#define Tk_DeleteBinding_TCL_DECLARED /* 47 */ EXTERN int Tk_DeleteBinding(Tcl_Interp *interp, Tk_BindingTable bindingTable, - ClientData object, CONST char *eventStr); -#endif -#ifndef Tk_DeleteBindingTable_TCL_DECLARED -#define Tk_DeleteBindingTable_TCL_DECLARED + ClientData object, const char *eventStr); /* 48 */ EXTERN void Tk_DeleteBindingTable(Tk_BindingTable bindingTable); -#endif -#ifndef Tk_DeleteErrorHandler_TCL_DECLARED -#define Tk_DeleteErrorHandler_TCL_DECLARED /* 49 */ EXTERN void Tk_DeleteErrorHandler(Tk_ErrorHandler handler); -#endif -#ifndef Tk_DeleteEventHandler_TCL_DECLARED -#define Tk_DeleteEventHandler_TCL_DECLARED /* 50 */ EXTERN void Tk_DeleteEventHandler(Tk_Window token, unsigned long mask, Tk_EventProc *proc, ClientData clientData); -#endif -#ifndef Tk_DeleteGenericHandler_TCL_DECLARED -#define Tk_DeleteGenericHandler_TCL_DECLARED /* 51 */ EXTERN void Tk_DeleteGenericHandler(Tk_GenericProc *proc, ClientData clientData); -#endif -#ifndef Tk_DeleteImage_TCL_DECLARED -#define Tk_DeleteImage_TCL_DECLARED /* 52 */ -EXTERN void Tk_DeleteImage(Tcl_Interp *interp, CONST char *name); -#endif -#ifndef Tk_DeleteSelHandler_TCL_DECLARED -#define Tk_DeleteSelHandler_TCL_DECLARED +EXTERN void Tk_DeleteImage(Tcl_Interp *interp, const char *name); /* 53 */ EXTERN void Tk_DeleteSelHandler(Tk_Window tkwin, Atom selection, Atom target); -#endif -#ifndef Tk_DestroyWindow_TCL_DECLARED -#define Tk_DestroyWindow_TCL_DECLARED /* 54 */ EXTERN void Tk_DestroyWindow(Tk_Window tkwin); -#endif -#ifndef Tk_DisplayName_TCL_DECLARED -#define Tk_DisplayName_TCL_DECLARED /* 55 */ EXTERN CONST84_RETURN char * Tk_DisplayName(Tk_Window tkwin); -#endif -#ifndef Tk_DistanceToTextLayout_TCL_DECLARED -#define Tk_DistanceToTextLayout_TCL_DECLARED /* 56 */ EXTERN int Tk_DistanceToTextLayout(Tk_TextLayout layout, int x, int y); -#endif -#ifndef Tk_Draw3DPolygon_TCL_DECLARED -#define Tk_Draw3DPolygon_TCL_DECLARED /* 57 */ EXTERN void Tk_Draw3DPolygon(Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint *pointPtr, int numPoints, int borderWidth, int leftRelief); -#endif -#ifndef Tk_Draw3DRectangle_TCL_DECLARED -#define Tk_Draw3DRectangle_TCL_DECLARED /* 58 */ EXTERN void Tk_Draw3DRectangle(Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief); -#endif -#ifndef Tk_DrawChars_TCL_DECLARED -#define Tk_DrawChars_TCL_DECLARED /* 59 */ EXTERN void Tk_DrawChars(Display *display, Drawable drawable, - GC gc, Tk_Font tkfont, CONST char *source, + GC gc, Tk_Font tkfont, const char *source, int numBytes, int x, int y); -#endif -#ifndef Tk_DrawFocusHighlight_TCL_DECLARED -#define Tk_DrawFocusHighlight_TCL_DECLARED /* 60 */ EXTERN void Tk_DrawFocusHighlight(Tk_Window tkwin, GC gc, int width, Drawable drawable); -#endif -#ifndef Tk_DrawTextLayout_TCL_DECLARED -#define Tk_DrawTextLayout_TCL_DECLARED /* 61 */ EXTERN void Tk_DrawTextLayout(Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int firstChar, int lastChar); -#endif -#ifndef Tk_Fill3DPolygon_TCL_DECLARED -#define Tk_Fill3DPolygon_TCL_DECLARED /* 62 */ EXTERN void Tk_Fill3DPolygon(Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint *pointPtr, int numPoints, int borderWidth, int leftRelief); -#endif -#ifndef Tk_Fill3DRectangle_TCL_DECLARED -#define Tk_Fill3DRectangle_TCL_DECLARED /* 63 */ EXTERN void Tk_Fill3DRectangle(Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief); -#endif -#ifndef Tk_FindPhoto_TCL_DECLARED -#define Tk_FindPhoto_TCL_DECLARED /* 64 */ EXTERN Tk_PhotoHandle Tk_FindPhoto(Tcl_Interp *interp, - CONST char *imageName); -#endif -#ifndef Tk_FontId_TCL_DECLARED -#define Tk_FontId_TCL_DECLARED + const char *imageName); /* 65 */ EXTERN Font Tk_FontId(Tk_Font font); -#endif -#ifndef Tk_Free3DBorder_TCL_DECLARED -#define Tk_Free3DBorder_TCL_DECLARED /* 66 */ EXTERN void Tk_Free3DBorder(Tk_3DBorder border); -#endif -#ifndef Tk_FreeBitmap_TCL_DECLARED -#define Tk_FreeBitmap_TCL_DECLARED /* 67 */ EXTERN void Tk_FreeBitmap(Display *display, Pixmap bitmap); -#endif -#ifndef Tk_FreeColor_TCL_DECLARED -#define Tk_FreeColor_TCL_DECLARED /* 68 */ EXTERN void Tk_FreeColor(XColor *colorPtr); -#endif -#ifndef Tk_FreeColormap_TCL_DECLARED -#define Tk_FreeColormap_TCL_DECLARED /* 69 */ EXTERN void Tk_FreeColormap(Display *display, Colormap colormap); -#endif -#ifndef Tk_FreeCursor_TCL_DECLARED -#define Tk_FreeCursor_TCL_DECLARED /* 70 */ EXTERN void Tk_FreeCursor(Display *display, Tk_Cursor cursor); -#endif -#ifndef Tk_FreeFont_TCL_DECLARED -#define Tk_FreeFont_TCL_DECLARED /* 71 */ EXTERN void Tk_FreeFont(Tk_Font f); -#endif -#ifndef Tk_FreeGC_TCL_DECLARED -#define Tk_FreeGC_TCL_DECLARED /* 72 */ EXTERN void Tk_FreeGC(Display *display, GC gc); -#endif -#ifndef Tk_FreeImage_TCL_DECLARED -#define Tk_FreeImage_TCL_DECLARED /* 73 */ EXTERN void Tk_FreeImage(Tk_Image image); -#endif -#ifndef Tk_FreeOptions_TCL_DECLARED -#define Tk_FreeOptions_TCL_DECLARED /* 74 */ -EXTERN void Tk_FreeOptions(Tk_ConfigSpec *specs, char *widgRec, - Display *display, int needFlags); -#endif -#ifndef Tk_FreePixmap_TCL_DECLARED -#define Tk_FreePixmap_TCL_DECLARED +EXTERN void Tk_FreeOptions(const Tk_ConfigSpec *specs, + char *widgRec, Display *display, + int needFlags); /* 75 */ EXTERN void Tk_FreePixmap(Display *display, Pixmap pixmap); -#endif -#ifndef Tk_FreeTextLayout_TCL_DECLARED -#define Tk_FreeTextLayout_TCL_DECLARED /* 76 */ EXTERN void Tk_FreeTextLayout(Tk_TextLayout textLayout); -#endif -#ifndef Tk_FreeXId_TCL_DECLARED -#define Tk_FreeXId_TCL_DECLARED /* 77 */ EXTERN void Tk_FreeXId(Display *display, XID xid); -#endif -#ifndef Tk_GCForColor_TCL_DECLARED -#define Tk_GCForColor_TCL_DECLARED /* 78 */ EXTERN GC Tk_GCForColor(XColor *colorPtr, Drawable drawable); -#endif -#ifndef Tk_GeometryRequest_TCL_DECLARED -#define Tk_GeometryRequest_TCL_DECLARED /* 79 */ EXTERN void Tk_GeometryRequest(Tk_Window tkwin, int reqWidth, int reqHeight); -#endif -#ifndef Tk_Get3DBorder_TCL_DECLARED -#define Tk_Get3DBorder_TCL_DECLARED /* 80 */ EXTERN Tk_3DBorder Tk_Get3DBorder(Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid colorName); -#endif -#ifndef Tk_GetAllBindings_TCL_DECLARED -#define Tk_GetAllBindings_TCL_DECLARED /* 81 */ EXTERN void Tk_GetAllBindings(Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object); -#endif -#ifndef Tk_GetAnchor_TCL_DECLARED -#define Tk_GetAnchor_TCL_DECLARED /* 82 */ -EXTERN int Tk_GetAnchor(Tcl_Interp *interp, CONST char *str, +EXTERN int Tk_GetAnchor(Tcl_Interp *interp, const char *str, Tk_Anchor *anchorPtr); -#endif -#ifndef Tk_GetAtomName_TCL_DECLARED -#define Tk_GetAtomName_TCL_DECLARED /* 83 */ EXTERN CONST84_RETURN char * Tk_GetAtomName(Tk_Window tkwin, Atom atom); -#endif -#ifndef Tk_GetBinding_TCL_DECLARED -#define Tk_GetBinding_TCL_DECLARED /* 84 */ EXTERN CONST84_RETURN char * Tk_GetBinding(Tcl_Interp *interp, Tk_BindingTable bindingTable, - ClientData object, CONST char *eventStr); -#endif -#ifndef Tk_GetBitmap_TCL_DECLARED -#define Tk_GetBitmap_TCL_DECLARED + ClientData object, const char *eventStr); /* 85 */ EXTERN Pixmap Tk_GetBitmap(Tcl_Interp *interp, Tk_Window tkwin, - CONST char *str); -#endif -#ifndef Tk_GetBitmapFromData_TCL_DECLARED -#define Tk_GetBitmapFromData_TCL_DECLARED + const char *str); /* 86 */ EXTERN Pixmap Tk_GetBitmapFromData(Tcl_Interp *interp, - Tk_Window tkwin, CONST char *source, + Tk_Window tkwin, const void *source, int width, int height); -#endif -#ifndef Tk_GetCapStyle_TCL_DECLARED -#define Tk_GetCapStyle_TCL_DECLARED /* 87 */ -EXTERN int Tk_GetCapStyle(Tcl_Interp *interp, CONST char *str, +EXTERN int Tk_GetCapStyle(Tcl_Interp *interp, const char *str, int *capPtr); -#endif -#ifndef Tk_GetColor_TCL_DECLARED -#define Tk_GetColor_TCL_DECLARED /* 88 */ EXTERN XColor * Tk_GetColor(Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid name); -#endif -#ifndef Tk_GetColorByValue_TCL_DECLARED -#define Tk_GetColorByValue_TCL_DECLARED /* 89 */ EXTERN XColor * Tk_GetColorByValue(Tk_Window tkwin, XColor *colorPtr); -#endif -#ifndef Tk_GetColormap_TCL_DECLARED -#define Tk_GetColormap_TCL_DECLARED /* 90 */ EXTERN Colormap Tk_GetColormap(Tcl_Interp *interp, Tk_Window tkwin, - CONST char *str); -#endif -#ifndef Tk_GetCursor_TCL_DECLARED -#define Tk_GetCursor_TCL_DECLARED + const char *str); /* 91 */ EXTERN Tk_Cursor Tk_GetCursor(Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid str); -#endif -#ifndef Tk_GetCursorFromData_TCL_DECLARED -#define Tk_GetCursorFromData_TCL_DECLARED /* 92 */ EXTERN Tk_Cursor Tk_GetCursorFromData(Tcl_Interp *interp, - Tk_Window tkwin, CONST char *source, - CONST char *mask, int width, int height, + Tk_Window tkwin, const char *source, + const char *mask, int width, int height, int xHot, int yHot, Tk_Uid fg, Tk_Uid bg); -#endif -#ifndef Tk_GetFont_TCL_DECLARED -#define Tk_GetFont_TCL_DECLARED /* 93 */ EXTERN Tk_Font Tk_GetFont(Tcl_Interp *interp, Tk_Window tkwin, - CONST char *str); -#endif -#ifndef Tk_GetFontFromObj_TCL_DECLARED -#define Tk_GetFontFromObj_TCL_DECLARED + const char *str); /* 94 */ EXTERN Tk_Font Tk_GetFontFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_GetFontMetrics_TCL_DECLARED -#define Tk_GetFontMetrics_TCL_DECLARED /* 95 */ EXTERN void Tk_GetFontMetrics(Tk_Font font, Tk_FontMetrics *fmPtr); -#endif -#ifndef Tk_GetGC_TCL_DECLARED -#define Tk_GetGC_TCL_DECLARED /* 96 */ EXTERN GC Tk_GetGC(Tk_Window tkwin, unsigned long valueMask, XGCValues *valuePtr); -#endif -#ifndef Tk_GetImage_TCL_DECLARED -#define Tk_GetImage_TCL_DECLARED /* 97 */ EXTERN Tk_Image Tk_GetImage(Tcl_Interp *interp, Tk_Window tkwin, - CONST char *name, + const char *name, Tk_ImageChangedProc *changeProc, ClientData clientData); -#endif -#ifndef Tk_GetImageMasterData_TCL_DECLARED -#define Tk_GetImageMasterData_TCL_DECLARED /* 98 */ EXTERN ClientData Tk_GetImageMasterData(Tcl_Interp *interp, - CONST char *name, Tk_ImageType **typePtrPtr); -#endif -#ifndef Tk_GetItemTypes_TCL_DECLARED -#define Tk_GetItemTypes_TCL_DECLARED + const char *name, + CONST86 Tk_ImageType **typePtrPtr); /* 99 */ EXTERN Tk_ItemType * Tk_GetItemTypes(void); -#endif -#ifndef Tk_GetJoinStyle_TCL_DECLARED -#define Tk_GetJoinStyle_TCL_DECLARED /* 100 */ -EXTERN int Tk_GetJoinStyle(Tcl_Interp *interp, CONST char *str, +EXTERN int Tk_GetJoinStyle(Tcl_Interp *interp, const char *str, int *joinPtr); -#endif -#ifndef Tk_GetJustify_TCL_DECLARED -#define Tk_GetJustify_TCL_DECLARED /* 101 */ -EXTERN int Tk_GetJustify(Tcl_Interp *interp, CONST char *str, +EXTERN int Tk_GetJustify(Tcl_Interp *interp, const char *str, Tk_Justify *justifyPtr); -#endif -#ifndef Tk_GetNumMainWindows_TCL_DECLARED -#define Tk_GetNumMainWindows_TCL_DECLARED /* 102 */ EXTERN int Tk_GetNumMainWindows(void); -#endif -#ifndef Tk_GetOption_TCL_DECLARED -#define Tk_GetOption_TCL_DECLARED /* 103 */ -EXTERN Tk_Uid Tk_GetOption(Tk_Window tkwin, CONST char *name, - CONST char *className); -#endif -#ifndef Tk_GetPixels_TCL_DECLARED -#define Tk_GetPixels_TCL_DECLARED +EXTERN Tk_Uid Tk_GetOption(Tk_Window tkwin, const char *name, + const char *className); /* 104 */ EXTERN int Tk_GetPixels(Tcl_Interp *interp, Tk_Window tkwin, - CONST char *str, int *intPtr); -#endif -#ifndef Tk_GetPixmap_TCL_DECLARED -#define Tk_GetPixmap_TCL_DECLARED + const char *str, int *intPtr); /* 105 */ EXTERN Pixmap Tk_GetPixmap(Display *display, Drawable d, int width, int height, int depth); -#endif -#ifndef Tk_GetRelief_TCL_DECLARED -#define Tk_GetRelief_TCL_DECLARED /* 106 */ -EXTERN int Tk_GetRelief(Tcl_Interp *interp, CONST char *name, +EXTERN int Tk_GetRelief(Tcl_Interp *interp, const char *name, int *reliefPtr); -#endif -#ifndef Tk_GetRootCoords_TCL_DECLARED -#define Tk_GetRootCoords_TCL_DECLARED /* 107 */ EXTERN void Tk_GetRootCoords(Tk_Window tkwin, int *xPtr, int *yPtr); -#endif -#ifndef Tk_GetScrollInfo_TCL_DECLARED -#define Tk_GetScrollInfo_TCL_DECLARED /* 108 */ EXTERN int Tk_GetScrollInfo(Tcl_Interp *interp, int argc, CONST84 char **argv, double *dblPtr, int *intPtr); -#endif -#ifndef Tk_GetScreenMM_TCL_DECLARED -#define Tk_GetScreenMM_TCL_DECLARED /* 109 */ EXTERN int Tk_GetScreenMM(Tcl_Interp *interp, Tk_Window tkwin, - CONST char *str, double *doublePtr); -#endif -#ifndef Tk_GetSelection_TCL_DECLARED -#define Tk_GetSelection_TCL_DECLARED + const char *str, double *doublePtr); /* 110 */ EXTERN int Tk_GetSelection(Tcl_Interp *interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc *proc, ClientData clientData); -#endif -#ifndef Tk_GetUid_TCL_DECLARED -#define Tk_GetUid_TCL_DECLARED /* 111 */ -EXTERN Tk_Uid Tk_GetUid(CONST char *str); -#endif -#ifndef Tk_GetVisual_TCL_DECLARED -#define Tk_GetVisual_TCL_DECLARED +EXTERN Tk_Uid Tk_GetUid(const char *str); /* 112 */ EXTERN Visual * Tk_GetVisual(Tcl_Interp *interp, Tk_Window tkwin, - CONST char *str, int *depthPtr, + const char *str, int *depthPtr, Colormap *colormapPtr); -#endif -#ifndef Tk_GetVRootGeometry_TCL_DECLARED -#define Tk_GetVRootGeometry_TCL_DECLARED /* 113 */ EXTERN void Tk_GetVRootGeometry(Tk_Window tkwin, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr); -#endif -#ifndef Tk_Grab_TCL_DECLARED -#define Tk_Grab_TCL_DECLARED /* 114 */ EXTERN int Tk_Grab(Tcl_Interp *interp, Tk_Window tkwin, int grabGlobal); -#endif -#ifndef Tk_HandleEvent_TCL_DECLARED -#define Tk_HandleEvent_TCL_DECLARED /* 115 */ EXTERN void Tk_HandleEvent(XEvent *eventPtr); -#endif -#ifndef Tk_IdToWindow_TCL_DECLARED -#define Tk_IdToWindow_TCL_DECLARED /* 116 */ EXTERN Tk_Window Tk_IdToWindow(Display *display, Window window); -#endif -#ifndef Tk_ImageChanged_TCL_DECLARED -#define Tk_ImageChanged_TCL_DECLARED /* 117 */ EXTERN void Tk_ImageChanged(Tk_ImageMaster master, int x, int y, int width, int height, int imageWidth, int imageHeight); -#endif -#ifndef Tk_Init_TCL_DECLARED -#define Tk_Init_TCL_DECLARED /* 118 */ EXTERN int Tk_Init(Tcl_Interp *interp); -#endif -#ifndef Tk_InternAtom_TCL_DECLARED -#define Tk_InternAtom_TCL_DECLARED /* 119 */ -EXTERN Atom Tk_InternAtom(Tk_Window tkwin, CONST char *name); -#endif -#ifndef Tk_IntersectTextLayout_TCL_DECLARED -#define Tk_IntersectTextLayout_TCL_DECLARED +EXTERN Atom Tk_InternAtom(Tk_Window tkwin, const char *name); /* 120 */ EXTERN int Tk_IntersectTextLayout(Tk_TextLayout layout, int x, int y, int width, int height); -#endif -#ifndef Tk_MaintainGeometry_TCL_DECLARED -#define Tk_MaintainGeometry_TCL_DECLARED /* 121 */ EXTERN void Tk_MaintainGeometry(Tk_Window slave, Tk_Window master, int x, int y, int width, int height); -#endif -#ifndef Tk_MainWindow_TCL_DECLARED -#define Tk_MainWindow_TCL_DECLARED /* 122 */ EXTERN Tk_Window Tk_MainWindow(Tcl_Interp *interp); -#endif -#ifndef Tk_MakeWindowExist_TCL_DECLARED -#define Tk_MakeWindowExist_TCL_DECLARED /* 123 */ EXTERN void Tk_MakeWindowExist(Tk_Window tkwin); -#endif -#ifndef Tk_ManageGeometry_TCL_DECLARED -#define Tk_ManageGeometry_TCL_DECLARED /* 124 */ EXTERN void Tk_ManageGeometry(Tk_Window tkwin, - CONST Tk_GeomMgr *mgrPtr, + const Tk_GeomMgr *mgrPtr, ClientData clientData); -#endif -#ifndef Tk_MapWindow_TCL_DECLARED -#define Tk_MapWindow_TCL_DECLARED /* 125 */ EXTERN void Tk_MapWindow(Tk_Window tkwin); -#endif -#ifndef Tk_MeasureChars_TCL_DECLARED -#define Tk_MeasureChars_TCL_DECLARED /* 126 */ -EXTERN int Tk_MeasureChars(Tk_Font tkfont, CONST char *source, +EXTERN int Tk_MeasureChars(Tk_Font tkfont, const char *source, int numBytes, int maxPixels, int flags, int *lengthPtr); -#endif -#ifndef Tk_MoveResizeWindow_TCL_DECLARED -#define Tk_MoveResizeWindow_TCL_DECLARED /* 127 */ EXTERN void Tk_MoveResizeWindow(Tk_Window tkwin, int x, int y, int width, int height); -#endif -#ifndef Tk_MoveWindow_TCL_DECLARED -#define Tk_MoveWindow_TCL_DECLARED /* 128 */ EXTERN void Tk_MoveWindow(Tk_Window tkwin, int x, int y); -#endif -#ifndef Tk_MoveToplevelWindow_TCL_DECLARED -#define Tk_MoveToplevelWindow_TCL_DECLARED /* 129 */ EXTERN void Tk_MoveToplevelWindow(Tk_Window tkwin, int x, int y); -#endif -#ifndef Tk_NameOf3DBorder_TCL_DECLARED -#define Tk_NameOf3DBorder_TCL_DECLARED /* 130 */ EXTERN CONST84_RETURN char * Tk_NameOf3DBorder(Tk_3DBorder border); -#endif -#ifndef Tk_NameOfAnchor_TCL_DECLARED -#define Tk_NameOfAnchor_TCL_DECLARED /* 131 */ EXTERN CONST84_RETURN char * Tk_NameOfAnchor(Tk_Anchor anchor); -#endif -#ifndef Tk_NameOfBitmap_TCL_DECLARED -#define Tk_NameOfBitmap_TCL_DECLARED /* 132 */ EXTERN CONST84_RETURN char * Tk_NameOfBitmap(Display *display, Pixmap bitmap); -#endif -#ifndef Tk_NameOfCapStyle_TCL_DECLARED -#define Tk_NameOfCapStyle_TCL_DECLARED /* 133 */ EXTERN CONST84_RETURN char * Tk_NameOfCapStyle(int cap); -#endif -#ifndef Tk_NameOfColor_TCL_DECLARED -#define Tk_NameOfColor_TCL_DECLARED /* 134 */ EXTERN CONST84_RETURN char * Tk_NameOfColor(XColor *colorPtr); -#endif -#ifndef Tk_NameOfCursor_TCL_DECLARED -#define Tk_NameOfCursor_TCL_DECLARED /* 135 */ EXTERN CONST84_RETURN char * Tk_NameOfCursor(Display *display, Tk_Cursor cursor); -#endif -#ifndef Tk_NameOfFont_TCL_DECLARED -#define Tk_NameOfFont_TCL_DECLARED /* 136 */ EXTERN CONST84_RETURN char * Tk_NameOfFont(Tk_Font font); -#endif -#ifndef Tk_NameOfImage_TCL_DECLARED -#define Tk_NameOfImage_TCL_DECLARED /* 137 */ EXTERN CONST84_RETURN char * Tk_NameOfImage(Tk_ImageMaster imageMaster); -#endif -#ifndef Tk_NameOfJoinStyle_TCL_DECLARED -#define Tk_NameOfJoinStyle_TCL_DECLARED /* 138 */ EXTERN CONST84_RETURN char * Tk_NameOfJoinStyle(int join); -#endif -#ifndef Tk_NameOfJustify_TCL_DECLARED -#define Tk_NameOfJustify_TCL_DECLARED /* 139 */ EXTERN CONST84_RETURN char * Tk_NameOfJustify(Tk_Justify justify); -#endif -#ifndef Tk_NameOfRelief_TCL_DECLARED -#define Tk_NameOfRelief_TCL_DECLARED /* 140 */ EXTERN CONST84_RETURN char * Tk_NameOfRelief(int relief); -#endif -#ifndef Tk_NameToWindow_TCL_DECLARED -#define Tk_NameToWindow_TCL_DECLARED /* 141 */ EXTERN Tk_Window Tk_NameToWindow(Tcl_Interp *interp, - CONST char *pathName, Tk_Window tkwin); -#endif -#ifndef Tk_OwnSelection_TCL_DECLARED -#define Tk_OwnSelection_TCL_DECLARED + const char *pathName, Tk_Window tkwin); /* 142 */ EXTERN void Tk_OwnSelection(Tk_Window tkwin, Atom selection, Tk_LostSelProc *proc, ClientData clientData); -#endif -#ifndef Tk_ParseArgv_TCL_DECLARED -#define Tk_ParseArgv_TCL_DECLARED /* 143 */ EXTERN int Tk_ParseArgv(Tcl_Interp *interp, Tk_Window tkwin, int *argcPtr, CONST84 char **argv, - Tk_ArgvInfo *argTable, int flags); -#endif -#ifndef Tk_PhotoPutBlock_NoComposite_TCL_DECLARED -#define Tk_PhotoPutBlock_NoComposite_TCL_DECLARED + const Tk_ArgvInfo *argTable, int flags); /* 144 */ EXTERN void Tk_PhotoPutBlock_NoComposite(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height); -#endif -#ifndef Tk_PhotoPutZoomedBlock_NoComposite_TCL_DECLARED -#define Tk_PhotoPutZoomedBlock_NoComposite_TCL_DECLARED /* 145 */ EXTERN void Tk_PhotoPutZoomedBlock_NoComposite( Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY); -#endif -#ifndef Tk_PhotoGetImage_TCL_DECLARED -#define Tk_PhotoGetImage_TCL_DECLARED /* 146 */ EXTERN int Tk_PhotoGetImage(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr); -#endif -#ifndef Tk_PhotoBlank_TCL_DECLARED -#define Tk_PhotoBlank_TCL_DECLARED /* 147 */ EXTERN void Tk_PhotoBlank(Tk_PhotoHandle handle); -#endif -#ifndef Tk_PhotoExpand_Panic_TCL_DECLARED -#define Tk_PhotoExpand_Panic_TCL_DECLARED /* 148 */ EXTERN void Tk_PhotoExpand_Panic(Tk_PhotoHandle handle, int width, int height); -#endif -#ifndef Tk_PhotoGetSize_TCL_DECLARED -#define Tk_PhotoGetSize_TCL_DECLARED /* 149 */ EXTERN void Tk_PhotoGetSize(Tk_PhotoHandle handle, int *widthPtr, int *heightPtr); -#endif -#ifndef Tk_PhotoSetSize_Panic_TCL_DECLARED -#define Tk_PhotoSetSize_Panic_TCL_DECLARED /* 150 */ EXTERN void Tk_PhotoSetSize_Panic(Tk_PhotoHandle handle, int width, int height); -#endif -#ifndef Tk_PointToChar_TCL_DECLARED -#define Tk_PointToChar_TCL_DECLARED /* 151 */ EXTERN int Tk_PointToChar(Tk_TextLayout layout, int x, int y); -#endif -#ifndef Tk_PostscriptFontName_TCL_DECLARED -#define Tk_PostscriptFontName_TCL_DECLARED /* 152 */ EXTERN int Tk_PostscriptFontName(Tk_Font tkfont, Tcl_DString *dsPtr); -#endif -#ifndef Tk_PreserveColormap_TCL_DECLARED -#define Tk_PreserveColormap_TCL_DECLARED /* 153 */ EXTERN void Tk_PreserveColormap(Display *display, Colormap colormap); -#endif -#ifndef Tk_QueueWindowEvent_TCL_DECLARED -#define Tk_QueueWindowEvent_TCL_DECLARED /* 154 */ EXTERN void Tk_QueueWindowEvent(XEvent *eventPtr, Tcl_QueuePosition position); -#endif -#ifndef Tk_RedrawImage_TCL_DECLARED -#define Tk_RedrawImage_TCL_DECLARED /* 155 */ EXTERN void Tk_RedrawImage(Tk_Image image, int imageX, int imageY, int width, int height, Drawable drawable, int drawableX, int drawableY); -#endif -#ifndef Tk_ResizeWindow_TCL_DECLARED -#define Tk_ResizeWindow_TCL_DECLARED /* 156 */ EXTERN void Tk_ResizeWindow(Tk_Window tkwin, int width, int height); -#endif -#ifndef Tk_RestackWindow_TCL_DECLARED -#define Tk_RestackWindow_TCL_DECLARED /* 157 */ EXTERN int Tk_RestackWindow(Tk_Window tkwin, int aboveBelow, Tk_Window other); -#endif -#ifndef Tk_RestrictEvents_TCL_DECLARED -#define Tk_RestrictEvents_TCL_DECLARED /* 158 */ EXTERN Tk_RestrictProc * Tk_RestrictEvents(Tk_RestrictProc *proc, ClientData arg, ClientData *prevArgPtr); -#endif -#ifndef Tk_SafeInit_TCL_DECLARED -#define Tk_SafeInit_TCL_DECLARED /* 159 */ EXTERN int Tk_SafeInit(Tcl_Interp *interp); -#endif -#ifndef Tk_SetAppName_TCL_DECLARED -#define Tk_SetAppName_TCL_DECLARED /* 160 */ -EXTERN CONST char * Tk_SetAppName(Tk_Window tkwin, CONST char *name); -#endif -#ifndef Tk_SetBackgroundFromBorder_TCL_DECLARED -#define Tk_SetBackgroundFromBorder_TCL_DECLARED +EXTERN const char * Tk_SetAppName(Tk_Window tkwin, const char *name); /* 161 */ EXTERN void Tk_SetBackgroundFromBorder(Tk_Window tkwin, Tk_3DBorder border); -#endif -#ifndef Tk_SetClass_TCL_DECLARED -#define Tk_SetClass_TCL_DECLARED /* 162 */ -EXTERN void Tk_SetClass(Tk_Window tkwin, CONST char *className); -#endif -#ifndef Tk_SetGrid_TCL_DECLARED -#define Tk_SetGrid_TCL_DECLARED +EXTERN void Tk_SetClass(Tk_Window tkwin, const char *className); /* 163 */ EXTERN void Tk_SetGrid(Tk_Window tkwin, int reqWidth, int reqHeight, int gridWidth, int gridHeight); -#endif -#ifndef Tk_SetInternalBorder_TCL_DECLARED -#define Tk_SetInternalBorder_TCL_DECLARED /* 164 */ EXTERN void Tk_SetInternalBorder(Tk_Window tkwin, int width); -#endif -#ifndef Tk_SetWindowBackground_TCL_DECLARED -#define Tk_SetWindowBackground_TCL_DECLARED /* 165 */ EXTERN void Tk_SetWindowBackground(Tk_Window tkwin, unsigned long pixel); -#endif -#ifndef Tk_SetWindowBackgroundPixmap_TCL_DECLARED -#define Tk_SetWindowBackgroundPixmap_TCL_DECLARED /* 166 */ EXTERN void Tk_SetWindowBackgroundPixmap(Tk_Window tkwin, Pixmap pixmap); -#endif -#ifndef Tk_SetWindowBorder_TCL_DECLARED -#define Tk_SetWindowBorder_TCL_DECLARED /* 167 */ EXTERN void Tk_SetWindowBorder(Tk_Window tkwin, unsigned long pixel); -#endif -#ifndef Tk_SetWindowBorderWidth_TCL_DECLARED -#define Tk_SetWindowBorderWidth_TCL_DECLARED /* 168 */ EXTERN void Tk_SetWindowBorderWidth(Tk_Window tkwin, int width); -#endif -#ifndef Tk_SetWindowBorderPixmap_TCL_DECLARED -#define Tk_SetWindowBorderPixmap_TCL_DECLARED /* 169 */ EXTERN void Tk_SetWindowBorderPixmap(Tk_Window tkwin, Pixmap pixmap); -#endif -#ifndef Tk_SetWindowColormap_TCL_DECLARED -#define Tk_SetWindowColormap_TCL_DECLARED /* 170 */ EXTERN void Tk_SetWindowColormap(Tk_Window tkwin, Colormap colormap); -#endif -#ifndef Tk_SetWindowVisual_TCL_DECLARED -#define Tk_SetWindowVisual_TCL_DECLARED /* 171 */ EXTERN int Tk_SetWindowVisual(Tk_Window tkwin, Visual *visual, int depth, Colormap colormap); -#endif -#ifndef Tk_SizeOfBitmap_TCL_DECLARED -#define Tk_SizeOfBitmap_TCL_DECLARED /* 172 */ EXTERN void Tk_SizeOfBitmap(Display *display, Pixmap bitmap, int *widthPtr, int *heightPtr); -#endif -#ifndef Tk_SizeOfImage_TCL_DECLARED -#define Tk_SizeOfImage_TCL_DECLARED /* 173 */ EXTERN void Tk_SizeOfImage(Tk_Image image, int *widthPtr, int *heightPtr); -#endif -#ifndef Tk_StrictMotif_TCL_DECLARED -#define Tk_StrictMotif_TCL_DECLARED /* 174 */ EXTERN int Tk_StrictMotif(Tk_Window tkwin); -#endif -#ifndef Tk_TextLayoutToPostscript_TCL_DECLARED -#define Tk_TextLayoutToPostscript_TCL_DECLARED /* 175 */ EXTERN void Tk_TextLayoutToPostscript(Tcl_Interp *interp, Tk_TextLayout layout); -#endif -#ifndef Tk_TextWidth_TCL_DECLARED -#define Tk_TextWidth_TCL_DECLARED /* 176 */ -EXTERN int Tk_TextWidth(Tk_Font font, CONST char *str, +EXTERN int Tk_TextWidth(Tk_Font font, const char *str, int numBytes); -#endif -#ifndef Tk_UndefineCursor_TCL_DECLARED -#define Tk_UndefineCursor_TCL_DECLARED /* 177 */ EXTERN void Tk_UndefineCursor(Tk_Window window); -#endif -#ifndef Tk_UnderlineChars_TCL_DECLARED -#define Tk_UnderlineChars_TCL_DECLARED /* 178 */ EXTERN void Tk_UnderlineChars(Display *display, Drawable drawable, GC gc, Tk_Font tkfont, - CONST char *source, int x, int y, + const char *source, int x, int y, int firstByte, int lastByte); -#endif -#ifndef Tk_UnderlineTextLayout_TCL_DECLARED -#define Tk_UnderlineTextLayout_TCL_DECLARED /* 179 */ EXTERN void Tk_UnderlineTextLayout(Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int underline); -#endif -#ifndef Tk_Ungrab_TCL_DECLARED -#define Tk_Ungrab_TCL_DECLARED /* 180 */ EXTERN void Tk_Ungrab(Tk_Window tkwin); -#endif -#ifndef Tk_UnmaintainGeometry_TCL_DECLARED -#define Tk_UnmaintainGeometry_TCL_DECLARED /* 181 */ EXTERN void Tk_UnmaintainGeometry(Tk_Window slave, Tk_Window master); -#endif -#ifndef Tk_UnmapWindow_TCL_DECLARED -#define Tk_UnmapWindow_TCL_DECLARED /* 182 */ EXTERN void Tk_UnmapWindow(Tk_Window tkwin); -#endif -#ifndef Tk_UnsetGrid_TCL_DECLARED -#define Tk_UnsetGrid_TCL_DECLARED /* 183 */ EXTERN void Tk_UnsetGrid(Tk_Window tkwin); -#endif -#ifndef Tk_UpdatePointer_TCL_DECLARED -#define Tk_UpdatePointer_TCL_DECLARED /* 184 */ EXTERN void Tk_UpdatePointer(Tk_Window tkwin, int x, int y, int state); -#endif -#ifndef Tk_AllocBitmapFromObj_TCL_DECLARED -#define Tk_AllocBitmapFromObj_TCL_DECLARED /* 185 */ EXTERN Pixmap Tk_AllocBitmapFromObj(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_Alloc3DBorderFromObj_TCL_DECLARED -#define Tk_Alloc3DBorderFromObj_TCL_DECLARED /* 186 */ EXTERN Tk_3DBorder Tk_Alloc3DBorderFromObj(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_AllocColorFromObj_TCL_DECLARED -#define Tk_AllocColorFromObj_TCL_DECLARED /* 187 */ EXTERN XColor * Tk_AllocColorFromObj(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_AllocCursorFromObj_TCL_DECLARED -#define Tk_AllocCursorFromObj_TCL_DECLARED /* 188 */ EXTERN Tk_Cursor Tk_AllocCursorFromObj(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_AllocFontFromObj_TCL_DECLARED -#define Tk_AllocFontFromObj_TCL_DECLARED /* 189 */ EXTERN Tk_Font Tk_AllocFontFromObj(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_CreateOptionTable_TCL_DECLARED -#define Tk_CreateOptionTable_TCL_DECLARED /* 190 */ EXTERN Tk_OptionTable Tk_CreateOptionTable(Tcl_Interp *interp, - CONST Tk_OptionSpec *templatePtr); -#endif -#ifndef Tk_DeleteOptionTable_TCL_DECLARED -#define Tk_DeleteOptionTable_TCL_DECLARED + const Tk_OptionSpec *templatePtr); /* 191 */ EXTERN void Tk_DeleteOptionTable(Tk_OptionTable optionTable); -#endif -#ifndef Tk_Free3DBorderFromObj_TCL_DECLARED -#define Tk_Free3DBorderFromObj_TCL_DECLARED /* 192 */ EXTERN void Tk_Free3DBorderFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_FreeBitmapFromObj_TCL_DECLARED -#define Tk_FreeBitmapFromObj_TCL_DECLARED /* 193 */ EXTERN void Tk_FreeBitmapFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_FreeColorFromObj_TCL_DECLARED -#define Tk_FreeColorFromObj_TCL_DECLARED /* 194 */ EXTERN void Tk_FreeColorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_FreeConfigOptions_TCL_DECLARED -#define Tk_FreeConfigOptions_TCL_DECLARED /* 195 */ EXTERN void Tk_FreeConfigOptions(char *recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin); -#endif -#ifndef Tk_FreeSavedOptions_TCL_DECLARED -#define Tk_FreeSavedOptions_TCL_DECLARED /* 196 */ EXTERN void Tk_FreeSavedOptions(Tk_SavedOptions *savePtr); -#endif -#ifndef Tk_FreeCursorFromObj_TCL_DECLARED -#define Tk_FreeCursorFromObj_TCL_DECLARED /* 197 */ EXTERN void Tk_FreeCursorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_FreeFontFromObj_TCL_DECLARED -#define Tk_FreeFontFromObj_TCL_DECLARED /* 198 */ EXTERN void Tk_FreeFontFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_Get3DBorderFromObj_TCL_DECLARED -#define Tk_Get3DBorderFromObj_TCL_DECLARED /* 199 */ EXTERN Tk_3DBorder Tk_Get3DBorderFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_GetAnchorFromObj_TCL_DECLARED -#define Tk_GetAnchorFromObj_TCL_DECLARED /* 200 */ EXTERN int Tk_GetAnchorFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tk_Anchor *anchorPtr); -#endif -#ifndef Tk_GetBitmapFromObj_TCL_DECLARED -#define Tk_GetBitmapFromObj_TCL_DECLARED /* 201 */ EXTERN Pixmap Tk_GetBitmapFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_GetColorFromObj_TCL_DECLARED -#define Tk_GetColorFromObj_TCL_DECLARED /* 202 */ EXTERN XColor * Tk_GetColorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_GetCursorFromObj_TCL_DECLARED -#define Tk_GetCursorFromObj_TCL_DECLARED /* 203 */ EXTERN Tk_Cursor Tk_GetCursorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); -#endif -#ifndef Tk_GetOptionInfo_TCL_DECLARED -#define Tk_GetOptionInfo_TCL_DECLARED /* 204 */ EXTERN Tcl_Obj * Tk_GetOptionInfo(Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionTable, Tcl_Obj *namePtr, Tk_Window tkwin); -#endif -#ifndef Tk_GetOptionValue_TCL_DECLARED -#define Tk_GetOptionValue_TCL_DECLARED /* 205 */ EXTERN Tcl_Obj * Tk_GetOptionValue(Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionTable, Tcl_Obj *namePtr, Tk_Window tkwin); -#endif -#ifndef Tk_GetJustifyFromObj_TCL_DECLARED -#define Tk_GetJustifyFromObj_TCL_DECLARED /* 206 */ EXTERN int Tk_GetJustifyFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tk_Justify *justifyPtr); -#endif -#ifndef Tk_GetMMFromObj_TCL_DECLARED -#define Tk_GetMMFromObj_TCL_DECLARED /* 207 */ EXTERN int Tk_GetMMFromObj(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr); -#endif -#ifndef Tk_GetPixelsFromObj_TCL_DECLARED -#define Tk_GetPixelsFromObj_TCL_DECLARED /* 208 */ EXTERN int Tk_GetPixelsFromObj(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, int *intPtr); -#endif -#ifndef Tk_GetReliefFromObj_TCL_DECLARED -#define Tk_GetReliefFromObj_TCL_DECLARED /* 209 */ EXTERN int Tk_GetReliefFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr); -#endif -#ifndef Tk_GetScrollInfoObj_TCL_DECLARED -#define Tk_GetScrollInfoObj_TCL_DECLARED /* 210 */ EXTERN int Tk_GetScrollInfoObj(Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[], double *dblPtr, + Tcl_Obj *const objv[], double *dblPtr, int *intPtr); -#endif -#ifndef Tk_InitOptions_TCL_DECLARED -#define Tk_InitOptions_TCL_DECLARED /* 211 */ EXTERN int Tk_InitOptions(Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin); -#endif -#ifndef Tk_MainEx_TCL_DECLARED -#define Tk_MainEx_TCL_DECLARED /* 212 */ EXTERN void Tk_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); -#endif -#ifndef Tk_RestoreSavedOptions_TCL_DECLARED -#define Tk_RestoreSavedOptions_TCL_DECLARED /* 213 */ EXTERN void Tk_RestoreSavedOptions(Tk_SavedOptions *savePtr); -#endif -#ifndef Tk_SetOptions_TCL_DECLARED -#define Tk_SetOptions_TCL_DECLARED /* 214 */ EXTERN int Tk_SetOptions(Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionTable, int objc, - Tcl_Obj *CONST objv[], Tk_Window tkwin, + Tcl_Obj *const objv[], Tk_Window tkwin, Tk_SavedOptions *savePtr, int *maskPtr); -#endif -#ifndef Tk_InitConsoleChannels_TCL_DECLARED -#define Tk_InitConsoleChannels_TCL_DECLARED /* 215 */ EXTERN void Tk_InitConsoleChannels(Tcl_Interp *interp); -#endif -#ifndef Tk_CreateConsoleWindow_TCL_DECLARED -#define Tk_CreateConsoleWindow_TCL_DECLARED /* 216 */ EXTERN int Tk_CreateConsoleWindow(Tcl_Interp *interp); -#endif -#ifndef Tk_CreateSmoothMethod_TCL_DECLARED -#define Tk_CreateSmoothMethod_TCL_DECLARED /* 217 */ EXTERN void Tk_CreateSmoothMethod(Tcl_Interp *interp, - Tk_SmoothMethod *method); -#endif + const Tk_SmoothMethod *method); /* Slot 218 is reserved */ /* Slot 219 is reserved */ -#ifndef Tk_GetDash_TCL_DECLARED -#define Tk_GetDash_TCL_DECLARED /* 220 */ -EXTERN int Tk_GetDash(Tcl_Interp *interp, CONST char *value, +EXTERN int Tk_GetDash(Tcl_Interp *interp, const char *value, Tk_Dash *dash); -#endif -#ifndef Tk_CreateOutline_TCL_DECLARED -#define Tk_CreateOutline_TCL_DECLARED /* 221 */ EXTERN void Tk_CreateOutline(Tk_Outline *outline); -#endif -#ifndef Tk_DeleteOutline_TCL_DECLARED -#define Tk_DeleteOutline_TCL_DECLARED /* 222 */ EXTERN void Tk_DeleteOutline(Display *display, Tk_Outline *outline); -#endif -#ifndef Tk_ConfigOutlineGC_TCL_DECLARED -#define Tk_ConfigOutlineGC_TCL_DECLARED /* 223 */ EXTERN int Tk_ConfigOutlineGC(XGCValues *gcValues, Tk_Canvas canvas, Tk_Item *item, Tk_Outline *outline); -#endif -#ifndef Tk_ChangeOutlineGC_TCL_DECLARED -#define Tk_ChangeOutlineGC_TCL_DECLARED /* 224 */ EXTERN int Tk_ChangeOutlineGC(Tk_Canvas canvas, Tk_Item *item, Tk_Outline *outline); -#endif -#ifndef Tk_ResetOutlineGC_TCL_DECLARED -#define Tk_ResetOutlineGC_TCL_DECLARED /* 225 */ EXTERN int Tk_ResetOutlineGC(Tk_Canvas canvas, Tk_Item *item, Tk_Outline *outline); -#endif -#ifndef Tk_CanvasPsOutline_TCL_DECLARED -#define Tk_CanvasPsOutline_TCL_DECLARED /* 226 */ EXTERN int Tk_CanvasPsOutline(Tk_Canvas canvas, Tk_Item *item, Tk_Outline *outline); -#endif -#ifndef Tk_SetTSOrigin_TCL_DECLARED -#define Tk_SetTSOrigin_TCL_DECLARED /* 227 */ EXTERN void Tk_SetTSOrigin(Tk_Window tkwin, GC gc, int x, int y); -#endif -#ifndef Tk_CanvasGetCoordFromObj_TCL_DECLARED -#define Tk_CanvasGetCoordFromObj_TCL_DECLARED /* 228 */ EXTERN int Tk_CanvasGetCoordFromObj(Tcl_Interp *interp, Tk_Canvas canvas, Tcl_Obj *obj, double *doublePtr); -#endif -#ifndef Tk_CanvasSetOffset_TCL_DECLARED -#define Tk_CanvasSetOffset_TCL_DECLARED /* 229 */ EXTERN void Tk_CanvasSetOffset(Tk_Canvas canvas, GC gc, Tk_TSOffset *offset); -#endif -#ifndef Tk_DitherPhoto_TCL_DECLARED -#define Tk_DitherPhoto_TCL_DECLARED /* 230 */ EXTERN void Tk_DitherPhoto(Tk_PhotoHandle handle, int x, int y, int width, int height); -#endif -#ifndef Tk_PostscriptBitmap_TCL_DECLARED -#define Tk_PostscriptBitmap_TCL_DECLARED /* 231 */ EXTERN int Tk_PostscriptBitmap(Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psInfo, Pixmap bitmap, int startX, int startY, int width, int height); -#endif -#ifndef Tk_PostscriptColor_TCL_DECLARED -#define Tk_PostscriptColor_TCL_DECLARED /* 232 */ EXTERN int Tk_PostscriptColor(Tcl_Interp *interp, Tk_PostscriptInfo psInfo, XColor *colorPtr); -#endif -#ifndef Tk_PostscriptFont_TCL_DECLARED -#define Tk_PostscriptFont_TCL_DECLARED /* 233 */ EXTERN int Tk_PostscriptFont(Tcl_Interp *interp, Tk_PostscriptInfo psInfo, Tk_Font font); -#endif -#ifndef Tk_PostscriptImage_TCL_DECLARED -#define Tk_PostscriptImage_TCL_DECLARED /* 234 */ EXTERN int Tk_PostscriptImage(Tk_Image image, Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psinfo, int x, int y, int width, int height, int prepass); -#endif -#ifndef Tk_PostscriptPath_TCL_DECLARED -#define Tk_PostscriptPath_TCL_DECLARED /* 235 */ EXTERN void Tk_PostscriptPath(Tcl_Interp *interp, Tk_PostscriptInfo psInfo, double *coordPtr, int numPoints); -#endif -#ifndef Tk_PostscriptStipple_TCL_DECLARED -#define Tk_PostscriptStipple_TCL_DECLARED /* 236 */ EXTERN int Tk_PostscriptStipple(Tcl_Interp *interp, Tk_Window tkwin, Tk_PostscriptInfo psInfo, Pixmap bitmap); -#endif -#ifndef Tk_PostscriptY_TCL_DECLARED -#define Tk_PostscriptY_TCL_DECLARED /* 237 */ EXTERN double Tk_PostscriptY(double y, Tk_PostscriptInfo psInfo); -#endif -#ifndef Tk_PostscriptPhoto_TCL_DECLARED -#define Tk_PostscriptPhoto_TCL_DECLARED /* 238 */ EXTERN int Tk_PostscriptPhoto(Tcl_Interp *interp, Tk_PhotoImageBlock *blockPtr, Tk_PostscriptInfo psInfo, int width, int height); -#endif -#ifndef Tk_CreateClientMessageHandler_TCL_DECLARED -#define Tk_CreateClientMessageHandler_TCL_DECLARED /* 239 */ EXTERN void Tk_CreateClientMessageHandler( Tk_ClientMessageProc *proc); -#endif -#ifndef Tk_DeleteClientMessageHandler_TCL_DECLARED -#define Tk_DeleteClientMessageHandler_TCL_DECLARED /* 240 */ EXTERN void Tk_DeleteClientMessageHandler( Tk_ClientMessageProc *proc); -#endif -#ifndef Tk_CreateAnonymousWindow_TCL_DECLARED -#define Tk_CreateAnonymousWindow_TCL_DECLARED /* 241 */ EXTERN Tk_Window Tk_CreateAnonymousWindow(Tcl_Interp *interp, - Tk_Window parent, CONST char *screenName); -#endif -#ifndef Tk_SetClassProcs_TCL_DECLARED -#define Tk_SetClassProcs_TCL_DECLARED + Tk_Window parent, const char *screenName); /* 242 */ EXTERN void Tk_SetClassProcs(Tk_Window tkwin, - Tk_ClassProcs *procs, + const Tk_ClassProcs *procs, ClientData instanceData); -#endif -#ifndef Tk_SetInternalBorderEx_TCL_DECLARED -#define Tk_SetInternalBorderEx_TCL_DECLARED /* 243 */ EXTERN void Tk_SetInternalBorderEx(Tk_Window tkwin, int left, int right, int top, int bottom); -#endif -#ifndef Tk_SetMinimumRequestSize_TCL_DECLARED -#define Tk_SetMinimumRequestSize_TCL_DECLARED /* 244 */ EXTERN void Tk_SetMinimumRequestSize(Tk_Window tkwin, int minWidth, int minHeight); -#endif -#ifndef Tk_SetCaretPos_TCL_DECLARED -#define Tk_SetCaretPos_TCL_DECLARED /* 245 */ EXTERN void Tk_SetCaretPos(Tk_Window tkwin, int x, int y, int height); -#endif -#ifndef Tk_PhotoPutBlock_Panic_TCL_DECLARED -#define Tk_PhotoPutBlock_Panic_TCL_DECLARED /* 246 */ EXTERN void Tk_PhotoPutBlock_Panic(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule); -#endif -#ifndef Tk_PhotoPutZoomedBlock_Panic_TCL_DECLARED -#define Tk_PhotoPutZoomedBlock_Panic_TCL_DECLARED /* 247 */ EXTERN void Tk_PhotoPutZoomedBlock_Panic(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule); -#endif -#ifndef Tk_CollapseMotionEvents_TCL_DECLARED -#define Tk_CollapseMotionEvents_TCL_DECLARED /* 248 */ EXTERN int Tk_CollapseMotionEvents(Display *display, int collapse); -#endif -#ifndef Tk_RegisterStyleEngine_TCL_DECLARED -#define Tk_RegisterStyleEngine_TCL_DECLARED /* 249 */ -EXTERN Tk_StyleEngine Tk_RegisterStyleEngine(CONST char *name, +EXTERN Tk_StyleEngine Tk_RegisterStyleEngine(const char *name, Tk_StyleEngine parent); -#endif -#ifndef Tk_GetStyleEngine_TCL_DECLARED -#define Tk_GetStyleEngine_TCL_DECLARED /* 250 */ -EXTERN Tk_StyleEngine Tk_GetStyleEngine(CONST char *name); -#endif -#ifndef Tk_RegisterStyledElement_TCL_DECLARED -#define Tk_RegisterStyledElement_TCL_DECLARED +EXTERN Tk_StyleEngine Tk_GetStyleEngine(const char *name); /* 251 */ EXTERN int Tk_RegisterStyledElement(Tk_StyleEngine engine, Tk_ElementSpec *templatePtr); -#endif -#ifndef Tk_GetElementId_TCL_DECLARED -#define Tk_GetElementId_TCL_DECLARED /* 252 */ -EXTERN int Tk_GetElementId(CONST char *name); -#endif -#ifndef Tk_CreateStyle_TCL_DECLARED -#define Tk_CreateStyle_TCL_DECLARED +EXTERN int Tk_GetElementId(const char *name); /* 253 */ -EXTERN Tk_Style Tk_CreateStyle(CONST char *name, +EXTERN Tk_Style Tk_CreateStyle(const char *name, Tk_StyleEngine engine, ClientData clientData); -#endif -#ifndef Tk_GetStyle_TCL_DECLARED -#define Tk_GetStyle_TCL_DECLARED /* 254 */ -EXTERN Tk_Style Tk_GetStyle(Tcl_Interp *interp, CONST char *name); -#endif -#ifndef Tk_FreeStyle_TCL_DECLARED -#define Tk_FreeStyle_TCL_DECLARED +EXTERN Tk_Style Tk_GetStyle(Tcl_Interp *interp, const char *name); /* 255 */ EXTERN void Tk_FreeStyle(Tk_Style style); -#endif -#ifndef Tk_NameOfStyle_TCL_DECLARED -#define Tk_NameOfStyle_TCL_DECLARED /* 256 */ -EXTERN CONST char * Tk_NameOfStyle(Tk_Style style); -#endif -#ifndef Tk_AllocStyleFromObj_TCL_DECLARED -#define Tk_AllocStyleFromObj_TCL_DECLARED +EXTERN const char * Tk_NameOfStyle(Tk_Style style); /* 257 */ EXTERN Tk_Style Tk_AllocStyleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); -#endif -#ifndef Tk_GetStyleFromObj_TCL_DECLARED -#define Tk_GetStyleFromObj_TCL_DECLARED /* 258 */ EXTERN Tk_Style Tk_GetStyleFromObj(Tcl_Obj *objPtr); -#endif -#ifndef Tk_FreeStyleFromObj_TCL_DECLARED -#define Tk_FreeStyleFromObj_TCL_DECLARED /* 259 */ EXTERN void Tk_FreeStyleFromObj(Tcl_Obj *objPtr); -#endif -#ifndef Tk_GetStyledElement_TCL_DECLARED -#define Tk_GetStyledElement_TCL_DECLARED /* 260 */ EXTERN Tk_StyledElement Tk_GetStyledElement(Tk_Style style, int elementId, Tk_OptionTable optionTable); -#endif -#ifndef Tk_GetElementSize_TCL_DECLARED -#define Tk_GetElementSize_TCL_DECLARED /* 261 */ EXTERN void Tk_GetElementSize(Tk_Style style, Tk_StyledElement element, char *recordPtr, Tk_Window tkwin, int width, int height, int inner, int *widthPtr, int *heightPtr); -#endif -#ifndef Tk_GetElementBox_TCL_DECLARED -#define Tk_GetElementBox_TCL_DECLARED /* 262 */ EXTERN void Tk_GetElementBox(Tk_Style style, Tk_StyledElement element, char *recordPtr, Tk_Window tkwin, int x, int y, int width, int height, int inner, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr); -#endif -#ifndef Tk_GetElementBorderWidth_TCL_DECLARED -#define Tk_GetElementBorderWidth_TCL_DECLARED /* 263 */ EXTERN int Tk_GetElementBorderWidth(Tk_Style style, Tk_StyledElement element, char *recordPtr, Tk_Window tkwin); -#endif -#ifndef Tk_DrawElement_TCL_DECLARED -#define Tk_DrawElement_TCL_DECLARED /* 264 */ EXTERN void Tk_DrawElement(Tk_Style style, Tk_StyledElement element, char *recordPtr, Tk_Window tkwin, Drawable d, int x, int y, int width, int height, int state); -#endif -#ifndef Tk_PhotoExpand_TCL_DECLARED -#define Tk_PhotoExpand_TCL_DECLARED /* 265 */ EXTERN int Tk_PhotoExpand(Tcl_Interp *interp, Tk_PhotoHandle handle, int width, int height); -#endif -#ifndef Tk_PhotoPutBlock_TCL_DECLARED -#define Tk_PhotoPutBlock_TCL_DECLARED /* 266 */ EXTERN int Tk_PhotoPutBlock(Tcl_Interp *interp, Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule); -#endif -#ifndef Tk_PhotoPutZoomedBlock_TCL_DECLARED -#define Tk_PhotoPutZoomedBlock_TCL_DECLARED /* 267 */ EXTERN int Tk_PhotoPutZoomedBlock(Tcl_Interp *interp, Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule); -#endif -#ifndef Tk_PhotoSetSize_TCL_DECLARED -#define Tk_PhotoSetSize_TCL_DECLARED /* 268 */ EXTERN int Tk_PhotoSetSize(Tcl_Interp *interp, Tk_PhotoHandle handle, int width, int height); -#endif -#ifndef Tk_GetUserInactiveTime_TCL_DECLARED -#define Tk_GetUserInactiveTime_TCL_DECLARED /* 269 */ EXTERN long Tk_GetUserInactiveTime(Display *dpy); -#endif -#ifndef Tk_ResetUserInactiveTime_TCL_DECLARED -#define Tk_ResetUserInactiveTime_TCL_DECLARED /* 270 */ EXTERN void Tk_ResetUserInactiveTime(Display *dpy); -#endif -#ifndef Tk_Interp_TCL_DECLARED -#define Tk_Interp_TCL_DECLARED /* 271 */ EXTERN Tcl_Interp * Tk_Interp(Tk_Window tkwin); -#endif -#ifndef Tk_CreateOldImageType_TCL_DECLARED -#define Tk_CreateOldImageType_TCL_DECLARED /* 272 */ -EXTERN void Tk_CreateOldImageType(Tk_ImageType *typePtr); -#endif -#ifndef Tk_CreateOldPhotoImageFormat_TCL_DECLARED -#define Tk_CreateOldPhotoImageFormat_TCL_DECLARED +EXTERN void Tk_CreateOldImageType(const Tk_ImageType *typePtr); /* 273 */ 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 + const Tk_PhotoImageFormat *formatPtr); -typedef struct TkStubHooks { - struct TkPlatStubs *tkPlatStubs; - struct TkIntStubs *tkIntStubs; - struct TkIntPlatStubs *tkIntPlatStubs; - struct TkIntXlibStubs *tkIntXlibStubs; +typedef struct { + const struct TkPlatStubs *tkPlatStubs; + const struct TkIntStubs *tkIntStubs; + const struct TkIntPlatStubs *tkIntPlatStubs; + const struct TkIntXlibStubs *tkIntXlibStubs; } TkStubHooks; typedef struct TkStubs { int magic; - struct TkStubHooks *hooks; + const TkStubHooks *hooks; void (*tk_MainLoop) (void); /* 0 */ XColor * (*tk_3DBorderColor) (Tk_3DBorder border); /* 1 */ GC (*tk_3DBorderGC) (Tk_Window tkwin, Tk_3DBorder border, int which); /* 2 */ void (*tk_3DHorizontalBevel) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftIn, int rightIn, int topBevel, int relief); /* 3 */ void (*tk_3DVerticalBevel) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftBevel, int relief); /* 4 */ - void (*tk_AddOption) (Tk_Window tkwin, CONST char *name, CONST char *value, int priority); /* 5 */ + void (*tk_AddOption) (Tk_Window tkwin, const char *name, const char *value, int priority); /* 5 */ void (*tk_BindEvent) (Tk_BindingTable bindingTable, XEvent *eventPtr, Tk_Window tkwin, int numObjects, ClientData *objectPtr); /* 6 */ void (*tk_CanvasDrawableCoords) (Tk_Canvas canvas, double x, double y, short *drawableXPtr, short *drawableYPtr); /* 7 */ void (*tk_CanvasEventuallyRedraw) (Tk_Canvas canvas, int x1, int y1, int x2, int y2); /* 8 */ - int (*tk_CanvasGetCoord) (Tcl_Interp *interp, Tk_Canvas canvas, CONST char *str, double *doublePtr); /* 9 */ + int (*tk_CanvasGetCoord) (Tcl_Interp *interp, Tk_Canvas canvas, const char *str, double *doublePtr); /* 9 */ Tk_CanvasTextInfo * (*tk_CanvasGetTextInfo) (Tk_Canvas canvas); /* 10 */ int (*tk_CanvasPsBitmap) (Tcl_Interp *interp, Tk_Canvas canvas, Pixmap bitmap, int x, int y, int width, int height); /* 11 */ int (*tk_CanvasPsColor) (Tcl_Interp *interp, Tk_Canvas canvas, XColor *colorPtr); /* 12 */ @@ -1714,53 +894,53 @@ typedef struct TkStubs { int (*tk_CanvasPsStipple) (Tcl_Interp *interp, Tk_Canvas canvas, Pixmap bitmap); /* 15 */ double (*tk_CanvasPsY) (Tk_Canvas canvas, double y); /* 16 */ void (*tk_CanvasSetStippleOrigin) (Tk_Canvas canvas, GC gc); /* 17 */ - int (*tk_CanvasTagsParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, CONST char *value, char *widgRec, int offset); /* 18 */ - char * (*tk_CanvasTagsPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 19 */ + int (*tk_CanvasTagsParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 18 */ + CONST86 char * (*tk_CanvasTagsPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 19 */ Tk_Window (*tk_CanvasTkwin) (Tk_Canvas canvas); /* 20 */ void (*tk_CanvasWindowCoords) (Tk_Canvas canvas, double x, double y, short *screenXPtr, short *screenYPtr); /* 21 */ void (*tk_ChangeWindowAttributes) (Tk_Window tkwin, unsigned long valueMask, XSetWindowAttributes *attsPtr); /* 22 */ int (*tk_CharBbox) (Tk_TextLayout layout, int index, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr); /* 23 */ void (*tk_ClearSelection) (Tk_Window tkwin, Atom selection); /* 24 */ - int (*tk_ClipboardAppend) (Tcl_Interp *interp, Tk_Window tkwin, Atom target, Atom format, char *buffer); /* 25 */ + int (*tk_ClipboardAppend) (Tcl_Interp *interp, Tk_Window tkwin, Atom target, Atom format, const char *buffer); /* 25 */ int (*tk_ClipboardClear) (Tcl_Interp *interp, Tk_Window tkwin); /* 26 */ - int (*tk_ConfigureInfo) (Tcl_Interp *interp, Tk_Window tkwin, Tk_ConfigSpec *specs, char *widgRec, CONST char *argvName, int flags); /* 27 */ - int (*tk_ConfigureValue) (Tcl_Interp *interp, Tk_Window tkwin, Tk_ConfigSpec *specs, char *widgRec, CONST char *argvName, int flags); /* 28 */ - int (*tk_ConfigureWidget) (Tcl_Interp *interp, Tk_Window tkwin, Tk_ConfigSpec *specs, int argc, CONST84 char **argv, char *widgRec, int flags); /* 29 */ + int (*tk_ConfigureInfo) (Tcl_Interp *interp, Tk_Window tkwin, const Tk_ConfigSpec *specs, char *widgRec, const char *argvName, int flags); /* 27 */ + int (*tk_ConfigureValue) (Tcl_Interp *interp, Tk_Window tkwin, const Tk_ConfigSpec *specs, char *widgRec, const char *argvName, int flags); /* 28 */ + int (*tk_ConfigureWidget) (Tcl_Interp *interp, Tk_Window tkwin, const Tk_ConfigSpec *specs, int argc, CONST84 char **argv, char *widgRec, int flags); /* 29 */ void (*tk_ConfigureWindow) (Tk_Window tkwin, unsigned int valueMask, XWindowChanges *valuePtr); /* 30 */ - Tk_TextLayout (*tk_ComputeTextLayout) (Tk_Font font, CONST char *str, int numChars, int wrapLength, Tk_Justify justify, int flags, int *widthPtr, int *heightPtr); /* 31 */ + Tk_TextLayout (*tk_ComputeTextLayout) (Tk_Font font, const char *str, int numChars, int wrapLength, Tk_Justify justify, int flags, int *widthPtr, int *heightPtr); /* 31 */ Tk_Window (*tk_CoordsToWindow) (int rootX, int rootY, Tk_Window tkwin); /* 32 */ - unsigned long (*tk_CreateBinding) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, CONST char *eventStr, CONST char *command, int append); /* 33 */ + unsigned long (*tk_CreateBinding) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, const char *eventStr, const char *script, int append); /* 33 */ Tk_BindingTable (*tk_CreateBindingTable) (Tcl_Interp *interp); /* 34 */ Tk_ErrorHandler (*tk_CreateErrorHandler) (Display *display, int errNum, int request, int minorCode, Tk_ErrorProc *errorProc, ClientData clientData); /* 35 */ void (*tk_CreateEventHandler) (Tk_Window token, unsigned long mask, Tk_EventProc *proc, ClientData clientData); /* 36 */ void (*tk_CreateGenericHandler) (Tk_GenericProc *proc, ClientData clientData); /* 37 */ - void (*tk_CreateImageType) (Tk_ImageType *typePtr); /* 38 */ + void (*tk_CreateImageType) (const Tk_ImageType *typePtr); /* 38 */ void (*tk_CreateItemType) (Tk_ItemType *typePtr); /* 39 */ - void (*tk_CreatePhotoImageFormat) (Tk_PhotoImageFormat *formatPtr); /* 40 */ + void (*tk_CreatePhotoImageFormat) (const Tk_PhotoImageFormat *formatPtr); /* 40 */ void (*tk_CreateSelHandler) (Tk_Window tkwin, Atom selection, Atom target, Tk_SelectionProc *proc, ClientData clientData, Atom format); /* 41 */ - Tk_Window (*tk_CreateWindow) (Tcl_Interp *interp, Tk_Window parent, CONST char *name, CONST char *screenName); /* 42 */ - Tk_Window (*tk_CreateWindowFromPath) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *pathName, CONST char *screenName); /* 43 */ - int (*tk_DefineBitmap) (Tcl_Interp *interp, CONST char *name, CONST char *source, int width, int height); /* 44 */ + Tk_Window (*tk_CreateWindow) (Tcl_Interp *interp, Tk_Window parent, const char *name, const char *screenName); /* 42 */ + Tk_Window (*tk_CreateWindowFromPath) (Tcl_Interp *interp, Tk_Window tkwin, const char *pathName, const char *screenName); /* 43 */ + int (*tk_DefineBitmap) (Tcl_Interp *interp, const char *name, const void *source, int width, int height); /* 44 */ void (*tk_DefineCursor) (Tk_Window window, Tk_Cursor cursor); /* 45 */ void (*tk_DeleteAllBindings) (Tk_BindingTable bindingTable, ClientData object); /* 46 */ - int (*tk_DeleteBinding) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, CONST char *eventStr); /* 47 */ + int (*tk_DeleteBinding) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, const char *eventStr); /* 47 */ void (*tk_DeleteBindingTable) (Tk_BindingTable bindingTable); /* 48 */ void (*tk_DeleteErrorHandler) (Tk_ErrorHandler handler); /* 49 */ void (*tk_DeleteEventHandler) (Tk_Window token, unsigned long mask, Tk_EventProc *proc, ClientData clientData); /* 50 */ void (*tk_DeleteGenericHandler) (Tk_GenericProc *proc, ClientData clientData); /* 51 */ - void (*tk_DeleteImage) (Tcl_Interp *interp, CONST char *name); /* 52 */ + void (*tk_DeleteImage) (Tcl_Interp *interp, const char *name); /* 52 */ void (*tk_DeleteSelHandler) (Tk_Window tkwin, Atom selection, Atom target); /* 53 */ void (*tk_DestroyWindow) (Tk_Window tkwin); /* 54 */ CONST84_RETURN char * (*tk_DisplayName) (Tk_Window tkwin); /* 55 */ int (*tk_DistanceToTextLayout) (Tk_TextLayout layout, int x, int y); /* 56 */ void (*tk_Draw3DPolygon) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint *pointPtr, int numPoints, int borderWidth, int leftRelief); /* 57 */ void (*tk_Draw3DRectangle) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief); /* 58 */ - void (*tk_DrawChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char *source, int numBytes, int x, int y); /* 59 */ + void (*tk_DrawChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int numBytes, int x, int y); /* 59 */ void (*tk_DrawFocusHighlight) (Tk_Window tkwin, GC gc, int width, Drawable drawable); /* 60 */ void (*tk_DrawTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int firstChar, int lastChar); /* 61 */ void (*tk_Fill3DPolygon) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint *pointPtr, int numPoints, int borderWidth, int leftRelief); /* 62 */ void (*tk_Fill3DRectangle) (Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief); /* 63 */ - Tk_PhotoHandle (*tk_FindPhoto) (Tcl_Interp *interp, CONST char *imageName); /* 64 */ + Tk_PhotoHandle (*tk_FindPhoto) (Tcl_Interp *interp, const char *imageName); /* 64 */ Font (*tk_FontId) (Tk_Font font); /* 65 */ void (*tk_Free3DBorder) (Tk_3DBorder border); /* 66 */ void (*tk_FreeBitmap) (Display *display, Pixmap bitmap); /* 67 */ @@ -1770,7 +950,7 @@ typedef struct TkStubs { void (*tk_FreeFont) (Tk_Font f); /* 71 */ void (*tk_FreeGC) (Display *display, GC gc); /* 72 */ void (*tk_FreeImage) (Tk_Image image); /* 73 */ - void (*tk_FreeOptions) (Tk_ConfigSpec *specs, char *widgRec, Display *display, int needFlags); /* 74 */ + void (*tk_FreeOptions) (const Tk_ConfigSpec *specs, char *widgRec, Display *display, int needFlags); /* 74 */ void (*tk_FreePixmap) (Display *display, Pixmap pixmap); /* 75 */ void (*tk_FreeTextLayout) (Tk_TextLayout textLayout); /* 76 */ void (*tk_FreeXId) (Display *display, XID xid); /* 77 */ @@ -1778,51 +958,51 @@ typedef struct TkStubs { void (*tk_GeometryRequest) (Tk_Window tkwin, int reqWidth, int reqHeight); /* 79 */ Tk_3DBorder (*tk_Get3DBorder) (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid colorName); /* 80 */ void (*tk_GetAllBindings) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object); /* 81 */ - int (*tk_GetAnchor) (Tcl_Interp *interp, CONST char *str, Tk_Anchor *anchorPtr); /* 82 */ + int (*tk_GetAnchor) (Tcl_Interp *interp, const char *str, Tk_Anchor *anchorPtr); /* 82 */ CONST84_RETURN char * (*tk_GetAtomName) (Tk_Window tkwin, Atom atom); /* 83 */ - CONST84_RETURN char * (*tk_GetBinding) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, CONST char *eventStr); /* 84 */ - Pixmap (*tk_GetBitmap) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *str); /* 85 */ - Pixmap (*tk_GetBitmapFromData) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *source, int width, int height); /* 86 */ - int (*tk_GetCapStyle) (Tcl_Interp *interp, CONST char *str, int *capPtr); /* 87 */ + CONST84_RETURN char * (*tk_GetBinding) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, const char *eventStr); /* 84 */ + Pixmap (*tk_GetBitmap) (Tcl_Interp *interp, Tk_Window tkwin, const char *str); /* 85 */ + Pixmap (*tk_GetBitmapFromData) (Tcl_Interp *interp, Tk_Window tkwin, const void *source, int width, int height); /* 86 */ + int (*tk_GetCapStyle) (Tcl_Interp *interp, const char *str, int *capPtr); /* 87 */ XColor * (*tk_GetColor) (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid name); /* 88 */ XColor * (*tk_GetColorByValue) (Tk_Window tkwin, XColor *colorPtr); /* 89 */ - Colormap (*tk_GetColormap) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *str); /* 90 */ + Colormap (*tk_GetColormap) (Tcl_Interp *interp, Tk_Window tkwin, const char *str); /* 90 */ Tk_Cursor (*tk_GetCursor) (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid str); /* 91 */ - Tk_Cursor (*tk_GetCursorFromData) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *source, CONST char *mask, int width, int height, int xHot, int yHot, Tk_Uid fg, Tk_Uid bg); /* 92 */ - Tk_Font (*tk_GetFont) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *str); /* 93 */ + Tk_Cursor (*tk_GetCursorFromData) (Tcl_Interp *interp, Tk_Window tkwin, const char *source, const char *mask, int width, int height, int xHot, int yHot, Tk_Uid fg, Tk_Uid bg); /* 92 */ + Tk_Font (*tk_GetFont) (Tcl_Interp *interp, Tk_Window tkwin, const char *str); /* 93 */ Tk_Font (*tk_GetFontFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 94 */ void (*tk_GetFontMetrics) (Tk_Font font, Tk_FontMetrics *fmPtr); /* 95 */ GC (*tk_GetGC) (Tk_Window tkwin, unsigned long valueMask, XGCValues *valuePtr); /* 96 */ - Tk_Image (*tk_GetImage) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *name, Tk_ImageChangedProc *changeProc, ClientData clientData); /* 97 */ - ClientData (*tk_GetImageMasterData) (Tcl_Interp *interp, CONST char *name, Tk_ImageType **typePtrPtr); /* 98 */ + Tk_Image (*tk_GetImage) (Tcl_Interp *interp, Tk_Window tkwin, const char *name, Tk_ImageChangedProc *changeProc, ClientData clientData); /* 97 */ + ClientData (*tk_GetImageMasterData) (Tcl_Interp *interp, const char *name, CONST86 Tk_ImageType **typePtrPtr); /* 98 */ Tk_ItemType * (*tk_GetItemTypes) (void); /* 99 */ - int (*tk_GetJoinStyle) (Tcl_Interp *interp, CONST char *str, int *joinPtr); /* 100 */ - int (*tk_GetJustify) (Tcl_Interp *interp, CONST char *str, Tk_Justify *justifyPtr); /* 101 */ + int (*tk_GetJoinStyle) (Tcl_Interp *interp, const char *str, int *joinPtr); /* 100 */ + int (*tk_GetJustify) (Tcl_Interp *interp, const char *str, Tk_Justify *justifyPtr); /* 101 */ int (*tk_GetNumMainWindows) (void); /* 102 */ - Tk_Uid (*tk_GetOption) (Tk_Window tkwin, CONST char *name, CONST char *className); /* 103 */ - int (*tk_GetPixels) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *str, int *intPtr); /* 104 */ + Tk_Uid (*tk_GetOption) (Tk_Window tkwin, const char *name, const char *className); /* 103 */ + int (*tk_GetPixels) (Tcl_Interp *interp, Tk_Window tkwin, const char *str, int *intPtr); /* 104 */ Pixmap (*tk_GetPixmap) (Display *display, Drawable d, int width, int height, int depth); /* 105 */ - int (*tk_GetRelief) (Tcl_Interp *interp, CONST char *name, int *reliefPtr); /* 106 */ + int (*tk_GetRelief) (Tcl_Interp *interp, const char *name, int *reliefPtr); /* 106 */ void (*tk_GetRootCoords) (Tk_Window tkwin, int *xPtr, int *yPtr); /* 107 */ int (*tk_GetScrollInfo) (Tcl_Interp *interp, int argc, CONST84 char **argv, double *dblPtr, int *intPtr); /* 108 */ - int (*tk_GetScreenMM) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *str, double *doublePtr); /* 109 */ + int (*tk_GetScreenMM) (Tcl_Interp *interp, Tk_Window tkwin, const char *str, double *doublePtr); /* 109 */ int (*tk_GetSelection) (Tcl_Interp *interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc *proc, ClientData clientData); /* 110 */ - Tk_Uid (*tk_GetUid) (CONST char *str); /* 111 */ - Visual * (*tk_GetVisual) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *str, int *depthPtr, Colormap *colormapPtr); /* 112 */ + Tk_Uid (*tk_GetUid) (const char *str); /* 111 */ + Visual * (*tk_GetVisual) (Tcl_Interp *interp, Tk_Window tkwin, const char *str, int *depthPtr, Colormap *colormapPtr); /* 112 */ void (*tk_GetVRootGeometry) (Tk_Window tkwin, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr); /* 113 */ int (*tk_Grab) (Tcl_Interp *interp, Tk_Window tkwin, int grabGlobal); /* 114 */ void (*tk_HandleEvent) (XEvent *eventPtr); /* 115 */ Tk_Window (*tk_IdToWindow) (Display *display, Window window); /* 116 */ void (*tk_ImageChanged) (Tk_ImageMaster master, int x, int y, int width, int height, int imageWidth, int imageHeight); /* 117 */ int (*tk_Init) (Tcl_Interp *interp); /* 118 */ - Atom (*tk_InternAtom) (Tk_Window tkwin, CONST char *name); /* 119 */ + Atom (*tk_InternAtom) (Tk_Window tkwin, const char *name); /* 119 */ int (*tk_IntersectTextLayout) (Tk_TextLayout layout, int x, int y, int width, int height); /* 120 */ void (*tk_MaintainGeometry) (Tk_Window slave, Tk_Window master, int x, int y, int width, int height); /* 121 */ Tk_Window (*tk_MainWindow) (Tcl_Interp *interp); /* 122 */ void (*tk_MakeWindowExist) (Tk_Window tkwin); /* 123 */ - void (*tk_ManageGeometry) (Tk_Window tkwin, CONST Tk_GeomMgr *mgrPtr, ClientData clientData); /* 124 */ + void (*tk_ManageGeometry) (Tk_Window tkwin, const Tk_GeomMgr *mgrPtr, ClientData clientData); /* 124 */ void (*tk_MapWindow) (Tk_Window tkwin); /* 125 */ - int (*tk_MeasureChars) (Tk_Font tkfont, CONST char *source, int numBytes, int maxPixels, int flags, int *lengthPtr); /* 126 */ + int (*tk_MeasureChars) (Tk_Font tkfont, const char *source, int numBytes, int maxPixels, int flags, int *lengthPtr); /* 126 */ void (*tk_MoveResizeWindow) (Tk_Window tkwin, int x, int y, int width, int height); /* 127 */ void (*tk_MoveWindow) (Tk_Window tkwin, int x, int y); /* 128 */ void (*tk_MoveToplevelWindow) (Tk_Window tkwin, int x, int y); /* 129 */ @@ -1837,9 +1017,9 @@ typedef struct TkStubs { CONST84_RETURN char * (*tk_NameOfJoinStyle) (int join); /* 138 */ CONST84_RETURN char * (*tk_NameOfJustify) (Tk_Justify justify); /* 139 */ CONST84_RETURN char * (*tk_NameOfRelief) (int relief); /* 140 */ - Tk_Window (*tk_NameToWindow) (Tcl_Interp *interp, CONST char *pathName, Tk_Window tkwin); /* 141 */ + Tk_Window (*tk_NameToWindow) (Tcl_Interp *interp, const char *pathName, Tk_Window tkwin); /* 141 */ void (*tk_OwnSelection) (Tk_Window tkwin, Atom selection, Tk_LostSelProc *proc, ClientData clientData); /* 142 */ - int (*tk_ParseArgv) (Tcl_Interp *interp, Tk_Window tkwin, int *argcPtr, CONST84 char **argv, Tk_ArgvInfo *argTable, int flags); /* 143 */ + int (*tk_ParseArgv) (Tcl_Interp *interp, Tk_Window tkwin, int *argcPtr, CONST84 char **argv, const Tk_ArgvInfo *argTable, int flags); /* 143 */ void (*tk_PhotoPutBlock_NoComposite) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height); /* 144 */ void (*tk_PhotoPutZoomedBlock_NoComposite) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY); /* 145 */ int (*tk_PhotoGetImage) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr); /* 146 */ @@ -1856,9 +1036,9 @@ typedef struct TkStubs { int (*tk_RestackWindow) (Tk_Window tkwin, int aboveBelow, Tk_Window other); /* 157 */ Tk_RestrictProc * (*tk_RestrictEvents) (Tk_RestrictProc *proc, ClientData arg, ClientData *prevArgPtr); /* 158 */ int (*tk_SafeInit) (Tcl_Interp *interp); /* 159 */ - CONST char * (*tk_SetAppName) (Tk_Window tkwin, CONST char *name); /* 160 */ + const char * (*tk_SetAppName) (Tk_Window tkwin, const char *name); /* 160 */ void (*tk_SetBackgroundFromBorder) (Tk_Window tkwin, Tk_3DBorder border); /* 161 */ - void (*tk_SetClass) (Tk_Window tkwin, CONST char *className); /* 162 */ + void (*tk_SetClass) (Tk_Window tkwin, const char *className); /* 162 */ void (*tk_SetGrid) (Tk_Window tkwin, int reqWidth, int reqHeight, int gridWidth, int gridHeight); /* 163 */ void (*tk_SetInternalBorder) (Tk_Window tkwin, int width); /* 164 */ void (*tk_SetWindowBackground) (Tk_Window tkwin, unsigned long pixel); /* 165 */ @@ -1872,9 +1052,9 @@ typedef struct TkStubs { void (*tk_SizeOfImage) (Tk_Image image, int *widthPtr, int *heightPtr); /* 173 */ int (*tk_StrictMotif) (Tk_Window tkwin); /* 174 */ void (*tk_TextLayoutToPostscript) (Tcl_Interp *interp, Tk_TextLayout layout); /* 175 */ - int (*tk_TextWidth) (Tk_Font font, CONST char *str, int numBytes); /* 176 */ + int (*tk_TextWidth) (Tk_Font font, const char *str, int numBytes); /* 176 */ void (*tk_UndefineCursor) (Tk_Window window); /* 177 */ - void (*tk_UnderlineChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char *source, int x, int y, int firstByte, int lastByte); /* 178 */ + void (*tk_UnderlineChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int x, int y, int firstByte, int lastByte); /* 178 */ void (*tk_UnderlineTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int underline); /* 179 */ void (*tk_Ungrab) (Tk_Window tkwin); /* 180 */ void (*tk_UnmaintainGeometry) (Tk_Window slave, Tk_Window master); /* 181 */ @@ -1886,7 +1066,7 @@ typedef struct TkStubs { XColor * (*tk_AllocColorFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); /* 187 */ Tk_Cursor (*tk_AllocCursorFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); /* 188 */ Tk_Font (*tk_AllocFontFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr); /* 189 */ - Tk_OptionTable (*tk_CreateOptionTable) (Tcl_Interp *interp, CONST Tk_OptionSpec *templatePtr); /* 190 */ + Tk_OptionTable (*tk_CreateOptionTable) (Tcl_Interp *interp, const Tk_OptionSpec *templatePtr); /* 190 */ void (*tk_DeleteOptionTable) (Tk_OptionTable optionTable); /* 191 */ void (*tk_Free3DBorderFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 192 */ void (*tk_FreeBitmapFromObj) (Tk_Window tkwin, Tcl_Obj *objPtr); /* 193 */ @@ -1906,17 +1086,17 @@ typedef struct TkStubs { int (*tk_GetMMFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr); /* 207 */ int (*tk_GetPixelsFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, int *intPtr); /* 208 */ int (*tk_GetReliefFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr); /* 209 */ - int (*tk_GetScrollInfoObj) (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], double *dblPtr, int *intPtr); /* 210 */ + int (*tk_GetScrollInfoObj) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], double *dblPtr, int *intPtr); /* 210 */ int (*tk_InitOptions) (Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin); /* 211 */ void (*tk_MainEx) (int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); /* 212 */ void (*tk_RestoreSavedOptions) (Tk_SavedOptions *savePtr); /* 213 */ - int (*tk_SetOptions) (Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionTable, int objc, Tcl_Obj *CONST objv[], Tk_Window tkwin, Tk_SavedOptions *savePtr, int *maskPtr); /* 214 */ + int (*tk_SetOptions) (Tcl_Interp *interp, char *recordPtr, Tk_OptionTable optionTable, int objc, Tcl_Obj *const objv[], Tk_Window tkwin, Tk_SavedOptions *savePtr, int *maskPtr); /* 214 */ void (*tk_InitConsoleChannels) (Tcl_Interp *interp); /* 215 */ int (*tk_CreateConsoleWindow) (Tcl_Interp *interp); /* 216 */ - void (*tk_CreateSmoothMethod) (Tcl_Interp *interp, Tk_SmoothMethod *method); /* 217 */ - VOID *reserved218; - VOID *reserved219; - int (*tk_GetDash) (Tcl_Interp *interp, CONST char *value, Tk_Dash *dash); /* 220 */ + void (*tk_CreateSmoothMethod) (Tcl_Interp *interp, const Tk_SmoothMethod *method); /* 217 */ + void (*reserved218)(void); + void (*reserved219)(void); + int (*tk_GetDash) (Tcl_Interp *interp, const char *value, Tk_Dash *dash); /* 220 */ void (*tk_CreateOutline) (Tk_Outline *outline); /* 221 */ void (*tk_DeleteOutline) (Display *display, Tk_Outline *outline); /* 222 */ int (*tk_ConfigOutlineGC) (XGCValues *gcValues, Tk_Canvas canvas, Tk_Item *item, Tk_Outline *outline); /* 223 */ @@ -1937,22 +1117,22 @@ typedef struct TkStubs { int (*tk_PostscriptPhoto) (Tcl_Interp *interp, Tk_PhotoImageBlock *blockPtr, Tk_PostscriptInfo psInfo, int width, int height); /* 238 */ void (*tk_CreateClientMessageHandler) (Tk_ClientMessageProc *proc); /* 239 */ void (*tk_DeleteClientMessageHandler) (Tk_ClientMessageProc *proc); /* 240 */ - Tk_Window (*tk_CreateAnonymousWindow) (Tcl_Interp *interp, Tk_Window parent, CONST char *screenName); /* 241 */ - void (*tk_SetClassProcs) (Tk_Window tkwin, Tk_ClassProcs *procs, ClientData instanceData); /* 242 */ + Tk_Window (*tk_CreateAnonymousWindow) (Tcl_Interp *interp, Tk_Window parent, const char *screenName); /* 241 */ + void (*tk_SetClassProcs) (Tk_Window tkwin, const Tk_ClassProcs *procs, ClientData instanceData); /* 242 */ void (*tk_SetInternalBorderEx) (Tk_Window tkwin, int left, int right, int top, int bottom); /* 243 */ void (*tk_SetMinimumRequestSize) (Tk_Window tkwin, int minWidth, int minHeight); /* 244 */ void (*tk_SetCaretPos) (Tk_Window tkwin, int x, int y, int height); /* 245 */ void (*tk_PhotoPutBlock_Panic) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule); /* 246 */ void (*tk_PhotoPutZoomedBlock_Panic) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule); /* 247 */ int (*tk_CollapseMotionEvents) (Display *display, int collapse); /* 248 */ - Tk_StyleEngine (*tk_RegisterStyleEngine) (CONST char *name, Tk_StyleEngine parent); /* 249 */ - Tk_StyleEngine (*tk_GetStyleEngine) (CONST char *name); /* 250 */ + Tk_StyleEngine (*tk_RegisterStyleEngine) (const char *name, Tk_StyleEngine parent); /* 249 */ + Tk_StyleEngine (*tk_GetStyleEngine) (const char *name); /* 250 */ int (*tk_RegisterStyledElement) (Tk_StyleEngine engine, Tk_ElementSpec *templatePtr); /* 251 */ - int (*tk_GetElementId) (CONST char *name); /* 252 */ - Tk_Style (*tk_CreateStyle) (CONST char *name, Tk_StyleEngine engine, ClientData clientData); /* 253 */ - Tk_Style (*tk_GetStyle) (Tcl_Interp *interp, CONST char *name); /* 254 */ + int (*tk_GetElementId) (const char *name); /* 252 */ + Tk_Style (*tk_CreateStyle) (const char *name, Tk_StyleEngine engine, ClientData clientData); /* 253 */ + Tk_Style (*tk_GetStyle) (Tcl_Interp *interp, const char *name); /* 254 */ void (*tk_FreeStyle) (Tk_Style style); /* 255 */ - CONST char * (*tk_NameOfStyle) (Tk_Style style); /* 256 */ + const char * (*tk_NameOfStyle) (Tk_Style style); /* 256 */ Tk_Style (*tk_AllocStyleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 257 */ Tk_Style (*tk_GetStyleFromObj) (Tcl_Obj *objPtr); /* 258 */ void (*tk_FreeStyleFromObj) (Tcl_Obj *objPtr); /* 259 */ @@ -1968,1128 +1148,586 @@ typedef struct TkStubs { long (*tk_GetUserInactiveTime) (Display *dpy); /* 269 */ void (*tk_ResetUserInactiveTime) (Display *dpy); /* 270 */ 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 */ + void (*tk_CreateOldImageType) (const Tk_ImageType *typePtr); /* 272 */ + void (*tk_CreateOldPhotoImageFormat) (const Tk_PhotoImageFormat *formatPtr); /* 273 */ } TkStubs; -extern TkStubs *tkStubsPtr; +extern const TkStubs *tkStubsPtr; #ifdef __cplusplus } #endif -#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) +#if defined(USE_TK_STUBS) /* * Inline function declarations: */ -#ifndef Tk_MainLoop #define Tk_MainLoop \ (tkStubsPtr->tk_MainLoop) /* 0 */ -#endif -#ifndef Tk_3DBorderColor #define Tk_3DBorderColor \ (tkStubsPtr->tk_3DBorderColor) /* 1 */ -#endif -#ifndef Tk_3DBorderGC #define Tk_3DBorderGC \ (tkStubsPtr->tk_3DBorderGC) /* 2 */ -#endif -#ifndef Tk_3DHorizontalBevel #define Tk_3DHorizontalBevel \ (tkStubsPtr->tk_3DHorizontalBevel) /* 3 */ -#endif -#ifndef Tk_3DVerticalBevel #define Tk_3DVerticalBevel \ (tkStubsPtr->tk_3DVerticalBevel) /* 4 */ -#endif -#ifndef Tk_AddOption #define Tk_AddOption \ (tkStubsPtr->tk_AddOption) /* 5 */ -#endif -#ifndef Tk_BindEvent #define Tk_BindEvent \ (tkStubsPtr->tk_BindEvent) /* 6 */ -#endif -#ifndef Tk_CanvasDrawableCoords #define Tk_CanvasDrawableCoords \ (tkStubsPtr->tk_CanvasDrawableCoords) /* 7 */ -#endif -#ifndef Tk_CanvasEventuallyRedraw #define Tk_CanvasEventuallyRedraw \ (tkStubsPtr->tk_CanvasEventuallyRedraw) /* 8 */ -#endif -#ifndef Tk_CanvasGetCoord #define Tk_CanvasGetCoord \ (tkStubsPtr->tk_CanvasGetCoord) /* 9 */ -#endif -#ifndef Tk_CanvasGetTextInfo #define Tk_CanvasGetTextInfo \ (tkStubsPtr->tk_CanvasGetTextInfo) /* 10 */ -#endif -#ifndef Tk_CanvasPsBitmap #define Tk_CanvasPsBitmap \ (tkStubsPtr->tk_CanvasPsBitmap) /* 11 */ -#endif -#ifndef Tk_CanvasPsColor #define Tk_CanvasPsColor \ (tkStubsPtr->tk_CanvasPsColor) /* 12 */ -#endif -#ifndef Tk_CanvasPsFont #define Tk_CanvasPsFont \ (tkStubsPtr->tk_CanvasPsFont) /* 13 */ -#endif -#ifndef Tk_CanvasPsPath #define Tk_CanvasPsPath \ (tkStubsPtr->tk_CanvasPsPath) /* 14 */ -#endif -#ifndef Tk_CanvasPsStipple #define Tk_CanvasPsStipple \ (tkStubsPtr->tk_CanvasPsStipple) /* 15 */ -#endif -#ifndef Tk_CanvasPsY #define Tk_CanvasPsY \ (tkStubsPtr->tk_CanvasPsY) /* 16 */ -#endif -#ifndef Tk_CanvasSetStippleOrigin #define Tk_CanvasSetStippleOrigin \ (tkStubsPtr->tk_CanvasSetStippleOrigin) /* 17 */ -#endif -#ifndef Tk_CanvasTagsParseProc #define Tk_CanvasTagsParseProc \ (tkStubsPtr->tk_CanvasTagsParseProc) /* 18 */ -#endif -#ifndef Tk_CanvasTagsPrintProc #define Tk_CanvasTagsPrintProc \ (tkStubsPtr->tk_CanvasTagsPrintProc) /* 19 */ -#endif -#ifndef Tk_CanvasTkwin #define Tk_CanvasTkwin \ (tkStubsPtr->tk_CanvasTkwin) /* 20 */ -#endif -#ifndef Tk_CanvasWindowCoords #define Tk_CanvasWindowCoords \ (tkStubsPtr->tk_CanvasWindowCoords) /* 21 */ -#endif -#ifndef Tk_ChangeWindowAttributes #define Tk_ChangeWindowAttributes \ (tkStubsPtr->tk_ChangeWindowAttributes) /* 22 */ -#endif -#ifndef Tk_CharBbox #define Tk_CharBbox \ (tkStubsPtr->tk_CharBbox) /* 23 */ -#endif -#ifndef Tk_ClearSelection #define Tk_ClearSelection \ (tkStubsPtr->tk_ClearSelection) /* 24 */ -#endif -#ifndef Tk_ClipboardAppend #define Tk_ClipboardAppend \ (tkStubsPtr->tk_ClipboardAppend) /* 25 */ -#endif -#ifndef Tk_ClipboardClear #define Tk_ClipboardClear \ (tkStubsPtr->tk_ClipboardClear) /* 26 */ -#endif -#ifndef Tk_ConfigureInfo #define Tk_ConfigureInfo \ (tkStubsPtr->tk_ConfigureInfo) /* 27 */ -#endif -#ifndef Tk_ConfigureValue #define Tk_ConfigureValue \ (tkStubsPtr->tk_ConfigureValue) /* 28 */ -#endif -#ifndef Tk_ConfigureWidget #define Tk_ConfigureWidget \ (tkStubsPtr->tk_ConfigureWidget) /* 29 */ -#endif -#ifndef Tk_ConfigureWindow #define Tk_ConfigureWindow \ (tkStubsPtr->tk_ConfigureWindow) /* 30 */ -#endif -#ifndef Tk_ComputeTextLayout #define Tk_ComputeTextLayout \ (tkStubsPtr->tk_ComputeTextLayout) /* 31 */ -#endif -#ifndef Tk_CoordsToWindow #define Tk_CoordsToWindow \ (tkStubsPtr->tk_CoordsToWindow) /* 32 */ -#endif -#ifndef Tk_CreateBinding #define Tk_CreateBinding \ (tkStubsPtr->tk_CreateBinding) /* 33 */ -#endif -#ifndef Tk_CreateBindingTable #define Tk_CreateBindingTable \ (tkStubsPtr->tk_CreateBindingTable) /* 34 */ -#endif -#ifndef Tk_CreateErrorHandler #define Tk_CreateErrorHandler \ (tkStubsPtr->tk_CreateErrorHandler) /* 35 */ -#endif -#ifndef Tk_CreateEventHandler #define Tk_CreateEventHandler \ (tkStubsPtr->tk_CreateEventHandler) /* 36 */ -#endif -#ifndef Tk_CreateGenericHandler #define Tk_CreateGenericHandler \ (tkStubsPtr->tk_CreateGenericHandler) /* 37 */ -#endif -#ifndef Tk_CreateImageType #define Tk_CreateImageType \ (tkStubsPtr->tk_CreateImageType) /* 38 */ -#endif -#ifndef Tk_CreateItemType #define Tk_CreateItemType \ (tkStubsPtr->tk_CreateItemType) /* 39 */ -#endif -#ifndef Tk_CreatePhotoImageFormat #define Tk_CreatePhotoImageFormat \ (tkStubsPtr->tk_CreatePhotoImageFormat) /* 40 */ -#endif -#ifndef Tk_CreateSelHandler #define Tk_CreateSelHandler \ (tkStubsPtr->tk_CreateSelHandler) /* 41 */ -#endif -#ifndef Tk_CreateWindow #define Tk_CreateWindow \ (tkStubsPtr->tk_CreateWindow) /* 42 */ -#endif -#ifndef Tk_CreateWindowFromPath #define Tk_CreateWindowFromPath \ (tkStubsPtr->tk_CreateWindowFromPath) /* 43 */ -#endif -#ifndef Tk_DefineBitmap #define Tk_DefineBitmap \ (tkStubsPtr->tk_DefineBitmap) /* 44 */ -#endif -#ifndef Tk_DefineCursor #define Tk_DefineCursor \ (tkStubsPtr->tk_DefineCursor) /* 45 */ -#endif -#ifndef Tk_DeleteAllBindings #define Tk_DeleteAllBindings \ (tkStubsPtr->tk_DeleteAllBindings) /* 46 */ -#endif -#ifndef Tk_DeleteBinding #define Tk_DeleteBinding \ (tkStubsPtr->tk_DeleteBinding) /* 47 */ -#endif -#ifndef Tk_DeleteBindingTable #define Tk_DeleteBindingTable \ (tkStubsPtr->tk_DeleteBindingTable) /* 48 */ -#endif -#ifndef Tk_DeleteErrorHandler #define Tk_DeleteErrorHandler \ (tkStubsPtr->tk_DeleteErrorHandler) /* 49 */ -#endif -#ifndef Tk_DeleteEventHandler #define Tk_DeleteEventHandler \ (tkStubsPtr->tk_DeleteEventHandler) /* 50 */ -#endif -#ifndef Tk_DeleteGenericHandler #define Tk_DeleteGenericHandler \ (tkStubsPtr->tk_DeleteGenericHandler) /* 51 */ -#endif -#ifndef Tk_DeleteImage #define Tk_DeleteImage \ (tkStubsPtr->tk_DeleteImage) /* 52 */ -#endif -#ifndef Tk_DeleteSelHandler #define Tk_DeleteSelHandler \ (tkStubsPtr->tk_DeleteSelHandler) /* 53 */ -#endif -#ifndef Tk_DestroyWindow #define Tk_DestroyWindow \ (tkStubsPtr->tk_DestroyWindow) /* 54 */ -#endif -#ifndef Tk_DisplayName #define Tk_DisplayName \ (tkStubsPtr->tk_DisplayName) /* 55 */ -#endif -#ifndef Tk_DistanceToTextLayout #define Tk_DistanceToTextLayout \ (tkStubsPtr->tk_DistanceToTextLayout) /* 56 */ -#endif -#ifndef Tk_Draw3DPolygon #define Tk_Draw3DPolygon \ (tkStubsPtr->tk_Draw3DPolygon) /* 57 */ -#endif -#ifndef Tk_Draw3DRectangle #define Tk_Draw3DRectangle \ (tkStubsPtr->tk_Draw3DRectangle) /* 58 */ -#endif -#ifndef Tk_DrawChars #define Tk_DrawChars \ (tkStubsPtr->tk_DrawChars) /* 59 */ -#endif -#ifndef Tk_DrawFocusHighlight #define Tk_DrawFocusHighlight \ (tkStubsPtr->tk_DrawFocusHighlight) /* 60 */ -#endif -#ifndef Tk_DrawTextLayout #define Tk_DrawTextLayout \ (tkStubsPtr->tk_DrawTextLayout) /* 61 */ -#endif -#ifndef Tk_Fill3DPolygon #define Tk_Fill3DPolygon \ (tkStubsPtr->tk_Fill3DPolygon) /* 62 */ -#endif -#ifndef Tk_Fill3DRectangle #define Tk_Fill3DRectangle \ (tkStubsPtr->tk_Fill3DRectangle) /* 63 */ -#endif -#ifndef Tk_FindPhoto #define Tk_FindPhoto \ (tkStubsPtr->tk_FindPhoto) /* 64 */ -#endif -#ifndef Tk_FontId #define Tk_FontId \ (tkStubsPtr->tk_FontId) /* 65 */ -#endif -#ifndef Tk_Free3DBorder #define Tk_Free3DBorder \ (tkStubsPtr->tk_Free3DBorder) /* 66 */ -#endif -#ifndef Tk_FreeBitmap #define Tk_FreeBitmap \ (tkStubsPtr->tk_FreeBitmap) /* 67 */ -#endif -#ifndef Tk_FreeColor #define Tk_FreeColor \ (tkStubsPtr->tk_FreeColor) /* 68 */ -#endif -#ifndef Tk_FreeColormap #define Tk_FreeColormap \ (tkStubsPtr->tk_FreeColormap) /* 69 */ -#endif -#ifndef Tk_FreeCursor #define Tk_FreeCursor \ (tkStubsPtr->tk_FreeCursor) /* 70 */ -#endif -#ifndef Tk_FreeFont #define Tk_FreeFont \ (tkStubsPtr->tk_FreeFont) /* 71 */ -#endif -#ifndef Tk_FreeGC #define Tk_FreeGC \ (tkStubsPtr->tk_FreeGC) /* 72 */ -#endif -#ifndef Tk_FreeImage #define Tk_FreeImage \ (tkStubsPtr->tk_FreeImage) /* 73 */ -#endif -#ifndef Tk_FreeOptions #define Tk_FreeOptions \ (tkStubsPtr->tk_FreeOptions) /* 74 */ -#endif -#ifndef Tk_FreePixmap #define Tk_FreePixmap \ (tkStubsPtr->tk_FreePixmap) /* 75 */ -#endif -#ifndef Tk_FreeTextLayout #define Tk_FreeTextLayout \ (tkStubsPtr->tk_FreeTextLayout) /* 76 */ -#endif -#ifndef Tk_FreeXId #define Tk_FreeXId \ (tkStubsPtr->tk_FreeXId) /* 77 */ -#endif -#ifndef Tk_GCForColor #define Tk_GCForColor \ (tkStubsPtr->tk_GCForColor) /* 78 */ -#endif -#ifndef Tk_GeometryRequest #define Tk_GeometryRequest \ (tkStubsPtr->tk_GeometryRequest) /* 79 */ -#endif -#ifndef Tk_Get3DBorder #define Tk_Get3DBorder \ (tkStubsPtr->tk_Get3DBorder) /* 80 */ -#endif -#ifndef Tk_GetAllBindings #define Tk_GetAllBindings \ (tkStubsPtr->tk_GetAllBindings) /* 81 */ -#endif -#ifndef Tk_GetAnchor #define Tk_GetAnchor \ (tkStubsPtr->tk_GetAnchor) /* 82 */ -#endif -#ifndef Tk_GetAtomName #define Tk_GetAtomName \ (tkStubsPtr->tk_GetAtomName) /* 83 */ -#endif -#ifndef Tk_GetBinding #define Tk_GetBinding \ (tkStubsPtr->tk_GetBinding) /* 84 */ -#endif -#ifndef Tk_GetBitmap #define Tk_GetBitmap \ (tkStubsPtr->tk_GetBitmap) /* 85 */ -#endif -#ifndef Tk_GetBitmapFromData #define Tk_GetBitmapFromData \ (tkStubsPtr->tk_GetBitmapFromData) /* 86 */ -#endif -#ifndef Tk_GetCapStyle #define Tk_GetCapStyle \ (tkStubsPtr->tk_GetCapStyle) /* 87 */ -#endif -#ifndef Tk_GetColor #define Tk_GetColor \ (tkStubsPtr->tk_GetColor) /* 88 */ -#endif -#ifndef Tk_GetColorByValue #define Tk_GetColorByValue \ (tkStubsPtr->tk_GetColorByValue) /* 89 */ -#endif -#ifndef Tk_GetColormap #define Tk_GetColormap \ (tkStubsPtr->tk_GetColormap) /* 90 */ -#endif -#ifndef Tk_GetCursor #define Tk_GetCursor \ (tkStubsPtr->tk_GetCursor) /* 91 */ -#endif -#ifndef Tk_GetCursorFromData #define Tk_GetCursorFromData \ (tkStubsPtr->tk_GetCursorFromData) /* 92 */ -#endif -#ifndef Tk_GetFont #define Tk_GetFont \ (tkStubsPtr->tk_GetFont) /* 93 */ -#endif -#ifndef Tk_GetFontFromObj #define Tk_GetFontFromObj \ (tkStubsPtr->tk_GetFontFromObj) /* 94 */ -#endif -#ifndef Tk_GetFontMetrics #define Tk_GetFontMetrics \ (tkStubsPtr->tk_GetFontMetrics) /* 95 */ -#endif -#ifndef Tk_GetGC #define Tk_GetGC \ (tkStubsPtr->tk_GetGC) /* 96 */ -#endif -#ifndef Tk_GetImage #define Tk_GetImage \ (tkStubsPtr->tk_GetImage) /* 97 */ -#endif -#ifndef Tk_GetImageMasterData #define Tk_GetImageMasterData \ (tkStubsPtr->tk_GetImageMasterData) /* 98 */ -#endif -#ifndef Tk_GetItemTypes #define Tk_GetItemTypes \ (tkStubsPtr->tk_GetItemTypes) /* 99 */ -#endif -#ifndef Tk_GetJoinStyle #define Tk_GetJoinStyle \ (tkStubsPtr->tk_GetJoinStyle) /* 100 */ -#endif -#ifndef Tk_GetJustify #define Tk_GetJustify \ (tkStubsPtr->tk_GetJustify) /* 101 */ -#endif -#ifndef Tk_GetNumMainWindows #define Tk_GetNumMainWindows \ (tkStubsPtr->tk_GetNumMainWindows) /* 102 */ -#endif -#ifndef Tk_GetOption #define Tk_GetOption \ (tkStubsPtr->tk_GetOption) /* 103 */ -#endif -#ifndef Tk_GetPixels #define Tk_GetPixels \ (tkStubsPtr->tk_GetPixels) /* 104 */ -#endif -#ifndef Tk_GetPixmap #define Tk_GetPixmap \ (tkStubsPtr->tk_GetPixmap) /* 105 */ -#endif -#ifndef Tk_GetRelief #define Tk_GetRelief \ (tkStubsPtr->tk_GetRelief) /* 106 */ -#endif -#ifndef Tk_GetRootCoords #define Tk_GetRootCoords \ (tkStubsPtr->tk_GetRootCoords) /* 107 */ -#endif -#ifndef Tk_GetScrollInfo #define Tk_GetScrollInfo \ (tkStubsPtr->tk_GetScrollInfo) /* 108 */ -#endif -#ifndef Tk_GetScreenMM #define Tk_GetScreenMM \ (tkStubsPtr->tk_GetScreenMM) /* 109 */ -#endif -#ifndef Tk_GetSelection #define Tk_GetSelection \ (tkStubsPtr->tk_GetSelection) /* 110 */ -#endif -#ifndef Tk_GetUid #define Tk_GetUid \ (tkStubsPtr->tk_GetUid) /* 111 */ -#endif -#ifndef Tk_GetVisual #define Tk_GetVisual \ (tkStubsPtr->tk_GetVisual) /* 112 */ -#endif -#ifndef Tk_GetVRootGeometry #define Tk_GetVRootGeometry \ (tkStubsPtr->tk_GetVRootGeometry) /* 113 */ -#endif -#ifndef Tk_Grab #define Tk_Grab \ (tkStubsPtr->tk_Grab) /* 114 */ -#endif -#ifndef Tk_HandleEvent #define Tk_HandleEvent \ (tkStubsPtr->tk_HandleEvent) /* 115 */ -#endif -#ifndef Tk_IdToWindow #define Tk_IdToWindow \ (tkStubsPtr->tk_IdToWindow) /* 116 */ -#endif -#ifndef Tk_ImageChanged #define Tk_ImageChanged \ (tkStubsPtr->tk_ImageChanged) /* 117 */ -#endif -#ifndef Tk_Init #define Tk_Init \ (tkStubsPtr->tk_Init) /* 118 */ -#endif -#ifndef Tk_InternAtom #define Tk_InternAtom \ (tkStubsPtr->tk_InternAtom) /* 119 */ -#endif -#ifndef Tk_IntersectTextLayout #define Tk_IntersectTextLayout \ (tkStubsPtr->tk_IntersectTextLayout) /* 120 */ -#endif -#ifndef Tk_MaintainGeometry #define Tk_MaintainGeometry \ (tkStubsPtr->tk_MaintainGeometry) /* 121 */ -#endif -#ifndef Tk_MainWindow #define Tk_MainWindow \ (tkStubsPtr->tk_MainWindow) /* 122 */ -#endif -#ifndef Tk_MakeWindowExist #define Tk_MakeWindowExist \ (tkStubsPtr->tk_MakeWindowExist) /* 123 */ -#endif -#ifndef Tk_ManageGeometry #define Tk_ManageGeometry \ (tkStubsPtr->tk_ManageGeometry) /* 124 */ -#endif -#ifndef Tk_MapWindow #define Tk_MapWindow \ (tkStubsPtr->tk_MapWindow) /* 125 */ -#endif -#ifndef Tk_MeasureChars #define Tk_MeasureChars \ (tkStubsPtr->tk_MeasureChars) /* 126 */ -#endif -#ifndef Tk_MoveResizeWindow #define Tk_MoveResizeWindow \ (tkStubsPtr->tk_MoveResizeWindow) /* 127 */ -#endif -#ifndef Tk_MoveWindow #define Tk_MoveWindow \ (tkStubsPtr->tk_MoveWindow) /* 128 */ -#endif -#ifndef Tk_MoveToplevelWindow #define Tk_MoveToplevelWindow \ (tkStubsPtr->tk_MoveToplevelWindow) /* 129 */ -#endif -#ifndef Tk_NameOf3DBorder #define Tk_NameOf3DBorder \ (tkStubsPtr->tk_NameOf3DBorder) /* 130 */ -#endif -#ifndef Tk_NameOfAnchor #define Tk_NameOfAnchor \ (tkStubsPtr->tk_NameOfAnchor) /* 131 */ -#endif -#ifndef Tk_NameOfBitmap #define Tk_NameOfBitmap \ (tkStubsPtr->tk_NameOfBitmap) /* 132 */ -#endif -#ifndef Tk_NameOfCapStyle #define Tk_NameOfCapStyle \ (tkStubsPtr->tk_NameOfCapStyle) /* 133 */ -#endif -#ifndef Tk_NameOfColor #define Tk_NameOfColor \ (tkStubsPtr->tk_NameOfColor) /* 134 */ -#endif -#ifndef Tk_NameOfCursor #define Tk_NameOfCursor \ (tkStubsPtr->tk_NameOfCursor) /* 135 */ -#endif -#ifndef Tk_NameOfFont #define Tk_NameOfFont \ (tkStubsPtr->tk_NameOfFont) /* 136 */ -#endif -#ifndef Tk_NameOfImage #define Tk_NameOfImage \ (tkStubsPtr->tk_NameOfImage) /* 137 */ -#endif -#ifndef Tk_NameOfJoinStyle #define Tk_NameOfJoinStyle \ (tkStubsPtr->tk_NameOfJoinStyle) /* 138 */ -#endif -#ifndef Tk_NameOfJustify #define Tk_NameOfJustify \ (tkStubsPtr->tk_NameOfJustify) /* 139 */ -#endif -#ifndef Tk_NameOfRelief #define Tk_NameOfRelief \ (tkStubsPtr->tk_NameOfRelief) /* 140 */ -#endif -#ifndef Tk_NameToWindow #define Tk_NameToWindow \ (tkStubsPtr->tk_NameToWindow) /* 141 */ -#endif -#ifndef Tk_OwnSelection #define Tk_OwnSelection \ (tkStubsPtr->tk_OwnSelection) /* 142 */ -#endif -#ifndef Tk_ParseArgv #define Tk_ParseArgv \ (tkStubsPtr->tk_ParseArgv) /* 143 */ -#endif -#ifndef Tk_PhotoPutBlock_NoComposite #define Tk_PhotoPutBlock_NoComposite \ (tkStubsPtr->tk_PhotoPutBlock_NoComposite) /* 144 */ -#endif -#ifndef Tk_PhotoPutZoomedBlock_NoComposite #define Tk_PhotoPutZoomedBlock_NoComposite \ (tkStubsPtr->tk_PhotoPutZoomedBlock_NoComposite) /* 145 */ -#endif -#ifndef Tk_PhotoGetImage #define Tk_PhotoGetImage \ (tkStubsPtr->tk_PhotoGetImage) /* 146 */ -#endif -#ifndef Tk_PhotoBlank #define Tk_PhotoBlank \ (tkStubsPtr->tk_PhotoBlank) /* 147 */ -#endif -#ifndef Tk_PhotoExpand_Panic #define Tk_PhotoExpand_Panic \ (tkStubsPtr->tk_PhotoExpand_Panic) /* 148 */ -#endif -#ifndef Tk_PhotoGetSize #define Tk_PhotoGetSize \ (tkStubsPtr->tk_PhotoGetSize) /* 149 */ -#endif -#ifndef Tk_PhotoSetSize_Panic #define Tk_PhotoSetSize_Panic \ (tkStubsPtr->tk_PhotoSetSize_Panic) /* 150 */ -#endif -#ifndef Tk_PointToChar #define Tk_PointToChar \ (tkStubsPtr->tk_PointToChar) /* 151 */ -#endif -#ifndef Tk_PostscriptFontName #define Tk_PostscriptFontName \ (tkStubsPtr->tk_PostscriptFontName) /* 152 */ -#endif -#ifndef Tk_PreserveColormap #define Tk_PreserveColormap \ (tkStubsPtr->tk_PreserveColormap) /* 153 */ -#endif -#ifndef Tk_QueueWindowEvent #define Tk_QueueWindowEvent \ (tkStubsPtr->tk_QueueWindowEvent) /* 154 */ -#endif -#ifndef Tk_RedrawImage #define Tk_RedrawImage \ (tkStubsPtr->tk_RedrawImage) /* 155 */ -#endif -#ifndef Tk_ResizeWindow #define Tk_ResizeWindow \ (tkStubsPtr->tk_ResizeWindow) /* 156 */ -#endif -#ifndef Tk_RestackWindow #define Tk_RestackWindow \ (tkStubsPtr->tk_RestackWindow) /* 157 */ -#endif -#ifndef Tk_RestrictEvents #define Tk_RestrictEvents \ (tkStubsPtr->tk_RestrictEvents) /* 158 */ -#endif -#ifndef Tk_SafeInit #define Tk_SafeInit \ (tkStubsPtr->tk_SafeInit) /* 159 */ -#endif -#ifndef Tk_SetAppName #define Tk_SetAppName \ (tkStubsPtr->tk_SetAppName) /* 160 */ -#endif -#ifndef Tk_SetBackgroundFromBorder #define Tk_SetBackgroundFromBorder \ (tkStubsPtr->tk_SetBackgroundFromBorder) /* 161 */ -#endif -#ifndef Tk_SetClass #define Tk_SetClass \ (tkStubsPtr->tk_SetClass) /* 162 */ -#endif -#ifndef Tk_SetGrid #define Tk_SetGrid \ (tkStubsPtr->tk_SetGrid) /* 163 */ -#endif -#ifndef Tk_SetInternalBorder #define Tk_SetInternalBorder \ (tkStubsPtr->tk_SetInternalBorder) /* 164 */ -#endif -#ifndef Tk_SetWindowBackground #define Tk_SetWindowBackground \ (tkStubsPtr->tk_SetWindowBackground) /* 165 */ -#endif -#ifndef Tk_SetWindowBackgroundPixmap #define Tk_SetWindowBackgroundPixmap \ (tkStubsPtr->tk_SetWindowBackgroundPixmap) /* 166 */ -#endif -#ifndef Tk_SetWindowBorder #define Tk_SetWindowBorder \ (tkStubsPtr->tk_SetWindowBorder) /* 167 */ -#endif -#ifndef Tk_SetWindowBorderWidth #define Tk_SetWindowBorderWidth \ (tkStubsPtr->tk_SetWindowBorderWidth) /* 168 */ -#endif -#ifndef Tk_SetWindowBorderPixmap #define Tk_SetWindowBorderPixmap \ (tkStubsPtr->tk_SetWindowBorderPixmap) /* 169 */ -#endif -#ifndef Tk_SetWindowColormap #define Tk_SetWindowColormap \ (tkStubsPtr->tk_SetWindowColormap) /* 170 */ -#endif -#ifndef Tk_SetWindowVisual #define Tk_SetWindowVisual \ (tkStubsPtr->tk_SetWindowVisual) /* 171 */ -#endif -#ifndef Tk_SizeOfBitmap #define Tk_SizeOfBitmap \ (tkStubsPtr->tk_SizeOfBitmap) /* 172 */ -#endif -#ifndef Tk_SizeOfImage #define Tk_SizeOfImage \ (tkStubsPtr->tk_SizeOfImage) /* 173 */ -#endif -#ifndef Tk_StrictMotif #define Tk_StrictMotif \ (tkStubsPtr->tk_StrictMotif) /* 174 */ -#endif -#ifndef Tk_TextLayoutToPostscript #define Tk_TextLayoutToPostscript \ (tkStubsPtr->tk_TextLayoutToPostscript) /* 175 */ -#endif -#ifndef Tk_TextWidth #define Tk_TextWidth \ (tkStubsPtr->tk_TextWidth) /* 176 */ -#endif -#ifndef Tk_UndefineCursor #define Tk_UndefineCursor \ (tkStubsPtr->tk_UndefineCursor) /* 177 */ -#endif -#ifndef Tk_UnderlineChars #define Tk_UnderlineChars \ (tkStubsPtr->tk_UnderlineChars) /* 178 */ -#endif -#ifndef Tk_UnderlineTextLayout #define Tk_UnderlineTextLayout \ (tkStubsPtr->tk_UnderlineTextLayout) /* 179 */ -#endif -#ifndef Tk_Ungrab #define Tk_Ungrab \ (tkStubsPtr->tk_Ungrab) /* 180 */ -#endif -#ifndef Tk_UnmaintainGeometry #define Tk_UnmaintainGeometry \ (tkStubsPtr->tk_UnmaintainGeometry) /* 181 */ -#endif -#ifndef Tk_UnmapWindow #define Tk_UnmapWindow \ (tkStubsPtr->tk_UnmapWindow) /* 182 */ -#endif -#ifndef Tk_UnsetGrid #define Tk_UnsetGrid \ (tkStubsPtr->tk_UnsetGrid) /* 183 */ -#endif -#ifndef Tk_UpdatePointer #define Tk_UpdatePointer \ (tkStubsPtr->tk_UpdatePointer) /* 184 */ -#endif -#ifndef Tk_AllocBitmapFromObj #define Tk_AllocBitmapFromObj \ (tkStubsPtr->tk_AllocBitmapFromObj) /* 185 */ -#endif -#ifndef Tk_Alloc3DBorderFromObj #define Tk_Alloc3DBorderFromObj \ (tkStubsPtr->tk_Alloc3DBorderFromObj) /* 186 */ -#endif -#ifndef Tk_AllocColorFromObj #define Tk_AllocColorFromObj \ (tkStubsPtr->tk_AllocColorFromObj) /* 187 */ -#endif -#ifndef Tk_AllocCursorFromObj #define Tk_AllocCursorFromObj \ (tkStubsPtr->tk_AllocCursorFromObj) /* 188 */ -#endif -#ifndef Tk_AllocFontFromObj #define Tk_AllocFontFromObj \ (tkStubsPtr->tk_AllocFontFromObj) /* 189 */ -#endif -#ifndef Tk_CreateOptionTable #define Tk_CreateOptionTable \ (tkStubsPtr->tk_CreateOptionTable) /* 190 */ -#endif -#ifndef Tk_DeleteOptionTable #define Tk_DeleteOptionTable \ (tkStubsPtr->tk_DeleteOptionTable) /* 191 */ -#endif -#ifndef Tk_Free3DBorderFromObj #define Tk_Free3DBorderFromObj \ (tkStubsPtr->tk_Free3DBorderFromObj) /* 192 */ -#endif -#ifndef Tk_FreeBitmapFromObj #define Tk_FreeBitmapFromObj \ (tkStubsPtr->tk_FreeBitmapFromObj) /* 193 */ -#endif -#ifndef Tk_FreeColorFromObj #define Tk_FreeColorFromObj \ (tkStubsPtr->tk_FreeColorFromObj) /* 194 */ -#endif -#ifndef Tk_FreeConfigOptions #define Tk_FreeConfigOptions \ (tkStubsPtr->tk_FreeConfigOptions) /* 195 */ -#endif -#ifndef Tk_FreeSavedOptions #define Tk_FreeSavedOptions \ (tkStubsPtr->tk_FreeSavedOptions) /* 196 */ -#endif -#ifndef Tk_FreeCursorFromObj #define Tk_FreeCursorFromObj \ (tkStubsPtr->tk_FreeCursorFromObj) /* 197 */ -#endif -#ifndef Tk_FreeFontFromObj #define Tk_FreeFontFromObj \ (tkStubsPtr->tk_FreeFontFromObj) /* 198 */ -#endif -#ifndef Tk_Get3DBorderFromObj #define Tk_Get3DBorderFromObj \ (tkStubsPtr->tk_Get3DBorderFromObj) /* 199 */ -#endif -#ifndef Tk_GetAnchorFromObj #define Tk_GetAnchorFromObj \ (tkStubsPtr->tk_GetAnchorFromObj) /* 200 */ -#endif -#ifndef Tk_GetBitmapFromObj #define Tk_GetBitmapFromObj \ (tkStubsPtr->tk_GetBitmapFromObj) /* 201 */ -#endif -#ifndef Tk_GetColorFromObj #define Tk_GetColorFromObj \ (tkStubsPtr->tk_GetColorFromObj) /* 202 */ -#endif -#ifndef Tk_GetCursorFromObj #define Tk_GetCursorFromObj \ (tkStubsPtr->tk_GetCursorFromObj) /* 203 */ -#endif -#ifndef Tk_GetOptionInfo #define Tk_GetOptionInfo \ (tkStubsPtr->tk_GetOptionInfo) /* 204 */ -#endif -#ifndef Tk_GetOptionValue #define Tk_GetOptionValue \ (tkStubsPtr->tk_GetOptionValue) /* 205 */ -#endif -#ifndef Tk_GetJustifyFromObj #define Tk_GetJustifyFromObj \ (tkStubsPtr->tk_GetJustifyFromObj) /* 206 */ -#endif -#ifndef Tk_GetMMFromObj #define Tk_GetMMFromObj \ (tkStubsPtr->tk_GetMMFromObj) /* 207 */ -#endif -#ifndef Tk_GetPixelsFromObj #define Tk_GetPixelsFromObj \ (tkStubsPtr->tk_GetPixelsFromObj) /* 208 */ -#endif -#ifndef Tk_GetReliefFromObj #define Tk_GetReliefFromObj \ (tkStubsPtr->tk_GetReliefFromObj) /* 209 */ -#endif -#ifndef Tk_GetScrollInfoObj #define Tk_GetScrollInfoObj \ (tkStubsPtr->tk_GetScrollInfoObj) /* 210 */ -#endif -#ifndef Tk_InitOptions #define Tk_InitOptions \ (tkStubsPtr->tk_InitOptions) /* 211 */ -#endif -#ifndef Tk_MainEx #define Tk_MainEx \ (tkStubsPtr->tk_MainEx) /* 212 */ -#endif -#ifndef Tk_RestoreSavedOptions #define Tk_RestoreSavedOptions \ (tkStubsPtr->tk_RestoreSavedOptions) /* 213 */ -#endif -#ifndef Tk_SetOptions #define Tk_SetOptions \ (tkStubsPtr->tk_SetOptions) /* 214 */ -#endif -#ifndef Tk_InitConsoleChannels #define Tk_InitConsoleChannels \ (tkStubsPtr->tk_InitConsoleChannels) /* 215 */ -#endif -#ifndef Tk_CreateConsoleWindow #define Tk_CreateConsoleWindow \ (tkStubsPtr->tk_CreateConsoleWindow) /* 216 */ -#endif -#ifndef Tk_CreateSmoothMethod #define Tk_CreateSmoothMethod \ (tkStubsPtr->tk_CreateSmoothMethod) /* 217 */ -#endif /* Slot 218 is reserved */ /* Slot 219 is reserved */ -#ifndef Tk_GetDash #define Tk_GetDash \ (tkStubsPtr->tk_GetDash) /* 220 */ -#endif -#ifndef Tk_CreateOutline #define Tk_CreateOutline \ (tkStubsPtr->tk_CreateOutline) /* 221 */ -#endif -#ifndef Tk_DeleteOutline #define Tk_DeleteOutline \ (tkStubsPtr->tk_DeleteOutline) /* 222 */ -#endif -#ifndef Tk_ConfigOutlineGC #define Tk_ConfigOutlineGC \ (tkStubsPtr->tk_ConfigOutlineGC) /* 223 */ -#endif -#ifndef Tk_ChangeOutlineGC #define Tk_ChangeOutlineGC \ (tkStubsPtr->tk_ChangeOutlineGC) /* 224 */ -#endif -#ifndef Tk_ResetOutlineGC #define Tk_ResetOutlineGC \ (tkStubsPtr->tk_ResetOutlineGC) /* 225 */ -#endif -#ifndef Tk_CanvasPsOutline #define Tk_CanvasPsOutline \ (tkStubsPtr->tk_CanvasPsOutline) /* 226 */ -#endif -#ifndef Tk_SetTSOrigin #define Tk_SetTSOrigin \ (tkStubsPtr->tk_SetTSOrigin) /* 227 */ -#endif -#ifndef Tk_CanvasGetCoordFromObj #define Tk_CanvasGetCoordFromObj \ (tkStubsPtr->tk_CanvasGetCoordFromObj) /* 228 */ -#endif -#ifndef Tk_CanvasSetOffset #define Tk_CanvasSetOffset \ (tkStubsPtr->tk_CanvasSetOffset) /* 229 */ -#endif -#ifndef Tk_DitherPhoto #define Tk_DitherPhoto \ (tkStubsPtr->tk_DitherPhoto) /* 230 */ -#endif -#ifndef Tk_PostscriptBitmap #define Tk_PostscriptBitmap \ (tkStubsPtr->tk_PostscriptBitmap) /* 231 */ -#endif -#ifndef Tk_PostscriptColor #define Tk_PostscriptColor \ (tkStubsPtr->tk_PostscriptColor) /* 232 */ -#endif -#ifndef Tk_PostscriptFont #define Tk_PostscriptFont \ (tkStubsPtr->tk_PostscriptFont) /* 233 */ -#endif -#ifndef Tk_PostscriptImage #define Tk_PostscriptImage \ (tkStubsPtr->tk_PostscriptImage) /* 234 */ -#endif -#ifndef Tk_PostscriptPath #define Tk_PostscriptPath \ (tkStubsPtr->tk_PostscriptPath) /* 235 */ -#endif -#ifndef Tk_PostscriptStipple #define Tk_PostscriptStipple \ (tkStubsPtr->tk_PostscriptStipple) /* 236 */ -#endif -#ifndef Tk_PostscriptY #define Tk_PostscriptY \ (tkStubsPtr->tk_PostscriptY) /* 237 */ -#endif -#ifndef Tk_PostscriptPhoto #define Tk_PostscriptPhoto \ (tkStubsPtr->tk_PostscriptPhoto) /* 238 */ -#endif -#ifndef Tk_CreateClientMessageHandler #define Tk_CreateClientMessageHandler \ (tkStubsPtr->tk_CreateClientMessageHandler) /* 239 */ -#endif -#ifndef Tk_DeleteClientMessageHandler #define Tk_DeleteClientMessageHandler \ (tkStubsPtr->tk_DeleteClientMessageHandler) /* 240 */ -#endif -#ifndef Tk_CreateAnonymousWindow #define Tk_CreateAnonymousWindow \ (tkStubsPtr->tk_CreateAnonymousWindow) /* 241 */ -#endif -#ifndef Tk_SetClassProcs #define Tk_SetClassProcs \ (tkStubsPtr->tk_SetClassProcs) /* 242 */ -#endif -#ifndef Tk_SetInternalBorderEx #define Tk_SetInternalBorderEx \ (tkStubsPtr->tk_SetInternalBorderEx) /* 243 */ -#endif -#ifndef Tk_SetMinimumRequestSize #define Tk_SetMinimumRequestSize \ (tkStubsPtr->tk_SetMinimumRequestSize) /* 244 */ -#endif -#ifndef Tk_SetCaretPos #define Tk_SetCaretPos \ (tkStubsPtr->tk_SetCaretPos) /* 245 */ -#endif -#ifndef Tk_PhotoPutBlock_Panic #define Tk_PhotoPutBlock_Panic \ (tkStubsPtr->tk_PhotoPutBlock_Panic) /* 246 */ -#endif -#ifndef Tk_PhotoPutZoomedBlock_Panic #define Tk_PhotoPutZoomedBlock_Panic \ (tkStubsPtr->tk_PhotoPutZoomedBlock_Panic) /* 247 */ -#endif -#ifndef Tk_CollapseMotionEvents #define Tk_CollapseMotionEvents \ (tkStubsPtr->tk_CollapseMotionEvents) /* 248 */ -#endif -#ifndef Tk_RegisterStyleEngine #define Tk_RegisterStyleEngine \ (tkStubsPtr->tk_RegisterStyleEngine) /* 249 */ -#endif -#ifndef Tk_GetStyleEngine #define Tk_GetStyleEngine \ (tkStubsPtr->tk_GetStyleEngine) /* 250 */ -#endif -#ifndef Tk_RegisterStyledElement #define Tk_RegisterStyledElement \ (tkStubsPtr->tk_RegisterStyledElement) /* 251 */ -#endif -#ifndef Tk_GetElementId #define Tk_GetElementId \ (tkStubsPtr->tk_GetElementId) /* 252 */ -#endif -#ifndef Tk_CreateStyle #define Tk_CreateStyle \ (tkStubsPtr->tk_CreateStyle) /* 253 */ -#endif -#ifndef Tk_GetStyle #define Tk_GetStyle \ (tkStubsPtr->tk_GetStyle) /* 254 */ -#endif -#ifndef Tk_FreeStyle #define Tk_FreeStyle \ (tkStubsPtr->tk_FreeStyle) /* 255 */ -#endif -#ifndef Tk_NameOfStyle #define Tk_NameOfStyle \ (tkStubsPtr->tk_NameOfStyle) /* 256 */ -#endif -#ifndef Tk_AllocStyleFromObj #define Tk_AllocStyleFromObj \ (tkStubsPtr->tk_AllocStyleFromObj) /* 257 */ -#endif -#ifndef Tk_GetStyleFromObj #define Tk_GetStyleFromObj \ (tkStubsPtr->tk_GetStyleFromObj) /* 258 */ -#endif -#ifndef Tk_FreeStyleFromObj #define Tk_FreeStyleFromObj \ (tkStubsPtr->tk_FreeStyleFromObj) /* 259 */ -#endif -#ifndef Tk_GetStyledElement #define Tk_GetStyledElement \ (tkStubsPtr->tk_GetStyledElement) /* 260 */ -#endif -#ifndef Tk_GetElementSize #define Tk_GetElementSize \ (tkStubsPtr->tk_GetElementSize) /* 261 */ -#endif -#ifndef Tk_GetElementBox #define Tk_GetElementBox \ (tkStubsPtr->tk_GetElementBox) /* 262 */ -#endif -#ifndef Tk_GetElementBorderWidth #define Tk_GetElementBorderWidth \ (tkStubsPtr->tk_GetElementBorderWidth) /* 263 */ -#endif -#ifndef Tk_DrawElement #define Tk_DrawElement \ (tkStubsPtr->tk_DrawElement) /* 264 */ -#endif -#ifndef Tk_PhotoExpand #define Tk_PhotoExpand \ (tkStubsPtr->tk_PhotoExpand) /* 265 */ -#endif -#ifndef Tk_PhotoPutBlock #define Tk_PhotoPutBlock \ (tkStubsPtr->tk_PhotoPutBlock) /* 266 */ -#endif -#ifndef Tk_PhotoPutZoomedBlock #define Tk_PhotoPutZoomedBlock \ (tkStubsPtr->tk_PhotoPutZoomedBlock) /* 267 */ -#endif -#ifndef Tk_PhotoSetSize #define Tk_PhotoSetSize \ (tkStubsPtr->tk_PhotoSetSize) /* 268 */ -#endif -#ifndef Tk_GetUserInactiveTime #define Tk_GetUserInactiveTime \ (tkStubsPtr->tk_GetUserInactiveTime) /* 269 */ -#endif -#ifndef Tk_ResetUserInactiveTime #define Tk_ResetUserInactiveTime \ (tkStubsPtr->tk_ResetUserInactiveTime) /* 270 */ -#endif -#ifndef Tk_Interp #define Tk_Interp \ (tkStubsPtr->tk_Interp) /* 271 */ -#endif -#ifndef Tk_CreateOldImageType #define Tk_CreateOldImageType \ (tkStubsPtr->tk_CreateOldImageType) /* 272 */ -#endif -#ifndef Tk_CreateOldPhotoImageFormat #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) */ +#endif /* defined(USE_TK_STUBS) */ /* !END!: Do not edit above this line. */ +/* Functions that don't belong in the stub table */ +#undef Tk_MainEx +#undef Tk_Init +#undef Tk_SafeInit +#undef Tk_CreateConsoleWindow + +#if defined(_WIN32) && defined(UNICODE) +# define Tk_MainEx Tk_MainExW + EXTERN void Tk_MainExW(int argc, wchar_t **argv, + Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); +#endif + #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef TkUnusedStubEntry - #endif /* _TKDECLS */ - diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 338652b..36798a2 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -64,11 +64,11 @@ enum validateType { static const Tk_OptionSpec entryOptSpec[] = { {TK_OPTION_BORDER, "-background", "background", "Background", DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder), - 0, (ClientData) DEF_ENTRY_BG_MONO, 0}, + 0, DEF_ENTRY_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth), 0, 0, 0}, {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", @@ -85,7 +85,7 @@ static const Tk_OptionSpec entryOptSpec[] = { "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1, Tk_Offset(Entry, exportSelection), 0, 0, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", @@ -115,7 +115,7 @@ static const Tk_OptionSpec entryOptSpec[] = { DEF_ENTRY_INVALIDCMD, -1, Tk_Offset(Entry, invalidCmd), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_SYNONYM, "-invcmd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-invalidcommand", 0}, + NULL, 0, -1, 0, "-invalidcommand", 0}, {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0}, {TK_OPTION_BORDER, "-readonlybackground", "readonlyBackground", @@ -126,20 +126,20 @@ static const Tk_OptionSpec entryOptSpec[] = { DEF_ENTRY_RELIEF, -1, Tk_Offset(Entry, relief), 0, 0, 0}, {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground", DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder), - 0, (ClientData) DEF_ENTRY_SELECT_MONO, 0}, + 0, DEF_ENTRY_SELECT_MONO, 0}, {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1, Tk_Offset(Entry, selBorderWidth), - 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0}, + 0, DEF_ENTRY_SELECT_BD_MONO, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr), - TK_CONFIG_NULL_OK, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0}, + TK_CONFIG_NULL_OK, DEF_ENTRY_SELECT_FG_MONO, 0}, {TK_OPTION_STRING, "-show", "show", "Show", DEF_ENTRY_SHOW, -1, Tk_Offset(Entry, showChar), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_ENTRY_STATE, -1, Tk_Offset(Entry, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_ENTRY_TAKE_FOCUS, -1, Tk_Offset(Entry, takeFocus), TK_OPTION_NULL_OK, 0, 0}, @@ -148,11 +148,11 @@ static const Tk_OptionSpec entryOptSpec[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate", DEF_ENTRY_VALIDATE, -1, Tk_Offset(Entry, validate), - 0, (ClientData) validateStrings, 0}, + 0, validateStrings, 0}, {TK_OPTION_STRING, "-validatecommand", "validateCommand","ValidateCommand", NULL, -1, Tk_Offset(Entry, validateCmd), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_SYNONYM, "-vcmd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-validatecommand", 0}, + NULL, 0, -1, 0, "-validatecommand", 0}, {TK_OPTION_INT, "-width", "width", "Width", DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0}, {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", @@ -181,19 +181,19 @@ static const Tk_OptionSpec entryOptSpec[] = { static const Tk_OptionSpec sbOptSpec[] = { {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Background", DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(Spinbox, activeBorder), - 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0}, + 0, DEF_BUTTON_ACTIVE_BG_MONO, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder), - 0, (ClientData) DEF_ENTRY_BG_MONO, 0}, + 0, DEF_ENTRY_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth), 0, 0, 0}, {TK_OPTION_BORDER, "-buttonbackground", "Button.background", "Background", DEF_BUTTON_BG_COLOR, -1, Tk_Offset(Spinbox, buttonBorder), - 0, (ClientData) DEF_BUTTON_BG_MONO, 0}, + 0, DEF_BUTTON_BG_MONO, 0}, {TK_OPTION_CURSOR, "-buttoncursor", "Button.cursor", "Cursor", DEF_BUTTON_CURSOR, -1, Tk_Offset(Spinbox, bCursor), TK_OPTION_NULL_OK, 0, 0}, @@ -218,7 +218,7 @@ static const Tk_OptionSpec sbOptSpec[] = { "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1, Tk_Offset(Entry, exportSelection), 0, 0, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", @@ -255,7 +255,7 @@ static const Tk_OptionSpec sbOptSpec[] = { DEF_ENTRY_INVALIDCMD, -1, Tk_Offset(Entry, invalidCmd), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_SYNONYM, "-invcmd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-invalidcommand", 0}, + NULL, 0, -1, 0, "-invalidcommand", 0}, {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", @@ -272,17 +272,17 @@ static const Tk_OptionSpec sbOptSpec[] = { 0, 0, 0}, {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground", DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder), - 0, (ClientData) DEF_ENTRY_SELECT_MONO, 0}, + 0, DEF_ENTRY_SELECT_MONO, 0}, {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1, Tk_Offset(Entry, selBorderWidth), - 0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0}, + 0, DEF_ENTRY_SELECT_BD_MONO, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr), - TK_CONFIG_NULL_OK, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0}, + TK_CONFIG_NULL_OK, DEF_ENTRY_SELECT_FG_MONO, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_ENTRY_STATE, -1, Tk_Offset(Entry, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_ENTRY_TAKE_FOCUS, -1, Tk_Offset(Entry, takeFocus), TK_CONFIG_NULL_OK, 0, 0}, @@ -293,14 +293,14 @@ static const Tk_OptionSpec sbOptSpec[] = { DEF_SPINBOX_TO, -1, Tk_Offset(Spinbox, toValue), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate", DEF_ENTRY_VALIDATE, -1, Tk_Offset(Entry, validate), - 0, (ClientData) validateStrings, 0}, + 0, validateStrings, 0}, {TK_OPTION_STRING, "-validatecommand", "validateCommand","ValidateCommand", NULL, -1, Tk_Offset(Entry, validateCmd), TK_CONFIG_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-values", "values", "Values", DEF_SPINBOX_VALUES, -1, Tk_Offset(Spinbox, valueStr), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_SYNONYM, "-vcmd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-validatecommand", 0}, + NULL, 0, -1, 0, "-validatecommand", 0}, {TK_OPTION_INT, "-width", "width", "Width", DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0}, {TK_OPTION_BOOLEAN, "-wrap", "wrap", "Wrap", @@ -317,7 +317,7 @@ static const Tk_OptionSpec sbOptSpec[] = { * dispatch the entry widget command. */ -static const char *entryCmdNames[] = { +static const char *const entryCmdNames[] = { "bbox", "cget", "configure", "delete", "get", "icursor", "index", "insert", "scan", "selection", "validate", "xview", NULL }; @@ -328,7 +328,7 @@ enum entryCmd { COMMAND_SCAN, COMMAND_SELECTION, COMMAND_VALIDATE, COMMAND_XVIEW }; -static const char *selCmdNames[] = { +static const char *const selCmdNames[] = { "adjust", "clear", "from", "present", "range", "to", NULL }; @@ -343,7 +343,7 @@ enum selCmd { * dispatch the spinbox widget command. */ -static const char *sbCmdNames[] = { +static const char *const sbCmdNames[] = { "bbox", "cget", "configure", "delete", "get", "icursor", "identify", "index", "insert", "invoke", "scan", "selection", "set", "validate", "xview", NULL @@ -356,7 +356,7 @@ enum sbCmd { SB_CMD_SET, SB_CMD_VALIDATE, SB_CMD_XVIEW }; -static const char *sbSelCmdNames[] = { +static const char *const sbSelCmdNames[] = { "adjust", "clear", "element", "from", "present", "range", "to", NULL }; @@ -374,7 +374,7 @@ enum sbselCmd { * modify them, you must modify the strings here. */ -static const char *selElementNames[] = { +static const char *const selElementNames[] = { "none", "buttondown", "buttonup", NULL, "entry" }; @@ -392,7 +392,7 @@ static const char *selElementNames[] = { static int ConfigureEntry(Tcl_Interp *interp, Entry *entryPtr, int objc, Tcl_Obj *const objv[], int flags); static int DeleteChars(Entry *entryPtr, int index, int count); -static void DestroyEntry(char *memPtr); +static void DestroyEntry(void *memPtr); static void DisplayEntry(ClientData clientData); static void EntryBlinkProc(ClientData clientData); static void EntryCmdDeletedProc(ClientData clientData); @@ -412,8 +412,8 @@ static char * EntryTextVarProc(ClientData clientData, const char *name2, int flags); static void EntryUpdateScrollbar(Entry *entryPtr); static int EntryValidate(Entry *entryPtr, char *cmd); -static int EntryValidateChange(Entry *entryPtr, char *change, - const char *newStr, int index, int type); +static int EntryValidateChange(Entry *entryPtr, const char *change, + const char *newStr, int index, int type); static void ExpandPercents(Entry *entryPtr, const char *before, const char *change, const char *newStr, int index, int type, Tcl_DString *dsPtr); @@ -426,8 +426,8 @@ static int EntryWidgetObjCmd(ClientData clientData, Tcl_Obj *const objv[]); static void EntryWorldChanged(ClientData instanceData); static int GetEntryIndex(Tcl_Interp *interp, Entry *entryPtr, - char *string, int *indexPtr); -static int InsertChars(Entry *entryPtr, int index, char *string); + const char *string, int *indexPtr); +static int InsertChars(Entry *entryPtr, int index, const char *string); /* * These forward declarations are the spinbox specific ones: @@ -446,11 +446,12 @@ static int ComputeFormat(Spinbox *sbPtr); * that can be invoked from generic window code. */ -static Tk_ClassProcs entryClass = { +static const Tk_ClassProcs entryClass = { sizeof(Tk_ClassProcs), /* size */ EntryWorldChanged, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; - /* *-------------------------------------------------------------- @@ -482,7 +483,7 @@ Tk_EntryObjCmd( char *tmp; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -506,18 +507,18 @@ Tk_EntryObjCmd( * initialized as memset covers the rest. */ - entryPtr = (Entry *) ckalloc(sizeof(Entry)); + entryPtr = ckalloc(sizeof(Entry)); memset(entryPtr, 0, sizeof(Entry)); entryPtr->tkwin = tkwin; entryPtr->display = Tk_Display(tkwin); entryPtr->interp = interp; entryPtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(entryPtr->tkwin), EntryWidgetObjCmd, - (ClientData) entryPtr, EntryCmdDeletedProc); + Tk_PathName(entryPtr->tkwin), EntryWidgetObjCmd, entryPtr, + EntryCmdDeletedProc); entryPtr->optionTable = optionTable; entryPtr->type = TK_ENTRY; - tmp = (char *) ckalloc(1); + tmp = ckalloc(1); tmp[0] = '\0'; entryPtr->string = tmp; entryPtr->selectFirst = -1; @@ -541,15 +542,15 @@ Tk_EntryObjCmd( * otherwise Tk might free it while we still need it. */ - Tcl_Preserve((ClientData) entryPtr->tkwin); + Tcl_Preserve(entryPtr->tkwin); Tk_SetClass(entryPtr->tkwin, "Entry"); - Tk_SetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr); + Tk_SetClassProcs(entryPtr->tkwin, &entryClass, entryPtr); Tk_CreateEventHandler(entryPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - EntryEventProc, (ClientData) entryPtr); + EntryEventProc, entryPtr); Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING, - EntryFetchSelection, (ClientData) entryPtr, XA_STRING); + EntryFetchSelection, entryPtr, XA_STRING); if ((Tk_InitOptions(interp, (char *) entryPtr, optionTable, tkwin) != TCL_OK) || @@ -558,7 +559,7 @@ Tk_EntryObjCmd( return TCL_ERROR; } - Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(entryPtr->tkwin)); return TCL_OK; } @@ -587,12 +588,12 @@ EntryWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = clientData; int cmdIndex, selIndex, result; Tcl_Obj *objPtr; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } @@ -601,17 +602,17 @@ EntryWidgetObjCmd( * valid command names. */ - result = Tcl_GetIndexFromObj(interp, objv[1], entryCmdNames, - "option", 0, &cmdIndex); + result = Tcl_GetIndexFromObj(interp, objv[1], entryCmdNames, "option", 0, + &cmdIndex); if (result != TCL_OK) { return result; } - Tcl_Preserve((ClientData) entryPtr); + Tcl_Preserve(entryPtr); switch ((enum entryCmd) cmdIndex) { case COMMAND_BBOX: { int index, x, y, width, height; - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *bbox[4]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -625,9 +626,11 @@ EntryWidgetObjCmd( index--; } Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height); - sprintf(buf, "%d %d %d %d", x + entryPtr->layoutX, - y + entryPtr->layoutY, width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX); + bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY); + bbox[2] = Tcl_NewIntObj(width); + bbox[3] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); break; } @@ -641,9 +644,8 @@ EntryWidgetObjCmd( entryPtr->optionTable, objv[2], entryPtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); break; case COMMAND_CONFIGURE: @@ -654,9 +656,8 @@ EntryWidgetObjCmd( entryPtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0); } @@ -693,7 +694,7 @@ EntryWidgetObjCmd( Tcl_WrongNumArgs(interp, 2, objv, NULL); goto error; } - Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1)); break; case COMMAND_ICURSOR: @@ -745,7 +746,7 @@ EntryWidgetObjCmd( case COMMAND_SCAN: { int x; - char *minorCmd; + const char *minorCmd; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x"); @@ -764,9 +765,11 @@ EntryWidgetObjCmd( && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) { EntryScanTo(entryPtr, x); } else { - Tcl_AppendResult(interp, "bad scan option \"", - Tcl_GetString(objv[2]), "\": must be mark or dragto", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + minorCmd)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + minorCmd, NULL); goto error; } break; @@ -860,7 +863,7 @@ EntryWidgetObjCmd( goto error; } Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((entryPtr->selectFirst >= 0))); + Tcl_NewBooleanObj(entryPtr->selectFirst >= 0)); goto done; case SELECTION_RANGE: @@ -886,7 +889,7 @@ EntryWidgetObjCmd( if (!(entryPtr->flags & GOT_SELECTION) && (entryPtr->exportSelection)) { Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, - EntryLostSelection, (ClientData) entryPtr); + EntryLostSelection, entryPtr); entryPtr->flags |= GOT_SELECTION; } EventuallyRedraw(entryPtr); @@ -921,7 +924,7 @@ EntryWidgetObjCmd( if (entryPtr->validate != VALIDATE_NONE) { entryPtr->validate = selIndex; } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(code == TCL_OK)); break; } @@ -930,13 +933,12 @@ EntryWidgetObjCmd( if (objc == 2) { double first, last; - char buf[TCL_DOUBLE_SPACE]; + Tcl_Obj *span[2]; EntryVisibleRange(entryPtr, &first, &last); - Tcl_PrintDouble(NULL, first, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, last, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + span[0] = Tcl_NewDoubleObj(first); + span[1] = Tcl_NewDoubleObj(last); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, span)); goto done; } else if (objc == 3) { if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), @@ -986,11 +988,11 @@ EntryWidgetObjCmd( } done: - Tcl_Release((ClientData) entryPtr); + Tcl_Release(entryPtr); return result; error: - Tcl_Release((ClientData) entryPtr); + Tcl_Release(entryPtr); return TCL_ERROR; } @@ -1014,9 +1016,9 @@ EntryWidgetObjCmd( static void DestroyEntry( - char *memPtr) /* Info about entry widget. */ + void *memPtr) /* Info about entry widget. */ { - Entry *entryPtr = (Entry *) memPtr; + Entry *entryPtr = memPtr; /* * Free up all the stuff that requires special handling, then let @@ -1025,9 +1027,9 @@ DestroyEntry( ckfree((char *)entryPtr->string); if (entryPtr->textVarName != NULL) { - Tcl_UntraceVar(entryPtr->interp, entryPtr->textVarName, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - EntryTextVarProc, (ClientData) entryPtr); + Tcl_UntraceVar2(entryPtr->interp, entryPtr->textVarName, + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + EntryTextVarProc, entryPtr); entryPtr->flags &= ~ENTRY_VAR_TRACED; } if (entryPtr->textGC != None) { @@ -1054,10 +1056,10 @@ DestroyEntry( Tk_FreeTextLayout(entryPtr->textLayout); Tk_FreeConfigOptions((char *) entryPtr, entryPtr->optionTable, entryPtr->tkwin); - Tcl_Release((ClientData) entryPtr->tkwin); + Tcl_Release(entryPtr->tkwin); entryPtr->tkwin = NULL; - ckfree((char *) entryPtr); + ckfree(entryPtr); } /* @@ -1110,9 +1112,9 @@ ConfigureEntry( if ((entryPtr->textVarName != NULL) && (entryPtr->flags & ENTRY_VAR_TRACED)) { - Tcl_UntraceVar(interp, entryPtr->textVarName, + Tcl_UntraceVar2(interp, entryPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - EntryTextVarProc, (ClientData) entryPtr); + EntryTextVarProc, entryPtr); entryPtr->flags &= ~ENTRY_VAR_TRACED; } @@ -1121,12 +1123,12 @@ ConfigureEntry( * value. */ - oldExport = entryPtr->exportSelection; + oldExport = entryPtr->exportSelection; if (entryPtr->type == TK_SPINBOX) { - oldValues = sbPtr->valueStr; - oldFormat = sbPtr->reqFormat; - oldFrom = sbPtr->fromValue; - oldTo = sbPtr->toValue; + oldValues = sbPtr->valueStr; + oldFormat = sbPtr->reqFormat; + oldFrom = sbPtr->fromValue; + oldTo = sbPtr->toValue; } for (error = 0; error <= 1; error++) { @@ -1175,9 +1177,11 @@ ConfigureEntry( if (entryPtr->type == TK_SPINBOX) { if (sbPtr->fromValue > sbPtr->toValue) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "-to value must be greater than -from value", - TCL_VOLATILE); + -1)); + Tcl_SetErrorCode(interp, "TK", "SPINBOX", "RANGE_SANITY", + NULL); continue; } @@ -1194,9 +1198,12 @@ ConfigureEntry( formatLen = strlen(fmt); if ((fmt[0] != '%') || (fmt[formatLen-1] != 'f')) { - badFormatOpt: - Tcl_AppendResult(interp, "bad spinbox format specifier \"", - sbPtr->reqFormat, "\"", NULL); + badFormatOpt: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad spinbox format specifier \"%s\"", + sbPtr->reqFormat)); + Tcl_SetErrorCode(interp, "TK", "SPINBOX", "FORMAT_SANITY", + NULL); continue; } if ((sscanf(fmt, "%%%d.%d%[f]", &min, &max, fbuf) == 3) @@ -1273,7 +1280,7 @@ ConfigureEntry( && (entryPtr->selectFirst != -1) && !(entryPtr->flags & GOT_SELECTION)) { Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection, - (ClientData) entryPtr); + entryPtr); entryPtr->flags |= GOT_SELECTION; } @@ -1303,7 +1310,7 @@ ConfigureEntry( if (entryPtr->textVarName != NULL) { const char *value; - value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2(interp, entryPtr->textVarName, NULL, TCL_GLOBAL_ONLY); if (value == NULL) { /* @@ -1357,12 +1364,10 @@ ConfigureEntry( if (sscanf(entryPtr->string, "%lf", &dvalue) <= 0) { /* Scan failure */ dvalue = sbPtr->fromValue; - } else { - if (dvalue > sbPtr->toValue) { - dvalue = sbPtr->toValue; - } else if (dvalue < sbPtr->fromValue) { - dvalue = sbPtr->fromValue; - } + } else if (dvalue > sbPtr->toValue) { + dvalue = sbPtr->toValue; + } else if (dvalue < sbPtr->fromValue) { + dvalue = sbPtr->fromValue; } sprintf(sbPtr->formatBuf, sbPtr->valueFormat, dvalue); @@ -1382,16 +1387,16 @@ ConfigureEntry( if ((entryPtr->textVarName != NULL) && !(entryPtr->flags & ENTRY_VAR_TRACED)) { - code = Tcl_TraceVar(interp, entryPtr->textVarName, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - EntryTextVarProc, (ClientData) entryPtr); + code = Tcl_TraceVar2(interp, entryPtr->textVarName, + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + EntryTextVarProc, entryPtr); if (code != TCL_OK) { return TCL_ERROR; } entryPtr->flags |= ENTRY_VAR_TRACED; } - EntryWorldChanged((ClientData) entryPtr); + EntryWorldChanged(entryPtr); if (error) { Tcl_SetObjResult(interp, errorResult); Tcl_DecrRefCount(errorResult); @@ -1428,7 +1433,7 @@ EntryWorldChanged( unsigned long mask; Tk_3DBorder border; XColor *colorPtr; - Entry *entryPtr = (Entry *) instanceData; + Entry *entryPtr = instanceData; entryPtr->avgWidth = Tk_TextWidth(entryPtr->tkfont, "0", 1); if (entryPtr->avgWidth == 0) { @@ -1452,8 +1457,8 @@ EntryWorldChanged( * the background may be overridden. */ - border = entryPtr->normalBorder; - colorPtr = entryPtr->fgColorPtr; + border = entryPtr->normalBorder; + colorPtr = entryPtr->fgColorPtr; switch (entryPtr->state) { case STATE_DISABLED: if (entryPtr->disabledBorder != NULL) { @@ -1580,7 +1585,7 @@ static void DisplayEntry( ClientData clientData) /* Information about window. */ { - Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = clientData; Tk_Window tkwin = entryPtr->tkwin; int baseY, selStartX, selEndX, cursorX; int showSelection, xBound; @@ -1607,14 +1612,14 @@ DisplayEntry( * side-effect of destroying or unmapping the entry widget. */ - Tcl_Preserve((ClientData) entryPtr); + Tcl_Preserve(entryPtr); EntryUpdateScrollbar(entryPtr); if ((entryPtr->flags & ENTRY_DELETED) || !Tk_IsMapped(tkwin)) { - Tcl_Release((ClientData) entryPtr); + Tcl_Release(entryPtr); return; } - Tcl_Release((ClientData) entryPtr); + Tcl_Release(entryPtr); } #ifndef TK_NO_DOUBLE_BUFFERING @@ -1685,7 +1690,7 @@ DisplayEntry( baseY - fm.ascent - entryPtr->selBorderWidth, (selEndX - selStartX) + 2*entryPtr->selBorderWidth, (fm.ascent + fm.descent) + 2*entryPtr->selBorderWidth, - entryPtr->selBorderWidth, + entryPtr->selBorderWidth, #ifndef MAC_OSX_TK TK_RELIEF_RAISED #else @@ -1935,7 +1940,7 @@ EntryComputeGeometry( size = Tcl_UniCharToUtf(ch, buf); entryPtr->numDisplayBytes = entryPtr->numChars * size; - p = (char *) ckalloc((unsigned) (entryPtr->numDisplayBytes + 1)); + p = ckalloc(entryPtr->numDisplayBytes + 1); entryPtr->displayString = p; for (i = entryPtr->numChars; --i >= 0; ) { @@ -1999,12 +2004,10 @@ EntryComputeGeometry( height = fm.linespace + 2*entryPtr->inset + 2*(YPAD-XPAD); if (entryPtr->prefWidth > 0) { width = entryPtr->prefWidth*entryPtr->avgWidth + 2*entryPtr->inset; + } else if (totalLength == 0) { + width = entryPtr->avgWidth + 2*entryPtr->inset; } else { - if (totalLength == 0) { - width = entryPtr->avgWidth + 2*entryPtr->inset; - } else { - width = totalLength + 2*entryPtr->inset; - } + width = totalLength + 2*entryPtr->inset; } /* @@ -2038,7 +2041,7 @@ InsertChars( Entry *entryPtr, /* Entry that is to get the new elements. */ int index, /* Add the new elements before this character * index. */ - char *value) /* New characters to add (NULL-terminated + const char *value) /* New characters to add (NULL-terminated * string). */ { ptrdiff_t byteIndex; @@ -2055,7 +2058,7 @@ InsertChars( } newByteCount = entryPtr->numBytes + byteCount + 1; - newStr = (char *) ckalloc((unsigned) newByteCount); + newStr = ckalloc(newByteCount); memcpy(newStr, string, byteIndex); strcpy(newStr + byteIndex, value); strcpy(newStr + byteIndex + byteCount, string + byteIndex); @@ -2156,11 +2159,11 @@ DeleteChars( byteCount = Tcl_UtfAtIndex(string + byteIndex, count) - (string+byteIndex); newByteCount = entryPtr->numBytes + 1 - byteCount; - newStr = (char *) ckalloc((unsigned) newByteCount); + newStr = ckalloc(newByteCount); memcpy(newStr, string, (size_t) byteIndex); strcpy(newStr + byteIndex, string + byteIndex + byteCount); - toDelete = (char *) ckalloc((unsigned) (byteCount + 1)); + toDelete = ckalloc(byteCount + 1); memcpy(toDelete, string + byteIndex, (size_t) byteCount); toDelete[byteCount] = '\0'; @@ -2264,8 +2267,8 @@ EntryValueChanged( if (entryPtr->textVarName == NULL) { newValue = NULL; } else { - newValue = Tcl_SetVar(entryPtr->interp, entryPtr->textVarName, - entryPtr->string, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + newValue = Tcl_SetVar2(entryPtr->interp, entryPtr->textVarName, + NULL, entryPtr->string, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); } if ((newValue != NULL) && (strcmp(newValue, entryPtr->string) != 0)) { @@ -2346,7 +2349,7 @@ EntrySetValue( * during validation */ - char *tmp = (char *) ckalloc((unsigned) (valueLen + 1)); + char *tmp = ckalloc(valueLen + 1); strcpy(tmp, value); value = tmp; @@ -2375,7 +2378,7 @@ EntrySetValue( if (malloced) { entryPtr->string = value; } else { - char *tmp = (char *) ckalloc((unsigned) (valueLen + 1)); + char *tmp = ckalloc(valueLen + 1); strcpy(tmp, value); entryPtr->string = tmp; @@ -2435,10 +2438,10 @@ EntryEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = clientData; if ((entryPtr->type == TK_SPINBOX) && (eventPtr->type == MotionNotify)) { - Spinbox *sbPtr = (Spinbox *) clientData; + Spinbox *sbPtr = clientData; int elem; elem = GetSpinboxElement(sbPtr, eventPtr->xmotion.x, @@ -2475,15 +2478,15 @@ EntryEventProc( if (entryPtr->flags & REDRAW_PENDING) { Tcl_CancelIdleCall(DisplayEntry, clientData); } - Tcl_EventuallyFree(clientData, DestroyEntry); + Tcl_EventuallyFree(clientData, (Tcl_FreeProc *) DestroyEntry); } break; case ConfigureNotify: - Tcl_Preserve((ClientData) entryPtr); + Tcl_Preserve(entryPtr); entryPtr->flags |= UPDATE_SCROLLBAR; EntryComputeGeometry(entryPtr); EventuallyRedraw(entryPtr); - Tcl_Release((ClientData) entryPtr); + Tcl_Release(entryPtr); break; case FocusIn: case FocusOut: @@ -2516,7 +2519,7 @@ static void EntryCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = clientData; /* * This function could be invoked either because the window was destroyed @@ -2555,40 +2558,41 @@ GetEntryIndex( Tcl_Interp *interp, /* For error messages. */ Entry *entryPtr, /* Entry for which the index is being * specified. */ - char *string, /* Specifies character in entryPtr. */ + const char *string, /* Specifies character in entryPtr. */ int *indexPtr) /* Where to store converted character index */ { size_t length; length = strlen(string); - if (string[0] == 'a') { - if (strncmp(string, "anchor", length) == 0) { - *indexPtr = entryPtr->selectAnchor; - } else { - badIndex: - - Tcl_AppendResult(interp, "bad ", - (entryPtr->type == TK_ENTRY) ? "entry" : "spinbox", - " index \"", string, "\"", NULL); - return TCL_ERROR; + switch (string[0]) { + case 'a': + if (strncmp(string, "anchor", length) != 0) { + goto badIndex; } - } else if (string[0] == 'e') { - if (strncmp(string, "end", length) == 0) { - *indexPtr = entryPtr->numChars; - } else { + *indexPtr = entryPtr->selectAnchor; + break; + case 'e': + if (strncmp(string, "end", length) != 0) { goto badIndex; } - } else if (string[0] == 'i') { - if (strncmp(string, "insert", length) == 0) { - *indexPtr = entryPtr->insertPos; - } else { + *indexPtr = entryPtr->numChars; + break; + case 'i': + if (strncmp(string, "insert", length) != 0) { goto badIndex; } - } else if (string[0] == 's') { + *indexPtr = entryPtr->insertPos; + break; + case 's': if (entryPtr->selectFirst < 0) { - Tcl_AppendResult(interp, "selection isn't in widget ", - Tk_PathName(entryPtr->tkwin), NULL); + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "selection isn't in widget %s", + Tk_PathName(entryPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", + (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX", + "NO_SELECTION", NULL); return TCL_ERROR; } if (length < 5) { @@ -2601,7 +2605,8 @@ GetEntryIndex( } else { goto badIndex; } - } else if (string[0] == '@') { + break; + case '@': { int x, roundUp, maxWidth; if (Tcl_GetInt(NULL, string + 1, &x) != TCL_OK) { @@ -2612,7 +2617,7 @@ GetEntryIndex( } roundUp = 0; maxWidth = Tk_Width(entryPtr->tkwin) - entryPtr->inset - - entryPtr->xWidth - 1; + - entryPtr->xWidth - 1; if (x > maxWidth) { x = maxWidth; roundUp = 1; @@ -2630,7 +2635,9 @@ GetEntryIndex( if (roundUp && (*indexPtr < entryPtr->numChars)) { *indexPtr += 1; } - } else { + break; + } + default: if (Tcl_GetInt(NULL, string, indexPtr) != TCL_OK) { goto badIndex; } @@ -2641,6 +2648,14 @@ GetEntryIndex( } } return TCL_OK; + + badIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad %s index \"%s\"", + (entryPtr->type == TK_ENTRY) ? "entry" : "spinbox", string)); + Tcl_SetErrorCode(interp, "TK", + (entryPtr->type == TK_ENTRY) ? "ENTRY" : "SPINBOX", + "BAD_INDEX", NULL); + return TCL_ERROR; } /* @@ -2732,7 +2747,7 @@ EntrySelectTo( if (!(entryPtr->flags & GOT_SELECTION) && (entryPtr->exportSelection)) { Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection, - (ClientData) entryPtr); + entryPtr); entryPtr->flags |= GOT_SELECTION; } @@ -2792,7 +2807,7 @@ EntryFetchSelection( int maxBytes) /* Maximum number of bytes to place at buffer, * not including terminating NUL character. */ { - Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = clientData; int byteCount; const char *string; const char *selStart, *selEnd; @@ -2815,7 +2830,7 @@ EntryFetchSelection( buffer[byteCount] = '\0'; return byteCount; } - + /* *---------------------------------------------------------------------- * @@ -2838,7 +2853,7 @@ static void EntryLostSelection( ClientData clientData) /* Information about entry widget. */ { - Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = clientData; entryPtr->flags &= ~GOT_SELECTION; @@ -2892,7 +2907,7 @@ EventuallyRedraw( if (!(entryPtr->flags & REDRAW_PENDING)) { entryPtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayEntry, (ClientData) entryPtr); + Tcl_DoWhenIdle(DisplayEntry, entryPtr); } } @@ -2973,27 +2988,33 @@ EntryUpdateScrollbar( int code; double first, last; Tcl_Interp *interp; + Tcl_DString buf; if (entryPtr->scrollCmd == NULL) { return; } interp = entryPtr->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); EntryVisibleRange(entryPtr, &first, &last); Tcl_PrintDouble(NULL, first, firstStr); Tcl_PrintDouble(NULL, last, lastStr); - code = Tcl_VarEval(interp, entryPtr->scrollCmd, " ", firstStr, " ", - lastStr, NULL); + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, entryPtr->scrollCmd, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, firstStr, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, lastStr, -1); + code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); if (code != TCL_OK) { - Tcl_AddErrorInfo(interp, - "\n (horizontal scrolling command executed by "); - Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin)); - Tcl_AddErrorInfo(interp, ")"); - Tcl_BackgroundError(interp); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (horizontal scrolling command executed by %s)", + Tk_PathName(entryPtr->tkwin))); + Tcl_BackgroundException(interp, code); } - Tcl_SetResult(interp, NULL, TCL_STATIC); - Tcl_Release((ClientData) interp); + Tcl_ResetResult(interp); + Tcl_Release(interp); } /* @@ -3018,7 +3039,7 @@ static void EntryBlinkProc( ClientData clientData) /* Pointer to record describing entry. */ { - Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = clientData; if ((entryPtr->state == STATE_DISABLED) || (entryPtr->state == STATE_READONLY) || @@ -3028,11 +3049,11 @@ EntryBlinkProc( if (entryPtr->flags & CURSOR_ON) { entryPtr->flags &= ~CURSOR_ON; entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - entryPtr->insertOffTime, EntryBlinkProc, (ClientData) entryPtr); + entryPtr->insertOffTime, EntryBlinkProc, entryPtr); } else { entryPtr->flags |= CURSOR_ON; entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - entryPtr->insertOnTime, EntryBlinkProc, (ClientData) entryPtr); + entryPtr->insertOnTime, EntryBlinkProc, entryPtr); } EventuallyRedraw(entryPtr); } @@ -3066,23 +3087,22 @@ EntryFocusProc( entryPtr->flags |= GOT_FOCUS | CURSOR_ON; if (entryPtr->insertOffTime != 0) { entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - entryPtr->insertOnTime, EntryBlinkProc, - (ClientData) entryPtr); + entryPtr->insertOnTime, EntryBlinkProc, entryPtr); } if (entryPtr->validate == VALIDATE_ALL || - entryPtr->validate == VALIDATE_FOCUS || - entryPtr->validate == VALIDATE_FOCUSIN) { - EntryValidateChange(entryPtr, NULL, - entryPtr->string, -1, VALIDATE_FOCUSIN); + entryPtr->validate == VALIDATE_FOCUS || + entryPtr->validate == VALIDATE_FOCUSIN) { + EntryValidateChange(entryPtr, NULL, entryPtr->string, -1, + VALIDATE_FOCUSIN); } } else { entryPtr->flags &= ~(GOT_FOCUS | CURSOR_ON); - entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL; + entryPtr->insertBlinkHandler = NULL; if (entryPtr->validate == VALIDATE_ALL || - entryPtr->validate == VALIDATE_FOCUS || - entryPtr->validate == VALIDATE_FOCUSOUT) { - EntryValidateChange(entryPtr, NULL, - entryPtr->string, -1, VALIDATE_FOCUSOUT); + entryPtr->validate == VALIDATE_FOCUS || + entryPtr->validate == VALIDATE_FOCUSOUT) { + EntryValidateChange(entryPtr, NULL, entryPtr->string, -1, + VALIDATE_FOCUSOUT); } } EventuallyRedraw(entryPtr); @@ -3114,7 +3134,7 @@ EntryTextVarProc( const char *name2, /* Not used. */ int flags) /* Information about what happened. */ { - Entry *entryPtr = (Entry *) clientData; + Entry *entryPtr = clientData; const char *value; if (entryPtr->flags & ENTRY_DELETED) { @@ -3131,9 +3151,9 @@ EntryTextVarProc( if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_SetVar(interp, entryPtr->textVarName, entryPtr->string, - TCL_GLOBAL_ONLY); - Tcl_TraceVar(interp, entryPtr->textVarName, + Tcl_SetVar2(interp, entryPtr->textVarName, NULL, + entryPtr->string, TCL_GLOBAL_ONLY); + Tcl_TraceVar2(interp, entryPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, EntryTextVarProc, clientData); entryPtr->flags |= ENTRY_VAR_TRACED; @@ -3147,7 +3167,7 @@ EntryTextVarProc( * value because we changed it because someone typed in the entry). */ - value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2(interp, entryPtr->textVarName, NULL, TCL_GLOBAL_ONLY); if (value == NULL) { value = ""; } @@ -3192,10 +3212,10 @@ EntryValidate( */ if (code != TCL_OK && code != TCL_RETURN) { - Tcl_AddErrorInfo(interp, "\n\t(in validation command executed by "); - Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->tkwin)); - Tcl_AddErrorInfo(interp, ")"); - Tcl_BackgroundError(interp); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (in validation command executed by %s)", + Tk_PathName(entryPtr->tkwin))); + Tcl_BackgroundException(interp, code); return TCL_ERROR; } @@ -3206,13 +3226,13 @@ EntryValidate( if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp), &bool) != TCL_OK) { Tcl_AddErrorInfo(interp, - "\nvalid boolean not returned by validation command"); - Tcl_BackgroundError(interp); - Tcl_SetResult(interp, NULL, 0); + "\n (invalid boolean result from validation command)"); + Tcl_BackgroundException(interp, TCL_ERROR); + Tcl_ResetResult(interp); return TCL_ERROR; } - Tcl_SetResult(interp, NULL, 0); + Tcl_ResetResult(interp); return (bool ? TCL_OK : TCL_BREAK); } @@ -3238,7 +3258,7 @@ EntryValidate( static int EntryValidateChange( register Entry *entryPtr, /* Entry that needs validation. */ - char *change, /* Characters to be added/deleted + const char *change, /* Characters to be added/deleted * (NUL-terminated string). */ const char *newValue, /* Potential new value of entry string */ int index, /* index of insert/delete, -1 otherwise */ @@ -3321,16 +3341,19 @@ EntryValidateChange( if (varValidate) { entryPtr->validate = VALIDATE_NONE; } else if (entryPtr->invalidCmd != NULL) { + int result; + Tcl_DStringInit(&script); ExpandPercents(entryPtr, entryPtr->invalidCmd, change, newValue, index, type, &script); Tcl_DStringAppend(&script, "", 1); p = Tcl_DStringValue(&script); - if (Tcl_EvalEx(entryPtr->interp, p, -1, - TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) != TCL_OK) { + result = Tcl_EvalEx(entryPtr->interp, p, -1, + TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); + if (result != TCL_OK) { Tcl_AddErrorInfo(entryPtr->interp, - "\n\t(in invalidcommand executed by entry)"); - Tcl_BackgroundError(entryPtr->interp); + "\n (in invalidcommand executed by entry)"); + Tcl_BackgroundException(entryPtr->interp, result); code = TCL_ERROR; entryPtr->validate = VALIDATE_NONE; } @@ -3550,7 +3573,7 @@ Tk_SpinboxObjCmd( char *tmp; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -3574,7 +3597,7 @@ Tk_SpinboxObjCmd( * initialized as memset covers the rest. */ - sbPtr = (Spinbox *) ckalloc(sizeof(Spinbox)); + sbPtr = ckalloc(sizeof(Spinbox)); entryPtr = (Entry *) sbPtr; memset(sbPtr, 0, sizeof(Spinbox)); @@ -3582,11 +3605,11 @@ Tk_SpinboxObjCmd( entryPtr->display = Tk_Display(tkwin); entryPtr->interp = interp; entryPtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(entryPtr->tkwin), SpinboxWidgetObjCmd, - (ClientData) sbPtr, EntryCmdDeletedProc); + Tk_PathName(entryPtr->tkwin), SpinboxWidgetObjCmd, sbPtr, + EntryCmdDeletedProc); entryPtr->optionTable = optionTable; entryPtr->type = TK_SPINBOX; - tmp = (char *) ckalloc(1); + tmp = ckalloc(1); tmp[0] = '\0'; entryPtr->string = tmp; entryPtr->selectFirst = -1; @@ -3613,7 +3636,7 @@ Tk_SpinboxObjCmd( sbPtr->fromValue = 0.0; sbPtr->toValue = 100.0; sbPtr->increment = 1.0; - sbPtr->formatBuf = (char *) ckalloc(TCL_DOUBLE_SPACE); + sbPtr->formatBuf = ckalloc(TCL_DOUBLE_SPACE); sbPtr->bdRelief = TK_RELIEF_FLAT; sbPtr->buRelief = TK_RELIEF_FLAT; @@ -3622,15 +3645,15 @@ Tk_SpinboxObjCmd( * otherwise Tk might free it while we still need it. */ - Tcl_Preserve((ClientData) entryPtr->tkwin); + Tcl_Preserve(entryPtr->tkwin); Tk_SetClass(entryPtr->tkwin, "Spinbox"); - Tk_SetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr); + Tk_SetClassProcs(entryPtr->tkwin, &entryClass, entryPtr); Tk_CreateEventHandler(entryPtr->tkwin, PointerMotionMask|ExposureMask|StructureNotifyMask|FocusChangeMask, - EntryEventProc, (ClientData) entryPtr); + EntryEventProc, entryPtr); Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING, - EntryFetchSelection, (ClientData) entryPtr, XA_STRING); + EntryFetchSelection, entryPtr, XA_STRING); if (Tk_InitOptions(interp, (char *) sbPtr, optionTable, tkwin) != TCL_OK) { @@ -3641,10 +3664,10 @@ Tk_SpinboxObjCmd( goto error; } - Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(entryPtr->tkwin)); return TCL_OK; - error: + error: Tk_DestroyWindow(entryPtr->tkwin); return TCL_ERROR; } @@ -3674,13 +3697,13 @@ SpinboxWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Entry *entryPtr = (Entry *) clientData; - Spinbox *sbPtr = (Spinbox *) clientData; + Entry *entryPtr = clientData; + Spinbox *sbPtr = clientData; int cmdIndex, selIndex, result; Tcl_Obj *objPtr; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } @@ -3695,11 +3718,11 @@ SpinboxWidgetObjCmd( return result; } - Tcl_Preserve((ClientData) entryPtr); + Tcl_Preserve(entryPtr); switch ((enum sbCmd) cmdIndex) { case SB_CMD_BBOX: { int index, x, y, width, height; - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *bbox[4]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -3712,11 +3735,12 @@ SpinboxWidgetObjCmd( if ((index == entryPtr->numChars) && (index > 0)) { index--; } - Tk_CharBbox(entryPtr->textLayout, index, &x, &y, - &width, &height); - sprintf(buf, "%d %d %d %d", x + entryPtr->layoutX, - y + entryPtr->layoutY, width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height); + bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX); + bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY); + bbox[2] = Tcl_NewIntObj(width); + bbox[3] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); break; } @@ -3730,22 +3754,19 @@ SpinboxWidgetObjCmd( entryPtr->optionTable, objv[2], entryPtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); break; case SB_CMD_CONFIGURE: if (objc <= 3) { objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr, - entryPtr->optionTable, - (objc == 3) ? objv[2] : NULL, + entryPtr->optionTable, (objc == 3) ? objv[2] : NULL, entryPtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0); } @@ -3784,7 +3805,7 @@ SpinboxWidgetObjCmd( Tcl_WrongNumArgs(interp, 2, objv, NULL); goto error; } - Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1)); break; case SB_CMD_ICURSOR: @@ -3812,8 +3833,8 @@ SpinboxWidgetObjCmd( } elem = GetSpinboxElement(sbPtr, x, y); if (elem != SEL_NONE) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - selElementNames[elem], -1); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(selElementNames[elem], -1)); } break; } @@ -3872,7 +3893,7 @@ SpinboxWidgetObjCmd( case SB_CMD_SCAN: { int x; - char *minorCmd; + const char *minorCmd; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x"); @@ -3891,9 +3912,11 @@ SpinboxWidgetObjCmd( && (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) { EntryScanTo(entryPtr, x); } else { - Tcl_AppendResult(interp, "bad scan option \"", - Tcl_GetString(objv[2]), "\": must be mark or dragto", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + minorCmd)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + minorCmd, NULL); goto error; } break; @@ -3986,8 +4009,8 @@ SpinboxWidgetObjCmd( Tcl_WrongNumArgs(interp, 3, objv, NULL); goto error; } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((entryPtr->selectFirst >= 0))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + entryPtr->selectFirst >= 0)); goto done; case SB_SEL_RANGE: @@ -4011,9 +4034,9 @@ SpinboxWidgetObjCmd( entryPtr->selectLast = index2; } if (!(entryPtr->flags & GOT_SELECTION) - && (entryPtr->exportSelection)) { + && entryPtr->exportSelection) { Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, - EntryLostSelection, (ClientData) entryPtr); + EntryLostSelection, entryPtr); entryPtr->flags |= GOT_SELECTION; } EventuallyRedraw(entryPtr); @@ -4037,8 +4060,8 @@ SpinboxWidgetObjCmd( goto error; } if (objc == 3) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - selElementNames[sbPtr->selElement], -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + selElementNames[sbPtr->selElement], -1)); } else { int lastElement = sbPtr->selElement; @@ -4069,7 +4092,7 @@ SpinboxWidgetObjCmd( goto error; } } - Tcl_SetStringObj(Tcl_GetObjResult(interp), entryPtr->string, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1)); break; } @@ -4087,7 +4110,8 @@ SpinboxWidgetObjCmd( if (entryPtr->validate != VALIDATE_NONE) { entryPtr->validate = selIndex; } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj((code == TCL_OK))); + + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(code == TCL_OK)); break; } @@ -4096,13 +4120,12 @@ SpinboxWidgetObjCmd( if (objc == 2) { double first, last; - char buf[TCL_DOUBLE_SPACE]; + Tcl_Obj *span[2]; EntryVisibleRange(entryPtr, &first, &last); - Tcl_PrintDouble(NULL, first, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, last, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + span[0] = Tcl_NewDoubleObj(first); + span[1] = Tcl_NewDoubleObj(last); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, span)); goto done; } else if (objc == 3) { if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), @@ -4153,11 +4176,11 @@ SpinboxWidgetObjCmd( } done: - Tcl_Release((ClientData) entryPtr); + Tcl_Release(entryPtr); return result; error: - Tcl_Release((ClientData) entryPtr); + Tcl_Release(entryPtr); return TCL_ERROR; } @@ -4226,7 +4249,7 @@ SpinboxInvoke( * "down" button. */ { Entry *entryPtr = (Entry *) sbPtr; - char *type; + const char *type; int code, up; Tcl_DString script; @@ -4257,7 +4280,7 @@ SpinboxInvoke( */ int i, listc, elemLen, length = entryPtr->numChars; - char *bytes; + const char *bytes; Tcl_Obj **listv; Tcl_ListObjGetElements(interp, sbPtr->listObj, &listc, &listv); @@ -4354,8 +4377,9 @@ SpinboxInvoke( Tcl_DStringFree(&script); if (code != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n\t(in command executed by spinbox)"); - Tcl_BackgroundError(interp); + Tcl_AddErrorInfo(interp, + "\n (in command executed by spinbox)"); + Tcl_BackgroundException(interp, code); /* * Yes, it's an error, but a bg one, so we return OK @@ -4364,7 +4388,7 @@ SpinboxInvoke( return TCL_OK; } - Tcl_SetResult(interp, NULL, 0); + Tcl_ResetResult(interp); } return TCL_OK; diff --git a/generic/tkEntry.h b/generic/tkEntry.h index 7f8aa1f..52535c8 100644 --- a/generic/tkEntry.h +++ b/generic/tkEntry.h @@ -6,7 +6,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * Copyright (c) 2002 Apple Computer, Inc. + * Copyright (c) 2002 Apple Inc. */ #ifndef _TKENTRY @@ -16,11 +16,6 @@ #include "tkInt.h" #endif -#ifdef BUILD_tk -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT -#endif - enum EntryType { TK_ENTRY, TK_SPINBOX }; @@ -48,7 +43,7 @@ typedef struct { * Fields that are set by widget commands other than "configure". */ - CONST char *string; /* Pointer to storage for string; + const char *string; /* Pointer to storage for string; * NULL-terminated; malloc-ed. */ int insertPos; /* Character index before which next typed * character will be inserted. */ @@ -138,7 +133,7 @@ typedef struct { * configuration settings above. */ - CONST char *displayString; /* String to use when displaying. This may be + const char *displayString; /* String to use when displaying. This may be * a pointer to string, or a pointer to * malloced memory with the same character * length as string but whose characters are @@ -300,7 +295,4 @@ MODULE_SCOPE int TkpDrawEntryBorderAndFocus(Entry *entryPtr, Drawable d, int isSpinbox); MODULE_SCOPE int TkpDrawSpinboxButtons(Spinbox *sbPtr, Drawable d); -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TKENTRY */ diff --git a/generic/tkError.c b/generic/tkError.c index 6617c37..fc223e6 100644 --- a/generic/tkError.c +++ b/generic/tkError.c @@ -107,7 +107,7 @@ Tk_CreateErrorHandler( * Create the handler record. */ - errorPtr = (TkErrorHandler *) ckalloc(sizeof(TkErrorHandler)); + errorPtr = ckalloc(sizeof(TkErrorHandler)); errorPtr->dispPtr = dispPtr; errorPtr->firstRequest = NextRequest(display); errorPtr->lastRequest = (unsigned) -1; @@ -182,7 +182,7 @@ Tk_DeleteErrorHandler( } else { prevPtr->nextPtr = nextPtr; } - ckfree((char *) errorPtr); + ckfree(errorPtr); continue; } prevPtr = errorPtr; @@ -246,8 +246,8 @@ ErrorProc( && (errorPtr->lastRequest < errEventPtr->serial))) { continue; } - if (errorPtr->errorProc == NULL || (*errorPtr->errorProc)( - errorPtr->clientData, errEventPtr) == 0) { + if (errorPtr->errorProc == NULL || + errorPtr->errorProc(errorPtr->clientData, errEventPtr) == 0) { return 0; } } @@ -269,8 +269,7 @@ ErrorProc( if (errEventPtr->error_code == BadWindow) { Window w = (Window) errEventPtr->resourceid; - if (Tk_IdToWindow(display, w) != NULL - || TkpWindowWasRecentlyDeleted(w, dispPtr)) { + if (Tk_IdToWindow(display, w) != NULL) { return 0; } } @@ -280,7 +279,7 @@ ErrorProc( */ couldntHandle: - return (*defaultHandler)(display, errEventPtr); + return defaultHandler(display, errEventPtr); } /* diff --git a/generic/tkEvent.c b/generic/tkEvent.c index 03e7283..bcc6d98 100644 --- a/generic/tkEvent.c +++ b/generic/tkEvent.c @@ -73,7 +73,7 @@ typedef struct TkWindowEvent { * Array of event masks corresponding to each X event: */ -static unsigned long realEventMasks[MappingNotify+1] = { +static const unsigned long realEventMasks[MappingNotify+1] = { 0, 0, KeyPressMask, /* KeyPress */ @@ -114,7 +114,7 @@ static unsigned long realEventMasks[MappingNotify+1] = { 0 /* Mapping Notify */ }; -static unsigned long virtualEventMasks[TK_LASTEVENT-VirtualEvent] = { +static const unsigned long virtualEventMasks[TK_LASTEVENT-VirtualEvent] = { VirtualEventMask, /* VirtualEvents */ ActivateMask, /* ActivateNotify */ ActivateMask, /* DeactivateNotify */ @@ -245,16 +245,10 @@ InvokeFocusHandlers( } /* - * MouseWheel events are not focus specific on Mac OS X. + * Only key-related events are directed according to the focus. */ -#ifdef MAC_OSX_TK -#define FOCUS_DIRECTED_EVENT_MASK (KeyPressMask|KeyReleaseMask) -#else -#define FOCUS_DIRECTED_EVENT_MASK (KeyPressMask|KeyReleaseMask|MouseWheelMask) -#endif - - if (mask & FOCUS_DIRECTED_EVENT_MASK) { + if (mask & (KeyPressMask|KeyReleaseMask)) { (*winPtrPtr)->dispPtr->lastEventTime = eventPtr->xkey.time; *winPtrPtr = TkFocusKeyEvent(*winPtrPtr, eventPtr); if (*winPtrPtr == NULL) { @@ -326,7 +320,7 @@ InvokeMouseHandlers( *---------------------------------------------------------------------- */ -#if defined(TK_USE_INPUT_METHODS) +#ifdef TK_USE_INPUT_METHODS static void CreateXIC( TkWindow *winPtr) @@ -357,12 +351,12 @@ CreateXIC( XFree(preedit_attlist); } - + if (winPtr->inputContext == NULL) { /* XCreateIC failed. */ - return; + return; } - + /* * Adjust the window's event mask if the IM requires it. */ @@ -668,7 +662,7 @@ InvokeClientMessageHandlers( if (tmpPtr == NULL) { tsdPtr->lastCmPtr = prevPtr; } - (void) ckfree((char *) curPtr); + ckfree(curPtr); curPtr = tmpPtr; continue; } @@ -730,7 +724,7 @@ InvokeGenericHandlers( if (tmpPtr == NULL) { tsdPtr->lastGenericPtr = prevPtr; } - (void) ckfree((char *) curPtr); + ckfree(curPtr); curPtr = tmpPtr; continue; } @@ -738,7 +732,7 @@ InvokeGenericHandlers( int done; tsdPtr->handlersActive++; - done = (*curPtr->proc)(curPtr->clientData, eventPtr); + done = curPtr->proc(curPtr->clientData, eventPtr); tsdPtr->handlersActive--; if (done) { return done; @@ -794,7 +788,7 @@ Tk_CreateEventHandler( * No event handlers defined at all, so must create. */ - handlerPtr = (TkEventHandler *) ckalloc(sizeof(TkEventHandler)); + handlerPtr = ckalloc(sizeof(TkEventHandler)); winPtr->handlerList = handlerPtr; } else { int found = 0; @@ -825,8 +819,7 @@ Tk_CreateEventHandler( * No event handler matched, so create a new one. */ - handlerPtr->nextPtr = (TkEventHandler *) - ckalloc(sizeof(TkEventHandler)); + handlerPtr->nextPtr = ckalloc(sizeof(TkEventHandler)); handlerPtr = handlerPtr->nextPtr; } @@ -873,7 +866,7 @@ Tk_DeleteEventHandler( register InProgress *ipPtr; TkEventHandler *prevPtr; register TkWindow *winPtr = (TkWindow *) token; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -912,7 +905,7 @@ Tk_DeleteEventHandler( } else { prevPtr->nextPtr = handlerPtr->nextPtr; } - ckfree((char *) handlerPtr); + ckfree(handlerPtr); /* * No need to call XSelectInput: Tk always selects on all events for all @@ -945,10 +938,10 @@ Tk_CreateGenericHandler( ClientData clientData) /* One-word value to pass to proc. */ { GenericHandler *handlerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - handlerPtr = (GenericHandler *) ckalloc(sizeof(GenericHandler)); + handlerPtr = ckalloc(sizeof(GenericHandler)); handlerPtr->proc = proc; handlerPtr->clientData = clientData; @@ -986,7 +979,7 @@ Tk_DeleteGenericHandler( ClientData clientData) { GenericHandler * handler; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (handler=tsdPtr->genericList ; handler ; handler=handler->nextPtr) { @@ -1019,7 +1012,7 @@ Tk_CreateClientMessageHandler( Tk_ClientMessageProc *proc) /* Function to call on event. */ { GenericHandler *handlerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1027,7 +1020,7 @@ Tk_CreateClientMessageHandler( * with an extra clientData field we'll never use. */ - handlerPtr = (GenericHandler *) ckalloc(sizeof(GenericHandler)); + handlerPtr = ckalloc(sizeof(GenericHandler)); handlerPtr->proc = (Tk_GenericProc *) proc; handlerPtr->clientData = NULL; /* never used */ @@ -1065,7 +1058,7 @@ Tk_DeleteClientMessageHandler( Tk_ClientMessageProc *proc) { GenericHandler * handler; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (handler=tsdPtr->cmList ; handler!=NULL ; handler=handler->nextPtr) { @@ -1096,7 +1089,7 @@ Tk_DeleteClientMessageHandler( void TkEventInit(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->handlersActive = 0; @@ -1131,9 +1124,8 @@ TkXErrorHandler( ClientData clientData, /* Pointer to flag we set. */ XErrorEvent *errEventPtr) /* X error info. */ { - int *error; + int *error = clientData; - error = (int *) clientData; *error = 1; return 0; } @@ -1174,7 +1166,7 @@ ParentXId( gotXError = 0; handler = Tk_CreateErrorHandler(display, -1, -1, -1, - TkXErrorHandler, (ClientData) (&gotXError)); + TkXErrorHandler, &gotXError); /* * Get the parent window. @@ -1224,7 +1216,7 @@ Tk_HandleEvent( unsigned long mask; InProgress ip; Tcl_Interp *interp = NULL; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); UpdateButtonEventState(eventPtr); @@ -1278,7 +1270,7 @@ Tk_HandleEvent( * code. */ - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); result = ((InvokeFocusHandlers(&winPtr, mask, eventPtr)) || (InvokeMouseHandlers(winPtr, mask, eventPtr))); @@ -1307,7 +1299,7 @@ Tk_HandleEvent( XSetICFocus(winPtr->inputContext); } } -#endif +#endif /*TK_USE_INPUT_METHODS*/ /* * For events where it hasn't already been done, update the current time @@ -1338,15 +1330,15 @@ Tk_HandleEvent( Tk_InternAtom((Tk_Window) winPtr, "WM_PROTOCOLS")) { TkWmProtocolEventProc(winPtr, eventPtr); } else { - InvokeClientMessageHandlers(tsdPtr, (Tk_Window)winPtr, + InvokeClientMessageHandlers(tsdPtr, (Tk_Window) winPtr, eventPtr); } } } else { for (handlerPtr = winPtr->handlerList; handlerPtr != NULL; ) { - if ((handlerPtr->mask & mask) != 0) { + if (handlerPtr->mask & mask) { ip.nextHandler = handlerPtr->nextPtr; - (*(handlerPtr->proc))(handlerPtr->clientData, eventPtr); + handlerPtr->proc(handlerPtr->clientData, eventPtr); handlerPtr = ip.nextHandler; } else { handlerPtr = handlerPtr->nextPtr; @@ -1380,7 +1372,7 @@ Tk_HandleEvent( releaseInterpreter: if (interp != NULL) { - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } /* @@ -1418,7 +1410,7 @@ TkEventDeadWindow( { register TkEventHandler *handlerPtr; register InProgress *ipPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1439,7 +1431,7 @@ TkEventDeadWindow( ipPtr->winPtr = None; } } - ckfree((char *) handlerPtr); + ckfree(handlerPtr); } } @@ -1467,7 +1459,7 @@ TkCurrentTime( TkDisplay *dispPtr) /* Display for which the time is desired. */ { register XEvent *eventPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->pendingPtr == NULL) { @@ -1521,7 +1513,7 @@ Tk_RestrictEvents( * argument. */ { Tk_RestrictProc *prev; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); prev = tsdPtr->restrictProc; @@ -1614,7 +1606,7 @@ Tk_QueueWindowEvent( */ if (!(dispPtr->flags & TK_DISPLAY_COLLAPSE_MOTION_EVENTS)) { - wevPtr = (TkWindowEvent *) ckalloc(sizeof(TkWindowEvent)); + wevPtr = ckalloc(sizeof(TkWindowEvent)); wevPtr->header.proc = WindowEventProc; wevPtr->event = *eventPtr; Tcl_QueueEvent(&wevPtr->header, position); @@ -1642,11 +1634,11 @@ Tk_QueueWindowEvent( Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, position); dispPtr->delayedMotionPtr = NULL; - Tcl_CancelIdleCall(DelayedMotionProc, (ClientData) dispPtr); + Tcl_CancelIdleCall(DelayedMotionProc, dispPtr); } } - wevPtr = (TkWindowEvent *) ckalloc(sizeof(TkWindowEvent)); + wevPtr = ckalloc(sizeof(TkWindowEvent)); wevPtr->header.proc = WindowEventProc; wevPtr->event = *eventPtr; if ((eventPtr->type == MotionNotify) && (position == TCL_QUEUE_TAIL)) { @@ -1660,7 +1652,7 @@ Tk_QueueWindowEvent( Tcl_Panic("Tk_QueueWindowEvent found unexpected delayed motion event"); } dispPtr->delayedMotionPtr = wevPtr; - Tcl_DoWhenIdle(DelayedMotionProc, (ClientData) dispPtr); + Tcl_DoWhenIdle(DelayedMotionProc, dispPtr); } else { Tcl_QueueEvent(&wevPtr->header, position); } @@ -1736,14 +1728,14 @@ WindowEventProc( { TkWindowEvent *wevPtr = (TkWindowEvent *) evPtr; Tk_RestrictAction result; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!(flags & TCL_WINDOW_EVENTS)) { return 0; } if (tsdPtr->restrictProc != NULL) { - result = (*tsdPtr->restrictProc)(tsdPtr->restrictArg, &wevPtr->event); + result = tsdPtr->restrictProc(tsdPtr->restrictArg, &wevPtr->event); if (result != TK_PROCESS_EVENT) { if (result == TK_DEFER_EVENT) { return 0; @@ -1835,7 +1827,7 @@ DelayedMotionProc( ClientData clientData) /* Pointer to display containing a delayed * motion event to be serviced. */ { - TkDisplay *dispPtr = (TkDisplay *) clientData; + TkDisplay *dispPtr = clientData; if (dispPtr->delayedMotionPtr == NULL) { Tcl_Panic("DelayedMotionProc found no delayed mouse motion event"); @@ -1867,7 +1859,7 @@ TkCreateExitHandler( { ExitHandler *exitPtr; - exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler)); + exitPtr = ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; Tcl_MutexLock(&exitMutex); @@ -1932,7 +1924,7 @@ TkDeleteExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree((char *) exitPtr); + ckfree(exitPtr); break; } } @@ -1963,10 +1955,10 @@ TkCreateThreadExitHandler( ClientData clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler)); + exitPtr = ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; @@ -2004,7 +1996,7 @@ TkDeleteThreadExitHandler( ClientData clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL; @@ -2016,7 +2008,7 @@ TkDeleteThreadExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree((char *) exitPtr); + ckfree(exitPtr); return; } } @@ -2059,8 +2051,8 @@ TkFinalize( firstExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); - (*exitPtr->proc)(exitPtr->clientData); - ckfree((char *) exitPtr); + exitPtr->proc(exitPtr->clientData); + ckfree(exitPtr); Tcl_MutexLock(&exitMutex); } firstExitPtr = NULL; @@ -2073,7 +2065,7 @@ TkFinalize( * TkFinalizeThread -- * * Runs our private thread exit handlers and removes itself from Tcl. - * This is benificial should we want to protect from dangling pointers + * This is beneficial should we want to protect from dangling pointers * should the Tk shared library be unloaded prior to Tcl which can happen * on Windows should the process be forcefully exiting from an exception * handler. @@ -2092,7 +2084,7 @@ TkFinalizeThread( ClientData clientData) /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_DeleteThreadExitHandler(TkFinalizeThread, NULL); @@ -2109,8 +2101,8 @@ TkFinalizeThread( */ tsdPtr->firstExitPtr = exitPtr->nextPtr; - (*exitPtr->proc)(exitPtr->clientData); - ckfree((char *) exitPtr); + exitPtr->proc(exitPtr->clientData); + ckfree(exitPtr); } } } diff --git a/generic/tkFileFilter.c b/generic/tkFileFilter.c index 547dd9b..8588d70 100644 --- a/generic/tkFileFilter.c +++ b/generic/tkFileFilter.c @@ -13,13 +13,10 @@ #include "tkInt.h" #include "tkFileFilter.h" -static int AddClause(Tcl_Interp *interp, - FileFilter *filterPtr, Tcl_Obj *patternsObj, - Tcl_Obj *ostypesObj, int isWindows); -static void FreeClauses(FileFilter *filterPtr); -static void FreeGlobPatterns(FileFilterClause *clausePtr); -static void FreeMacFileTypes(FileFilterClause *clausePtr); -static FileFilter * GetFilter(FileFilterList *flistPtr, CONST char *name); +static int AddClause(Tcl_Interp *interp, FileFilter *filterPtr, + Tcl_Obj *patternsObj, Tcl_Obj *ostypesObj, + int isWindows); +static FileFilter * GetFilter(FileFilterList *flistPtr, const char *name); /* *---------------------------------------------------------------------- @@ -87,7 +84,7 @@ TkGetFileFilters( int i; if (types == NULL) { - return TCL_OK; + return TCL_OK; } if (Tcl_ListObjGetElements(interp, types, &listObjc, @@ -103,6 +100,7 @@ TkGetFileFilters( * the -filefilters option may have been used more than once in the * command line. */ + TkFreeFileFilters(flistPtr); for (i = 0; i<listObjc; i++) { @@ -122,10 +120,12 @@ TkGetFileFilters( } if (count != 2 && count != 3) { - Tcl_AppendResult(interp, "bad file type \"", - Tcl_GetString(listObjv[i]), "\", ", - "should be \"typeName {extension ?extensions ...?} ", - "?{macType ?macTypes ...?}?\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad file type \"%s\", should be " + "\"typeName {extension ?extensions ...?} " + "?{macType ?macTypes ...?}?\"", + Tcl_GetString(listObjv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FILE_TYPE", NULL); return TCL_ERROR; } @@ -160,15 +160,47 @@ void TkFreeFileFilters( FileFilterList *flistPtr) /* List of file filters to free */ { - FileFilter *filterPtr, *toFree; + FileFilter *filterPtr; + FileFilterClause *clausePtr; + GlobPattern *globPtr; + MacFileType *mfPtr; + register void *toFree; /* A pointer that we are about to free. */ + + for (filterPtr = flistPtr->filters; filterPtr != NULL; ) { + for (clausePtr = filterPtr->clauses; clausePtr != NULL; ) { + /* + * Squelch each of the glob patterns. + */ + + for (globPtr = clausePtr->patterns; globPtr != NULL; ) { + ckfree(globPtr->pattern); + toFree = globPtr; + globPtr = globPtr->next; + ckfree(toFree); + } + + /* + * Squelch each of the Mac file type codes. + */ + + for (mfPtr = clausePtr->macTypes; mfPtr != NULL; ) { + toFree = mfPtr; + mfPtr = mfPtr->next; + ckfree(toFree); + } + toFree = clausePtr; + clausePtr = clausePtr->next; + ckfree(toFree); + } + + /* + * Squelch the name of the filter and the overall structure. + */ - filterPtr=flistPtr->filters; - while (filterPtr != NULL) { + ckfree(filterPtr->name); toFree = filterPtr; filterPtr = filterPtr->next; - FreeClauses(toFree); - ckfree((char*)toFree->name); - ckfree((char*)toFree); + ckfree(toFree); } flistPtr->filters = NULL; } @@ -231,7 +263,7 @@ AddClause( for (i=0; i<ostypeCount; i++) { int len; - CONST char *strType = Tcl_GetStringFromObj(ostypeList[i], &len); + const char *strType = Tcl_GetStringFromObj(ostypeList[i], &len); /* * If len is < 4, it is definitely an error. If equal or longer, @@ -259,8 +291,10 @@ AddClause( Tcl_DStringFree(&osTypeDS); } if (len != 4) { - Tcl_AppendResult(interp, "bad Macintosh file type \"", - Tcl_GetString(ostypeList[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad Macintosh file type \"%s\"", + Tcl_GetString(ostypeList[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "MAC_TYPE", NULL); code = TCL_ERROR; goto done; } @@ -271,10 +305,10 @@ AddClause( * Add the clause into the list of clauses */ - clausePtr = (FileFilterClause*)ckalloc(sizeof(FileFilterClause)); - clausePtr->patterns = NULL; + clausePtr = ckalloc(sizeof(FileFilterClause)); + clausePtr->patterns = NULL; clausePtr->patternsTail = NULL; - clausePtr->macTypes = NULL; + clausePtr->macTypes = NULL; clausePtr->macTypesTail = NULL; if (filterPtr->clauses == NULL) { @@ -287,39 +321,38 @@ AddClause( if (globCount > 0 && globList != NULL) { for (i=0; i<globCount; i++) { - GlobPattern *globPtr = (GlobPattern*)ckalloc(sizeof(GlobPattern)); + GlobPattern *globPtr = ckalloc(sizeof(GlobPattern)); int len; + const char *str = Tcl_GetStringFromObj(globList[i], &len); - CONST char *str = Tcl_GetStringFromObj(globList[i], &len); len = (len + 1) * sizeof(char); - if (str[0] && str[0] != '*') { /* * Prepend a "*" to patterns that do not have a leading "*" */ - globPtr->pattern = (char*)ckalloc((unsigned int) len+1); + globPtr->pattern = ckalloc(len + 1); globPtr->pattern[0] = '*'; strcpy(globPtr->pattern+1, str); } else if (isWindows) { if (strcmp(str, "*") == 0) { - globPtr->pattern = (char*)ckalloc(4 * sizeof(char)); + globPtr->pattern = ckalloc(4); strcpy(globPtr->pattern, "*.*"); } else if (strcmp(str, "") == 0) { /* * An empty string means "match all files with no * extensions" - * BUG: "*." actually matches with all files on Win95 + * TODO: "*." actually matches with all files on Win95 */ - globPtr->pattern = (char *) ckalloc(3 * sizeof(char)); + globPtr->pattern = ckalloc(3); strcpy(globPtr->pattern, "*."); } else { - globPtr->pattern = (char *) ckalloc((unsigned int) len); + globPtr->pattern = ckalloc(len); strcpy(globPtr->pattern, str); } } else { - globPtr->pattern = (char *) ckalloc((unsigned int) len); + globPtr->pattern = ckalloc(len); strcpy(globPtr->pattern, str); } @@ -343,8 +376,8 @@ AddClause( for (i=0; i<ostypeCount; i++) { Tcl_DString osTypeDS; int len; - MacFileType *mfPtr = (MacFileType *) ckalloc(sizeof(MacFileType)); - CONST char *strType = Tcl_GetStringFromObj(ostypeList[i], &len); + MacFileType *mfPtr = ckalloc(sizeof(MacFileType)); + const char *strType = Tcl_GetStringFromObj(ostypeList[i], &len); char *string; /* @@ -399,11 +432,12 @@ static FileFilter * GetFilter( FileFilterList *flistPtr, /* The FileFilterList that contains the newly * created filter */ - CONST char *name) /* Name of the filter. It is usually displayed + const char *name) /* Name of the filter. It is usually displayed * in the "File Types" listbox in the file * dialogs. */ { FileFilter *filterPtr = flistPtr->filters; + size_t len; for (; filterPtr; filterPtr=filterPtr->next) { if (strcmp(filterPtr->name, name) == 0) { @@ -411,11 +445,12 @@ GetFilter( } } - filterPtr = (FileFilter *) ckalloc(sizeof(FileFilter)); + filterPtr = ckalloc(sizeof(FileFilter)); filterPtr->clauses = NULL; filterPtr->clausesTail = NULL; - filterPtr->name = (char *) ckalloc((strlen(name)+1) * sizeof(char)); - strcpy(filterPtr->name, name); + len = strlen(name) + 1; + filterPtr->name = ckalloc(len); + memcpy(filterPtr->name, name, len); if (flistPtr->filters == NULL) { flistPtr->filters = flistPtr->filtersTail = filterPtr; @@ -430,103 +465,6 @@ GetFilter( } /* - *---------------------------------------------------------------------- - * - * FreeClauses -- - * - * Frees the malloc'ed file type clause - * - * Results: - * None. - * - * Side effects: - * The list of clauses in filterPtr->clauses are freed. - * - *---------------------------------------------------------------------- - */ - -static void -FreeClauses( - FileFilter *filterPtr) /* FileFilter whose clauses are to be freed */ -{ - FileFilterClause *clausePtr = filterPtr->clauses; - - while (clausePtr != NULL) { - FileFilterClause *toFree = clausePtr; - clausePtr = clausePtr->next; - - FreeGlobPatterns(toFree); - FreeMacFileTypes(toFree); - ckfree((char *) toFree); - } - filterPtr->clauses = NULL; - filterPtr->clausesTail = NULL; -} - -/* - *---------------------------------------------------------------------- - * - * FreeGlobPatterns -- - * - * Frees the malloc'ed glob patterns in a clause - * - * Results: - * None. - * - * Side effects: - * The list of glob patterns in clausePtr->patterns are freed. - * - *---------------------------------------------------------------------- - */ - -static void -FreeGlobPatterns( - FileFilterClause *clausePtr)/* The clause whose patterns are to be freed*/ -{ - GlobPattern *globPtr = clausePtr->patterns; - - while (globPtr != NULL) { - GlobPattern *toFree = globPtr; - globPtr = globPtr->next; - - ckfree((char *) toFree->pattern); - ckfree((char *) toFree); - } - clausePtr->patterns = NULL; -} - -/* - *---------------------------------------------------------------------- - * - * FreeMacFileTypes -- - * - * Frees the malloc'ed Mac file types in a clause - * - * Results: - * None. - * - * Side effects: - * The list of Mac file types in clausePtr->macTypes are freed. - * - *---------------------------------------------------------------------- - */ - -static void -FreeMacFileTypes( - FileFilterClause *clausePtr)/* The clause whose mac types are to be - * freed */ -{ - MacFileType *mfPtr = clausePtr->macTypes; - - while (mfPtr != NULL) { - MacFileType *toFree = mfPtr; - mfPtr = mfPtr->next; - ckfree((char *) toFree); - } - clausePtr->macTypes = NULL; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tkFileFilter.h b/generic/tkFileFilter.h index 24002df..131e423 100644 --- a/generic/tkFileFilter.h +++ b/generic/tkFileFilter.h @@ -15,11 +15,6 @@ #define OSType long -#ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif - typedef struct GlobPattern { struct GlobPattern *next; /* Chains to the next glob pattern in a glob * pattern list */ @@ -80,6 +75,4 @@ MODULE_SCOPE int TkGetFileFilters(Tcl_Interp *interp, FileFilterList *flistPtr, Tcl_Obj *valuePtr, int isWindows); -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT -#endif +#endif /* _TK_FILE_FILTER */ diff --git a/generic/tkFocus.c b/generic/tkFocus.c index 85093ee..60f631d 100644 --- a/generic/tkFocus.c +++ b/generic/tkFocus.c @@ -68,14 +68,6 @@ typedef struct TkDisplayFocusInfo { } DisplayFocusInfo; /* - * The following magic value is stored in the "send_event" field of FocusIn - * and FocusOut events that are generated in this file. This allows us to - * separate "real" events coming from the server from those that we generated. - */ - -#define GENERATED_EVENT_MAGIC ((Bool) 0x547321ac) - -/* * Debugging support... */ @@ -116,16 +108,16 @@ Tk_FocusObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static CONST char *focusOptions[] = { + static const char *const focusOptions[] = { "-displayof", "-force", "-lastfor", NULL }; - Tk_Window tkwin = (Tk_Window) clientData; - TkWindow *winPtr = (TkWindow *) clientData; - TkWindow *newPtr, *focusWinPtr, *topLevelPtr; + Tk_Window tkwin = clientData; + TkWindow *winPtr = clientData; + TkWindow *newPtr, *topLevelPtr; ToplevelFocusInfo *tlFocusPtr; - char *windowName; + const char *windowName; int index; /* @@ -133,9 +125,10 @@ Tk_FocusObjCmd( */ if (objc == 1) { - focusWinPtr = TkGetFocusWin(winPtr); - if (focusWinPtr != NULL) { - Tcl_SetResult(interp, focusWinPtr->pathName, TCL_STATIC); + Tk_Window focusWin = (Tk_Window) TkGetFocusWin(winPtr); + + if (focusWin != NULL) { + Tcl_SetObjResult(interp, TkNewWindowObj(focusWin)); } return TCL_OK; } @@ -169,8 +162,8 @@ Tk_FocusObjCmd( * We have a subcommand to parse and act upon. */ - if (Tcl_GetIndexFromObj(interp, objv[1], focusOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], focusOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (objc != 3) { @@ -186,7 +179,7 @@ Tk_FocusObjCmd( } newPtr = TkGetFocusWin(newPtr); if (newPtr != NULL) { - Tcl_SetResult(interp, newPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) newPtr)); } break; case 1: /* -force */ @@ -212,19 +205,19 @@ Tk_FocusObjCmd( return TCL_ERROR; } for (topLevelPtr = newPtr; topLevelPtr != NULL; - topLevelPtr = topLevelPtr->parentPtr) { + topLevelPtr = topLevelPtr->parentPtr) { if (!(topLevelPtr->flags & TK_TOP_HIERARCHY)) { continue; } for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL; tlFocusPtr = tlFocusPtr->nextPtr) { if (tlFocusPtr->topLevelPtr == topLevelPtr) { - Tcl_SetResult(interp, - tlFocusPtr->focusWinPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) + tlFocusPtr->focusWinPtr)); return TCL_OK; } } - Tcl_SetResult(interp, topLevelPtr->pathName, TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) topLevelPtr)); return TCL_OK; } break; @@ -286,7 +279,7 @@ TkFocusFilterEvent( * pass the event through to Tk bindings. */ - if (eventPtr->xfocus.send_event == GENERATED_EVENT_MAGIC) { + if (eventPtr->xfocus.send_event == GENERATED_FOCUS_EVENT_MAGIC) { eventPtr->xfocus.send_event = 0; return 1; } @@ -389,7 +382,7 @@ TkFocusFilterEvent( * tree, then ignore the event. */ - if (TkGrabState(winPtr) == TK_GRAB_EXCLUDED) { + if (TkGrabState(winPtr) == TK_GRAB_EXCLUDED) { return retValue; } @@ -422,7 +415,7 @@ TkFocusFilterEvent( } } if (tlFocusPtr == NULL) { - tlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo)); + tlFocusPtr = ckalloc(sizeof(ToplevelFocusInfo)); tlFocusPtr->topLevelPtr = tlFocusPtr->focusWinPtr = winPtr; tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr; winPtr->mainPtr->tlFocusPtr = tlFocusPtr; @@ -496,14 +489,14 @@ TkFocusFilterEvent( } else if (eventPtr->type == LeaveNotify) { /* * If the pointer just left a window for which we automatically - * claimed the focus on enter, move the focus back to the root - * window, where it was before we claimed it above. Note: + * claimed the focus on enter, move the focus back to the root window, + * where it was before we claimed it above. Note: * dispPtr->implicitWinPtr may not be the same as - * displayFocusPtr->focusWinPtr (e.g. because the "focus" command - * was used to redirect the focus after it arrived at - * dispPtr->implicitWinPtr)!! In addition, we generate events - * because the window manager won't give us a FocusOut event when - * we focus on the root. + * displayFocusPtr->focusWinPtr (e.g. because the "focus" command was + * used to redirect the focus after it arrived at + * dispPtr->implicitWinPtr)!! In addition, we generate events because + * the window manager won't give us a FocusOut event when we focus on + * the root. */ if ((dispPtr->implicitWinPtr != NULL) @@ -577,7 +570,7 @@ TkSetFocusWin( */ allMapped = 1; - for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) { + for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) { if (topLevelPtr == NULL) { /* * The window is being deleted. No point in worrying about giving @@ -603,16 +596,14 @@ TkSetFocusWin( */ if (displayFocusPtr->focusOnMapPtr != NULL) { - Tk_DeleteEventHandler( - (Tk_Window) displayFocusPtr->focusOnMapPtr, + Tk_DeleteEventHandler((Tk_Window) displayFocusPtr->focusOnMapPtr, StructureNotifyMask, FocusMapProc, - (ClientData) displayFocusPtr->focusOnMapPtr); + displayFocusPtr->focusOnMapPtr); displayFocusPtr->focusOnMapPtr = NULL; } if (!allMapped) { - Tk_CreateEventHandler((Tk_Window) winPtr, - VisibilityChangeMask, FocusMapProc, - (ClientData) winPtr); + Tk_CreateEventHandler((Tk_Window) winPtr, VisibilityChangeMask, + FocusMapProc, winPtr); displayFocusPtr->focusOnMapPtr = winPtr; displayFocusPtr->forceFocus = force; return; @@ -625,7 +616,7 @@ TkSetFocusWin( } } if (tlFocusPtr == NULL) { - tlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo)); + tlFocusPtr = ckalloc(sizeof(ToplevelFocusInfo)); tlFocusPtr->topLevelPtr = topLevelPtr; tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr; winPtr->mainPtr->tlFocusPtr = tlFocusPtr; @@ -849,7 +840,7 @@ TkFocusDeadWindow( } else { prevPtr->nextPtr = tlFocusPtr->nextPtr; } - ckfree((char *) tlFocusPtr); + ckfree(tlFocusPtr); break; } else if (winPtr == tlFocusPtr->focusWinPtr) { /* @@ -922,7 +913,7 @@ GenerateFocusEvents( } event.xfocus.serial = LastKnownRequestProcessed(winPtr->display); - event.xfocus.send_event = GENERATED_EVENT_MAGIC; + event.xfocus.send_event = GENERATED_FOCUS_EVENT_MAGIC; event.xfocus.display = winPtr->display; event.xfocus.mode = NotifyNormal; TkInOutEvents(&event, sourcePtr, destPtr, FocusOut, FocusIn, @@ -955,7 +946,7 @@ FocusMapProc( ClientData clientData, /* Toplevel window. */ XEvent *eventPtr) /* Information about event. */ { - TkWindow *winPtr = (TkWindow *) clientData; + TkWindow *winPtr = clientData; DisplayFocusInfo *displayFocusPtr; if (eventPtr->type == VisibilityNotify) { @@ -1009,7 +1000,7 @@ FindDisplayFocusInfo( * The record doesn't exist yet. Make a new one. */ - displayFocusPtr = (DisplayFocusInfo *) ckalloc(sizeof(DisplayFocusInfo)); + displayFocusPtr = ckalloc(sizeof(DisplayFocusInfo)); displayFocusPtr->dispPtr = dispPtr; displayFocusPtr->focusWinPtr = NULL; displayFocusPtr->focusOnMapPtr = NULL; @@ -1045,13 +1036,13 @@ TkFocusFree( DisplayFocusInfo *displayFocusPtr = mainPtr->displayFocusPtr; mainPtr->displayFocusPtr = mainPtr->displayFocusPtr->nextPtr; - ckfree((char *) displayFocusPtr); + ckfree(displayFocusPtr); } while (mainPtr->tlFocusPtr != NULL) { ToplevelFocusInfo *tlFocusPtr = mainPtr->tlFocusPtr; mainPtr->tlFocusPtr = mainPtr->tlFocusPtr->nextPtr; - ckfree((char *) tlFocusPtr); + ckfree(tlFocusPtr); } } @@ -1060,8 +1051,8 @@ TkFocusFree( * * TkFocusSplit -- * - * Adjust focus window for a newly managed toplevel, thus splitting - * the toplevel into two toplevels. + * Adjust focus window for a newly managed toplevel, thus splitting the + * toplevel into two toplevels. * * Results: * None. @@ -1073,29 +1064,29 @@ TkFocusFree( */ void -TkFocusSplit(winPtr) - TkWindow *winPtr; /* Window is the new toplevel - * Any focus point at or below window - * must be moved to this new toplevel */ +TkFocusSplit( + TkWindow *winPtr) /* Window is the new toplevel. Any focus point + * at or below window must be moved to this + * new toplevel. */ { ToplevelFocusInfo *tlFocusPtr; - TkWindow *topLevelPtr; - TkWindow *subWinPtr; + TkWindow *topLevelPtr, *subWinPtr; FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr); /* - * Find the top-level window for winPtr, then find (or create) - * a record for the top-level. Also see whether winPtr and all its - * ancestors are mapped. + * Find the top-level window for winPtr, then find (or create) a record + * for the top-level. Also see whether winPtr and all its ancestors are + * mapped. */ - for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) { + for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) { if (topLevelPtr == NULL) { /* - * The window is being deleted. No point in worrying about - * giving it the focus. + * The window is being deleted. No point in worrying about giving + * it the focus. */ + return; } if (topLevelPtr->flags & TK_TOP_HIERARCHY) { @@ -1103,37 +1094,57 @@ TkFocusSplit(winPtr) } } - /* Search all focus records to find child windows of winPtr */ + /* + * Search all focus records to find child windows of winPtr. + */ + for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL; - tlFocusPtr = tlFocusPtr->nextPtr) { + tlFocusPtr = tlFocusPtr->nextPtr) { if (tlFocusPtr->topLevelPtr == topLevelPtr) { break; } } if (tlFocusPtr == NULL) { - /* No focus record for this toplevel, nothing to do. */ + /* + * No focus record for this toplevel, nothing to do. + */ + return; } - /* See if current focusWin is child of the new toplevel */ - for (subWinPtr = tlFocusPtr->focusWinPtr; - subWinPtr && subWinPtr != winPtr && subWinPtr != topLevelPtr; - subWinPtr = subWinPtr->parentPtr) {} + /* + * See if current focusWin is child of the new toplevel. + */ + + for (subWinPtr = tlFocusPtr->focusWinPtr; + subWinPtr && subWinPtr != winPtr && subWinPtr != topLevelPtr; + subWinPtr = subWinPtr->parentPtr) { + /* EMPTY */ + } if (subWinPtr == winPtr) { - /* Move focus to new toplevel */ - ToplevelFocusInfo *newTlFocusPtr; + /* + * Move focus to new toplevel. + */ + + ToplevelFocusInfo *newTlFocusPtr = ckalloc(sizeof(ToplevelFocusInfo)); - newTlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo)); newTlFocusPtr->topLevelPtr = winPtr; newTlFocusPtr->focusWinPtr = tlFocusPtr->focusWinPtr; newTlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr; winPtr->mainPtr->tlFocusPtr = newTlFocusPtr; - /* Move old toplevel's focus to the toplevel itself */ + + /* + * Move old toplevel's focus to the toplevel itself. + */ + tlFocusPtr->focusWinPtr = topLevelPtr; } - /* If it's not, then let focus progress naturally */ + + /* + * If it's not, then let focus progress naturally. + */ } /* @@ -1153,28 +1164,28 @@ TkFocusSplit(winPtr) */ void -TkFocusJoin(winPtr) - TkWindow *winPtr; /* Window is no longer a toplevel */ +TkFocusJoin( + TkWindow *winPtr) /* Window is no longer a toplevel. */ { - ToplevelFocusInfo *tlFocusPtr; - ToplevelFocusInfo *tmpPtr; + ToplevelFocusInfo *tlFocusPtr, *tmpPtr; /* * Remove old toplevel record */ + if (winPtr && winPtr->mainPtr && winPtr->mainPtr->tlFocusPtr - && winPtr->mainPtr->tlFocusPtr->topLevelPtr == winPtr) { + && winPtr->mainPtr->tlFocusPtr->topLevelPtr == winPtr) { tmpPtr = winPtr->mainPtr->tlFocusPtr; winPtr->mainPtr->tlFocusPtr = tmpPtr->nextPtr; - ckfree((char *)tmpPtr); - } else { + ckfree(tmpPtr); + } else if (winPtr && winPtr->mainPtr) { for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL; - tlFocusPtr = tlFocusPtr->nextPtr) { + tlFocusPtr = tlFocusPtr->nextPtr) { if (tlFocusPtr->nextPtr && - tlFocusPtr->nextPtr->topLevelPtr == winPtr) { + tlFocusPtr->nextPtr->topLevelPtr == winPtr) { tmpPtr = tlFocusPtr->nextPtr; tlFocusPtr->nextPtr = tmpPtr->nextPtr; - ckfree((char *)tmpPtr); + ckfree(tmpPtr); break; } } diff --git a/generic/tkFont.c b/generic/tkFont.c index 7ff1ae9..102fc6e 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -163,7 +163,7 @@ static const TkStateMap xlfdSetwidthMap[] = { * configuring a set of font attributes. */ -static const char *fontOpt[] = { +static const char *const fontOpt[] = { "-family", "-size", "-weight", @@ -188,27 +188,27 @@ static const char *fontOpt[] = { * the alias list are also automatically tried. */ -static char *timesAliases[] = { +static const char *const timesAliases[] = { "Times", /* Unix. */ "Times New Roman", /* Windows. */ "New York", /* Mac. */ NULL }; -static char *helveticaAliases[] = { +static const char *const helveticaAliases[] = { "Helvetica", /* Unix. */ "Arial", /* Windows. */ "Geneva", /* Mac. */ NULL }; -static char *courierAliases[] = { +static const char *const courierAliases[] = { "Courier", /* Unix and Mac. */ "Courier New", /* Windows. */ NULL }; -static char *minchoAliases[] = { +static const char *const minchoAliases[] = { "mincho", /* Unix. */ "\357\274\255\357\274\263 \346\230\216\346\234\235", /* Windows (MS mincho). */ @@ -217,7 +217,7 @@ static char *minchoAliases[] = { NULL }; -static char *gothicAliases[] = { +static const char *const gothicAliases[] = { "gothic", /* Unix. */ "\357\274\255\357\274\263 \343\202\264\343\202\267\343\203\203\343\202\257", /* Windows (MS goshikku). */ @@ -226,7 +226,7 @@ static char *gothicAliases[] = { NULL }; -static char *dingbatsAliases[] = { +static const char *const dingbatsAliases[] = { "dingbats", "zapfdingbats", "itc zapfdingbats", /* Unix. */ /* Windows. */ @@ -234,7 +234,7 @@ static char *dingbatsAliases[] = { NULL }; -static char **fontAliases[] = { +static const char *const *const fontAliases[] = { timesAliases, helveticaAliases, courierAliases, @@ -250,7 +250,7 @@ static char **fontAliases[] = { * be examined also. */ -static char *systemClass[] = { +static const char *const systemClass[] = { "fixed", /* Unix. */ /* Windows. */ "chicago", "osaka", "sistemny", @@ -258,7 +258,7 @@ static char *systemClass[] = { NULL }; -static char *serifClass[] = { +static const char *const serifClass[] = { "times", "palatino", "mincho", /* All platforms. */ "song ti", /* Unix. */ @@ -268,7 +268,7 @@ static char *serifClass[] = { NULL }; -static char *sansClass[] = { +static const char *const sansClass[] = { "helvetica", "gothic", /* All platforms. */ /* Unix. */ "ms sans serif", "traditional arabic", @@ -277,7 +277,7 @@ static char *sansClass[] = { NULL }; -static char *monoClass[] = { +static const char *const monoClass[] = { "courier", "gothic", /* All platforms. */ "fangsong ti", /* Unix. */ "simplified arabic fixed", /* Windows. */ @@ -285,11 +285,11 @@ static char *monoClass[] = { NULL }; -static char *symbolClass[] = { +static const char *const symbolClass[] = { "symbol", "dingbats", "wingdings", NULL }; -static char **fontFallbacks[] = { +static const char *const *const fontFallbacks[] = { systemClass, serifClass, sansClass, @@ -304,7 +304,7 @@ static char **fontFallbacks[] = { * found, all font families in the system are examined. */ -static char *globalFontClass[] = { +static const char *const globalFontClass[] = { "symbol", /* All platforms. */ /* Unix. */ "lucida sans unicode", /* Windows. */ @@ -325,6 +325,7 @@ static int ConfigAttributesObj(Tcl_Interp *interp, TkFontAttributes *faPtr); static void DupFontObjProc(Tcl_Obj *srcObjPtr, Tcl_Obj *dupObjPtr); static int FieldSpecified(const char *field); +static void FreeFontObj(Tcl_Obj *objPtr); static void FreeFontObjProc(Tcl_Obj *objPtr); static int GetAttributeInfoObj(Tcl_Interp *interp, const TkFontAttributes *faPtr, Tcl_Obj *objPtr); @@ -345,7 +346,7 @@ static void UpdateDependentFonts(TkFontInfo *fiPtr, * font object points to the TkFont structure for the font, or NULL. */ -Tcl_ObjType tkFontObjType = { +const Tcl_ObjType tkFontObjType = { "font", /* name */ FreeFontObjProc, /* freeIntRepProc */ DupFontObjProc, /* dupIntRepProc */ @@ -376,9 +377,8 @@ void TkFontPkgInit( TkMainInfo *mainPtr) /* The application being created. */ { - TkFontInfo *fiPtr; + TkFontInfo *fiPtr = ckalloc(sizeof(TkFontInfo)); - fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo)); Tcl_InitHashTable(&fiPtr->fontCache, TCL_STRING_KEYS); Tcl_InitHashTable(&fiPtr->namedTable, TCL_STRING_KEYS); fiPtr->mainPtr = mainPtr; @@ -410,21 +410,18 @@ void TkFontPkgFree( TkMainInfo *mainPtr) /* The application being deleted. */ { - TkFontInfo *fiPtr; + TkFontInfo *fiPtr = mainPtr->fontInfoPtr; Tcl_HashEntry *hPtr, *searchPtr; Tcl_HashSearch search; - int fontsLeft; + int fontsLeft = 0; - fiPtr = mainPtr->fontInfoPtr; - - fontsLeft = 0; for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search); searchPtr != NULL; searchPtr = Tcl_NextHashEntry(&search)) { fontsLeft++; #ifdef DEBUG_FONTS fprintf(stderr, "Font %s still in cache.\n", - Tcl_GetHashKey(&fiPtr->fontCache, searchPtr)); + (char *) Tcl_GetHashKey(&fiPtr->fontCache, searchPtr)); #endif } @@ -438,14 +435,14 @@ TkFontPkgFree( hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search); while (hPtr != NULL) { - ckfree((char *) Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); hPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&fiPtr->namedTable); - if (fiPtr->updatePending != 0) { - Tcl_CancelIdleCall(TheWorldHasChanged, (ClientData) fiPtr); + if (fiPtr->updatePending) { + Tcl_CancelIdleCall(TheWorldHasChanged, fiPtr); } - ckfree((char *) fiPtr); + ckfree(fiPtr); } /* @@ -473,9 +470,9 @@ Tk_FontObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int index; - Tk_Window tkwin; - TkFontInfo *fiPtr; - static const char *optionStrings[] = { + Tk_Window tkwin = clientData; + TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; + static const char *const optionStrings[] = { "actual", "configure", "create", "delete", "families", "measure", "metrics", "names", NULL @@ -485,9 +482,6 @@ Tk_FontObjCmd( FONT_FAMILIES, FONT_MEASURE, FONT_METRICS, FONT_NAMES }; - tkwin = (Tk_Window) clientData; - fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; - if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; @@ -528,7 +522,7 @@ Tk_FontObjCmd( s = Tcl_GetString(objv[n]); if (s[0] == '-' && s[1] != '-') { optPtr = objv[n]; - ++n; + n++; } else { optPtr = NULL; } @@ -540,7 +534,7 @@ Tk_FontObjCmd( if (n < objc) { if (!strcmp(Tcl_GetString(objv[n]), "--")) { - ++n; + n++; } } @@ -550,7 +544,7 @@ Tk_FontObjCmd( if (n < objc) { charPtr = objv[n]; - ++n; + n++; } /* @@ -575,6 +569,7 @@ Tk_FontObjCmd( -1, 40, "..."); Tcl_AppendToObj(resultPtr, "\"", -1); Tcl_SetObjResult(interp, resultPtr); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FONT_SAMPLE", NULL); return TCL_ERROR; } uniChar = Tcl_GetUniChar(charPtr, 0); @@ -605,47 +600,47 @@ Tk_FontObjCmd( return result; } case FONT_CONFIGURE: { - int result; - char *string; - Tcl_Obj *objPtr; - NamedFont *nfPtr; - Tcl_HashEntry *namedHashPtr; - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?"); - return TCL_ERROR; - } - string = Tcl_GetString(objv[2]); - namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string); + int result; + const char *string; + Tcl_Obj *objPtr; + NamedFont *nfPtr; + Tcl_HashEntry *namedHashPtr; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "fontname ?-option value ...?"); + return TCL_ERROR; + } + string = Tcl_GetString(objv[2]); + namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string); nfPtr = NULL; /* lint. */ - if (namedHashPtr != NULL) { - nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); - } - if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) { - Tcl_AppendResult(interp, "named font \"", string, - "\" doesn't exist", NULL); - return TCL_ERROR; - } - if (objc == 3) { - objPtr = NULL; - } else if (objc == 4) { - objPtr = objv[3]; - } else { - result = ConfigAttributesObj(interp, tkwin, objc - 3, objv + 3, - &nfPtr->fa); - UpdateDependentFonts(fiPtr, tkwin, namedHashPtr); - return result; - } - return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr); - } + if (namedHashPtr != NULL) { + nfPtr = Tcl_GetHashValue(namedHashPtr); + } + if ((namedHashPtr == NULL) || nfPtr->deletePending) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" doesn't exist", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); + return TCL_ERROR; + } + if (objc == 3) { + objPtr = NULL; + } else if (objc == 4) { + objPtr = objv[3]; + } else { + result = ConfigAttributesObj(interp, tkwin, objc - 3, objv + 3, + &nfPtr->fa); + UpdateDependentFonts(fiPtr, tkwin, namedHashPtr); + return result; + } + return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr); + } case FONT_CREATE: { - int skip, i; - char *name; + int skip = 3, i; + const char *name; char buf[16 + TCL_INTEGER_SPACE]; TkFontAttributes fa; Tcl_HashEntry *namedHashPtr; - skip = 3; if (objc < 3) { name = NULL; } else { @@ -677,12 +672,12 @@ Tk_FontObjCmd( if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) { return TCL_ERROR; } - Tcl_AppendResult(interp, name, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); break; } case FONT_DELETE: { int i, result = TCL_OK; - char *string; + const char *string; /* * Delete the named font. If there are still widgets using this font, @@ -693,16 +688,15 @@ Tk_FontObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?"); return TCL_ERROR; } - for (i = 2; i < objc && result == TCL_OK; i++) { + for (i = 2; (i < objc) && (result == TCL_OK); i++) { string = Tcl_GetString(objv[i]); result = TkDeleteNamedFont(interp, tkwin, string); } return result; } case FONT_FAMILIES: { - int skip; + int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); - skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); if (skip < 0) { return TCL_ERROR; } @@ -714,10 +708,9 @@ Tk_FontObjCmd( break; } case FONT_MEASURE: { - char *string; + const char *string; Tk_Font tkfont; int length = 0, skip = 0; - Tcl_Obj *resultPtr; if (objc > 4) { skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin); @@ -726,7 +719,8 @@ Tk_FontObjCmd( } } if (objc - skip != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "font ?-displayof window? text"); + Tcl_WrongNumArgs(interp, 2, objv, + "font ?-displayof window? text"); return TCL_ERROR; } tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]); @@ -734,8 +728,8 @@ Tk_FontObjCmd( return TCL_ERROR; } string = Tcl_GetStringFromObj(objv[3 + skip], &length); - resultPtr = Tcl_GetObjResult(interp); - Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tk_TextWidth(tkfont, string, length))); Tk_FreeFont(tkfont); break; } @@ -743,7 +737,7 @@ Tk_FontObjCmd( Tk_Font tkfont; int skip, index, i; const TkFontMetrics *fmPtr; - static const char *switches[] = { + static const char *const switches[] = { "-ascent", "-descent", "-linespace", "-fixed", NULL }; @@ -764,12 +758,10 @@ Tk_FontObjCmd( objv += skip; fmPtr = GetFontMetrics(tkfont); if (objc == 3) { - char buf[64 + TCL_INTEGER_SPACE * 4]; - - sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-ascent %d -descent %d -linespace %d -fixed %d", fmPtr->ascent, fmPtr->descent, - fmPtr->ascent + fmPtr->descent, fmPtr->fixed); - Tcl_AppendResult(interp, buf, NULL); + fmPtr->ascent + fmPtr->descent, fmPtr->fixed)); } else { if (Tcl_GetIndexFromObj(interp, objv[3], switches, "metric", 0, &index) != TCL_OK) { @@ -783,33 +775,35 @@ Tk_FontObjCmd( case 2: i = fmPtr->ascent + fmPtr->descent; break; case 3: i = fmPtr->fixed; break; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), i); + Tcl_SetObjResult(interp, Tcl_NewIntObj(i)); } Tk_FreeFont(tkfont); break; } case FONT_NAMES: { - char *string; - NamedFont *nfPtr; Tcl_HashSearch search; Tcl_HashEntry *namedHashPtr; - Tcl_Obj *strPtr, *resultPtr; + Tcl_Obj *resultPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "names"); return TCL_ERROR; } - resultPtr = Tcl_GetObjResult(interp); + resultPtr = Tcl_NewObj(); namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search); while (namedHashPtr != NULL) { - nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); - if (nfPtr->deletePending == 0) { - string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr); - strPtr = Tcl_NewStringObj(string, -1); - Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); + NamedFont *nfPtr = Tcl_GetHashValue(namedHashPtr); + + if (!nfPtr->deletePending) { + char *string = Tcl_GetHashKey(&fiPtr->namedTable, + namedHashPtr); + + Tcl_ListObjAppendElement(NULL, resultPtr, + Tcl_NewStringObj(string, -1)); } namedHashPtr = Tcl_NextHashEntry(&search); } + Tcl_SetObjResult(interp, resultPtr); break; } } @@ -844,9 +838,8 @@ UpdateDependentFonts( Tcl_HashEntry *cacheHashPtr; Tcl_HashSearch search; TkFont *fontPtr; - NamedFont *nfPtr; + NamedFont *nfPtr = Tcl_GetHashValue(namedHashPtr); - nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); if (nfPtr->refCount == 0) { /* * Well nobody's using this named font, so don't have to tell any @@ -858,13 +851,13 @@ UpdateDependentFonts( cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search); while (cacheHashPtr != NULL) { - for (fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr); + for (fontPtr = Tcl_GetHashValue(cacheHashPtr); fontPtr != NULL; fontPtr = fontPtr->nextPtr) { if (fontPtr->namedHashPtr == namedHashPtr) { TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa); - if (fiPtr->updatePending == 0) { + if (!fiPtr->updatePending) { fiPtr->updatePending = 1; - Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr); + Tcl_DoWhenIdle(TheWorldHasChanged, fiPtr); } } } @@ -876,11 +869,9 @@ static void TheWorldHasChanged( ClientData clientData) /* Info about application's fonts. */ { - TkFontInfo *fiPtr; + TkFontInfo *fiPtr = clientData; - fiPtr = (TkFontInfo *) clientData; fiPtr->updatePending = 0; - RecomputeWidgets(fiPtr->mainPtr->winPtr); } @@ -888,10 +879,11 @@ static void RecomputeWidgets( TkWindow *winPtr) /* Window to which command is sent. */ { - Tk_ClassWorldChangedProc *proc; - proc = Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc); + Tk_ClassWorldChangedProc *proc = + Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc); + if (proc != NULL) { - (*proc)(winPtr->instanceData); + proc(winPtr->instanceData); } /* @@ -949,21 +941,19 @@ TkCreateNamedFont( const char *name, /* Name for the new named font. */ TkFontAttributes *faPtr) /* Attributes for the new named font. */ { - TkFontInfo *fiPtr; + TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; Tcl_HashEntry *namedHashPtr; int isNew; NamedFont *nfPtr; - fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; - namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &isNew); - if (!isNew) { - nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); - if (nfPtr->deletePending == 0) { + nfPtr = Tcl_GetHashValue(namedHashPtr); + if (!nfPtr->deletePending) { if (interp) { - Tcl_AppendResult(interp, "named font \"", name, - "\" already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" already exists", name)); + Tcl_SetErrorCode(interp, "TK", "FONT", "EXISTS", NULL); } return TCL_ERROR; } @@ -980,7 +970,7 @@ TkCreateNamedFont( return TCL_OK; } - nfPtr = (NamedFont *) ckalloc(sizeof(NamedFont)); + nfPtr = ckalloc(sizeof(NamedFont)); nfPtr->deletePending = 0; Tcl_SetHashValue(namedHashPtr, nfPtr); nfPtr->fa = *faPtr; @@ -1004,28 +994,27 @@ int TkDeleteNamedFont( Tcl_Interp *interp, /* Interp for error return (can be NULL). */ Tk_Window tkwin, /* A window associated with interp. */ - CONST char *name) /* Name for the new named font. */ + const char *name) /* Name for the new named font. */ { - TkFontInfo *fiPtr; + TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; NamedFont *nfPtr; Tcl_HashEntry *namedHashPtr; - fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; - namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, name); if (namedHashPtr == NULL) { if (interp) { - Tcl_AppendResult(interp, "named font \"", name, - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "named font \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", name, NULL); } return TCL_ERROR; } - nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); + nfPtr = Tcl_GetHashValue(namedHashPtr); if (nfPtr->refCount != 0) { nfPtr->deletePending = 1; } else { Tcl_DeleteHashEntry(namedHashPtr); - ckfree((char *) nfPtr); + ckfree(nfPtr); } return TCL_OK; } @@ -1062,7 +1051,7 @@ Tk_GetFont( Tk_Font tkfont; Tcl_Obj *strPtr; - strPtr = Tcl_NewStringObj((char *) string, -1); + strPtr = Tcl_NewStringObj(string, -1); Tcl_IncrRefCount(strPtr); tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr); Tcl_DecrRefCount(strPtr); @@ -1098,19 +1087,18 @@ Tk_AllocFontFromObj( Tcl_Obj *objPtr) /* Object describing font, as: named font, * native format, or parseable string. */ { - TkFontInfo *fiPtr; + TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; Tcl_HashEntry *cacheHashPtr, *namedHashPtr; TkFont *fontPtr, *firstFontPtr, *oldFontPtr; int isNew, descent; NamedFont *nfPtr; - fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; - if (objPtr->typePtr != &tkFontObjType) { + if (objPtr->typePtr != &tkFontObjType + || objPtr->internalRep.twoPtrValue.ptr2 != fiPtr) { SetFontFromAny(interp, objPtr); } - oldFontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1; - + oldFontPtr = objPtr->internalRep.twoPtrValue.ptr1; if (oldFontPtr != NULL) { if (oldFontPtr->resourceRefCount == 0) { /* @@ -1118,7 +1106,7 @@ Tk_AllocFontFromObj( * longer in use. Clear the reference. */ - FreeFontObjProc(objPtr); + FreeFontObj(objPtr); oldFontPtr = NULL; } else if (Tk_Screen(tkwin) == oldFontPtr->screen) { oldFontPtr->resourceRefCount++; @@ -1134,18 +1122,19 @@ Tk_AllocFontFromObj( isNew = 0; if (oldFontPtr != NULL) { cacheHashPtr = oldFontPtr->cacheHashPtr; - FreeFontObjProc(objPtr); + FreeFontObj(objPtr); } else { cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr), &isNew); } - firstFontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr); + firstFontPtr = Tcl_GetHashValue(cacheHashPtr); for (fontPtr = firstFontPtr; (fontPtr != NULL); fontPtr = fontPtr->nextPtr) { if (Tk_Screen(tkwin) == fontPtr->screen) { fontPtr->resourceRefCount++; fontPtr->objRefCount++; - objPtr->internalRep.twoPtrValue.ptr1 = (void *) fontPtr; + objPtr->internalRep.twoPtrValue.ptr1 = fontPtr; + objPtr->internalRep.twoPtrValue.ptr2 = fiPtr; return (Tk_Font) fontPtr; } } @@ -1161,7 +1150,7 @@ Tk_AllocFontFromObj( * Construct a font based on a named font. */ - nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); + nfPtr = Tcl_GetHashValue(namedHashPtr); nfPtr->refCount++; fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa); @@ -1200,8 +1189,10 @@ Tk_AllocFontFromObj( if (isNew) { Tcl_DeleteHashEntry(cacheHashPtr); } - Tcl_AppendResult(interp, "failed to allocate font due to ", - "internal system font engine problem", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "failed to allocate font due to internal system font engine" + " problem", -1)); + Tcl_SetErrorCode(interp, "TK", "FONT", "INTERNAL_PROBLEM", NULL); return NULL; } @@ -1253,7 +1244,8 @@ Tk_AllocFontFromObj( } } - objPtr->internalRep.twoPtrValue.ptr1 = (void *) fontPtr; + objPtr->internalRep.twoPtrValue.ptr1 = fontPtr; + objPtr->internalRep.twoPtrValue.ptr2 = fiPtr; return (Tk_Font) fontPtr; } @@ -1278,19 +1270,20 @@ Tk_AllocFontFromObj( Tk_Font Tk_GetFontFromObj( - Tk_Window tkwin, /* The window that the font will be used in. */ + Tk_Window tkwin, /* The window that the font will be used + * in. */ Tcl_Obj *objPtr) /* The object from which to get the font. */ { TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; TkFont *fontPtr; Tcl_HashEntry *hashPtr; - if (objPtr->typePtr != &tkFontObjType) { + if (objPtr->typePtr != &tkFontObjType + || objPtr->internalRep.twoPtrValue.ptr2 != fiPtr) { SetFontFromAny(NULL, objPtr); } - fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1; - + fontPtr = objPtr->internalRep.twoPtrValue.ptr1; if (fontPtr != NULL) { if (fontPtr->resourceRefCount == 0) { /* @@ -1298,7 +1291,7 @@ Tk_GetFontFromObj( * longer in use. Clear the reference. */ - FreeFontObjProc(objPtr); + FreeFontObj(objPtr); fontPtr = NULL; } else if (Tk_Screen(tkwin) == fontPtr->screen) { return (Tk_Font) fontPtr; @@ -1312,16 +1305,17 @@ Tk_GetFontFromObj( if (fontPtr != NULL) { hashPtr = fontPtr->cacheHashPtr; - FreeFontObjProc(objPtr); + FreeFontObj(objPtr); } else { hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr)); } if (hashPtr != NULL) { - for (fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); fontPtr != NULL; + for (fontPtr = Tcl_GetHashValue(hashPtr); fontPtr != NULL; fontPtr = fontPtr->nextPtr) { if (Tk_Screen(tkwin) == fontPtr->screen) { fontPtr->objRefCount++; - objPtr->internalRep.twoPtrValue.ptr1 = (void *) fontPtr; + objPtr->internalRep.twoPtrValue.ptr1 = fontPtr; + objPtr->internalRep.twoPtrValue.ptr2 = fiPtr; return (Tk_Font) fontPtr; } } @@ -1363,10 +1357,11 @@ SetFontFromAny( Tcl_GetString(objPtr); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &tkFontObjType; objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; return TCL_OK; } @@ -1394,9 +1389,8 @@ const char * Tk_NameOfFont( Tk_Font tkfont) /* Font whose name is desired. */ { - TkFont *fontPtr; + TkFont *fontPtr = (TkFont *) tkfont; - fontPtr = (TkFont *) tkfont; return fontPtr->cacheHashPtr->key.string; } @@ -1421,13 +1415,12 @@ void Tk_FreeFont( Tk_Font tkfont) /* Font to be released. */ { - TkFont *fontPtr, *prevPtr; + TkFont *fontPtr = (TkFont *) tkfont, *prevPtr; NamedFont *nfPtr; - if (tkfont == NULL) { + if (fontPtr == NULL) { return; } - fontPtr = (TkFont *) tkfont; fontPtr->resourceRefCount--; if (fontPtr->resourceRefCount > 0) { return; @@ -1438,15 +1431,15 @@ Tk_FreeFont( * the named font and free it if no-one else is using it. */ - nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr); + nfPtr = Tcl_GetHashValue(fontPtr->namedHashPtr); nfPtr->refCount--; - if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) { + if ((nfPtr->refCount == 0) && nfPtr->deletePending) { Tcl_DeleteHashEntry(fontPtr->namedHashPtr); - ckfree((char *) nfPtr); + ckfree(nfPtr); } } - prevPtr = (TkFont *) Tcl_GetHashValue(fontPtr->cacheHashPtr); + prevPtr = Tcl_GetHashValue(fontPtr->cacheHashPtr); if (prevPtr == fontPtr) { if (fontPtr->nextPtr == NULL) { Tcl_DeleteHashEntry(fontPtr->cacheHashPtr); @@ -1462,7 +1455,7 @@ Tk_FreeFont( TkpDeleteFont(fontPtr); if (fontPtr->objRefCount == 0) { - ckfree((char *) fontPtr); + ckfree(fontPtr); } } @@ -1496,7 +1489,7 @@ Tk_FreeFontFromObj( /* *--------------------------------------------------------------------------- * - * FreeFontObjProc -- + * FreeFontObjProc, FreeFontObj -- * * This proc is called to release an object reference to a font. Called * when the object's internal rep is released or when the cached fontPtr @@ -1516,14 +1509,23 @@ static void FreeFontObjProc( Tcl_Obj *objPtr) /* The object we are releasing. */ { - TkFont *fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1; + FreeFontObj(objPtr); + objPtr->typePtr = NULL; +} + +static void +FreeFontObj( + Tcl_Obj *objPtr) /* The object we are releasing. */ +{ + TkFont *fontPtr = objPtr->internalRep.twoPtrValue.ptr1; if (fontPtr != NULL) { fontPtr->objRefCount--; if ((fontPtr->resourceRefCount == 0) && (fontPtr->objRefCount == 0)) { - ckfree((char *) fontPtr); + ckfree(fontPtr); } objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; } } @@ -1550,10 +1552,12 @@ DupFontObjProc( Tcl_Obj *srcObjPtr, /* The object we are copying from. */ Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { - TkFont *fontPtr = (TkFont *) srcObjPtr->internalRep.twoPtrValue.ptr1; + TkFont *fontPtr = srcObjPtr->internalRep.twoPtrValue.ptr1; dupObjPtr->typePtr = srcObjPtr->typePtr; - dupObjPtr->internalRep.twoPtrValue.ptr1 = (void *) fontPtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = fontPtr; + dupObjPtr->internalRep.twoPtrValue.ptr2 + = srcObjPtr->internalRep.twoPtrValue.ptr2; if (fontPtr != NULL) { fontPtr->objRefCount++; @@ -1584,9 +1588,8 @@ Tk_FontId( Tk_Font tkfont) /* Font that is going to be selected into * GC. */ { - TkFont *fontPtr; + TkFont *fontPtr = (TkFont *) tkfont; - fontPtr = (TkFont *) tkfont; return fontPtr->fid; } @@ -1617,9 +1620,8 @@ Tk_GetFontMetrics( Tk_FontMetrics *fmPtr) /* Pointer to structure in which font metrics * for tkfont will be stored. */ { - TkFont *fontPtr; + TkFont *fontPtr = (TkFont *) tkfont; - fontPtr = (TkFont *) tkfont; fmPtr->ascent = fontPtr->fm.ascent; fmPtr->descent = fontPtr->fm.descent; fmPtr->linespace = fontPtr->fm.ascent + fontPtr->fm.descent; @@ -1659,13 +1661,12 @@ Tk_PostscriptFontName( * which the name of the Postscript font that * corresponds to tkfont will be appended. */ { - TkFont *fontPtr; + TkFont *fontPtr = (TkFont *) tkfont; Tk_Uid family, weightString, slantString; char *src, *dest; int upper, len; len = Tcl_DStringLength(dsPtr); - fontPtr = (TkFont *) tkfont; /* * Convert the case-insensitive Tk_Font family name to the case-sensitive @@ -1763,7 +1764,7 @@ Tk_PostscriptFontName( slantString = NULL; if (fontPtr->fa.slant == TK_FS_ROMAN) { - ; + /* Do nothing */ } else if ((strcmp(family, "Helvetica") == 0) || (strcmp(family, "Courier") == 0) || (strcmp(family, "AvantGarde") == 0)) { @@ -1891,19 +1892,17 @@ TkUnderlineCharsInContext( int lastByte) /* Index of first byte after the last * character. */ { - TkFont *fontPtr; + TkFont *fontPtr = (TkFont *) tkfont; int startX, endX; - fontPtr = (TkFont *) tkfont; - TkpMeasureCharsInContext(tkfont, string, numBytes, 0, firstByte, -1, 0, &startX); TkpMeasureCharsInContext(tkfont, string, numBytes, 0, lastByte, -1, 0, &endX); XFillRectangle(display, drawable, gc, x + startX, - y + fontPtr->underlinePos, (unsigned int) (endX - startX), - (unsigned int) fontPtr->underlineHeight); + y + fontPtr->underlinePos, (unsigned) (endX - startX), + (unsigned) fontPtr->underlineHeight); } /* @@ -1954,7 +1953,7 @@ Tk_ComputeTextLayout( int *widthPtr, /* Filled with width of string. */ int *heightPtr) /* Filled with height of string. */ { - TkFont *fontPtr; + TkFont *fontPtr = (TkFont *) tkfont; const char *start, *end, *special; int n, y, bytesThisChunk, maxChunks, curLine, layoutHeight; int baseline, height, curX, newX, maxWidth, *lineLengths; @@ -1965,7 +1964,6 @@ Tk_ComputeTextLayout( Tcl_DStringInit(&lineBuffer); - fontPtr = (TkFont *) tkfont; if ((fontPtr == NULL) || (string == NULL)) { if (widthPtr != NULL) { *widthPtr = 0; @@ -1989,8 +1987,8 @@ Tk_ComputeTextLayout( maxChunks = 1; - layoutPtr = (TextLayout *) - ckalloc(sizeof(TextLayout) + (maxChunks-1) * sizeof(LayoutChunk)); + layoutPtr = ckalloc(sizeof(TextLayout) + + (maxChunks-1) * sizeof(LayoutChunk)); layoutPtr->tkfont = tkfont; layoutPtr->string = string; layoutPtr->numChunks = 0; @@ -2154,7 +2152,7 @@ Tk_ComputeTextLayout( * on the next line. Otherwise "Hello" and "Hello\n" are the same height. */ - if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) { + if ((layoutPtr->numChunks > 0) && !(flags & TK_IGNORE_NEWLINES)) { if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') { chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX, curX, baseline); @@ -2243,11 +2241,10 @@ void Tk_FreeTextLayout( Tk_TextLayout textLayout) /* The text layout to be released. */ { - TextLayout *layoutPtr; + TextLayout *layoutPtr = (TextLayout *) textLayout; - layoutPtr = (TextLayout *) textLayout; if (layoutPtr != NULL) { - ckfree((char *) layoutPtr); + ckfree(layoutPtr); } } @@ -2275,7 +2272,8 @@ void Tk_DrawTextLayout( Display *display, /* Display on which to draw. */ Drawable drawable, /* Window or pixmap in which to draw. */ - GC gc, /* Graphics context to use for drawing text. */ + GC gc, /* Graphics context to use for drawing + * text. */ Tk_TextLayout layout, /* Layout information, from a previous call to * Tk_ComputeTextLayout(). */ int x, int y, /* Upper-left hand corner of rectangle in @@ -2287,13 +2285,11 @@ Tk_DrawTextLayout( * draw from the given text item. A number < 0 * means to draw all characters. */ { - TextLayout *layoutPtr; + TextLayout *layoutPtr = (TextLayout *) layout; int i, numDisplayChars, drawX; - const char *firstByte; - const char *lastByte; + const char *firstByte, *lastByte; LayoutChunk *chunkPtr; - layoutPtr = (TextLayout *) layout; if (layoutPtr == NULL) { return; } @@ -2318,9 +2314,78 @@ Tk_DrawTextLayout( numDisplayChars = lastChar; } lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars); - Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont, - firstByte, lastByte - firstByte, - x + chunkPtr->x + drawX, y + chunkPtr->y); + Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont, firstByte, + lastByte - firstByte, x+chunkPtr->x+drawX, y+chunkPtr->y); + } + firstChar -= chunkPtr->numChars; + lastChar -= chunkPtr->numChars; + if (lastChar <= 0) { + break; + } + chunkPtr++; + } +} + +void +TkDrawAngledTextLayout( + Display *display, /* Display on which to draw. */ + Drawable drawable, /* Window or pixmap in which to draw. */ + GC gc, /* Graphics context to use for drawing + * text. */ + Tk_TextLayout layout, /* Layout information, from a previous call to + * Tk_ComputeTextLayout(). */ + int x, int y, /* Upper-left hand corner of rectangle in + * which to draw (pixels). */ + double angle, + int firstChar, /* The index of the first character to draw + * from the given text item. 0 specfies the + * beginning. */ + int lastChar) /* The index just after the last character to + * draw from the given text item. A number < 0 + * means to draw all characters. */ +{ + TextLayout *layoutPtr = (TextLayout *) layout; + int i, numDisplayChars, drawX; + const char *firstByte, *lastByte; + LayoutChunk *chunkPtr; + double sinA = sin(angle * PI/180.0), cosA = cos(angle * PI/180.0); + + if (layoutPtr == NULL) { + return; + } + + if (lastChar < 0) { + lastChar = 100000000; + } + chunkPtr = layoutPtr->chunks; + for (i = 0; i < layoutPtr->numChunks; i++) { + numDisplayChars = chunkPtr->numDisplayChars; + if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) { + double dx, dy; + + if (firstChar <= 0) { + drawX = 0; + firstChar = 0; + firstByte = chunkPtr->start; + } else { + firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar); + Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start, + firstByte - chunkPtr->start, -1, 0, &drawX); + } + if (lastChar < numDisplayChars) { + numDisplayChars = lastChar; + } + lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars); + dx = cosA * (chunkPtr->x + drawX) + sinA * (chunkPtr->y); + dy = -sinA * (chunkPtr->x + drawX) + cosA * (chunkPtr->y); + if (angle == 0.0) { + Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont, + firstByte, lastByte - firstByte, + (int)(x + dx), (int)(y + dy)); + } else { + TkDrawAngledChars(display, drawable, gc, layoutPtr->tkfont, + firstByte, lastByte - firstByte, x+dx, y+dy, angle); + } } firstChar -= chunkPtr->numChars; lastChar -= chunkPtr->numChars; @@ -2366,18 +2431,79 @@ Tk_UnderlineTextLayout( int underline) /* Index of the single character to underline, * or -1 for no underline. */ { - TextLayout *layoutPtr; - TkFont *fontPtr; int xx, yy, width, height; if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0) && (width != 0)) { - layoutPtr = (TextLayout *) layout; - fontPtr = (TkFont *) layoutPtr->tkfont; + TextLayout *layoutPtr = (TextLayout *) layout; + TkFont *fontPtr = (TkFont *) layoutPtr->tkfont; XFillRectangle(display, drawable, gc, x + xx, y + yy + fontPtr->fm.ascent + fontPtr->underlinePos, - (unsigned int) width, (unsigned int) fontPtr->underlineHeight); + (unsigned) width, (unsigned) fontPtr->underlineHeight); + } +} + +void +TkUnderlineAngledTextLayout( + Display *display, /* Display on which to draw. */ + Drawable drawable, /* Window or pixmap in which to draw. */ + GC gc, /* Graphics context to use for drawing + * text. */ + Tk_TextLayout layout, /* Layout information, from a previous call to + * Tk_ComputeTextLayout(). */ + int x, int y, /* Upper-left hand corner of rectangle in + * which to draw (pixels). */ + double angle, + int underline) /* Index of the single character to underline, + * or -1 for no underline. */ +{ + int xx, yy, width, height; + + if (angle == 0.0) { + Tk_UnderlineTextLayout(display, drawable, gc, layout, x,y, underline); + return; + } + + if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0) + && (width != 0)) { + TextLayout *layoutPtr = (TextLayout *) layout; + TkFont *fontPtr = (TkFont *) layoutPtr->tkfont; + double sinA = sin(angle*PI/180), cosA = cos(angle*PI/180); + double dy = yy + fontPtr->fm.ascent + fontPtr->underlinePos; + XPoint points[5]; + + /* + * Note that we're careful to only round a double value once, which + * minimizes roundoff errors. + */ + + points[0].x = x + ROUND16(xx*cosA + dy*sinA); + points[0].y = y + ROUND16(dy*cosA - xx*sinA); + points[1].x = x + ROUND16(xx*cosA + dy*sinA + width*cosA); + points[1].y = y + ROUND16(dy*cosA - xx*sinA - width*sinA); + if (fontPtr->underlineHeight == 1) { + /* + * Thin underlines look better when rotated when drawn as a line + * rather than a rectangle; the rasterizer copes better. + */ + + XDrawLines(display, drawable, gc, points, 2, CoordModeOrigin); + } else { + points[2].x = x + ROUND16(xx*cosA + dy*sinA + width*cosA + + fontPtr->underlineHeight*sinA); + points[2].y = y + ROUND16(dy*cosA - xx*sinA - width*sinA + + fontPtr->underlineHeight*cosA); + points[3].x = x + ROUND16(xx*cosA + dy*sinA + + fontPtr->underlineHeight*sinA); + points[3].y = y + ROUND16(dy*cosA - xx*sinA + + fontPtr->underlineHeight*cosA); + points[4].x = points[0].x; + points[4].y = points[0].y; + XFillPolygon(display, drawable, gc, points, 5, Complex, + CoordModeOrigin); + XDrawLines(display, drawable, gc, points, 5, CoordModeOrigin); + } } } @@ -2421,7 +2547,7 @@ Tk_PointToChar( * to the upper-left corner of the text * layout. */ { - TextLayout *layoutPtr; + TextLayout *layoutPtr = (TextLayout *) layout; LayoutChunk *chunkPtr, *lastPtr; TkFont *fontPtr; int i, n, dummy, baseline, pos, numChars; @@ -2439,7 +2565,6 @@ Tk_PointToChar( * Find which line contains the point. */ - layoutPtr = (TextLayout *) layout; fontPtr = (TkFont *) layoutPtr->tkfont; lastPtr = chunkPtr = layoutPtr->chunks; numChars = 0; @@ -2486,8 +2611,7 @@ Tk_PointToChar( return numChars; } n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start, - chunkPtr->numBytes, x - chunkPtr->x, - 0, &dummy); + chunkPtr->numBytes, x - chunkPtr->x, 0, &dummy); return numChars + Tcl_NumUtfChars(chunkPtr->start, n); } numChars += chunkPtr->numChars; @@ -2570,7 +2694,7 @@ Tk_CharBbox( * bounding box for the character specified by * index, if non-NULL. */ { - TextLayout *layoutPtr; + TextLayout *layoutPtr = (TextLayout *) layout; LayoutChunk *chunkPtr; int i, x = 0, w; Tk_Font tkfont; @@ -2581,7 +2705,6 @@ Tk_CharBbox( return 0; } - layoutPtr = (TextLayout *) layout; chunkPtr = layoutPtr->chunks; tkfont = layoutPtr->tkfont; fontPtr = (TkFont *) tkfont; @@ -2682,11 +2805,10 @@ Tk_DistanceToTextLayout( * (in pixels). */ { int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent; + TextLayout *layoutPtr = (TextLayout *) layout; LayoutChunk *chunkPtr; - TextLayout *layoutPtr; TkFont *fontPtr; - layoutPtr = (TextLayout *) layout; fontPtr = (TkFont *) layoutPtr->tkfont; ascent = fontPtr->fm.ascent; descent = fontPtr->fm.descent; @@ -2770,7 +2892,7 @@ Tk_IntersectTextLayout( * rectangular area, in pixels. */ { int result, i, x1, y1, x2, y2; - TextLayout *layoutPtr; + TextLayout *layoutPtr = (TextLayout *) layout; LayoutChunk *chunkPtr; TkFont *fontPtr; int left, top, right, bottom; @@ -2782,7 +2904,6 @@ Tk_IntersectTextLayout( * and see if they were all inside or all outside. */ - layoutPtr = (TextLayout *) layout; chunkPtr = layoutPtr->chunks; fontPtr = (TkFont *) layoutPtr->tkfont; @@ -2793,10 +2914,11 @@ Tk_IntersectTextLayout( result = 0; for (i = 0; i < layoutPtr->numChunks; i++) { - if (chunkPtr->start[0] == '\n') { + if ((chunkPtr->start[0] == '\n') || (chunkPtr->numBytes == 0)) { /* - * Newline characters are not counted when computing area - * intersection (but tab characters would still be considered). + * Newline characters and empty chunks are not counted when + * computing area intersection (but tab characters would still be + * considered). */ chunkPtr++; @@ -2830,6 +2952,256 @@ Tk_IntersectTextLayout( /* *--------------------------------------------------------------------------- * + * TkIntersectAngledTextLayout -- + * + * Determines whether a text layout that has been turned by an angle + * about its top-left coordinae lies entirely inside, entirely outside, + * or overlaps a given rectangle. Non-displaying space characters that + * occur at the end of individual lines in the text layout are ignored + * for intersection calculations. + * + * Results: + * The return value is -1 if the text layout is entirely outside of the + * rectangle, 0 if it overlaps, and 1 if it is entirely inside of the + * rectangle. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static inline int +PointInQuadrilateral( + double qx[], + double qy[], + double x, + double y) +{ + int i; + + for (i=0 ; i<4 ; i++) { + double sideDX = qx[(i+1)%4] - qx[i]; + double sideDY = qy[(i+1)%4] - qy[i]; + double dx = x - qx[i]; + double dy = y - qy[i]; + + if (sideDX*dy < sideDY*dx) { + return 0; + } + } + return 1; +} + +static inline int +SidesIntersect( + double ax1, double ay1, double ax2, double ay2, + double bx1, double by1, double bx2, double by2) +{ +#if 0 +/* http://www.freelunchdesign.com/cgi-bin/codwiki.pl?DiscussionTopics/CollideMeUpBaby */ + + double a1, b1, c1, a2, b2, c2, r1, r2, r3, r4, denom; + + a1 = ay2 - ay1; + b1 = ax1 - ax2; + c1 = (ax2 * ay1) - (ax1 * ay2); + r3 = (a1 * bx1) + (b1 * by1) + c1; + r4 = (a1 * bx2) + (b1 * by2) + c1; + if ((r3 != 0.0) && (r4 != 0.0) && (r3*r4 > 0.0)) { + return 0; + } + + a2 = by2 - by1; + b2 = bx1 - bx2; + c2 = (bx2 * by1) - (bx1 * by2); + r1 = (a2 * ax1) + (b2 * ay1) + c2; + r2 = (a2 * ax2) + (b2 * ay2) + c2; + if ((r1 != 0.0) && (r2 != 0.0) && (r1*r2 > 0.0)) { + return 0; + } + + denom = (a1 * b2) - (a2 * b1); + return (denom != 0.0); +#else + /* + * A more efficient version. Two line segments intersect if, when seen + * from the perspective of one line, the two endpoints of the other + * segment lie on opposite sides of the line, and vice versa. "Lie on + * opposite sides" is computed by taking the cross products and seeing if + * they are of opposite signs. + */ + + double dx, dy, dx1, dy1; + + dx = ax2 - ax1; + dy = ay2 - ay1; + dx1 = bx1 - ax1; + dy1 = by1 - ay1; + if ((dx*dy1-dy*dx1 > 0.0) == (dx*(by2-ay1)-dy*(bx2-ax1) > 0.0)) { + return 0; + } + dx = bx2 - bx1; + dy = by2 - by1; + if ((dy*dx1-dx*dy1 > 0.0) == (dx*(ay2-by1)-dy*(ax2-bx1) > 0.0)) { + return 0; + } + return 1; +#endif +} + +int +TkIntersectAngledTextLayout( + Tk_TextLayout layout, /* Layout information, from a previous call to + * Tk_ComputeTextLayout(). */ + int x, int y, /* Upper-left hand corner, in pixels, of + * rectangular area to compare with text + * layout. Coordinates are with respect to the + * upper-left hand corner of the text layout + * itself. */ + int width, int height, /* The width and height of the above + * rectangular area, in pixels. */ + double angle) +{ + int i, x1, y1, x2, y2; + TextLayout *layoutPtr; + LayoutChunk *chunkPtr; + TkFont *fontPtr; + double c = cos(angle * PI/180.0), s = sin(angle * PI/180.0); + double rx[4], ry[4]; + + if (angle == 0.0) { + return Tk_IntersectTextLayout(layout, x, y, width, height); + } + + /* + * Compute the coordinates of the rectangle, rotated into text layout + * space. + */ + + rx[0] = x*c - y*s; + ry[0] = y*c + x*s; + rx[1] = (x+width)*c - y*s; + ry[1] = y*c + (x+width)*s; + rx[2] = (x+width)*c - (y+height)*s; + ry[2] = (y+height)*c + (x+width)*s; + rx[3] = x*c - (y+height)*s; + ry[3] = (y+height)*c + x*s; + + /* + * Want to know if all chunks are inside the rectangle, or if there is any + * overlap. First, we check to see if all chunks are inside; if and only + * if they are, we're in the "inside" case. + */ + + layoutPtr = (TextLayout *) layout; + chunkPtr = layoutPtr->chunks; + fontPtr = (TkFont *) layoutPtr->tkfont; + + for (i=0 ; i<layoutPtr->numChunks ; i++,chunkPtr++) { + if (chunkPtr->start[0] == '\n') { + /* + * Newline characters are not counted when computing area + * intersection (but tab characters would still be considered). + */ + + continue; + } + + x1 = chunkPtr->x; + y1 = chunkPtr->y - fontPtr->fm.ascent; + x2 = chunkPtr->x + chunkPtr->displayWidth; + y2 = chunkPtr->y + fontPtr->fm.descent; + if ( !PointInQuadrilateral(rx, ry, x1, y1) || + !PointInQuadrilateral(rx, ry, x2, y1) || + !PointInQuadrilateral(rx, ry, x2, y2) || + !PointInQuadrilateral(rx, ry, x1, y2)) { + goto notInside; + } + } + return 1; + + /* + * Next, check to see if all the points of the rectangle are inside a + * single chunk; if they are, we're in an "overlap" case. + */ + + notInside: + chunkPtr = layoutPtr->chunks; + + for (i=0 ; i<layoutPtr->numChunks ; i++,chunkPtr++) { + double cx[4], cy[4]; + + if (chunkPtr->start[0] == '\n') { + /* + * Newline characters are not counted when computing area + * intersection (but tab characters would still be considered). + */ + + continue; + } + + cx[0] = cx[3] = chunkPtr->x; + cy[0] = cy[1] = chunkPtr->y - fontPtr->fm.ascent; + cx[1] = cx[2] = chunkPtr->x + chunkPtr->displayWidth; + cy[2] = cy[3] = chunkPtr->y + fontPtr->fm.descent; + if ( !PointInQuadrilateral(cx, cy, rx[0], ry[0]) || + !PointInQuadrilateral(cx, cy, rx[1], ry[1]) || + !PointInQuadrilateral(cx, cy, rx[2], ry[2]) || + !PointInQuadrilateral(cx, cy, rx[3], ry[3])) { + goto notReverseInside; + } + } + return 0; + + /* + * If we're overlapping now, we must be partially in and out of at least + * one chunk. If that is the case, there must be one line segment of the + * rectangle that is touching or crossing a line segment of a chunk. + */ + + notReverseInside: + chunkPtr = layoutPtr->chunks; + + for (i=0 ; i<layoutPtr->numChunks ; i++,chunkPtr++) { + int j; + + if (chunkPtr->start[0] == '\n') { + /* + * Newline characters are not counted when computing area + * intersection (but tab characters would still be considered). + */ + + continue; + } + + x1 = chunkPtr->x; + y1 = chunkPtr->y - fontPtr->fm.ascent; + x2 = chunkPtr->x + chunkPtr->displayWidth; + y2 = chunkPtr->y + fontPtr->fm.descent; + + for (j=0 ; j<4 ; j++) { + int k = (j+1) % 4; + + if ( SidesIntersect(rx[j],ry[j], rx[k],ry[k], x1,y1, x2,y1) || + SidesIntersect(rx[j],ry[j], rx[k],ry[k], x2,y1, x2,y2) || + SidesIntersect(rx[j],ry[j], rx[k],ry[k], x2,y2, x1,y2) || + SidesIntersect(rx[j],ry[j], rx[k],ry[k], x1,y2, x1,y1)) { + return 0; + } + } + } + + /* + * They must be wholly non-overlapping. + */ + + return -1; +} + +/* + *--------------------------------------------------------------------------- + * * Tk_TextLayoutToPostscript -- * * Outputs the contents of a text layout in Postscript format. The set of @@ -2870,112 +3242,93 @@ Tk_TextLayoutToPostscript( Tcl_Interp *interp, /* Filled with Postscript code. */ Tk_TextLayout layout) /* The layout to be rendered. */ { -#define MAXUSE 128 - char buf[MAXUSE+30], uindex[5] = "\0\0\0\0", one_char[5]; - LayoutChunk *chunkPtr; - int i, j, used, c, baseline, charsize; + TextLayout *layoutPtr = (TextLayout *) layout; + LayoutChunk *chunkPtr = layoutPtr->chunks; + int baseline = chunkPtr->y; + Tcl_Obj *psObj = Tcl_NewObj(); + int i, j, len; + const char *p, *glyphname; + char uindex[5], c, *ps; Tcl_UniChar ch; - const char *p, *last_p, *glyphname; - TextLayout *layoutPtr; - int bytecount=0; - layoutPtr = (TextLayout *) layout; - chunkPtr = layoutPtr->chunks; - baseline = chunkPtr->y; - used = 0; - buf[used++] = '['; - buf[used++] = '('; - for (i = 0; i < layoutPtr->numChunks; i++) { + Tcl_AppendToObj(psObj, "[(", -1); + for (i = 0; i < layoutPtr->numChunks; i++, chunkPtr++) { if (baseline != chunkPtr->y) { - buf[used++] = ')'; - buf[used++] = ']'; - buf[used++] = '\n'; - buf[used++] = '['; - buf[used++] = '('; + Tcl_AppendToObj(psObj, ")]\n[(", -1); baseline = chunkPtr->y; } if (chunkPtr->numDisplayChars <= 0) { if (chunkPtr->start[0] == '\t') { - buf[used++] = '\\'; - buf[used++] = 't'; + Tcl_AppendToObj(psObj, "\\t", -1); } - } else { - p = chunkPtr->start; - for (j = 0; j < chunkPtr->numDisplayChars; j++) { + continue; + } + + for (p=chunkPtr->start, j=0; j<chunkPtr->numDisplayChars; j++) { + /* + * INTL: We only handle symbols that have an encoding as a glyph + * from the standard set defined by Adobe. The rest get punted. + * Eventually this should be revised to handle more sophsticiated + * international postscript fonts. + */ + + p += Tcl_UtfToUniChar(p, &ch); + if ((ch == '(') || (ch == ')') || (ch == '\\') || (ch < 0x20)) { /* - * INTL: For now we just treat the characters as binary data - * and display the lower byte. Eventually this should be - * revised to handle international postscript fonts. + * Tricky point: the "03" is necessary in the sprintf below, + * so that a full three digits of octal are always generated. + * Without the "03", a number following this sequence could be + * interpreted by Postscript as part of this sequence. */ - last_p = p; - p += (charsize = Tcl_UtfToUniChar(p,&ch)); - Tcl_UtfToExternal(interp, NULL, last_p, charsize, 0, NULL, - one_char, 4, NULL, &bytecount, NULL); - if (bytecount == 1) { - c = UCHAR(one_char[0]); - /* c = UCHAR( ch & 0xFF) */; - if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20) - || (c >= UCHAR(0x7f))) { - /* - * Tricky point: the "03" is necessary in the sprintf - * below, so that a full three digits of octal are - * always generated. Without the "03", a number - * following this sequence could be interpreted by - * Postscript as part of this sequence. - */ + Tcl_AppendPrintfToObj(psObj, "\\%03o", ch); + continue; + } else if (ch <= 0x7f) { + /* + * Normal ASCII character. + */ - sprintf(buf + used, "\\%03o", c); - used += 4; - } else { - buf[used++] = c; - } - } else { + c = (char) ch; + Tcl_AppendToObj(psObj, &c, 1); + continue; + } + + /* + * This character doesn't belong to the ASCII character set, so we + * use the full glyph name. + */ + + sprintf(uindex, "%04X", ch); /* endianness? */ + glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, 0); + if (glyphname) { + ps = Tcl_GetStringFromObj(psObj, &len); + if (ps[len-1] == '(') { /* - * This character doesn't belong to system character set. - * So, we must use full glyph name. + * In-place edit. Ewww! */ - sprintf(uindex, "%04X", ch); /* endianness? */ - glyphname = Tcl_GetVar2(interp,"::tk::psglyphs",uindex,0); - if (glyphname) { - if (used > 0 && buf [used-1] == '(') { - --used; - } else { - buf[used++] = ')'; - } - buf[used++] = '/'; - while ((*glyphname) && (used < (MAXUSE+27))) { - buf[used++] = *glyphname++ ; - } - buf[used++] = '('; - } - - } - if (used >= MAXUSE) { - buf[used] = '\0'; - Tcl_AppendResult(interp, buf, NULL); - used = 0; + ps[len-1] = '/'; + } else { + Tcl_AppendToObj(psObj, ")/", -1); } - } - } - if (used >= MAXUSE) { - /* - * If there are a whole bunch of returns or tabs in a row, then - * buf[] could get filled up. - */ + Tcl_AppendToObj(psObj, glyphname, -1); + Tcl_AppendToObj(psObj, "(", -1); + } else { + /* + * No known mapping for the character into the space of + * PostScript glyphs. Ignore it. :-( + */ - buf[used] = '\0'; - Tcl_AppendResult(interp, buf, NULL); - used = 0; +#ifdef TK_DEBUG_POSTSCRIPT_OUTPUT + fprintf(stderr, "Warning: no mapping to PostScript " + "glyphs for \\u%04x\n", ch); +#endif + } } - chunkPtr++; } - buf[used++] = ')'; - buf[used++] = ']'; - buf[used++] = '\n'; - buf[used] = '\0'; - Tcl_AppendResult(interp, buf, NULL); + Tcl_AppendToObj(psObj, ")]\n", -1); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); } /* @@ -3011,7 +3364,7 @@ ConfigAttributesObj( { int i, n, index; Tcl_Obj *optionPtr, *valuePtr; - char *value; + const char *value; for (i = 0; i < objc; i += 2) { optionPtr = objv[i]; @@ -3028,8 +3381,10 @@ ConfigAttributesObj( */ if (interp != NULL) { - Tcl_AppendResult(interp, "value for \"", - Tcl_GetString(optionPtr), "\" option missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" option missing", + Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "FONT", "NO_ATTRIBUTE", NULL); } return TCL_ERROR; } @@ -3110,9 +3465,7 @@ GetAttributeInfoObj( { int i, index, start, end; const char *str; - Tcl_Obj *optionPtr, *valuePtr, *resultPtr; - - resultPtr = Tcl_GetObjResult(interp); + Tcl_Obj *valuePtr, *resultPtr = NULL; start = 0; end = FONT_NUMFIELDS; @@ -3126,6 +3479,9 @@ GetAttributeInfoObj( } valuePtr = NULL; + if (objPtr == NULL) { + resultPtr = Tcl_NewObj(); + } for (i = start; i < end; i++) { switch (i) { case FONT_FAMILY: @@ -3159,10 +3515,11 @@ GetAttributeInfoObj( Tcl_SetObjResult(interp, valuePtr); return TCL_OK; } - optionPtr = Tcl_NewStringObj(fontOpt[i], -1); - Tcl_ListObjAppendElement(NULL, resultPtr, optionPtr); + Tcl_ListObjAppendElement(NULL, resultPtr, + Tcl_NewStringObj(fontOpt[i], -1)); Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr); } + Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } @@ -3204,7 +3561,7 @@ ParseFontNameObj( char *dash; int objc, result, i, n; Tcl_Obj **objv; - char *string; + const char *string; TkInitFontAttributes(faPtr); @@ -3222,7 +3579,7 @@ ParseFontNameObj( } dash = strchr(string + 1, '-'); if ((dash != NULL) - && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */ + && !isspace(UCHAR(dash[-1]))) { /* INTL: ISO space */ goto xlfd; } @@ -3270,8 +3627,9 @@ ParseFontNameObj( if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK) || (objc < 1)) { if (interp != NULL) { - Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "font \"%s\" doesn't exist", string)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT", string, NULL); } return TCL_ERROR; } @@ -3318,8 +3676,10 @@ ParseFontNameObj( */ if (interp != NULL) { - Tcl_AppendResult(interp, "unknown font style \"", - Tcl_GetString(objv[i]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown font style \"%s\"", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "FONT_STYLE", + Tcl_GetString(objv[i]), NULL); } return TCL_ERROR; } @@ -3367,7 +3727,7 @@ NewChunk( if (layoutPtr->numChunks == maxChunks) { maxChunks *= 2; s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk)); - layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s); + layoutPtr = ckrealloc(layoutPtr, s); *layoutPtrPtr = layoutPtr; *maxPtr = maxChunks; @@ -3439,7 +3799,7 @@ TkFontParseXLFD( } Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, (char *) str, -1); + Tcl_DStringAppend(&ds, str, -1); src = Tcl_DStringValue(&ds); field[0] = src; @@ -3472,7 +3832,7 @@ TkFontParseXLFD( * parsed set of attributes)". */ - if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) { + if ((i > XLFD_ADD_STYLE) && FieldSpecified(field[XLFD_ADD_STYLE])) { if (atoi(field[XLFD_ADD_STYLE]) != 0) { for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) { field[j + 1] = field[j]; @@ -3701,7 +4061,6 @@ TkFontGetPoints( * platform expects when asking for the font. * * Results: - * As above. The return value is NULL if the font name has no aliases. * * Side effects: @@ -3710,7 +4069,7 @@ TkFontGetPoints( *------------------------------------------------------------------------- */ -char ** +const char *const * TkFontGetAliasList( const char *faceName) /* Font name to test for aliases. */ { @@ -3743,7 +4102,7 @@ TkFontGetAliasList( *------------------------------------------------------------------------- */ -char *** +const char *const *const * TkFontGetFallbacks(void) { return fontFallbacks; @@ -3768,7 +4127,7 @@ TkFontGetFallbacks(void) *------------------------------------------------------------------------- */ -char ** +const char *const * TkFontGetGlobalClass(void) { return globalFontClass; @@ -3791,7 +4150,7 @@ TkFontGetGlobalClass(void) *------------------------------------------------------------------------- */ -char ** +const char *const * TkFontGetSymbolClass(void) { return symbolClass; @@ -3819,7 +4178,7 @@ Tcl_Obj * TkDebugFont( Tk_Window tkwin, /* The window in which the font will be used * (not currently used). */ - char *name) /* Name of the desired color. */ + const char *name) /* Name of the desired color. */ { TkFont *fontPtr; Tcl_HashEntry *hashPtr; @@ -3829,7 +4188,7 @@ TkDebugFont( hashPtr = Tcl_FindHashEntry( &((TkWindow *) tkwin)->mainPtr->fontInfoPtr->fontCache, name); if (hashPtr != NULL) { - fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); + fontPtr = Tcl_GetHashValue(hashPtr); if (fontPtr == NULL) { Tcl_Panic("TkDebugFont found empty hash table entry"); } @@ -3871,12 +4230,11 @@ TkFontGetFirstTextLayout( Tk_Font *font, char *dst) { - TextLayout *layoutPtr; + TextLayout *layoutPtr = (TextLayout *) layout; LayoutChunk *chunkPtr; int numBytesInChunk; - layoutPtr = (TextLayout *)layout; - if ((layoutPtr==NULL) || (layoutPtr->numChunks==0) + if ((layoutPtr == NULL) || (layoutPtr->numChunks == 0) || (layoutPtr->chunks->numDisplayChars <= 0)) { dst[0] = '\0'; return 0; diff --git a/generic/tkFont.h b/generic/tkFont.h index ef6336c..b8de885 100644 --- a/generic/tkFont.h +++ b/generic/tkFont.h @@ -14,11 +14,6 @@ #ifndef _TKFONT #define _TKFONT -#ifdef BUILD_tk -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT -#endif - /* * The following structure keeps track of the attributes of a font. It can be * used to keep track of either the desired attributes or the actual @@ -187,24 +182,30 @@ typedef struct TkXLFDAttributes { #define XLFD_NUMFIELDS 13 /* Number of fields in XLFD. */ /* + * Helper macro. How to correctly round a double to a short. + */ + +#define ROUND16(x) ((short) floor((x) + 0.5)) + +/* * Low-level API exported by generic code to platform-specific code. */ #define TkInitFontAttributes(fa) memset((fa), 0, sizeof(TkFontAttributes)); #define TkInitXLFDAttributes(xa) memset((xa), 0, sizeof(TkXLFDAttributes)); -MODULE_SCOPE int TkFontParseXLFD(CONST char *string, +MODULE_SCOPE int TkFontParseXLFD(const char *string, TkFontAttributes *faPtr, TkXLFDAttributes *xaPtr); -MODULE_SCOPE char ** TkFontGetAliasList(CONST char *faceName); -MODULE_SCOPE char *** TkFontGetFallbacks(void); +MODULE_SCOPE const char *const * TkFontGetAliasList(const char *faceName); +MODULE_SCOPE const char *const *const * TkFontGetFallbacks(void); MODULE_SCOPE int TkFontGetPixels(Tk_Window tkwin, int size); MODULE_SCOPE int TkFontGetPoints(Tk_Window tkwin, int size); -MODULE_SCOPE char ** TkFontGetGlobalClass(void); -MODULE_SCOPE char ** TkFontGetSymbolClass(void); +MODULE_SCOPE const char *const * TkFontGetGlobalClass(void); +MODULE_SCOPE const char *const * TkFontGetSymbolClass(void); MODULE_SCOPE int TkCreateNamedFont(Tcl_Interp *interp, Tk_Window tkwin, - CONST char *name, TkFontAttributes *faPtr); + const char *name, TkFontAttributes *faPtr); MODULE_SCOPE int TkDeleteNamedFont(Tcl_Interp *interp, - Tk_Window tkwin, CONST char *name); + Tk_Window tkwin, const char *name); MODULE_SCOPE int TkFontGetFirstTextLayout(Tk_TextLayout layout, Tk_Font *font, char *dst); @@ -215,12 +216,9 @@ MODULE_SCOPE int TkFontGetFirstTextLayout(Tk_TextLayout layout, MODULE_SCOPE void TkpDeleteFont(TkFont *tkFontPtr); MODULE_SCOPE void TkpFontPkgInit(TkMainInfo *mainPtr); MODULE_SCOPE TkFont * TkpGetFontFromAttributes(TkFont *tkFontPtr, - Tk_Window tkwin, CONST TkFontAttributes *faPtr); + Tk_Window tkwin, const TkFontAttributes *faPtr); MODULE_SCOPE void TkpGetFontFamilies(Tcl_Interp *interp, Tk_Window tkwin); -MODULE_SCOPE TkFont * TkpGetNativeFont(Tk_Window tkwin, CONST char *name); - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT +MODULE_SCOPE TkFont * TkpGetNativeFont(Tk_Window tkwin, const char *name); #endif /* _TKFONT */ diff --git a/generic/tkFrame.c b/generic/tkFrame.c index e38fe87..057b4b8 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -162,7 +162,7 @@ enum labelanchor { LABELANCHOR_W, LABELANCHOR_WN, LABELANCHOR_WS }; -static CONST char *labelAnchorStrings[] = { +static const char *const labelAnchorStrings[] = { "e", "en", "es", "n", "ne", "nw", "s", "se", "sw", "w", "wn", "ws", NULL }; @@ -175,9 +175,9 @@ static CONST char *labelAnchorStrings[] = { static const Tk_OptionSpec commonOptSpec[] = { {TK_OPTION_BORDER, "-background", "background", "Background", DEF_FRAME_BG_COLOR, -1, Tk_Offset(Frame, border), - TK_OPTION_NULL_OK, (ClientData) DEF_FRAME_BG_MONO, 0}, + TK_OPTION_NULL_OK, DEF_FRAME_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_STRING, "-colormap", "colormap", "Colormap", DEF_FRAME_COLORMAP, -1, Tk_Offset(Frame, colormapName), TK_OPTION_NULL_OK, 0, 0}, @@ -220,7 +220,7 @@ static const Tk_OptionSpec commonOptSpec[] = { static const Tk_OptionSpec frameOptSpec[] = { {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), 0, 0, 0}, {TK_OPTION_STRING, "-class", "class", "Class", @@ -228,12 +228,12 @@ static const Tk_OptionSpec frameOptSpec[] = { {TK_OPTION_RELIEF, "-relief", "relief", "Relief", DEF_FRAME_RELIEF, -1, Tk_Offset(Frame, relief), 0, 0, 0}, {TK_OPTION_END, NULL, NULL, NULL, - NULL, 0, 0, 0, (ClientData) commonOptSpec, 0} + NULL, 0, 0, 0, commonOptSpec, 0} }; static const Tk_OptionSpec toplevelOptSpec[] = { {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_FRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), 0, 0, 0}, {TK_OPTION_STRING, "-class", "class", "Class", @@ -250,26 +250,26 @@ static const Tk_OptionSpec toplevelOptSpec[] = { DEF_TOPLEVEL_USE, -1, Tk_Offset(Frame, useThis), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_END, NULL, NULL, NULL, - NULL, 0, 0, 0, (ClientData) commonOptSpec, 0} + NULL, 0, 0, 0, commonOptSpec, 0} }; static const Tk_OptionSpec labelframeOptSpec[] = { {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_LABELFRAME_BORDER_WIDTH, -1, Tk_Offset(Frame, borderWidth), 0, 0, 0}, {TK_OPTION_STRING, "-class", "class", "Class", DEF_LABELFRAME_CLASS, -1, Tk_Offset(Frame, className), 0, 0, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_LABELFRAME_FONT, -1, Tk_Offset(Labelframe, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", DEF_LABELFRAME_FG, -1, Tk_Offset(Labelframe, textColorPtr), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-labelanchor", "labelAnchor", "LabelAnchor", DEF_LABELFRAME_LABELANCHOR, -1, Tk_Offset(Labelframe, labelAnchor), - 0, (ClientData) labelAnchorStrings, 0}, + 0, labelAnchorStrings, 0}, {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget", NULL, -1, Tk_Offset(Labelframe, labelWin), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", @@ -278,24 +278,24 @@ static const Tk_OptionSpec labelframeOptSpec[] = { DEF_LABELFRAME_TEXT, Tk_Offset(Labelframe, textPtr), -1, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_END, NULL, NULL, NULL, - NULL, 0, 0, 0, (ClientData) commonOptSpec, 0} + NULL, 0, 0, 0, commonOptSpec, 0} }; /* * Class names for widgets, indexed by FrameType. */ -static CONST char *classNames[] = {"Frame", "Toplevel", "Labelframe"}; +static const char *const classNames[] = {"Frame", "Toplevel", "Labelframe"}; /* * The following table maps from FrameType to the option template for that * class of widgets. */ -static const Tk_OptionSpec * const optionSpecs[] = { +static const Tk_OptionSpec *const optionSpecs[] = { frameOptSpec, toplevelOptSpec, - labelframeOptSpec + labelframeOptSpec, }; /* @@ -304,11 +304,11 @@ static const Tk_OptionSpec * const optionSpecs[] = { static void ComputeFrameGeometry(Frame *framePtr); static int ConfigureFrame(Tcl_Interp *interp, Frame *framePtr, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int CreateFrame(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST argv[], - enum FrameType type, char *appName); -static void DestroyFrame(char *memPtr); + int objc, Tcl_Obj *const argv[], + enum FrameType type, const char *appName); +static void DestroyFrame(void *memPtr); static void DestroyFramePartly(Frame *framePtr); static void DisplayFrame(ClientData clientData); static void FrameCmdDeletedProc(ClientData clientData); @@ -322,7 +322,7 @@ static void FrameStructureProc(ClientData clientData, XEvent *eventPtr); static int FrameWidgetObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static void FrameWorldChanged(ClientData instanceData); static void MapFrame(ClientData clientData); @@ -331,9 +331,11 @@ static void MapFrame(ClientData clientData); * can be invoked from generic window code. */ -static Tk_ClassProcs frameClass = { +static const Tk_ClassProcs frameClass = { sizeof(Tk_ClassProcs), /* size */ - FrameWorldChanged /* worldChangedProc */ + FrameWorldChanged, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -371,7 +373,7 @@ Tk_FrameObjCmd( ClientData clientData, /* Either NULL or pointer to option table. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { return CreateFrame(clientData, interp, objc, objv, TYPE_FRAME, NULL); } @@ -381,7 +383,7 @@ Tk_ToplevelObjCmd( ClientData clientData, /* Either NULL or pointer to option table. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { return CreateFrame(clientData, interp, objc, objv, TYPE_TOPLEVEL, NULL); } @@ -391,7 +393,7 @@ Tk_LabelframeObjCmd( ClientData clientData, /* Either NULL or pointer to option table. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { return CreateFrame(clientData, interp, objc, objv, TYPE_LABELFRAME, NULL); } @@ -420,16 +422,16 @@ TkCreateFrame( ClientData clientData, /* Either NULL or pointer to option table. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - char **argv, /* Argument strings. */ + const char *const *argv, /* Argument strings. */ int toplevel, /* Non-zero means create a toplevel window, * zero means create a frame. */ - char *appName) /* Should only be non-NULL if there is no main + const char *appName) /* Should only be non-NULL if there is no main * window associated with the interpreter. * Gives the base name to use for the new * application. */ { int result, i; - Tcl_Obj **objv = (Tcl_Obj **) ckalloc((argc+1) * sizeof(Tcl_Obj **)); + Tcl_Obj **objv = ckalloc((argc+1) * sizeof(Tcl_Obj **)); for (i=0; i<argc; i++) { objv[i] = Tcl_NewStringObj(argv[i], -1); @@ -441,7 +443,7 @@ TkCreateFrame( for (i=0; i<argc; i++) { Tcl_DecrRefCount(objv[i]); } - ckfree((char *) objv); + ckfree(objv); return result; } @@ -450,9 +452,9 @@ CreateFrame( ClientData clientData, /* NULL. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[], /* Argument objects. */ + Tcl_Obj *const objv[], /* Argument objects. */ enum FrameType type, /* What widget type to create. */ - char *appName) /* Should only be non-NULL if there are no + const char *appName) /* Should only be non-NULL if there are no * Main window associated with the * interpreter. Gives the base name to use for * the new application. */ @@ -461,14 +463,15 @@ CreateFrame( Frame *framePtr; Tk_OptionTable optionTable; Tk_Window newWin; - CONST char *className, *screenName, *visualName, *colormapName, *arg, *useOption; - int i, c, length, depth; + const char *className, *screenName, *visualName, *colormapName; + const char *arg, *useOption; + int i, length, depth; unsigned int mask; Colormap colormap; Visual *visual; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -493,20 +496,19 @@ CreateFrame( if (length < 2) { continue; } - c = arg[1]; - if ((c == 'c') && (length >= 3) + if ((arg[1] == 'c') && (length >= 3) && (strncmp(arg, "-class", (unsigned) length) == 0)) { className = Tcl_GetString(objv[i+1]); - } else if ((c == 'c') + } else if ((arg[1] == 'c') && (length >= 3) && (strncmp(arg, "-colormap", (unsigned) length) == 0)) { colormapName = Tcl_GetString(objv[i+1]); - } else if ((c == 's') && (type == TYPE_TOPLEVEL) + } else if ((arg[1] == 's') && (type == TYPE_TOPLEVEL) && (strncmp(arg, "-screen", (unsigned) length) == 0)) { screenName = Tcl_GetString(objv[i+1]); - } else if ((c == 'u') && (type == TYPE_TOPLEVEL) + } else if ((arg[1] == 'u') && (type == TYPE_TOPLEVEL) && (strncmp(arg, "-use", (unsigned) length) == 0)) { useOption = Tcl_GetString(objv[i+1]); - } else if ((c == 'v') + } else if ((arg[1] == 'v') && (strncmp(arg, "-visual", (unsigned) length) == 0)) { visualName = Tcl_GetString(objv[i+1]); } @@ -545,9 +547,10 @@ CreateFrame( * are being destroyed. Let an error be thrown. */ - Tcl_AppendResult(interp, "unable to create widget \"", - Tcl_GetString(objv[1]), "\"", NULL); - newWin = NULL; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to create widget \"%s\"", Tcl_GetString(objv[1]))); + Tcl_SetErrorCode(interp, "TK", "APPLICATION_GONE", NULL); + return TCL_ERROR; } else { /* * We were called from Tk_Init; create a new application. @@ -557,13 +560,14 @@ CreateFrame( } if (newWin == NULL) { goto error; - } else { - /* - * Mark Tk frames as suitable candidates for [wm manage] - */ - TkWindow *winPtr = (TkWindow *)newWin; - winPtr->flags |= TK_WM_MANAGEABLE; } + + /* + * Mark Tk frames as suitable candidates for [wm manage]. + */ + + ((TkWindow *) newWin)->flags |= TK_WM_MANAGEABLE; + if (className == NULL) { className = Tk_GetOption(newWin, "class", "Class"); if (className == NULL) { @@ -574,10 +578,9 @@ CreateFrame( if (useOption == NULL) { useOption = Tk_GetOption(newWin, "use", "Use"); } - if ((useOption != NULL) && (*useOption != 0)) { - if (TkpUseWindow(interp, newWin, useOption) != TCL_OK) { - goto error; - } + if ((useOption != NULL) && (*useOption != 0) + && (TkpUseWindow(interp, newWin, useOption) != TCL_OK)) { + goto error; } if (visualName == NULL) { visualName = Tk_GetOption(newWin, "visual", "Visual"); @@ -621,18 +624,17 @@ CreateFrame( */ if (type == TYPE_LABELFRAME) { - framePtr = (Frame *) ckalloc(sizeof(Labelframe)); - memset((void *) framePtr, 0, (sizeof(Labelframe))); + framePtr = ckalloc(sizeof(Labelframe)); + memset(framePtr, 0, sizeof(Labelframe)); } else { - framePtr = (Frame *) ckalloc(sizeof(Frame)); - memset((void *) framePtr, 0, (sizeof(Frame))); - } - framePtr->tkwin = newWin; - framePtr->display = Tk_Display(newWin); - framePtr->interp = interp; - framePtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(newWin), FrameWidgetObjCmd, - (ClientData) framePtr, FrameCmdDeletedProc); + framePtr = ckalloc(sizeof(Frame)); + memset(framePtr, 0, sizeof(Frame)); + } + framePtr->tkwin = newWin; + framePtr->display = Tk_Display(newWin); + framePtr->interp = interp; + framePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(newWin), + FrameWidgetObjCmd, framePtr, FrameCmdDeletedProc); framePtr->optionTable = optionTable; framePtr->type = type; framePtr->colormap = colormap; @@ -641,6 +643,7 @@ CreateFrame( if (framePtr->type == TYPE_LABELFRAME) { Labelframe *labelframePtr = (Labelframe *) framePtr; + labelframePtr->labelAnchor = LABELANCHOR_NW; labelframePtr->textGC = None; } @@ -649,31 +652,32 @@ CreateFrame( * Store backreference to frame widget in window structure. */ - Tk_SetClassProcs(newWin, &frameClass, (ClientData) framePtr); + Tk_SetClassProcs(newWin, &frameClass, framePtr); mask = ExposureMask | StructureNotifyMask | FocusChangeMask; if (type == TYPE_TOPLEVEL) { mask |= ActivateMask; } - Tk_CreateEventHandler(newWin, mask, FrameEventProc, (ClientData) framePtr); + Tk_CreateEventHandler(newWin, mask, FrameEventProc, framePtr); if ((Tk_InitOptions(interp, (char *) framePtr, optionTable, newWin) != TCL_OK) || (ConfigureFrame(interp, framePtr, objc-2, objv+2) != TCL_OK)) { goto error; } - if ((framePtr->isContainer)) { - if (framePtr->useThis == NULL) { - TkpMakeContainer(framePtr->tkwin); - } else { - Tcl_AppendResult(interp, "A window cannot have both the -use ", - "and the -container option set.", NULL); + if (framePtr->isContainer) { + if (framePtr->useThis != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "windows cannot have both the -use and the -container" + " option set", -1)); + Tcl_SetErrorCode(interp, "TK", "FRAME", "CONTAINMENT", NULL); goto error; } + TkpMakeContainer(framePtr->tkwin); } if (type == TYPE_TOPLEVEL) { - Tcl_DoWhenIdle(MapFrame, (ClientData) framePtr); + Tcl_DoWhenIdle(MapFrame, framePtr); } - Tcl_SetResult(interp, Tk_PathName(newWin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(newWin)); return TCL_OK; error: @@ -706,28 +710,28 @@ FrameWidgetObjCmd( ClientData clientData, /* Information about frame widget. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static CONST char *frameOptions[] = { + static const char *const frameOptions[] = { "cget", "configure", NULL }; enum options { FRAME_CGET, FRAME_CONFIGURE }; - register Frame *framePtr = (Frame *) clientData; + register Frame *framePtr = clientData; int result = TCL_OK, index; int c, i, length; Tcl_Obj *objPtr; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], frameOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], frameOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } - Tcl_Preserve((ClientData) framePtr); + Tcl_Preserve(framePtr); switch ((enum options) index) { case FRAME_CGET: if (objc != 3) { @@ -740,22 +744,19 @@ FrameWidgetObjCmd( if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); break; case FRAME_CONFIGURE: if (objc <= 3) { objPtr = Tk_GetOptionInfo(interp, (char *) framePtr, - framePtr->optionTable, - (objc == 3) ? objv[2] : NULL, + framePtr->optionTable, (objc == 3) ? objv[2] : NULL, framePtr->tkwin); if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { /* * Don't allow the options -class, -colormap, -container, -screen, @@ -763,7 +764,8 @@ FrameWidgetObjCmd( */ for (i = 2; i < objc; i++) { - char *arg = Tcl_GetStringFromObj(objv[i], &length); + const char *arg = Tcl_GetStringFromObj(objv[i], &length); + if (length < 2) { continue; } @@ -781,26 +783,25 @@ FrameWidgetObjCmd( || ((c == 'v') && (strncmp(arg, "-visual", (unsigned)length) == 0))) { - #ifdef SUPPORT_CONFIG_EMBEDDED +#ifdef SUPPORT_CONFIG_EMBEDDED if (c == 'u') { - CONST char *string = Tcl_GetString(objv[i+1]); + const char *string = Tcl_GetString(objv[i+1]); + if (TkpUseWindow(interp, framePtr->tkwin, string) != TCL_OK) { result = TCL_ERROR; goto done; } - } else { - Tcl_AppendResult(interp, "can't modify ", arg, - " option after widget is created", NULL); - result = TCL_ERROR; - goto done; + continue; } - #else - Tcl_AppendResult(interp, "can't modify ", arg, - " option after widget is created", NULL); - result = TCL_ERROR; - goto done; - #endif +#endif + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't modify %s option after widget is created", + arg)); + Tcl_SetErrorCode(interp, "TK", "FRAME", "CREATE_ONLY", + NULL); + result = TCL_ERROR; + goto done; } } result = ConfigureFrame(interp, framePtr, objc-2, objv+2); @@ -809,7 +810,7 @@ FrameWidgetObjCmd( } done: - Tcl_Release((ClientData) framePtr); + Tcl_Release(framePtr); return result; } @@ -833,10 +834,10 @@ FrameWidgetObjCmd( static void DestroyFrame( - char *memPtr) /* Info about frame widget. */ + void *memPtr) /* Info about frame widget. */ { - register Frame *framePtr = (Frame *) memPtr; - register Labelframe *labelframePtr = (Labelframe *) memPtr; + register Frame *framePtr = memPtr; + register Labelframe *labelframePtr = memPtr; if (framePtr->type == TYPE_LABELFRAME) { Tk_FreeTextLayout(labelframePtr->textLayout); @@ -847,7 +848,7 @@ DestroyFrame( if (framePtr->colormap != None) { Tk_FreeColormap(framePtr->display, framePtr->colormap); } - ckfree((char *) framePtr); + ckfree(framePtr); } /* @@ -876,8 +877,8 @@ DestroyFramePartly( if (framePtr->type == TYPE_LABELFRAME && labelframePtr->labelWin != NULL) { Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask, - FrameStructureProc, (ClientData) framePtr); - Tk_ManageGeometry(labelframePtr->labelWin, NULL, (ClientData) NULL); + FrameStructureProc, framePtr); + Tk_ManageGeometry(labelframePtr->labelWin, NULL, NULL); if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) { Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin); } @@ -915,7 +916,7 @@ ConfigureFrame( register Frame *framePtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in objv. */ - Tcl_Obj *CONST objv[]) /* Arguments. */ + Tcl_Obj *const objv[]) /* Arguments. */ { Tk_SavedOptions savedOptions; char *oldMenuName; @@ -943,9 +944,8 @@ ConfigureFrame( ckfree(oldMenuName); } return TCL_ERROR; - } else { - Tk_FreeSavedOptions(&savedOptions); } + Tk_FreeSavedOptions(&savedOptions); /* * A few of the options require additional processing. @@ -955,7 +955,7 @@ ConfigureFrame( || ((oldMenuName != NULL) && (framePtr->menuName == NULL)) || ((oldMenuName != NULL) && (framePtr->menuName != NULL) && strcmp(oldMenuName, framePtr->menuName) != 0)) - && framePtr->type == TYPE_TOPLEVEL) { + && framePtr->type == TYPE_TOPLEVEL) { TkSetWindowMenuBar(interp, framePtr->tkwin, oldMenuName, framePtr->menuName); } @@ -989,8 +989,8 @@ ConfigureFrame( if (oldWindow != labelframePtr->labelWin) { if (oldWindow != NULL) { Tk_DeleteEventHandler(oldWindow, StructureNotifyMask, - FrameStructureProc, (ClientData) framePtr); - Tk_ManageGeometry(oldWindow, NULL, (ClientData) NULL); + FrameStructureProc, framePtr); + Tk_ManageGeometry(oldWindow, NULL, NULL); Tk_UnmaintainGeometry(oldWindow, framePtr->tkwin); Tk_UnmapWindow(oldWindow); } @@ -1011,25 +1011,19 @@ ConfigureFrame( } sibling = ancestor; if (Tk_IsTopLevel(ancestor)) { - badWindow: - Tcl_AppendResult(interp, "can't use ", - Tk_PathName(labelframePtr->labelWin), - " as label in this frame", NULL); - labelframePtr->labelWin = NULL; - return TCL_ERROR; + goto badLabelWindow; } } if (Tk_IsTopLevel(labelframePtr->labelWin)) { - goto badWindow; + goto badLabelWindow; } if (labelframePtr->labelWin == framePtr->tkwin) { - goto badWindow; + goto badLabelWindow; } Tk_CreateEventHandler(labelframePtr->labelWin, - StructureNotifyMask, FrameStructureProc, - (ClientData) framePtr); + StructureNotifyMask, FrameStructureProc, framePtr); Tk_ManageGeometry(labelframePtr->labelWin, &frameGeomType, - (ClientData) framePtr); + framePtr); /* * If the frame is not parent to the label, make sure the @@ -1043,9 +1037,16 @@ ConfigureFrame( } } - FrameWorldChanged((ClientData) framePtr); - + FrameWorldChanged(framePtr); return TCL_OK; + + badLabelWindow: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as label in this frame", + Tk_PathName(labelframePtr->labelWin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); + labelframePtr->labelWin = NULL; + return TCL_ERROR; } /* @@ -1070,14 +1071,14 @@ static void FrameWorldChanged( ClientData instanceData) /* Information about widget. */ { - Frame *framePtr = (Frame *) instanceData; - Labelframe *labelframePtr = (Labelframe *) framePtr; + Frame *framePtr = instanceData; + Labelframe *labelframePtr = instanceData; Tk_Window tkwin = framePtr->tkwin; XGCValues gcValues; GC gc; int anyTextLabel, anyWindowLabel; int bWidthLeft, bWidthRight, bWidthTop, bWidthBottom; - char *labelText; + const char *labelText; anyTextLabel = (framePtr->type == TYPE_LABELFRAME) && (labelframePtr->textPtr != NULL) && @@ -1110,14 +1111,17 @@ FrameWorldChanged( if (anyTextLabel) { labelText = Tcl_GetString(labelframePtr->textPtr); Tk_FreeTextLayout(labelframePtr->textLayout); - labelframePtr->textLayout = Tk_ComputeTextLayout(labelframePtr->tkfont, + labelframePtr->textLayout = + Tk_ComputeTextLayout(labelframePtr->tkfont, labelText, -1, 0, TK_JUSTIFY_CENTER, 0, - &labelframePtr->labelReqWidth, &labelframePtr->labelReqHeight); + &labelframePtr->labelReqWidth, + &labelframePtr->labelReqHeight); labelframePtr->labelReqWidth += 2 * LABELSPACING; labelframePtr->labelReqHeight += 2 * LABELSPACING; } else if (anyWindowLabel) { labelframePtr->labelReqWidth = Tk_ReqWidth(labelframePtr->labelWin); - labelframePtr->labelReqHeight = Tk_ReqHeight(labelframePtr->labelWin); + labelframePtr->labelReqHeight = + Tk_ReqHeight(labelframePtr->labelWin); } /* @@ -1210,7 +1214,7 @@ FrameWorldChanged( if (Tk_IsMapped(tkwin)) { if (!(framePtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr); + Tcl_DoWhenIdle(DisplayFrame, framePtr); } framePtr->flags |= REDRAW_PENDING; } @@ -1247,7 +1251,9 @@ ComputeFrameGeometry( * We have nothing to do here unless there is a label. */ - if (framePtr->type != TYPE_LABELFRAME) return; + if (framePtr->type != TYPE_LABELFRAME) { + return; + } if (labelframePtr->textPtr == NULL && labelframePtr->labelWin == NULL) { return; } @@ -1273,10 +1279,14 @@ ComputeFrameGeometry( if ((labelframePtr->labelAnchor >= LABELANCHOR_N) && (labelframePtr->labelAnchor <= LABELANCHOR_SW)) { maxWidth -= padding; - if (maxWidth < 1) maxWidth = 1; + if (maxWidth < 1) { + maxWidth = 1; + } } else { maxHeight -= padding; - if (maxHeight < 1) maxHeight = 1; + if (maxHeight < 1) { + maxHeight = 1; + } } if (labelframePtr->labelBox.width > maxWidth) { labelframePtr->labelBox.width = maxWidth; @@ -1379,7 +1389,7 @@ static void DisplayFrame( ClientData clientData) /* Information about widget. */ { - register Frame *framePtr = (Frame *) clientData; + register Frame *framePtr = clientData; register Tk_Window tkwin = framePtr->tkwin; int bdX1, bdY1, bdX2, bdY2, hlWidth; Pixmap pixmap; @@ -1416,7 +1426,9 @@ DisplayFrame( * If -background is set to "", no interior is drawn. */ - if (framePtr->border == NULL) return; + if (framePtr->border == NULL) { + return; + } if (framePtr->type != TYPE_LABELFRAME) { /* @@ -1547,7 +1559,8 @@ DisplayFrame( || (labelframePtr->labelBox.height != Tk_Height(labelframePtr->labelWin))) { Tk_MoveResizeWindow(labelframePtr->labelWin, - labelframePtr->labelBox.x, labelframePtr->labelBox.y, + labelframePtr->labelBox.x, + labelframePtr->labelBox.y, labelframePtr->labelBox.width, labelframePtr->labelBox.height); } @@ -1560,7 +1573,6 @@ DisplayFrame( } } - #ifndef TK_NO_DOUBLE_BUFFERING /* * Everything's been redisplayed; now copy the pixmap onto the screen @@ -1602,7 +1614,7 @@ FrameEventProc( ClientData clientData, /* Information about window. */ register XEvent *eventPtr) /* Information about event. */ { - register Frame *framePtr = (Frame *) clientData; + register Frame *framePtr = clientData; if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) { goto redraw; @@ -1636,15 +1648,15 @@ FrameEventProc( Tk_DeleteEventHandler(framePtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - FrameEventProc, (ClientData) framePtr); + FrameEventProc, framePtr); framePtr->tkwin = NULL; Tcl_DeleteCommandFromToken(framePtr->interp, framePtr->widgetCmd); } if (framePtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayFrame, (ClientData) framePtr); + Tcl_CancelIdleCall(DisplayFrame, framePtr); } - Tcl_CancelIdleCall(MapFrame, (ClientData) framePtr); - Tcl_EventuallyFree((ClientData) framePtr, DestroyFrame); + Tcl_CancelIdleCall(MapFrame, framePtr); + Tcl_EventuallyFree(framePtr, (Tcl_FreeProc *) DestroyFrame); } else if (eventPtr->type == FocusIn) { if (eventPtr->xfocus.detail != NotifyInferior) { framePtr->flags |= GOT_FOCUS; @@ -1667,7 +1679,7 @@ FrameEventProc( redraw: if ((framePtr->tkwin != NULL) && !(framePtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr); + Tcl_DoWhenIdle(DisplayFrame, framePtr); framePtr->flags |= REDRAW_PENDING; } } @@ -1694,7 +1706,7 @@ static void FrameCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - Frame *framePtr = (Frame *) clientData; + Frame *framePtr = clientData; Tk_Window tkwin = framePtr->tkwin; if (framePtr->menuName != NULL) { @@ -1745,7 +1757,7 @@ static void MapFrame( ClientData clientData) /* Pointer to frame structure. */ { - Frame *framePtr = (Frame *) clientData; + Frame *framePtr = clientData; /* * Wait for all other background events to be processed before mapping @@ -1754,7 +1766,7 @@ MapFrame( * doesn't get a false idea of its desired geometry. */ - Tcl_Preserve((ClientData) framePtr); + Tcl_Preserve(framePtr); while (1) { if (Tcl_DoOneEvent(TCL_IDLE_EVENTS) == 0) { break; @@ -1766,12 +1778,12 @@ MapFrame( */ if (framePtr->tkwin == NULL) { - Tcl_Release((ClientData) framePtr); + Tcl_Release(framePtr); return; } } Tk_MapWindow(framePtr->tkwin); - Tcl_Release((ClientData) framePtr); + Tcl_Release(framePtr); } /* @@ -1800,8 +1812,8 @@ TkInstallFrameMenu( TkWindow *winPtr = (TkWindow *) tkwin; if (winPtr->mainPtr != NULL) { - Frame *framePtr; - framePtr = (Frame*) winPtr->instanceData; + Frame *framePtr = winPtr->instanceData; + if (framePtr == NULL) { Tcl_Panic("TkInstallFrameMenu couldn't get frame pointer"); } @@ -1833,7 +1845,7 @@ FrameStructureProc( ClientData clientData, /* Pointer to record describing frame. */ XEvent *eventPtr) /* Describes what just happened. */ { - Labelframe *labelframePtr = (Labelframe *) clientData; + Labelframe *labelframePtr = clientData; if (eventPtr->type == DestroyNotify) { /* @@ -1843,7 +1855,7 @@ FrameStructureProc( if (labelframePtr->frame.type == TYPE_LABELFRAME) { labelframePtr->labelWin = NULL; - FrameWorldChanged((ClientData) labelframePtr); + FrameWorldChanged(labelframePtr); } } } @@ -1871,9 +1883,9 @@ FrameRequestProc( ClientData clientData, /* Pointer to record for frame. */ Tk_Window tkwin) /* Window that changed its desired size. */ { - Frame *framePtr = (Frame *) clientData; + Frame *framePtr = clientData; - FrameWorldChanged((ClientData) framePtr); + FrameWorldChanged(framePtr); } /* @@ -1899,8 +1911,8 @@ FrameLostSlaveProc( * stolen away. */ Tk_Window tkwin) /* Tk's handle for the slave window. */ { - Frame *framePtr = (Frame *) clientData; - Labelframe *labelframePtr = (Labelframe *) clientData; + Frame *framePtr = clientData; + Labelframe *labelframePtr = clientData; /* * This should only happen in a labelframe but it doesn't hurt to be @@ -1909,40 +1921,47 @@ FrameLostSlaveProc( if (labelframePtr->frame.type == TYPE_LABELFRAME) { Tk_DeleteEventHandler(labelframePtr->labelWin, StructureNotifyMask, - FrameStructureProc, (ClientData) labelframePtr); + FrameStructureProc, labelframePtr); if (framePtr->tkwin != Tk_Parent(labelframePtr->labelWin)) { Tk_UnmaintainGeometry(labelframePtr->labelWin, framePtr->tkwin); } Tk_UnmapWindow(labelframePtr->labelWin); labelframePtr->labelWin = NULL; } - FrameWorldChanged((ClientData) framePtr); + FrameWorldChanged(framePtr); } void -TkMapTopFrame (tkwin) - Tk_Window tkwin; +TkMapTopFrame( + Tk_Window tkwin) { - Frame *framePtr = ((TkWindow*)tkwin)->instanceData; + Frame *framePtr = ((TkWindow *) tkwin)->instanceData; Tk_OptionTable optionTable; + if (Tk_IsTopLevel(tkwin) && framePtr->type == TYPE_FRAME) { framePtr->type = TYPE_TOPLEVEL; - Tcl_DoWhenIdle(MapFrame, (ClientData)framePtr); + Tcl_DoWhenIdle(MapFrame, framePtr); if (framePtr->menuName != NULL) { TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin, NULL, - framePtr->menuName); + framePtr->menuName); } } else if (!Tk_IsTopLevel(tkwin) && framePtr->type == TYPE_TOPLEVEL) { framePtr->type = TYPE_FRAME; } else { - /* Not a frame or toplevel, skip it */ + /* + * Not a frame or toplevel, skip it. + */ + return; } + /* - * The option table has already been created so - * the cached pointer will be returned. + * The option table has already been created so the cached pointer will be + * returned. */ - optionTable = Tk_CreateOptionTable(framePtr->interp, optionSpecs[framePtr->type]); + + optionTable = Tk_CreateOptionTable(framePtr->interp, + optionSpecs[framePtr->type]); framePtr->optionTable = optionTable; } @@ -1969,7 +1988,7 @@ TkMapTopFrame (tkwin) Tk_Window TkToplevelWindowForCommand( Tcl_Interp *interp, - CONST char *cmdName) + const char *cmdName) { Tcl_CmdInfo cmdInfo; Frame *framePtr; @@ -1980,7 +1999,7 @@ TkToplevelWindowForCommand( if (cmdInfo.objProc != FrameWidgetObjCmd) { return NULL; } - framePtr = (Frame *) cmdInfo.objClientData; + framePtr = cmdInfo.objClientData; if (framePtr->type != TYPE_TOPLEVEL) { return NULL; } diff --git a/generic/tkGC.c b/generic/tkGC.c index 800e4d3..5663ede 100644 --- a/generic/tkGC.c +++ b/generic/tkGC.c @@ -218,7 +218,7 @@ Tk_GetGC( valueHashPtr = Tcl_CreateHashEntry(&dispPtr->gcValueTable, (char *) &valueKey, &isNew); if (!isNew) { - gcPtr = (TkGC *) Tcl_GetHashValue(valueHashPtr); + gcPtr = Tcl_GetHashValue(valueHashPtr); gcPtr->refCount++; return gcPtr->gc; } @@ -228,7 +228,7 @@ Tk_GetGC( * and add a new structure to the database. */ - gcPtr = (TkGC *) ckalloc(sizeof(TkGC)); + gcPtr = ckalloc(sizeof(TkGC)); /* * Find or make a drawable to use to specify the screen and depth of the @@ -311,14 +311,14 @@ Tk_FreeGC( if (idHashPtr == NULL) { Tcl_Panic("Tk_FreeGC received unknown gc argument"); } - gcPtr = (TkGC *) Tcl_GetHashValue(idHashPtr); + gcPtr = Tcl_GetHashValue(idHashPtr); gcPtr->refCount--; if (gcPtr->refCount == 0) { Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc)); XFreeGC(gcPtr->display, gcPtr->gc); Tcl_DeleteHashEntry(gcPtr->valueHashPtr); Tcl_DeleteHashEntry(idHashPtr); - ckfree((char *) gcPtr); + ckfree(gcPtr); } } @@ -349,7 +349,7 @@ TkGCCleanup( for (entryPtr = Tcl_FirstHashEntry(&dispPtr->gcIdTable, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - gcPtr = (TkGC *) Tcl_GetHashValue(entryPtr); + gcPtr = Tcl_GetHashValue(entryPtr); /* * This call is not needed, as it is only used on Unix to restore the @@ -360,7 +360,7 @@ TkGCCleanup( XFreeGC(gcPtr->display, gcPtr->gc); Tcl_DeleteHashEntry(gcPtr->valueHashPtr); Tcl_DeleteHashEntry(entryPtr); - ckfree((char *) gcPtr); + ckfree(gcPtr); } Tcl_DeleteHashTable(&dispPtr->gcValueTable); Tcl_DeleteHashTable(&dispPtr->gcIdTable); diff --git a/generic/tkGeometry.c b/generic/tkGeometry.c index 4c8e4f8..2e0009a 100644 --- a/generic/tkGeometry.c +++ b/generic/tkGeometry.c @@ -84,7 +84,7 @@ void Tk_ManageGeometry( Tk_Window tkwin, /* Window whose geometry is to be managed by * proc. */ - CONST Tk_GeomMgr *mgrPtr, /* Static structure describing the geometry + const Tk_GeomMgr *mgrPtr, /* Static structure describing the geometry * manager. This structure must never go * away. */ ClientData clientData) /* Arbitrary one-word argument to pass to @@ -96,7 +96,7 @@ Tk_ManageGeometry( && ((winPtr->geomMgrPtr != mgrPtr) || (winPtr->geomData != clientData)) && (winPtr->geomMgrPtr->lostSlaveProc != NULL)) { - (*winPtr->geomMgrPtr->lostSlaveProc)(winPtr->geomData, tkwin); + winPtr->geomMgrPtr->lostSlaveProc(winPtr->geomData, tkwin); } winPtr->geomMgrPtr = mgrPtr; @@ -152,7 +152,7 @@ Tk_GeometryRequest( winPtr->reqHeight = reqHeight; if ((winPtr->geomMgrPtr != NULL) && (winPtr->geomMgrPtr->requestProc != NULL)) { - (*winPtr->geomMgrPtr->requestProc)(winPtr->geomData, tkwin); + winPtr->geomMgrPtr->requestProc(winPtr->geomData, tkwin); } } @@ -304,6 +304,88 @@ Tk_SetMinimumRequestSize( /* *---------------------------------------------------------------------- * + * TkSetGeometryMaster -- + * + * Set a geometry master for this window. Only one master may own + * a window at any time. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * The geometry master is recorded for the window. + * + *---------------------------------------------------------------------- + */ + +int +TkSetGeometryMaster( + Tcl_Interp *interp, /* Current interpreter, for error. */ + Tk_Window tkwin, /* Window that will have geometry master + * set. */ + const char *master) /* The master identity. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + if (winPtr->geometryMaster != NULL && + strcmp(winPtr->geometryMaster, master) == 0) { + return TCL_OK; + } + if (winPtr->geometryMaster != NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot use geometry manager %s inside %s which already" + " has slaves managed by %s", + master, Tk_PathName(tkwin), winPtr->geometryMaster)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "FIGHT", NULL); + } + return TCL_ERROR; + } + + winPtr->geometryMaster = ckalloc(strlen(master) + 1); + strcpy(winPtr->geometryMaster, master); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TkFreeGeometryMaster -- + * + * Remove a geometry master for this window. Only one master may own + * a window at any time. + * + * Results: + * None. + * + * Side effects: + * The geometry master is cleared for the window. + * + *---------------------------------------------------------------------- + */ + +void +TkFreeGeometryMaster( + Tk_Window tkwin, /* Window that will have geometry master + * cleared. */ + const char *master) /* The master identity. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + if (winPtr->geometryMaster != NULL && + strcmp(winPtr->geometryMaster, master) != 0) { + Tcl_Panic("Trying to free %s from geometry manager %s", + winPtr->geometryMaster, master); + } + if (winPtr->geometryMaster != NULL) { + ckfree(winPtr->geometryMaster); + winPtr->geometryMaster = NULL; + } +} + +/* + *---------------------------------------------------------------------- + * * Tk_MaintainGeometry -- * * This procedure is invoked by geometry managers to handle slaves whose @@ -379,9 +461,9 @@ Tk_MaintainGeometry( hPtr = Tcl_CreateHashEntry(&dispPtr->maintainHashTable, (char *) master, &isNew); if (!isNew) { - masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr); + masterPtr = Tcl_GetHashValue(hPtr); } else { - masterPtr = (MaintainMaster *) ckalloc(sizeof(MaintainMaster)); + masterPtr = ckalloc(sizeof(MaintainMaster)); masterPtr->ancestor = master; masterPtr->checkScheduled = 0; masterPtr->slavePtr = NULL; @@ -399,13 +481,13 @@ Tk_MaintainGeometry( goto gotSlave; } } - slavePtr = (MaintainSlave *) ckalloc(sizeof(MaintainSlave)); + slavePtr = ckalloc(sizeof(MaintainSlave)); slavePtr->slave = slave; slavePtr->master = master; slavePtr->nextPtr = masterPtr->slavePtr; masterPtr->slavePtr = slavePtr; Tk_CreateEventHandler(slave, StructureNotifyMask, MaintainSlaveProc, - (ClientData) slavePtr); + slavePtr); /* * Make sure that there are event handlers registered for all the windows @@ -418,7 +500,7 @@ Tk_MaintainGeometry( ancestor = Tk_Parent(ancestor)) { if (ancestor == masterPtr->ancestor) { Tk_CreateEventHandler(ancestor, StructureNotifyMask, - MaintainMasterProc, (ClientData) masterPtr); + MaintainMasterProc, masterPtr); masterPtr->ancestor = Tk_Parent(ancestor); } } @@ -509,7 +591,7 @@ Tk_UnmaintainGeometry( if (hPtr == NULL) { return; } - masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr); + masterPtr = Tcl_GetHashValue(hPtr); slavePtr = masterPtr->slavePtr; if (slavePtr->slave == slave) { masterPtr->slavePtr = slavePtr->nextPtr; @@ -526,23 +608,23 @@ Tk_UnmaintainGeometry( } } Tk_DeleteEventHandler(slavePtr->slave, StructureNotifyMask, - MaintainSlaveProc, (ClientData) slavePtr); - ckfree((char *) slavePtr); + MaintainSlaveProc, slavePtr); + ckfree(slavePtr); if (masterPtr->slavePtr == NULL) { if (masterPtr->ancestor != NULL) { for (ancestor = master; ; ancestor = Tk_Parent(ancestor)) { Tk_DeleteEventHandler(ancestor, StructureNotifyMask, - MaintainMasterProc, (ClientData) masterPtr); + MaintainMasterProc, masterPtr); if (ancestor == masterPtr->ancestor) { break; } } } if (masterPtr->checkScheduled) { - Tcl_CancelIdleCall(MaintainCheckProc, (ClientData) masterPtr); + Tcl_CancelIdleCall(MaintainCheckProc, masterPtr); } Tcl_DeleteHashEntry(hPtr); - ckfree((char *) masterPtr); + ckfree(masterPtr); } } @@ -573,7 +655,7 @@ MaintainMasterProc( * master window. */ XEvent *eventPtr) /* Describes what just happened. */ { - MaintainMaster *masterPtr = (MaintainMaster *) clientData; + MaintainMaster *masterPtr = clientData; MaintainSlave *slavePtr; int done; @@ -582,7 +664,7 @@ MaintainMasterProc( || (eventPtr->type == UnmapNotify)) { if (!masterPtr->checkScheduled) { masterPtr->checkScheduled = 1; - Tcl_DoWhenIdle(MaintainCheckProc, (ClientData) masterPtr); + Tcl_DoWhenIdle(MaintainCheckProc, masterPtr); } } else if (eventPtr->type == DestroyNotify) { /* @@ -627,7 +709,7 @@ MaintainSlaveProc( * master-slave pair. */ XEvent *eventPtr) /* Describes what just happened. */ { - MaintainSlave *slavePtr = (MaintainSlave *) clientData; + MaintainSlave *slavePtr = clientData; if (eventPtr->type == DestroyNotify) { Tk_UnmaintainGeometry(slavePtr->slave, slavePtr->master); @@ -659,7 +741,7 @@ MaintainCheckProc( ClientData clientData) /* Pointer to MaintainMaster structure for the * master window. */ { - MaintainMaster *masterPtr = (MaintainMaster *) clientData; + MaintainMaster *masterPtr = clientData; MaintainSlave *slavePtr; Tk_Window ancestor, parent; int x, y, map; diff --git a/generic/tkGet.c b/generic/tkGet.c index 9fc0d50..d58b4a5 100644 --- a/generic/tkGet.c +++ b/generic/tkGet.c @@ -35,10 +35,10 @@ static void FreeUidThreadExitProc(ClientData clientData); * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj. */ -static CONST char *anchorStrings[] = { +static const char *const anchorStrings[] = { "n", "ne", "e", "se", "s", "sw", "w", "nw", "center", NULL }; -static CONST char *justifyStrings[] = { +static const char *const justifyStrings[] = { "left", "right", "center", NULL }; @@ -101,7 +101,7 @@ Tk_GetAnchorFromObj( int Tk_GetAnchor( Tcl_Interp *interp, /* Use this for error reporting. */ - CONST char *string, /* String describing a direction. */ + const char *string, /* String describing a direction. */ Tk_Anchor *anchorPtr) /* Where to store Tk_Anchor corresponding to * string. */ { @@ -152,8 +152,10 @@ Tk_GetAnchor( } error: - Tcl_AppendResult(interp, "bad anchor position \"", string, - "\": must be n, ne, e, se, s, sw, w, nw, or center", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad anchor position \"%s\": must be" + " n, ne, e, se, s, sw, w, nw, or center", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ANCHOR", NULL); return TCL_ERROR; } @@ -173,7 +175,7 @@ Tk_GetAnchor( *-------------------------------------------------------------- */ -CONST char * +const char * Tk_NameOfAnchor( Tk_Anchor anchor) /* Anchor for which identifying string is * desired. */ @@ -214,7 +216,7 @@ Tk_NameOfAnchor( int Tk_GetJoinStyle( Tcl_Interp *interp, /* Use this for error reporting. */ - CONST char *string, /* String describing a justification style. */ + const char *string, /* String describing a justification style. */ int *joinPtr) /* Where to store join style corresponding to * string. */ { @@ -237,8 +239,10 @@ Tk_GetJoinStyle( return TCL_OK; } - Tcl_AppendResult(interp, "bad join style \"", string, - "\": must be bevel, miter, or round", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad join style \"%s\": must be bevel, miter, or round", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "JOIN", NULL); return TCL_ERROR; } @@ -258,7 +262,7 @@ Tk_GetJoinStyle( *-------------------------------------------------------------- */ -CONST char * +const char * Tk_NameOfJoinStyle( int join) /* Join style for which identifying string is * desired. */ @@ -293,7 +297,7 @@ Tk_NameOfJoinStyle( int Tk_GetCapStyle( Tcl_Interp *interp, /* Use this for error reporting. */ - CONST char *string, /* String describing a justification style. */ + const char *string, /* String describing a justification style. */ int *capPtr) /* Where to store cap style corresponding to * string. */ { @@ -316,8 +320,10 @@ Tk_GetCapStyle( return TCL_OK; } - Tcl_AppendResult(interp, "bad cap style \"", string, - "\": must be butt, projecting, or round", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad cap style \"%s\": must be butt, projecting, or round", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CAP", NULL); return TCL_ERROR; } @@ -337,7 +343,7 @@ Tk_GetCapStyle( *-------------------------------------------------------------- */ -CONST char * +const char * Tk_NameOfCapStyle( int cap) /* Cap style for which identifying string is * desired. */ @@ -409,7 +415,7 @@ Tk_GetJustifyFromObj( int Tk_GetJustify( Tcl_Interp *interp, /* Use this for error reporting. */ - CONST char *string, /* String describing a justification style. */ + const char *string, /* String describing a justification style. */ Tk_Justify *justifyPtr) /* Where to store Tk_Justify corresponding to * string. */ { @@ -432,8 +438,10 @@ Tk_GetJustify( return TCL_OK; } - Tcl_AppendResult(interp, "bad justification \"", string, - "\": must be left, right, or center", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad justification \"%s\": must be left, right, or center", + string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "JUSTIFY", NULL); return TCL_ERROR; } @@ -454,7 +462,7 @@ Tk_GetJustify( *-------------------------------------------------------------- */ -CONST char * +const char * Tk_NameOfJustify( Tk_Justify justify) /* Justification style for which identifying * string is desired. */ @@ -487,8 +495,9 @@ static void FreeUidThreadExitProc( ClientData clientData) /* Not used. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_DeleteHashTable(&tsdPtr->uidTable); tsdPtr->initialized = 0; } @@ -517,10 +526,10 @@ FreeUidThreadExitProc( Tk_Uid Tk_GetUid( - CONST char *string) /* String to convert. */ + const char *string) /* String to convert. */ { int dummy; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_HashTable *tablePtr = &tsdPtr->uidTable; @@ -559,7 +568,7 @@ Tk_GetScreenMM( Tk_Window tkwin, /* Window whose screen determines conversion * from centimeters and other absolute * units. */ - CONST char *string, /* String describing a screen distance. */ + const char *string, /* String describing a screen distance. */ double *doublePtr) /* Place to store converted result. */ { char *end; @@ -567,9 +576,7 @@ Tk_GetScreenMM( d = strtod(string, &end); if (end == string) { - error: - Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", NULL); - return TCL_ERROR; + goto error; } while ((*end != '\0') && isspace(UCHAR(*end))) { end++; @@ -605,6 +612,12 @@ Tk_GetScreenMM( } *doublePtr = d; return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCREEN_DISTANCE", NULL); + return TCL_ERROR; } /* @@ -633,7 +646,7 @@ Tk_GetPixels( Tk_Window tkwin, /* Window whose screen determines conversion * from centimeters and other absolute * units. */ - CONST char *string, /* String describing a number of pixels. */ + const char *string, /* String describing a number of pixels. */ int *intPtr) /* Place to store converted result. */ { double d; @@ -658,7 +671,6 @@ Tk_GetPixels( * string. * * Results: - * The return value is a standard Tcl return result. If TCL_OK is * returned, then everything went well and the pixel distance is stored * at *doublePtr; otherwise TCL_ERROR is returned and an error message is @@ -676,7 +688,7 @@ TkGetDoublePixels( Tk_Window tkwin, /* Window whose screen determines conversion * from centimeters and other absolute * units. */ - CONST char *string, /* String describing a number of pixels. */ + const char *string, /* String describing a number of pixels. */ double *doublePtr) /* Place to store converted result. */ { char *end; @@ -684,9 +696,7 @@ TkGetDoublePixels( d = strtod((char *) string, &end); if (end == string) { - error: - Tcl_AppendResult(interp, "bad screen distance \"", string, "\"", NULL); - return TCL_ERROR; + goto error; } while ((*end != '\0') && isspace(UCHAR(*end))) { end++; @@ -725,6 +735,12 @@ TkGetDoublePixels( } *doublePtr = d; return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FRACTIONAL_PIXELS", NULL); + return TCL_ERROR; } /* diff --git a/generic/tkGrab.c b/generic/tkGrab.c index 44a4f8c..00d4511 100644 --- a/generic/tkGrab.c +++ b/generic/tkGrab.c @@ -12,9 +12,9 @@ #include "tkInt.h" -#ifdef __WIN32__ +#ifdef _WIN32 #include "tkWinInt.h" -#elif !(defined(__WIN32__) || defined(MAC_OSX_TK)) +#elif !defined(MAC_OSX_TK) #include "tkUnixInt.h" #endif @@ -132,7 +132,7 @@ typedef struct NewGrabWinEvent { * we generated. */ -#define GENERATED_EVENT_MAGIC ((Bool) 0x147321ac) +#define GENERATED_GRAB_EVENT_MAGIC ((Bool) 0x147321ac) /* * Mask that selects any of the state bits corresponding to buttons, plus @@ -141,7 +141,7 @@ typedef struct NewGrabWinEvent { #define ALL_BUTTONS \ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask) -static unsigned int buttonStates[] = { +static const unsigned int buttonStates[] = { Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask }; @@ -152,7 +152,7 @@ static unsigned int buttonStates[] = { static void EatGrabEvents(TkDisplay *dispPtr, unsigned int serial); static TkWindow * FindCommonAncestor(TkWindow *winPtr1, TkWindow *winPtr2, int *countPtr1, int *countPtr2); -static Tk_RestrictAction GrabRestrictProc(ClientData arg, XEvent *eventPtr); +static Tk_RestrictProc GrabRestrictProc; static int GrabWinEventProc(Tcl_Event *evPtr, int flags); static void MovePointer2(TkWindow *sourcePtr, TkWindow *destPtr, int mode, int leaveEvents, int EnterEvents); @@ -183,18 +183,18 @@ Tk_GrabObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int globalGrab; Tk_Window tkwin; TkDisplay *dispPtr; - char *arg; + const char *arg; int index; int len; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "current", "release", "set", "status", NULL }; - static CONST char *flagStrings[] = { + static const char *const flagStrings[] = { "-global", NULL }; enum options { @@ -205,16 +205,21 @@ Tk_GrabObjCmd( /* * Can't use Tcl_WrongNumArgs here because we want the message to * read: - * wrong # args: should be "cmd ?-global window" or "cmd option - * ?arg arg ...?" + * wrong # args: should be "cmd ?-global? window" or "cmd option + * ?arg ...?" * We can fake it with Tcl_WrongNumArgs if we assume the command name * is "grab", but if it has been aliased, the message will be * incorrect. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "wrong # args: should be \"", - Tcl_GetString(objv[0]), " ?-global? window\" or \"", - Tcl_GetString(objv[0]), " option ?arg arg ...?\"", NULL); + + Tcl_WrongNumArgs(interp, 1, objv, "?-global? window"); + Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]), + " option ?arg ...?\"", NULL); + /* This API not exposed: + * + ((Interp *) interp)->flags |= INTERP_ALTERNATE_WRONG_ARGS; + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); + */ return TCL_ERROR; } @@ -229,7 +234,7 @@ Tk_GrabObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "?-global? window"); return TCL_ERROR; } - tkwin = Tk_NameToWindow(interp, arg, (Tk_Window) clientData); + tkwin = Tk_NameToWindow(interp, arg, clientData); if (tkwin == NULL) { return TCL_ERROR; } @@ -245,8 +250,7 @@ Tk_GrabObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "?-global? window"); return TCL_ERROR; } - tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), - (Tk_Window) clientData); + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), clientData); if (tkwin == NULL) { return TCL_ERROR; } @@ -272,23 +276,26 @@ Tk_GrabObjCmd( } if (objc == 3) { tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), - (Tk_Window) clientData); + clientData); if (tkwin == NULL) { return TCL_ERROR; } dispPtr = ((TkWindow *) tkwin)->dispPtr; if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_SetResult(interp, dispPtr->eventualGrabWinPtr->pathName, - TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) + dispPtr->eventualGrabWinPtr)); } } else { + Tcl_Obj *resultObj = Tcl_NewObj(); + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; dispPtr = dispPtr->nextPtr) { if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_AppendElement(interp, - dispPtr->eventualGrabWinPtr->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, TkNewWindowObj( + (Tk_Window) dispPtr->eventualGrabWinPtr)); } } + Tcl_SetObjResult(interp, resultObj); } return TCL_OK; @@ -298,8 +305,7 @@ Tk_GrabObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "release window"); return TCL_ERROR; } - tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), - (Tk_Window) clientData); + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), clientData); if (tkwin == NULL) { Tcl_ResetResult(interp); } else { @@ -316,7 +322,7 @@ Tk_GrabObjCmd( if (objc == 3) { globalGrab = 0; tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), - (Tk_Window) clientData); + clientData); } else { globalGrab = 1; @@ -332,7 +338,7 @@ Tk_GrabObjCmd( return TCL_ERROR; } tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[3]), - (Tk_Window) clientData); + clientData); } if (tkwin == NULL) { return TCL_ERROR; @@ -342,24 +348,26 @@ Tk_GrabObjCmd( case GRABCMD_STATUS: { /* [grab status window] */ TkWindow *winPtr; + const char *statusString; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "status window"); return TCL_ERROR; } winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]), - (Tk_Window) clientData); + clientData); if (winPtr == NULL) { return TCL_ERROR; } dispPtr = winPtr->dispPtr; if (dispPtr->eventualGrabWinPtr != winPtr) { - Tcl_SetResult(interp, "none", TCL_STATIC); + statusString = "none"; } else if (dispPtr->grabFlags & GRAB_GLOBAL) { - Tcl_SetResult(interp, "global", TCL_STATIC); + statusString = "global"; } else { - Tcl_SetResult(interp, "local", TCL_STATIC); + statusString = "local"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(statusString, -1)); break; } } @@ -412,16 +420,18 @@ Tk_Grab( return TCL_OK; } if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) { - alreadyGrabbed: - Tcl_SetResult(interp, "grab failed: another application has grab", - TCL_STATIC); - return TCL_ERROR; + goto alreadyGrabbed; } Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr); } Tk_MakeWindowExist(tkwin); - if (!grabGlobal) { +#ifndef MAC_OSX_TK + if (!grabGlobal) +#else + if (0) +#endif /* MAC_OSX_TK */ + { Window dummy1, dummy2; int dummy3, dummy4, dummy5, dummy6; unsigned int state; @@ -437,7 +447,7 @@ Tk_Grab( dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL); XQueryPointer(dispPtr->display, winPtr->window, &dummy1, &dummy2, &dummy3, &dummy4, &dummy5, &dummy6, &state); - if ((state & ALL_BUTTONS) != 0) { + if (state & ALL_BUTTONS) { dispPtr->grabFlags |= GRAB_TEMP_GLOBAL; goto setGlobalGrab; } @@ -476,26 +486,7 @@ Tk_Grab( Tcl_Sleep(100); } if (grabResult != 0) { - grabError: - if (grabResult == GrabNotViewable) { - Tcl_SetResult(interp, "grab failed: window not viewable", - TCL_STATIC); - } else if (grabResult == AlreadyGrabbed) { - goto alreadyGrabbed; - } else if (grabResult == GrabFrozen) { - Tcl_SetResult(interp, - "grab failed: keyboard or pointer frozen", TCL_STATIC); - } else if (grabResult == GrabInvalidTime) { - Tcl_SetResult(interp, "grab failed: invalid time", - TCL_STATIC); - } else { - char msg[64 + TCL_INTEGER_SPACE]; - - sprintf(msg, "grab failed for unknown reason (code %d)", - grabResult); - Tcl_AppendResult(interp, msg, NULL); - } - return TCL_ERROR; + goto grabError; } grabResult = XGrabKeyboard(dispPtr->display, Tk_WindowId(tkwin), False, GrabModeAsync, GrabModeAsync, CurrentTime); @@ -543,6 +534,31 @@ Tk_Grab( } QueueGrabWindowChange(dispPtr, winPtr); return TCL_OK; + + grabError: + if (grabResult == GrabNotViewable) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: window not viewable", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "UNVIEWABLE", NULL); + } else if (grabResult == AlreadyGrabbed) { + alreadyGrabbed: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: another application has grab", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "GRABBED", NULL); + } else if (grabResult == GrabFrozen) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: keyboard or pointer frozen", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "FROZEN", NULL); + } else if (grabResult == GrabInvalidTime) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "grab failed: invalid time", -1)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "BAD_TIME", NULL); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "grab failed for unknown reason (code %d)", grabResult)); + Tcl_SetErrorCode(interp, "TK", "GRAB", "UNKNOWN", NULL); + } + return TCL_ERROR; } /* @@ -724,7 +740,7 @@ TkPointerEvent( * serverWinPtr. */ - if (eventPtr->xcrossing.send_event != GENERATED_EVENT_MAGIC) { + if (eventPtr->xcrossing.send_event != GENERATED_GRAB_EVENT_MAGIC) { if ((eventPtr->type == LeaveNotify) && (winPtr->flags & TK_TOP_HIERARCHY)) { dispPtr->serverWinPtr = NULL; @@ -843,7 +859,7 @@ TkPointerEvent( } } if (eventPtr->type == ButtonPress) { - if ((eventPtr->xbutton.state & ALL_BUTTONS) == 0) { + if (!(eventPtr->xbutton.state & ALL_BUTTONS)) { if (outsideGrabTree) { TkChangeEventWindow(eventPtr, dispPtr->grabWinPtr); Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD); @@ -1153,7 +1169,7 @@ MovePointer2( } event.xcrossing.serial = LastKnownRequestProcessed(winPtr->display); - event.xcrossing.send_event = GENERATED_EVENT_MAGIC; + event.xcrossing.send_event = GENERATED_GRAB_EVENT_MAGIC; event.xcrossing.display = winPtr->display; event.xcrossing.root = RootWindow(winPtr->display, winPtr->screenNum); event.xcrossing.time = TkCurrentTime(winPtr->dispPtr); @@ -1239,17 +1255,18 @@ EatGrabEvents( unsigned int serial) /* Only discard events that have a serial * number at least this great. */ { - Tk_RestrictProc *oldProc; + Tk_RestrictProc *prevProc; GrabInfo info; - ClientData oldArg, dummy; + ClientData prevArg; info.display = dispPtr->display; info.serial = serial; TkpSync(info.display); - oldProc = Tk_RestrictEvents(GrabRestrictProc, (ClientData)&info, &oldArg); + prevProc = Tk_RestrictEvents(GrabRestrictProc, &info, &prevArg); while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) { + /* EMPTY */ } - Tk_RestrictEvents(oldProc, oldArg, &dummy); + Tk_RestrictEvents(prevProc, prevArg, &prevArg); } /* @@ -1276,7 +1293,7 @@ GrabRestrictProc( ClientData arg, XEvent *eventPtr) { - GrabInfo *info = (GrabInfo *) arg; + GrabInfo *info = arg; int mode, diff; /* @@ -1334,7 +1351,7 @@ QueueGrabWindowChange( { NewGrabWinEvent *grabEvPtr; - grabEvPtr = (NewGrabWinEvent *) ckalloc(sizeof(NewGrabWinEvent)); + grabEvPtr = ckalloc(sizeof(NewGrabWinEvent)); grabEvPtr->header.proc = GrabWinEventProc; grabEvPtr->dispPtr = dispPtr; if (grabWinPtr == NULL) { diff --git a/generic/tkGrid.c b/generic/tkGrid.c index ccdde19..2a88b76 100644 --- a/generic/tkGrid.c +++ b/generic/tkGrid.c @@ -241,10 +241,13 @@ typedef struct UniformGroup { * size. 0 means if this window is a master then * Tk will set its requested size to fit the * needs of its slaves. + * ALLOCED_MASTER 1 means that Grid has allocated itself as + * geometry master for this window. */ #define REQUESTED_RELAYOUT 1 #define DONT_PROPAGATE 2 +#define ALLOCED_MASTER 4 /* * Prototypes for procedures used only in this file: @@ -258,31 +261,31 @@ static void ArrangeGrid(ClientData clientData); static int CheckSlotData(Gridder *masterPtr, int slot, int slotType, int checkOnly); static int ConfigureSlaves(Tcl_Interp *interp, Tk_Window tkwin, - int objc, Tcl_Obj *CONST objv[]); -static void DestroyGrid(char *memPtr); + int objc, Tcl_Obj *const objv[]); +static void DestroyGrid(void *memPtr); static Gridder * GetGrid(Tk_Window tkwin); static int GridAnchorCommand(Tk_Window tkwin, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int GridBboxCommand(Tk_Window tkwin, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int GridForgetRemoveCommand(Tk_Window tkwin, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int GridInfoCommand(Tk_Window tkwin, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int GridLocationCommand(Tk_Window tkwin, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int GridPropagateCommand(Tk_Window tkwin, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int GridRowColumnConfigureCommand(Tk_Window tkwin, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int GridSizeCommand(Tk_Window tkwin, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int GridSlavesCommand(Tk_Window tkwin, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static void GridStructureProc(ClientData clientData, XEvent *eventPtr); static void GridLostSlaveProc(ClientData clientData, @@ -298,8 +301,8 @@ static int SetSlaveColumn(Tcl_Interp *interp, Gridder *slavePtr, int column, int numCols); static int SetSlaveRow(Tcl_Interp *interp, Gridder *slavePtr, int row, int numRows); -static void StickyToString(int flags, char *result); -static int StringToSticky(char *string); +static Tcl_Obj * StickyToObj(int flags); +static int StringToSticky(const char *string); static void Unlink(Gridder *gridPtr); static const Tk_GeomMgr gridMgrType = { @@ -330,10 +333,10 @@ Tk_GridObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; - static CONST char *optionStrings[] = { + Tk_Window tkwin = clientData; + static const char *const optionStrings[] = { "anchor", "bbox", "columnconfigure", "configure", "forget", "info", "location", "propagate", "remove", "rowconfigure", "size", "slaves", NULL @@ -346,7 +349,7 @@ Tk_GridObjCmd( int index; if (objc >= 2) { - char *argv1 = Tcl_GetString(objv[1]); + const char *argv1 = Tcl_GetString(objv[1]); if ((argv1[0] == '.') || (argv1[0] == REL_SKIP) || (argv1[0] == REL_VERT)) { @@ -358,8 +361,8 @@ Tk_GridObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -399,7 +402,8 @@ Tk_GridObjCmd( } /* This should not happen */ - Tcl_SetResult(interp, "Internal error in grid.", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("internal error in grid", -1)); + Tcl_SetErrorCode(interp, "TK", "API_ABUSE", NULL); return TCL_ERROR; } @@ -425,7 +429,7 @@ GridAnchorCommand( Tk_Window tkwin, /* Main window of the application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window master; Gridder *masterPtr; @@ -444,8 +448,9 @@ GridAnchorCommand( if (objc == 3) { gridPtr = masterPtr->masterDataPtr; - Tcl_SetResult(interp, (char *) Tk_NameOfAnchor(gridPtr == NULL ? - GRID_DEFAULT_ANCHOR : gridPtr->anchor), TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfAnchor(gridPtr?gridPtr->anchor:GRID_DEFAULT_ANCHOR), + -1)); return TCL_OK; } @@ -466,7 +471,7 @@ GridAnchorCommand( } if (!(masterPtr->flags & REQUESTED_RELAYOUT)) { masterPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangeGrid, masterPtr); } } return TCL_OK; @@ -493,7 +498,7 @@ GridBboxCommand( Tk_Window tkwin, /* Main window of the application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window master; Gridder *masterPtr; /* master grid record */ @@ -623,12 +628,12 @@ GridForgetRemoveCommand( Tk_Window tkwin, /* Main window of the application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window slave; Gridder *slavePtr; int i; - char *string = Tcl_GetString(objv[1]); + const char *string = Tcl_GetString(objv[1]); char c = string[0]; for (i = 2; i < objc; i++) { @@ -659,7 +664,7 @@ GridForgetRemoveCommand( } slavePtr->doubleBw = 2*Tk_Changes(tkwin)->border_width; if (slavePtr->flags & REQUESTED_RELAYOUT) { - Tcl_CancelIdleCall(ArrangeGrid, (ClientData) slavePtr); + Tcl_CancelIdleCall(ArrangeGrid, slavePtr); } slavePtr->flags = 0; slavePtr->sticky = 0; @@ -679,7 +684,7 @@ GridForgetRemoveCommand( Tcl_IncrRefCount(slavePtr->in); } } - Tk_ManageGeometry(slave, NULL, (ClientData) NULL); + Tk_ManageGeometry(slave, NULL, NULL); if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) { Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin); @@ -713,11 +718,11 @@ GridInfoCommand( Tk_Window tkwin, /* Main window of the application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register Gridder *slavePtr; Tk_Window slave; - char buffer[64 + TCL_INTEGER_SPACE * 4]; + Tcl_Obj *infoObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -732,18 +737,24 @@ GridInfoCommand( return TCL_OK; } - Tcl_AppendElement(interp, "-in"); - Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin)); - sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d", - slavePtr->column, slavePtr->row, - slavePtr->numCols, slavePtr->numRows); - Tcl_AppendResult(interp, buffer, NULL); - TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX); - TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY); - TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX); - TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY); - StickyToString(slavePtr->sticky, buffer); - Tcl_AppendResult(interp, " -sticky ", buffer, NULL); + infoObj = Tcl_NewObj(); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1), + TkNewWindowObj(slavePtr->masterPtr->tkwin)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-column", -1), + Tcl_NewIntObj(slavePtr->column)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-row", -1), + Tcl_NewIntObj(slavePtr->row)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-columnspan", -1), + Tcl_NewIntObj(slavePtr->numCols)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-rowspan", -1), + Tcl_NewIntObj(slavePtr->numRows)); + TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX); + TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY); + TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft, slavePtr->padX); + TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-sticky", -1), + StickyToObj(slavePtr->sticky)); + Tcl_SetObjResult(interp, infoObj); return TCL_OK; } @@ -769,7 +780,7 @@ GridLocationCommand( Tk_Window tkwin, /* Main window of the application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window master; Gridder *masterPtr; /* Master grid record. */ @@ -809,8 +820,8 @@ GridLocationCommand( */ while (masterPtr->flags & REQUESTED_RELAYOUT) { - Tcl_CancelIdleCall(ArrangeGrid, (ClientData) masterPtr); - ArrangeGrid((ClientData) masterPtr); + Tcl_CancelIdleCall(ArrangeGrid, masterPtr); + ArrangeGrid(masterPtr); } SetGridSize(masterPtr); endX = MAX(gridPtr->columnEnd, gridPtr->columnMax); @@ -862,7 +873,7 @@ GridPropagateCommand( Tk_Window tkwin, /* Main window of the application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window master; Gridder *masterPtr; @@ -893,8 +904,22 @@ GridPropagateCommand( old = !(masterPtr->flags & DONT_PROPAGATE); if (propagate != old) { if (propagate) { + /* + * If we have slaves, we need to register as geometry master. + */ + + if (masterPtr->slavePtr != NULL) { + if (TkSetGeometryMaster(interp, master, "grid") != TCL_OK) { + return TCL_ERROR; + } + masterPtr->flags |= ALLOCED_MASTER; + } masterPtr->flags &= ~DONT_PROPAGATE; } else { + if (masterPtr->flags & ALLOCED_MASTER) { + TkFreeGeometryMaster(master, "grid"); + masterPtr->flags &= ~ALLOCED_MASTER; + } masterPtr->flags |= DONT_PROPAGATE; } @@ -908,7 +933,7 @@ GridPropagateCommand( } if (!(masterPtr->flags & REQUESTED_RELAYOUT)) { masterPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangeGrid, masterPtr); } } return TCL_OK; @@ -936,7 +961,7 @@ GridRowColumnConfigureCommand( Tk_Window tkwin, /* Main window of the application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window master, slave; Gridder *masterPtr, *slavePtr; @@ -948,8 +973,8 @@ GridRowColumnConfigureCommand( Tcl_Obj **lObjv; /* array of indices */ int ok; /* temporary TCL result code */ int i, j, first, last; - char *string; - static CONST char *optionStrings[] = { + const char *string; + static const char *const optionStrings[] = { "-minsize", "-pad", "-uniform", "-weight", NULL }; enum options { @@ -959,7 +984,7 @@ GridRowColumnConfigureCommand( Tcl_Obj *listCopy; if (((objc % 2 != 0) && (objc > 6)) || (objc < 4)) { - Tcl_WrongNumArgs(interp, 2, objv, "master index ?-option value...?"); + Tcl_WrongNumArgs(interp, 2, objv, "master index ?-option value ...?"); return TCL_ERROR; } @@ -977,9 +1002,9 @@ GridRowColumnConfigureCommand( string = Tcl_GetString(objv[1]); slotType = (*string == 'c') ? COLUMN : ROW; if (lObjc == 0) { - Tcl_AppendResult(interp, "no ", - (slotType == COLUMN) ? "column" : "row", - " indices specified", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("no %s indices specified", + (slotType == COLUMN) ? "column" : "row")); + Tcl_SetErrorCode(interp, "TK", "GRID", "NO_INDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -990,16 +1015,17 @@ GridRowColumnConfigureCommand( if ((objc == 4) || (objc == 5)) { if (lObjc != 1) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), - ": must specify a single element on retrieval", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify a single element on retrieval", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "USAGE", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, lObjv[0], &slot) != TCL_OK) { Tcl_AppendResult(interp, - " (when retreiving options only integer indices are " + " (when retrieving options only integer indices are " "allowed)", NULL); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_FORMAT", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1050,25 +1076,25 @@ GridRowColumnConfigureCommand( * returned. */ - if (Tcl_GetIndexFromObj(interp, objv[4], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[4], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { Tcl_DecrRefCount(listCopy); return TCL_ERROR; } if (index == ROWCOL_MINSIZE) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].minSize : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].minSize : 0)); } else if (index == ROWCOL_WEIGHT) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].weight : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].weight : 0)); } else if (index == ROWCOL_UNIFORM) { Tk_Uid value = (ok == TCL_OK) ? slotPtr[slot].uniform : ""; - Tcl_SetObjResult(interp, - Tcl_NewStringObj(value == NULL ? "" : value, -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + (value == NULL) ? "" : value, -1)); } else if (index == ROWCOL_PAD) { - Tcl_SetObjResult(interp, - Tcl_NewIntObj((ok == TCL_OK) ? slotPtr[slot].pad : 0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj( + (ok == TCL_OK) ? slotPtr[slot].pad : 0)); } Tcl_DecrRefCount(listCopy); return TCL_OK; @@ -1101,17 +1127,17 @@ GridRowColumnConfigureCommand( slavePtr = GetGrid(slave); if (slavePtr->masterPtr != masterPtr) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": the window \"", - Tcl_GetString(lObjv[j]), "\" is not managed by \"", - Tcl_GetString(objv[2]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the window \"%s\" is not managed by \"%s\"", + Tcl_GetString(lObjv[j]), Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "NOT_MASTER", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } } else { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": illegal index \"", - Tcl_GetString(lObjv[j]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "illegal index \"%s\"", Tcl_GetString(lObjv[j]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID_INDEX", NULL); Tcl_DecrRefCount(listCopy); return TCL_ERROR; } @@ -1131,11 +1157,12 @@ GridRowColumnConfigureCommand( for (slot = first; slot <= last; slot++) { ok = CheckSlotData(masterPtr, slot, slotType, /*checkOnly*/ 0); if (ok != TCL_OK) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " ", - Tcl_GetString(objv[1]), ": \"", - Tcl_GetString(lObjv[j]), - "\" is out of range", NULL); - Tcl_DecrRefCount(listCopy); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" is out of range", + Tcl_GetString(lObjv[j]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "INDEX_RANGE", + NULL); + Tcl_DecrRefCount(listCopy); return TCL_ERROR; } slotPtr = (slotType == COLUMN) ? @@ -1148,15 +1175,15 @@ GridRowColumnConfigureCommand( */ for (i = 4; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, - "option", 0, &index) != TCL_OK) { - Tcl_DecrRefCount(listCopy); + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { + Tcl_DecrRefCount(listCopy); return TCL_ERROR; } if (index == ROWCOL_MINSIZE) { if (Tk_GetPixelsFromObj(interp, master, objv[i+1], &size) != TCL_OK) { - Tcl_DecrRefCount(listCopy); + Tcl_DecrRefCount(listCopy); return TCL_ERROR; } else { slotPtr[slot].minSize = size; @@ -1165,14 +1192,11 @@ GridRowColumnConfigureCommand( int wt; if (Tcl_GetIntFromObj(interp,objv[i+1],&wt)!=TCL_OK) { - Tcl_DecrRefCount(listCopy); + Tcl_DecrRefCount(listCopy); return TCL_ERROR; } else if (wt < 0) { - Tcl_AppendResult(interp, "invalid arg \"", - Tcl_GetString(objv[i]), - "\": should be non-negative", NULL); - Tcl_DecrRefCount(listCopy); - return TCL_ERROR; + Tcl_DecrRefCount(listCopy); + goto negativeIndex; } else { slotPtr[slot].weight = wt; } @@ -1186,14 +1210,11 @@ GridRowColumnConfigureCommand( } else if (index == ROWCOL_PAD) { if (Tk_GetPixelsFromObj(interp, master, objv[i+1], &size) != TCL_OK) { - Tcl_DecrRefCount(listCopy); + Tcl_DecrRefCount(listCopy); return TCL_ERROR; } else if (size < 0) { - Tcl_AppendResult(interp, "invalid arg \"", - Tcl_GetString(objv[i]), - "\": should be non-negative", NULL); - Tcl_DecrRefCount(listCopy); - return TCL_ERROR; + Tcl_DecrRefCount(listCopy); + goto negativeIndex; } else { slotPtr[slot].pad = size; } @@ -1239,9 +1260,16 @@ GridRowColumnConfigureCommand( } if (!(masterPtr->flags & REQUESTED_RELAYOUT)) { masterPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangeGrid, masterPtr); } return TCL_OK; + + negativeIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid arg \"%s\": should be non-negative", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL); + return TCL_ERROR; } /* @@ -1266,7 +1294,7 @@ GridSizeCommand( Tk_Window tkwin, /* Main window of the application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window master; Gridder *masterPtr; @@ -1317,35 +1345,36 @@ GridSlavesCommand( Tk_Window tkwin, /* Main window of the application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tk_Window master; Gridder *masterPtr; /* master grid record */ Gridder *slavePtr; int i, value, index; int row = -1, column = -1; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "-column", "-row", NULL }; enum options { SLAVES_COLUMN, SLAVES_ROW }; Tcl_Obj *res; if ((objc < 3) || ((objc % 2) == 0)) { - Tcl_WrongNumArgs(interp, 2, objv, "window ?-option value...?"); + Tcl_WrongNumArgs(interp, 2, objv, "window ?-option value ...?"); return TCL_ERROR; } for (i = 3; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[i+1], &value) != TCL_OK) { return TCL_ERROR; } if (value < 0) { - Tcl_AppendResult(interp, Tcl_GetString(objv[i]), - " is an invalid value: should NOT be < 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%d is an invalid value: should NOT be < 0", value)); + Tcl_SetErrorCode(interp, "TK", "GRID", "NEG_INDEX", NULL); return TCL_ERROR; } if (index == SLAVES_COLUMN) { @@ -1363,16 +1392,15 @@ GridSlavesCommand( res = Tcl_NewListObj(0, NULL); for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - if (column>=0 && (slavePtr->column > column + if ((column >= 0) && (slavePtr->column > column || slavePtr->column+slavePtr->numCols-1 < column)) { continue; } - if (row>=0 && (slavePtr->row > row || + if ((row >= 0) && (slavePtr->row > row || slavePtr->row+slavePtr->numRows-1 < row)) { continue; } - Tcl_ListObjAppendElement(interp, res, - Tcl_NewStringObj(Tk_PathName(slavePtr->tkwin), -1)); + Tcl_ListObjAppendElement(interp,res, TkNewWindowObj(slavePtr->tkwin)); } Tcl_SetObjResult(interp, res); return TCL_OK; @@ -1403,12 +1431,12 @@ GridReqProc( Tk_Window tkwin) /* Other Tk-related information about the * window. */ { - register Gridder *gridPtr = (Gridder *) clientData; + register Gridder *gridPtr = clientData; gridPtr = gridPtr->masterPtr; if (gridPtr && !(gridPtr->flags & REQUESTED_RELAYOUT)) { gridPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr); + Tcl_DoWhenIdle(ArrangeGrid, gridPtr); } } @@ -1435,7 +1463,7 @@ GridLostSlaveProc( * stolen away. */ Tk_Window tkwin) /* Tk's handle for the slave window. */ { - register Gridder *slavePtr = (Gridder *) clientData; + register Gridder *slavePtr = clientData; if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) { Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin); @@ -1693,7 +1721,7 @@ ArrangeGrid( ClientData clientData) /* Structure describing master whose slaves * are to be re-layed out. */ { - register Gridder *masterPtr = (Gridder *) clientData; + register Gridder *masterPtr = clientData; register Gridder *slavePtr; GridMaster *slotPtr = masterPtr->masterDataPtr; int abort; @@ -1729,7 +1757,7 @@ ArrangeGrid( } masterPtr->abortPtr = &abort; abort = 0; - Tcl_Preserve((ClientData) masterPtr); + Tcl_Preserve(masterPtr); /* * Call the constraint engine to fill in the row and column offsets. @@ -1756,10 +1784,10 @@ ArrangeGrid( Tk_GeometryRequest(masterPtr->tkwin, width, height); if (width>1 && height>1) { masterPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangeGrid, masterPtr); } masterPtr->abortPtr = NULL; - Tcl_Release((ClientData) masterPtr); + Tcl_Release(masterPtr); return; } @@ -1845,7 +1873,7 @@ ArrangeGrid( } masterPtr->abortPtr = NULL; - Tcl_Release((ClientData) masterPtr); + Tcl_Release(masterPtr); } /* @@ -1928,8 +1956,7 @@ ResolveConstraints( gridCount = MAX(constraintCount, slotCount); if (gridCount >= TYPICAL_SIZE) { - layoutPtr = (GridLayout *) - ckalloc(sizeof(GridLayout) * (1+gridCount)); + layoutPtr = ckalloc(sizeof(GridLayout) * (1+gridCount)); } else { layoutPtr = layoutData; } @@ -2051,12 +2078,12 @@ ResolveConstraints( * sizeof(UniformGroup); size_t newSize = (uniformGroupsAlloced + UNIFORM_PREALLOC) * sizeof(UniformGroup); - UniformGroup *newUG = (UniformGroup *) ckalloc(newSize); + UniformGroup *newUG = ckalloc(newSize); UniformGroup *oldUG = uniformGroupPtr; memcpy(newUG, oldUG, oldSize); if (oldUG != uniformPre) { - ckfree((char *) oldUG); + ckfree(oldUG); } uniformGroupPtr = newUG; uniformGroupsAlloced += UNIFORM_PREALLOC; @@ -2096,7 +2123,7 @@ ResolveConstraints( } if (uniformGroupPtr != uniformPre) { - ckfree((char *) uniformGroupPtr); + ckfree(uniformGroupPtr); } /* @@ -2366,7 +2393,7 @@ ResolveConstraints( --layoutPtr; if (layoutPtr != layoutData) { - ckfree((char *) layoutPtr); + ckfree(layoutPtr); } return requiredSize; } @@ -2412,9 +2439,9 @@ GetGrid( hPtr = Tcl_CreateHashEntry(&dispPtr->gridHashTable, (char*) tkwin, &isNew); if (!isNew) { - return (Gridder *) Tcl_GetHashValue(hPtr); + return Tcl_GetHashValue(hPtr); } - gridPtr = (Gridder *) ckalloc(sizeof(Gridder)); + gridPtr = ckalloc(sizeof(Gridder)); gridPtr->tkwin = tkwin; gridPtr->masterPtr = NULL; gridPtr->masterDataPtr = NULL; @@ -2433,7 +2460,7 @@ GetGrid( gridPtr->padTop = 0; gridPtr->iPadX = 0; gridPtr->iPadY = 0; - gridPtr->doubleBw = 2*Tk_Changes(tkwin)->border_width; + gridPtr->doubleBw = 2 * Tk_Changes(tkwin)->border_width; gridPtr->abortPtr = NULL; gridPtr->flags = 0; gridPtr->sticky = 0; @@ -2442,7 +2469,7 @@ GetGrid( gridPtr->masterDataPtr = NULL; Tcl_SetHashValue(hPtr, gridPtr); Tk_CreateEventHandler(tkwin, StructureNotifyMask, - GridStructureProc, (ClientData) gridPtr); + GridStructureProc, gridPtr); return gridPtr; } @@ -2513,7 +2540,8 @@ SetSlaveColumn( lastCol = ((newColumn >= 0) ? newColumn : 0) + newNumCols; if (lastCol >= MAX_ELEMENT) { - Tcl_SetResult(interp, "Column out of bounds", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("column out of bounds",-1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_COLUMN", NULL); return TCL_ERROR; } @@ -2553,7 +2581,8 @@ SetSlaveRow( lastRow = ((newRow >= 0) ? newRow : 0) + newNumRows; if (lastRow >= MAX_ELEMENT) { - Tcl_SetResult(interp, "Row out of bounds", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("row out of bounds", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_ROW", NULL); return TCL_ERROR; } @@ -2622,14 +2651,14 @@ CheckSlotData( int newNumSlot = slot + PREALLOC; size_t oldSize = numSlot * sizeof(SlotInfo); size_t newSize = newNumSlot * sizeof(SlotInfo); - SlotInfo *newSI = (SlotInfo *) ckalloc(newSize); + SlotInfo *newSI = ckalloc(newSize); SlotInfo *oldSI = (slotType == ROW) ? masterPtr->masterDataPtr->rowPtr : masterPtr->masterDataPtr->columnPtr; memcpy(newSI, oldSI, oldSize); memset(newSI+numSlot, 0, newSize - oldSize); - ckfree((char *) oldSI); + ckfree(oldSI); if (slotType == ROW) { masterPtr->masterDataPtr->rowPtr = newSI; masterPtr->masterDataPtr->rowSpace = newNumSlot; @@ -2672,17 +2701,17 @@ InitMasterData( Gridder *masterPtr) { if (masterPtr->masterDataPtr == NULL) { - GridMaster *gridPtr = masterPtr->masterDataPtr = (GridMaster *) + GridMaster *gridPtr = masterPtr->masterDataPtr = ckalloc(sizeof(GridMaster)); size_t size = sizeof(SlotInfo) * TYPICAL_SIZE; gridPtr->columnEnd = 0; gridPtr->columnMax = 0; - gridPtr->columnPtr = (SlotInfo *) ckalloc(size); + gridPtr->columnPtr = ckalloc(size); gridPtr->columnSpace = TYPICAL_SIZE; gridPtr->rowEnd = 0; gridPtr->rowMax = 0; - gridPtr->rowPtr = (SlotInfo *) ckalloc(size); + gridPtr->rowPtr = ckalloc(size); gridPtr->rowSpace = TYPICAL_SIZE; gridPtr->startX = 0; gridPtr->startY = 0; @@ -2736,7 +2765,7 @@ Unlink( } if (!(masterPtr->flags & REQUESTED_RELAYOUT)) { masterPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangeGrid, masterPtr); } if (masterPtr->abortPtr != NULL) { *masterPtr->abortPtr = 1; @@ -2744,6 +2773,16 @@ Unlink( SetGridSize(slavePtr->masterPtr); slavePtr->masterPtr = NULL; + + /* + * If we have emptied this master from slaves it means we are no longer + * handling it and should mark it as free. + */ + + if ((masterPtr->slavePtr == NULL) && (masterPtr->flags & ALLOCED_MASTER)) { + TkFreeGeometryMaster(masterPtr->tkwin, "grid"); + masterPtr->flags &= ~ALLOCED_MASTER; + } } /* @@ -2768,23 +2807,23 @@ Unlink( static void DestroyGrid( - char *memPtr) /* Info about window that is now dead. */ + void *memPtr) /* Info about window that is now dead. */ { - register Gridder *gridPtr = (Gridder *) memPtr; + register Gridder *gridPtr = memPtr; if (gridPtr->masterDataPtr != NULL) { if (gridPtr->masterDataPtr->rowPtr != NULL) { - ckfree((char *) gridPtr->masterDataPtr -> rowPtr); + ckfree(gridPtr->masterDataPtr -> rowPtr); } if (gridPtr->masterDataPtr->columnPtr != NULL) { - ckfree((char *) gridPtr->masterDataPtr -> columnPtr); + ckfree(gridPtr->masterDataPtr -> columnPtr); } - ckfree((char *) gridPtr->masterDataPtr); + ckfree(gridPtr->masterDataPtr); } if (gridPtr->in != NULL) { Tcl_DecrRefCount(gridPtr->in); } - ckfree((char *) gridPtr); + ckfree(gridPtr); } /* @@ -2811,21 +2850,21 @@ GridStructureProc( * eventPtr. */ XEvent *eventPtr) /* Describes what just happened. */ { - register Gridder *gridPtr = (Gridder *) clientData; + register Gridder *gridPtr = clientData; TkDisplay *dispPtr = ((TkWindow *) gridPtr->tkwin)->dispPtr; if (eventPtr->type == ConfigureNotify) { if ((gridPtr->slavePtr != NULL) && !(gridPtr->flags & REQUESTED_RELAYOUT)) { gridPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr); + Tcl_DoWhenIdle(ArrangeGrid, gridPtr); } if ((gridPtr->masterPtr != NULL) && (gridPtr->doubleBw != 2*Tk_Changes(gridPtr->tkwin)->border_width)) { if (!(gridPtr->masterPtr->flags & REQUESTED_RELAYOUT)) { gridPtr->doubleBw = 2*Tk_Changes(gridPtr->tkwin)->border_width; gridPtr->masterPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr->masterPtr); + Tcl_DoWhenIdle(ArrangeGrid, gridPtr->masterPtr); } } } else if (eventPtr->type == DestroyNotify) { @@ -2844,15 +2883,15 @@ GridStructureProc( Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->gridHashTable, (char *) gridPtr->tkwin)); if (gridPtr->flags & REQUESTED_RELAYOUT) { - Tcl_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr); + Tcl_CancelIdleCall(ArrangeGrid, gridPtr); } gridPtr->tkwin = NULL; - Tcl_EventuallyFree((ClientData) gridPtr, DestroyGrid); + Tcl_EventuallyFree(gridPtr, (Tcl_FreeProc *)DestroyGrid); } else if (eventPtr->type == MapNotify) { if ((gridPtr->slavePtr != NULL) && !(gridPtr->flags & REQUESTED_RELAYOUT)) { gridPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr); + Tcl_DoWhenIdle(ArrangeGrid, gridPtr); } } else if (eventPtr->type == UnmapNotify) { register Gridder *gridPtr2; @@ -2890,7 +2929,7 @@ ConfigureSlaves( Tk_Window tkwin, /* Any window in application containing * slaves. Used to look up slave names. */ int objc, /* Number of elements in argv. */ - Tcl_Obj *CONST objv[]) /* Argument objects: contains one or more + Tcl_Obj *const objv[]) /* Argument objects: contains one or more * window names followed by any number of * "option value" pairs. Caller must make sure * that there is at least one window name. */ @@ -2904,10 +2943,10 @@ ConfigureSlaves( int defaultRow = -1; int defaultColumn = 0; /* Default column number */ int defaultColumnSpan = 1; /* Default number of columns */ - char *lastWindow; /* Use this window to base current row/col + const char *lastWindow; /* Use this window to base current row/col * on */ int numSkip; /* Number of 'x' found */ - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "-column", "-columnspan", "-in", "-ipadx", "-ipady", "-padx", "-pady", "-row", "-rowspan", "-sticky", NULL }; @@ -2915,7 +2954,7 @@ ConfigureSlaves( CONF_COLUMN, CONF_COLUMNSPAN, CONF_IN, CONF_IPADX, CONF_IPADY, CONF_PADX, CONF_PADY, CONF_ROW, CONF_ROWSPAN, CONF_STICKY }; int index; - char *string; + const char *string; char firstChar; int positionGiven; @@ -2967,24 +3006,27 @@ ConfigureSlaves( continue; } if (length > 1 && i == 0) { - Tcl_AppendResult(interp, "bad argument \"", string, - "\": must be name of window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be name of window", string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } if (length > 1 && firstChar == '-') { break; } if (length > 1) { - Tcl_AppendResult(interp, "unexpected parameter, \"", - string, "\", in configure list. ", - "Should be window name or option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unexpected parameter \"%s\" in configure list:" + " should be window name or option", string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } if ((firstChar == REL_HORIZ) && ((numWindows == 0) || (prevChar == REL_SKIP) || (prevChar == REL_VERT))) { - Tcl_AppendResult(interp, - "Must specify window before shortcut '-'.", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify window before shortcut '-'", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -2993,14 +3035,18 @@ ConfigureSlaves( continue; } - Tcl_AppendResult(interp, "invalid window shortcut, \"", - string, "\" should be '-', 'x', or '^'", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid window shortcut, \"%s\" should be '-', 'x', or '^'", + string)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } numWindows = i; if ((objc - numWindows) & 1) { - Tcl_AppendResult(interp, "extra option or option with no value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra option or option with no value", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -3012,8 +3058,8 @@ ConfigureSlaves( */ for (i = numWindows; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == CONF_IN) { @@ -3026,10 +3072,10 @@ ConfigureSlaves( } else if (index == CONF_ROW) { if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad row value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad row value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "POSITIVE_INT", NULL); return TCL_ERROR; } defaultRow = tmp; @@ -3079,7 +3125,7 @@ ConfigureSlaves( for (defaultColumnSpan = 1; j + defaultColumnSpan < numWindows; defaultColumnSpan++) { - char *string = Tcl_GetString(objv[j + defaultColumnSpan]); + const char *string = Tcl_GetString(objv[j + defaultColumnSpan]); if (*string != REL_HORIZ) { break; @@ -3091,8 +3137,10 @@ ConfigureSlaves( } if (Tk_TopWinHierarchy(slave)) { - Tcl_AppendResult(interp, "can't manage \"", Tcl_GetString(objv[j]), - "\": it's a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't manage \"%s\": it's a top-level window", + Tcl_GetString(objv[j]))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } slavePtr = GetGrid(slave); @@ -3113,15 +3161,16 @@ ConfigureSlaves( */ for (i = numWindows; i < objc; i += 2) { - Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", 0, - &index); + Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, + sizeof(char *), "option", 0, &index); switch ((enum options) index) { case CONF_COLUMN: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_AppendResult(interp, "bad column value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad column value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } if (SetSlaveColumn(interp, slavePtr, tmp, -1) != TCL_OK) { @@ -3131,9 +3180,10 @@ ConfigureSlaves( case CONF_COLUMNSPAN: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp <= 0) { - Tcl_AppendResult(interp, "bad columnspan value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a positive integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad columnspan value \"%s\": must be a positive integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } if (SetSlaveColumn(interp, slavePtr, -1, tmp) != TCL_OK) { @@ -3146,8 +3196,9 @@ ConfigureSlaves( return TCL_ERROR; } if (other == slave) { - Tcl_SetResult(interp, "Window can't be managed in itself", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "window can't be managed in itself", -1)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } positionGiven = 1; @@ -3158,9 +3209,11 @@ ConfigureSlaves( int sticky = StringToSticky(Tcl_GetString(objv[i+1])); if (sticky == -1) { - Tcl_AppendResult(interp, "bad stickyness value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "a string containing n, e, s, and/or w", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad stickyness value \"%s\": must be" + " a string containing n, e, s, and/or w", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL); return TCL_ERROR; } slavePtr->sticky = sticky; @@ -3169,22 +3222,24 @@ ConfigureSlaves( case CONF_IPADX: if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1], &tmp) != TCL_OK) || (tmp < 0)) { - Tcl_AppendResult(interp, "bad ipadx value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipadx value \"%s\": must be positive screen distance", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } - slavePtr->iPadX = tmp*2; + slavePtr->iPadX = tmp * 2; break; case CONF_IPADY: if ((Tk_GetPixelsFromObj(NULL, slave, objv[i+1], &tmp) != TCL_OK) || (tmp < 0)) { - Tcl_AppendResult(interp, "bad ipady value \"", - Tcl_GetString(objv[i+1]), "\": must be ", - "positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipady value \"%s\": must be positive screen distance", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } - slavePtr->iPadY = tmp*2; + slavePtr->iPadY = tmp * 2; break; case CONF_PADX: if (TkParsePadAmount(interp, tkwin, objv[i+1], @@ -3201,9 +3256,10 @@ ConfigureSlaves( case CONF_ROW: if (Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK || tmp < 0) { - Tcl_AppendResult(interp, "bad row value \"", - Tcl_GetString(objv[i+1]), - "\": must be a non-negative integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad row value \"%s\": must be a non-negative integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLUMN", NULL); return TCL_ERROR; } if (SetSlaveRow(interp, slavePtr, tmp, -1) != TCL_OK) { @@ -3213,9 +3269,10 @@ ConfigureSlaves( case CONF_ROWSPAN: if ((Tcl_GetIntFromObj(NULL, objv[i+1], &tmp) != TCL_OK) || tmp <= 0) { - Tcl_AppendResult(interp, "bad rowspan value \"", - Tcl_GetString(objv[i+1]), - "\": must be a positive integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad rowspan value \"%s\": must be a positive integer", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SPAN", NULL); return TCL_ERROR; } if (SetSlaveRow(interp, slavePtr, -1, tmp) != TCL_OK) { @@ -3280,8 +3337,10 @@ ConfigureSlaves( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't put %s inside %s", Tcl_GetString(objv[j]), + Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); Unlink(slavePtr); return TCL_ERROR; } @@ -3292,14 +3351,25 @@ ConfigureSlaves( */ if (masterPtr->masterPtr == slavePtr) { - Tcl_AppendResult(interp, "can't put ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), - ", would cause management loop.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't put %s inside %s, would cause management loop", + Tcl_GetString(objv[j]), Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); Unlink(slavePtr); return TCL_ERROR; } - Tk_ManageGeometry(slave, &gridMgrType, (ClientData) slavePtr); + Tk_ManageGeometry(slave, &gridMgrType, slavePtr); + + if (!(masterPtr->flags & DONT_PROPAGATE)) { + if (TkSetGeometryMaster(interp, masterPtr->tkwin, "grid") + != TCL_OK) { + Tk_ManageGeometry(slave, NULL, NULL); + Unlink(slavePtr); + return TCL_ERROR; + } + masterPtr->flags |= ALLOCED_MASTER; + } /* * Assign default position information. @@ -3332,7 +3402,7 @@ ConfigureSlaves( } if (!(masterPtr->flags & REQUESTED_RELAYOUT)) { masterPtr->flags |= REQUESTED_RELAYOUT; - Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangeGrid, masterPtr); } } @@ -3344,8 +3414,8 @@ ConfigureSlaves( numSkip = 0; for (j = 0; j < numWindows; j++) { struct Gridder *otherPtr; - int match; /* Found a match for the ^ */ - int lastRow, lastColumn; /* Implied end of table. */ + int match; /* Found a match for the ^ */ + int lastRow, lastColumn; /* Implied end of table. */ string = Tcl_GetString(objv[j]); firstChar = string[0]; @@ -3362,7 +3432,9 @@ ConfigureSlaves( } if (masterPtr == NULL) { - Tcl_AppendResult(interp, "can't use '^', cant find master", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't use '^', cant find master", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } @@ -3371,7 +3443,7 @@ ConfigureSlaves( */ for (width = 1; width + j < numWindows; width++) { - char *string = Tcl_GetString(objv[j+width]); + const char *string = Tcl_GetString(objv[j+width]); if (*string != REL_VERT) { break; @@ -3414,30 +3486,44 @@ ConfigureSlaves( } } if (!match) { - Tcl_AppendResult(interp, "can't find slave to extend with \"^\".", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't find slave to extend with \"^\"", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } } if (masterPtr == NULL) { - Tcl_AppendResult(interp, "can't determine master window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't determine master window", -1)); + Tcl_SetErrorCode(interp, "TK", "GRID", "SHORTCUT_USAGE", NULL); return TCL_ERROR; } SetGridSize(masterPtr); + + /* + * If we have emptied this master from slaves it means we are no longer + * handling it and should mark it as free. + */ + + if (masterPtr->slavePtr == NULL && masterPtr->flags & ALLOCED_MASTER) { + TkFreeGeometryMaster(masterPtr->tkwin, "grid"); + masterPtr->flags &= ~ALLOCED_MASTER; + } + return TCL_OK; } /* *---------------------------------------------------------------------- * - * StickyToString + * StickyToObj * * Converts the internal boolean combination of "sticky" bits onto a Tcl * list element containing zero or more of n, s, e, or w. * * Results: - * A string is placed into the "result" pointer. + * A new object is returned that holds the sticky representation. * * Side effects: * none. @@ -3445,29 +3531,26 @@ ConfigureSlaves( *---------------------------------------------------------------------- */ -static void -StickyToString( - int flags, /* The sticky flags. */ - char *result) /* Where to put the result. */ +static Tcl_Obj * +StickyToObj( + int flags) /* The sticky flags. */ { int count = 0; - if (flags&STICK_NORTH) { - result[count++] = 'n'; - } - if (flags&STICK_EAST) { - result[count++] = 'e'; + char buffer[4]; + + if (flags & STICK_NORTH) { + buffer[count++] = 'n'; } - if (flags&STICK_SOUTH) { - result[count++] = 's'; + if (flags & STICK_EAST) { + buffer[count++] = 'e'; } - if (flags&STICK_WEST) { - result[count++] = 'w'; + if (flags & STICK_SOUTH) { + buffer[count++] = 's'; } - if (count) { - result[count] = '\0'; - } else { - sprintf(result, "{}"); + if (flags & STICK_WEST) { + buffer[count++] = 'w'; } + return Tcl_NewStringObj(buffer, count); } /* @@ -3490,7 +3573,7 @@ StickyToString( static int StringToSticky( - char *string) + const char *string) { int sticky = 0; char c; diff --git a/generic/tkImage.c b/generic/tkImage.c index 6c7c9cd..359d6c6 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.c @@ -15,8 +15,8 @@ /* * Each call to Tk_GetImage returns a pointer to one of the following - * structures, which is used as a token by clients (widgets) that - * display images. + * structures, which is used as a token by clients (widgets) that display + * images. */ typedef struct Image { @@ -106,22 +106,22 @@ static void ImageTypeThreadExitProc( ClientData clientData) /* not used */ { - Tk_ImageType *freePtr; + Tk_ImageType *freePtr; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); while (tsdPtr->oldImageTypeList != NULL) { freePtr = tsdPtr->oldImageTypeList; tsdPtr->oldImageTypeList = tsdPtr->oldImageTypeList->nextPtr; - ckfree((char *) freePtr); + ckfree(freePtr); } while (tsdPtr->imageTypeList != NULL) { freePtr = tsdPtr->imageTypeList; tsdPtr->imageTypeList = tsdPtr->imageTypeList->nextPtr; - ckfree((char *) freePtr); + ckfree(freePtr); } } - + /* *---------------------------------------------------------------------- * @@ -143,11 +143,12 @@ ImageTypeThreadExitProc( void Tk_CreateOldImageType( - Tk_ImageType *typePtr) /* Structure describing the type. All of the + const Tk_ImageType *typePtr) + /* Structure describing the type. All of the * fields except "nextPtr" must be filled in * by caller. */ { - Tk_ImageType *copyPtr; + Tk_ImageType *copyPtr; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -155,7 +156,7 @@ Tk_CreateOldImageType( tsdPtr->initialized = 1; Tcl_CreateThreadExitHandler(ImageTypeThreadExitProc, NULL); } - copyPtr = (Tk_ImageType *) ckalloc(sizeof(Tk_ImageType)); + copyPtr = ckalloc(sizeof(Tk_ImageType)); *copyPtr = *typePtr; copyPtr->nextPtr = tsdPtr->oldImageTypeList; tsdPtr->oldImageTypeList = copyPtr; @@ -163,11 +164,12 @@ Tk_CreateOldImageType( void Tk_CreateImageType( - Tk_ImageType *typePtr) /* Structure describing the type. All of the + const Tk_ImageType *typePtr) + /* Structure describing the type. All of the * fields except "nextPtr" must be filled in * by caller. */ { - Tk_ImageType *copyPtr; + Tk_ImageType *copyPtr; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -175,7 +177,7 @@ Tk_CreateImageType( tsdPtr->initialized = 1; Tcl_CreateThreadExitHandler(ImageTypeThreadExitProc, NULL); } - copyPtr = (Tk_ImageType *) ckalloc(sizeof(Tk_ImageType)); + copyPtr = ckalloc(sizeof(Tk_ImageType)); *copyPtr = *typePtr; copyPtr->nextPtr = tsdPtr->imageTypeList; tsdPtr->imageTypeList = copyPtr; @@ -203,9 +205,9 @@ Tk_ImageObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument strings. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { - static CONST char *imageOptions[] = { + static const char *const imageOptions[] = { "create", "delete", "height", "inuse", "names", "type", "types", "width", NULL }; @@ -213,7 +215,7 @@ Tk_ImageObjCmd( IMAGE_CREATE, IMAGE_DELETE, IMAGE_HEIGHT, IMAGE_INUSE, IMAGE_NAMES, IMAGE_TYPE, IMAGE_TYPES, IMAGE_WIDTH }; - TkWindow *winPtr = (TkWindow *) clientData; + TkWindow *winPtr = clientData; int i, isNew, firstOption, index; Tk_ImageType *typePtr; ImageMaster *masterPtr; @@ -222,8 +224,9 @@ Tk_ImageObjCmd( Tcl_HashSearch search; char idString[16 + TCL_INTEGER_SPACE]; TkDisplay *dispPtr = winPtr->dispPtr; - char *arg, *name; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + const char *arg, *name; + Tcl_Obj *resultObj; + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (objc < 2) { @@ -231,16 +234,18 @@ Tk_ImageObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], imageOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], imageOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { case IMAGE_CREATE: { Tcl_Obj **args; int oldimage = 0; + if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "type ?name? ?options?"); + Tcl_WrongNumArgs(interp, 2, objv, + "type ?name? ?-option value ...?"); return TCL_ERROR; } @@ -267,8 +272,9 @@ Tk_ImageObjCmd( } } if (typePtr == NULL) { - Tcl_AppendResult(interp, "image type \"", arg, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image type \"%s\" doesn't exist", arg)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE_TYPE", arg, NULL); return TCL_ERROR; } @@ -277,12 +283,11 @@ Tk_ImageObjCmd( */ if ((objc == 3) || (*(arg = Tcl_GetString(objv[3])) == '-')) { - Tcl_CmdInfo dummy; do { dispPtr->imageId++; sprintf(idString, "image%d", dispPtr->imageId); name = idString; - } while (Tcl_GetCommandInfo(interp, name, &dummy) != 0); + } while (Tcl_FindCommand(interp, name, NULL, 0) != NULL); firstOption = 3; } else { TkWindow *topWin; @@ -299,8 +304,10 @@ Tk_ImageObjCmd( topWin = (TkWindow *) TkToplevelWindowForCommand(interp, name); if (topWin != NULL && winPtr->mainPtr->winPtr == topWin) { - Tcl_AppendResult(interp, "images may not be named the ", - "same as the main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "images may not be named the same as the main window", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "SMASH_MAIN", NULL); return TCL_ERROR; } } @@ -311,7 +318,7 @@ Tk_ImageObjCmd( hPtr = Tcl_CreateHashEntry(&winPtr->mainPtr->imageTable, name, &isNew); if (isNew) { - masterPtr = (ImageMaster *) ckalloc(sizeof(ImageMaster)); + masterPtr = ckalloc(sizeof(ImageMaster)); masterPtr->typePtr = NULL; masterPtr->masterData = NULL; masterPtr->width = masterPtr->height = 1; @@ -320,7 +327,7 @@ Tk_ImageObjCmd( masterPtr->instancePtr = NULL; masterPtr->deleted = 0; masterPtr->winPtr = winPtr->mainPtr->winPtr; - Tcl_Preserve((ClientData) masterPtr->winPtr); + Tcl_Preserve(masterPtr->winPtr); Tcl_SetHashValue(hPtr, masterPtr); } else { /* @@ -328,17 +335,17 @@ Tk_ImageObjCmd( * from the master. */ - masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->typePtr != NULL) { for (imagePtr = masterPtr->instancePtr; imagePtr != NULL; imagePtr = imagePtr->nextPtr) { - (*masterPtr->typePtr->freeProc)(imagePtr->instanceData, + masterPtr->typePtr->freeProc(imagePtr->instanceData, imagePtr->display); - (*imagePtr->changeProc)(imagePtr->widgetClientData, - 0, 0, masterPtr->width, masterPtr->height, + imagePtr->changeProc(imagePtr->widgetClientData, 0, 0, + masterPtr->width, masterPtr->height, masterPtr->width, masterPtr->height); } - (*masterPtr->typePtr->deleteProc)(masterPtr->masterData); + masterPtr->typePtr->deleteProc(masterPtr->masterData); masterPtr->typePtr = NULL; } masterPtr->deleted = 0; @@ -356,35 +363,34 @@ Tk_ImageObjCmd( if (oldimage) { int i; - args = (Tcl_Obj **) ckalloc((objc+1) * sizeof(char *)); + args = ckalloc((objc+1) * sizeof(char *)); for (i = 0; i < objc; i++) { args[i] = (Tcl_Obj *) Tcl_GetString(objv[i]); } args[objc] = NULL; } - Tcl_Preserve((ClientData) masterPtr); - if ((*typePtr->createProc)(interp, name, objc, args, typePtr, - (Tk_ImageMaster)masterPtr, &masterPtr->masterData) != TCL_OK) { + Tcl_Preserve(masterPtr); + if (typePtr->createProc(interp, name, objc, args, typePtr, + (Tk_ImageMaster)masterPtr, &masterPtr->masterData) != TCL_OK){ EventuallyDeleteImage(masterPtr, 0); - Tcl_Release((ClientData) masterPtr); + Tcl_Release(masterPtr); if (oldimage) { - ckfree((char *) args); + ckfree(args); } return TCL_ERROR; } - Tcl_Release((ClientData) masterPtr); + Tcl_Release(masterPtr); if (oldimage) { - ckfree((char *) args); + ckfree(args); } masterPtr->typePtr = typePtr; for (imagePtr = masterPtr->instancePtr; imagePtr != NULL; imagePtr = imagePtr->nextPtr) { - imagePtr->instanceData = (*typePtr->getProc)(imagePtr->tkwin, + imagePtr->instanceData = typePtr->getProc(imagePtr->tkwin, masterPtr->masterData); } - Tcl_SetResult(interp, - Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); break; } case IMAGE_DELETE: @@ -394,7 +400,7 @@ Tk_ImageObjCmd( if (hPtr == NULL) { goto alreadyDeleted; } - masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { goto alreadyDeleted; } @@ -407,28 +413,34 @@ Tk_ImageObjCmd( return TCL_ERROR; } hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search); + resultObj = Tcl_NewObj(); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { continue; } - Tcl_AppendElement(interp, Tcl_GetHashKey( - &winPtr->mainPtr->imageTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), -1)); } + Tcl_SetObjResult(interp, resultObj); break; case IMAGE_TYPES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (typePtr = tsdPtr->imageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { - Tcl_AppendElement(interp, typePtr->name); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + typePtr->name, -1)); } for (typePtr = tsdPtr->oldImageTypeList; typePtr != NULL; typePtr = typePtr->nextPtr) { - Tcl_AppendElement(interp, typePtr->name); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + typePtr->name, -1)); } + Tcl_SetObjResult(interp, resultObj); break; case IMAGE_HEIGHT: @@ -451,7 +463,7 @@ Tk_ImageObjCmd( if (hPtr == NULL) { goto alreadyDeleted; } - masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { goto alreadyDeleted; } @@ -462,19 +474,20 @@ Tk_ImageObjCmd( switch ((enum options) index) { case IMAGE_HEIGHT: - Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->height); + Tcl_SetObjResult(interp, Tcl_NewIntObj(masterPtr->height)); break; case IMAGE_INUSE: - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), - masterPtr->typePtr!=NULL && masterPtr->instancePtr!=NULL); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + masterPtr->typePtr && masterPtr->instancePtr)); break; case IMAGE_TYPE: if (masterPtr->typePtr != NULL) { - Tcl_SetResult(interp, masterPtr->typePtr->name, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(masterPtr->typePtr->name, -1)); } break; case IMAGE_WIDTH: - Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->width); + Tcl_SetObjResult(interp, Tcl_NewIntObj(masterPtr->width)); break; default: Tcl_Panic("can't happen"); @@ -484,7 +497,8 @@ Tk_ImageObjCmd( return TCL_OK; alreadyDeleted: - Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("image \"%s\" doesn't exist",arg)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", arg, NULL); return TCL_ERROR; } @@ -527,8 +541,8 @@ Tk_ImageChanged( masterPtr->height = imageHeight; for (imagePtr = masterPtr->instancePtr; imagePtr != NULL; imagePtr = imagePtr->nextPtr) { - (*imagePtr->changeProc)(imagePtr->widgetClientData, x, y, - width, height, imageWidth, imageHeight); + imagePtr->changeProc(imagePtr->widgetClientData, x, y, width, height, + imageWidth, imageHeight); } } @@ -549,7 +563,7 @@ Tk_ImageChanged( *---------------------------------------------------------------------- */ -CONST char * +const char * Tk_NameOfImage( Tk_ImageMaster imageMaster) /* Token for image. */ { @@ -589,7 +603,7 @@ Tk_GetImage( * be found. */ Tk_Window tkwin, /* Token for window in which image will be * used. */ - CONST char *name, /* Name of desired image. */ + const char *name, /* Name of desired image. */ Tk_ImageChangedProc *changeProc, /* Function to invoke when redisplay is needed * because image's pixels or size changed. */ @@ -603,19 +617,19 @@ Tk_GetImage( if (hPtr == NULL) { goto noSuchImage; } - masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->typePtr == NULL) { goto noSuchImage; } if (masterPtr->deleted) { goto noSuchImage; } - imagePtr = (Image *) ckalloc(sizeof(Image)); + imagePtr = ckalloc(sizeof(Image)); imagePtr->tkwin = tkwin; imagePtr->display = Tk_Display(tkwin); imagePtr->masterPtr = masterPtr; imagePtr->instanceData = - (*masterPtr->typePtr->getProc)(tkwin, masterPtr->masterData); + masterPtr->typePtr->getProc(tkwin, masterPtr->masterData); imagePtr->changeProc = changeProc; imagePtr->widgetClientData = clientData; imagePtr->nextPtr = masterPtr->instancePtr; @@ -624,7 +638,9 @@ Tk_GetImage( noSuchImage: if (interp) { - Tcl_AppendResult(interp, "image \"", name, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "IMAGE", name, NULL); } return NULL; } @@ -661,7 +677,7 @@ Tk_FreeImage( */ if (masterPtr->typePtr != NULL) { - (*masterPtr->typePtr->freeProc)(imagePtr->instanceData, + masterPtr->typePtr->freeProc(imagePtr->instanceData, imagePtr->display); } prevPtr = masterPtr->instancePtr; @@ -673,7 +689,7 @@ Tk_FreeImage( } prevPtr->nextPtr = imagePtr->nextPtr; } - ckfree((char *) imagePtr); + ckfree(imagePtr); /* * If there are no more instances left for the master, and if the master @@ -684,8 +700,8 @@ Tk_FreeImage( if (masterPtr->hPtr != NULL) { Tcl_DeleteHashEntry(masterPtr->hPtr); } - Tcl_Release((ClientData) masterPtr->winPtr); - ckfree((char *) masterPtr); + Tcl_Release(masterPtr->winPtr); + ckfree(masterPtr); } } @@ -739,9 +755,9 @@ Tk_PostscriptImage( */ if (imagePtr->masterPtr->typePtr->postscriptProc != NULL) { - return (*imagePtr->masterPtr->typePtr->postscriptProc)( - imagePtr->masterPtr->masterData, interp, tkwin, psinfo, - x, y, width, height, prepass); + return imagePtr->masterPtr->typePtr->postscriptProc( + imagePtr->masterPtr->masterData, interp, tkwin, psinfo, + x, y, width, height, prepass); } if (prepass) { @@ -760,15 +776,15 @@ Tk_PostscriptImage( gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin)); newGC = Tk_GetGC(tkwin, GCForeground, &gcValues); if (newGC != None) { - XFillRectangle(Tk_Display(tkwin), pmap, newGC, - 0, 0, (unsigned int)width, (unsigned int)height); + XFillRectangle(Tk_Display(tkwin), pmap, newGC, 0, 0, + (unsigned) width, (unsigned) height); Tk_FreeGC(Tk_Display(tkwin), newGC); } Tk_RedrawImage(image, x, y, width, height, pmap, 0, 0); ximage = XGetImage(Tk_Display(tkwin), pmap, 0, 0, - (unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap); + (unsigned) width, (unsigned) height, AllPlanes, ZPixmap); Tk_FreePixmap(Tk_Display(tkwin), pmap); @@ -849,9 +865,9 @@ Tk_RedrawImage( if ((imageY + height) > imagePtr->masterPtr->height) { height = imagePtr->masterPtr->height - imageY; } - (*imagePtr->masterPtr->typePtr->displayProc)( - imagePtr->instanceData, imagePtr->display, drawable, - imageX, imageY, width, height, drawableX, drawableY); + imagePtr->masterPtr->typePtr->displayProc(imagePtr->instanceData, + imagePtr->display, drawable, imageX, imageY, width, height, + drawableX, drawableY); } /* @@ -904,7 +920,7 @@ void Tk_DeleteImage( Tcl_Interp *interp, /* Interpreter in which the image was * created. */ - CONST char *name) /* Name of image. */ + const char *name) /* Name of image. */ { Tcl_HashEntry *hPtr; TkWindow *winPtr; @@ -917,7 +933,7 @@ Tk_DeleteImage( if (hPtr == NULL) { return; } - DeleteImage((ImageMaster *)Tcl_GetHashValue(hPtr)); + DeleteImage(Tcl_GetHashValue(hPtr)); } /* @@ -950,20 +966,19 @@ DeleteImage( if (typePtr != NULL) { for (imagePtr = masterPtr->instancePtr; imagePtr != NULL; imagePtr = imagePtr->nextPtr) { - (*typePtr->freeProc)(imagePtr->instanceData, - imagePtr->display); - (*imagePtr->changeProc)(imagePtr->widgetClientData, 0, 0, + typePtr->freeProc(imagePtr->instanceData, imagePtr->display); + imagePtr->changeProc(imagePtr->widgetClientData, 0, 0, masterPtr->width, masterPtr->height, masterPtr->width, masterPtr->height); } - (*typePtr->deleteProc)(masterPtr->masterData); + typePtr->deleteProc(masterPtr->masterData); } if (masterPtr->instancePtr == NULL) { if (masterPtr->hPtr != NULL) { Tcl_DeleteHashEntry(masterPtr->hPtr); } - Tcl_Release((ClientData) masterPtr->winPtr); - ckfree((char *) masterPtr); + Tcl_Release(masterPtr->winPtr); + ckfree(masterPtr); } else { masterPtr->deleted = 1; } @@ -998,8 +1013,7 @@ EventuallyDeleteImage( } if (!masterPtr->deleted) { masterPtr->deleted = 1; - Tcl_EventuallyFree((ClientData) masterPtr, - (Tcl_FreeProc *)DeleteImage); + Tcl_EventuallyFree(masterPtr, (Tcl_FreeProc *) DeleteImage); } } @@ -1031,7 +1045,7 @@ TkDeleteAllImages( for (hPtr = Tcl_FirstHashEntry(&mainPtr->imageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - EventuallyDeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr), 1); + EventuallyDeleteImage(Tcl_GetHashValue(hPtr), 1); } Tcl_DeleteHashTable(&mainPtr->imageTable); } @@ -1060,21 +1074,21 @@ ClientData Tk_GetImageMasterData( Tcl_Interp *interp, /* Interpreter in which the image was * created. */ - CONST char *name, /* Name of image. */ - Tk_ImageType **typePtrPtr) /* Points to location to fill in with pointer + const char *name, /* Name of image. */ + const Tk_ImageType **typePtrPtr) + /* Points to location to fill in with pointer * to type information for image. */ { + TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp); Tcl_HashEntry *hPtr; - TkWindow *winPtr; ImageMaster *masterPtr; - winPtr = (TkWindow *) Tk_MainWindow(interp); hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name); if (hPtr == NULL) { *typePtrPtr = NULL; return NULL; } - masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + masterPtr = Tcl_GetHashValue(hPtr); if (masterPtr->deleted) { *typePtrPtr = NULL; return NULL; diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c index 4f5c6ac..0906673 100644 --- a/generic/tkImgBmap.c +++ b/generic/tkImgBmap.c @@ -75,8 +75,8 @@ typedef struct BitmapInstance { static int GetByte(Tcl_Channel chan); static int ImgBmapCreate(Tcl_Interp *interp, - char *name, int argc, Tcl_Obj *CONST objv[], - Tk_ImageType *typePtr, Tk_ImageMaster master, + const char *name, int argc, Tcl_Obj *const objv[], + const Tk_ImageType *typePtr, Tk_ImageMaster master, ClientData *clientDataPtr); static ClientData ImgBmapGet(Tk_Window tkwin, ClientData clientData); static void ImgBmapDisplay(ClientData clientData, @@ -98,27 +98,28 @@ Tk_ImageType tkBitmapImageType = { ImgBmapFree, /* freeProc */ ImgBmapDelete, /* deleteProc */ ImgBmapPostscript, /* postscriptProc */ - NULL /* nextPtr */ + NULL, /* nextPtr */ + NULL }; /* * Information used for parsing configuration specs: */ -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_UID, "-background", NULL, NULL, - "", Tk_Offset(BitmapMaster, bgUid), 0}, + "", Tk_Offset(BitmapMaster, bgUid), 0, NULL}, {TK_CONFIG_STRING, "-data", NULL, NULL, - NULL, Tk_Offset(BitmapMaster, dataString), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(BitmapMaster, dataString), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_STRING, "-file", NULL, NULL, - NULL, Tk_Offset(BitmapMaster, fileString), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(BitmapMaster, fileString), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_UID, "-foreground", NULL, NULL, - "#000000", Tk_Offset(BitmapMaster, fgUid), 0}, + "#000000", Tk_Offset(BitmapMaster, fgUid), 0, NULL}, {TK_CONFIG_STRING, "-maskdata", NULL, NULL, - NULL, Tk_Offset(BitmapMaster, maskDataString), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(BitmapMaster, maskDataString), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_STRING, "-maskfile", NULL, NULL, - NULL, Tk_Offset(BitmapMaster, maskFileString), TK_CONFIG_NULL_OK}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + NULL, Tk_Offset(BitmapMaster, maskFileString), TK_CONFIG_NULL_OK, NULL}, + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -129,7 +130,7 @@ static Tk_ConfigSpec configSpecs[] = { #define MAX_WORD_LENGTH 100 typedef struct ParseInfo { - char *string; /* Next character of string data for bitmap, + const char *string; /* Next character of string data for bitmap, * or NULL if bitmap is being read from * file. */ Tcl_Channel chan; /* File containing bitmap data, or NULL if no @@ -145,11 +146,11 @@ typedef struct ParseInfo { */ static int ImgBmapCmd(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *CONST objv[]); + int argc, Tcl_Obj *const objv[]); static void ImgBmapCmdDeletedProc(ClientData clientData); static void ImgBmapConfigureInstance(BitmapInstance *instancePtr); static int ImgBmapConfigureMaster(BitmapMaster *masterPtr, - int argc, Tcl_Obj *CONST objv[], int flags); + int argc, Tcl_Obj *const objv[], int flags); static int NextBitmapWord(ParseInfo *parseInfoPtr); /* @@ -173,23 +174,22 @@ static int ImgBmapCreate( Tcl_Interp *interp, /* Interpreter for application containing * image. */ - char *name, /* Name to use for image. */ + const char *name, /* Name to use for image. */ int argc, /* Number of arguments. */ - Tcl_Obj *CONST argv[], /* Argument objects for options (doesn't + Tcl_Obj *const argv[], /* Argument objects for options (doesn't * include image name or type). */ - Tk_ImageType *typePtr, /* Pointer to our type record (not used). */ + const Tk_ImageType *typePtr,/* Pointer to our type record (not used). */ Tk_ImageMaster master, /* Token for image, to be used by us in later * callbacks. */ ClientData *clientDataPtr) /* Store manager's token for image here; it * will be returned in later callbacks. */ { - BitmapMaster *masterPtr; + BitmapMaster *masterPtr = ckalloc(sizeof(BitmapMaster)); - masterPtr = (BitmapMaster *) ckalloc(sizeof(BitmapMaster)); masterPtr->tkMaster = master; masterPtr->interp = interp; masterPtr->imageCmd = Tcl_CreateObjCommand(interp, name, ImgBmapCmd, - (ClientData) masterPtr, ImgBmapCmdDeletedProc); + masterPtr, ImgBmapCmdDeletedProc); masterPtr->width = masterPtr->height = 0; masterPtr->data = NULL; masterPtr->maskData = NULL; @@ -201,10 +201,10 @@ ImgBmapCreate( masterPtr->maskDataString = NULL; masterPtr->instancePtr = NULL; if (ImgBmapConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) { - ImgBmapDelete((ClientData) masterPtr); + ImgBmapDelete(masterPtr); return TCL_ERROR; } - *clientDataPtr = (ClientData) masterPtr; + *clientDataPtr = masterPtr; return TCL_OK; } @@ -233,26 +233,25 @@ ImgBmapConfigureMaster( BitmapMaster *masterPtr, /* Pointer to data structure describing * overall bitmap image to (reconfigure). */ int objc, /* Number of entries in objv. */ - Tcl_Obj *CONST objv[], /* Pairs of configuration options for image. */ + Tcl_Obj *const objv[], /* Pairs of configuration options for image. */ int flags) /* Flags to pass to Tk_ConfigureWidget, such * as TK_CONFIG_ARGV_ONLY. */ { BitmapInstance *instancePtr; int maskWidth, maskHeight, dummy1, dummy2; + const char **argv = ckalloc((objc+1) * sizeof(char *)); - CONST char **argv = (CONST char **) ckalloc((objc+1) * sizeof(char *)); for (dummy1 = 0; dummy1 < objc; dummy1++) { - argv[dummy1]=Tcl_GetString(objv[dummy1]); + argv[dummy1] = Tcl_GetString(objv[dummy1]); } argv[objc] = NULL; if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp), - configSpecs, objc, argv, (char *) masterPtr, flags) - != TCL_OK) { - ckfree((char *) argv); + configSpecs, objc, argv, (char *) masterPtr, flags) != TCL_OK) { + ckfree(argv); return TCL_ERROR; } - ckfree((char *) argv); + ckfree(argv); /* * Parse the bitmap and/or mask to create binary data. Make sure that the @@ -278,8 +277,10 @@ ImgBmapConfigureMaster( if ((masterPtr->maskFileString != NULL) || (masterPtr->maskDataString != NULL)) { if (masterPtr->data == NULL) { - Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap", - TCL_STATIC); + Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj( + "can't have mask without bitmap", -1)); + Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", + "NO_BITMAP", NULL); return TCL_ERROR; } masterPtr->maskData = TkGetBitmapData(masterPtr->interp, @@ -292,8 +293,10 @@ ImgBmapConfigureMaster( || (maskHeight != masterPtr->height)) { ckfree(masterPtr->maskData); masterPtr->maskData = NULL; - Tcl_SetResult(masterPtr->interp, - "bitmap and mask have different sizes", TCL_STATIC); + Tcl_SetObjResult(masterPtr->interp, Tcl_NewStringObj( + "bitmap and mask have different sizes", -1)); + Tcl_SetErrorCode(masterPtr->interp, "TK", "IMAGE", "BITMAP", + "MASK_SIZE", NULL); return TCL_ERROR; } } @@ -327,7 +330,7 @@ ImgBmapConfigureMaster( * None. * * Side effects: - * Generates errors via Tcl_BackgroundError if there are problems in + * Generates errors via Tcl_BackgroundException if there are problems in * setting up the instance. * *---------------------------------------------------------------------- @@ -442,10 +445,10 @@ ImgBmapConfigureInstance( Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc); } instancePtr->gc = None; - Tcl_AddErrorInfo(masterPtr->interp, "\n (while configuring image \""); - Tcl_AddErrorInfo(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster)); - Tcl_AddErrorInfo(masterPtr->interp, "\")"); - Tcl_BackgroundError(masterPtr->interp); + Tcl_AppendObjToErrorInfo(masterPtr->interp, Tcl_ObjPrintf( + "\n (while configuring image \"%s\")", Tk_NameOfImage( + masterPtr->tkMaster))); + Tcl_BackgroundException(masterPtr->interp, TCL_ERROR); } /* @@ -473,8 +476,8 @@ ImgBmapConfigureInstance( char * TkGetBitmapData( Tcl_Interp *interp, /* For reporting errors, or NULL. */ - char *string, /* String describing bitmap. May be NULL. */ - char *fileName, /* Name of file containing bitmap description. + const char *string, /* String describing bitmap. May be NULL. */ + const char *fileName, /* Name of file containing bitmap description. * Used only if string is NULL. Must not be * NULL if string is NULL. */ int *widthPtr, int *heightPtr, @@ -482,7 +485,7 @@ TkGetBitmapData( int *hotXPtr, int *hotYPtr) /* Position of hot spot or -1,-1. */ { int width, height, numBytes, hotX, hotY; - CONST char *expandedFileName; + const char *expandedFileName; char *p, *end; ParseInfo pi; char *data = NULL; @@ -491,8 +494,10 @@ TkGetBitmapData( pi.string = string; if (string == NULL) { if ((interp != NULL) && Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get bitmap data from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get bitmap data from a file in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL); return NULL; } expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer); @@ -504,8 +509,9 @@ TkGetBitmapData( if (pi.chan == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't read bitmap file \"", - fileName, "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read bitmap file \"%s\": %s", + fileName, Tcl_PosixError(interp))); } return NULL; } @@ -594,8 +600,11 @@ TkGetBitmapData( } } else if ((pi.word[0] == '{') && (pi.word[1] == 0)) { if (interp != NULL) { - Tcl_AppendResult(interp, "format error in bitmap data; ", - "looks like it's an obsolete X10 bitmap file", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "format error in bitmap data; looks like it's an" + " obsolete X10 bitmap file", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "OBSOLETE", + NULL); } goto errorCleanup; } @@ -611,7 +620,7 @@ TkGetBitmapData( goto error; } numBytes = ((width+7)/8) * height; - data = (char *) ckalloc((unsigned) numBytes); + data = ckalloc(numBytes); for (p = data; numBytes > 0; p++, numBytes--) { if (NextBitmapWord(&pi) != TCL_OK) { goto error; @@ -637,7 +646,9 @@ TkGetBitmapData( error: if (interp != NULL) { - Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "format error in bitmap data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "BITMAP", "FORMAT", NULL); } errorCleanup: @@ -674,7 +685,8 @@ NextBitmapWord( ParseInfo *parseInfoPtr) /* Describes what we're reading and where we * are in it. */ { - char *src, *dst; + const char *src; + char *dst; int c; parseInfoPtr->wordLength = 0; @@ -742,18 +754,18 @@ ImgBmapCmd( ClientData clientData, /* Information about the image master. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static CONST char *bmapOptions[] = {"cget", "configure", NULL}; - BitmapMaster *masterPtr = (BitmapMaster *) clientData; + static const char *const bmapOptions[] = {"cget", "configure", NULL}; + BitmapMaster *masterPtr = clientData; int index; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], bmapOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], bmapOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { @@ -807,7 +819,7 @@ ImgBmapGet( ClientData masterData) /* Pointer to our master structure for the * image. */ { - BitmapMaster *masterPtr = (BitmapMaster *) masterData; + BitmapMaster *masterPtr = masterData; BitmapInstance *instancePtr; /* @@ -819,7 +831,7 @@ ImgBmapGet( instancePtr = instancePtr->nextPtr) { if (instancePtr->tkwin == tkwin) { instancePtr->refCount++; - return (ClientData) instancePtr; + return instancePtr; } } @@ -828,7 +840,7 @@ ImgBmapGet( * the image. */ - instancePtr = (BitmapInstance *) ckalloc(sizeof(BitmapInstance)); + instancePtr = ckalloc(sizeof(BitmapInstance)); instancePtr->refCount = 1; instancePtr->masterPtr = masterPtr; instancePtr->tkwin = tkwin; @@ -850,7 +862,7 @@ ImgBmapGet( masterPtr->height); } - return (ClientData) instancePtr; + return instancePtr; } /* @@ -882,7 +894,7 @@ ImgBmapDisplay( /* Coordinates within drawable that correspond * to imageX and imageY. */ { - BitmapInstance *instancePtr = (BitmapInstance *) clientData; + BitmapInstance *instancePtr = clientData; int masking; /* @@ -936,7 +948,7 @@ ImgBmapFree( * instance to be displayed. */ Display *display) /* Display containing window that used image. */ { - BitmapInstance *instancePtr = (BitmapInstance *) clientData; + BitmapInstance *instancePtr = clientData; BitmapInstance *prevPtr; instancePtr->refCount--; @@ -973,7 +985,7 @@ ImgBmapFree( } prevPtr->nextPtr = instancePtr->nextPtr; } - ckfree((char *) instancePtr); + ckfree(instancePtr); } /* @@ -998,7 +1010,7 @@ ImgBmapDelete( ClientData masterData) /* Pointer to BitmapMaster structure for * image. Must not have any more instances. */ { - BitmapMaster *masterPtr = (BitmapMaster *) masterData; + BitmapMaster *masterPtr = masterData; if (masterPtr->instancePtr != NULL) { Tcl_Panic("tried to delete bitmap image when instances still exist"); @@ -1014,7 +1026,7 @@ ImgBmapDelete( ckfree(masterPtr->maskData); } Tk_FreeOptions(configSpecs, (char *) masterPtr, NULL, 0); - ckfree((char *) masterPtr); + ckfree(masterPtr); } /* @@ -1039,7 +1051,7 @@ ImgBmapCmdDeletedProc( ClientData clientData) /* Pointer to BitmapMaster structure for * image. */ { - BitmapMaster *masterPtr = (BitmapMaster *) clientData; + BitmapMaster *masterPtr = clientData; masterPtr->imageCmd = NULL; if (masterPtr->tkMaster != NULL) { @@ -1077,7 +1089,6 @@ GetByte( return buffer; } } - /* *---------------------------------------------------------------------- @@ -1100,28 +1111,22 @@ GetByte( * 3. The postscript coordinate system has been scaled so that the * entire bitmap is one unit squared. * - * Some postscript implementations cannot handle bitmap strings longer - * than about 60k characters. If the bitmap data is that big or bigger, - * then we render it by splitting it into several smaller bitmaps. - * * Results: - * Returns TCL_OK on success. Returns TCL_ERROR and leaves and error - * message in interp->result if there is a problem. + * None. * * Side effects: - * Postscript code is appended to interp->result. + * Postscript code is appended to psObj. * *---------------------------------------------------------------------- */ -static int +static void ImgBmapPsImagemask( - Tcl_Interp *interp, /* Append postscript to this interpreter */ + Tcl_Obj *psObj, /* Append postscript to this buffer. */ int width, int height, /* Width and height of the bitmap in pixels */ - char *data) /* Data for the bitmap */ + char *data) /* Data for the bitmap. */ { int i, j, nBytePerRow; - char buffer[200]; /* * The bit order of bitmaps in Tk is the opposite of the bit order that @@ -1150,29 +1155,20 @@ ImgBmapPsImagemask( 15, 143, 79, 207, 47, 175, 111, 239, 31, 159, 95, 223, 63, 191, 127, 255, }; - if (width*height > 60000) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unable to generate postscript for bitmaps " - "larger than 60000 pixels", NULL); - return TCL_ERROR; - } - - sprintf(buffer, "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n", + Tcl_AppendPrintfToObj(psObj, + "0 0 moveto %d %d true [%d 0 0 %d 0 %d] {<\n", width, height, width, -height, height); - Tcl_AppendResult(interp, buffer, NULL); - nBytePerRow = (width+7)/8; - for(i=0; i<height; i++){ - for(j=0; j<nBytePerRow; j++){ - sprintf(buffer, " %02x", + nBytePerRow = (width + 7) / 8; + for (i=0; i<height; i++) { + for (j=0; j<nBytePerRow; j++) { + Tcl_AppendPrintfToObj(psObj, " %02x", bit_reverse[0xff & data[i*nBytePerRow + j]]); - Tcl_AppendResult(interp, buffer, NULL); } - Tcl_AppendResult(interp, "\n", NULL); + Tcl_AppendToObj(psObj, "\n", -1); } - Tcl_AppendResult(interp, ">} imagemask \n", NULL); - return TCL_OK; + Tcl_AppendToObj(psObj, ">} imagemask \n", -1); } /* @@ -1183,7 +1179,6 @@ ImgBmapPsImagemask( * This procedure generates postscript for rendering a bitmap image. * * Results: - * On success, this routine writes postscript code into interp->result * and returns TCL_OK TCL_ERROR is returned and an error message is left * in interp->result if anything goes wrong. @@ -1203,8 +1198,9 @@ ImgBmapPostscript( int x, int y, int width, int height, int prepass) { - BitmapMaster *masterPtr = (BitmapMaster *) clientData; - char buffer[200]; + BitmapMaster *masterPtr = clientData; + Tcl_InterpState interpState; + Tcl_Obj *psObj; if (prepass) { return TCL_OK; @@ -1214,11 +1210,32 @@ ImgBmapPostscript( * There is nothing to do for bitmaps with zero width or height. */ - if (width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<= 0){ + if (width<=0 || height<=0 || masterPtr->width<=0 || masterPtr->height<=0){ return TCL_OK; } /* + * Some postscript implementations cannot handle bitmap strings longer + * than about 60k characters. If the bitmap data is that big or bigger, + * we bail out. + */ + + if (masterPtr->width*masterPtr->height > 60000) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to generate postscript for bitmaps larger than 60000" + " pixels", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); + return TCL_ERROR; + } + + /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * Translate the origin of the coordinate system to be the lower-left * corner of the bitmap and adjust the scale of the coordinate system so * that entire bitmap covers one square unit of the page. The calling @@ -1227,13 +1244,11 @@ ImgBmapPostscript( * necessary here. */ - if (x!=0 || y!=0) { - sprintf(buffer, "%d %d moveto\n", x, y); - Tcl_AppendResult(interp, buffer, NULL); + if (x != 0 || y != 0) { + Tcl_AppendPrintfToObj(psObj, "%d %d moveto\n", x, y); } - if (width!=1 || height!=1) { - sprintf(buffer, "%d %d scale\n", width, height); - Tcl_AppendResult(interp, buffer, NULL); + if (width != 1 || height != 1) { + Tcl_AppendPrintfToObj(psObj, "%d %d scale\n", width, height); } /* @@ -1249,16 +1264,19 @@ ImgBmapPostscript( TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->bgUid, &color); + Tcl_ResetResult(interp); if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (masterPtr->maskData == NULL) { - Tcl_AppendResult(interp, - "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto ", - "closepath fill\n", NULL); - } else if (ImgBmapPsImagemask(interp, masterPtr->width, - masterPtr->height, masterPtr->maskData) != TCL_OK) { - return TCL_ERROR; + Tcl_AppendToObj(psObj, + "0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto " + "closepath fill\n", -1); + } else { + ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height, + masterPtr->maskData); } } @@ -1271,15 +1289,29 @@ ImgBmapPostscript( TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->fgUid, &color); + Tcl_ResetResult(interp); if (Tk_PostscriptColor(interp, psinfo, &color) != TCL_OK) { - return TCL_ERROR; - } - if (ImgBmapPsImagemask(interp, masterPtr->width, masterPtr->height, - masterPtr->data) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + + ImgBmapPsImagemask(psObj, masterPtr->width, masterPtr->height, + masterPtr->data); } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + return TCL_ERROR; } /* diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index e576559..1c28b54 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -11,7 +11,7 @@ * Copyright (c) Reed Wade (wade@cs.utk.edu), University of Tennessee * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1997 Australian National University - * Copyright (c) 2005 Donal K. Fellows + * Copyright (c) 2005-2010 Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -28,9 +28,6 @@ * | notice appear in supporting documentation. This software is | * | provided "as is" without express or implied warranty. | * +--------------------------------------------------------------------+ - * - * This file also contains code from miGIF. See lower down in file for the - * applicable copyright notice for that portion. */ #include "tkInt.h" @@ -110,6 +107,14 @@ typedef struct { } GIFImageConfig; /* + * Type of a function used to do the writing to a file or buffer when + * serializing in the GIF format. + */ + +typedef int (WriteBytesFunc) (ClientData clientData, const char *bytes, + int byteCount); + +/* * The format record for the GIF file format: */ @@ -128,8 +133,11 @@ static int StringReadGIF(Tcl_Interp *interp, Tcl_Obj *dataObj, int srcX, int srcY); static int FileWriteGIF(Tcl_Interp *interp, const char *filename, Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr); -static int CommonWriteGIF(Tcl_Interp *interp, Tcl_Channel handle, - Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr); +static int StringWriteGIF(Tcl_Interp *interp, Tcl_Obj *format, + Tk_PhotoImageBlock *blockPtr); +static int CommonWriteGIF(Tcl_Interp *interp, ClientData clientData, + WriteBytesFunc *writeProc, Tcl_Obj *format, + Tk_PhotoImageBlock *blockPtr); Tk_PhotoImageFormat tkImgFmtGIF = { "gif", /* name */ @@ -138,7 +146,8 @@ Tk_PhotoImageFormat tkImgFmtGIF = { FileReadGIF, /* fileReadProc */ StringReadGIF, /* stringReadProc */ FileWriteGIF, /* fileWriteProc */ - NULL, /* stringWriteProc */ + StringWriteGIF, /* stringWriteProc */ + NULL }; #define INTERLACE 0x40 @@ -186,6 +195,135 @@ static int Mgetc(MFile *handle); static int char64(int c); static void mInit(unsigned char *string, MFile *handle, int length); + +/* + * Types, defines and variables needed to write and compress a GIF. + */ + +#define LSB(a) ((unsigned char) (((short)(a)) & 0x00FF)) +#define MSB(a) ((unsigned char) (((short)(a)) >> 8)) + +#define GIFBITS 12 +#define HSIZE 5003 /* 80% occupancy */ + +#define DEFAULT_BACKGROUND_VALUE 0xD9 + +typedef struct { + int ssize; + int csize; + int rsize; + unsigned char *pixelOffset; + int pixelSize; + int pixelPitch; + int greenOffset; + int blueOffset; + int alphaOffset; + int num; + unsigned char mapa[MAXCOLORMAPSIZE][3]; +} GifWriterState; + +typedef int (* ifunptr) (GifWriterState *statePtr); + +/* + * Support for compression of GIFs. + */ + +#define MAXCODE(numBits) (((long) 1 << (numBits)) - 1) + +#ifdef SIGNED_COMPARE_SLOW +#define U(x) ((unsigned) (x)) +#else +#define U(x) (x) +#endif + +typedef struct { + int numBits; /* Number of bits/code. */ + long maxCode; /* Maximum code, given numBits. */ + int hashTable[HSIZE]; + unsigned int codeTable[HSIZE]; + long hSize; /* For dynamic table sizing. */ + + /* + * To save much memory, we overlay the table used by compress() with those + * used by decompress(). The tab_prefix table is the same size and type as + * the codeTable. The tab_suffix table needs 2**GIFBITS characters. We get + * this from the beginning of hashTable. The output stack uses the rest of + * hashTable, and contains characters. There is plenty of room for any + * possible stack (stack used to be 8000 characters). + */ + + int freeEntry; /* First unused entry. */ + + /* + * Block compression parameters. After all codes are used up, and + * compression rate changes, start over. + */ + + int clearFlag; + + int offset; + unsigned int inCount; /* Length of input */ + unsigned int outCount; /* # of codes output (for debugging) */ + + /* + * Algorithm: use open addressing double hashing (no chaining) on the + * prefix code / next character combination. We do a variant of Knuth's + * algorithm D (vol. 3, sec. 6.4) along with G. Knott's relatively-prime + * secondary probe. Here, the modular division first probe is gives way to + * a faster exclusive-or manipulation. Also do block compression with an + * adaptive reset, whereby the code table is cleared when the compression + * ratio decreases, but after the table fills. The variable-length output + * codes are re-sized at this point, and a special CLEAR code is generated + * for the decompressor. Late addition: construct the table according to + * file size for noticeable speed improvement on small files. Please + * direct questions about this implementation to ames!jaw. + */ + + int initialBits; + ClientData destination; + WriteBytesFunc *writeProc; + + int clearCode; + int eofCode; + + unsigned long currentAccumulated; + int currentBits; + + /* + * Number of characters so far in this 'packet' + */ + + int accumulatedByteCount; + + /* + * Define the storage for the packet accumulator + */ + + unsigned char packetAccumulator[256]; +} GIFState_t; + +/* + * Definition of new functions to write GIFs + */ + +static int ColorNumber(GifWriterState *statePtr, + int red, int green, int blue); +static void Compress(int initBits, ClientData handle, + WriteBytesFunc *writeProc, ifunptr readValue, + GifWriterState *statePtr); +static int IsNewColor(GifWriterState *statePtr, + int red, int green, int blue); +static void SaveMap(GifWriterState *statePtr, + Tk_PhotoImageBlock *blockPtr); +static int ReadValue(GifWriterState *statePtr); +static WriteBytesFunc WriteToChannel; +static WriteBytesFunc WriteToByteArray; +static void Output(GIFState_t *statePtr, long code); +static void ClearForBlock(GIFState_t *statePtr); +static void ClearHashTable(GIFState_t *statePtr, int hSize); +static void CharInit(GIFState_t *statePtr); +static void CharOut(GIFState_t *statePtr, int c); +static void FlushChar(GIFState_t *statePtr); /* *---------------------------------------------------------------------- @@ -255,14 +393,15 @@ FileReadGIF( * image being read. */ { int fileWidth, fileHeight, imageWidth, imageHeight; - int nBytes, index = 0, argc = 0, i, result = TCL_ERROR; + unsigned int nBytes; + int index = 0, argc = 0, i, result = TCL_ERROR; Tcl_Obj **objv; unsigned char buf[100]; unsigned char *trashBuffer = NULL; int bitPixel; unsigned char colorMap[MAXCOLORMAPSIZE][4]; int transparent = -1; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "-index", NULL }; GIFImageConfig gifConf, *gifConfPtr = &gifConf; @@ -272,6 +411,7 @@ FileReadGIF( * source and not a file. */ + memset(colorMap, 0, MAXCOLORMAPSIZE*4); memset(gifConfPtr, 0, sizeof(GIFImageConfig)); if (fileName == INLINE_DATA_BINARY || fileName == INLINE_DATA_BASE64) { gifConfPtr->fromData = fileName; @@ -287,13 +427,16 @@ FileReadGIF( return TCL_ERROR; } for (i = 1; i < argc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option name", - 0, &nBytes) != TCL_OK) { + int optionIdx; + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, + sizeof(char *), "option name", 0, &optionIdx) != TCL_OK) { return TCL_ERROR; } if (i == (argc-1)) { - Tcl_AppendResult(interp, "no value given for \"", - Tcl_GetString(objv[i]), "\" option", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no value given for \"%s\" option", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "OPT_VALUE", NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[++i], &index) != TCL_OK) { @@ -306,13 +449,15 @@ FileReadGIF( */ if (!ReadGIFHeader(gifConfPtr, chan, &fileWidth, &fileHeight)) { - Tcl_AppendResult(interp, "couldn't read GIF header from file \"", - fileName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read GIF header from file \"%s\"", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "GIF image file \"", fileName, - "\" has dimension(s) <= 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "GIF image file \"%s\" has dimension(s) <= 0", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BOGUS_SIZE", NULL); return TCL_ERROR; } @@ -327,7 +472,9 @@ FileReadGIF( if (BitSet(buf[0], LOCALCOLORMAP)) { /* Global Colormap */ if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); return TCL_ERROR; } } @@ -363,14 +510,18 @@ FileReadGIF( * Premature end of image. */ - Tcl_AppendResult(interp, - "premature end of image data for this index", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "premature end of image data for this index", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "PREMATURE_END", + NULL); goto error; } switch (buf[0]) { case GIF_TERMINATOR: - Tcl_AppendResult(interp, "no image data for this index", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no image data for this index", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "NO_DATA", NULL); goto error; case GIF_EXTENSION: @@ -379,23 +530,29 @@ FileReadGIF( */ if (Fread(gifConfPtr, buf, 1, 1, chan) != 1) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "error reading extension function code in GIF image", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT", + NULL); goto error; } if (DoExtension(gifConfPtr, chan, buf[0], gifConfPtr->workingBuffer, &transparent) < 0) { - Tcl_SetResult(interp, "error reading extension in GIF image", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading extension in GIF image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "BAD_EXT", + NULL); goto error; } continue; case GIF_START: if (Fread(gifConfPtr, buf, 1, 9, chan) != 9) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't read left/top/width/height in GIF image", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "DIMENSIONS", + NULL); goto error; } break; @@ -423,7 +580,10 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", + "COLOR_MAP", NULL); goto error; } } @@ -433,8 +593,14 @@ FileReadGIF( */ if (trashBuffer == NULL) { + if (fileWidth > (int)((UINT_MAX/3)/fileHeight)) { + goto error; + } nBytes = fileWidth * fileHeight * 3; - trashBuffer = (unsigned char *) ckalloc((unsigned) nBytes); + trashBuffer = ckalloc(nBytes); + if (trashBuffer) { + memset(trashBuffer, 0, nBytes); + } } /* @@ -470,7 +636,9 @@ FileReadGIF( if (BitSet(buf[8], LOCALCOLORMAP)) { if (!ReadColorMap(gifConfPtr, chan, bitPixel, colorMap)) { - Tcl_AppendResult(interp, "error reading color map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading color map", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLOR_MAP", NULL); goto error; } } @@ -516,22 +684,31 @@ FileReadGIF( block.offset[1] = 1; block.offset[2] = 2; block.offset[3] = (transparent>=0) ? 3 : 0; + if (imageWidth > INT_MAX/block.pixelSize) { + goto error; + } block.pitch = block.pixelSize * imageWidth; + if (imageHeight > (int)(UINT_MAX/block.pitch)) { + goto error; + } nBytes = block.pitch * imageHeight; - block.pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes); + block.pixelPtr = ckalloc(nBytes); + if (block.pixelPtr) { + memset(block.pixelPtr, 0, nBytes); + } if (ReadImage(gifConfPtr, interp, block.pixelPtr, chan, imageWidth, - imageHeight, colorMap, srcX, srcY, BitSet(buf[8],INTERLACE), + imageHeight, colorMap, srcX, srcY, BitSet(buf[8], INTERLACE), transparent) != TCL_OK) { - ckfree((char *) block.pixelPtr); + ckfree(block.pixelPtr); goto error; } if (Tk_PhotoPutBlock(interp, imageHandle, &block, destX, destY, width, height, TK_PHOTO_COMPOSITE_SET) != TCL_OK) { - ckfree((char *) block.pixelPtr); + ckfree(block.pixelPtr); goto error; } - ckfree((char *) block.pixelPtr); + ckfree(block.pixelPtr); } /* @@ -539,7 +716,7 @@ FileReadGIF( * which suits as well). We're done. */ - Tcl_AppendResult(interp, tkImgFmtGIF.name, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(tkImgFmtGIF.name, -1)); result = TCL_OK; error: @@ -548,7 +725,7 @@ FileReadGIF( */ if (trashBuffer != NULL) { - ckfree((char *) trashBuffer); + ckfree(trashBuffer); } return result; } @@ -765,19 +942,19 @@ DoExtension( int count; switch (label) { - case 0x01: /* Plain Text Extension */ + case 0x01: /* Plain Text Extension */ break; - case 0xff: /* Application Extension */ + case 0xff: /* Application Extension */ break; - case 0xfe: /* Comment Extension */ + case 0xfe: /* Comment Extension */ do { count = GetDataBlock(gifConfPtr, chan, buf); } while (count > 0); return count; - case 0xf9: /* Graphic Control Extension */ + case 0xf9: /* Graphic Control Extension */ count = GetDataBlock(gifConfPtr, chan, buf); if (count < 0) { return 1; @@ -873,13 +1050,14 @@ ReadImage( */ if (Fread(gifConfPtr, &initialCodeSize, 1, 1, chan) <= 0) { - Tcl_AppendResult(interp, "error reading GIF image: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading GIF image: %s", Tcl_PosixError(interp))); return TCL_ERROR; } if (initialCodeSize > MAX_LWZ_BITS) { - Tcl_SetResult(interp, "malformed image", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("malformed image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "MALFORMED", NULL); return TCL_ERROR; } @@ -1278,7 +1456,7 @@ Mgetc( handle->data++; } while (c == GIF_SPACE); - if (c>GIF_SPECIAL) { + if (c > GIF_SPECIAL) { handle->state = GIF_DONE; return handle->c; } @@ -1414,8 +1592,8 @@ Fread( * lolo@pcsig22.etsimo.uniovi.es * Date: Fri September 20 1996 * - * Modified for transparency handling (gif89a) and miGIF compression - * by Jan Nijtmans <j.nijtmans@chello.nl> + * Modified for transparency handling (gif89a) + * by Jan Nijtmans <nijtmans@users.sourceforge.net> * *---------------------------------------------------------------------- * FileWriteGIF- @@ -1424,54 +1602,12 @@ Fread( * data from a photo image into a given file * * Results: - * A standard TCL completion code. If TCL_ERROR is returned then an error - * message is left in interp->result. + * A standard TCL completion code. If TCL_ERROR is returned then an + * error message is left in the interp's result. * *---------------------------------------------------------------------- */ -/* - * Types, defines and variables needed to write and compress a GIF. - */ - -typedef int (* ifunptr) (ClientData clientData); - -#define LSB(a) ((unsigned char) (((short)(a)) & 0x00FF)) -#define MSB(a) ((unsigned char) (((short)(a)) >> 8)) - -#define GIFBITS 12 -#define HSIZE 5003 /* 80% occupancy */ - -typedef struct { - int ssize; - int csize; - int rsize; - unsigned char *pixelo; - int pixelSize; - int pixelPitch; - int greenOffset; - int blueOffset; - int alphaOffset; - int num; - unsigned char mapa[MAXCOLORMAPSIZE][3]; -} GifWriterState; - -/* - * Definition of new functions to write GIFs - */ - -static int color(GifWriterState *statePtr, - int red, int green, int blue, - unsigned char mapa[MAXCOLORMAPSIZE][3]); -static void compress(int initBits, Tcl_Channel handle, - ifunptr readValue, ClientData clientData); -static int nuevo(GifWriterState *statePtr, - int red, int green, int blue, - unsigned char mapa[MAXCOLORMAPSIZE][3]); -static void savemap(GifWriterState *statePtr, - Tk_PhotoImageBlock *blockPtr, - unsigned char mapa[MAXCOLORMAPSIZE][3]); -static int ReadValue(ClientData clientData); static int FileWriteGIF( @@ -1493,22 +1629,69 @@ FileWriteGIF( return TCL_ERROR; } - result = CommonWriteGIF(interp, chan, format, blockPtr); + result = CommonWriteGIF(interp, chan, WriteToChannel, format, blockPtr); if (Tcl_Close(interp, chan) == TCL_ERROR) { return TCL_ERROR; } return result; } + +static int +StringWriteGIF( + Tcl_Interp *interp, /* Interpreter to use for reporting errors and + * returning the GIF data. */ + Tcl_Obj *format, + Tk_PhotoImageBlock *blockPtr) +{ + int result; + Tcl_Obj *objPtr = Tcl_NewObj(); + + Tcl_IncrRefCount(objPtr); + result = CommonWriteGIF(interp, objPtr, WriteToByteArray, format, + blockPtr); + if (result == TCL_OK) { + Tcl_SetObjResult(interp, objPtr); + } + Tcl_DecrRefCount(objPtr); + return result; +} + +static int +WriteToChannel( + ClientData clientData, + const char *bytes, + int byteCount) +{ + Tcl_Channel handle = clientData; + + return Tcl_Write(handle, bytes, byteCount); +} + +static int +WriteToByteArray( + ClientData clientData, + const char *bytes, + int byteCount) +{ + Tcl_Obj *objPtr = clientData; + Tcl_Obj *tmpObj = Tcl_NewByteArrayObj((unsigned char *) bytes, byteCount); + + Tcl_IncrRefCount(tmpObj); + Tcl_AppendObjToObj(objPtr, tmpObj); + Tcl_DecrRefCount(tmpObj); + return byteCount; +} static int CommonWriteGIF( Tcl_Interp *interp, - Tcl_Channel handle, + ClientData handle, + WriteBytesFunc *writeProc, Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr) { - GifWriterState state, *statePtr = &state; + GifWriterState state; int resolution; long width, height, x; unsigned char c; @@ -1517,140 +1700,141 @@ CommonWriteGIF( top = 0; left = 0; - memset(statePtr, 0, sizeof(state)); + memset(&state, 0, sizeof(state)); - statePtr->pixelSize = blockPtr->pixelSize; - statePtr->greenOffset = blockPtr->offset[1]-blockPtr->offset[0]; - statePtr->blueOffset = blockPtr->offset[2]-blockPtr->offset[0]; - statePtr->alphaOffset = blockPtr->offset[0]; - if (statePtr->alphaOffset < blockPtr->offset[2]) { - statePtr->alphaOffset = blockPtr->offset[2]; + state.pixelSize = blockPtr->pixelSize; + state.greenOffset = blockPtr->offset[1]-blockPtr->offset[0]; + state.blueOffset = blockPtr->offset[2]-blockPtr->offset[0]; + state.alphaOffset = blockPtr->offset[0]; + if (state.alphaOffset < blockPtr->offset[2]) { + state.alphaOffset = blockPtr->offset[2]; } - if (++statePtr->alphaOffset < statePtr->pixelSize) { - statePtr->alphaOffset -= blockPtr->offset[0]; + if (++state.alphaOffset < state.pixelSize) { + state.alphaOffset -= blockPtr->offset[0]; } else { - statePtr->alphaOffset = 0; + state.alphaOffset = 0; } - Tcl_Write(handle, (char *) (statePtr->alphaOffset ? GIF89a : GIF87a), 6); + writeProc(handle, (char *) (state.alphaOffset ? GIF89a : GIF87a), 6); - for (x=0 ; x<MAXCOLORMAPSIZE ; x++) { - statePtr->mapa[x][CM_RED] = 255; - statePtr->mapa[x][CM_GREEN] = 255; - statePtr->mapa[x][CM_BLUE] = 255; + for (x = 0; x < MAXCOLORMAPSIZE ;x++) { + state.mapa[x][CM_RED] = 255; + state.mapa[x][CM_GREEN] = 255; + state.mapa[x][CM_BLUE] = 255; } width = blockPtr->width; height = blockPtr->height; - statePtr->pixelo = blockPtr->pixelPtr + blockPtr->offset[0]; - statePtr->pixelPitch = blockPtr->pitch; - savemap(statePtr, blockPtr, statePtr->mapa); - if (statePtr->num >= MAXCOLORMAPSIZE) { - Tcl_AppendResult(interp, "too many colors", NULL); + state.pixelOffset = blockPtr->pixelPtr + blockPtr->offset[0]; + state.pixelPitch = blockPtr->pitch; + SaveMap(&state, blockPtr); + if (state.num >= MAXCOLORMAPSIZE) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("too many colors", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "GIF", "COLORFUL", NULL); return TCL_ERROR; } - if (statePtr->num<2) { - statePtr->num = 2; + if (state.num<2) { + state.num = 2; } c = LSB(width); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = MSB(width); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = LSB(height); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = MSB(height); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); resolution = 0; - while (statePtr->num >> resolution) { + while (state.num >> resolution) { resolution++; } c = 111 + resolution * 17; - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); - statePtr->num = 1 << resolution; + state.num = 1 << resolution; /* * Background color */ c = 0; - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); /* * Zero for future expansion. */ - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); - for (x=0 ; x<statePtr->num ; x++) { - c = statePtr->mapa[x][CM_RED]; - Tcl_Write(handle, (char *) &c, 1); - c = statePtr->mapa[x][CM_GREEN]; - Tcl_Write(handle, (char *) &c, 1); - c = statePtr->mapa[x][CM_BLUE]; - Tcl_Write(handle, (char *) &c, 1); + for (x = 0; x < state.num; x++) { + c = state.mapa[x][CM_RED]; + writeProc(handle, (char *) &c, 1); + c = state.mapa[x][CM_GREEN]; + writeProc(handle, (char *) &c, 1); + c = state.mapa[x][CM_BLUE]; + writeProc(handle, (char *) &c, 1); } /* * Write out extension for transparent colour index, if necessary. */ - if (statePtr->alphaOffset) { + if (state.alphaOffset) { c = GIF_EXTENSION; - Tcl_Write(handle, (char *) &c, 1); - Tcl_Write(handle, "\371\4\1\0\0\0", 7); + writeProc(handle, (char *) &c, 1); + writeProc(handle, "\371\4\1\0\0\0", 7); } c = GIF_START; - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = LSB(top); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = MSB(top); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = LSB(left); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = MSB(left); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = LSB(width); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = MSB(width); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = LSB(height); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = MSB(height); - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = 0; - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = resolution; - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); - statePtr->ssize = statePtr->rsize = blockPtr->width; - statePtr->csize = blockPtr->height; - compress(resolution+1, handle, ReadValue, (ClientData) statePtr); + state.ssize = state.rsize = blockPtr->width; + state.csize = blockPtr->height; + Compress(resolution+1, handle, writeProc, ReadValue, &state); c = 0; - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); c = GIF_TERMINATOR; - Tcl_Write(handle, (char *) &c, 1); + writeProc(handle, (char *) &c, 1); return TCL_OK; } static int -color( +ColorNumber( GifWriterState *statePtr, - int red, int green, int blue, - unsigned char mapa[MAXCOLORMAPSIZE][3]) + int red, int green, int blue) { int x = (statePtr->alphaOffset != 0); - for (; x<=MAXCOLORMAPSIZE ; x++) { - if ((mapa[x][CM_RED] == red) && (mapa[x][CM_GREEN] == green) && - (mapa[x][CM_BLUE] == blue)) { + for (; x <= MAXCOLORMAPSIZE; x++) { + if ((statePtr->mapa[x][CM_RED] == red) && + (statePtr->mapa[x][CM_GREEN] == green) && + (statePtr->mapa[x][CM_BLUE] == blue)) { return x; } } @@ -1658,16 +1842,16 @@ color( } static int -nuevo( +IsNewColor( GifWriterState *statePtr, - int red, int green, int blue, - unsigned char mapa[MAXCOLORMAPSIZE][3]) + int red, int green, int blue) { int x = (statePtr->alphaOffset != 0); for (; x<=statePtr->num ; x++) { - if ((mapa[x][CM_RED] == red) && (mapa[x][CM_GREEN] == green) && - (mapa[x][CM_BLUE] == blue)) { + if ((statePtr->mapa[x][CM_RED] == red) && + (statePtr->mapa[x][CM_GREEN] == green) && + (statePtr->mapa[x][CM_BLUE] == blue)) { return 0; } } @@ -1675,10 +1859,9 @@ nuevo( } static void -savemap( +SaveMap( GifWriterState *statePtr, - Tk_PhotoImageBlock *blockPtr, - unsigned char mapa[MAXCOLORMAPSIZE][3]) + Tk_PhotoImageBlock *blockPtr) { unsigned char *colores; int x, y; @@ -1686,9 +1869,9 @@ savemap( if (statePtr->alphaOffset) { statePtr->num = 0; - mapa[0][CM_RED] = 0xd9; - mapa[0][CM_GREEN] = 0xd9; - mapa[0][CM_BLUE] = 0xd9; + statePtr->mapa[0][CM_RED] = DEFAULT_BACKGROUND_VALUE; + statePtr->mapa[0][CM_GREEN] = DEFAULT_BACKGROUND_VALUE; + statePtr->mapa[0][CM_BLUE] = DEFAULT_BACKGROUND_VALUE; } else { statePtr->num = -1; } @@ -1700,14 +1883,14 @@ savemap( red = colores[0]; green = colores[statePtr->greenOffset]; blue = colores[statePtr->blueOffset]; - if (nuevo(statePtr, red, green, blue, mapa)) { + if (IsNewColor(statePtr, red, green, blue)) { statePtr->num++; if (statePtr->num >= MAXCOLORMAPSIZE) { return; } - mapa[statePtr->num][CM_RED] = red; - mapa[statePtr->num][CM_GREEN] = green; - mapa[statePtr->num][CM_BLUE] = blue; + statePtr->mapa[statePtr->num][CM_RED] = red; + statePtr->mapa[statePtr->num][CM_GREEN] = green; + statePtr->mapa[statePtr->num][CM_BLUE] = blue; } } colores += statePtr->pixelSize; @@ -1717,26 +1900,26 @@ savemap( static int ReadValue( - ClientData clientData) + GifWriterState *statePtr) { - GifWriterState *statePtr = (GifWriterState *) clientData; unsigned int col; if (statePtr->csize == 0) { return EOF; } - if (statePtr->alphaOffset && statePtr->pixelo[statePtr->alphaOffset]==0) { + if (statePtr->alphaOffset + && (statePtr->pixelOffset[statePtr->alphaOffset]==0)) { col = 0; } else { - col = color(statePtr, statePtr->pixelo[0], - statePtr->pixelo[statePtr->greenOffset], - statePtr->pixelo[statePtr->blueOffset], statePtr->mapa); + col = ColorNumber(statePtr, statePtr->pixelOffset[0], + statePtr->pixelOffset[statePtr->greenOffset], + statePtr->pixelOffset[statePtr->blueOffset]); } - statePtr->pixelo += statePtr->pixelSize; + statePtr->pixelOffset += statePtr->pixelSize; if (--statePtr->ssize <= 0) { statePtr->ssize = statePtr->rsize; statePtr->csize--; - statePtr->pixelo += statePtr->pixelPitch + statePtr->pixelOffset += statePtr->pixelPitch - (statePtr->rsize * statePtr->pixelSize); } @@ -1744,501 +1927,308 @@ ReadValue( } /* - *----------------------------------------------------------------------- - * - * miGIF Compression - mouse and ivo's GIF-compatible compression + * GIF Image compression - modified 'Compress' * - * -run length encoding compression routines- + * Based on: compress.c - File compression ala IEEE Computer, June 1984. * - * Copyright (C) 1998 Hutchison Avenue Software Corporation - * http://www.hasc.com - * info@hasc.com - * - * Permission to use, copy, modify, and distribute this software and its - * documentation for any purpose and without fee is hereby granted, provided - * that the above copyright notice appear in all copies and that both that - * copyright notice and this permission notice appear in supporting - * documentation. This software is provided "AS IS." The Hutchison Avenue - * Software Corporation disclaims all warranties, either express or implied, - * including but not limited to implied warranties of merchantability and - * fitness for a particular purpose, with respect to this code and - * accompanying documentation. - * - * The miGIF compression routines do not, strictly speaking, generate files - * conforming to the GIF spec, since the image data is not LZW-compressed - * (this is the point: in order to avoid transgression of the Unisys patent on - * the LZW algorithm.) However, miGIF generates data streams that any - * reasonably sane LZW decompresser will decompress to what we want. - * - * miGIF compression uses run length encoding. It compresses horizontal runs - * of pixels of the same color. This type of compression gives good results on - * images with many runs, for example images with lines, text and solid shapes - * on a solid-colored background. It gives little or no compression on images - * with few runs, for example digital or scanned photos. - * - * der Mouse - * mouse@rodents.montreal.qc.ca - * 7D C8 61 52 5D E7 2D 39 4E F1 31 3E E8 B3 27 4B - * - * ivo@hasc.com - * - * The Graphics Interchange Format(c) is the Copyright property of CompuServe - * Incorporated. GIF(sm) is a Service Mark property of CompuServe Incorporated. - * - *----------------------------------------------------------------------- + * By Authors: Spencer W. Thomas (decvax!harpo!utah-cs!utah-gr!thomas) + * Jim McKie (decvax!mcvax!jim) + * Steve Davies (decvax!vax135!petsd!peora!srd) + * Ken Turkowski (decvax!decwrl!turtlevax!ken) + * James A. Woods (decvax!ihnp4!ames!jaw) + * Joe Orost (decvax!vax135!petsd!joe) */ - -typedef struct { - int runlengthPixel; - int runlengthBaseCode; - int runlengthCount; - int runlengthTablePixel; - int runlengthTableMax; - int justCleared; - int outputBits; - int outputBitsInit; - int outputCount; - int outputBump; - int outputBumpInit; - int outputClear; - int outputClearInit; - int maxOcodes; - int codeClear; - int codeEOF; - unsigned int obuf; - int obits; - Tcl_Channel ofile; - unsigned char oblock[256]; - int oblen; -} miGIFState_t; -/* - * Used only when debugging GIF compression code - */ -/* #define MIGIF_DEBUGGING_ENVARS */ +static void +Compress( + int initialBits, + ClientData handle, + WriteBytesFunc *writeProc, + ifunptr readValue, + GifWriterState *statePtr) +{ + long fcode, ent, disp, hSize, i = 0; + int c, hshift; + GIFState_t state; -#ifdef MIGIF_DEBUGGING_ENVARS + memset(&state, 0, sizeof(state)); -/* - * This debugging code is _absolutely_ not thread-safe. It's also not normally - * enabled either. - */ + /* + * Set up the globals: initialBits - initial number of bits + * outChannel - pointer to output file + */ -static int verboseSet = 0; -static int verbose; -#define MIGIF_VERBOSE (verboseSet?verbose:setVerbose()) -#define DEBUGMSG(printfArgs) if (MIGIF_VERBOSE) { printf printfArgs; } + state.initialBits = initialBits; + state.destination = handle; + state.writeProc = writeProc; -static int -setVerbose(void) -{ - verbose = !!getenv("MIGIF_VERBOSE"); - verboseSet = 1; - return verbose; -} + /* + * Set up the necessary values. + */ -static const char * -binformat( - unsigned int v, - int nbits) -{ - static char bufs[8][64]; - static int bhand = 0; - unsigned int bit; - int bno; - char *bp; - - bhand--; - if (bhand < 0) { - bhand = (sizeof(bufs) / sizeof(bufs[0])) - 1; - } - bp = &bufs[bhand][0]; - for (bno=nbits-1,bit=((unsigned int)1)<<bno ; bno>=0 ; bno--,bit>>=1) { - *bp++ = (v & bit) ? '1' : '0'; - if (((bno&3) == 0) && (bno != 0)) { - *bp++ = '.'; - } + state.offset = 0; + state.hSize = HSIZE; + state.outCount = 0; + state.clearFlag = 0; + state.inCount = 1; + state.maxCode = MAXCODE(state.numBits = state.initialBits); + state.clearCode = 1 << (initialBits - 1); + state.eofCode = state.clearCode + 1; + state.freeEntry = state.clearCode + 2; + CharInit(&state); + + ent = readValue(statePtr); + + hshift = 0; + for (fcode = (long) state.hSize; fcode < 65536L; fcode *= 2L) { + hshift++; } - *bp = '\0'; - return &bufs[bhand][0]; -} -#else /* !MIGIF_DEBUGGING_ENVARS */ -#define DEBUGMSG(printfArgs) /* do nothing */ -#endif - -static void -writeBlock( - miGIFState_t *statePtr) -{ - unsigned char c; + hshift = 8 - hshift; /* Set hash code range bound */ + + hSize = state.hSize; + ClearHashTable(&state, (int) hSize); /* Clear hash table */ + + Output(&state, (long) state.clearCode); + + while (U(c = readValue(statePtr)) != U(EOF)) { + state.inCount++; -#ifdef MIGIF_DEBUGGING_ENVARS - if (MIGIF_VERBOSE) { - int i; - printf("writeBlock %d:", statePtr->oblen); - for (i=0 ; i<statePtr->oblen ; i++) { - printf(" %02x", statePtr->oblock[i]); + fcode = (long) (((long) c << GIFBITS) + ent); + i = ((long)c << hshift) ^ ent; /* XOR hashing */ + + if (state.hashTable[i] == fcode) { + ent = state.codeTable[i]; + continue; + } else if ((long) state.hashTable[i] < 0) { /* Empty slot */ + goto nomatch; + } + + disp = hSize - i; /* Secondary hash (after G. Knott) */ + if (i == 0) { + disp = 1; + } + + probe: + if ((i -= disp) < 0) { + i += hSize; + } + + if (state.hashTable[i] == fcode) { + ent = state.codeTable[i]; + continue; + } + if ((long) state.hashTable[i] > 0) { + goto probe; + } + + nomatch: + Output(&state, (long) ent); + state.outCount++; + ent = c; + if (U(state.freeEntry) < U((long)1 << GIFBITS)) { + state.codeTable[i] = state.freeEntry++; /* code -> hashtable */ + state.hashTable[i] = fcode; + } else { + ClearForBlock(&state); } - printf("\n"); - } -#endif - c = statePtr->oblen; - Tcl_Write(statePtr->ofile, (char *) &c, 1); - Tcl_Write(statePtr->ofile, (char *) &statePtr->oblock[0], statePtr->oblen); - statePtr->oblen = 0; -} - -static void -blockOut( - miGIFState_t *statePtr, - unsigned c) -{ - DEBUGMSG(("blockOut %s\n", binformat(c, 8))); - statePtr->oblock[statePtr->oblen++] = (unsigned char) c; - if (statePtr->oblen >= 255) { - writeBlock(statePtr); - } -} - -static void -blockFlush( - miGIFState_t *statePtr) -{ - DEBUGMSG(("blockFlush\n")); - if (statePtr->oblen > 0) { - writeBlock(statePtr); - } -} - -static void -output( - miGIFState_t *statePtr, - int val) -{ - DEBUGMSG(("output %s [%s %d %d]\n", binformat(val, statePtr->outputBits), - binformat(statePtr->obuf, statePtr->obits), statePtr->obits, - statePtr->outputBits)); - statePtr->obuf |= val << statePtr->obits; - statePtr->obits += statePtr->outputBits; - while (statePtr->obits >= 8) { - blockOut(statePtr, statePtr->obuf & 0xff); - statePtr->obuf >>= 8; - statePtr->obits -= 8; - } - DEBUGMSG(("output leaving [%s %d]\n", - binformat(statePtr->obuf, statePtr->obits), statePtr->obits)); -} - -static void -outputFlush( - miGIFState_t *statePtr) -{ - DEBUGMSG(("outputFlush\n")); - if (statePtr->obits > 0) { - blockOut(statePtr, statePtr->obuf); } - blockFlush(statePtr); -} - -static void -didClear( - miGIFState_t *statePtr) -{ - DEBUGMSG(("didClear\n")); - statePtr->outputBits = statePtr->outputBitsInit; - statePtr->outputBump = statePtr->outputBumpInit; - statePtr->outputClear = statePtr->outputClearInit; - statePtr->outputCount = 0; - statePtr->runlengthTableMax = 0; - statePtr->justCleared = 1; + + /* + * Put out the final code. + */ + + Output(&state, (long) ent); + state.outCount++; + Output(&state, (long) state.eofCode); } +/***************************************************************** + * Output -- + * Output the given code. + * + * Inputs: + * code: A numBits-bit integer. If == -1, then EOF. This assumes that + * numBits =< (long) wordsize - 1. + * Outputs: + * Outputs code to the file. + * Assumptions: + * Chars are 8 bits long. + * Algorithm: + * Maintain a GIFBITS character long buffer (so that 8 codes will fit in + * it exactly). Use the VAX insv instruction to insert each code in turn. + * When the buffer fills up empty it and start over. + */ + static void -outputPlain( - miGIFState_t *statePtr, - int c) +Output( + GIFState_t *statePtr, + long code) { - DEBUGMSG(("outputPlain %s\n", binformat(c, statePtr->outputBits))); - statePtr->justCleared = 0; - output(statePtr, c); - statePtr->outputCount++; - if (statePtr->outputCount >= statePtr->outputBump) { - statePtr->outputBits++; - statePtr->outputBump += 1 << (statePtr->outputBits - 1); - } - if (statePtr->outputCount >= statePtr->outputClear) { - output(statePtr, statePtr->codeClear); - didClear(statePtr); + static const unsigned long masks[] = { + 0x0000, + 0x0001, 0x0003, 0x0007, 0x000F, + 0x001F, 0x003F, 0x007F, 0x00FF, + 0x01FF, 0x03FF, 0x07FF, 0x0FFF, + 0x1FFF, 0x3FFF, 0x7FFF, 0xFFFF + }; + + statePtr->currentAccumulated &= masks[statePtr->currentBits]; + if (statePtr->currentBits > 0) { + statePtr->currentAccumulated |= ((long) code << statePtr->currentBits); + } else { + statePtr->currentAccumulated = code; } -} - -static unsigned int -isqrt( - unsigned int x) -{ - unsigned int r; - unsigned int v; + statePtr->currentBits += statePtr->numBits; - if (x < 2) { - return x; + while (statePtr->currentBits >= 8) { + CharOut(statePtr, (unsigned) (statePtr->currentAccumulated & 0xff)); + statePtr->currentAccumulated >>= 8; + statePtr->currentBits -= 8; } - for (v=x,r=1 ; v ; v>>=2,r<<=1); - while (1) { - v = ((x / r) + r) / 2; - if (v==r || v==r+1) { - return r; + + /* + * If the next entry is going to be too big for the code size, then + * increase it, if possible. + */ + + if ((statePtr->freeEntry > statePtr->maxCode) || statePtr->clearFlag) { + if (statePtr->clearFlag) { + statePtr->maxCode = MAXCODE( + statePtr->numBits = statePtr->initialBits); + statePtr->clearFlag = 0; + } else { + statePtr->numBits++; + if (statePtr->numBits == GIFBITS) { + statePtr->maxCode = (long)1 << GIFBITS; + } else { + statePtr->maxCode = MAXCODE(statePtr->numBits); + } } - r = v; } -} - -static int -computeTriangleCount( - unsigned int count, - unsigned int nrepcodes) -{ - unsigned int perrep; - unsigned int cost; - cost = 0; - perrep = (nrepcodes * (nrepcodes+1)) / 2; - while (count >= perrep) { - cost += nrepcodes; - count -= perrep; - } - if (count > 0) { - unsigned int n = isqrt(count); + if (code == statePtr->eofCode) { + /* + * At EOF, write the rest of the buffer. + */ - while (n*(n+1) >= 2*count) { - n--; - } - while (n*(n+1) < 2*count) { - n++; + while (statePtr->currentBits > 0) { + CharOut(statePtr, + (unsigned) (statePtr->currentAccumulated & 0xff)); + statePtr->currentAccumulated >>= 8; + statePtr->currentBits -= 8; } - cost += n; - } - return (int) cost + 1; -} - -static void -maxOutputClear( - miGIFState_t *statePtr) -{ - statePtr->outputClear = statePtr->maxOcodes; -} - -static void -resetOutputClear( - miGIFState_t *statePtr) -{ - statePtr->outputClear = statePtr->outputClearInit; - if (statePtr->outputCount >= statePtr->outputClear) { - output(statePtr, statePtr->codeClear); - didClear(statePtr); + FlushChar(statePtr); } } +/* + * Clear out the hash table + */ + static void -runlengthFlushFromClear( - miGIFState_t *statePtr, - int count) +ClearForBlock( /* Table clear for block compress. */ + GIFState_t *statePtr) { - int n; - - DEBUGMSG(("runlengthFlushFromClear %d\n", count)); - maxOutputClear(statePtr); - statePtr->runlengthTablePixel = statePtr->runlengthPixel; - n = 1; - while (count > 0) { - if (n == 1) { - statePtr->runlengthTableMax = 1; - outputPlain(statePtr, statePtr->runlengthPixel); - count--; - } else if (count >= n) { - statePtr->runlengthTableMax = n; - outputPlain(statePtr, statePtr->runlengthBaseCode+n-2); - count -= n; - } else if (count == 1) { - statePtr->runlengthTableMax++; - outputPlain(statePtr, statePtr->runlengthPixel); - count = 0; - } else { - statePtr->runlengthTableMax++; - outputPlain(statePtr, statePtr->runlengthBaseCode+count-2); - count = 0; - } - if (statePtr->outputCount == 0) { - n = 1; - } else { - n++; - } - } - resetOutputClear(statePtr); - DEBUGMSG(("runlengthFlushFromClear leaving tableMax=%d\n", - statePtr->runlengthTableMax)); + ClearHashTable(statePtr, (int) statePtr->hSize); + statePtr->freeEntry = statePtr->clearCode + 2; + statePtr->clearFlag = 1; + + Output(statePtr, (long) statePtr->clearCode); } static void -runlengthFlushClearOrRep( - miGIFState_t *statePtr, - int count) +ClearHashTable( /* Reset code table. */ + GIFState_t *statePtr, + int hSize) { - int withclr; - - DEBUGMSG(("runlengthFlushClearOrRep %d\n", count)); - withclr = computeTriangleCount((unsigned) count, - (unsigned) statePtr->maxOcodes); - if (withclr < count) { - output(statePtr, statePtr->codeClear); - didClear(statePtr); - runlengthFlushFromClear(statePtr, count); - } else { - for (; count>0 ; count--) { - outputPlain(statePtr, statePtr->runlengthPixel); - } + register int *hashTablePtr = statePtr->hashTable + hSize; + register long i; + register long m1 = -1; + + i = hSize - 16; + do { /* might use Sys V memset(3) here */ + *(hashTablePtr-16) = m1; + *(hashTablePtr-15) = m1; + *(hashTablePtr-14) = m1; + *(hashTablePtr-13) = m1; + *(hashTablePtr-12) = m1; + *(hashTablePtr-11) = m1; + *(hashTablePtr-10) = m1; + *(hashTablePtr-9) = m1; + *(hashTablePtr-8) = m1; + *(hashTablePtr-7) = m1; + *(hashTablePtr-6) = m1; + *(hashTablePtr-5) = m1; + *(hashTablePtr-4) = m1; + *(hashTablePtr-3) = m1; + *(hashTablePtr-2) = m1; + *(hashTablePtr-1) = m1; + hashTablePtr -= 16; + } while ((i -= 16) >= 0); + + for (i += 16; i > 0; i--) { + *--hashTablePtr = m1; } } +/* + ***************************************************************************** + * + * GIF Specific routines + * + ***************************************************************************** + */ + +/* + * Set up the 'byte output' routine + */ + static void -runlengthFlushWithTable( - miGIFState_t *statePtr, - int count) +CharInit( + GIFState_t *statePtr) { - int repmax; - int repleft; - int leftover; - - DEBUGMSG(("runlengthFlushWithTable %d\n", count)); - repmax = count / statePtr->runlengthTableMax; - leftover = count % statePtr->runlengthTableMax; - repleft = (leftover ? 1 : 0); - if (statePtr->outputCount+repmax+repleft > statePtr->maxOcodes) { - repmax = statePtr->maxOcodes - statePtr->outputCount; - leftover = count - (repmax * statePtr->runlengthTableMax); - repleft = computeTriangleCount((unsigned) leftover, - (unsigned) statePtr->maxOcodes); - } - DEBUGMSG(("runlengthFlushWithTable repmax=%d leftover=%d repleft=%d\n", - repmax, leftover, repleft)); - if (computeTriangleCount((unsigned) count, (unsigned) statePtr->maxOcodes) - < repmax+repleft) { - output(statePtr, statePtr->codeClear); - didClear(statePtr); - runlengthFlushFromClear(statePtr, count); - return; - } - maxOutputClear(statePtr); - for (; repmax>0 ; repmax--) { - outputPlain(statePtr, - statePtr->runlengthBaseCode + statePtr->runlengthTableMax - 2); - } - if (leftover) { - if (statePtr->justCleared) { - runlengthFlushFromClear(statePtr, leftover); - } else if (leftover == 1) { - outputPlain(statePtr, statePtr->runlengthPixel); - } else { - outputPlain(statePtr, statePtr->runlengthBaseCode + leftover - 2); - } - } - resetOutputClear(statePtr); + statePtr->accumulatedByteCount = 0; + statePtr->currentAccumulated = 0; + statePtr->currentBits = 0; } +/* + * Add a character to the end of the current packet, and if it is 254 + * characters, flush the packet to disk. + */ + static void -runlengthFlush( - miGIFState_t *statePtr) +CharOut( + GIFState_t *statePtr, + int c) { - DEBUGMSG(("runlengthFlush [ %d %d\n", statePtr->runlengthCount, - statePtr->runlengthPixel)); - if (statePtr->runlengthCount == 1) { - outputPlain(statePtr, statePtr->runlengthPixel); - statePtr->runlengthCount = 0; - DEBUGMSG(("runlengthFlush ]\n")); - return; - } - if (statePtr->justCleared) { - runlengthFlushFromClear(statePtr, statePtr->runlengthCount); - } else if ((statePtr->runlengthTableMax < 2) - || (statePtr->runlengthTablePixel != statePtr->runlengthPixel)) { - runlengthFlushClearOrRep(statePtr, statePtr->runlengthCount); - } else { - runlengthFlushWithTable(statePtr, statePtr->runlengthCount); + statePtr->packetAccumulator[statePtr->accumulatedByteCount++] = c; + if (statePtr->accumulatedByteCount >= 254) { + FlushChar(statePtr); } - DEBUGMSG(("runlengthFlush ]\n")); - statePtr->runlengthCount = 0; } +/* + * Flush the packet to disk, and reset the accumulator + */ + static void -compress( - int initBits, - Tcl_Channel handle, - ifunptr readValue, - ClientData clientData) +FlushChar( + GIFState_t *statePtr) { - int c; - miGIFState_t state, *statePtr = &state; - - memset(statePtr, 0, sizeof(state)); - - statePtr->ofile = handle; - statePtr->obuf = 0; - statePtr->obits = 0; - statePtr->oblen = 0; - statePtr->codeClear = 1 << (initBits - 1); - statePtr->codeEOF = statePtr->codeClear + 1; - statePtr->runlengthBaseCode = statePtr->codeEOF + 1; - statePtr->outputBumpInit = (1 << (initBits - 1)) - 1; - - /* - * For images with a lot of runs, making outputClearInit larger will give - * better compression. - */ - - statePtr->outputClearInit = - (initBits <= 3) ? 9 : (statePtr->outputBumpInit-1); -#ifdef MIGIF_DEBUGGING_ENVARS - { - const char *ocienv = getenv("MIGIF_OUT_CLEAR_INIT"); + unsigned char c; - if (ocienv) { - statePtr->outputClearInit = atoi(ocienv); - DEBUGMSG(("[overriding outputClearInit to %d]\n", - statePtr->outputClearInit)); - } - } -#endif - statePtr->outputBitsInit = initBits; - statePtr->maxOcodes = - (1 << GIFBITS) - ((1 << (statePtr->outputBitsInit - 1)) + 3); - didClear(statePtr); - output(statePtr, statePtr->codeClear); - statePtr->runlengthCount = 0; - while (1) { - c = readValue(clientData); - if (statePtr->runlengthCount>0 && statePtr->runlengthPixel!=c) { - runlengthFlush(statePtr); - } - if (c == EOF) { - break; - } - if (statePtr->runlengthPixel == c) { - statePtr->runlengthCount++; - } else { - statePtr->runlengthPixel = c; - statePtr->runlengthCount = 1; - } + if (statePtr->accumulatedByteCount > 0) { + c = statePtr->accumulatedByteCount; + statePtr->writeProc(statePtr->destination, (const char *) &c, 1); + statePtr->writeProc(statePtr->destination, + (const char *) statePtr->packetAccumulator, + statePtr->accumulatedByteCount); + statePtr->accumulatedByteCount = 0; } - output(statePtr, statePtr->codeEOF); - outputFlush(statePtr); } -/* - *----------------------------------------------------------------------- - * - * End of miGIF section - See copyright notice at start of section. - * - *----------------------------------------------------------------------- - */ +/* The End */ /* * Local Variables: diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c new file mode 100644 index 0000000..2ee515b --- /dev/null +++ b/generic/tkImgPNG.c @@ -0,0 +1,3563 @@ +/* + * tkImgPNG.c -- + * + * A Tk photo image file handler for PNG files. + * + * Copyright (c) 2006-2008 Muonics, Inc. + * Copyright (c) 2008 Donal K. Fellows + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "assert.h" +#include "tkInt.h" + +#define PNG_INT32(a,b,c,d) \ + (((long)(a) << 24) | ((long)(b) << 16) | ((long)(c) << 8) | (long)(d)) +#define PNG_BLOCK_SZ 1024 /* Process up to 1k at a time. */ +#define PNG_MIN(a, b) (((a) < (b)) ? (a) : (b)) + +/* + * Every PNG image starts with the following 8-byte signature. + */ + +#define PNG_SIG_SZ 8 +static const unsigned char pngSignature[] = { + 137, 80, 78, 71, 13, 10, 26, 10 +}; + +static const int startLine[8] = { + 0, 0, 0, 4, 0, 2, 0, 1 +}; + +/* + * Chunk type flags. + */ + +#define PNG_CF_ANCILLARY 0x10000000L /* Non-critical chunk (can ignore). */ +#define PNG_CF_PRIVATE 0x00100000L /* Application-specific chunk. */ +#define PNG_CF_RESERVED 0x00001000L /* Not used. */ +#define PNG_CF_COPYSAFE 0x00000010L /* Opaque data safe for copying. */ + +/* + * Chunk types, not all of which have support implemented. Note that there are + * others in the official extension set which we will never support (as they + * are officially deprecated). + */ + +#define CHUNK_IDAT PNG_INT32('I','D','A','T') /* Pixel data. */ +#define CHUNK_IEND PNG_INT32('I','E','N','D') /* End of Image. */ +#define CHUNK_IHDR PNG_INT32('I','H','D','R') /* Header. */ +#define CHUNK_PLTE PNG_INT32('P','L','T','E') /* Palette. */ + +#define CHUNK_bKGD PNG_INT32('b','K','G','D') /* Background Color */ +#define CHUNK_cHRM PNG_INT32('c','H','R','M') /* Chroma values. */ +#define CHUNK_gAMA PNG_INT32('g','A','M','A') /* Gamma. */ +#define CHUNK_hIST PNG_INT32('h','I','S','T') /* Histogram. */ +#define CHUNK_iCCP PNG_INT32('i','C','C','P') /* Color profile. */ +#define CHUNK_iTXt PNG_INT32('i','T','X','t') /* Internationalized + * text (comments, + * etc.) */ +#define CHUNK_oFFs PNG_INT32('o','F','F','s') /* Image offset. */ +#define CHUNK_pCAL PNG_INT32('p','C','A','L') /* Pixel calibration + * data. */ +#define CHUNK_pHYs PNG_INT32('p','H','Y','s') /* Physical pixel + * dimensions. */ +#define CHUNK_sBIT PNG_INT32('s','B','I','T') /* Significant bits */ +#define CHUNK_sCAL PNG_INT32('s','C','A','L') /* Physical scale. */ +#define CHUNK_sPLT PNG_INT32('s','P','L','T') /* Suggested + * palette. */ +#define CHUNK_sRGB PNG_INT32('s','R','G','B') /* Standard RGB space + * declaration. */ +#define CHUNK_tEXt PNG_INT32('t','E','X','t') /* Plain Latin-1 + * text. */ +#define CHUNK_tIME PNG_INT32('t','I','M','E') /* Time stamp. */ +#define CHUNK_tRNS PNG_INT32('t','R','N','S') /* Transparency. */ +#define CHUNK_zTXt PNG_INT32('z','T','X','t') /* Compressed Latin-1 + * text. */ + +/* + * Color flags. + */ + +#define PNG_COLOR_INDEXED 1 +#define PNG_COLOR_USED 2 +#define PNG_COLOR_ALPHA 4 + +/* + * Actual color types. + */ + +#define PNG_COLOR_GRAY 0 +#define PNG_COLOR_RGB (PNG_COLOR_USED) +#define PNG_COLOR_PLTE (PNG_COLOR_USED | PNG_COLOR_INDEXED) +#define PNG_COLOR_GRAYALPHA (PNG_COLOR_GRAY | PNG_COLOR_ALPHA) +#define PNG_COLOR_RGBA (PNG_COLOR_USED | PNG_COLOR_ALPHA) + +/* + * Compression Methods. + */ + +#define PNG_COMPRESS_DEFLATE 0 + +/* + * Filter Methods. + */ + +#define PNG_FILTMETH_STANDARD 0 + +/* + * Interlacing Methods. + */ + +#define PNG_INTERLACE_NONE 0 +#define PNG_INTERLACE_ADAM7 1 + +/* + * State information, used to store everything about the PNG image being + * currently parsed or created. + */ + +typedef struct { + /* + * PNG data source/destination channel/object/byte array. + */ + + Tcl_Channel channel; /* Channel for from-file reads. */ + Tcl_Obj *objDataPtr; + unsigned char *strDataBuf; /* Raw source data for from-string reads. */ + int strDataLen; /* Length of source data. */ + unsigned char *base64Data; /* base64 encoded string data. */ + unsigned char base64Bits; /* Remaining bits from last base64 read. */ + unsigned char base64State; /* Current state of base64 decoder. */ + double alpha; /* Alpha from -format option. */ + + /* + * Image header information. + */ + + unsigned char bitDepth; /* Number of bits per pixel. */ + unsigned char colorType; /* Grayscale, TrueColor, etc. */ + unsigned char compression; /* Compression Mode (always zlib). */ + unsigned char filter; /* Filter mode (0 - 3). */ + unsigned char interlace; /* Type of interlacing (if any). */ + unsigned char numChannels; /* Number of channels per pixel. */ + unsigned char bytesPerPixel;/* Bytes per pixel in scan line. */ + int bitScale; /* Scale factor for RGB/Gray depths < 8. */ + int currentLine; /* Current line being unfiltered. */ + unsigned char phase; /* Interlacing phase (0..6). */ + Tk_PhotoImageBlock block; + int blockLen; /* Number of bytes in Tk image pixels. */ + + /* + * For containing data read from PLTE (palette) and tRNS (transparency) + * chunks. + */ + + int paletteLen; /* Number of PLTE entries (1..256). */ + int useTRNS; /* Flag to indicate whether there was a + * palette given. */ + struct { + unsigned char red; + unsigned char green; + unsigned char blue; + unsigned char alpha; + } palette[256]; /* Palette RGB/Transparency table. */ + unsigned char transVal[6]; /* Fully-transparent RGB/Gray Value. */ + + /* + * For compressing and decompressing IDAT chunks. + */ + + Tcl_ZlibStream stream; /* Inflating or deflating stream; this one is + * not bound to a Tcl command. */ + Tcl_Obj *lastLineObj; /* Last line of pixels, for unfiltering. */ + Tcl_Obj *thisLineObj; /* Current line of pixels to process. */ + int lineSize; /* Number of bytes in a PNG line. */ + int phaseSize; /* Number of bytes/line in current phase. */ +} PNGImage; + +/* + * Maximum size of various chunks. + */ + +#define PNG_PLTE_MAXSZ 768 /* 3 bytes/RGB entry, 256 entries max */ +#define PNG_TRNS_MAXSZ 256 /* 1-byte alpha, 256 entries max */ + +/* + * Forward declarations of non-global functions defined in this file: + */ + +static void ApplyAlpha(PNGImage *pngPtr); +static int CheckColor(Tcl_Interp *interp, PNGImage *pngPtr); +static inline int CheckCRC(Tcl_Interp *interp, PNGImage *pngPtr, + unsigned long calculated); +static void CleanupPNGImage(PNGImage *pngPtr); +static int DecodeLine(Tcl_Interp *interp, PNGImage *pngPtr); +static int DecodePNG(Tcl_Interp *interp, PNGImage *pngPtr, + Tcl_Obj *fmtObj, Tk_PhotoHandle imageHandle, + int destX, int destY); +static int EncodePNG(Tcl_Interp *interp, + Tk_PhotoImageBlock *blockPtr, PNGImage *pngPtr); +static int FileMatchPNG(Tcl_Channel chan, const char *fileName, + Tcl_Obj *fmtObj, int *widthPtr, int *heightPtr, + Tcl_Interp *interp); +static int FileReadPNG(Tcl_Interp *interp, Tcl_Channel chan, + const char *fileName, Tcl_Obj *fmtObj, + Tk_PhotoHandle imageHandle, int destX, int destY, + int width, int height, int srcX, int srcY); +static int FileWritePNG(Tcl_Interp *interp, const char *filename, + Tcl_Obj *fmtObj, Tk_PhotoImageBlock *blockPtr); +static int InitPNGImage(Tcl_Interp *interp, PNGImage *pngPtr, + Tcl_Channel chan, Tcl_Obj *objPtr, int dir); +static inline unsigned char Paeth(int a, int b, int c); +static int ParseFormat(Tcl_Interp *interp, Tcl_Obj *fmtObj, + PNGImage *pngPtr); +static int ReadBase64(Tcl_Interp *interp, PNGImage *pngPtr, + unsigned char *destPtr, int destSz, + unsigned long *crcPtr); +static int ReadByteArray(Tcl_Interp *interp, PNGImage *pngPtr, + unsigned char *destPtr, int destSz, + unsigned long *crcPtr); +static int ReadData(Tcl_Interp *interp, PNGImage *pngPtr, + unsigned char *destPtr, int destSz, + unsigned long *crcPtr); +static int ReadChunkHeader(Tcl_Interp *interp, PNGImage *pngPtr, + int *sizePtr, unsigned long *typePtr, + unsigned long *crcPtr); +static int ReadIDAT(Tcl_Interp *interp, PNGImage *pngPtr, + int chunkSz, unsigned long crc); +static int ReadIHDR(Tcl_Interp *interp, PNGImage *pngPtr); +static inline int ReadInt32(Tcl_Interp *interp, PNGImage *pngPtr, + unsigned long *resultPtr, unsigned long *crcPtr); +static int ReadPLTE(Tcl_Interp *interp, PNGImage *pngPtr, + int chunkSz, unsigned long crc); +static int ReadTRNS(Tcl_Interp *interp, PNGImage *pngPtr, + int chunkSz, unsigned long crc); +static int SkipChunk(Tcl_Interp *interp, PNGImage *pngPtr, + int chunkSz, unsigned long crc); +static int StringMatchPNG(Tcl_Obj *dataObj, Tcl_Obj *fmtObj, + int *widthPtr, int *heightPtr, + Tcl_Interp *interp); +static int StringReadPNG(Tcl_Interp *interp, Tcl_Obj *dataObj, + Tcl_Obj *fmtObj, Tk_PhotoHandle imageHandle, + int destX, int destY, int width, int height, + int srcX, int srcY); +static int StringWritePNG(Tcl_Interp *interp, Tcl_Obj *fmtObj, + Tk_PhotoImageBlock *blockPtr); +static int UnfilterLine(Tcl_Interp *interp, PNGImage *pngPtr); +static inline int WriteByte(Tcl_Interp *interp, PNGImage *pngPtr, + unsigned char c, unsigned long *crcPtr); +static inline int WriteChunk(Tcl_Interp *interp, PNGImage *pngPtr, + unsigned long chunkType, + const unsigned char *dataPtr, int dataSize); +static int WriteData(Tcl_Interp *interp, PNGImage *pngPtr, + const unsigned char *srcPtr, int srcSz, + unsigned long *crcPtr); +static int WriteExtraChunks(Tcl_Interp *interp, + PNGImage *pngPtr); +static int WriteIHDR(Tcl_Interp *interp, PNGImage *pngPtr, + Tk_PhotoImageBlock *blockPtr); +static int WriteIDAT(Tcl_Interp *interp, PNGImage *pngPtr, + Tk_PhotoImageBlock *blockPtr); +static inline int WriteInt32(Tcl_Interp *interp, PNGImage *pngPtr, + unsigned long l, unsigned long *crcPtr); + +/* + * The format record for the PNG file format: + */ + +Tk_PhotoImageFormat tkImgFmtPNG = { + "png", /* name */ + FileMatchPNG, /* fileMatchProc */ + StringMatchPNG, /* stringMatchProc */ + FileReadPNG, /* fileReadProc */ + StringReadPNG, /* stringReadProc */ + FileWritePNG, /* fileWriteProc */ + StringWritePNG, /* stringWriteProc */ + NULL +}; + +/* + *---------------------------------------------------------------------- + * + * InitPNGImage -- + * + * This function is invoked by each of the Tk image handler procs + * (MatchStringProc, etc.) to initialize state information used during + * the course of encoding or decoding a PNG image. + * + * Results: + * TCL_OK, or TCL_ERROR if initialization failed. + * + * Side effects: + * The reference count of the -data Tcl_Obj*, if any, is incremented. + * + *---------------------------------------------------------------------- + */ + +static int +InitPNGImage( + Tcl_Interp *interp, + PNGImage *pngPtr, + Tcl_Channel chan, + Tcl_Obj *objPtr, + int dir) +{ + memset(pngPtr, 0, sizeof(PNGImage)); + + pngPtr->channel = chan; + pngPtr->alpha = 1.0; + + /* + * If decoding from a -data string object, increment its reference count + * for the duration of the decode and get its length and byte array for + * reading with ReadData(). + */ + + if (objPtr) { + Tcl_IncrRefCount(objPtr); + pngPtr->objDataPtr = objPtr; + pngPtr->strDataBuf = + Tcl_GetByteArrayFromObj(objPtr, &pngPtr->strDataLen); + } + + /* + * Initialize the palette transparency table to fully opaque. + */ + + memset(pngPtr->palette, 255, sizeof(pngPtr->palette)); + + /* + * Initialize Zlib inflate/deflate stream. + */ + + if (Tcl_ZlibStreamInit(NULL, dir, TCL_ZLIB_FORMAT_ZLIB, + TCL_ZLIB_COMPRESS_DEFAULT, NULL, &pngPtr->stream) != TCL_OK) { + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "zlib initialization failed", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "ZLIB_INIT", NULL); + } + if (objPtr) { + Tcl_DecrRefCount(objPtr); + } + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CleanupPNGImage -- + * + * This function is invoked by each of the Tk image handler procs + * (MatchStringProc, etc.) prior to returning to Tcl in order to clean up + * any allocated memory and call other cleanup handlers such as zlib's + * inflateEnd/deflateEnd. + * + * Results: + * None. + * + * Side effects: + * The reference count of the -data Tcl_Obj*, if any, is decremented. + * Buffers are freed, streams are closed. The PNGImage should not be used + * for any purpose without being reinitialized post-cleanup. + * + *---------------------------------------------------------------------- + */ + +static void +CleanupPNGImage( + PNGImage *pngPtr) +{ + /* + * Don't need the object containing the -data value anymore. + */ + + if (pngPtr->objDataPtr) { + Tcl_DecrRefCount(pngPtr->objDataPtr); + } + + /* + * Discard pixel buffer. + */ + + if (pngPtr->stream) { + Tcl_ZlibStreamClose(pngPtr->stream); + } + + if (pngPtr->block.pixelPtr) { + ckfree(pngPtr->block.pixelPtr); + } + if (pngPtr->thisLineObj) { + Tcl_DecrRefCount(pngPtr->thisLineObj); + } + if (pngPtr->lastLineObj) { + Tcl_DecrRefCount(pngPtr->lastLineObj); + } + + memset(pngPtr, 0, sizeof(PNGImage)); +} + +/* + *---------------------------------------------------------------------- + * + * ReadBase64 -- + * + * This function is invoked to read the specified number of bytes from + * base-64 encoded image data. + * + * Note: It would be better if the Tk_PhotoImage stuff handled this by + * creating a channel from the -data value, which would take care of + * base64 decoding and made the data readable as if it were coming from a + * file. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error occurs. + * + * Side effects: + * The file position will change. The running CRC is updated if a pointer + * to it is provided. + * + *---------------------------------------------------------------------- + */ + +static int +ReadBase64( + Tcl_Interp *interp, + PNGImage *pngPtr, + unsigned char *destPtr, + int destSz, + unsigned long *crcPtr) +{ + static const unsigned char from64[] = { + 0x82, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x80, 0x80, + 0x83, 0x80, 0x80, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x80, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x3e, + 0x83, 0x83, 0x83, 0x3f, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, + 0x3b, 0x3c, 0x3d, 0x83, 0x83, 0x83, 0x81, 0x83, 0x83, 0x83, 0x00, + 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, + 0x0c, 0x0d, 0x0e, 0x0f, 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, + 0x17, 0x18, 0x19, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x1a, 0x1b, + 0x1c, 0x1d, 0x1e, 0x1f, 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, + 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, + 0x32, 0x33, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, 0x83, + 0x83, 0x83 + }; + + /* + * Definitions for the base-64 decoder. + */ + +#define PNG64_SPECIAL 0x80 /* Flag bit */ +#define PNG64_SPACE 0x80 /* Whitespace */ +#define PNG64_PAD 0x81 /* Padding */ +#define PNG64_DONE 0x82 /* End of data */ +#define PNG64_BAD 0x83 /* Ooooh, naughty! */ + + while (destSz && pngPtr->strDataLen) { + unsigned char c = 0; + unsigned char c64 = from64[*pngPtr->strDataBuf++]; + + pngPtr->strDataLen--; + + if (PNG64_SPACE == c64) { + continue; + } + + if (c64 & PNG64_SPECIAL) { + c = (unsigned char) pngPtr->base64Bits; + } else { + switch (pngPtr->base64State++) { + case 0: + pngPtr->base64Bits = c64 << 2; + continue; + case 1: + c = (unsigned char) (pngPtr->base64Bits | (c64 >> 4)); + pngPtr->base64Bits = (c64 & 0xF) << 4; + break; + case 2: + c = (unsigned char) (pngPtr->base64Bits | (c64 >> 2)); + pngPtr->base64Bits = (c64 & 0x3) << 6; + break; + case 3: + c = (unsigned char) (pngPtr->base64Bits | c64); + pngPtr->base64State = 0; + pngPtr->base64Bits = 0; + break; + } + } + + if (crcPtr) { + *crcPtr = Tcl_ZlibCRC32(*crcPtr, &c, 1); + } + + if (destPtr) { + *destPtr++ = c; + } + + destSz--; + + if (c64 & PNG64_SPECIAL) { + break; + } + } + + if (destSz) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of image data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ReadByteArray -- + * + * This function is invoked to read the specified number of bytes from a + * non-base64-encoded byte array provided via the -data option. + * + * Note: It would be better if the Tk_PhotoImage stuff handled this by + * creating a channel from the -data value and made the data readable as + * if it were coming from a file. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error occurs. + * + * Side effects: + * The file position will change. The running CRC is updated if a pointer + * to it is provided. + * + *---------------------------------------------------------------------- + */ + +static int +ReadByteArray( + Tcl_Interp *interp, + PNGImage *pngPtr, + unsigned char *destPtr, + int destSz, + unsigned long *crcPtr) +{ + /* + * Check to make sure the number of requested bytes are available. + */ + + if (pngPtr->strDataLen < destSz) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of image data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EARLY_END", NULL); + return TCL_ERROR; + } + + while (destSz) { + int blockSz = PNG_MIN(destSz, PNG_BLOCK_SZ); + + memcpy(destPtr, pngPtr->strDataBuf, blockSz); + + pngPtr->strDataBuf += blockSz; + pngPtr->strDataLen -= blockSz; + + if (crcPtr) { + *crcPtr = Tcl_ZlibCRC32(*crcPtr, destPtr, blockSz); + } + + destPtr += blockSz; + destSz -= blockSz; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ReadData -- + * + * This function is invoked to read the specified number of bytes from + * the image file or data. It is a wrapper around the choice of byte + * array Tcl_Obj or Tcl_Channel which depends on whether the image data + * is coming from a file or -data. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error occurs. + * + * Side effects: + * The file position will change. The running CRC is updated if a pointer + * to it is provided. + * + *---------------------------------------------------------------------- + */ + +static int +ReadData( + Tcl_Interp *interp, + PNGImage *pngPtr, + unsigned char *destPtr, + int destSz, + unsigned long *crcPtr) +{ + if (pngPtr->base64Data) { + return ReadBase64(interp, pngPtr, destPtr, destSz, crcPtr); + } else if (pngPtr->strDataBuf) { + return ReadByteArray(interp, pngPtr, destPtr, destSz, crcPtr); + } + + while (destSz) { + int blockSz = PNG_MIN(destSz, PNG_BLOCK_SZ); + + blockSz = Tcl_Read(pngPtr->channel, (char *)destPtr, blockSz); + if (blockSz < 0) { + /* TODO: failure info... */ + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel read failed: %s", Tcl_PosixError(interp))); + return TCL_ERROR; + } + + /* + * Update CRC, pointer, and remaining count if anything was read. + */ + + if (blockSz) { + if (crcPtr) { + *crcPtr = Tcl_ZlibCRC32(*crcPtr, destPtr, blockSz); + } + + destPtr += blockSz; + destSz -= blockSz; + } + + /* + * Check for EOF before all desired data was read. + */ + + if (destSz && Tcl_Eof(pngPtr->channel)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unexpected end of file", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EOF", NULL); + return TCL_ERROR; + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ReadInt32 -- + * + * This function is invoked to read a 32-bit integer in network byte + * order from the image data and return the value in host byte order. + * This is used, for example, to read the 32-bit CRC value for a chunk + * stored in the image file for comparison with the calculated CRC value. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error occurs. + * + * Side effects: + * The file position will change. The running CRC is updated if a pointer + * to it is provided. + * + *---------------------------------------------------------------------- + */ + +static inline int +ReadInt32( + Tcl_Interp *interp, + PNGImage *pngPtr, + unsigned long *resultPtr, + unsigned long *crcPtr) +{ + unsigned char p[4]; + + if (ReadData(interp, pngPtr, p, 4, crcPtr) == TCL_ERROR) { + return TCL_ERROR; + } + + *resultPtr = PNG_INT32(p[0], p[1], p[2], p[3]); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CheckCRC -- + * + * This function is reads the final 4-byte integer CRC from a chunk and + * compares it to the running CRC calculated over the chunk type and data + * fields. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error or CRC mismatch occurs. + * + * Side effects: + * The file position will change. + * + *---------------------------------------------------------------------- + */ + +static inline int +CheckCRC( + Tcl_Interp *interp, + PNGImage *pngPtr, + unsigned long calculated) +{ + unsigned long chunked; + + /* + * Read the CRC field at the end of the chunk. + */ + + if (ReadInt32(interp, pngPtr, &chunked, NULL) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Compare the read CRC to what we calculate to make sure they match. + */ + + if (calculated != chunked) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("CRC check failed", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "CRC", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * SkipChunk -- + * + * This function is used to skip a PNG chunk that is not used by this + * implementation. Given the input stream has had the chunk length and + * chunk type fields already read, this function will read the number of + * bytes indicated by the chunk length, plus four for the CRC, and will + * verify that CRC is correct for the skipped data. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error or CRC mismatch occurs. + * + * Side effects: + * The file position will change. + * + *---------------------------------------------------------------------- + */ + +static int +SkipChunk( + Tcl_Interp *interp, + PNGImage *pngPtr, + int chunkSz, + unsigned long crc) +{ + unsigned char buffer[PNG_BLOCK_SZ]; + + /* + * Skip data in blocks until none is left. Read up to PNG_BLOCK_SZ bytes + * at a time, rather than trusting the claimed chunk size, which may not + * be trustworthy. + */ + + while (chunkSz) { + int blockSz = PNG_MIN(chunkSz, PNG_BLOCK_SZ); + + if (ReadData(interp, pngPtr, buffer, blockSz, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + chunkSz -= blockSz; + } + + if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + * 4.3. Summary of standard chunks + * + * This table summarizes some properties of the standard chunk types. + * + * Critical chunks (must appear in this order, except PLTE is optional): + * + * Name Multiple Ordering constraints OK? + * + * IHDR No Must be first + * PLTE No Before IDAT + * IDAT Yes Multiple IDATs must be consecutive + * IEND No Must be last + * + * Ancillary chunks (need not appear in this order): + * + * Name Multiple Ordering constraints OK? + * + * cHRM No Before PLTE and IDAT + * gAMA No Before PLTE and IDAT + * iCCP No Before PLTE and IDAT + * sBIT No Before PLTE and IDAT + * sRGB No Before PLTE and IDAT + * bKGD No After PLTE; before IDAT + * hIST No After PLTE; before IDAT + * tRNS No After PLTE; before IDAT + * pHYs No Before IDAT + * sPLT Yes Before IDAT + * tIME No None + * iTXt Yes None + * tEXt Yes None + * zTXt Yes None + * + * [From the PNG specification.] + */ + +/* + *---------------------------------------------------------------------- + * + * ReadChunkHeader -- + * + * This function is used at the start of each chunk to extract the + * four-byte chunk length and four-byte chunk type fields. It will + * continue reading until it finds a chunk type that is handled by this + * implementation, checking the CRC of any chunks it skips. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error occurs or an unknown critical + * chunk type is encountered. + * + * Side effects: + * The file position will change. The running CRC is updated. + * + *---------------------------------------------------------------------- + */ + +static int +ReadChunkHeader( + Tcl_Interp *interp, + PNGImage *pngPtr, + int *sizePtr, + unsigned long *typePtr, + unsigned long *crcPtr) +{ + unsigned long chunkType = 0; + int chunkSz = 0; + unsigned long crc = 0; + + /* + * Continue until finding a chunk type that is handled. + */ + + while (!chunkType) { + unsigned long temp; + unsigned char pc[4]; + int i; + + /* + * Read the 4-byte length field for the chunk. The length field is not + * included in the CRC calculation, so the running CRC must be reset + * afterward. Limit chunk lengths to INT_MAX, to align with the + * maximum size for Tcl_Read, Tcl_GetByteArrayFromObj, etc. + */ + + if (ReadData(interp, pngPtr, pc, 4, NULL) == TCL_ERROR) { + return TCL_ERROR; + } + + temp = PNG_INT32(pc[0], pc[1], pc[2], pc[3]); + + if (temp > INT_MAX) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "chunk size is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "OUTSIZE", NULL); + return TCL_ERROR; + } + + chunkSz = (int) temp; + crc = Tcl_ZlibCRC32(0, NULL, 0); + + /* + * Read the 4-byte chunk type. + */ + + if (ReadData(interp, pngPtr, pc, 4, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Convert it to a host-order integer for simple comparison. + */ + + chunkType = PNG_INT32(pc[0], pc[1], pc[2], pc[3]); + + /* + * Check to see if this is a known/supported chunk type. Note that the + * PNG specs require non-critical (i.e., ancillary) chunk types that + * are not recognized to be ignored, rather than be treated as an + * error. It does, however, recommend that an unknown critical chunk + * type be treated as a failure. + * + * This switch/loop acts as a filter of sorts for undesired chunk + * types. The chunk type should still be checked elsewhere for + * determining it is in the correct order. + */ + + switch (chunkType) { + /* + * These chunk types are required and/or supported. + */ + + case CHUNK_IDAT: + case CHUNK_IEND: + case CHUNK_IHDR: + case CHUNK_PLTE: + case CHUNK_tRNS: + break; + + /* + * These chunk types are part of the standard, but are not used by + * this implementation (at least not yet). Note that these are all + * ancillary chunks (lowercase first letter). + */ + + case CHUNK_bKGD: + case CHUNK_cHRM: + case CHUNK_gAMA: + case CHUNK_hIST: + case CHUNK_iCCP: + case CHUNK_iTXt: + case CHUNK_oFFs: + case CHUNK_pCAL: + case CHUNK_pHYs: + case CHUNK_sBIT: + case CHUNK_sCAL: + case CHUNK_sPLT: + case CHUNK_sRGB: + case CHUNK_tEXt: + case CHUNK_tIME: + case CHUNK_zTXt: + /* + * TODO: might want to check order here. + */ + + if (SkipChunk(interp, pngPtr, chunkSz, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + chunkType = 0; + break; + + default: + /* + * Unknown chunk type. If it's critical, we can't continue. + */ + + if (!(chunkType & PNG_CF_ANCILLARY)) { + if (chunkType & PNG_INT32(128,128,128,128)) { + /* + * No nice ASCII conversion; shouldn't happen either, but + * we'll be doubly careful. + */ + + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "encountered an unsupported criticial chunk type", + -1)); + } else { + char typeString[5]; + + typeString[0] = (char) ((chunkType >> 24) & 255); + typeString[1] = (char) ((chunkType >> 16) & 255); + typeString[2] = (char) ((chunkType >> 8) & 255); + typeString[3] = (char) (chunkType & 255); + typeString[4] = '\0'; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "encountered an unsupported criticial chunk type" + " \"%s\"", typeString)); + } + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", + "UNSUPPORTED_CRITICAL", NULL); + return TCL_ERROR; + } + + /* + * Check to see if the chunk type has legal bytes. + */ + + for (i=0 ; i<4 ; i++) { + if ((pc[i] < 65) || (pc[i] > 122) || + ((pc[i] > 90) && (pc[i] < 97))) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid chunk type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", + "INVALID_CHUNK", NULL); + return TCL_ERROR; + } + } + + /* + * It seems to be an otherwise legally labelled ancillary chunk + * that we don't want, so skip it after at least checking its CRC. + */ + + if (SkipChunk(interp, pngPtr, chunkSz, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + chunkType = 0; + } + } + + /* + * Found a known chunk type that's handled, albiet possibly not in the + * right order. Send back the chunk type (for further checking or + * handling), the chunk size and the current CRC for the rest of the + * calculation. + */ + + *typePtr = chunkType; + *sizePtr = chunkSz; + *crcPtr = crc; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CheckColor -- + * + * Do validation on color type, depth, and related information, and + * calculates storage requirements and offsets based on image dimensions + * and color. + * + * Results: + * TCL_OK, or TCL_ERROR if color information is invalid or some other + * failure occurs. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +CheckColor( + Tcl_Interp *interp, + PNGImage *pngPtr) +{ + int offset; + + /* + * Verify the color type is valid and the bit depth is allowed. + */ + + switch (pngPtr->colorType) { + case PNG_COLOR_GRAY: + pngPtr->numChannels = 1; + if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) && + (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth) && + (16 != pngPtr->bitDepth)) { + goto unsupportedDepth; + } + break; + + case PNG_COLOR_RGB: + pngPtr->numChannels = 3; + if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { + goto unsupportedDepth; + } + break; + + case PNG_COLOR_PLTE: + pngPtr->numChannels = 1; + if ((1 != pngPtr->bitDepth) && (2 != pngPtr->bitDepth) && + (4 != pngPtr->bitDepth) && (8 != pngPtr->bitDepth)) { + goto unsupportedDepth; + } + break; + + case PNG_COLOR_GRAYALPHA: + pngPtr->numChannels = 2; + if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { + goto unsupportedDepth; + } + break; + + case PNG_COLOR_RGBA: + pngPtr->numChannels = 4; + if ((8 != pngPtr->bitDepth) && (16 != pngPtr->bitDepth)) { + unsupportedDepth: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bit depth is not allowed for given color type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_DEPTH", NULL); + return TCL_ERROR; + } + break; + + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color type field %d", pngPtr->colorType)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL); + return TCL_ERROR; + } + + /* + * Set up the Tk photo block's pixel size and channel offsets. offset + * array elements should already be 0 from the memset during InitPNGImage. + */ + + offset = (pngPtr->bitDepth > 8) ? 2 : 1; + + if (pngPtr->colorType & PNG_COLOR_USED) { + pngPtr->block.pixelSize = offset * 4; + pngPtr->block.offset[1] = offset; + pngPtr->block.offset[2] = offset * 2; + pngPtr->block.offset[3] = offset * 3; + } else { + pngPtr->block.pixelSize = offset * 2; + pngPtr->block.offset[3] = offset; + } + + /* + * Calculate the block pitch, which is the number of bytes per line in the + * image, given image width and depth of color. Make sure that it it isn't + * larger than Tk can handle. + */ + + if (pngPtr->block.width > INT_MAX / pngPtr->block.pixelSize) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image pitch is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PITCH", NULL); + return TCL_ERROR; + } + + pngPtr->block.pitch = pngPtr->block.pixelSize * pngPtr->block.width; + + /* + * Calculate the total size of the image as represented to Tk given pitch + * and image height. Make sure that it isn't larger than Tk can handle. + */ + + if (pngPtr->block.height > INT_MAX / pngPtr->block.pitch) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image total size is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "SIZE", NULL); + return TCL_ERROR; + } + + pngPtr->blockLen = pngPtr->block.height * pngPtr->block.pitch; + + /* + * Determine number of bytes per pixel in the source for later use. + */ + + switch (pngPtr->colorType) { + case PNG_COLOR_GRAY: + pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 2 : 1; + break; + case PNG_COLOR_RGB: + pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 6 : 3; + break; + case PNG_COLOR_PLTE: + pngPtr->bytesPerPixel = 1; + break; + case PNG_COLOR_GRAYALPHA: + pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 4 : 2; + break; + case PNG_COLOR_RGBA: + pngPtr->bytesPerPixel = (pngPtr->bitDepth > 8) ? 8 : 4; + break; + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown color type %d", pngPtr->colorType)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "UNKNOWN_COLOR", NULL); + return TCL_ERROR; + } + + /* + * Calculate scale factor for bit depths less than 8, in order to adjust + * them to a minimum of 8 bits per pixel in the Tk image. + */ + + if (pngPtr->bitDepth < 8) { + pngPtr->bitScale = 255 / (int)(pow(2, pngPtr->bitDepth) - 1); + } else { + pngPtr->bitScale = 1; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ReadIHDR -- + * + * This function reads the PNG header from the beginning of a PNG file + * and returns the dimensions of the image. + * + * Results: + * The return value is 1 if file "f" appears to start with a valid PNG + * header, 0 otherwise. If the header is valid, then *widthPtr and + * *heightPtr are modified to hold the dimensions of the image. + * + * Side effects: + * The access position in f advances. + * + *---------------------------------------------------------------------- + */ + +static int +ReadIHDR( + Tcl_Interp *interp, + PNGImage *pngPtr) +{ + unsigned char sigBuf[PNG_SIG_SZ]; + unsigned long chunkType; + int chunkSz; + unsigned long crc; + unsigned long width, height; + int mismatch; + + /* + * Read the appropriate number of bytes for the PNG signature. + */ + + if (ReadData(interp, pngPtr, sigBuf, PNG_SIG_SZ, NULL) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Compare the read bytes to the expected signature. + */ + + mismatch = memcmp(sigBuf, pngSignature, PNG_SIG_SZ); + + /* + * If reading from string, reset position and try base64 decode. + */ + + if (mismatch && pngPtr->strDataBuf) { + pngPtr->strDataBuf = Tcl_GetByteArrayFromObj(pngPtr->objDataPtr, + &pngPtr->strDataLen); + pngPtr->base64Data = pngPtr->strDataBuf; + + if (ReadData(interp, pngPtr, sigBuf, PNG_SIG_SZ, NULL) == TCL_ERROR) { + return TCL_ERROR; + } + + mismatch = memcmp(sigBuf, pngSignature, PNG_SIG_SZ); + } + + if (mismatch) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "data stream does not have a PNG signature", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_SIG", NULL); + return TCL_ERROR; + } + + if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType, + &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Read in the IHDR (header) chunk for width, height, etc. + * + * The first chunk in the file must be the IHDR (headr) chunk. + */ + + if (chunkType != CHUNK_IHDR) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "expected IHDR chunk type", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NO_IHDR", NULL); + return TCL_ERROR; + } + + if (chunkSz != 13) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid IHDR chunk size", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IHDR", NULL); + return TCL_ERROR; + } + + /* + * Read and verify the image width and height to be sure Tk can handle its + * dimensions. The PNG specification does not permit zero-width or + * zero-height images. + */ + + if (ReadInt32(interp, pngPtr, &width, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (ReadInt32(interp, pngPtr, &height, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (!width || !height || (width > INT_MAX) || (height > INT_MAX)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image dimensions are invalid or beyond architecture limits", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DIMENSIONS", NULL); + return TCL_ERROR; + } + + /* + * Set height and width for the Tk photo block. + */ + + pngPtr->block.width = (int) width; + pngPtr->block.height = (int) height; + + /* + * Read and the Bit Depth and Color Type. + */ + + if (ReadData(interp, pngPtr, &pngPtr->bitDepth, 1, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (ReadData(interp, pngPtr, &pngPtr->colorType, 1, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Verify that the color type is valid, the bit depth is allowed for the + * color type, and calculate the number of channels and pixel depth (bits + * per pixel * channels). Also set up offsets and sizes in the Tk photo + * block for the pixel data. + */ + + if (CheckColor(interp, pngPtr) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Only one compression method is currently defined by the standard. + */ + + if (ReadData(interp, pngPtr, &pngPtr->compression, 1, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (pngPtr->compression != PNG_COMPRESS_DEFLATE) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown compression method %d", pngPtr->compression)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_COMPRESS", NULL); + return TCL_ERROR; + } + + /* + * Only one filter method is currently defined by the standard; the method + * has five actual filter types associated with it. + */ + + if (ReadData(interp, pngPtr, &pngPtr->filter, 1, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (pngPtr->filter != PNG_FILTMETH_STANDARD) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown filter method %d", pngPtr->filter)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); + return TCL_ERROR; + } + + if (ReadData(interp, pngPtr, &pngPtr->interlace, 1, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + switch (pngPtr->interlace) { + case PNG_INTERLACE_NONE: + case PNG_INTERLACE_ADAM7: + break; + + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown interlace method %d", pngPtr->interlace)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_INTERLACE", NULL); + return TCL_ERROR; + } + + return CheckCRC(interp, pngPtr, crc); +} + +/* + *---------------------------------------------------------------------- + * + * ReadPLTE -- + * + * This function reads the PLTE (indexed color palette) chunk data from + * the PNG file and populates the palette table in the PNGImage + * structure. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error occurs or the PLTE chunk is + * invalid. + * + * Side effects: + * The access position in f advances. + * + *---------------------------------------------------------------------- + */ + +static int +ReadPLTE( + Tcl_Interp *interp, + PNGImage *pngPtr, + int chunkSz, + unsigned long crc) +{ + unsigned char buffer[PNG_PLTE_MAXSZ]; + int i, c; + + /* + * This chunk is mandatory for color type 3 and forbidden for 2 and 6. + */ + + switch (pngPtr->colorType) { + case PNG_COLOR_GRAY: + case PNG_COLOR_GRAYALPHA: + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PLTE chunk type forbidden for grayscale", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "PLTE_UNEXPECTED", + NULL); + return TCL_ERROR; + + default: + break; + } + + /* + * The palette chunk contains from 1 to 256 palette entries. Each entry + * consists of a 3-byte RGB value. It must therefore contain a non-zero + * multiple of 3 bytes, up to 768. + */ + + if (!chunkSz || (chunkSz > PNG_PLTE_MAXSZ) || (chunkSz % 3)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid palette chunk size", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_PLTE", NULL); + return TCL_ERROR; + } + + /* + * Read the palette contents and stash them for later, possibly. + */ + + if (ReadData(interp, pngPtr, buffer, chunkSz, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Stash away the palette entries and entry count for later mapping each + * pixel's palette index to its color. + */ + + for (i=0, c=0 ; c<chunkSz ; i++) { + pngPtr->palette[i].red = buffer[c++]; + pngPtr->palette[i].green = buffer[c++]; + pngPtr->palette[i].blue = buffer[c++]; + } + + pngPtr->paletteLen = i; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ReadTRNS -- + * + * This function reads the tRNS (transparency) chunk data from the PNG + * file and populates the alpha field of the palette table in the + * PNGImage structure or the single color transparency, as appropriate + * for the color type. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error occurs or the tRNS chunk is + * invalid. + * + * Side effects: + * The access position in f advances. + * + *---------------------------------------------------------------------- + */ + +static int +ReadTRNS( + Tcl_Interp *interp, + PNGImage *pngPtr, + int chunkSz, + unsigned long crc) +{ + unsigned char buffer[PNG_TRNS_MAXSZ]; + int i; + + if (pngPtr->colorType & PNG_COLOR_ALPHA) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "tRNS chunk not allowed color types with a full alpha channel", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "INVALID_TRNS", NULL); + return TCL_ERROR; + } + + /* + * For indexed color, there is up to one single-byte transparency value + * per palette entry (thus a max of 256). + */ + + if (chunkSz > PNG_TRNS_MAXSZ) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); + return TCL_ERROR; + } + + /* + * Read in the raw transparency information. + */ + + if (ReadData(interp, pngPtr, buffer, chunkSz, &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + switch (pngPtr->colorType) { + case PNG_COLOR_GRAYALPHA: + case PNG_COLOR_RGBA: + break; + + case PNG_COLOR_PLTE: + /* + * The number of tRNS entries must be less than or equal to the number + * of PLTE entries, and consists of a single-byte alpha level for the + * corresponding PLTE entry. + */ + + if (chunkSz > pngPtr->paletteLen) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "size of tRNS chunk is too large for the palette", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TRNS_SIZE", NULL); + return TCL_ERROR; + } + + for (i=0 ; i<chunkSz ; i++) { + pngPtr->palette[i].alpha = buffer[i]; + } + break; + + case PNG_COLOR_GRAY: + /* + * Grayscale uses a single 2-byte gray level, which we'll store in + * palette index 0, since we're not using the palette. + */ + + if (chunkSz != 2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size - must 2 bytes for grayscale", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); + return TCL_ERROR; + } + + /* + * According to the PNG specs, if the bit depth is less than 16, then + * only the lower byte is used. + */ + + if (16 == pngPtr->bitDepth) { + pngPtr->transVal[0] = buffer[0]; + pngPtr->transVal[1] = buffer[1]; + } else { + pngPtr->transVal[0] = buffer[1]; + } + pngPtr->useTRNS = 1; + break; + + case PNG_COLOR_RGB: + /* + * TrueColor uses a single RRGGBB triplet. + */ + + if (chunkSz != 6) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid tRNS chunk size - must 6 bytes for RGB", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_TRNS", NULL); + return TCL_ERROR; + } + + /* + * According to the PNG specs, if the bit depth is less than 16, then + * only the lower byte is used. But the tRNS chunk still contains two + * bytes per channel. + */ + + if (16 == pngPtr->bitDepth) { + memcpy(pngPtr->transVal, buffer, 6); + } else { + pngPtr->transVal[0] = buffer[1]; + pngPtr->transVal[1] = buffer[3]; + pngPtr->transVal[2] = buffer[5]; + } + pngPtr->useTRNS = 1; + break; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Paeth -- + * + * Utility function for applying the Paeth filter to a pixel. The Paeth + * filter is a linear function of the pixel to be filtered and the pixels + * to the left, above, and above-left of the pixel to be unfiltered. + * + * Results: + * Result of the Paeth function for the left, above, and above-left + * pixels. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static inline unsigned char +Paeth( + int a, + int b, + int c) +{ + int pa = abs(b - c); + int pb = abs(a - c); + int pc = abs(a + b - c - c); + + if ((pa <= pb) && (pa <= pc)) { + return (unsigned char) a; + } + + if (pb <= pc) { + return (unsigned char) b; + } + + return (unsigned char) c; +} + +/* + *---------------------------------------------------------------------- + * + * UnfilterLine -- + * + * Applies the filter algorithm specified in first byte of a line to the + * line of pixels being read from a PNG image. + * + * PNG specifies four filter algorithms (Sub, Up, Average, and Paeth) + * that combine a pixel's value with those of other pixels in the same + * and/or previous lines. Filtering is intended to make an image more + * compressible. + * + * Results: + * TCL_OK, or TCL_ERROR if the filter type is not recognized. + * + * Side effects: + * Pixel data in thisLineObj are modified. + * + *---------------------------------------------------------------------- + */ + +static int +UnfilterLine( + Tcl_Interp *interp, + PNGImage *pngPtr) +{ + unsigned char *thisLine = + Tcl_GetByteArrayFromObj(pngPtr->thisLineObj, NULL); + unsigned char *lastLine = + Tcl_GetByteArrayFromObj(pngPtr->lastLineObj, NULL); + +#define PNG_FILTER_NONE 0 +#define PNG_FILTER_SUB 1 +#define PNG_FILTER_UP 2 +#define PNG_FILTER_AVG 3 +#define PNG_FILTER_PAETH 4 + + switch (*thisLine) { + case PNG_FILTER_NONE: /* Nothing to do */ + break; + case PNG_FILTER_SUB: { /* Sub(x) = Raw(x) - Raw(x-bpp) */ + unsigned char *rawBpp = thisLine + 1; + unsigned char *raw = rawBpp + pngPtr->bytesPerPixel; + unsigned char *end = thisLine + pngPtr->phaseSize; + + while (raw < end) { + *raw++ += *rawBpp++; + } + break; + } + case PNG_FILTER_UP: /* Up(x) = Raw(x) - Prior(x) */ + if (pngPtr->currentLine > startLine[pngPtr->phase]) { + unsigned char *prior = lastLine + 1; + unsigned char *raw = thisLine + 1; + unsigned char *end = thisLine + pngPtr->phaseSize; + + while (raw < end) { + *raw++ += *prior++; + } + } + break; + case PNG_FILTER_AVG: + /* Avg(x) = Raw(x) - floor((Raw(x-bpp)+Prior(x))/2) */ + if (pngPtr->currentLine > startLine[pngPtr->phase]) { + unsigned char *prior = lastLine + 1; + unsigned char *rawBpp = thisLine + 1; + unsigned char *raw = rawBpp; + unsigned char *end = thisLine + pngPtr->phaseSize; + unsigned char *end2 = raw + pngPtr->bytesPerPixel; + + while ((raw < end2) && (raw < end)) { + *raw++ += *prior++ / 2; + } + + while (raw < end) { + *raw++ += (unsigned char) + (((int) *rawBpp++ + (int) *prior++) / 2); + } + } else { + unsigned char *rawBpp = thisLine + 1; + unsigned char *raw = rawBpp + pngPtr->bytesPerPixel; + unsigned char *end = thisLine + pngPtr->phaseSize; + + while (raw < end) { + *raw++ += *rawBpp++ / 2; + } + } + break; + case PNG_FILTER_PAETH: + /* Paeth(x) = Raw(x) - PaethPredictor(Raw(x-bpp), Prior(x), Prior(x-bpp)) */ + if (pngPtr->currentLine > startLine[pngPtr->phase]) { + unsigned char *priorBpp = lastLine + 1; + unsigned char *prior = priorBpp; + unsigned char *rawBpp = thisLine + 1; + unsigned char *raw = rawBpp; + unsigned char *end = thisLine + pngPtr->phaseSize; + unsigned char *end2 = rawBpp + pngPtr->bytesPerPixel; + + while ((raw < end) && (raw < end2)) { + *raw++ += *prior++; + } + + while (raw < end) { + *raw++ += Paeth(*rawBpp++, *prior++, *priorBpp++); + } + } else { + unsigned char *rawBpp = thisLine + 1; + unsigned char *raw = rawBpp + pngPtr->bytesPerPixel; + unsigned char *end = thisLine + pngPtr->phaseSize; + + while (raw < end) { + *raw++ += *rawBpp++; + } + } + break; + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid filter type %d", *thisLine)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_FILTER", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * DecodeLine -- + * + * Unfilters a line of pixels from the PNG source data and decodes the + * data into the Tk_PhotoImageBlock for later copying into the Tk image. + * + * Results: + * TCL_OK, or TCL_ERROR if the filter type is not recognized. + * + * Side effects: + * Pixel data in thisLine and block are modified and state information + * updated. + * + *---------------------------------------------------------------------- + */ + +static int +DecodeLine( + Tcl_Interp *interp, + PNGImage *pngPtr) +{ + unsigned char *pixelPtr = pngPtr->block.pixelPtr; + int colNum = 0; /* Current pixel column */ + unsigned char chan = 0; /* Current channel (0..3) = (R, G, B, A) */ + unsigned char readByte = 0; /* Current scan line byte */ + int haveBits = 0; /* Number of bits remaining in current byte */ + unsigned char pixBits = 0; /* Extracted bits for current channel */ + int shifts = 0; /* Number of channels extracted from byte */ + int offset = 0; /* Current offset into pixelPtr */ + int colStep = 1; /* Column increment each pass */ + int pixStep = 0; /* extra pixelPtr increment each pass */ + unsigned char lastPixel[6]; + unsigned char *p = Tcl_GetByteArrayFromObj(pngPtr->thisLineObj, NULL); + + p++; + if (UnfilterLine(interp, pngPtr) == TCL_ERROR) { + return TCL_ERROR; + } + if (pngPtr->currentLine >= pngPtr->block.height) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PNG image data overflow")); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DATA_OVERFLOW", NULL); + return TCL_ERROR; + } + + + if (pngPtr->interlace) { + switch (pngPtr->phase) { + case 1: /* Phase 1: */ + colStep = 8; /* 1 pixel per block of 8 per line */ + break; /* Start at column 0 */ + case 2: /* Phase 2: */ + colStep = 8; /* 1 pixels per block of 8 per line */ + colNum = 4; /* Start at column 4 */ + break; + case 3: /* Phase 3: */ + colStep = 4; /* 2 pixels per block of 8 per line */ + break; /* Start at column 0 */ + case 4: /* Phase 4: */ + colStep = 4; /* 2 pixels per block of 8 per line */ + colNum = 2; /* Start at column 2 */ + break; + case 5: /* Phase 5: */ + colStep = 2; /* 4 pixels per block of 8 per line */ + break; /* Start at column 0 */ + case 6: /* Phase 6: */ + colStep = 2; /* 4 pixels per block of 8 per line */ + colNum = 1; /* Start at column 1 */ + break; + /* Phase 7: */ + /* 8 pixels per block of 8 per line */ + /* Start at column 0 */ + } + } + + /* + * Calculate offset into pixelPtr for the first pixel of the line. + */ + + offset = pngPtr->currentLine * pngPtr->block.pitch; + + /* + * Adjust up for the starting pixel of the line. + */ + + offset += colNum * pngPtr->block.pixelSize; + + /* + * Calculate the extra number of bytes to skip between columns. + */ + + pixStep = (colStep - 1) * pngPtr->block.pixelSize; + + for ( ; colNum < pngPtr->block.width ; colNum += colStep) { + if (haveBits < (pngPtr->bitDepth * pngPtr->numChannels)) { + haveBits = 0; + } + + for (chan = 0 ; chan < pngPtr->numChannels ; chan++) { + if (!haveBits) { + shifts = 0; + readByte = *p++; + haveBits += 8; + } + + if (16 == pngPtr->bitDepth) { + pngPtr->block.pixelPtr[offset++] = readByte; + + if (pngPtr->useTRNS) { + lastPixel[chan * 2] = readByte; + } + + readByte = *p++; + + if (pngPtr->useTRNS) { + lastPixel[(chan * 2) + 1] = readByte; + } + + pngPtr->block.pixelPtr[offset++] = readByte; + + haveBits = 0; + continue; + } + + switch (pngPtr->bitDepth) { + case 1: + pixBits = (unsigned char)((readByte >> (7-shifts)) & 0x01); + break; + case 2: + pixBits = (unsigned char)((readByte >> (6-shifts*2)) & 0x03); + break; + case 4: + pixBits = (unsigned char)((readByte >> (4-shifts*4)) & 0x0f); + break; + case 8: + pixBits = readByte; + break; + } + + if (PNG_COLOR_PLTE == pngPtr->colorType) { + pixelPtr[offset++] = pngPtr->palette[pixBits].red; + pixelPtr[offset++] = pngPtr->palette[pixBits].green; + pixelPtr[offset++] = pngPtr->palette[pixBits].blue; + pixelPtr[offset++] = pngPtr->palette[pixBits].alpha; + chan += 2; + } else { + pixelPtr[offset++] = (unsigned char) + (pixBits * pngPtr->bitScale); + + if (pngPtr->useTRNS) { + lastPixel[chan] = pixBits; + } + } + + haveBits -= pngPtr->bitDepth; + shifts++; + } + + /* + * Apply boolean transparency via tRNS data if necessary (where + * necessary means a tRNS chunk was provided and we're not using an + * alpha channel or indexed alpha). + */ + + if ((PNG_COLOR_PLTE != pngPtr->colorType) && + !(pngPtr->colorType & PNG_COLOR_ALPHA)) { + unsigned char alpha; + + if (pngPtr->useTRNS) { + if (memcmp(lastPixel, pngPtr->transVal, + pngPtr->bytesPerPixel) == 0) { + alpha = 0x00; + } else { + alpha = 0xff; + } + } else { + alpha = 0xff; + } + + pixelPtr[offset++] = alpha; + + if (16 == pngPtr->bitDepth) { + pixelPtr[offset++] = alpha; + } + } + + offset += pixStep; + } + + if (pngPtr->interlace) { + /* Skip lines */ + + switch (pngPtr->phase) { + case 1: case 2: case 3: + pngPtr->currentLine += 8; + break; + case 4: case 5: + pngPtr->currentLine += 4; + break; + case 6: case 7: + pngPtr->currentLine += 2; + break; + } + + /* + * Start the next phase if there are no more lines to do. + */ + + if (pngPtr->currentLine >= pngPtr->block.height) { + unsigned long pixels = 0; + + while ((!pixels || (pngPtr->currentLine >= pngPtr->block.height)) + && (pngPtr->phase < 7)) { + pngPtr->phase++; + + switch (pngPtr->phase) { + case 2: + pixels = (pngPtr->block.width + 3) >> 3; + pngPtr->currentLine = 0; + break; + case 3: + pixels = (pngPtr->block.width + 3) >> 2; + pngPtr->currentLine = 4; + break; + case 4: + pixels = (pngPtr->block.width + 1) >> 2; + pngPtr->currentLine = 0; + break; + case 5: + pixels = (pngPtr->block.width + 1) >> 1; + pngPtr->currentLine = 2; + break; + case 6: + pixels = pngPtr->block.width >> 1; + pngPtr->currentLine = 0; + break; + case 7: + pngPtr->currentLine = 1; + pixels = pngPtr->block.width; + break; + } + } + + if (16 == pngPtr->bitDepth) { + pngPtr->phaseSize = 1 + (pngPtr->numChannels * pixels * 2); + } else { + pngPtr->phaseSize = 1 + ((pngPtr->numChannels * pixels * + pngPtr->bitDepth + 7) >> 3); + } + } + } else { + pngPtr->currentLine++; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ReadIDAT -- + * + * This function reads the IDAT (pixel data) chunk from the PNG file to + * build the image. It will continue reading until all IDAT chunks have + * been processed or an error occurs. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error occurs or an IDAT chunk is + * invalid. + * + * Side effects: + * The access position in f advances. Memory may be allocated by zlib + * through PNGZAlloc. + * + *---------------------------------------------------------------------- + */ + +static int +ReadIDAT( + Tcl_Interp *interp, + PNGImage *pngPtr, + int chunkSz, + unsigned long crc) +{ + /* + * Process IDAT contents until there is no more in this chunk. + */ + + while (chunkSz && !Tcl_ZlibStreamEof(pngPtr->stream)) { + int len1, len2; + + /* + * Read another block of input into the zlib stream if data remains. + */ + + if (chunkSz) { + Tcl_Obj *inputObj = NULL; + int blockSz = PNG_MIN(chunkSz, PNG_BLOCK_SZ); + unsigned char *inputPtr = NULL; + + /* + * Check for end of zlib stream. + */ + + if (Tcl_ZlibStreamEof(pngPtr->stream)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data after end of zlib stream", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", + NULL); + return TCL_ERROR; + } + + inputObj = Tcl_NewObj(); + Tcl_IncrRefCount(inputObj); + inputPtr = Tcl_SetByteArrayLength(inputObj, blockSz); + + /* + * Read the next bit of IDAT chunk data, up to read buffer size. + */ + + if (ReadData(interp, pngPtr, inputPtr, blockSz, + &crc) == TCL_ERROR) { + Tcl_DecrRefCount(inputObj); + return TCL_ERROR; + } + + chunkSz -= blockSz; + + Tcl_ZlibStreamPut(pngPtr->stream, inputObj, TCL_ZLIB_NO_FLUSH); + Tcl_DecrRefCount(inputObj); + } + + /* + * Inflate, processing each output buffer's worth as a line of pixels, + * until we cannot fill the buffer any more. + */ + + getNextLine: + Tcl_GetByteArrayFromObj(pngPtr->thisLineObj, &len1); + if (Tcl_ZlibStreamGet(pngPtr->stream, pngPtr->thisLineObj, + pngPtr->phaseSize - len1) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_GetByteArrayFromObj(pngPtr->thisLineObj, &len2); + + if (len2 == pngPtr->phaseSize) { + if (pngPtr->phase > 7) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data after final scan line of final phase", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", + NULL); + return TCL_ERROR; + } + + if (DecodeLine(interp, pngPtr) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Swap the current/last lines so that we always have the last + * line processed available, which is necessary for filtering. + */ + + { + Tcl_Obj *temp = pngPtr->lastLineObj; + + pngPtr->lastLineObj = pngPtr->thisLineObj; + pngPtr->thisLineObj = temp; + } + Tcl_SetByteArrayLength(pngPtr->thisLineObj, 0); + + /* + * Try to read another line of pixels out of the buffer + * immediately, but don't allow write past end of block. + */ + + if (pngPtr->currentLine < pngPtr->block.height) { + goto getNextLine; + } + + } + + /* + * Got less than a whole buffer-load of pixels. Either we're going to + * be getting more data from the next IDAT, or we've done what we can + * here. + */ + } + + /* + * Ensure that if we've got to the end of the compressed data, we've + * also got to the end of the compressed stream. This sanity check is + * enforced by most PNG readers. + */ + + if (chunkSz != 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "compressed data after stream finalize in PNG data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); + return TCL_ERROR; + } + + return CheckCRC(interp, pngPtr, crc); +} + +/* + *---------------------------------------------------------------------- + * + * ApplyAlpha -- + * + * Applies an overall alpha value to a complete image that has been read. + * This alpha value is specified using the -format option to [image + * create photo]. + * + * Results: + * N/A + * + * Side effects: + * The access position in f may change. + * + *---------------------------------------------------------------------- + */ + +static void +ApplyAlpha( + PNGImage *pngPtr) +{ + if (pngPtr->alpha != 1.0) { + register unsigned char *p = pngPtr->block.pixelPtr; + unsigned char *endPtr = p + pngPtr->blockLen; + int offset = pngPtr->block.offset[3]; + + p += offset; + + if (16 == pngPtr->bitDepth) { + register int channel; + + while (p < endPtr) { + channel = (unsigned char) + (((p[0] << 8) | p[1]) * pngPtr->alpha); + + *p++ = (unsigned char) (channel >> 8); + *p++ = (unsigned char) (channel & 0xff); + + p += offset; + } + } else { + while (p < endPtr) { + p[0] = (unsigned char) (pngPtr->alpha * p[0]); + p += 1 + offset; + } + } + } +} + +/* + *---------------------------------------------------------------------- + * + * ParseFormat -- + * + * This function parses the -format string that can be specified to the + * [image create photo] command to extract options for postprocessing of + * loaded images. Currently, this just allows specifying and applying an + * overall alpha value to the loaded image (for example, to make it + * entirely 50% as transparent as the actual image file). + * + * Results: + * TCL_OK, or TCL_ERROR if the format specification is invalid. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +ParseFormat( + Tcl_Interp *interp, + Tcl_Obj *fmtObj, + PNGImage *pngPtr) +{ + Tcl_Obj **objv = NULL; + int objc = 0; + static const char *const fmtOptions[] = { + "-alpha", NULL + }; + enum fmtOptions { + OPT_ALPHA + }; + + /* + * Extract elements of format specification as a list. + */ + + if (fmtObj && + Tcl_ListObjGetElements(interp, fmtObj, &objc, &objv) != TCL_OK) { + return TCL_ERROR; + } + + for (; objc>0 ; objc--, objv++) { + int optIndex; + + /* + * Ignore the "png" part of the format specification. + */ + + if (!strcasecmp(Tcl_GetString(objv[0]), "png")) { + continue; + } + + if (Tcl_GetIndexFromObjStruct(interp, objv[0], fmtOptions, + sizeof(char *), "option", 0, &optIndex) == TCL_ERROR) { + return TCL_ERROR; + } + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "value"); + return TCL_ERROR; + } + + objc--; + objv++; + + switch ((enum fmtOptions) optIndex) { + case OPT_ALPHA: + if (Tcl_GetDoubleFromObj(interp, objv[0], + &pngPtr->alpha) == TCL_ERROR) { + return TCL_ERROR; + } + + if ((pngPtr->alpha < 0.0) || (pngPtr->alpha > 1.0)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-alpha value must be between 0.0 and 1.0", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_ALPHA", + NULL); + return TCL_ERROR; + } + break; + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * DecodePNG -- + * + * This function handles the entirety of reading a PNG file (or data) + * from the first byte to the last. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O error occurs or any problems are + * detected in the PNG file. + * + * Side effects: + * The access position in f advances. Memory may be allocated and image + * dimensions and contents may change. + * + *---------------------------------------------------------------------- + */ + +static int +DecodePNG( + Tcl_Interp *interp, + PNGImage *pngPtr, + Tcl_Obj *fmtObj, + Tk_PhotoHandle imageHandle, + int destX, + int destY) +{ + unsigned long chunkType; + int chunkSz; + unsigned long crc; + + /* + * Parse the PNG signature and IHDR (header) chunk. + */ + + if (ReadIHDR(interp, pngPtr) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Extract alpha value from -format object, if specified. + */ + + if (ParseFormat(interp, fmtObj, pngPtr) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * The next chunk may either be a PLTE (Palette) chunk or the first of at + * least one IDAT (data) chunks. It could also be one of a number of + * ancillary chunks, but those are skipped for us by the switch in + * ReadChunkHeader(). + * + * PLTE is mandatory for color type 3 and forbidden for 2 and 6 + */ + + if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType, + &crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (CHUNK_PLTE == chunkType) { + /* + * Finish parsing the PLTE chunk. + */ + + if (ReadPLTE(interp, pngPtr, chunkSz, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Begin the next chunk. + */ + + if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType, + &crc) == TCL_ERROR) { + return TCL_ERROR; + } + } else if (PNG_COLOR_PLTE == pngPtr->colorType) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PLTE chunk required for indexed color", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_PLTE", NULL); + return TCL_ERROR; + } + + /* + * The next chunk may be a tRNS (palette transparency) chunk, depending on + * the color type. It must come after the PLTE chunk and before the IDAT + * chunk, but can be present if there is no PLTE chunk because it can be + * used for Grayscale and TrueColor in lieu of an alpha channel. + */ + + if (CHUNK_tRNS == chunkType) { + /* + * Finish parsing the tRNS chunk. + */ + + if (ReadTRNS(interp, pngPtr, chunkSz, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Begin the next chunk. + */ + + if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType, + &crc) == TCL_ERROR) { + return TCL_ERROR; + } + } + + /* + * Other ancillary chunk types could appear here, but for now we're only + * interested in IDAT. The others should have been skipped. + */ + + if (chunkType != CHUNK_IDAT) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "at least one IDAT chunk is required", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "NEED_IDAT", NULL); + return TCL_ERROR; + } + + /* + * Expand the photo size (if not set by the user) to provide enough space + * for the image being parsed. It does not matter if width or height wrap + * to negative here: Tk will not shrink the image. + */ + + if (Tk_PhotoExpand(interp, imageHandle, destX + pngPtr->block.width, + destY + pngPtr->block.height) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * A scan line consists of one byte for a filter type, plus the number of + * bits per color sample times the number of color samples per pixel. + */ + + if (pngPtr->block.width > ((INT_MAX - 1) / (pngPtr->numChannels * 2))) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "line size is out of supported range on this architecture", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "LINE_SIZE", NULL); + return TCL_ERROR; + } + + if (16 == pngPtr->bitDepth) { + pngPtr->lineSize = 1 + (pngPtr->numChannels * pngPtr->block.width*2); + } else { + pngPtr->lineSize = 1 + ((pngPtr->numChannels * pngPtr->block.width) / + (8 / pngPtr->bitDepth)); + if (pngPtr->block.width % (8 / pngPtr->bitDepth)) { + pngPtr->lineSize++; + } + } + + /* + * Allocate space for decoding the scan lines. + */ + + pngPtr->lastLineObj = Tcl_NewObj(); + Tcl_IncrRefCount(pngPtr->lastLineObj); + pngPtr->thisLineObj = Tcl_NewObj(); + Tcl_IncrRefCount(pngPtr->thisLineObj); + + pngPtr->block.pixelPtr = attemptckalloc(pngPtr->blockLen); + if (!pngPtr->block.pixelPtr) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "memory allocation failed", -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); + return TCL_ERROR; + } + + /* + * Determine size of the first phase if interlaced. Phase size should + * always be <= line size, so probably not necessary to check for + * arithmetic overflow here: should be covered by line size check. + */ + + if (pngPtr->interlace) { + /* + * Only one pixel per block of 8 per line in the first phase. + */ + + unsigned int pixels = (pngPtr->block.width + 7) >> 3; + + pngPtr->phase = 1; + if (16 == pngPtr->bitDepth) { + pngPtr->phaseSize = 1 + pngPtr->numChannels*pixels*2; + } else { + pngPtr->phaseSize = 1 + + ((pngPtr->numChannels*pixels*pngPtr->bitDepth + 7) >> 3); + } + } else { + pngPtr->phaseSize = pngPtr->lineSize; + } + + /* + * All of the IDAT (data) chunks must be consecutive. + */ + + while (CHUNK_IDAT == chunkType) { + if (ReadIDAT(interp, pngPtr, chunkSz, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType, + &crc) == TCL_ERROR) { + return TCL_ERROR; + } + } + + /* + * Ensure that we've got to the end of the compressed stream now that + * there are no more IDAT segments. This sanity check is enforced by most + * PNG readers. + */ + + if (!Tcl_ZlibStreamEof(pngPtr->stream)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unfinalized data stream in PNG data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "EXTRA_DATA", NULL); + return TCL_ERROR; + } + + /* + * Now skip the remaining chunks which we're also not interested in. + */ + + while (CHUNK_IEND != chunkType) { + if (SkipChunk(interp, pngPtr, chunkSz, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + if (ReadChunkHeader(interp, pngPtr, &chunkSz, &chunkType, + &crc) == TCL_ERROR) { + return TCL_ERROR; + } + } + + /* + * Got the IEND (end of image) chunk. Do some final checks... + */ + + if (chunkSz) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "IEND chunk contents must be empty", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); + return TCL_ERROR; + } + + /* + * Check the CRC on the IEND chunk. + */ + + if (CheckCRC(interp, pngPtr, crc) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * TODO: verify that nothing else comes after the IEND chunk, or do we + * really care? + */ + +#if 0 + if (ReadData(interp, pngPtr, &c, 1, NULL) != TCL_ERROR) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra data following IEND chunk", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "BAD_IEND", NULL); + return TCL_ERROR; + } +#endif + + /* + * Apply overall image alpha if specified. + */ + + ApplyAlpha(pngPtr); + + /* + * Copy the decoded image block into the Tk photo image. + */ + + if (Tk_PhotoPutBlock(interp, imageHandle, &pngPtr->block, destX, destY, + pngPtr->block.width, pngPtr->block.height, + TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) { + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * FileMatchPNG -- + * + * This function is invoked by the photo image type to see if a file + * contains image data in PNG format. + * + * Results: + * The return value is 1 if the first characters in file f look like PNG + * data, and 0 otherwise. + * + * Side effects: + * The access position in f may change. + * + *---------------------------------------------------------------------- + */ + +static int +FileMatchPNG( + Tcl_Channel chan, + const char *fileName, + Tcl_Obj *fmtObj, + int *widthPtr, + int *heightPtr, + Tcl_Interp *interp) +{ + PNGImage png; + int match = 0; + + InitPNGImage(NULL, &png, chan, NULL, TCL_ZLIB_STREAM_INFLATE); + + if (ReadIHDR(interp, &png) == TCL_OK) { + *widthPtr = png.block.width; + *heightPtr = png.block.height; + match = 1; + } + + CleanupPNGImage(&png); + + return match; +} + +/* + *---------------------------------------------------------------------- + * + * FileReadPNG -- + * + * This function is called by the photo image type to read PNG format + * data from a file and write it into a given photo image. + * + * Results: + * A standard TCL completion code. If TCL_ERROR is returned then an error + * message is left in the interp's result. + * + * Side effects: + * The access position in file f is changed, and new data is added to the + * image given by imageHandle. + * + *---------------------------------------------------------------------- + */ + +static int +FileReadPNG( + Tcl_Interp *interp, + Tcl_Channel chan, + const char *fileName, + Tcl_Obj *fmtObj, + Tk_PhotoHandle imageHandle, + int destX, + int destY, + int width, + int height, + int srcX, + int srcY) +{ + PNGImage png; + int result = TCL_ERROR; + + result = InitPNGImage(interp, &png, chan, NULL, TCL_ZLIB_STREAM_INFLATE); + + if (TCL_OK == result) { + result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY); + } + + CleanupPNGImage(&png); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * StringMatchPNG -- + * + * This function is invoked by the photo image type to see if an object + * contains image data in PNG format. + * + * Results: + * The return value is 1 if the first characters in the data are like PNG + * data, and 0 otherwise. + * + * Side effects: + * The size of the image is placed in widthPre and heightPtr. + * + *---------------------------------------------------------------------- + */ + +static int +StringMatchPNG( + Tcl_Obj *pObjData, + Tcl_Obj *fmtObj, + int *widthPtr, + int *heightPtr, + Tcl_Interp *interp) +{ + PNGImage png; + int match = 0; + + InitPNGImage(NULL, &png, NULL, pObjData, TCL_ZLIB_STREAM_INFLATE); + + png.strDataBuf = Tcl_GetByteArrayFromObj(pObjData, &png.strDataLen); + + if (ReadIHDR(interp, &png) == TCL_OK) { + *widthPtr = png.block.width; + *heightPtr = png.block.height; + match = 1; + } + + CleanupPNGImage(&png); + return match; +} + +/* + *---------------------------------------------------------------------- + * + * StringReadPNG -- + * + * This function is called by the photo image type to read PNG format + * data from an object and give it to the photo image. + * + * Results: + * A standard TCL completion code. If TCL_ERROR is returned then an error + * message is left in the interp's result. + * + * Side effects: + * New data is added to the image given by imageHandle. + * + *---------------------------------------------------------------------- + */ + +static int +StringReadPNG( + Tcl_Interp *interp, + Tcl_Obj *pObjData, + Tcl_Obj *fmtObj, + Tk_PhotoHandle imageHandle, + int destX, + int destY, + int width, + int height, + int srcX, + int srcY) +{ + PNGImage png; + int result = TCL_ERROR; + + result = InitPNGImage(interp, &png, NULL, pObjData, + TCL_ZLIB_STREAM_INFLATE); + + if (TCL_OK == result) { + result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY); + } + + CleanupPNGImage(&png); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * WriteData -- + * + * This function writes a bytes from a buffer out to the PNG image. + * + * Results: + * TCL_OK, or TCL_ERROR if the write fails. + * + * Side effects: + * File or buffer will be modified. + * + *---------------------------------------------------------------------- + */ + +static int +WriteData( + Tcl_Interp *interp, + PNGImage *pngPtr, + const unsigned char *srcPtr, + int srcSz, + unsigned long *crcPtr) +{ + if (!srcPtr || !srcSz) { + return TCL_OK; + } + + if (crcPtr) { + *crcPtr = Tcl_ZlibCRC32(*crcPtr, srcPtr, srcSz); + } + + /* + * TODO: is Tcl_AppendObjToObj faster here? i.e., does Tcl join the + * objects immediately or store them in a multi-object rep? + */ + + if (pngPtr->objDataPtr) { + int objSz; + unsigned char *destPtr; + + Tcl_GetByteArrayFromObj(pngPtr->objDataPtr, &objSz); + + if (objSz > INT_MAX - srcSz) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image too large to store completely in byte array", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); + return TCL_ERROR; + } + + destPtr = Tcl_SetByteArrayLength(pngPtr->objDataPtr, objSz + srcSz); + + if (!destPtr) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "memory allocation failed", -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); + return TCL_ERROR; + } + + memcpy(destPtr+objSz, srcPtr, srcSz); + } else if (Tcl_Write(pngPtr->channel, (const char *) srcPtr, srcSz) < 0) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "write to channel failed: %s", Tcl_PosixError(interp))); + return TCL_ERROR; + } + + return TCL_OK; +} + +static inline int +WriteByte( + Tcl_Interp *interp, + PNGImage *pngPtr, + unsigned char c, + unsigned long *crcPtr) +{ + return WriteData(interp, pngPtr, &c, 1, crcPtr); +} + +/* + *---------------------------------------------------------------------- + * + * WriteInt32 -- + * + * This function writes a 32-bit integer value out to the PNG image as + * four bytes in network byte order. + * + * Results: + * TCL_OK, or TCL_ERROR if the write fails. + * + * Side effects: + * File or buffer will be modified. + * + *---------------------------------------------------------------------- + */ + +static inline int +WriteInt32( + Tcl_Interp *interp, + PNGImage *pngPtr, + unsigned long l, + unsigned long *crcPtr) +{ + unsigned char pc[4]; + + pc[0] = (unsigned char) ((l & 0xff000000) >> 24); + pc[1] = (unsigned char) ((l & 0x00ff0000) >> 16); + pc[2] = (unsigned char) ((l & 0x0000ff00) >> 8); + pc[3] = (unsigned char) ((l & 0x000000ff) >> 0); + + return WriteData(interp, pngPtr, pc, 4, crcPtr); +} + +/* + *---------------------------------------------------------------------- + * + * WriteChunk -- + * + * Writes a complete chunk to the PNG image, including chunk type, + * length, contents, and CRC. + * + * Results: + * TCL_OK, or TCL_ERROR if the write fails. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static inline int +WriteChunk( + Tcl_Interp *interp, + PNGImage *pngPtr, + unsigned long chunkType, + const unsigned char *dataPtr, + int dataSize) +{ + unsigned long crc = Tcl_ZlibCRC32(0, NULL, 0); + int result = TCL_OK; + + /* + * Write the length field for the chunk. + */ + + result = WriteInt32(interp, pngPtr, dataSize, NULL); + + /* + * Write the Chunk Type. + */ + + if (TCL_OK == result) { + result = WriteInt32(interp, pngPtr, chunkType, &crc); + } + + /* + * Write the contents (if any). + */ + + if (TCL_OK == result) { + result = WriteData(interp, pngPtr, dataPtr, dataSize, &crc); + } + + /* + * Write out the CRC at the end of the chunk. + */ + + if (TCL_OK == result) { + result = WriteInt32(interp, pngPtr, crc, NULL); + } + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * WriteIHDR -- + * + * This function writes the PNG header at the beginning of a PNG file, + * which includes information such as dimensions and color type. + * + * Results: + * TCL_OK, or TCL_ERROR if the write fails. + * + * Side effects: + * File or buffer will be modified. + * + *---------------------------------------------------------------------- + */ + +static int +WriteIHDR( + Tcl_Interp *interp, + PNGImage *pngPtr, + Tk_PhotoImageBlock *blockPtr) +{ + unsigned long crc = Tcl_ZlibCRC32(0, NULL, 0); + int result = TCL_OK; + + /* + * The IHDR (header) chunk has a fixed size of 13 bytes. + */ + + result = WriteInt32(interp, pngPtr, 13, NULL); + + /* + * Write the IHDR Chunk Type. + */ + + if (TCL_OK == result) { + result = WriteInt32(interp, pngPtr, CHUNK_IHDR, &crc); + } + + /* + * Write the image width, height. + */ + + if (TCL_OK == result) { + result = WriteInt32(interp, pngPtr, (unsigned long) blockPtr->width, + &crc); + } + + if (TCL_OK == result) { + result = WriteInt32(interp, pngPtr, (unsigned long) blockPtr->height, + &crc); + } + + /* + * Write bit depth. Although the PNG format supports 16 bits per channel, + * Tk supports only 8 in the internal representation, which blockPtr + * points to. + */ + + if (TCL_OK == result) { + result = WriteByte(interp, pngPtr, 8, &crc); + } + + /* + * Write out the color type, previously determined. + */ + + if (TCL_OK == result) { + result = WriteByte(interp, pngPtr, pngPtr->colorType, &crc); + } + + /* + * Write compression method (only one method is defined). + */ + + if (TCL_OK == result) { + result = WriteByte(interp, pngPtr, PNG_COMPRESS_DEFLATE, &crc); + } + + /* + * Write filter method (only one method is defined). + */ + + if (TCL_OK == result) { + result = WriteByte(interp, pngPtr, PNG_FILTMETH_STANDARD, &crc); + } + + /* + * Write interlace method as not interlaced. + * + * TODO: support interlace through -format? + */ + + if (TCL_OK == result) { + result = WriteByte(interp, pngPtr, PNG_INTERLACE_NONE, &crc); + } + + /* + * Write out the CRC at the end of the chunk. + */ + + if (TCL_OK == result) { + result = WriteInt32(interp, pngPtr, crc, NULL); + } + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * WriteIDAT -- + * + * Writes the IDAT (data) chunk to the PNG image, containing the pixel + * channel data. Currently, image lines are not filtered and writing + * interlaced pixels is not supported. + * + * Results: + * TCL_OK, or TCL_ERROR if the write fails. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +WriteIDAT( + Tcl_Interp *interp, + PNGImage *pngPtr, + Tk_PhotoImageBlock *blockPtr) +{ + int rowNum, flush = TCL_ZLIB_NO_FLUSH, outputSize, result; + Tcl_Obj *outputObj; + unsigned char *outputBytes; + + /* + * Filter and compress each row one at a time. + */ + + for (rowNum=0 ; rowNum < blockPtr->height ; rowNum++) { + int colNum; + unsigned char *srcPtr, *destPtr; + + srcPtr = blockPtr->pixelPtr + (rowNum * blockPtr->pitch); + destPtr = Tcl_SetByteArrayLength(pngPtr->thisLineObj, + pngPtr->lineSize); + + /* + * TODO: use Paeth filtering. + */ + + *destPtr++ = PNG_FILTER_NONE; + + /* + * Copy each pixel into the destination buffer after the filter type + * before filtering. + */ + + for (colNum = 0 ; colNum < blockPtr->width ; colNum++) { + /* + * Copy red or gray channel. + */ + + *destPtr++ = srcPtr[blockPtr->offset[0]]; + + /* + * If not grayscale, copy the green and blue channels. + */ + + if (pngPtr->colorType & PNG_COLOR_USED) { + *destPtr++ = srcPtr[blockPtr->offset[1]]; + *destPtr++ = srcPtr[blockPtr->offset[2]]; + } + + /* + * Copy the alpha channel, if used. + */ + + if (pngPtr->colorType & PNG_COLOR_ALPHA) { + *destPtr++ = srcPtr[blockPtr->offset[3]]; + } + + /* + * Point to the start of the next pixel. + */ + + srcPtr += blockPtr->pixelSize; + } + + /* + * Compress the line of pixels into the destination. If this is the + * last line, finalize the compressor at the same time. Note that this + * can't be just a flush; that leads to a file that some PNG readers + * choke on. [Bug 2984787] + */ + + if (rowNum + 1 == blockPtr->height) { + flush = TCL_ZLIB_FINALIZE; + } + if (Tcl_ZlibStreamPut(pngPtr->stream, pngPtr->thisLineObj, + flush) != TCL_OK) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "deflate() returned error", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "DEFLATE", NULL); + return TCL_ERROR; + } + + /* + * Swap line buffers to keep the last around for filtering next. + */ + + { + Tcl_Obj *temp = pngPtr->lastLineObj; + + pngPtr->lastLineObj = pngPtr->thisLineObj; + pngPtr->thisLineObj = temp; + } + } + + /* + * Now get the compressed data and write it as one big IDAT chunk. + */ + + outputObj = Tcl_NewObj(); + (void) Tcl_ZlibStreamGet(pngPtr->stream, outputObj, -1); + outputBytes = Tcl_GetByteArrayFromObj(outputObj, &outputSize); + result = WriteChunk(interp, pngPtr, CHUNK_IDAT, outputBytes, outputSize); + Tcl_DecrRefCount(outputObj); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * WriteExtraChunks -- + * + * Writes an sBIT and a tEXt chunks to the PNG image, describing a bunch + * of not very important metadata that many readers seem to need anyway. + * + * Results: + * TCL_OK, or TCL_ERROR if the write fails. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +WriteExtraChunks( + Tcl_Interp *interp, + PNGImage *pngPtr) +{ + static const unsigned char sBIT_contents[] = { + 8, 8, 8, 8 + }; + int sBIT_length = 4; + Tcl_DString buf; + + /* + * Each byte of each channel is always significant; we always write RGBA + * images with 8 bits per channel as that is what the photo image's basic + * data model is. + */ + + switch (pngPtr->colorType) { + case PNG_COLOR_GRAY: + sBIT_length = 1; + break; + case PNG_COLOR_GRAYALPHA: + sBIT_length = 2; + break; + case PNG_COLOR_RGB: + case PNG_COLOR_PLTE: + sBIT_length = 3; + break; + case PNG_COLOR_RGBA: + sBIT_length = 4; + break; + } + if (WriteChunk(interp, pngPtr, CHUNK_sBIT, sBIT_contents, sBIT_length) + != TCL_OK) { + return TCL_ERROR; + } + + /* + * Say that it is Tk that made the PNG. Note that we *need* the NUL at the + * end of "Software" to be transferred; do *not* change the length + * parameter to -1 there! + */ + + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, "Software", 9); + Tcl_DStringAppend(&buf, "Tk Toolkit v", -1); + Tcl_DStringAppend(&buf, TK_PATCH_LEVEL, -1); + if (WriteChunk(interp, pngPtr, CHUNK_tEXt, + (unsigned char *) Tcl_DStringValue(&buf), + Tcl_DStringLength(&buf)) != TCL_OK) { + Tcl_DStringFree(&buf); + return TCL_ERROR; + } + Tcl_DStringFree(&buf); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * EncodePNG -- + * + * This function handles the entirety of writing a PNG file (or data) + * from the first byte to the last. No effort is made to optimize the + * image data for best compression. + * + * Results: + * TCL_OK, or TCL_ERROR if an I/O or memory error occurs. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +EncodePNG( + Tcl_Interp *interp, + Tk_PhotoImageBlock *blockPtr, + PNGImage *pngPtr) +{ + int greenOffset, blueOffset, alphaOffset; + + /* + * Determine appropriate color type based on color usage (e.g., only red + * and maybe alpha channel = grayscale). + * + * TODO: Check whether this is doing any good; Tk might just be pushing + * full RGBA data all the time through here, even though the actual image + * doesn't need it... + */ + + greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; + blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; + alphaOffset = blockPtr->offset[3]; + if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) { + alphaOffset = 0; + } else { + alphaOffset -= blockPtr->offset[0]; + } + + if ((greenOffset != 0) || (blueOffset != 0)) { + if (alphaOffset) { + pngPtr->colorType = PNG_COLOR_RGBA; + pngPtr->bytesPerPixel = 4; + } else { + pngPtr->colorType = PNG_COLOR_RGB; + pngPtr->bytesPerPixel = 3; + } + } else { + if (alphaOffset) { + pngPtr->colorType = PNG_COLOR_GRAYALPHA; + pngPtr->bytesPerPixel = 2; + } else { + pngPtr->colorType = PNG_COLOR_GRAY; + pngPtr->bytesPerPixel = 1; + } + } + + /* + * Allocate buffers for lines for filtering and compressed data. + */ + + pngPtr->lineSize = 1 + (pngPtr->bytesPerPixel * blockPtr->width); + pngPtr->blockLen = pngPtr->lineSize * blockPtr->height; + + if ((blockPtr->width > (INT_MAX - 1) / (pngPtr->bytesPerPixel)) || + (blockPtr->height > INT_MAX / pngPtr->lineSize)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "image is too large to encode pixel data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PNG", "TOO_LARGE", NULL); + return TCL_ERROR; + } + + pngPtr->lastLineObj = Tcl_NewObj(); + Tcl_IncrRefCount(pngPtr->lastLineObj); + pngPtr->thisLineObj = Tcl_NewObj(); + Tcl_IncrRefCount(pngPtr->thisLineObj); + + /* + * Write out the PNG Signature that all PNGs begin with. + */ + + if (WriteData(interp, pngPtr, pngSignature, PNG_SIG_SZ, + NULL) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Write out the IHDR (header) chunk containing image dimensions, color + * type, etc. + */ + + if (WriteIHDR(interp, pngPtr, blockPtr) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Write out the extra chunks containing metadata that is of interest to + * other programs more than us. + */ + + if (WriteExtraChunks(interp, pngPtr) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Write out the image pixels in the IDAT (data) chunk. + */ + + if (WriteIDAT(interp, pngPtr, blockPtr) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Write out the IEND chunk that all PNGs end with. + */ + + return WriteChunk(interp, pngPtr, CHUNK_IEND, NULL, 0); +} + +/* + *---------------------------------------------------------------------- + * + * FileWritePNG -- + * + * This function is called by the photo image type to write PNG format + * data to a file. + * + * Results: + * A standard TCL completion code. If TCL_ERROR is returned then an error + * message is left in the interp's result. + * + * Side effects: + * The specified file is overwritten. + * + *---------------------------------------------------------------------- + */ + +static int +FileWritePNG( + Tcl_Interp *interp, + const char *filename, + Tcl_Obj *fmtObj, + Tk_PhotoImageBlock *blockPtr) +{ + Tcl_Channel chan; + PNGImage png; + int result = TCL_ERROR; + + /* + * Open a Tcl file channel where the image data will be stored. Tk ought + * to take care of this, and just provide a channel, but it doesn't. + */ + + chan = Tcl_OpenFileChannel(interp, filename, "w", 0644); + + if (!chan) { + return TCL_ERROR; + } + + /* + * Initalize PNGImage instance for encoding. + */ + + if (InitPNGImage(interp, &png, chan, NULL, + TCL_ZLIB_STREAM_DEFLATE) == TCL_ERROR) { + goto cleanup; + } + + /* + * Set the translation mode to binary so that CR and LF are not to the + * platform's EOL sequence. + */ + + if (Tcl_SetChannelOption(interp, chan, "-translation", + "binary") != TCL_OK) { + goto cleanup; + } + + /* + * Write the raw PNG data out to the file. + */ + + result = EncodePNG(interp, blockPtr, &png); + + cleanup: + Tcl_Close(interp, chan); + CleanupPNGImage(&png); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * StringWritePNG -- + * + * This function is called by the photo image type to write PNG format + * data to a Tcl object and return it in the result. + * + * Results: + * A standard TCL completion code. If TCL_ERROR is returned then an error + * message is left in the interp's result. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +StringWritePNG( + Tcl_Interp *interp, + Tcl_Obj *fmtObj, + Tk_PhotoImageBlock *blockPtr) +{ + Tcl_Obj *resultObj = Tcl_NewObj(); + PNGImage png; + int result = TCL_ERROR; + + /* + * Initalize PNGImage instance for encoding. + */ + + if (InitPNGImage(interp, &png, NULL, resultObj, + TCL_ZLIB_STREAM_DEFLATE) == TCL_ERROR) { + goto cleanup; + } + + /* + * Write the raw PNG data into the prepared Tcl_Obj buffer. Set the result + * back to the interpreter if successful. + */ + + result = EncodePNG(interp, blockPtr, &png); + + if (TCL_OK == result) { + Tcl_SetObjResult(interp, png.objDataPtr); + } + + cleanup: + CleanupPNGImage(&png); + return result; +} + +/* + * Local Variables: + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tkImgPPM.c b/generic/tkImgPPM.c index ddd16b2..6f084f0 100644 --- a/generic/tkImgPPM.c +++ b/generic/tkImgPPM.c @@ -34,14 +34,14 @@ * The format record for the PPM file format: */ -static int FileMatchPPM(Tcl_Channel chan, CONST char *fileName, +static int FileMatchPPM(Tcl_Channel chan, const char *fileName, Tcl_Obj *format, int *widthPtr, int *heightPtr, Tcl_Interp *interp); static int FileReadPPM(Tcl_Interp *interp, Tcl_Channel chan, - CONST char *fileName, Tcl_Obj *format, + const char *fileName, Tcl_Obj *format, Tk_PhotoHandle imageHandle, int destX, int destY, int width, int height, int srcX, int srcY); -static int FileWritePPM(Tcl_Interp *interp, CONST char *fileName, +static int FileWritePPM(Tcl_Interp *interp, const char *fileName, Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr); static int StringWritePPM(Tcl_Interp *interp, Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr); @@ -60,6 +60,7 @@ Tk_PhotoImageFormat tkImgFmtPPM = { StringReadPPM, /* stringReadProc */ FileWritePPM, /* fileWriteProc */ StringWritePPM, /* stringWriteProc */ + NULL }; /* @@ -93,7 +94,7 @@ static int ReadPPMStringHeader(Tcl_Obj *dataObj, int *widthPtr, static int FileMatchPPM( Tcl_Channel chan, /* The image file, open for reading. */ - CONST char *fileName, /* The name of the image file. */ + const char *fileName, /* The name of the image file. */ Tcl_Obj *format, /* User-specified format string, or NULL. */ int *widthPtr, int *heightPtr, /* The dimensions of the image are returned @@ -129,7 +130,7 @@ static int FileReadPPM( Tcl_Interp *interp, /* Interpreter to use for reporting errors. */ Tcl_Channel chan, /* The image file, open for reading. */ - CONST char *fileName, /* The name of the image file. */ + const char *fileName, /* The name of the image file. */ Tcl_Obj *format, /* User-specified format string, or NULL. */ Tk_PhotoHandle imageHandle, /* The photo image to write into. */ int destX, int destY, /* Coordinates of top-left pixel in photo @@ -146,21 +147,22 @@ FileReadPPM( type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity); if (type == 0) { - Tcl_AppendResult(interp, "couldn't read raw PPM header from file \"", - fileName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read raw PPM header from file \"%s\"", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "PPM image file \"", fileName, - "\" has dimension(s) <= 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image file \"%s\" has dimension(s) <= 0", fileName)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity > 0xffff)) { - char buffer[TCL_INTEGER_SPACE]; - - sprintf(buffer, "%d", maxIntensity); - Tcl_AppendResult(interp, "PPM image file \"", fileName, - "\" has bad maximum intensity value ", buffer, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image file \"%s\" has bad maximum intensity value %d", + fileName, maxIntensity)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } else if (maxIntensity > 0x00ff) { bytesPerChannel = 2; @@ -209,7 +211,7 @@ FileReadPPM( nLines = 1; } nBytes = nLines * block.pitch; - pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes); + pixelPtr = ckalloc(nBytes); block.pixelPtr = pixelPtr + srcX * block.pixelSize; for (h = height; h > 0; h -= nLines) { @@ -219,11 +221,13 @@ FileReadPPM( } count = Tcl_Read(chan, (char *) pixelPtr, nBytes); if (count != nBytes) { - Tcl_AppendResult(interp, "error reading PPM image file \"", - fileName, "\": ", - Tcl_Eof(chan) ? "not enough data" : Tcl_PosixError(interp), - NULL); - ckfree((char *) pixelPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading PPM image file \"%s\": %s", fileName, + Tcl_Eof(chan)?"not enough data":Tcl_PosixError(interp))); + if (Tcl_Eof(chan)) { + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "EOF", NULL); + } + ckfree(pixelPtr); return TCL_ERROR; } if (maxIntensity < 0x00ff) { @@ -245,13 +249,13 @@ FileReadPPM( block.height = nLines; if (Tk_PhotoPutBlock(interp, imageHandle, &block, destX, destY, width, nLines, TK_PHOTO_COMPOSITE_SET) != TCL_OK) { - ckfree((char *) pixelPtr); + ckfree(pixelPtr); return TCL_ERROR; } destY += nLines; } - ckfree((char *) pixelPtr); + ckfree(pixelPtr); return TCL_OK; } @@ -276,7 +280,7 @@ FileReadPPM( static int FileWritePPM( Tcl_Interp *interp, - CONST char *fileName, + const char *fileName, Tcl_Obj *format, Tk_PhotoImageBlock *blockPtr) { @@ -335,8 +339,8 @@ FileWritePPM( chan = NULL; writeerror: - Tcl_AppendResult(interp, "error writing \"", fileName, "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s", + fileName, Tcl_PosixError(interp))); if (chan != NULL) { Tcl_Close(NULL, chan); } @@ -492,22 +496,22 @@ StringReadPPM( type = ReadPPMStringHeader(dataObj, &fileWidth, &fileHeight, &maxIntensity, &dataBuffer, &dataSize); if (type == 0) { - Tcl_AppendResult(interp, "couldn't read raw PPM header from string", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't read raw PPM header from string", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "NO_HEADER", NULL); return TCL_ERROR; } if ((fileWidth <= 0) || (fileHeight <= 0)) { - Tcl_AppendResult(interp, "PPM image data has dimension(s) <= 0", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "PPM image data has dimension(s) <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "DIMENSIONS", NULL); return TCL_ERROR; } if ((maxIntensity <= 0) || (maxIntensity > 0xffff)) { - char buffer[TCL_INTEGER_SPACE]; - - sprintf(buffer, "%d", maxIntensity); - Tcl_AppendResult(interp, - "PPM image data has bad maximum intensity value ", buffer, - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "PPM image data has bad maximum intensity value %d", + maxIntensity)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "INTENSITY", NULL); return TCL_ERROR; } else if (maxIntensity > 0x00ff) { bytesPerChannel = 2; @@ -550,7 +554,9 @@ StringReadPPM( */ if (block.pitch*height > dataSize) { - Tcl_AppendResult(interp, "truncated PPM data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "truncated PPM data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } block.pixelPtr = dataBuffer + srcX * block.pixelSize; @@ -572,7 +578,7 @@ StringReadPPM( nLines = 1; } nBytes = nLines * block.pitch; - pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes); + pixelPtr = ckalloc(nBytes); block.pixelPtr = pixelPtr + srcX * block.pixelSize; for (h = height; h > 0; h -= nLines) { @@ -583,8 +589,10 @@ StringReadPPM( nBytes = nLines * block.pitch; } if (dataSize < nBytes) { - ckfree((char *) pixelPtr); - Tcl_AppendResult(interp, "truncated PPM data", NULL); + ckfree(pixelPtr); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "truncated PPM data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PPM", "TRUNCATED", NULL); return TCL_ERROR; } if (maxIntensity < 0x00ff) { @@ -605,13 +613,13 @@ StringReadPPM( block.height = nLines; if (Tk_PhotoPutBlock(interp, imageHandle, &block, destX, destY, width, nLines, TK_PHOTO_COMPOSITE_SET) != TCL_OK) { - ckfree((char *) pixelPtr); + ckfree(pixelPtr); return TCL_ERROR; } destY += nLines; } - ckfree((char *) pixelPtr); + ckfree(pixelPtr); return TCL_OK; } diff --git a/generic/tkImgPhInstance.c b/generic/tkImgPhInstance.c new file mode 100644 index 0000000..666a9b0 --- /dev/null +++ b/generic/tkImgPhInstance.c @@ -0,0 +1,1966 @@ +/* + * tkImgPhInstance.c -- + * + * Implements the rendering of images of type "photo" for Tk. Photo + * images are stored in full color (32 bits per pixel including alpha + * channel) and displayed using dithering if necessary. + * + * Copyright (c) 1994 The Australian National University. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 2002-2008 Donal K. Fellows + * Copyright (c) 2003 ActiveState Corporation. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * Author: Paul Mackerras (paulus@cs.anu.edu.au), + * Department of Computer Science, + * Australian National University. + */ + +#include "tkImgPhoto.h" + +/* + * Declaration for internal Xlib function used here: + */ + +extern int _XInitImageFuncPtrs(XImage *image); + +/* + * Forward declarations + */ + +static void BlendComplexAlpha(XImage *bgImg, PhotoInstance *iPtr, + int xOffset, int yOffset, int width, int height); +static int IsValidPalette(PhotoInstance *instancePtr, + const char *palette); +static int CountBits(pixel mask); +static void GetColorTable(PhotoInstance *instancePtr); +static void FreeColorTable(ColorTable *colorPtr, int force); +static void AllocateColors(ColorTable *colorPtr); +static void DisposeColorTable(ClientData clientData); +static int ReclaimColors(ColorTableId *id, int numColors); + +/* + * Hash table used to hash from (display, colormap, palette, gamma) to + * ColorTable address. + */ + +static Tcl_HashTable imgPhotoColorHash; +static int imgPhotoColorHashInitialized; +#define N_COLOR_HASH (sizeof(ColorTableId) / sizeof(int)) + +/* + *---------------------------------------------------------------------- + * + * TkImgPhotoConfigureInstance -- + * + * This function is called to create displaying information for a photo + * image instance based on the configuration information in the master. + * It is invoked both when new instances are created and when the master + * is reconfigured. + * + * Results: + * None. + * + * Side effects: + * Generates errors via Tcl_BackgroundException if there are problems in + * setting up the instance. + * + *---------------------------------------------------------------------- + */ + +void +TkImgPhotoConfigureInstance( + PhotoInstance *instancePtr) /* Instance to reconfigure. */ +{ + PhotoMaster *masterPtr = instancePtr->masterPtr; + XImage *imagePtr; + int bitsPerPixel; + ColorTable *colorTablePtr; + XRectangle validBox; + + /* + * If the -palette configuration option has been set for the master, use + * the value specified for our palette, but only if it is a valid palette + * for our windows. Use the gamma value specified the master. + */ + + if ((masterPtr->palette && masterPtr->palette[0]) + && IsValidPalette(instancePtr, masterPtr->palette)) { + instancePtr->palette = masterPtr->palette; + } else { + instancePtr->palette = instancePtr->defaultPalette; + } + instancePtr->gamma = masterPtr->gamma; + + /* + * If we don't currently have a color table, or if the one we have no + * longer applies (e.g. because our palette or gamma has changed), get a + * new one. + */ + + colorTablePtr = instancePtr->colorTablePtr; + if ((colorTablePtr == NULL) + || (instancePtr->colormap != colorTablePtr->id.colormap) + || (instancePtr->palette != colorTablePtr->id.palette) + || (instancePtr->gamma != colorTablePtr->id.gamma)) { + /* + * Free up our old color table, and get a new one. + */ + + if (colorTablePtr != NULL) { + colorTablePtr->liveRefCount -= 1; + FreeColorTable(colorTablePtr, 0); + } + GetColorTable(instancePtr); + + /* + * Create a new XImage structure for sending data to the X server, if + * necessary. + */ + + if (instancePtr->colorTablePtr->flags & BLACK_AND_WHITE) { + bitsPerPixel = 1; + } else { + bitsPerPixel = instancePtr->visualInfo.depth; + } + + if ((instancePtr->imagePtr == NULL) + || (instancePtr->imagePtr->bits_per_pixel != bitsPerPixel)) { + if (instancePtr->imagePtr != NULL) { + XDestroyImage(instancePtr->imagePtr); + } + imagePtr = XCreateImage(instancePtr->display, + instancePtr->visualInfo.visual, (unsigned) bitsPerPixel, + (bitsPerPixel > 1? ZPixmap: XYBitmap), 0, NULL, + 1, 1, 32, 0); + instancePtr->imagePtr = imagePtr; + + /* + * We create images using the local host's endianness, rather than + * the endianness of the server; otherwise we would have to + * byte-swap any 16 or 32 bit values that we store in the image + * if the server's endianness is different from ours. + */ + + if (imagePtr != NULL) { +#ifdef WORDS_BIGENDIAN + imagePtr->byte_order = MSBFirst; +#else + imagePtr->byte_order = LSBFirst; +#endif + _XInitImageFuncPtrs(imagePtr); + } + } + } + + /* + * If the user has specified a width and/or height for the master which is + * different from our current width/height, set the size to the values + * specified by the user. If we have no pixmap, we do this also, since it + * has the side effect of allocating a pixmap for us. + */ + + if ((instancePtr->pixels == None) || (instancePtr->error == NULL) + || (instancePtr->width != masterPtr->width) + || (instancePtr->height != masterPtr->height)) { + TkImgPhotoInstanceSetSize(instancePtr); + } + + /* + * Redither this instance if necessary. + */ + + if ((masterPtr->flags & IMAGE_CHANGED) + || (instancePtr->colorTablePtr != colorTablePtr)) { + TkClipBox(masterPtr->validRegion, &validBox); + if ((validBox.width > 0) && (validBox.height > 0)) { + TkImgDitherInstance(instancePtr, validBox.x, validBox.y, + validBox.width, validBox.height); + } + } +} + +/* + *---------------------------------------------------------------------- + * + * TkImgPhotoGet -- + * + * This function is called for each use of a photo image in a widget. + * + * Results: + * The return value is a token for the instance, which is passed back to + * us in calls to TkImgPhotoDisplay and ImgPhotoFree. + * + * Side effects: + * A data structure is set up for the instance (or, an existing instance + * is re-used for the new one). + * + *---------------------------------------------------------------------- + */ + +ClientData +TkImgPhotoGet( + Tk_Window tkwin, /* Window in which the instance will be + * used. */ + ClientData masterData) /* Pointer to our master structure for the + * image. */ +{ + PhotoMaster *masterPtr = masterData; + PhotoInstance *instancePtr; + Colormap colormap; + int mono, nRed, nGreen, nBlue, numVisuals; + XVisualInfo visualInfo, *visInfoPtr; + char buf[TCL_INTEGER_SPACE * 3]; + XColor *white, *black; + XGCValues gcValues; + + /* + * Table of "best" choices for palette for PseudoColor displays with + * between 3 and 15 bits/pixel. + */ + + static const int paletteChoice[13][3] = { + /* #red, #green, #blue */ + {2, 2, 2, /* 3 bits, 8 colors */}, + {2, 3, 2, /* 4 bits, 12 colors */}, + {3, 4, 2, /* 5 bits, 24 colors */}, + {4, 5, 3, /* 6 bits, 60 colors */}, + {5, 6, 4, /* 7 bits, 120 colors */}, + {7, 7, 4, /* 8 bits, 198 colors */}, + {8, 10, 6, /* 9 bits, 480 colors */}, + {10, 12, 8, /* 10 bits, 960 colors */}, + {14, 15, 9, /* 11 bits, 1890 colors */}, + {16, 20, 12, /* 12 bits, 3840 colors */}, + {20, 24, 16, /* 13 bits, 7680 colors */}, + {26, 30, 20, /* 14 bits, 15600 colors */}, + {32, 32, 30, /* 15 bits, 30720 colors */} + }; + + /* + * See if there is already an instance for windows using the same + * colormap. If so then just re-use it. + */ + + colormap = Tk_Colormap(tkwin); + for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; + instancePtr = instancePtr->nextPtr) { + if ((colormap == instancePtr->colormap) + && (Tk_Display(tkwin) == instancePtr->display)) { + /* + * Re-use this instance. + */ + + if (instancePtr->refCount == 0) { + /* + * We are resurrecting this instance. + */ + + Tcl_CancelIdleCall(TkImgDisposeInstance, instancePtr); + if (instancePtr->colorTablePtr != NULL) { + FreeColorTable(instancePtr->colorTablePtr, 0); + } + GetColorTable(instancePtr); + } + instancePtr->refCount++; + return instancePtr; + } + } + + /* + * The image isn't already in use in a window with the same colormap. Make + * a new instance of the image. + */ + + instancePtr = ckalloc(sizeof(PhotoInstance)); + instancePtr->masterPtr = masterPtr; + instancePtr->display = Tk_Display(tkwin); + instancePtr->colormap = Tk_Colormap(tkwin); + Tk_PreserveColormap(instancePtr->display, instancePtr->colormap); + instancePtr->refCount = 1; + instancePtr->colorTablePtr = NULL; + instancePtr->pixels = None; + instancePtr->error = NULL; + instancePtr->width = 0; + instancePtr->height = 0; + instancePtr->imagePtr = 0; + instancePtr->nextPtr = masterPtr->instancePtr; + masterPtr->instancePtr = instancePtr; + + /* + * Obtain information about the visual and decide on the default palette. + */ + + visualInfo.screen = Tk_ScreenNumber(tkwin); + visualInfo.visualid = XVisualIDFromVisual(Tk_Visual(tkwin)); + visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), + VisualScreenMask | VisualIDMask, &visualInfo, &numVisuals); + if (visInfoPtr == NULL) { + Tcl_Panic("TkImgPhotoGet couldn't find visual for window"); + } + + nRed = 2; + nGreen = nBlue = 0; + mono = 1; + instancePtr->visualInfo = *visInfoPtr; + switch (visInfoPtr->class) { + case DirectColor: + case TrueColor: + nRed = 1 << CountBits(visInfoPtr->red_mask); + nGreen = 1 << CountBits(visInfoPtr->green_mask); + nBlue = 1 << CountBits(visInfoPtr->blue_mask); + mono = 0; + break; + case PseudoColor: + case StaticColor: + if (visInfoPtr->depth > 15) { + nRed = 32; + nGreen = 32; + nBlue = 32; + mono = 0; + } else if (visInfoPtr->depth >= 3) { + const int *ip = paletteChoice[visInfoPtr->depth - 3]; + + nRed = ip[0]; + nGreen = ip[1]; + nBlue = ip[2]; + mono = 0; + } + break; + case GrayScale: + case StaticGray: + nRed = 1 << visInfoPtr->depth; + break; + } + XFree((char *) visInfoPtr); + + if (mono) { + sprintf(buf, "%d", nRed); + } else { + sprintf(buf, "%d/%d/%d", nRed, nGreen, nBlue); + } + instancePtr->defaultPalette = Tk_GetUid(buf); + + /* + * Make a GC with background = black and foreground = white. + */ + + white = Tk_GetColor(masterPtr->interp, tkwin, "white"); + black = Tk_GetColor(masterPtr->interp, tkwin, "black"); + gcValues.foreground = (white != NULL)? white->pixel: + WhitePixelOfScreen(Tk_Screen(tkwin)); + gcValues.background = (black != NULL)? black->pixel: + BlackPixelOfScreen(Tk_Screen(tkwin)); + Tk_FreeColor(white); + Tk_FreeColor(black); + gcValues.graphics_exposures = False; + instancePtr->gc = Tk_GetGC(tkwin, + GCForeground|GCBackground|GCGraphicsExposures, &gcValues); + + /* + * Set configuration options and finish the initialization of the + * instance. This will also dither the image if necessary. + */ + + TkImgPhotoConfigureInstance(instancePtr); + + /* + * If this is the first instance, must set the size of the image. + */ + + if (instancePtr->nextPtr == NULL) { + Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, + masterPtr->width, masterPtr->height); + } + + return instancePtr; +} + +/* + *---------------------------------------------------------------------- + * + * BlendComplexAlpha -- + * + * This function is called when an image with partially transparent + * pixels must be drawn over another image. It blends the photo data onto + * a local copy of the surface that we are drawing on, *including* the + * pixels drawn by everything that should be drawn underneath the image. + * + * Much of this code has hard-coded values in for speed because this + * routine is performance critical for complex image drawing. + * + * Results: + * None. + * + * Side effects: + * Background image passed in gets drawn over with image data. + * + * Notes: + * This should work on all platforms that set mask and shift data + * properly from the visualInfo. RGB is really only a 24+ bpp version + * whereas RGB15 is the correct version and works for 15bpp+, but it + * slower, so it's only used for 15bpp+. + * + * Note that Win32 pre-defines those operations that we really need. + * + *---------------------------------------------------------------------- + */ + +#ifndef _WIN32 +#define GetRValue(rgb) (UCHAR(((rgb) & red_mask) >> red_shift)) +#define GetGValue(rgb) (UCHAR(((rgb) & green_mask) >> green_shift)) +#define GetBValue(rgb) (UCHAR(((rgb) & blue_mask) >> blue_shift)) +#define RGB(r, g, b) ((unsigned)( \ + (UCHAR(r) << red_shift) | \ + (UCHAR(g) << green_shift) | \ + (UCHAR(b) << blue_shift) )) +#define RGB15(r, g, b) ((unsigned)( \ + (((r) * red_mask / 255) & red_mask) | \ + (((g) * green_mask / 255) & green_mask) | \ + (((b) * blue_mask / 255) & blue_mask) )) +#endif /* !_WIN32 */ + +static void +BlendComplexAlpha( + XImage *bgImg, /* Background image to draw on. */ + PhotoInstance *iPtr, /* Image instance to draw. */ + int xOffset, int yOffset, /* X & Y offset into image instance to + * draw. */ + int width, int height) /* Width & height of image to draw. */ +{ + int x, y, line; + unsigned long pixel; + unsigned char r, g, b, alpha, unalpha, *masterPtr; + unsigned char *alphaAr = iPtr->masterPtr->pix32; + + /* + * This blending is an integer version of the Source-Over compositing rule + * (see Porter&Duff, "Compositing Digital Images", proceedings of SIGGRAPH + * 1984) that has been hard-coded (for speed) to work with targetting a + * solid surface. + * + * The 'unalpha' field must be 255-alpha; it is separated out to encourage + * more efficient compilation. + */ + +#define ALPHA_BLEND(bgPix, imgPix, alpha, unalpha) \ + ((bgPix * unalpha + imgPix * alpha) / 255) + + /* + * We have to get the mask and shift info from the visual on non-Win32 so + * that the macros Get*Value(), RGB() and RGB15() work correctly. This + * might be cached for better performance. + */ + +#ifndef _WIN32 + unsigned long red_mask, green_mask, blue_mask; + unsigned long red_shift, green_shift, blue_shift; + Visual *visual = iPtr->visualInfo.visual; + + red_mask = visual->red_mask; + green_mask = visual->green_mask; + blue_mask = visual->blue_mask; + red_shift = 0; + green_shift = 0; + blue_shift = 0; + while ((0x0001 & (red_mask >> red_shift)) == 0) { + red_shift++; + } + while ((0x0001 & (green_mask >> green_shift)) == 0) { + green_shift++; + } + while ((0x0001 & (blue_mask >> blue_shift)) == 0) { + blue_shift++; + } +#endif /* !_WIN32 */ + + /* + * Only UNIX requires the special case for <24bpp. It varies with 3 extra + * shifts and uses RGB15. The 24+bpp version could also then be further + * optimized. + */ + +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) + if (bgImg->depth < 24) { + unsigned char red_mlen, green_mlen, blue_mlen; + + red_mlen = 8 - CountBits(red_mask >> red_shift); + green_mlen = 8 - CountBits(green_mask >> green_shift); + blue_mlen = 8 - CountBits(blue_mask >> blue_shift); + for (y = 0; y < height; y++) { + line = (y + yOffset) * iPtr->masterPtr->width; + for (x = 0; x < width; x++) { + masterPtr = alphaAr + ((line + x + xOffset) * 4); + alpha = masterPtr[3]; + + /* + * Ignore pixels that are fully transparent + */ + + if (alpha) { + /* + * We could perhaps be more efficient than XGetPixel for + * 24 and 32 bit displays, but this seems "fast enough". + */ + + r = masterPtr[0]; + g = masterPtr[1]; + b = masterPtr[2]; + if (alpha != 255) { + /* + * Only blend pixels that have some transparency + */ + + unsigned char ra, ga, ba; + + pixel = XGetPixel(bgImg, x, y); + ra = GetRValue(pixel) << red_mlen; + ga = GetGValue(pixel) << green_mlen; + ba = GetBValue(pixel) << blue_mlen; + unalpha = 255 - alpha; /* Calculate once. */ + r = ALPHA_BLEND(ra, r, alpha, unalpha); + g = ALPHA_BLEND(ga, g, alpha, unalpha); + b = ALPHA_BLEND(ba, b, alpha, unalpha); + } + XPutPixel(bgImg, x, y, RGB15(r, g, b)); + } + } + } + return; + } +#endif /* !_WIN32 && !MAC_OSX_TK */ + + for (y = 0; y < height; y++) { + line = (y + yOffset) * iPtr->masterPtr->width; + for (x = 0; x < width; x++) { + masterPtr = alphaAr + ((line + x + xOffset) * 4); + alpha = masterPtr[3]; + + /* + * Ignore pixels that are fully transparent + */ + + if (alpha) { + /* + * We could perhaps be more efficient than XGetPixel for 24 + * and 32 bit displays, but this seems "fast enough". + */ + + r = masterPtr[0]; + g = masterPtr[1]; + b = masterPtr[2]; + if (alpha != 255) { + /* + * Only blend pixels that have some transparency + */ + + unsigned char ra, ga, ba; + + pixel = XGetPixel(bgImg, x, y); + ra = GetRValue(pixel); + ga = GetGValue(pixel); + ba = GetBValue(pixel); + unalpha = 255 - alpha; /* Calculate once. */ + r = ALPHA_BLEND(ra, r, alpha, unalpha); + g = ALPHA_BLEND(ga, g, alpha, unalpha); + b = ALPHA_BLEND(ba, b, alpha, unalpha); + } + XPutPixel(bgImg, x, y, RGB(r, g, b)); + } + } + } +#undef ALPHA_BLEND +} + +/* + *---------------------------------------------------------------------- + * + * TkImgPhotoDisplay -- + * + * This function is invoked to draw a photo image. + * + * Results: + * None. + * + * Side effects: + * A portion of the image gets rendered in a pixmap or window. + * + *---------------------------------------------------------------------- + */ + +void +TkImgPhotoDisplay( + ClientData clientData, /* Pointer to PhotoInstance structure for + * instance to be displayed. */ + Display *display, /* Display on which to draw image. */ + Drawable drawable, /* Pixmap or window in which to draw image. */ + int imageX, int imageY, /* Upper-left corner of region within image to + * draw. */ + int width, int height, /* Dimensions of region within image to + * draw. */ + int drawableX,int drawableY)/* Coordinates within drawable that correspond + * to imageX and imageY. */ +{ + PhotoInstance *instancePtr = clientData; + XVisualInfo visInfo = instancePtr->visualInfo; + + /* + * If there's no pixmap, it means that an error occurred while creating + * the image instance so it can't be displayed. + */ + + if (instancePtr->pixels == None) { + return; + } + + if ((instancePtr->masterPtr->flags & COMPLEX_ALPHA) + && visInfo.depth >= 15 + && (visInfo.class == DirectColor || visInfo.class == TrueColor)) { + Tk_ErrorHandler handler; + XImage *bgImg = NULL; + + /* + * Create an error handler to suppress the case where the input was + * not properly constrained, which can cause an X error. [Bug 979239] + */ + + handler = Tk_CreateErrorHandler(display, -1, -1, -1, NULL, NULL); + + /* + * Pull the current background from the display to blend with + */ + + bgImg = XGetImage(display, drawable, drawableX, drawableY, + (unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap); + if (bgImg == NULL) { + Tk_DeleteErrorHandler(handler); + /* We failed to get the image so draw without blending alpha. It's the best we can do */ + goto fallBack; + } + + BlendComplexAlpha(bgImg, instancePtr, imageX, imageY, width, height); + + /* + * Color info is unimportant as we only do this operation for depth >= + * 15. + */ + + TkPutImage(NULL, 0, display, drawable, instancePtr->gc, + bgImg, 0, 0, drawableX, drawableY, + (unsigned int) width, (unsigned int) height); + XDestroyImage(bgImg); + Tk_DeleteErrorHandler(handler); + } else { + /* + * masterPtr->region describes which parts of the image contain valid + * data. We set this region as the clip mask for the gc, setting its + * origin appropriately, and use it when drawing the image. + */ + + fallBack: + TkSetRegion(display, instancePtr->gc, + instancePtr->masterPtr->validRegion); + XSetClipOrigin(display, instancePtr->gc, drawableX - imageX, + drawableY - imageY); + XCopyArea(display, instancePtr->pixels, drawable, instancePtr->gc, + imageX, imageY, (unsigned) width, (unsigned) height, + drawableX, drawableY); + XSetClipMask(display, instancePtr->gc, None); + XSetClipOrigin(display, instancePtr->gc, 0, 0); + } + XFlush(display); +} + +/* + *---------------------------------------------------------------------- + * + * TkImgPhotoFree -- + * + * This function is called when a widget ceases to use a particular + * instance of an image. We don't actually get rid of the instance until + * later because we may be about to get this instance again. + * + * Results: + * None. + * + * Side effects: + * Internal data structures get cleaned up, later. + * + *---------------------------------------------------------------------- + */ + +void +TkImgPhotoFree( + ClientData clientData, /* Pointer to PhotoInstance structure for + * instance to be displayed. */ + Display *display) /* Display containing window that used + * image. */ +{ + PhotoInstance *instancePtr = clientData; + ColorTable *colorPtr; + + instancePtr->refCount -= 1; + if (instancePtr->refCount > 0) { + return; + } + + /* + * There are no more uses of the image within this widget. Decrement the + * count of live uses of its color table, so that its colors can be + * reclaimed if necessary, and set up an idle call to free the instance + * structure. + */ + + colorPtr = instancePtr->colorTablePtr; + if (colorPtr != NULL) { + colorPtr->liveRefCount -= 1; + } + + Tcl_DoWhenIdle(TkImgDisposeInstance, instancePtr); +} + +/* + *---------------------------------------------------------------------- + * + * TkImgPhotoInstanceSetSize -- + * + * This function reallocates the instance pixmap and dithering error + * array for a photo instance, as necessary, to change the image's size + * to `width' x `height' pixels. + * + * Results: + * None. + * + * Side effects: + * Storage gets reallocated, here and in the X server. + * + *---------------------------------------------------------------------- + */ + +void +TkImgPhotoInstanceSetSize( + PhotoInstance *instancePtr) /* Instance whose size is to be changed. */ +{ + PhotoMaster *masterPtr; + schar *newError, *errSrcPtr, *errDestPtr; + int h, offset; + XRectangle validBox; + Pixmap newPixmap; + + masterPtr = instancePtr->masterPtr; + TkClipBox(masterPtr->validRegion, &validBox); + + if ((instancePtr->width != masterPtr->width) + || (instancePtr->height != masterPtr->height) + || (instancePtr->pixels == None)) { + newPixmap = Tk_GetPixmap(instancePtr->display, + RootWindow(instancePtr->display, + instancePtr->visualInfo.screen), + (masterPtr->width > 0) ? masterPtr->width: 1, + (masterPtr->height > 0) ? masterPtr->height: 1, + instancePtr->visualInfo.depth); + if (!newPixmap) { + Tcl_Panic("Fail to create pixmap with Tk_GetPixmap in TkImgPhotoInstanceSetSize"); + } + + /* + * The following is a gross hack needed to properly support colormaps + * under Windows. Before the pixels can be copied to the pixmap, the + * relevent colormap must be associated with the drawable. Normally we + * can infer this association from the window that was used to create + * the pixmap. However, in this case we're using the root window, so + * we have to be more explicit. + */ + + TkSetPixmapColormap(newPixmap, instancePtr->colormap); + + if (instancePtr->pixels != None) { + /* + * Copy any common pixels from the old pixmap and free it. + */ + + XCopyArea(instancePtr->display, instancePtr->pixels, newPixmap, + instancePtr->gc, validBox.x, validBox.y, + validBox.width, validBox.height, validBox.x, validBox.y); + Tk_FreePixmap(instancePtr->display, instancePtr->pixels); + } + instancePtr->pixels = newPixmap; + } + + if ((instancePtr->width != masterPtr->width) + || (instancePtr->height != masterPtr->height) + || (instancePtr->error == NULL)) { + if (masterPtr->height > 0 && masterPtr->width > 0) { + /* + * TODO: use attemptckalloc() here once there is a strategy that + * will allow us to recover from failure. Right now, there's no + * such possibility. + */ + + newError = ckalloc(masterPtr->height * masterPtr->width + * 3 * sizeof(schar)); + + /* + * Zero the new array so that we don't get bogus error values + * propagating into areas we dither later. + */ + + if ((instancePtr->error != NULL) + && ((instancePtr->width == masterPtr->width) + || (validBox.width == masterPtr->width))) { + if (validBox.y > 0) { + memset(newError, 0, (size_t) + validBox.y * masterPtr->width * 3 * sizeof(schar)); + } + h = validBox.y + validBox.height; + if (h < masterPtr->height) { + memset(newError + h*masterPtr->width*3, 0, + (size_t) (masterPtr->height - h) + * masterPtr->width * 3 * sizeof(schar)); + } + } else { + memset(newError, 0, (size_t) + masterPtr->height * masterPtr->width *3*sizeof(schar)); + } + } else { + newError = NULL; + } + + if (instancePtr->error != NULL) { + /* + * Copy the common area over to the new array and free the old + * array. + */ + + if (masterPtr->width == instancePtr->width) { + offset = validBox.y * masterPtr->width * 3; + memcpy(newError + offset, instancePtr->error + offset, + (size_t) (validBox.height + * masterPtr->width * 3 * sizeof(schar))); + + } else if (validBox.width > 0 && validBox.height > 0) { + errDestPtr = newError + + (validBox.y * masterPtr->width + validBox.x) * 3; + errSrcPtr = instancePtr->error + + (validBox.y * instancePtr->width + validBox.x) * 3; + + for (h = validBox.height; h > 0; --h) { + memcpy(errDestPtr, errSrcPtr, + validBox.width * 3 * sizeof(schar)); + errDestPtr += masterPtr->width * 3; + errSrcPtr += instancePtr->width * 3; + } + } + ckfree(instancePtr->error); + } + + instancePtr->error = newError; + } + + instancePtr->width = masterPtr->width; + instancePtr->height = masterPtr->height; +} + +/* + *---------------------------------------------------------------------- + * + * IsValidPalette -- + * + * This function is called to check whether a value given for the + * -palette option is valid for a particular instance of a photo image. + * + * Results: + * A boolean value: 1 if the palette is acceptable, 0 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +IsValidPalette( + PhotoInstance *instancePtr, /* Instance to which the palette specification + * is to be applied. */ + const char *palette) /* Palette specification string. */ +{ + int nRed, nGreen, nBlue, mono, numColors; + char *endp; + + /* + * First parse the specification: it must be of the form %d or %d/%d/%d. + */ + + nRed = strtol(palette, &endp, 10); + if ((endp == palette) || ((*endp != 0) && (*endp != '/')) + || (nRed < 2) || (nRed > 256)) { + return 0; + } + + if (*endp == 0) { + mono = 1; + nGreen = nBlue = nRed; + } else { + palette = endp + 1; + nGreen = strtol(palette, &endp, 10); + if ((endp == palette) || (*endp != '/') || (nGreen < 2) + || (nGreen > 256)) { + return 0; + } + palette = endp + 1; + nBlue = strtol(palette, &endp, 10); + if ((endp == palette) || (*endp != 0) || (nBlue < 2) + || (nBlue > 256)) { + return 0; + } + mono = 0; + } + + switch (instancePtr->visualInfo.class) { + case DirectColor: + case TrueColor: + if ((nRed > (1 << CountBits(instancePtr->visualInfo.red_mask))) + || (nGreen>(1<<CountBits(instancePtr->visualInfo.green_mask))) + || (nBlue>(1<<CountBits(instancePtr->visualInfo.blue_mask)))) { + return 0; + } + break; + case PseudoColor: + case StaticColor: + numColors = nRed; + if (!mono) { + numColors *= nGreen * nBlue; + } + if (numColors > (1 << instancePtr->visualInfo.depth)) { + return 0; + } + break; + case GrayScale: + case StaticGray: + if (!mono || (nRed > (1 << instancePtr->visualInfo.depth))) { + return 0; + } + break; + } + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * CountBits -- + * + * This function counts how many bits are set to 1 in `mask'. + * + * Results: + * The integer number of bits. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +CountBits( + pixel mask) /* Value to count the 1 bits in. */ +{ + int n; + + for (n=0 ; mask!=0 ; mask&=mask-1) { + n++; + } + return n; +} + +/* + *---------------------------------------------------------------------- + * + * GetColorTable -- + * + * This function is called to allocate a table of colormap information + * for an instance of a photo image. Only one such table is allocated for + * all photo instances using the same display, colormap, palette and + * gamma values, so that the application need only request a set of + * colors from the X server once for all such photo widgets. This + * function maintains a hash table to find previously-allocated + * ColorTables. + * + * Results: + * None. + * + * Side effects: + * A new ColorTable may be allocated and placed in the hash table, and + * have colors allocated for it. + * + *---------------------------------------------------------------------- + */ + +static void +GetColorTable( + PhotoInstance *instancePtr) /* Instance needing a color table. */ +{ + ColorTable *colorPtr; + Tcl_HashEntry *entry; + ColorTableId id; + int isNew; + + /* + * Look for an existing ColorTable in the hash table. + */ + + memset(&id, 0, sizeof(id)); + id.display = instancePtr->display; + id.colormap = instancePtr->colormap; + id.palette = instancePtr->palette; + id.gamma = instancePtr->gamma; + if (!imgPhotoColorHashInitialized) { + Tcl_InitHashTable(&imgPhotoColorHash, N_COLOR_HASH); + imgPhotoColorHashInitialized = 1; + } + entry = Tcl_CreateHashEntry(&imgPhotoColorHash, (char *) &id, &isNew); + + if (!isNew) { + /* + * Re-use the existing entry. + */ + + colorPtr = Tcl_GetHashValue(entry); + } else { + /* + * No color table currently available; need to make one. + */ + + colorPtr = ckalloc(sizeof(ColorTable)); + + /* + * The following line of code should not normally be needed due to the + * assignment in the following line. However, it compensates for bugs + * in some compilers (HP, for example) where sizeof(ColorTable) is 24 + * but the assignment only copies 20 bytes, leaving 4 bytes + * uninitialized; these cause problems when using the id for lookups + * in imgPhotoColorHash, and can result in core dumps. + */ + + memset(&colorPtr->id, 0, sizeof(ColorTableId)); + colorPtr->id = id; + Tk_PreserveColormap(colorPtr->id.display, colorPtr->id.colormap); + colorPtr->flags = 0; + colorPtr->refCount = 0; + colorPtr->liveRefCount = 0; + colorPtr->numColors = 0; + colorPtr->visualInfo = instancePtr->visualInfo; + colorPtr->pixelMap = NULL; + Tcl_SetHashValue(entry, colorPtr); + } + + colorPtr->refCount++; + colorPtr->liveRefCount++; + instancePtr->colorTablePtr = colorPtr; + if (colorPtr->flags & DISPOSE_PENDING) { + Tcl_CancelIdleCall(DisposeColorTable, colorPtr); + colorPtr->flags &= ~DISPOSE_PENDING; + } + + /* + * Allocate colors for this color table if necessary. + */ + + if ((colorPtr->numColors == 0) && !(colorPtr->flags & BLACK_AND_WHITE)) { + AllocateColors(colorPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * FreeColorTable -- + * + * This function is called when an instance ceases using a color table. + * + * Results: + * None. + * + * Side effects: + * If no other instances are using this color table, a when-idle handler + * is registered to free up the color table and the colors allocated for + * it. + * + *---------------------------------------------------------------------- + */ + +static void +FreeColorTable( + ColorTable *colorPtr, /* Pointer to the color table which is no + * longer required by an instance. */ + int force) /* Force free to happen immediately. */ +{ + colorPtr->refCount--; + if (colorPtr->refCount > 0) { + return; + } + + if (force) { + if (colorPtr->flags & DISPOSE_PENDING) { + Tcl_CancelIdleCall(DisposeColorTable, colorPtr); + colorPtr->flags &= ~DISPOSE_PENDING; + } + DisposeColorTable(colorPtr); + } else if (!(colorPtr->flags & DISPOSE_PENDING)) { + Tcl_DoWhenIdle(DisposeColorTable, colorPtr); + colorPtr->flags |= DISPOSE_PENDING; + } +} + +/* + *---------------------------------------------------------------------- + * + * AllocateColors -- + * + * This function allocates the colors required by a color table, and sets + * up the fields in the color table data structure which are used in + * dithering. + * + * Results: + * None. + * + * Side effects: + * Colors are allocated from the X server. Fields in the color table data + * structure are updated. + * + *---------------------------------------------------------------------- + */ + +static void +AllocateColors( + ColorTable *colorPtr) /* Pointer to the color table requiring colors + * to be allocated. */ +{ + int i, r, g, b, rMult, mono; + int numColors, nRed, nGreen, nBlue; + double fr, fg, fb, igam; + XColor *colors; + unsigned long *pixels; + + /* + * 16-bit intensity value for i/n of full intensity. + */ +#define CFRAC(i, n) ((i) * 65535 / (n)) + + /* As for CFRAC, but apply exponent of g. */ +#define CGFRAC(i, n, g) ((int)(65535 * pow((double)(i) / (n), (g)))) + + /* + * First parse the palette specification to get the required number of + * shades of each primary. + */ + + mono = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed, &nGreen, &nBlue) + <= 1; + igam = 1.0 / colorPtr->id.gamma; + + /* + * Each time around this loop, we reduce the number of colors we're trying + * to allocate until we succeed in allocating all of the colors we need. + */ + + for (;;) { + /* + * If we are using 1 bit/pixel, we don't need to allocate any colors + * (we just use the foreground and background colors in the GC). + */ + + if (mono && (nRed <= 2)) { + colorPtr->flags |= BLACK_AND_WHITE; + return; + } + + /* + * Calculate the RGB coordinates of the colors we want to allocate and + * store them in *colors. + */ + + if ((colorPtr->visualInfo.class == DirectColor) + || (colorPtr->visualInfo.class == TrueColor)) { + + /* + * Direct/True Color: allocate shades of red, green, blue + * independently. + */ + + if (mono) { + numColors = nGreen = nBlue = nRed; + } else { + numColors = MAX(MAX(nRed, nGreen), nBlue); + } + colors = ckalloc(numColors * sizeof(XColor)); + + for (i = 0; i < numColors; ++i) { + if (igam == 1.0) { + colors[i].red = CFRAC(i, nRed - 1); + colors[i].green = CFRAC(i, nGreen - 1); + colors[i].blue = CFRAC(i, nBlue - 1); + } else { + colors[i].red = CGFRAC(i, nRed - 1, igam); + colors[i].green = CGFRAC(i, nGreen - 1, igam); + colors[i].blue = CGFRAC(i, nBlue - 1, igam); + } + } + } else { + /* + * PseudoColor, StaticColor, GrayScale or StaticGray visual: we + * have to allocate each color in the color cube separately. + */ + + numColors = (mono) ? nRed: (nRed * nGreen * nBlue); + colors = ckalloc(numColors * sizeof(XColor)); + + if (!mono) { + /* + * Color display using a PseudoColor or StaticColor visual. + */ + + i = 0; + for (r = 0; r < nRed; ++r) { + for (g = 0; g < nGreen; ++g) { + for (b = 0; b < nBlue; ++b) { + if (igam == 1.0) { + colors[i].red = CFRAC(r, nRed - 1); + colors[i].green = CFRAC(g, nGreen - 1); + colors[i].blue = CFRAC(b, nBlue - 1); + } else { + colors[i].red = CGFRAC(r, nRed - 1, igam); + colors[i].green = CGFRAC(g, nGreen - 1, igam); + colors[i].blue = CGFRAC(b, nBlue - 1, igam); + } + i++; + } + } + } + } else { + /* + * Monochrome display - allocate the shades of grey we want. + */ + + for (i = 0; i < numColors; ++i) { + if (igam == 1.0) { + r = CFRAC(i, numColors - 1); + } else { + r = CGFRAC(i, numColors - 1, igam); + } + colors[i].red = colors[i].green = colors[i].blue = r; + } + } + } + + /* + * Now try to allocate the colors we've calculated. + */ + + pixels = ckalloc(numColors * sizeof(unsigned long)); + for (i = 0; i < numColors; ++i) { + if (!XAllocColor(colorPtr->id.display, colorPtr->id.colormap, + &colors[i])) { + /* + * Can't get all the colors we want in the default colormap; + * first try freeing colors from other unused color tables. + */ + + if (!ReclaimColors(&colorPtr->id, numColors - i) + || !XAllocColor(colorPtr->id.display, + colorPtr->id.colormap, &colors[i])) { + /* + * Still can't allocate the color. + */ + + break; + } + } + pixels[i] = colors[i].pixel; + } + + /* + * If we didn't get all of the colors, reduce the resolution of the + * color cube, free the ones we got, and try again. + */ + + if (i >= numColors) { + break; + } + XFreeColors(colorPtr->id.display, colorPtr->id.colormap, pixels, i, 0); + ckfree(colors); + ckfree(pixels); + + if (!mono) { + if ((nRed == 2) && (nGreen == 2) && (nBlue == 2)) { + /* + * Fall back to 1-bit monochrome display. + */ + + mono = 1; + } else { + /* + * Reduce the number of shades of each primary to about 3/4 of + * the previous value. This should reduce the total number of + * colors required to about half the previous value for + * PseudoColor displays. + */ + + nRed = (nRed * 3 + 2) / 4; + nGreen = (nGreen * 3 + 2) / 4; + nBlue = (nBlue * 3 + 2) / 4; + } + } else { + /* + * Reduce the number of shades of gray to about 1/2. + */ + + nRed = nRed / 2; + } + } + + /* + * We have allocated all of the necessary colors: fill in various fields + * of the ColorTable record. + */ + + if (!mono) { + colorPtr->flags |= COLOR_WINDOW; + + /* + * The following is a hairy hack. We only want to index into the + * pixelMap on colormap displays. However, if the display is on + * Windows, then we actually want to store the index not the value + * since we will be passing the color table into the TkPutImage call. + */ + +#ifndef _WIN32 + if ((colorPtr->visualInfo.class != DirectColor) + && (colorPtr->visualInfo.class != TrueColor)) { + colorPtr->flags |= MAP_COLORS; + } +#endif /* _WIN32 */ + } + + colorPtr->numColors = numColors; + colorPtr->pixelMap = pixels; + + /* + * Set up quantization tables for dithering. + */ + + rMult = nGreen * nBlue; + for (i = 0; i < 256; ++i) { + r = (i * (nRed - 1) + 127) / 255; + if (mono) { + fr = (double) colors[r].red / 65535.0; + if (colorPtr->id.gamma != 1.0 ) { + fr = pow(fr, colorPtr->id.gamma); + } + colorPtr->colorQuant[0][i] = (int)(fr * 255.99); + colorPtr->redValues[i] = colors[r].pixel; + } else { + g = (i * (nGreen - 1) + 127) / 255; + b = (i * (nBlue - 1) + 127) / 255; + if ((colorPtr->visualInfo.class == DirectColor) + || (colorPtr->visualInfo.class == TrueColor)) { + colorPtr->redValues[i] = + colors[r].pixel & colorPtr->visualInfo.red_mask; + colorPtr->greenValues[i] = + colors[g].pixel & colorPtr->visualInfo.green_mask; + colorPtr->blueValues[i] = + colors[b].pixel & colorPtr->visualInfo.blue_mask; + } else { + r *= rMult; + g *= nBlue; + colorPtr->redValues[i] = r; + colorPtr->greenValues[i] = g; + colorPtr->blueValues[i] = b; + } + fr = (double) colors[r].red / 65535.0; + fg = (double) colors[g].green / 65535.0; + fb = (double) colors[b].blue / 65535.0; + if (colorPtr->id.gamma != 1.0) { + fr = pow(fr, colorPtr->id.gamma); + fg = pow(fg, colorPtr->id.gamma); + fb = pow(fb, colorPtr->id.gamma); + } + colorPtr->colorQuant[0][i] = (int)(fr * 255.99); + colorPtr->colorQuant[1][i] = (int)(fg * 255.99); + colorPtr->colorQuant[2][i] = (int)(fb * 255.99); + } + } + + ckfree(colors); +} + +/* + *---------------------------------------------------------------------- + * + * DisposeColorTable -- + * + * Release a color table and its associated resources. + * + * Results: + * None. + * + * Side effects: + * The colors in the argument color table are freed, as is the color + * table structure itself. The color table is removed from the hash table + * which is used to locate color tables. + * + *---------------------------------------------------------------------- + */ + +static void +DisposeColorTable( + ClientData clientData) /* Pointer to the ColorTable whose + * colors are to be released. */ +{ + ColorTable *colorPtr = clientData; + Tcl_HashEntry *entry; + + if (colorPtr->pixelMap != NULL) { + if (colorPtr->numColors > 0) { + XFreeColors(colorPtr->id.display, colorPtr->id.colormap, + colorPtr->pixelMap, colorPtr->numColors, 0); + Tk_FreeColormap(colorPtr->id.display, colorPtr->id.colormap); + } + ckfree(colorPtr->pixelMap); + } + + entry = Tcl_FindHashEntry(&imgPhotoColorHash, (char *) &colorPtr->id); + if (entry == NULL) { + Tcl_Panic("DisposeColorTable couldn't find hash entry"); + } + Tcl_DeleteHashEntry(entry); + + ckfree(colorPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ReclaimColors -- + * + * This function is called to try to free up colors in the colormap used + * by a color table. It looks for other color tables with the same + * colormap and with a zero live reference count, and frees their colors. + * It only does so if there is the possibility of freeing up at least + * `numColors' colors. + * + * Results: + * The return value is TRUE if any colors were freed, FALSE otherwise. + * + * Side effects: + * ColorTables which are not currently in use may lose their color + * allocations. + * + *---------------------------------------------------------------------- + */ + +static int +ReclaimColors( + ColorTableId *id, /* Pointer to information identifying + * the color table which needs more colors. */ + int numColors) /* Number of colors required. */ +{ + Tcl_HashSearch srch; + Tcl_HashEntry *entry; + ColorTable *colorPtr; + int nAvail = 0; + + /* + * First scan through the color hash table to get an upper bound on how + * many colors we might be able to free. + */ + + entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch); + while (entry != NULL) { + colorPtr = Tcl_GetHashValue(entry); + if ((colorPtr->id.display == id->display) + && (colorPtr->id.colormap == id->colormap) + && (colorPtr->liveRefCount == 0 )&& (colorPtr->numColors != 0) + && ((colorPtr->id.palette != id->palette) + || (colorPtr->id.gamma != id->gamma))) { + /* + * We could take this guy's colors off him. + */ + + nAvail += colorPtr->numColors; + } + entry = Tcl_NextHashEntry(&srch); + } + + /* + * nAvail is an (over)estimate of the number of colors we could free. + */ + + if (nAvail < numColors) { + return 0; + } + + /* + * Scan through a second time freeing colors. + */ + + entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch); + while ((entry != NULL) && (numColors > 0)) { + colorPtr = Tcl_GetHashValue(entry); + if ((colorPtr->id.display == id->display) + && (colorPtr->id.colormap == id->colormap) + && (colorPtr->liveRefCount == 0) && (colorPtr->numColors != 0) + && ((colorPtr->id.palette != id->palette) + || (colorPtr->id.gamma != id->gamma))) { + /* + * Free the colors that this ColorTable has. + */ + + XFreeColors(colorPtr->id.display, colorPtr->id.colormap, + colorPtr->pixelMap, colorPtr->numColors, 0); + numColors -= colorPtr->numColors; + colorPtr->numColors = 0; + ckfree(colorPtr->pixelMap); + colorPtr->pixelMap = NULL; + } + + entry = Tcl_NextHashEntry(&srch); + } + return 1; /* We freed some colors. */ +} + +/* + *---------------------------------------------------------------------- + * + * TkImgDisposeInstance -- + * + * This function is called to finally free up an instance of a photo + * image which is no longer required. + * + * Results: + * None. + * + * Side effects: + * The instance data structure and the resources it references are freed. + * + *---------------------------------------------------------------------- + */ + +void +TkImgDisposeInstance( + ClientData clientData) /* Pointer to the instance whose resources are + * to be released. */ +{ + PhotoInstance *instancePtr = clientData; + PhotoInstance *prevPtr; + + if (instancePtr->pixels != None) { + Tk_FreePixmap(instancePtr->display, instancePtr->pixels); + } + if (instancePtr->gc != None) { + Tk_FreeGC(instancePtr->display, instancePtr->gc); + } + if (instancePtr->imagePtr != NULL) { + XDestroyImage(instancePtr->imagePtr); + } + if (instancePtr->error != NULL) { + ckfree(instancePtr->error); + } + if (instancePtr->colorTablePtr != NULL) { + FreeColorTable(instancePtr->colorTablePtr, 1); + } + + if (instancePtr->masterPtr->instancePtr == instancePtr) { + instancePtr->masterPtr->instancePtr = instancePtr->nextPtr; + } else { + for (prevPtr = instancePtr->masterPtr->instancePtr; + prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) { + /* Empty loop body. */ + } + prevPtr->nextPtr = instancePtr->nextPtr; + } + Tk_FreeColormap(instancePtr->display, instancePtr->colormap); + ckfree(instancePtr); +} + +/* + *---------------------------------------------------------------------- + * + * TkImgDitherInstance -- + * + * This function is called to update an area of an instance's pixmap by + * dithering the corresponding area of the master. + * + * Results: + * None. + * + * Side effects: + * The instance's pixmap gets updated. + * + *---------------------------------------------------------------------- + */ + +void +TkImgDitherInstance( + PhotoInstance *instancePtr, /* The instance to be updated. */ + int xStart, int yStart, /* Coordinates of the top-left pixel in the + * block to be dithered. */ + int width, int height) /* Dimensions of the block to be dithered. */ +{ + PhotoMaster *masterPtr = instancePtr->masterPtr; + ColorTable *colorPtr = instancePtr->colorTablePtr; + XImage *imagePtr; + int nLines, bigEndian, i, c, x, y, xEnd, doDithering = 1; + int bitsPerPixel, bytesPerLine, lineLength; + unsigned char *srcLinePtr; + schar *errLinePtr; + pixel firstBit, word, mask; + + /* + * Turn dithering off in certain cases where it is not needed (TrueColor, + * DirectColor with many colors). + */ + + if ((colorPtr->visualInfo.class == DirectColor) + || (colorPtr->visualInfo.class == TrueColor)) { + int nRed, nGreen, nBlue, result; + + result = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed, + &nGreen, &nBlue); + if ((nRed >= 256) + && ((result == 1) || ((nGreen >= 256) && (nBlue >= 256)))) { + doDithering = 0; + } + } + + /* + * First work out how many lines to do at a time, then how many bytes + * we'll need for pixel storage, and allocate it. + */ + + nLines = (MAX_PIXELS + width - 1) / width; + if (nLines < 1) { + nLines = 1; + } + if (nLines > height ) { + nLines = height; + } + + imagePtr = instancePtr->imagePtr; + if (imagePtr == NULL) { + return; /* We must be really tight on memory. */ + } + bitsPerPixel = imagePtr->bits_per_pixel; + bytesPerLine = ((bitsPerPixel * width + 31) >> 3) & ~3; + imagePtr->width = width; + imagePtr->height = nLines; + imagePtr->bytes_per_line = bytesPerLine; + + /* + * TODO: use attemptckalloc() here once we have some strategy for + * recovering from the failure. + */ + + imagePtr->data = ckalloc(imagePtr->bytes_per_line * nLines); + bigEndian = imagePtr->bitmap_bit_order == MSBFirst; + firstBit = bigEndian? (1 << (imagePtr->bitmap_unit - 1)): 1; + + lineLength = masterPtr->width * 3; + srcLinePtr = masterPtr->pix32 + (yStart * masterPtr->width + xStart) * 4; + errLinePtr = instancePtr->error + yStart * lineLength + xStart * 3; + xEnd = xStart + width; + + /* + * Loop over the image, doing at most nLines lines before updating the + * screen image. + */ + + for (; height > 0; height -= nLines) { + unsigned char *dstLinePtr = (unsigned char *) imagePtr->data; + int yEnd; + + if (nLines > height) { + nLines = height; + } + yEnd = yStart + nLines; + for (y = yStart; y < yEnd; ++y) { + unsigned char *srcPtr = srcLinePtr; + schar *errPtr = errLinePtr; + unsigned char *destBytePtr = dstLinePtr; + pixel *destLongPtr = (pixel *) dstLinePtr; + + if (colorPtr->flags & COLOR_WINDOW) { + /* + * Color window. We dither the three components independently, + * using Floyd-Steinberg dithering, which propagates errors + * from the quantization of pixels to the pixels below and to + * the right. + */ + + for (x = xStart; x < xEnd; ++x) { + int col[3]; + + if (doDithering) { + for (i = 0; i < 3; ++i) { + /* + * Compute the error propagated into this pixel + * for this component. If e[x,y] is the array of + * quantization error values, we compute + * 7/16 * e[x-1,y] + 1/16 * e[x-1,y-1] + * + 5/16 * e[x,y-1] + 3/16 * e[x+1,y-1] + * and round it to an integer. + * + * The expression ((c + 2056) >> 4) - 128 computes + * round(c / 16), and works correctly on machines + * without a sign-extending right shift. + */ + + c = (x > 0) ? errPtr[-3] * 7: 0; + if (y > 0) { + if (x > 0) { + c += errPtr[-lineLength-3]; + } + c += errPtr[-lineLength] * 5; + if ((x + 1) < masterPtr->width) { + c += errPtr[-lineLength+3] * 3; + } + } + + /* + * Add the propagated error to the value of this + * component, quantize it, and store the + * quantization error. + */ + + c = ((c + 2056) >> 4) - 128 + *srcPtr++; + if (c < 0) { + c = 0; + } else if (c > 255) { + c = 255; + } + col[i] = colorPtr->colorQuant[i][c]; + *errPtr++ = c - col[i]; + } + } else { + /* + * Output is virtually continuous in this case, so + * don't bother dithering. + */ + + col[0] = *srcPtr++; + col[1] = *srcPtr++; + col[2] = *srcPtr++; + } + srcPtr++; + + /* + * Translate the quantized component values into an X + * pixel value, and store it in the image. + */ + + i = colorPtr->redValues[col[0]] + + colorPtr->greenValues[col[1]] + + colorPtr->blueValues[col[2]]; + if (colorPtr->flags & MAP_COLORS) { + i = colorPtr->pixelMap[i]; + } + switch (bitsPerPixel) { + case NBBY: + *destBytePtr++ = i; + break; +#ifndef _WIN32 + /* + * This case is not valid for Windows because the + * image format is different from the pixel format in + * Win32. Eventually we need to fix the image code in + * Tk to use the Windows native image ordering. This + * would speed up the image code for all of the common + * sizes. + */ + + case NBBY * sizeof(pixel): + *destLongPtr++ = i; + break; +#endif + default: + XPutPixel(imagePtr, x - xStart, y - yStart, + (unsigned) i); + } + } + + } else if (bitsPerPixel > 1) { + /* + * Multibit monochrome window. The operation here is similar + * to the color window case above, except that there is only + * one component. If the master image is in color, use the + * luminance computed as + * 0.344 * red + 0.5 * green + 0.156 * blue. + */ + + for (x = xStart; x < xEnd; ++x) { + c = (x > 0) ? errPtr[-1] * 7: 0; + if (y > 0) { + if (x > 0) { + c += errPtr[-lineLength-1]; + } + c += errPtr[-lineLength] * 5; + if (x + 1 < masterPtr->width) { + c += errPtr[-lineLength+1] * 3; + } + } + c = ((c + 2056) >> 4) - 128; + + if (masterPtr->flags & COLOR_IMAGE) { + c += (unsigned) (srcPtr[0] * 11 + srcPtr[1] * 16 + + srcPtr[2] * 5 + 16) >> 5; + } else { + c += srcPtr[0]; + } + srcPtr += 4; + + if (c < 0) { + c = 0; + } else if (c > 255) { + c = 255; + } + i = colorPtr->colorQuant[0][c]; + *errPtr++ = c - i; + i = colorPtr->redValues[i]; + switch (bitsPerPixel) { + case NBBY: + *destBytePtr++ = i; + break; +#ifndef _WIN32 + /* + * This case is not valid for Windows because the + * image format is different from the pixel format in + * Win32. Eventually we need to fix the image code in + * Tk to use the Windows native image ordering. This + * would speed up the image code for all of the common + * sizes. + */ + + case NBBY * sizeof(pixel): + *destLongPtr++ = i; + break; +#endif + default: + XPutPixel(imagePtr, x - xStart, y - yStart, + (unsigned) i); + } + } + } else { + /* + * 1-bit monochrome window. This is similar to the multibit + * monochrome case above, except that the quantization is + * simpler (we only have black = 0 and white = 255), and we + * produce an XY-Bitmap. + */ + + word = 0; + mask = firstBit; + for (x = xStart; x < xEnd; ++x) { + /* + * If we have accumulated a whole word, store it in the + * image and start a new word. + */ + + if (mask == 0) { + *destLongPtr++ = word; + mask = firstBit; + word = 0; + } + + c = (x > 0) ? errPtr[-1] * 7: 0; + if (y > 0) { + if (x > 0) { + c += errPtr[-lineLength-1]; + } + c += errPtr[-lineLength] * 5; + if (x + 1 < masterPtr->width) { + c += errPtr[-lineLength+1] * 3; + } + } + c = ((c + 2056) >> 4) - 128; + + if (masterPtr->flags & COLOR_IMAGE) { + c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16 + + srcPtr[2] * 5 + 16) >> 5; + } else { + c += srcPtr[0]; + } + srcPtr += 4; + + if (c < 0) { + c = 0; + } else if (c > 255) { + c = 255; + } + if (c >= 128) { + word |= mask; + *errPtr++ = c - 255; + } else { + *errPtr++ = c; + } + mask = bigEndian? (mask >> 1): (mask << 1); + } + *destLongPtr = word; + } + srcLinePtr += masterPtr->width * 4; + errLinePtr += lineLength; + dstLinePtr += bytesPerLine; + } + + /* + * Update the pixmap for this instance with the block of pixels that + * we have just computed. + */ + + TkPutImage(colorPtr->pixelMap, colorPtr->numColors, + instancePtr->display, instancePtr->pixels, + instancePtr->gc, imagePtr, 0, 0, xStart, yStart, + (unsigned) width, (unsigned) nLines); + yStart = yEnd; + } + + ckfree(imagePtr->data); + imagePtr->data = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * TkImgResetDither -- + * + * This function is called to eliminate the content of a photo instance's + * dither error buffer. It's called when the overall image is blanked. + * + * Results: + * None. + * + * Side effects: + * The instance's dither buffer gets cleared. + * + *---------------------------------------------------------------------- + */ + +void +TkImgResetDither( + PhotoInstance *instancePtr) +{ + if (instancePtr->error) { + memset(instancePtr->error, 0, + /*(size_t)*/ (instancePtr->masterPtr->width + * instancePtr->masterPtr->height * 3 * sizeof(schar))); + } +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 47aa523..3e03f3d 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -18,209 +18,7 @@ * Australian National University. */ -#include "tkInt.h" -#include <ctype.h> - -#ifdef __WIN32__ -#include "tkWinInt.h" -#elif defined(__CYGWIN__) -#include "tkUnixInt.h" -#endif - -/* - * Declaration for internal Xlib function used here: - */ - -extern int _XInitImageFuncPtrs(XImage *image); - -/* - * A signed 8-bit integral type. If chars are unsigned and the compiler isn't - * an ANSI one, then we have to use short instead (which wastes space) to get - * signed behavior. - */ - -#if defined(__STDC__) || defined(_AIX) - typedef signed char schar; -#else -# ifndef __CHAR_UNSIGNED__ - typedef char schar; -# else - typedef short schar; -# endif -#endif - -/* - * An unsigned 32-bit integral type, used for pixel values. We use int rather - * than long here to accommodate those systems where longs are 64 bits. - */ - -typedef unsigned int pixel; - -/* - * The maximum number of pixels to transmit to the server in a single - * XPutImage call. - */ - -#define MAX_PIXELS 65536 - -/* - * The set of colors required to display a photo image in a window depends on: - * - the visual used by the window - * - the palette, which specifies how many levels of each primary color to - * use, and - * - the gamma value for the image. - * - * Pixel values allocated for specific colors are valid only for the colormap - * in which they were allocated. Sets of pixel values allocated for displaying - * photos are re-used in other windows if possible, that is, if the display, - * colormap, palette and gamma values match. A hash table is used to locate - * these sets of pixel values, using the following data structure as key: - */ - -typedef struct { - Display *display; /* Qualifies the colormap resource ID. */ - Colormap colormap; /* Colormap that the windows are using. */ - double gamma; /* Gamma exponent value for images. */ - Tk_Uid palette; /* Specifies how many shades of each primary - * we want to allocate. */ -} ColorTableId; - -/* - * For a particular (display, colormap, palette, gamma) combination, a data - * structure of the following type is used to store the allocated pixel values - * and other information: - */ - -typedef struct ColorTable { - ColorTableId id; /* Information used in selecting this color - * table. */ - int flags; /* See below. */ - int refCount; /* Number of instances using this map. */ - int liveRefCount; /* Number of instances which are actually in - * use, using this map. */ - int numColors; /* Number of colors allocated for this map. */ - - XVisualInfo visualInfo; /* Information about the visual for windows - * using this color table. */ - - pixel redValues[256]; /* Maps 8-bit values of red intensity to a - * pixel value or index in pixelMap. */ - pixel greenValues[256]; /* Ditto for green intensity. */ - pixel blueValues[256]; /* Ditto for blue intensity. */ - unsigned long *pixelMap; /* Actual pixel values allocated. */ - - unsigned char colorQuant[3][256]; - /* Maps 8-bit intensities to quantized - * intensities. The first index is 0 for red, - * 1 for green, 2 for blue. */ -} ColorTable; - -/* - * Bit definitions for the flags field of a ColorTable. - * BLACK_AND_WHITE: 1 means only black and white colors are - * available. - * COLOR_WINDOW: 1 means a full 3-D color cube has been - * allocated. - * DISPOSE_PENDING: 1 means a call to DisposeColorTable has been - * scheduled as an idle handler, but it hasn't - * been invoked yet. - * MAP_COLORS: 1 means pixel values should be mapped through - * pixelMap. - */ - -#ifdef COLOR_WINDOW -#undef COLOR_WINDOW -#endif - -#define BLACK_AND_WHITE 1 -#define COLOR_WINDOW 2 -#define DISPOSE_PENDING 4 -#define MAP_COLORS 8 - -/* - * Definition of the data associated with each photo image master. - */ - -typedef struct PhotoMaster { - Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means the - * image is being deleted. */ - Tcl_Interp *interp; /* Interpreter associated with the application - * using this image. */ - Tcl_Command imageCmd; /* Token for image command (used to delete it - * when the image goes away). NULL means the - * image command has already been deleted. */ - int flags; /* Sundry flags, defined below. */ - int width, height; /* Dimensions of image. */ - int userWidth, userHeight; /* User-declared image dimensions. */ - Tk_Uid palette; /* User-specified default palette for - * instances of this image. */ - double gamma; /* Display gamma value to correct for. */ - char *fileString; /* Name of file to read into image. */ - Tcl_Obj *dataString; /* Object to use as contents of image. */ - Tcl_Obj *format; /* User-specified format of data in image file - * or string value. */ - unsigned char *pix32; /* Local storage for 32-bit image. */ - int ditherX, ditherY; /* Location of first incorrectly dithered - * pixel in image. */ - TkRegion validRegion; /* Tk region indicating which parts of the - * image have valid image data. */ - struct PhotoInstance *instancePtr; - /* First in the list of instances associated - * with this master. */ -} PhotoMaster; - -/* - * Bit definitions for the flags field of a PhotoMaster. - * COLOR_IMAGE: 1 means that the image has different color - * components. - * IMAGE_CHANGED: 1 means that the instances of this image need - * to be redithered. - * COMPLEX_ALPHA: 1 means that the instances of this image have - * alpha values that aren't 0 or 255, and so need - * the copy-merge-replace renderer . - */ - -#define COLOR_IMAGE 1 -#define IMAGE_CHANGED 2 -#define COMPLEX_ALPHA 4 - -/* - * Flag to OR with the compositing rule to indicate that the source, despite - * having an alpha channel, has simple alpha. - */ - -#define SOURCE_IS_SIMPLE_ALPHA_PHOTO 0x10000000 - -/* - * The following data structure represents all of the instances of a photo - * image in windows on a given screen that are using the same colormap. - */ - -typedef struct PhotoInstance { - PhotoMaster *masterPtr; /* Pointer to master for image. */ - Display *display; /* Display for windows using this instance. */ - Colormap colormap; /* The image may only be used in windows with - * this particular colormap. */ - struct PhotoInstance *nextPtr; - /* Pointer to the next instance in the list of - * instances associated with this master. */ - int refCount; /* Number of instances using this structure. */ - Tk_Uid palette; /* Palette for these particular instances. */ - double gamma; /* Gamma value for these instances. */ - Tk_Uid defaultPalette; /* Default palette to use if a palette is not - * specified for the master. */ - ColorTable *colorTablePtr; /* Pointer to information about colors - * allocated for image display in windows like - * this one. */ - Pixmap pixels; /* X pixmap containing dithered image. */ - int width, height; /* Dimensions of the pixmap. */ - schar *error; /* Error image, used in dithering. */ - XImage *imagePtr; /* Image structure for converted pixels. */ - XVisualInfo visualInfo; /* Information about the visual that these - * windows are using. */ - GC gc; /* Graphics context for writing images to the - * pixmap. */ -} PhotoInstance; +#include "tkImgPhoto.h" /* * The following data structure is used to return information from @@ -301,16 +99,10 @@ static const char *const optionNames[] = { * Functions used in the type record for photo images. */ -static int ImgPhotoCreate(Tcl_Interp *interp, char *name, - int objc, Tcl_Obj *CONST objv[], - Tk_ImageType *typePtr, Tk_ImageMaster master, +static int ImgPhotoCreate(Tcl_Interp *interp, const char *name, + int objc, Tcl_Obj *const objv[], + const Tk_ImageType *typePtr, Tk_ImageMaster master, ClientData *clientDataPtr); -static ClientData ImgPhotoGet(Tk_Window tkwin, ClientData clientData); -static void ImgPhotoDisplay(ClientData clientData, - Display *display, Drawable drawable, - int imageX, int imageY, int width, int height, - int drawableX, int drawableY); -static void ImgPhotoFree(ClientData clientData, Display *display); static void ImgPhotoDelete(ClientData clientData); static int ImgPhotoPostscript(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, @@ -324,12 +116,13 @@ static int ImgPhotoPostscript(ClientData clientData, Tk_ImageType tkPhotoImageType = { "photo", /* name */ ImgPhotoCreate, /* createProc */ - ImgPhotoGet, /* getProc */ - ImgPhotoDisplay, /* displayProc */ - ImgPhotoFree, /* freeProc */ + TkImgPhotoGet, /* getProc */ + TkImgPhotoDisplay, /* displayProc */ + TkImgPhotoFree, /* freeProc */ ImgPhotoDelete, /* deleteProc */ ImgPhotoPostscript, /* postscriptProc */ - NULL /* nextPtr */ + NULL, /* nextPtr */ + NULL }; typedef struct ThreadSpecificData { @@ -340,7 +133,7 @@ typedef struct ThreadSpecificData { /* Pointer to the first in the list of known * photo image formats.*/ int initialized; /* Set to 1 if we've initialized the - * strucuture. */ + * structure. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -357,45 +150,27 @@ static Tcl_ThreadDataKey dataKey; * Information used for parsing configuration specifications: */ -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_STRING, "-file", NULL, NULL, - NULL, Tk_Offset(PhotoMaster, fileString), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(PhotoMaster, fileString), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_DOUBLE, "-gamma", NULL, NULL, - DEF_PHOTO_GAMMA, Tk_Offset(PhotoMaster, gamma), 0}, + DEF_PHOTO_GAMMA, Tk_Offset(PhotoMaster, gamma), 0, NULL}, {TK_CONFIG_INT, "-height", NULL, NULL, - DEF_PHOTO_HEIGHT, Tk_Offset(PhotoMaster, userHeight), 0}, + DEF_PHOTO_HEIGHT, Tk_Offset(PhotoMaster, userHeight), 0, NULL}, {TK_CONFIG_UID, "-palette", NULL, NULL, - DEF_PHOTO_PALETTE, Tk_Offset(PhotoMaster, palette), 0}, + DEF_PHOTO_PALETTE, Tk_Offset(PhotoMaster, palette), 0, NULL}, {TK_CONFIG_INT, "-width", NULL, NULL, - DEF_PHOTO_WIDTH, Tk_Offset(PhotoMaster, userWidth), 0}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + DEF_PHOTO_WIDTH, Tk_Offset(PhotoMaster, userWidth), 0, NULL}, + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* - * Hash table used to hash from (display, colormap, palette, gamma) to - * ColorTable address. - */ - -static Tcl_HashTable imgPhotoColorHash; -static int imgPhotoColorHashInitialized; -#define N_COLOR_HASH (sizeof(ColorTableId) / sizeof(int)) - -/* - * Implementation of the Porter-Duff Source-Over compositing rule. - */ - -#define PD_SRC_OVER(srcColor,srcAlpha,dstColor,dstAlpha) \ - (srcColor*srcAlpha/255) + dstAlpha*(255-srcAlpha)/255*dstColor/255 -#define PD_SRC_OVER_ALPHA(srcAlpha,dstAlpha) \ - (srcAlpha + (255-srcAlpha)*dstAlpha/255) - -/* * Forward declarations */ static void PhotoFormatThreadExitProc(ClientData clientData); static int ImgPhotoCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int ParseSubcommandOptions( struct SubcommandOptions *optPtr, Tcl_Interp *interp, int allowedOptions, @@ -404,47 +179,24 @@ static void ImgPhotoCmdDeletedProc(ClientData clientData); static int ImgPhotoConfigureMaster(Tcl_Interp *interp, PhotoMaster *masterPtr, int objc, Tcl_Obj *const objv[], int flags); -static void ImgPhotoConfigureInstance(PhotoInstance *instancePtr); static int ToggleComplexAlphaIfNeeded(PhotoMaster *mPtr); -static void ImgPhotoBlendComplexAlpha(XImage *bgImg, - PhotoInstance *iPtr, int xOffset, int yOffset, - int width, int height); static int ImgPhotoSetSize(PhotoMaster *masterPtr, int width, int height); -static void ImgPhotoInstanceSetSize(PhotoInstance *instancePtr); static int ImgStringWrite(Tcl_Interp *interp, Tcl_Obj *formatString, Tk_PhotoImageBlock *blockPtr); static char * ImgGetPhoto(PhotoMaster *masterPtr, Tk_PhotoImageBlock *blockPtr, struct SubcommandOptions *optPtr); -static int IsValidPalette(PhotoInstance *instancePtr, - const char *palette); -static int CountBits(pixel mask); -static void GetColorTable(PhotoInstance *instancePtr); -static void FreeColorTable(ColorTable *colorPtr, int force); -static void AllocateColors(ColorTable *colorPtr); -static void DisposeColorTable(ClientData clientData); -static void DisposeInstance(ClientData clientData); -static int ReclaimColors(ColorTableId *id, int numColors); static int MatchFileFormat(Tcl_Interp *interp, Tcl_Channel chan, - char *fileName, Tcl_Obj *formatString, + const char *fileName, Tcl_Obj *formatString, Tk_PhotoImageFormat **imageFormatPtr, int *widthPtr, int *heightPtr, int *oldformat); static int MatchStringFormat(Tcl_Interp *interp, Tcl_Obj *data, Tcl_Obj *formatString, Tk_PhotoImageFormat **imageFormatPtr, int *widthPtr, int *heightPtr, int *oldformat); -static Tcl_ObjCmdProc * PhotoOptionFind(Tcl_Interp *interp, Tcl_Obj *obj); -static void DitherInstance(PhotoInstance *instancePtr, int x, - int y, int width, int height); -static void PhotoOptionCleanupProc(ClientData clientData, - Tcl_Interp *interp); - -#undef MIN -#define MIN(a, b) ((a) < (b)? (a): (b)) -#undef MAX -#define MAX(a, b) ((a) > (b)? (a): (b)) +static const char * GetExtension(const char *path); /* *---------------------------------------------------------------------- @@ -467,19 +219,19 @@ PhotoFormatThreadExitProc( ClientData clientData) /* not used */ { Tk_PhotoImageFormat *freePtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); while (tsdPtr->oldFormatList != NULL) { freePtr = tsdPtr->oldFormatList; tsdPtr->oldFormatList = tsdPtr->oldFormatList->nextPtr; - ckfree((char *) freePtr); + ckfree(freePtr); } while (tsdPtr->formatList != NULL) { freePtr = tsdPtr->formatList; tsdPtr->formatList = tsdPtr->formatList->nextPtr; - ckfree((char *) freePtr->name); - ckfree((char *) freePtr); + ckfree((char *)freePtr->name); + ckfree(freePtr); } } @@ -504,20 +256,20 @@ PhotoFormatThreadExitProc( void Tk_CreateOldPhotoImageFormat( - Tk_PhotoImageFormat *formatPtr) + const Tk_PhotoImageFormat *formatPtr) /* Structure describing the format. All of the * fields except "nextPtr" must be filled in * by caller. */ { Tk_PhotoImageFormat *copyPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { tsdPtr->initialized = 1; Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL); } - copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat)); + copyPtr = ckalloc(sizeof(Tk_PhotoImageFormat)); *copyPtr = *formatPtr; copyPtr->nextPtr = tsdPtr->oldFormatList; tsdPtr->oldFormatList = copyPtr; @@ -525,20 +277,20 @@ Tk_CreateOldPhotoImageFormat( void Tk_CreatePhotoImageFormat( - Tk_PhotoImageFormat *formatPtr) + const Tk_PhotoImageFormat *formatPtr) /* Structure describing the format. All of the * fields except "nextPtr" must be filled in * by caller. */ { Tk_PhotoImageFormat *copyPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { tsdPtr->initialized = 1; Tcl_CreateThreadExitHandler(PhotoFormatThreadExitProc, NULL); } - copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat)); + copyPtr = ckalloc(sizeof(Tk_PhotoImageFormat)); *copyPtr = *formatPtr; if (isupper((unsigned char) *formatPtr->name)) { copyPtr->nextPtr = tsdPtr->oldFormatList; @@ -574,11 +326,11 @@ static int ImgPhotoCreate( Tcl_Interp *interp, /* Interpreter for application containing * image. */ - char *name, /* Name to use for image. */ + const char *name, /* Name to use for image. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[], /* Argument objects for options (doesn't + Tcl_Obj *const objv[], /* Argument objects for options (doesn't * include image name or type). */ - Tk_ImageType *typePtr, /* Pointer to our type record (not used). */ + const Tk_ImageType *typePtr,/* Pointer to our type record (not used). */ Tk_ImageMaster master, /* Token for image, to be used by us in later * callbacks. */ ClientData *clientDataPtr) /* Store manager's token for image here; it @@ -590,12 +342,12 @@ ImgPhotoCreate( * Allocate and initialize the photo image master record. */ - masterPtr = (PhotoMaster *) ckalloc(sizeof(PhotoMaster)); + masterPtr = ckalloc(sizeof(PhotoMaster)); memset(masterPtr, 0, sizeof(PhotoMaster)); masterPtr->tkMaster = master; masterPtr->interp = interp; masterPtr->imageCmd = Tcl_CreateObjCommand(interp, name, ImgPhotoCmd, - (ClientData) masterPtr, ImgPhotoCmdDeletedProc); + masterPtr, ImgPhotoCmdDeletedProc); masterPtr->palette = NULL; masterPtr->pix32 = NULL; masterPtr->instancePtr = NULL; @@ -606,11 +358,11 @@ ImgPhotoCreate( */ if (ImgPhotoConfigureMaster(interp, masterPtr, objc, objv, 0) != TCL_OK) { - ImgPhotoDelete((ClientData) masterPtr); + ImgPhotoDelete(masterPtr); return TCL_ERROR; } - *clientDataPtr = (ClientData) masterPtr; + *clientDataPtr = masterPtr; return TCL_OK; } @@ -637,9 +389,9 @@ ImgPhotoCmd( ClientData clientData, /* Information about photo master. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *photoOptions[] = { + static const char *const photoOptions[] = { "blank", "cget", "configure", "copy", "data", "get", "put", "read", "redither", "transparency", "write", NULL }; @@ -649,7 +401,7 @@ ImgPhotoCmd( PHOTO_WRITE }; - PhotoMaster *masterPtr = (PhotoMaster *) clientData; + PhotoMaster *masterPtr = clientData; int result, index, x, y, width, height, dataWidth, dataHeight, listObjc; struct SubcommandOptions options; Tcl_Obj **listObjv, **srcObjv; @@ -660,22 +412,17 @@ ImgPhotoCmd( int imageWidth, imageHeight, matched, length, oldformat = 0; Tcl_Channel chan; Tk_PhotoHandle srcHandle; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], photoOptions, "option", 0, &index) != TCL_OK) { - Tcl_ObjCmdProc *proc; - proc = PhotoOptionFind(interp, objv[1]); - if (proc == NULL) { - return TCL_ERROR; - } - return proc(clientData, interp, objc, objv); + return TCL_ERROR; } switch ((enum PhotoOptions) index) { @@ -693,7 +440,7 @@ ImgPhotoCmd( } case PHOTO_CGET: { - char *arg; + const char *arg; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "option"); @@ -748,12 +495,16 @@ ImgPhotoCmd( return TCL_OK; } else if (objc == 3) { - char *arg = Tcl_GetStringFromObj(objv[2], &length); + const char *arg = Tcl_GetStringFromObj(objv[2], &length); if (length > 1 && !strncmp(arg, "-data", (unsigned) length)) { Tcl_AppendResult(interp, "-data {} {} {}", NULL); if (masterPtr->dataString) { - Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + /* + * TODO: Modifying result is bad! + */ + + Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), masterPtr->dataString); } else { Tcl_AppendResult(interp, " {}", NULL); @@ -763,7 +514,11 @@ ImgPhotoCmd( !strncmp(arg, "-format", (unsigned) length)) { Tcl_AppendResult(interp, "-format {} {} {}", NULL); if (masterPtr->format) { - Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + /* + * TODO: Modifying result is bad! + */ + + Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), masterPtr->format); } else { Tcl_AppendResult(interp, " {}", NULL); @@ -773,9 +528,10 @@ ImgPhotoCmd( return Tk_ConfigureInfo(interp, Tk_MainWindow(interp), configSpecs, (char *) masterPtr, arg, 0); } + } else { + return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2, + TK_CONFIG_ARGV_ONLY); } - return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2, - TK_CONFIG_ARGV_ONLY); case PHOTO_COPY: /* @@ -806,17 +562,21 @@ ImgPhotoCmd( srcHandle = Tk_FindPhoto(interp, Tcl_GetString(options.name)); if (srcHandle == NULL) { - Tcl_AppendResult(interp, "image \"", - Tcl_GetString(options.name), "\" doesn't", - " exist or is not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image \"%s\" doesn't exist or is not a photo image", + Tcl_GetString(options.name))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO", + Tcl_GetString(options.name), NULL); return TCL_ERROR; } Tk_PhotoGetImage(srcHandle, &block); if ((options.fromX2 > block.width) || (options.fromY2 > block.height) || (options.fromX2 > block.width) || (options.fromY2 > block.height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside source image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside source image", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -868,8 +628,9 @@ ImgPhotoCmd( if (options.options & OPT_SHRINK) { if (ImgPhotoSetSize(masterPtr, options.toX2, options.toY2) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } } @@ -909,15 +670,16 @@ ImgPhotoCmd( return TCL_ERROR; } if ((options.name != NULL) || (index < objc)) { - Tcl_WrongNumArgs(interp, 2, objv, "?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?"); return TCL_ERROR; } if ((options.fromX > masterPtr->width) || (options.fromY > masterPtr->height) || (options.fromX2 > masterPtr->width) || (options.fromY2 > masterPtr->height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } @@ -925,7 +687,7 @@ ImgPhotoCmd( * Fill in default values for unspecified parameters. */ - if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) { + if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) { options.fromX2 = masterPtr->width; options.fromY2 = masterPtr->height; } @@ -963,9 +725,12 @@ ImgPhotoCmd( } } if (stringWriteProc == NULL) { - Tcl_AppendResult(interp, "image string format \"", - Tcl_GetString(options.format), "\" is ", - (matched ? "not supported" : "unknown"), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image string format \"%s\" is %s", + Tcl_GetString(options.format), + (matched ? "not supported" : "unknown"))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + Tcl_GetString(options.format), NULL); return TCL_ERROR; } } else { @@ -980,23 +745,25 @@ ImgPhotoCmd( if (oldformat) { Tcl_DString buffer; + typedef int (*OldStringWriteProc)(Tcl_Interp *interp, + Tcl_DString *dataPtr, const char *formatString, + Tk_PhotoImageBlock *blockPtr); Tcl_DStringInit(&buffer); - result = ((int (*) (Tcl_Interp *interp, - Tcl_DString *dataPtr, char *formatString, - Tk_PhotoImageBlock *blockPtr)) stringWriteProc) - (interp, &buffer, Tcl_GetString(options.format), &block); + result = ((OldStringWriteProc) stringWriteProc)(interp, &buffer, + Tcl_GetString(options.format), &block); if (result == TCL_OK) { Tcl_DStringResult(interp, &buffer); } else { Tcl_DStringFree(&buffer); } } else { - - result = ((int (*) (Tcl_Interp *interp, + typedef int (*NewStringWriteProc)(Tcl_Interp *interp, Tcl_Obj *formatString, Tk_PhotoImageBlock *blockPtr, - void *dummy)) stringWriteProc) - (interp, options.format, &block, NULL); + void *dummy); + + result = ((NewStringWriteProc) stringWriteProc)(interp, + options.format, &block, NULL); } if (options.background) { Tk_FreeColor(options.background); @@ -1012,7 +779,7 @@ ImgPhotoCmd( * photo get command - first parse and check parameters. */ - char string[TCL_INTEGER_SPACE * 3]; + Tcl_Obj *channels[3]; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "x y"); @@ -1024,8 +791,11 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " get: ", - "coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s get: coordinates out of range", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", + NULL); return TCL_ERROR; } @@ -1034,9 +804,10 @@ ImgPhotoCmd( */ pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4; - sprintf(string, "%d %d %d", pixelPtr[0], pixelPtr[1], - pixelPtr[2]); - Tcl_AppendResult(interp, string, NULL); + channels[0] = Tcl_NewIntObj(pixelPtr[0]); + channels[1] = Tcl_NewIntObj(pixelPtr[1]); + channels[2] = Tcl_NewIntObj(pixelPtr[2]); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, channels)); return TCL_OK; } @@ -1053,7 +824,7 @@ ImgPhotoCmd( return TCL_ERROR; } if ((options.name == NULL) || (index < objc)) { - Tcl_WrongNumArgs(interp, 2, objv, "data ?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "data ?-option value ...?"); return TCL_ERROR; } @@ -1062,7 +833,7 @@ ImgPhotoCmd( &imageHeight, &oldformat) == TCL_OK) { Tcl_Obj *format, *data; - if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) { + if (!(options.options & OPT_TO) || (options.toX2 < 0)) { options.toX2 = options.toX + imageWidth; options.toY2 = options.toY + imageHeight; } @@ -1080,10 +851,9 @@ ImgPhotoCmd( } data = (Tcl_Obj *) Tcl_GetString(data); } - if ((*imageFormat->stringReadProc)(interp, data, - format, (Tk_PhotoHandle) masterPtr, - options.toX, options.toY, imageWidth, imageHeight, - 0, 0) != TCL_OK) { + if (imageFormat->stringReadProc(interp, data, format, + (Tk_PhotoHandle) masterPtr, options.toX, options.toY, + imageWidth, imageHeight, 0, 0) != TCL_OK) { return TCL_ERROR; } masterPtr->flags |= IMAGE_CHANGED; @@ -1116,17 +886,32 @@ ImgPhotoCmd( break; } dataWidth = listObjc; - pixelPtr = (unsigned char *) - ckalloc((unsigned) dataWidth * dataHeight * 3); + /* + * Memory allocation overflow protection. + * May not be able to trigger/ demo / test this. + */ + + if (dataWidth > (int)((UINT_MAX/3) / dataHeight)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "photo image dimensions exceed Tcl memory limits", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "OVERFLOW", NULL); + break; + } + + pixelPtr = ckalloc(dataWidth * dataHeight * 3); block.pixelPtr = pixelPtr; } else if (listObjc != dataWidth) { - Tcl_AppendResult(interp, "all elements of color list must", - " have the same number of elements", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "all elements of color list must have the same" + " number of elements", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NON_RECTANGULAR", NULL); break; } for (x = 0; x < dataWidth; ++x) { - char *colorString = Tcl_GetString(listObjv[x]); + const char *colorString = Tcl_GetString(listObjv[x]); XColor color; int tmpr, tmpg, tmpb; @@ -1164,8 +949,9 @@ ImgPhotoCmd( if (!TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), colorString, &color)) { - Tcl_AppendResult(interp, "can't parse color \"", - colorString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't parse color \"%s\"", colorString)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); break; } *pixelPtr++ = color.red >> 8; @@ -1178,7 +964,7 @@ ImgPhotoCmd( } if (y < dataHeight || dataHeight == 0 || dataWidth == 0) { if (block.pixelPtr != NULL) { - ckfree((char *) block.pixelPtr); + ckfree(block.pixelPtr); } if (y < dataHeight) { return TCL_ERROR; @@ -1203,11 +989,11 @@ ImgPhotoCmd( block.offset[1] = 1; block.offset[2] = 2; block.offset[3] = 0; - result = Tk_PhotoPutBlock(interp, (ClientData)masterPtr, &block, + result = Tk_PhotoPutBlock(interp, masterPtr, &block, options.toX, options.toY, options.toX2 - options.toX, options.toY2 - options.toY, TK_PHOTO_COMPOSITE_SET); - ckfree((char *) block.pixelPtr); + ckfree(block.pixelPtr); return result; case PHOTO_READ: { @@ -1227,7 +1013,7 @@ ImgPhotoCmd( return TCL_ERROR; } if ((options.name == NULL) || (index < objc)) { - Tcl_WrongNumArgs(interp, 2, objv, "fileName ?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "fileName ?-option value ...?"); return TCL_ERROR; } @@ -1236,8 +1022,9 @@ ImgPhotoCmd( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get image from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get image from a file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL); return TCL_ERROR; } @@ -1275,12 +1062,14 @@ ImgPhotoCmd( if ((options.fromX > imageWidth) || (options.fromY > imageHeight) || (options.fromX2 > imageWidth) || (options.fromY2 > imageHeight)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside source image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside source image", + -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); Tcl_Close(NULL, chan); return TCL_ERROR; } - if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) { + if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) { width = imageWidth - options.fromX; height = imageHeight - options.fromY; } else { @@ -1296,7 +1085,9 @@ ImgPhotoCmd( if (ImgPhotoSetSize(masterPtr, options.toX + width, options.toY + height) != TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); return TCL_ERROR; } } @@ -1310,7 +1101,7 @@ ImgPhotoCmd( if (oldformat && format) { format = (Tcl_Obj *) Tcl_GetString(format); } - result = (*imageFormat->fileReadProc)(interp, chan, + result = imageFormat->fileReadProc(interp, chan, Tcl_GetString(options.name), format, (Tk_PhotoHandle) masterPtr, options.toX, options.toY, width, height, options.fromX, options.fromY); @@ -1356,7 +1147,7 @@ ImgPhotoCmd( return TCL_OK; case PHOTO_TRANS: { - static const char *photoTransOptions[] = { + static const char *const photoTransOptions[] = { "get", "set", NULL }; enum transOptions { @@ -1364,7 +1155,7 @@ ImgPhotoCmd( }; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], photoTransOptions, "option", @@ -1386,9 +1177,12 @@ ImgPhotoCmd( return TCL_ERROR; } if ((x < 0) || (x >= masterPtr->width) - || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), - " transparency get: coordinates out of range", NULL); + || (y < 0) || (y >= masterPtr->height)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s transparency get: coordinates out of range", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", + NULL); return TCL_ERROR; } @@ -1403,8 +1197,8 @@ ImgPhotoCmd( TkClipBox(testRegion, &testBox); TkDestroyRegion(testRegion); - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), - (testBox.width==0 && testBox.height==0)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + testBox.width==0 && testBox.height==0)); return TCL_OK; } @@ -1424,8 +1218,11 @@ ImgPhotoCmd( } if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { - Tcl_AppendResult(interp, Tcl_GetString(objv[0]), - " transparency set: coordinates out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s transparency set: coordinates out of range", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", + NULL); return TCL_ERROR; } @@ -1479,15 +1276,18 @@ ImgPhotoCmd( case PHOTO_WRITE: { char *data; + const char *fmtString; Tcl_Obj *format; + int usedExt; /* * Prevent file system access in safe interpreters. */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't write image to a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't write image to a file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL); return TCL_ERROR; } @@ -1505,26 +1305,36 @@ ImgPhotoCmd( return TCL_ERROR; } if ((options.name == NULL) || (index < objc)) { - Tcl_WrongNumArgs(interp, 2, objv, "fileName ?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "fileName ?-option value ...?"); return TCL_ERROR; } if ((options.fromX > masterPtr->width) || (options.fromY > masterPtr->height) || (options.fromX2 > masterPtr->width) || (options.fromY2 > masterPtr->height)) { - Tcl_AppendResult(interp, "coordinates for -from option extend ", - "outside image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "coordinates for -from option extend outside image", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_FROM", NULL); return TCL_ERROR; } /* - * Fill in default values for unspecified parameters. + * Fill in default values for unspecified parameters. Note that a + * missing -format flag results in us having a guess from the file + * extension. [Bug 2983824] */ if (!(options.options & OPT_FROM) || (options.fromX2 < 0)) { options.fromX2 = masterPtr->width; options.fromY2 = masterPtr->height; } + if (options.format == NULL) { + fmtString = GetExtension(Tcl_GetString(options.name)); + usedExt = (fmtString != NULL); + } else { + fmtString = Tcl_GetString(options.format); + usedExt = 0; + } /* * Search for an appropriate image file format handler, and give an @@ -1532,11 +1342,12 @@ ImgPhotoCmd( */ matched = 0; + redoFormatLookup: for (imageFormat = tsdPtr->formatList; imageFormat != NULL; imageFormat = imageFormat->nextPtr) { - if ((options.format == NULL) - || (strncasecmp(Tcl_GetString(options.format), - imageFormat->name, strlen(imageFormat->name)) == 0)) { + if ((fmtString == NULL) + || (strncasecmp(fmtString, imageFormat->name, + strlen(imageFormat->name)) == 0)) { matched = 1; if (imageFormat->fileWriteProc != NULL) { break; @@ -1547,9 +1358,9 @@ ImgPhotoCmd( oldformat = 1; for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL; imageFormat = imageFormat->nextPtr) { - if ((options.format == NULL) - || (strncasecmp(Tcl_GetString(options.format), - imageFormat->name, strlen(imageFormat->name)) == 0)) { + if ((fmtString == NULL) + || (strncasecmp(fmtString, imageFormat->name, + strlen(imageFormat->name)) == 0)) { matched = 1; if (imageFormat->fileWriteProc != NULL) { break; @@ -1557,19 +1368,32 @@ ImgPhotoCmd( } } } + if (usedExt && !matched) { + /* + * If we didn't find one and we're using file extensions as the + * basis for the guessing, go back and look again without + * prejudice. Supports old broken code. + */ + + usedExt = 0; + fmtString = NULL; + goto redoFormatLookup; + } if (imageFormat == NULL) { - if (options.format == NULL) { - Tcl_AppendResult(interp, "no available image file format ", - "has file writing capability", NULL); + if (fmtString == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no available image file format has file writing" + " capability", -1)); } else if (!matched) { - Tcl_AppendResult(interp, "image file format \"", - Tcl_GetString(options.format), - "\" is unknown", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" is unknown", fmtString)); } else { - Tcl_AppendResult(interp, "image file format \"", - Tcl_GetString(options.format), - "\" has no file writing capability", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" has no file writing capability", + fmtString)); } + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + fmtString, NULL); return TCL_ERROR; } @@ -1582,7 +1406,7 @@ ImgPhotoCmd( if (oldformat && format) { format = (Tcl_Obj *) Tcl_GetString(options.format); } - result = (*imageFormat->fileWriteProc)(interp, + result = imageFormat->fileWriteProc(interp, Tcl_GetString(options.name), format, &block); if (options.background) { Tk_FreeColor(options.background); @@ -1601,6 +1425,36 @@ ImgPhotoCmd( /* *---------------------------------------------------------------------- * + * GetExtension -- + * + * Return the extension part of a path, or NULL if there is no extension. + * The returned string will be a substring of the argument string, so + * should not be ckfree()d directly. No side effects. + * + *---------------------------------------------------------------------- + */ + +static const char * +GetExtension( + const char *path) +{ + char c; + const char *extension = NULL; + + for (; (c=*path++) != '\0' ;) { + if (c == '.') { + extension = path; + } + } + if (extension != NULL && extension[0] == '\0') { + extension = NULL; + } + return extension; +} + +/* + *---------------------------------------------------------------------- + * * ParseSubcommandOptions -- * * This function is invoked to process one of the options which may be @@ -1630,10 +1484,16 @@ ParseSubcommandOptions( int objc, /* Number of arguments in objv[]. */ Tcl_Obj *const objv[]) /* Arguments to be parsed. */ { + static const char *const compositingRules[] = { + "overlay", "set", /* Note that these must match the + * TK_PHOTO_COMPOSITE_* constants. */ + NULL + }; int index, c, bit, currentBit, length; int values[4], numValues, maxValues, argIndex; - char *option; + const char *option, *expandedOption, *needed; const char *const *listPtr; + Tcl_Obj *msgObj; for (index = *optIndexPtr; index < objc; *optIndexPtr = ++index) { /* @@ -1641,7 +1501,7 @@ ParseSubcommandOptions( * optPtr->name. */ - option = Tcl_GetStringFromObj(objv[index], &length); + expandedOption = option = Tcl_GetStringFromObj(objv[index], &length); if (option[0] != '-') { if (optPtr->name == NULL) { optPtr->name = objv[index]; @@ -1660,9 +1520,9 @@ ParseSubcommandOptions( for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { if ((c == *listPtr[0]) && (strncmp(option, *listPtr, (size_t) length) == 0)) { + expandedOption = *listPtr; if (bit != 0) { - bit = 0; /* An ambiguous option. */ - break; + goto unknownOrAmbiguousOption; } bit = currentBit; } @@ -1674,24 +1534,8 @@ ParseSubcommandOptions( * in the interpreter and return. */ - if ((allowedOptions & bit) == 0) { - Tcl_AppendResult(interp, "unrecognized option \"", - Tcl_GetString(objv[index]), - "\": must be ", NULL); - bit = 1; - for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { - if ((allowedOptions & bit) != 0) { - if ((allowedOptions & (bit - 1)) != 0) { - Tcl_AppendResult(interp, ", ", NULL); - if ((allowedOptions & ~((bit << 1) - 1)) == 0) { - Tcl_AppendResult(interp, "or ", NULL); - } - } - Tcl_AppendResult(interp, *listPtr, NULL); - } - bit <<= 1; - } - return TCL_ERROR; + if (!(allowedOptions & bit)) { + goto unknownOrAmbiguousOption; } /* @@ -1704,16 +1548,13 @@ ParseSubcommandOptions( * The -background option takes a single XColor value. */ - if (index + 1 < objc) { - *optIndexPtr = ++index; - optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp), - Tk_GetUid(Tcl_GetString(objv[index]))); - if (!optPtr->background) { - return TCL_ERROR; - } - } else { - Tcl_AppendResult(interp, "the \"-background\" option ", - "requires a value", NULL); + if (index + 1 >= objc) { + goto oneValueRequired; + } + *optIndexPtr = ++index; + optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp), + Tk_GetUid(Tcl_GetString(objv[index]))); + if (!optPtr->background) { return TCL_ERROR; } } else if (bit == OPT_FORMAT) { @@ -1722,45 +1563,31 @@ ParseSubcommandOptions( * parsing this is outside the scope of this function. */ - if (index + 1 < objc) { - *optIndexPtr = ++index; - optPtr->format = objv[index]; - } else { - Tcl_AppendResult(interp, "the \"-format\" option ", - "requires a value", NULL); - return TCL_ERROR; + if (index + 1 >= objc) { + goto oneValueRequired; } + *optIndexPtr = ++index; + optPtr->format = objv[index]; } else if (bit == OPT_COMPOSITE) { /* * The -compositingrule option takes a single value from a * well-known set. */ - if (index + 1 < objc) { - /* - * Note that these must match the TK_PHOTO_COMPOSITE_* - * constants. - */ - - static const char *compositingRules[] = { - "overlay", "set", NULL - }; - - index++; - if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules, - "compositing rule", 0, &optPtr->compositingRule) - != TCL_OK) { - return TCL_ERROR; - } - *optIndexPtr = index; - } else { - Tcl_AppendResult(interp, "the \"-compositingrule\" option ", - "requires a value", NULL); + if (index + 1 >= objc) { + goto oneValueRequired; + } + index++; + if (Tcl_GetIndexFromObj(interp, objv[index], compositingRules, + "compositing rule", 0, &optPtr->compositingRule) + != TCL_OK) { return TCL_ERROR; } + *optIndexPtr = index; } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) { - char *val; - maxValues = ((bit == OPT_FROM) || (bit == OPT_TO))? 4: 2; + const char *val; + + maxValues = ((bit == OPT_FROM) || (bit == OPT_TO)) ? 4 : 2; argIndex = index + 1; for (numValues = 0; numValues < maxValues; ++numValues) { if (argIndex >= objc) { @@ -1776,14 +1603,11 @@ ParseSubcommandOptions( } else { break; } - ++argIndex; + argIndex++; } if (numValues == 0) { - Tcl_AppendResult(interp, "the \"", option, "\" option ", - "requires one ", maxValues == 2? "or two": "to four", - " integer values", NULL); - return TCL_ERROR; + goto manyValuesRequired; } *optIndexPtr = (index += numValues); @@ -1807,9 +1631,8 @@ ParseSubcommandOptions( case OPT_FROM: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_AppendResult(interp, "value(s) for the -from", - " option must be non-negative", NULL); - return TCL_ERROR; + needed = "non-negative"; + goto numberOutOfRange; } if (numValues <= 2) { optPtr->fromX = values[0]; @@ -1830,9 +1653,8 @@ ParseSubcommandOptions( case OPT_TO: if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2) && ((values[2] < 0) || (values[3] < 0)))) { - Tcl_AppendResult(interp, "value(s) for the -to", - " option must be non-negative", NULL); - return TCL_ERROR; + needed = "non-negative"; + goto numberOutOfRange; } if (numValues <= 2) { optPtr->toX = values[0]; @@ -1848,9 +1670,8 @@ ParseSubcommandOptions( break; case OPT_ZOOM: if ((values[0] <= 0) || (values[1] <= 0)) { - Tcl_AppendResult(interp, "value(s) for the -zoom", - " option must be positive", NULL); - return TCL_ERROR; + needed = "positive"; + goto numberOutOfRange; } optPtr->zoomX = values[0]; optPtr->zoomY = values[1]; @@ -1864,8 +1685,50 @@ ParseSubcommandOptions( optPtr->options |= bit; } - return TCL_OK; + + /* + * Exception generation. + */ + + oneValueRequired: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the \"%s\" option requires a value", expandedOption)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "MISSING_VALUE", NULL); + return TCL_ERROR; + + manyValuesRequired: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "the \"%s\" option requires one %s integer values", + expandedOption, (maxValues == 2) ? "or two": "to four")); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "MISSING_VALUE", NULL); + return TCL_ERROR; + + numberOutOfRange: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value(s) for the %s option must be %s", expandedOption, needed)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_VALUE", NULL); + return TCL_ERROR; + + unknownOrAmbiguousOption: + msgObj = Tcl_ObjPrintf("unrecognized option \"%s\": must be ", option); + bit = 1; + for (listPtr = optionNames; *listPtr != NULL; ++listPtr) { + if (allowedOptions & bit) { + if (allowedOptions & (bit - 1)) { + if (allowedOptions & ~((bit << 1) - 1)) { + Tcl_AppendToObj(msgObj, ", ", -1); + } else { + Tcl_AppendToObj(msgObj, ", or ", -1); + } + } + Tcl_AppendToObj(msgObj, *listPtr, -1); + } + bit <<= 1; + } + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL); + return TCL_ERROR; } /* @@ -1908,7 +1771,7 @@ ImgPhotoConfigureMaster( Tk_PhotoImageFormat *imageFormat; const char **args; - args = (const char **) ckalloc((objc + 1) * sizeof(char *)); + args = ckalloc((objc + 1) * sizeof(char *)); for (i = 0, j = 0; i < objc; i++,j++) { args[j] = Tcl_GetStringFromObj(objv[i], &length); if ((length > 1) && (args[j][0] == '-')) { @@ -1918,8 +1781,11 @@ ImgPhotoConfigureMaster( data = objv[i]; j--; } else { - Tcl_AppendResult(interp, - "value for \"-data\" missing", NULL); + ckfree(args); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-data\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "MISSING_VALUE", NULL); return TCL_ERROR; } } else if ((args[j][1] == 'f') && @@ -1928,8 +1794,11 @@ ImgPhotoConfigureMaster( format = objv[i]; j--; } else { - Tcl_AppendResult(interp, - "value for \"-format\" missing", NULL); + ckfree(args); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "value for \"-format\" missing", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "MISSING_VALUE", NULL); return TCL_ERROR; } } @@ -1965,10 +1834,10 @@ ImgPhotoConfigureMaster( if (Tk_ConfigureWidget(interp, Tk_MainWindow(interp), configSpecs, j, args, (char *) masterPtr, flags) != TCL_OK) { - ckfree((char *) args); + ckfree(args); goto errorExit; } - ckfree((char *) args); + ckfree(args); /* * Regard the empty string for -file, -data or -format as the null value. @@ -2019,8 +1888,9 @@ ImgPhotoConfigureMaster( if (ImgPhotoSetSize(masterPtr, masterPtr->width, masterPtr->height) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } @@ -2032,15 +1902,16 @@ ImgPhotoConfigureMaster( if ((masterPtr->fileString != NULL) && ((masterPtr->fileString != oldFileString) || (masterPtr->format != oldFormat))) { - /* * Prevent file system access in a safe interpreter. */ if (Tcl_IsSafe(interp)) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "can't get image from a file in a safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get image from a file in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PHOTO_FILE", NULL); goto errorExit; } @@ -2064,15 +1935,16 @@ ImgPhotoConfigureMaster( result = ImgPhotoSetSize(masterPtr, imageWidth, imageHeight); if (result != TCL_OK) { Tcl_Close(NULL, chan); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } tempformat = masterPtr->format; if (oldformat && tempformat) { tempformat = (Tcl_Obj *) Tcl_GetString(tempformat); } - result = (*imageFormat->fileReadProc)(interp, chan, + result = imageFormat->fileReadProc(interp, chan, masterPtr->fileString, tempformat, (Tk_PhotoHandle) masterPtr, 0, 0, imageWidth, imageHeight, 0, 0); Tcl_Close(NULL, chan); @@ -2094,8 +1966,9 @@ ImgPhotoConfigureMaster( goto errorExit; } if (ImgPhotoSetSize(masterPtr, imageWidth, imageHeight) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); goto errorExit; } tempformat = masterPtr->format; @@ -2106,9 +1979,9 @@ ImgPhotoConfigureMaster( } tempdata = (Tcl_Obj *) Tcl_GetString(tempdata); } - if ((*imageFormat->stringReadProc)(interp, tempdata, - tempformat, (Tk_PhotoHandle) masterPtr, - 0, 0, imageWidth, imageHeight, 0, 0) != TCL_OK) { + if (imageFormat->stringReadProc(interp, tempdata, tempformat, + (Tk_PhotoHandle) masterPtr, 0, 0, imageWidth, imageHeight, + 0, 0) != TCL_OK) { goto errorExit; } @@ -2137,7 +2010,7 @@ ImgPhotoConfigureMaster( for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) { - ImgPhotoConfigureInstance(instancePtr); + TkImgPhotoConfigureInstance(instancePtr); } /* @@ -2172,333 +2045,6 @@ ImgPhotoConfigureMaster( /* *---------------------------------------------------------------------- * - * ImgPhotoConfigureInstance -- - * - * This function is called to create displaying information for a photo - * image instance based on the configuration information in the master. - * It is invoked both when new instances are created and when the master - * is reconfigured. - * - * Results: - * None. - * - * Side effects: - * Generates errors via Tcl_BackgroundError if there are problems in - * setting up the instance. - * - *---------------------------------------------------------------------- - */ - -static void -ImgPhotoConfigureInstance( - PhotoInstance *instancePtr) /* Instance to reconfigure. */ -{ - PhotoMaster *masterPtr = instancePtr->masterPtr; - XImage *imagePtr; - int bitsPerPixel; - ColorTable *colorTablePtr; - XRectangle validBox; - - /* - * If the -palette configuration option has been set for the master, use - * the value specified for our palette, but only if it is a valid palette - * for our windows. Use the gamma value specified the master. - */ - - if ((masterPtr->palette && masterPtr->palette[0]) - && IsValidPalette(instancePtr, masterPtr->palette)) { - instancePtr->palette = masterPtr->palette; - } else { - instancePtr->palette = instancePtr->defaultPalette; - } - instancePtr->gamma = masterPtr->gamma; - - /* - * If we don't currently have a color table, or if the one we have no - * longer applies (e.g. because our palette or gamma has changed), get a - * new one. - */ - - colorTablePtr = instancePtr->colorTablePtr; - if ((colorTablePtr == NULL) - || (instancePtr->colormap != colorTablePtr->id.colormap) - || (instancePtr->palette != colorTablePtr->id.palette) - || (instancePtr->gamma != colorTablePtr->id.gamma)) { - /* - * Free up our old color table, and get a new one. - */ - - if (colorTablePtr != NULL) { - colorTablePtr->liveRefCount -= 1; - FreeColorTable(colorTablePtr, 0); - } - GetColorTable(instancePtr); - - /* - * Create a new XImage structure for sending data to the X server, if - * necessary. - */ - - if (instancePtr->colorTablePtr->flags & BLACK_AND_WHITE) { - bitsPerPixel = 1; - } else { - bitsPerPixel = instancePtr->visualInfo.depth; - } - - if ((instancePtr->imagePtr == NULL) - || (instancePtr->imagePtr->bits_per_pixel != bitsPerPixel)) { - if (instancePtr->imagePtr != NULL) { - XDestroyImage(instancePtr->imagePtr); - } - imagePtr = XCreateImage(instancePtr->display, - instancePtr->visualInfo.visual, (unsigned) bitsPerPixel, - (bitsPerPixel > 1? ZPixmap: XYBitmap), 0, NULL, - 1, 1, 32, 0); - instancePtr->imagePtr = imagePtr; - - /* - * We create images using the local host's endianness, rather than - * the endianness of the server; otherwise we would have to - * byte-swap any 16 or 32 bit values that we store in the image - * if the server's endianness is different from ours. - */ - - if (imagePtr != NULL) { -#ifdef WORDS_BIGENDIAN - imagePtr->byte_order = MSBFirst; -#else - imagePtr->byte_order = LSBFirst; -#endif - _XInitImageFuncPtrs(imagePtr); - } - } - } - - /* - * If the user has specified a width and/or height for the master which is - * different from our current width/height, set the size to the values - * specified by the user. If we have no pixmap, we do this also, since it - * has the side effect of allocating a pixmap for us. - */ - - if ((instancePtr->pixels == None) || (instancePtr->error == NULL) - || (instancePtr->width != masterPtr->width) - || (instancePtr->height != masterPtr->height)) { - ImgPhotoInstanceSetSize(instancePtr); - } - - /* - * Redither this instance if necessary. - */ - - if ((masterPtr->flags & IMAGE_CHANGED) - || (instancePtr->colorTablePtr != colorTablePtr)) { - TkClipBox(masterPtr->validRegion, &validBox); - if ((validBox.width > 0) && (validBox.height > 0)) { - DitherInstance(instancePtr, validBox.x, validBox.y, - validBox.width, validBox.height); - } - } -} - -/* - *---------------------------------------------------------------------- - * - * ImgPhotoGet -- - * - * This function is called for each use of a photo image in a widget. - * - * Results: - * The return value is a token for the instance, which is passed back to - * us in calls to ImgPhotoDisplay and ImgPhotoFree. - * - * Side effects: - * A data structure is set up for the instance (or, an existing instance - * is re-used for the new one). - * - *---------------------------------------------------------------------- - */ - -static ClientData -ImgPhotoGet( - Tk_Window tkwin, /* Window in which the instance will be - * used. */ - ClientData masterData) /* Pointer to our master structure for the - * image. */ -{ - PhotoMaster *masterPtr = (PhotoMaster *) masterData; - PhotoInstance *instancePtr; - Colormap colormap; - int mono, nRed, nGreen, nBlue, numVisuals; - XVisualInfo visualInfo, *visInfoPtr; - char buf[TCL_INTEGER_SPACE * 3]; - XColor *white, *black; - XGCValues gcValues; - - /* - * Table of "best" choices for palette for PseudoColor displays with - * between 3 and 15 bits/pixel. - */ - - static const int paletteChoice[13][3] = { - /* #red, #green, #blue */ - {2, 2, 2, /* 3 bits, 8 colors */}, - {2, 3, 2, /* 4 bits, 12 colors */}, - {3, 4, 2, /* 5 bits, 24 colors */}, - {4, 5, 3, /* 6 bits, 60 colors */}, - {5, 6, 4, /* 7 bits, 120 colors */}, - {7, 7, 4, /* 8 bits, 198 colors */}, - {8, 10, 6, /* 9 bits, 480 colors */}, - {10, 12, 8, /* 10 bits, 960 colors */}, - {14, 15, 9, /* 11 bits, 1890 colors */}, - {16, 20, 12, /* 12 bits, 3840 colors */}, - {20, 24, 16, /* 13 bits, 7680 colors */}, - {26, 30, 20, /* 14 bits, 15600 colors */}, - {32, 32, 30, /* 15 bits, 30720 colors */} - }; - - /* - * See if there is already an instance for windows using the same - * colormap. If so then just re-use it. - */ - - colormap = Tk_Colormap(tkwin); - for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; - instancePtr = instancePtr->nextPtr) { - if ((colormap == instancePtr->colormap) - && (Tk_Display(tkwin) == instancePtr->display)) { - /* - * Re-use this instance. - */ - - if (instancePtr->refCount == 0) { - /* - * We are resurrecting this instance. - */ - - Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr); - if (instancePtr->colorTablePtr != NULL) { - FreeColorTable(instancePtr->colorTablePtr, 0); - } - GetColorTable(instancePtr); - } - instancePtr->refCount++; - return (ClientData) instancePtr; - } - } - - /* - * The image isn't already in use in a window with the same colormap. Make - * a new instance of the image. - */ - - instancePtr = (PhotoInstance *) ckalloc(sizeof(PhotoInstance)); - instancePtr->masterPtr = masterPtr; - instancePtr->display = Tk_Display(tkwin); - instancePtr->colormap = Tk_Colormap(tkwin); - Tk_PreserveColormap(instancePtr->display, instancePtr->colormap); - instancePtr->refCount = 1; - instancePtr->colorTablePtr = NULL; - instancePtr->pixels = None; - instancePtr->error = NULL; - instancePtr->width = 0; - instancePtr->height = 0; - instancePtr->imagePtr = 0; - instancePtr->nextPtr = masterPtr->instancePtr; - masterPtr->instancePtr = instancePtr; - - /* - * Obtain information about the visual and decide on the default palette. - */ - - visualInfo.screen = Tk_ScreenNumber(tkwin); - visualInfo.visualid = XVisualIDFromVisual(Tk_Visual(tkwin)); - visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), - VisualScreenMask | VisualIDMask, &visualInfo, &numVisuals); - if (visInfoPtr == NULL) { - Tcl_Panic("ImgPhotoGet couldn't find visual for window"); - } - - nRed = 2; - nGreen = nBlue = 0; - mono = 1; - instancePtr->visualInfo = *visInfoPtr; - switch (visInfoPtr->class) { - case DirectColor: - case TrueColor: - nRed = 1 << CountBits(visInfoPtr->red_mask); - nGreen = 1 << CountBits(visInfoPtr->green_mask); - nBlue = 1 << CountBits(visInfoPtr->blue_mask); - mono = 0; - break; - case PseudoColor: - case StaticColor: - if (visInfoPtr->depth > 15) { - nRed = 32; - nGreen = 32; - nBlue = 32; - mono = 0; - } else if (visInfoPtr->depth >= 3) { - const int *ip = paletteChoice[visInfoPtr->depth - 3]; - - nRed = ip[0]; - nGreen = ip[1]; - nBlue = ip[2]; - mono = 0; - } - break; - case GrayScale: - case StaticGray: - nRed = 1 << visInfoPtr->depth; - break; - } - XFree((char *) visInfoPtr); - - if (mono) { - sprintf(buf, "%d", nRed); - } else { - sprintf(buf, "%d/%d/%d", nRed, nGreen, nBlue); - } - instancePtr->defaultPalette = Tk_GetUid(buf); - - /* - * Make a GC with background = black and foreground = white. - */ - - white = Tk_GetColor(masterPtr->interp, tkwin, "white"); - black = Tk_GetColor(masterPtr->interp, tkwin, "black"); - gcValues.foreground = (white != NULL)? white->pixel: - WhitePixelOfScreen(Tk_Screen(tkwin)); - gcValues.background = (black != NULL)? black->pixel: - BlackPixelOfScreen(Tk_Screen(tkwin)); - Tk_FreeColor(white); - Tk_FreeColor(black); - gcValues.graphics_exposures = False; - instancePtr->gc = Tk_GetGC(tkwin, - GCForeground|GCBackground|GCGraphicsExposures, &gcValues); - - /* - * Set configuration options and finish the initialization of the - * instance. This will also dither the image if necessary. - */ - - ImgPhotoConfigureInstance(instancePtr); - - /* - * If this is the first instance, must set the size of the image. - */ - - if (instancePtr->nextPtr == NULL) { - Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, - masterPtr->width, masterPtr->height); - } - - return (ClientData) instancePtr; -} - -/* - *---------------------------------------------------------------------- - * * ToggleComplexAlphaIfNeeded -- * * This function is called when an image is modified to check if any @@ -2518,8 +2064,8 @@ static int ToggleComplexAlphaIfNeeded( PhotoMaster *mPtr) { - size_t len = MAX(mPtr->userWidth, mPtr->width) * - MAX(mPtr->userHeight, mPtr->height) * 4; + size_t len = (size_t)MAX(mPtr->userWidth, mPtr->width) * + (size_t)MAX(mPtr->userHeight, mPtr->height) * 4; unsigned char *c = mPtr->pix32; unsigned char *end = c + len; @@ -2529,6 +2075,9 @@ ToggleComplexAlphaIfNeeded( */ mPtr->flags &= ~COMPLEX_ALPHA; + if (c == NULL) { + return 0; + } c += 3; /* Start at first alpha byte. */ for (; c < end; c += 4) { if (*c && *c != 255) { @@ -2542,351 +2091,6 @@ ToggleComplexAlphaIfNeeded( /* *---------------------------------------------------------------------- * - * ImgPhotoBlendComplexAlpha -- - * - * This function is called when an image with partially transparent - * pixels must be drawn over another image. It blends the photo data onto - * a local copy of the surface that we are drawing on, *including* the - * pixels drawn by everything that should be drawn underneath the image. - * - * Much of this code has hard-coded values in for speed because this - * routine is performance critical for complex image drawing. - * - * Results: - * None. - * - * Side effects: - * Background image passed in gets drawn over with image data. - * - * Notes: - * This should work on all platforms that set mask and shift data - * properly from the visualInfo. RGB is really only a 24+ bpp version - * whereas RGB15 is the correct version and works for 15bpp+, but it - * slower, so it's only used for 15bpp+. - * - * Note that Win32 pre-defines those operations that we really need. - * - *---------------------------------------------------------------------- - */ - -#ifndef __WIN32__ -#define GetRValue(rgb) (UCHAR(((rgb) & red_mask) >> red_shift)) -#define GetGValue(rgb) (UCHAR(((rgb) & green_mask) >> green_shift)) -#define GetBValue(rgb) (UCHAR(((rgb) & blue_mask) >> blue_shift)) -#define RGB(r, g, b) ((unsigned)( \ - (UCHAR(r) << red_shift) | \ - (UCHAR(g) << green_shift) | \ - (UCHAR(b) << blue_shift) )) -#define RGB15(r, g, b) ((unsigned)( \ - (((r) * red_mask / 255) & red_mask) | \ - (((g) * green_mask / 255) & green_mask) | \ - (((b) * blue_mask / 255) & blue_mask) )) -#endif /* !__WIN32__ */ - -static void -ImgPhotoBlendComplexAlpha( - XImage *bgImg, /* Background image to draw on. */ - PhotoInstance *iPtr, /* Image instance to draw. */ - int xOffset, int yOffset, /* X & Y offset into image instance to - * draw. */ - int width, int height) /* Width & height of image to draw. */ -{ - int x, y, line; - unsigned long pixel; - unsigned char r, g, b, alpha, unalpha, *masterPtr; - unsigned char *alphaAr = iPtr->masterPtr->pix32; - - /* - * This blending is an integer version of the Source-Over compositing rule - * (see Porter&Duff, "Compositing Digital Images", proceedings of SIGGRAPH - * 1984) that has been hard-coded (for speed) to work with targetting a - * solid surface. - * - * The 'unalpha' field must be 255-alpha; it is separated out to encourage - * more efficient compilation. - */ - -#define ALPHA_BLEND(bgPix, imgPix, alpha, unalpha) \ - ((bgPix * unalpha + imgPix * alpha) / 255) - - /* - * We have to get the mask and shift info from the visual on non-Win32 so - * that the macros Get*Value(), RGB() and RGB15() work correctly. This - * might be cached for better performance. - */ - -#ifndef __WIN32__ - unsigned long red_mask, green_mask, blue_mask; - unsigned long red_shift, green_shift, blue_shift; - Visual *visual = iPtr->visualInfo.visual; - - red_mask = visual->red_mask; - green_mask = visual->green_mask; - blue_mask = visual->blue_mask; - red_shift = 0; - green_shift = 0; - blue_shift = 0; - while ((0x0001 & (red_mask >> red_shift)) == 0) { - red_shift++; - } - while ((0x0001 & (green_mask >> green_shift)) == 0) { - green_shift++; - } - while ((0x0001 & (blue_mask >> blue_shift)) == 0) { - blue_shift++; - } -#endif /* !__WIN32__ */ - - /* - * Only UNIX requires the special case for <24bpp. It varies with 3 extra - * shifts and uses RGB15. The 24+bpp version could also then be further - * optimized. - */ - -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) - if (bgImg->depth < 24) { - unsigned char red_mlen, green_mlen, blue_mlen; - - red_mlen = 8 - CountBits(red_mask >> red_shift); - green_mlen = 8 - CountBits(green_mask >> green_shift); - blue_mlen = 8 - CountBits(blue_mask >> blue_shift); - for (y = 0; y < height; y++) { - line = (y + yOffset) * iPtr->masterPtr->width; - for (x = 0; x < width; x++) { - masterPtr = alphaAr + ((line + x + xOffset) * 4); - alpha = masterPtr[3]; - - /* - * Ignore pixels that are fully transparent - */ - - if (alpha) { - /* - * We could perhaps be more efficient than XGetPixel for - * 24 and 32 bit displays, but this seems "fast enough". - */ - - r = masterPtr[0]; - g = masterPtr[1]; - b = masterPtr[2]; - if (alpha != 255) { - /* - * Only blend pixels that have some transparency - */ - - unsigned char ra, ga, ba; - - pixel = XGetPixel(bgImg, x, y); - ra = GetRValue(pixel) << red_mlen; - ga = GetGValue(pixel) << green_mlen; - ba = GetBValue(pixel) << blue_mlen; - unalpha = 255 - alpha; /* Calculate once. */ - r = ALPHA_BLEND(ra, r, alpha, unalpha); - g = ALPHA_BLEND(ga, g, alpha, unalpha); - b = ALPHA_BLEND(ba, b, alpha, unalpha); - } - XPutPixel(bgImg, x, y, RGB15(r, g, b)); - } - } - } - return; - } -#endif /* !__WIN32__ && !MAC_OSX_TK */ - - for (y = 0; y < height; y++) { - line = (y + yOffset) * iPtr->masterPtr->width; - for (x = 0; x < width; x++) { - masterPtr = alphaAr + ((line + x + xOffset) * 4); - alpha = masterPtr[3]; - - /* - * Ignore pixels that are fully transparent - */ - - if (alpha) { - /* - * We could perhaps be more efficient than XGetPixel for 24 - * and 32 bit displays, but this seems "fast enough". - */ - - r = masterPtr[0]; - g = masterPtr[1]; - b = masterPtr[2]; - if (alpha != 255) { - /* - * Only blend pixels that have some transparency - */ - - unsigned char ra, ga, ba; - - pixel = XGetPixel(bgImg, x, y); - ra = GetRValue(pixel); - ga = GetGValue(pixel); - ba = GetBValue(pixel); - unalpha = 255 - alpha; /* Calculate once. */ - r = ALPHA_BLEND(ra, r, alpha, unalpha); - g = ALPHA_BLEND(ga, g, alpha, unalpha); - b = ALPHA_BLEND(ba, b, alpha, unalpha); - } - XPutPixel(bgImg, x, y, RGB(r, g, b)); - } - } - } -#undef ALPHA_BLEND -} - -/* - *---------------------------------------------------------------------- - * - * ImgPhotoDisplay -- - * - * This function is invoked to draw a photo image. - * - * Results: - * None. - * - * Side effects: - * A portion of the image gets rendered in a pixmap or window. - * - *---------------------------------------------------------------------- - */ - -static void -ImgPhotoDisplay( - ClientData clientData, /* Pointer to PhotoInstance structure for - * instance to be displayed. */ - Display *display, /* Display on which to draw image. */ - Drawable drawable, /* Pixmap or window in which to draw image. */ - int imageX, int imageY, /* Upper-left corner of region within image to - * draw. */ - int width, int height, /* Dimensions of region within image to - * draw. */ - int drawableX,int drawableY)/* Coordinates within drawable that correspond - * to imageX and imageY. */ -{ - PhotoInstance *instancePtr = (PhotoInstance *) clientData; - XVisualInfo visInfo = instancePtr->visualInfo; - - /* - * If there's no pixmap, it means that an error occurred while creating - * the image instance so it can't be displayed. - */ - - if (instancePtr->pixels == None) { - return; - } - - if ((instancePtr->masterPtr->flags & COMPLEX_ALPHA) - && visInfo.depth >= 15 - && (visInfo.class == DirectColor || visInfo.class == TrueColor)) { - Tk_ErrorHandler handler; - XImage *bgImg = NULL; - - /* - * Create an error handler to suppress the case where the input was - * not properly constrained, which can cause an X error. [Bug 979239] - */ - - handler = Tk_CreateErrorHandler(display, -1, -1, -1, NULL, - (ClientData) NULL); - - /* - * Pull the current background from the display to blend with - */ - - bgImg = XGetImage(display, drawable, drawableX, drawableY, - (unsigned int)width, (unsigned int)height, AllPlanes, ZPixmap); - if (bgImg == NULL) { - Tk_DeleteErrorHandler(handler); - /* We failed to get the image so draw without blending alpha. It's the best we can do */ - goto fallBack; - } - - ImgPhotoBlendComplexAlpha(bgImg, instancePtr, imageX, imageY, width, - height); - - /* - * Color info is unimportant as we only do this operation for depth >= - * 15. - */ - - TkPutImage(NULL, 0, display, drawable, instancePtr->gc, - bgImg, 0, 0, drawableX, drawableY, - (unsigned int) width, (unsigned int) height); - XDestroyImage(bgImg); - Tk_DeleteErrorHandler(handler); - } else { - /* - * masterPtr->region describes which parts of the image contain valid - * data. We set this region as the clip mask for the gc, setting its - * origin appropriately, and use it when drawing the image. - */ - - fallBack: - TkSetRegion(display, instancePtr->gc, - instancePtr->masterPtr->validRegion); - XSetClipOrigin(display, instancePtr->gc, drawableX - imageX, - drawableY - imageY); - XCopyArea(display, instancePtr->pixels, drawable, instancePtr->gc, - imageX, imageY, (unsigned) width, (unsigned) height, - drawableX, drawableY); - XSetClipMask(display, instancePtr->gc, None); - XSetClipOrigin(display, instancePtr->gc, 0, 0); - } - XFlush(display); -} - -/* - *---------------------------------------------------------------------- - * - * ImgPhotoFree -- - * - * This function is called when a widget ceases to use a particular - * instance of an image. We don't actually get rid of the instance until - * later because we may be about to get this instance again. - * - * Results: - * None. - * - * Side effects: - * Internal data structures get cleaned up, later. - * - *---------------------------------------------------------------------- - */ - -static void -ImgPhotoFree( - ClientData clientData, /* Pointer to PhotoInstance structure for - * instance to be displayed. */ - Display *display) /* Display containing window that used - * image. */ -{ - PhotoInstance *instancePtr = (PhotoInstance *) clientData; - ColorTable *colorPtr; - - instancePtr->refCount -= 1; - if (instancePtr->refCount > 0) { - return; - } - - /* - * There are no more uses of the image within this widget. Decrement the - * count of live uses of its color table, so that its colors can be - * reclaimed if necessary, and set up an idle call to free the instance - * structure. - */ - - colorPtr = instancePtr->colorTablePtr; - if (colorPtr != NULL) { - colorPtr->liveRefCount -= 1; - } - - Tcl_DoWhenIdle(DisposeInstance, (ClientData) instancePtr); -} - -/* - *---------------------------------------------------------------------- - * * ImgPhotoDelete -- * * This function is called by the image code to delete the master @@ -2906,22 +2110,22 @@ ImgPhotoDelete( ClientData masterData) /* Pointer to PhotoMaster structure for image. * Must not have any more instances. */ { - PhotoMaster *masterPtr = (PhotoMaster *) masterData; + PhotoMaster *masterPtr = masterData; PhotoInstance *instancePtr; while ((instancePtr = masterPtr->instancePtr) != NULL) { if (instancePtr->refCount > 0) { Tcl_Panic("tried to delete photo image when instances still exist"); } - Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr); - DisposeInstance((ClientData) instancePtr); + Tcl_CancelIdleCall(TkImgDisposeInstance, instancePtr); + TkImgDisposeInstance(instancePtr); } masterPtr->tkMaster = NULL; if (masterPtr->imageCmd != NULL) { Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd); } if (masterPtr->pix32 != NULL) { - ckfree((char *) masterPtr->pix32); + ckfree(masterPtr->pix32); } if (masterPtr->validRegion != NULL) { TkDestroyRegion(masterPtr->validRegion); @@ -2933,7 +2137,7 @@ ImgPhotoDelete( Tcl_DecrRefCount(masterPtr->format); } Tk_FreeOptions(configSpecs, (char *) masterPtr, NULL, 0); - ckfree((char *) masterPtr); + ckfree(masterPtr); } /* @@ -2958,7 +2162,7 @@ ImgPhotoCmdDeletedProc( ClientData clientData) /* Pointer to PhotoMaster structure for * image. */ { - PhotoMaster *masterPtr = (PhotoMaster *) clientData; + PhotoMaster *masterPtr = clientData; masterPtr->imageCmd = NULL; if (masterPtr->tkMaster != NULL) { @@ -3004,6 +2208,10 @@ ImgPhotoSetSize( height = masterPtr->userHeight; } + if (width > INT_MAX / 4) { + /* Pitch overflows int */ + return TCL_ERROR; + } pitch = width * 4; /* @@ -3013,11 +2221,12 @@ ImgPhotoSetSize( if ((width != masterPtr->width) || (height != masterPtr->height) || (masterPtr->pix32 == NULL)) { - /* - * Not a u-long, but should be one. - */ + unsigned newPixSize; - unsigned /*long*/ newPixSize = (unsigned /*long*/) (height * pitch); + if (pitch && height > (int)(UINT_MAX / pitch)) { + return TCL_ERROR; + } + newPixSize = height * pitch; /* * Some mallocs() really hate allocating zero bytes. [Bug 619544] @@ -3026,7 +2235,7 @@ ImgPhotoSetSize( if (newPixSize == 0) { newPix32 = NULL; } else { - newPix32 = (unsigned char *) attemptckalloc(newPixSize); + newPix32 = attemptckalloc(newPixSize); if (newPix32 == NULL) { return TCL_ERROR; } @@ -3069,14 +2278,14 @@ ImgPhotoSetSize( if ((masterPtr->pix32 != NULL) && ((width == masterPtr->width) || (width == validBox.width))) { if (validBox.y > 0) { - memset(newPix32, 0, (size_t) (validBox.y * pitch)); + memset(newPix32, 0, ((size_t) validBox.y * pitch)); } h = validBox.y + validBox.height; if (h < height) { - memset(newPix32 + h*pitch, 0, (size_t) ((height - h) * pitch)); + memset(newPix32 + h*pitch, 0, ((size_t) (height - h) * pitch)); } } else { - memset(newPix32, 0, (size_t) (height * pitch)); + memset(newPix32, 0, ((size_t)height * pitch)); } if (masterPtr->pix32 != NULL) { @@ -3093,7 +2302,7 @@ ImgPhotoSetSize( offset = validBox.y * pitch; memcpy(newPix32 + offset, masterPtr->pix32 + offset, - (size_t) (validBox.height * pitch)); + ((size_t)validBox.height * pitch)); } else if ((validBox.width > 0) && (validBox.height > 0)) { /* @@ -3104,13 +2313,13 @@ ImgPhotoSetSize( srcPtr = masterPtr->pix32 + (validBox.y * masterPtr->width + validBox.x) * 4; for (h = validBox.height; h > 0; h--) { - memcpy(destPtr, srcPtr, (size_t) (validBox.width * 4)); + memcpy(destPtr, srcPtr, ((size_t)validBox.width * 4)); destPtr += width * 4; srcPtr += masterPtr->width * 4; } } - ckfree((char *) masterPtr->pix32); + ckfree(masterPtr->pix32); } masterPtr->pix32 = newPix32; @@ -3145,7 +2354,7 @@ ImgPhotoSetSize( for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) { - ImgPhotoInstanceSetSize(instancePtr); + TkImgPhotoInstanceSetSize(instancePtr); } return TCL_OK; @@ -3154,867 +2363,6 @@ ImgPhotoSetSize( /* *---------------------------------------------------------------------- * - * ImgPhotoInstanceSetSize -- - * - * This function reallocates the instance pixmap and dithering error - * array for a photo instance, as necessary, to change the image's size - * to `width' x `height' pixels. - * - * Results: - * None. - * - * Side effects: - * Storage gets reallocated, here and in the X server. - * - *---------------------------------------------------------------------- - */ - -static void -ImgPhotoInstanceSetSize( - PhotoInstance *instancePtr) /* Instance whose size is to be changed. */ -{ - PhotoMaster *masterPtr; - schar *newError, *errSrcPtr, *errDestPtr; - int h, offset; - XRectangle validBox; - Pixmap newPixmap; - - masterPtr = instancePtr->masterPtr; - TkClipBox(masterPtr->validRegion, &validBox); - - if ((instancePtr->width != masterPtr->width) - || (instancePtr->height != masterPtr->height) - || (instancePtr->pixels == None)) { - newPixmap = Tk_GetPixmap(instancePtr->display, - RootWindow(instancePtr->display, - instancePtr->visualInfo.screen), - (masterPtr->width > 0) ? masterPtr->width: 1, - (masterPtr->height > 0) ? masterPtr->height: 1, - instancePtr->visualInfo.depth); - if (!newPixmap) { - Tcl_Panic("Fail to create pixmap with Tk_GetPixmap in ImgPhotoInstanceSetSize.\n"); - } - - /* - * The following is a gross hack needed to properly support colormaps - * under Windows. Before the pixels can be copied to the pixmap, the - * relevent colormap must be associated with the drawable. Normally we - * can infer this association from the window that was used to create - * the pixmap. However, in this case we're using the root window, so - * we have to be more explicit. - */ - - TkSetPixmapColormap(newPixmap, instancePtr->colormap); - - if (instancePtr->pixels != None) { - /* - * Copy any common pixels from the old pixmap and free it. - */ - - XCopyArea(instancePtr->display, instancePtr->pixels, newPixmap, - instancePtr->gc, validBox.x, validBox.y, - validBox.width, validBox.height, validBox.x, validBox.y); - Tk_FreePixmap(instancePtr->display, instancePtr->pixels); - } - instancePtr->pixels = newPixmap; - } - - if ((instancePtr->width != masterPtr->width) - || (instancePtr->height != masterPtr->height) - || (instancePtr->error == NULL)) { - - if (masterPtr->height > 0 && masterPtr->width > 0) { - newError = (schar *) ckalloc((unsigned) - masterPtr->height * masterPtr->width * 3 * sizeof(schar)); - - /* - * Zero the new array so that we don't get bogus error values - * propagating into areas we dither later. - */ - - if ((instancePtr->error != NULL) - && ((instancePtr->width == masterPtr->width) - || (validBox.width == masterPtr->width))) { - if (validBox.y > 0) { - memset(newError, 0, (size_t) - validBox.y * masterPtr->width * 3 * sizeof(schar)); - } - h = validBox.y + validBox.height; - if (h < masterPtr->height) { - memset(newError + h*masterPtr->width*3, 0, - (size_t) (masterPtr->height - h) - * masterPtr->width * 3 * sizeof(schar)); - } - } else { - memset(newError, 0, (size_t) - masterPtr->height * masterPtr->width *3*sizeof(schar)); - } - } else { - newError = NULL; - } - - if (instancePtr->error != NULL) { - /* - * Copy the common area over to the new array and free the old - * array. - */ - - if (masterPtr->width == instancePtr->width) { - offset = validBox.y * masterPtr->width * 3; - memcpy(newError + offset, instancePtr->error + offset, - (size_t) (validBox.height - * masterPtr->width * 3 * sizeof(schar))); - - } else if (validBox.width > 0 && validBox.height > 0) { - errDestPtr = newError + - (validBox.y * masterPtr->width + validBox.x) * 3; - errSrcPtr = instancePtr->error + - (validBox.y * instancePtr->width + validBox.x) * 3; - - for (h = validBox.height; h > 0; --h) { - memcpy(errDestPtr, errSrcPtr, - validBox.width * 3 * sizeof(schar)); - errDestPtr += masterPtr->width * 3; - errSrcPtr += instancePtr->width * 3; - } - } - ckfree((char *) instancePtr->error); - } - - instancePtr->error = newError; - } - - instancePtr->width = masterPtr->width; - instancePtr->height = masterPtr->height; -} - -/* - *---------------------------------------------------------------------- - * - * IsValidPalette -- - * - * This function is called to check whether a value given for the - * -palette option is valid for a particular instance of a photo image. - * - * Results: - * A boolean value: 1 if the palette is acceptable, 0 otherwise. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -IsValidPalette( - PhotoInstance *instancePtr, /* Instance to which the palette specification - * is to be applied. */ - const char *palette) /* Palette specification string. */ -{ - int nRed, nGreen, nBlue, mono, numColors; - char *endp; - - /* - * First parse the specification: it must be of the form %d or %d/%d/%d. - */ - - nRed = strtol(palette, &endp, 10); - if ((endp == palette) || ((*endp != 0) && (*endp != '/')) - || (nRed < 2) || (nRed > 256)) { - return 0; - } - - if (*endp == 0) { - mono = 1; - nGreen = nBlue = nRed; - } else { - palette = endp + 1; - nGreen = strtol(palette, &endp, 10); - if ((endp == palette) || (*endp != '/') || (nGreen < 2) - || (nGreen > 256)) { - return 0; - } - palette = endp + 1; - nBlue = strtol(palette, &endp, 10); - if ((endp == palette) || (*endp != 0) || (nBlue < 2) - || (nBlue > 256)) { - return 0; - } - mono = 0; - } - - switch (instancePtr->visualInfo.class) { - case DirectColor: - case TrueColor: - if ((nRed > (1 << CountBits(instancePtr->visualInfo.red_mask))) - || (nGreen>(1<<CountBits(instancePtr->visualInfo.green_mask))) - || (nBlue>(1<<CountBits(instancePtr->visualInfo.blue_mask)))) { - return 0; - } - break; - case PseudoColor: - case StaticColor: - numColors = nRed; - if (!mono) { - numColors *= nGreen*nBlue; - } - if (numColors > (1 << instancePtr->visualInfo.depth)) { - return 0; - } - break; - case GrayScale: - case StaticGray: - if (!mono || (nRed > (1 << instancePtr->visualInfo.depth))) { - return 0; - } - break; - } - - return 1; -} - -/* - *---------------------------------------------------------------------- - * - * CountBits -- - * - * This function counts how many bits are set to 1 in `mask'. - * - * Results: - * The integer number of bits. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -CountBits( - pixel mask) /* Value to count the 1 bits in. */ -{ - int n; - - for (n=0 ; mask!=0 ; mask&=mask-1) { - n++; - } - return n; -} - -/* - *---------------------------------------------------------------------- - * - * GetColorTable -- - * - * This function is called to allocate a table of colormap information - * for an instance of a photo image. Only one such table is allocated for - * all photo instances using the same display, colormap, palette and - * gamma values, so that the application need only request a set of - * colors from the X server once for all such photo widgets. This - * function maintains a hash table to find previously-allocated - * ColorTables. - * - * Results: - * None. - * - * Side effects: - * A new ColorTable may be allocated and placed in the hash table, and - * have colors allocated for it. - * - *---------------------------------------------------------------------- - */ - -static void -GetColorTable( - PhotoInstance *instancePtr) /* Instance needing a color table. */ -{ - ColorTable *colorPtr; - Tcl_HashEntry *entry; - ColorTableId id; - int isNew; - - /* - * Look for an existing ColorTable in the hash table. - */ - - memset(&id, 0, sizeof(id)); - id.display = instancePtr->display; - id.colormap = instancePtr->colormap; - id.palette = instancePtr->palette; - id.gamma = instancePtr->gamma; - if (!imgPhotoColorHashInitialized) { - Tcl_InitHashTable(&imgPhotoColorHash, N_COLOR_HASH); - imgPhotoColorHashInitialized = 1; - } - entry = Tcl_CreateHashEntry(&imgPhotoColorHash, (char *) &id, &isNew); - - if (!isNew) { - /* - * Re-use the existing entry. - */ - - colorPtr = (ColorTable *) Tcl_GetHashValue(entry); - } else { - /* - * No color table currently available; need to make one. - */ - - colorPtr = (ColorTable *) ckalloc(sizeof(ColorTable)); - - /* - * The following line of code should not normally be needed due to the - * assignment in the following line. However, it compensates for bugs - * in some compilers (HP, for example) where sizeof(ColorTable) is 24 - * but the assignment only copies 20 bytes, leaving 4 bytes - * uninitialized; these cause problems when using the id for lookups - * in imgPhotoColorHash, and can result in core dumps. - */ - - memset(&colorPtr->id, 0, sizeof(ColorTableId)); - colorPtr->id = id; - Tk_PreserveColormap(colorPtr->id.display, colorPtr->id.colormap); - colorPtr->flags = 0; - colorPtr->refCount = 0; - colorPtr->liveRefCount = 0; - colorPtr->numColors = 0; - colorPtr->visualInfo = instancePtr->visualInfo; - colorPtr->pixelMap = NULL; - Tcl_SetHashValue(entry, colorPtr); - } - - colorPtr->refCount++; - colorPtr->liveRefCount++; - instancePtr->colorTablePtr = colorPtr; - if (colorPtr->flags & DISPOSE_PENDING) { - Tcl_CancelIdleCall(DisposeColorTable, (ClientData) colorPtr); - colorPtr->flags &= ~DISPOSE_PENDING; - } - - /* - * Allocate colors for this color table if necessary. - */ - - if ((colorPtr->numColors == 0) - && ((colorPtr->flags & BLACK_AND_WHITE) == 0)) { - AllocateColors(colorPtr); - } -} - -/* - *---------------------------------------------------------------------- - * - * FreeColorTable -- - * - * This function is called when an instance ceases using a color table. - * - * Results: - * None. - * - * Side effects: - * If no other instances are using this color table, a when-idle handler - * is registered to free up the color table and the colors allocated for - * it. - * - *---------------------------------------------------------------------- - */ - -static void -FreeColorTable( - ColorTable *colorPtr, /* Pointer to the color table which is no - * longer required by an instance. */ - int force) /* Force free to happen immediately. */ -{ - colorPtr->refCount--; - if (colorPtr->refCount > 0) { - return; - } - - if (force) { - if ((colorPtr->flags & DISPOSE_PENDING) != 0) { - Tcl_CancelIdleCall(DisposeColorTable, (ClientData) colorPtr); - colorPtr->flags &= ~DISPOSE_PENDING; - } - DisposeColorTable((ClientData) colorPtr); - } else if ((colorPtr->flags & DISPOSE_PENDING) == 0) { - Tcl_DoWhenIdle(DisposeColorTable, (ClientData) colorPtr); - colorPtr->flags |= DISPOSE_PENDING; - } -} - -/* - *---------------------------------------------------------------------- - * - * AllocateColors -- - * - * This function allocates the colors required by a color table, and sets - * up the fields in the color table data structure which are used in - * dithering. - * - * Results: - * None. - * - * Side effects: - * Colors are allocated from the X server. Fields in the color table data - * structure are updated. - * - *---------------------------------------------------------------------- - */ - -static void -AllocateColors( - ColorTable *colorPtr) /* Pointer to the color table requiring colors - * to be allocated. */ -{ - int i, r, g, b, rMult, mono; - int numColors, nRed, nGreen, nBlue; - double fr, fg, fb, igam; - XColor *colors; - unsigned long *pixels; - - /* - * 16-bit intensity value for i/n of full intensity. - */ -#define CFRAC(i, n) ((i) * 65535 / (n)) - - /* As for CFRAC, but apply exponent of g. */ -#define CGFRAC(i, n, g) ((int)(65535 * pow((double)(i) / (n), (g)))) - - /* - * First parse the palette specification to get the required number of - * shades of each primary. - */ - - mono = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed, &nGreen, &nBlue) - <= 1; - igam = 1.0 / colorPtr->id.gamma; - - /* - * Each time around this loop, we reduce the number of colors we're trying - * to allocate until we succeed in allocating all of the colors we need. - */ - - for (;;) { - /* - * If we are using 1 bit/pixel, we don't need to allocate any colors - * (we just use the foreground and background colors in the GC). - */ - - if (mono && (nRed <= 2)) { - colorPtr->flags |= BLACK_AND_WHITE; - return; - } - - /* - * Calculate the RGB coordinates of the colors we want to allocate and - * store them in *colors. - */ - - if ((colorPtr->visualInfo.class == DirectColor) - || (colorPtr->visualInfo.class == TrueColor)) { - - /* - * Direct/True Color: allocate shades of red, green, blue - * independently. - */ - - if (mono) { - numColors = nGreen = nBlue = nRed; - } else { - numColors = MAX(MAX(nRed, nGreen), nBlue); - } - colors = (XColor *) ckalloc(numColors * sizeof(XColor)); - - for (i = 0; i < numColors; ++i) { - if (igam == 1.0) { - colors[i].red = CFRAC(i, nRed - 1); - colors[i].green = CFRAC(i, nGreen - 1); - colors[i].blue = CFRAC(i, nBlue - 1); - } else { - colors[i].red = CGFRAC(i, nRed - 1, igam); - colors[i].green = CGFRAC(i, nGreen - 1, igam); - colors[i].blue = CGFRAC(i, nBlue - 1, igam); - } - } - } else { - /* - * PseudoColor, StaticColor, GrayScale or StaticGray visual: we - * have to allocate each color in the color cube separately. - */ - - numColors = (mono) ? nRed: (nRed * nGreen * nBlue); - colors = (XColor *) ckalloc(numColors * sizeof(XColor)); - - if (!mono) { - /* - * Color display using a PseudoColor or StaticColor visual. - */ - - i = 0; - for (r = 0; r < nRed; ++r) { - for (g = 0; g < nGreen; ++g) { - for (b = 0; b < nBlue; ++b) { - if (igam == 1.0) { - colors[i].red = CFRAC(r, nRed - 1); - colors[i].green = CFRAC(g, nGreen - 1); - colors[i].blue = CFRAC(b, nBlue - 1); - } else { - colors[i].red = CGFRAC(r, nRed - 1, igam); - colors[i].green = CGFRAC(g, nGreen - 1, igam); - colors[i].blue = CGFRAC(b, nBlue - 1, igam); - } - i++; - } - } - } - } else { - /* - * Monochrome display - allocate the shades of grey we want. - */ - - for (i = 0; i < numColors; ++i) { - if (igam == 1.0) { - r = CFRAC(i, numColors - 1); - } else { - r = CGFRAC(i, numColors - 1, igam); - } - colors[i].red = colors[i].green = colors[i].blue = r; - } - } - } - - /* - * Now try to allocate the colors we've calculated. - */ - - pixels = (unsigned long *) ckalloc(numColors * sizeof(unsigned long)); - for (i = 0; i < numColors; ++i) { - if (!XAllocColor(colorPtr->id.display, colorPtr->id.colormap, - &colors[i])) { - /* - * Can't get all the colors we want in the default colormap; - * first try freeing colors from other unused color tables. - */ - - if (!ReclaimColors(&colorPtr->id, numColors - i) - || !XAllocColor(colorPtr->id.display, - colorPtr->id.colormap, &colors[i])) { - /* - * Still can't allocate the color. - */ - - break; - } - } - pixels[i] = colors[i].pixel; - } - - /* - * If we didn't get all of the colors, reduce the resolution of the - * color cube, free the ones we got, and try again. - */ - - if (i >= numColors) { - break; - } - XFreeColors(colorPtr->id.display, colorPtr->id.colormap, pixels, i, 0); - ckfree((char *) colors); - ckfree((char *) pixels); - - if (!mono) { - if ((nRed == 2) && (nGreen == 2) && (nBlue == 2)) { - /* - * Fall back to 1-bit monochrome display. - */ - - mono = 1; - } else { - /* - * Reduce the number of shades of each primary to about 3/4 of - * the previous value. This should reduce the total number of - * colors required to about half the previous value for - * PseudoColor displays. - */ - - nRed = (nRed * 3 + 2) / 4; - nGreen = (nGreen * 3 + 2) / 4; - nBlue = (nBlue * 3 + 2) / 4; - } - } else { - /* - * Reduce the number of shades of gray to about 1/2. - */ - - nRed = nRed / 2; - } - } - - /* - * We have allocated all of the necessary colors: fill in various fields - * of the ColorTable record. - */ - - if (!mono) { - colorPtr->flags |= COLOR_WINDOW; - - /* - * The following is a hairy hack. We only want to index into the - * pixelMap on colormap displays. However, if the display is on - * Windows, then we actually want to store the index not the value - * since we will be passing the color table into the TkPutImage call. - */ - -#ifndef __WIN32__ - if ((colorPtr->visualInfo.class != DirectColor) - && (colorPtr->visualInfo.class != TrueColor)) { - colorPtr->flags |= MAP_COLORS; - } -#endif /* __WIN32__ */ - } - - colorPtr->numColors = numColors; - colorPtr->pixelMap = pixels; - - /* - * Set up quantization tables for dithering. - */ - - rMult = nGreen * nBlue; - for (i = 0; i < 256; ++i) { - r = (i * (nRed - 1) + 127) / 255; - if (mono) { - fr = (double) colors[r].red / 65535.0; - if (colorPtr->id.gamma != 1.0 ) { - fr = pow(fr, colorPtr->id.gamma); - } - colorPtr->colorQuant[0][i] = (int)(fr * 255.99); - colorPtr->redValues[i] = colors[r].pixel; - } else { - g = (i * (nGreen - 1) + 127) / 255; - b = (i * (nBlue - 1) + 127) / 255; - if ((colorPtr->visualInfo.class == DirectColor) - || (colorPtr->visualInfo.class == TrueColor)) { - colorPtr->redValues[i] = - colors[r].pixel & colorPtr->visualInfo.red_mask; - colorPtr->greenValues[i] = - colors[g].pixel & colorPtr->visualInfo.green_mask; - colorPtr->blueValues[i] = - colors[b].pixel & colorPtr->visualInfo.blue_mask; - } else { - r *= rMult; - g *= nBlue; - colorPtr->redValues[i] = r; - colorPtr->greenValues[i] = g; - colorPtr->blueValues[i] = b; - } - fr = (double) colors[r].red / 65535.0; - fg = (double) colors[g].green / 65535.0; - fb = (double) colors[b].blue / 65535.0; - if (colorPtr->id.gamma != 1.0) { - fr = pow(fr, colorPtr->id.gamma); - fg = pow(fg, colorPtr->id.gamma); - fb = pow(fb, colorPtr->id.gamma); - } - colorPtr->colorQuant[0][i] = (int)(fr * 255.99); - colorPtr->colorQuant[1][i] = (int)(fg * 255.99); - colorPtr->colorQuant[2][i] = (int)(fb * 255.99); - } - } - - ckfree((char *) colors); -} - -/* - *---------------------------------------------------------------------- - * - * DisposeColorTable -- - * - * Release a color table and its associated resources. - * - * Results: - * None. - * - * Side effects: - * The colors in the argument color table are freed, as is the color - * table structure itself. The color table is removed from the hash table - * which is used to locate color tables. - * - *---------------------------------------------------------------------- - */ - -static void -DisposeColorTable( - ClientData clientData) /* Pointer to the ColorTable whose - * colors are to be released. */ -{ - ColorTable *colorPtr = (ColorTable *) clientData; - Tcl_HashEntry *entry; - - if (colorPtr->pixelMap != NULL) { - if (colorPtr->numColors > 0) { - XFreeColors(colorPtr->id.display, colorPtr->id.colormap, - colorPtr->pixelMap, colorPtr->numColors, 0); - Tk_FreeColormap(colorPtr->id.display, colorPtr->id.colormap); - } - ckfree((char *) colorPtr->pixelMap); - } - - entry = Tcl_FindHashEntry(&imgPhotoColorHash, (char *) &colorPtr->id); - if (entry == NULL) { - Tcl_Panic("DisposeColorTable couldn't find hash entry"); - } - Tcl_DeleteHashEntry(entry); - - ckfree((char *) colorPtr); -} - -/* - *---------------------------------------------------------------------- - * - * ReclaimColors -- - * - * This function is called to try to free up colors in the colormap used - * by a color table. It looks for other color tables with the same - * colormap and with a zero live reference count, and frees their colors. - * It only does so if there is the possibility of freeing up at least - * `numColors' colors. - * - * Results: - * The return value is TRUE if any colors were freed, FALSE otherwise. - * - * Side effects: - * ColorTables which are not currently in use may lose their color - * allocations. - * - *---------------------------------------------------------------------- - */ - -static int -ReclaimColors( - ColorTableId *id, /* Pointer to information identifying - * the color table which needs more colors. */ - int numColors) /* Number of colors required. */ -{ - Tcl_HashSearch srch; - Tcl_HashEntry *entry; - ColorTable *colorPtr; - int nAvail = 0; - - /* - * First scan through the color hash table to get an upper bound on how - * many colors we might be able to free. - */ - - entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch); - while (entry != NULL) { - colorPtr = (ColorTable *) Tcl_GetHashValue(entry); - if ((colorPtr->id.display == id->display) - && (colorPtr->id.colormap == id->colormap) - && (colorPtr->liveRefCount == 0 )&& (colorPtr->numColors != 0) - && ((colorPtr->id.palette != id->palette) - || (colorPtr->id.gamma != id->gamma))) { - /* - * We could take this guy's colors off him. - */ - - nAvail += colorPtr->numColors; - } - entry = Tcl_NextHashEntry(&srch); - } - - /* - * nAvail is an (over)estimate of the number of colors we could free. - */ - - if (nAvail < numColors) { - return 0; - } - - /* - * Scan through a second time freeing colors. - */ - - entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch); - while ((entry != NULL) && (numColors > 0)) { - colorPtr = (ColorTable *) Tcl_GetHashValue(entry); - if ((colorPtr->id.display == id->display) - && (colorPtr->id.colormap == id->colormap) - && (colorPtr->liveRefCount == 0) && (colorPtr->numColors != 0) - && ((colorPtr->id.palette != id->palette) - || (colorPtr->id.gamma != id->gamma))) { - /* - * Free the colors that this ColorTable has. - */ - - XFreeColors(colorPtr->id.display, colorPtr->id.colormap, - colorPtr->pixelMap, colorPtr->numColors, 0); - numColors -= colorPtr->numColors; - colorPtr->numColors = 0; - ckfree((char *) colorPtr->pixelMap); - colorPtr->pixelMap = NULL; - } - - entry = Tcl_NextHashEntry(&srch); - } - return 1; /* We freed some colors. */ -} - -/* - *---------------------------------------------------------------------- - * - * DisposeInstance -- - * - * This function is called to finally free up an instance of a photo - * image which is no longer required. - * - * Results: - * None. - * - * Side effects: - * The instance data structure and the resources it references are freed. - * - *---------------------------------------------------------------------- - */ - -static void -DisposeInstance( - ClientData clientData) /* Pointer to the instance whose resources are - * to be released. */ -{ - PhotoInstance *instancePtr = (PhotoInstance *) clientData; - PhotoInstance *prevPtr; - - if (instancePtr->pixels != None) { - Tk_FreePixmap(instancePtr->display, instancePtr->pixels); - } - if (instancePtr->gc != None) { - Tk_FreeGC(instancePtr->display, instancePtr->gc); - } - if (instancePtr->imagePtr != NULL) { - XDestroyImage(instancePtr->imagePtr); - } - if (instancePtr->error != NULL) { - ckfree((char *) instancePtr->error); - } - if (instancePtr->colorTablePtr != NULL) { - FreeColorTable(instancePtr->colorTablePtr, 1); - } - - if (instancePtr->masterPtr->instancePtr == instancePtr) { - instancePtr->masterPtr->instancePtr = instancePtr->nextPtr; - } else { - for (prevPtr = instancePtr->masterPtr->instancePtr; - prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) { - /* Empty loop body. */ - } - prevPtr->nextPtr = instancePtr->nextPtr; - } - Tk_FreeColormap(instancePtr->display, instancePtr->colormap); - ckfree((char *) instancePtr); -} - -/* - *---------------------------------------------------------------------- - * * MatchFileFormat -- * * This function is called to find a photo image file format handler @@ -4038,7 +2386,7 @@ static int MatchFileFormat( Tcl_Interp *interp, /* Interpreter to use for reporting errors. */ Tcl_Channel chan, /* The image file, open for reading. */ - char *fileName, /* The name of the image file. */ + const char *fileName, /* The name of the image file. */ Tcl_Obj *formatObj, /* User-specified format string, or NULL. */ Tk_PhotoImageFormat **imageFormatPtr, /* A pointer to the photo image format record @@ -4050,9 +2398,9 @@ MatchFileFormat( { int matched = 0, useoldformat = 0; Tk_PhotoImageFormat *formatPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - char *formatString = NULL; + const char *formatString = NULL; if (formatObj) { formatString = Tcl_GetString(formatObj); @@ -4072,15 +2420,18 @@ MatchFileFormat( } matched = 1; if (formatPtr->fileMatchProc == NULL) { - Tcl_AppendResult(interp, "-file option isn't supported for ", - formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-file option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_FILE_FORMAT", NULL); return TCL_ERROR; } } if (formatPtr->fileMatchProc != NULL) { (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET); - if ((*formatPtr->fileMatchProc)(chan, fileName, formatObj, + if (formatPtr->fileMatchProc(chan, fileName, formatObj, widthPtr, heightPtr, interp)) { if (*widthPtr < 1) { *widthPtr = 1; @@ -4103,14 +2454,17 @@ MatchFileFormat( } matched = 1; if (formatPtr->fileMatchProc == NULL) { - Tcl_AppendResult(interp, "-file option isn't supported", - " for ", formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-file option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_FILE_FORMAT", NULL); return TCL_ERROR; } } if (formatPtr->fileMatchProc != NULL) { (void) Tcl_Seek(chan, Tcl_LongAsWide(0L), SEEK_SET); - if ((*formatPtr->fileMatchProc)(chan, fileName, (Tcl_Obj *) + if (formatPtr->fileMatchProc(chan, fileName, (Tcl_Obj *) formatString, widthPtr, heightPtr, interp)) { if (*widthPtr < 1) { *widthPtr = 1; @@ -4126,12 +2480,17 @@ MatchFileFormat( if (formatPtr == NULL) { if ((formatObj != NULL) && !matched) { - Tcl_AppendResult(interp, "image file format \"", formatString, - "\" is not supported", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image file format \"%s\" is not supported", + formatString)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + formatString, NULL); } else { - Tcl_AppendResult(interp, - "couldn't recognize data in image file \"", fileName, "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't recognize data in image file \"%s\"", + fileName)); + Tcl_SetErrorCode(interp, "TK", "PHOTO", "IMAGE", + "UNRECOGNIZED_DATA", NULL); } return TCL_ERROR; } @@ -4179,9 +2538,9 @@ MatchStringFormat( { int matched = 0, useoldformat = 0; Tk_PhotoImageFormat *formatPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - char *formatString = NULL; + const char *formatString = NULL; if (formatObj) { formatString = Tcl_GetString(formatObj); @@ -4201,15 +2560,18 @@ MatchStringFormat( } matched = 1; if (formatPtr->stringMatchProc == NULL) { - Tcl_AppendResult(interp, "-data option isn't supported for ", - formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-data option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_DATA_FORMAT", NULL); return TCL_ERROR; } } if ((formatPtr->stringMatchProc != NULL) && (formatPtr->stringReadProc != NULL) - && (*formatPtr->stringMatchProc)(data, formatObj, - widthPtr, heightPtr, interp)) { + && formatPtr->stringMatchProc(data, formatObj, + widthPtr, heightPtr, interp)) { break; } } @@ -4225,14 +2587,17 @@ MatchStringFormat( } matched = 1; if (formatPtr->stringMatchProc == NULL) { - Tcl_AppendResult(interp, "-data option isn't supported", - " for ", formatString, " images", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "-data option isn't supported for %s images", + formatString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "NOT_DATA_FORMAT", NULL); return TCL_ERROR; } } if ((formatPtr->stringMatchProc != NULL) && (formatPtr->stringReadProc != NULL) - && (*formatPtr->stringMatchProc)( + && formatPtr->stringMatchProc( (Tcl_Obj *) Tcl_GetString(data), (Tcl_Obj *) formatString, widthPtr, heightPtr, interp)) { @@ -4242,10 +2607,15 @@ MatchStringFormat( } if (formatPtr == NULL) { if ((formatObj != NULL) && !matched) { - Tcl_AppendResult(interp, "image format \"", formatString, - "\" is not supported", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image format \"%s\" is not supported", formatString)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + formatString, NULL); } else { - Tcl_AppendResult(interp, "couldn't recognize image data", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't recognize image data", -1)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "UNRECOGNIZED_DATA", NULL); } return TCL_ERROR; } @@ -4279,16 +2649,16 @@ Tk_PhotoHandle Tk_FindPhoto( Tcl_Interp *interp, /* Interpreter (application) in which image * exists. */ - CONST char *imageName) /* Name of the desired photo image. */ + const char *imageName) /* Name of the desired photo image. */ { - ClientData clientData; - Tk_ImageType *typePtr; + const Tk_ImageType *typePtr; + ClientData clientData = + Tk_GetImageMasterData(interp, imageName, &typePtr); - clientData = Tk_GetImageMasterData(interp, imageName, &typePtr); if ((typePtr == NULL) || (typePtr->name != tkPhotoImageType.name)) { return NULL; } - return (Tk_PhotoHandle) clientData; + return clientData; } /* @@ -4326,14 +2696,21 @@ Tk_PhotoPutBlock( int compRule) /* Compositing rule to use when processing * transparent pixels. */ { - register PhotoMaster *masterPtr; + register PhotoMaster *masterPtr = (PhotoMaster *) handle; int xEnd, yEnd, greenOffset, blueOffset, alphaOffset; int wLeft, hLeft, wCopy, hCopy, pitch; unsigned char *srcPtr, *srcLinePtr, *destPtr, *destLinePtr; int sourceIsSimplePhoto = compRule & SOURCE_IS_SIMPLE_ALPHA_PHOTO; XRectangle rect; - masterPtr = (PhotoMaster *) handle; + /* + * Zero-sized blocks never cause any changes. [Bug 3078902] + */ + + if (blockPtr->height == 0 || blockPtr->width == 0) { + return TCL_OK; + } + compRule &= ~SOURCE_IS_SIMPLE_ALPHA_PHOTO; if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) { @@ -4355,8 +2732,9 @@ Tk_PhotoPutBlock( if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -4415,7 +2793,7 @@ Tk_PhotoPutBlock( && (blockPtr->pitch == pitch))) && (compRule == TK_PHOTO_COMPOSITE_SET)) { memmove(destLinePtr, blockPtr->pixelPtr + blockPtr->offset[0], - (size_t) (height * width * 4)); + ((size_t)height * width * 4)); /* * We know there's an alpha offset and we're setting the data, so skip @@ -4447,7 +2825,7 @@ Tk_PhotoPutBlock( && (blueOffset == 2) && (alphaOffset == 3) && (width <= blockPtr->width) && compRuleSet) { - memcpy(destLinePtr, srcLinePtr, (size_t) (width * 4)); + memcpy(destLinePtr, srcLinePtr, ((size_t)width * 4)); srcLinePtr += blockPtr->pitch; destLinePtr += pitch; continue; @@ -4620,27 +2998,32 @@ Tk_PhotoPutBlock( * Check if display code needs alpha blending... */ - if (!sourceIsSimplePhoto && (width == 1) && (height == 1)) { + if (!sourceIsSimplePhoto && (height == 1)) { /* - * Optimize the single pixel case if we can. This speeds up code that - * builds up large simple-alpha images by single pixels. We don't - * negate COMPLEX_ALPHA in this case. [Bug 1409140] + * Optimize the single span case if we can. This speeds up code that + * builds up large simple-alpha images by scan-lines or individual + * pixels. We don't negate COMPLEX_ALPHA in this case. [Bug 1409140] + * [Patch 1539990] */ if (!(masterPtr->flags & COMPLEX_ALPHA)) { - unsigned char newAlpha; + register int x1; - destLinePtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4; - newAlpha = destLinePtr[3]; + for (x1=x ; x1<x+width ; x1++) { + register unsigned char newAlpha; - if (newAlpha && newAlpha != 255) { - masterPtr->flags |= COMPLEX_ALPHA; + destLinePtr = masterPtr->pix32 + (y*masterPtr->width + x1)*4; + newAlpha = destLinePtr[3]; + if (newAlpha && newAlpha != 255) { + masterPtr->flags |= COMPLEX_ALPHA; + break; + } } } } else if ((alphaOffset != 0) || (masterPtr->flags & COMPLEX_ALPHA)) { /* * Check for partial transparency if alpha pixels are specified, or - * rescan if we already knew such pixels existed. To restrict this + * rescan if we already knew such pixels existed. To restrict this * Toggle to only checking the changed pixels requires knowing where * the alpha pixels are. */ @@ -4708,6 +3091,14 @@ Tk_PhotoPutZoomedBlock( int pitch, xRepeat, yRepeat, blockXSkip, blockYSkip, sourceIsSimplePhoto; XRectangle rect; + /* + * Zero-sized blocks never cause any changes. [Bug 3078902] + */ + + if (blockPtr->height == 0 || blockPtr->width == 0) { + return TCL_OK; + } + if (zoomX==1 && zoomY==1 && subsampleX==1 && subsampleY==1) { return Tk_PhotoPutBlock(interp, handle, blockPtr, x, y, width, height, compRule); @@ -4734,11 +3125,13 @@ Tk_PhotoPutZoomedBlock( yEnd = y + height; if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) { int sameSrc = (blockPtr->pixelPtr == masterPtr->pix32); + if (ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width), MAX(yEnd, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -4749,7 +3142,7 @@ Tk_PhotoPutZoomedBlock( } if ((y < masterPtr->ditherY) || ((y == masterPtr->ditherY) - && (x < masterPtr->ditherX))) { + && (x < masterPtr->ditherX))) { /* * The dithering isn't correct past the start of this block. */ @@ -4923,7 +3316,7 @@ Tk_PhotoPutZoomedBlock( if (!sourceIsSimplePhoto && (width == 1) && (height == 1)) { /* * Optimize the single pixel case if we can. This speeds up code that - * builds up large simple-alpha images by single pixels. We don't + * builds up large simple-alpha images by single pixels. We don't * negate COMPLEX_ALPHA in this case. [Bug 1409140] */ if (!(masterPtr->flags & COMPLEX_ALPHA)) { @@ -4939,7 +3332,7 @@ Tk_PhotoPutZoomedBlock( } else if ((alphaOffset != 0) || (masterPtr->flags & COMPLEX_ALPHA)) { /* * Check for partial transparency if alpha pixels are specified, or - * rescan if we already knew such pixels existed. To restrict this + * rescan if we already knew such pixels existed. To restrict this * Toggle to only checking the changed pixels requires knowing where * the alpha pixels are. */ @@ -4997,7 +3390,7 @@ Tk_DitherPhoto( for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) { - DitherInstance(instancePtr, x, y, width, height); + TkImgDitherInstance(instancePtr, x, y, width, height); } /* @@ -5043,345 +3436,6 @@ Tk_DitherPhoto( /* *---------------------------------------------------------------------- * - * DitherInstance -- - * - * This function is called to update an area of an instance's pixmap by - * dithering the corresponding area of the master. - * - * Results: - * None. - * - * Side effects: - * The instance's pixmap gets updated. - * - *---------------------------------------------------------------------- - */ - -static void -DitherInstance( - PhotoInstance *instancePtr, /* The instance to be updated. */ - int xStart, int yStart, /* Coordinates of the top-left pixel in the - * block to be dithered. */ - int width, int height) /* Dimensions of the block to be dithered. */ -{ - PhotoMaster *masterPtr = instancePtr->masterPtr; - ColorTable *colorPtr = instancePtr->colorTablePtr; - XImage *imagePtr; - int nLines, bigEndian, i, c, x, y, xEnd, doDithering = 1; - int bitsPerPixel, bytesPerLine, lineLength; - unsigned char *srcLinePtr; - schar *errLinePtr; - pixel firstBit, word, mask; - - /* - * Turn dithering off in certain cases where it is not needed (TrueColor, - * DirectColor with many colors). - */ - - if ((colorPtr->visualInfo.class == DirectColor) - || (colorPtr->visualInfo.class == TrueColor)) { - int nRed, nGreen, nBlue, result; - - result = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed, - &nGreen, &nBlue); - if ((nRed >= 256) - && ((result == 1) || ((nGreen >= 256) && (nBlue >= 256)))) { - doDithering = 0; - } - } - - /* - * First work out how many lines to do at a time, then how many bytes - * we'll need for pixel storage, and allocate it. - */ - - nLines = (MAX_PIXELS + width - 1) / width; - if (nLines < 1) { - nLines = 1; - } - if (nLines > height ) { - nLines = height; - } - - imagePtr = instancePtr->imagePtr; - if (imagePtr == NULL) { - return; /* We must be really tight on memory. */ - } - bitsPerPixel = imagePtr->bits_per_pixel; - bytesPerLine = ((bitsPerPixel * width + 31) >> 3) & ~3; - imagePtr->width = width; - imagePtr->height = nLines; - imagePtr->bytes_per_line = bytesPerLine; - imagePtr->data = (char *) - ckalloc((unsigned) (imagePtr->bytes_per_line * nLines)); - bigEndian = imagePtr->bitmap_bit_order == MSBFirst; - firstBit = bigEndian? (1 << (imagePtr->bitmap_unit - 1)): 1; - - lineLength = masterPtr->width * 3; - srcLinePtr = masterPtr->pix32 + (yStart * masterPtr->width + xStart) * 4; - errLinePtr = instancePtr->error + yStart * lineLength + xStart * 3; - xEnd = xStart + width; - - /* - * Loop over the image, doing at most nLines lines before updating the - * screen image. - */ - - for (; height > 0; height -= nLines) { - unsigned char *dstLinePtr = (unsigned char *) imagePtr->data; - int yEnd; - - if (nLines > height) { - nLines = height; - } - yEnd = yStart + nLines; - for (y = yStart; y < yEnd; ++y) { - unsigned char *srcPtr = srcLinePtr; - schar *errPtr = errLinePtr; - unsigned char *destBytePtr = dstLinePtr; - pixel *destLongPtr = (pixel *) dstLinePtr; - - if (colorPtr->flags & COLOR_WINDOW) { - /* - * Color window. We dither the three components independently, - * using Floyd-Steinberg dithering, which propagates errors - * from the quantization of pixels to the pixels below and to - * the right. - */ - - for (x = xStart; x < xEnd; ++x) { - int col[3]; - - if (doDithering) { - for (i = 0; i < 3; ++i) { - /* - * Compute the error propagated into this pixel - * for this component. If e[x,y] is the array of - * quantization error values, we compute - * 7/16 * e[x-1,y] + 1/16 * e[x-1,y-1] - * + 5/16 * e[x,y-1] + 3/16 * e[x+1,y-1] - * and round it to an integer. - * - * The expression ((c + 2056) >> 4) - 128 computes - * round(c / 16), and works correctly on machines - * without a sign-extending right shift. - */ - - c = (x > 0) ? errPtr[-3] * 7: 0; - if (y > 0) { - if (x > 0) { - c += errPtr[-lineLength-3]; - } - c += errPtr[-lineLength] * 5; - if ((x + 1) < masterPtr->width) { - c += errPtr[-lineLength+3] * 3; - } - } - - /* - * Add the propagated error to the value of this - * component, quantize it, and store the - * quantization error. - */ - - c = ((c + 2056) >> 4) - 128 + *srcPtr++; - if (c < 0) { - c = 0; - } else if (c > 255) { - c = 255; - } - col[i] = colorPtr->colorQuant[i][c]; - *errPtr++ = c - col[i]; - } - } else { - /* - * Output is virtually continuous in this case, so - * don't bother dithering. - */ - - col[0] = *srcPtr++; - col[1] = *srcPtr++; - col[2] = *srcPtr++; - } - srcPtr++; - - /* - * Translate the quantized component values into an X - * pixel value, and store it in the image. - */ - - i = colorPtr->redValues[col[0]] - + colorPtr->greenValues[col[1]] - + colorPtr->blueValues[col[2]]; - if (colorPtr->flags & MAP_COLORS) { - i = colorPtr->pixelMap[i]; - } - switch (bitsPerPixel) { - case NBBY: - *destBytePtr++ = i; - break; -#ifndef __WIN32__ - /* - * This case is not valid for Windows because the - * image format is different from the pixel format in - * Win32. Eventually we need to fix the image code in - * Tk to use the Windows native image ordering. This - * would speed up the image code for all of the common - * sizes. - */ - - case NBBY * sizeof(pixel): - *destLongPtr++ = i; - break; -#endif - default: - XPutPixel(imagePtr, x - xStart, y - yStart, - (unsigned) i); - } - } - - } else if (bitsPerPixel > 1) { - /* - * Multibit monochrome window. The operation here is similar - * to the color window case above, except that there is only - * one component. If the master image is in color, use the - * luminance computed as - * 0.344 * red + 0.5 * green + 0.156 * blue. - */ - - for (x = xStart; x < xEnd; ++x) { - c = (x > 0) ? errPtr[-1] * 7: 0; - if (y > 0) { - if (x > 0) { - c += errPtr[-lineLength-1]; - } - c += errPtr[-lineLength] * 5; - if (x + 1 < masterPtr->width) { - c += errPtr[-lineLength+1] * 3; - } - } - c = ((c + 2056) >> 4) - 128; - - if ((masterPtr->flags & COLOR_IMAGE) == 0) { - c += srcPtr[0]; - } else { - c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16 - + srcPtr[2] * 5 + 16) >> 5; - } - srcPtr += 4; - - if (c < 0) { - c = 0; - } else if (c > 255) { - c = 255; - } - i = colorPtr->colorQuant[0][c]; - *errPtr++ = c - i; - i = colorPtr->redValues[i]; - switch (bitsPerPixel) { - case NBBY: - *destBytePtr++ = i; - break; -#ifndef __WIN32__ - /* - * This case is not valid for Windows because the - * image format is different from the pixel format in - * Win32. Eventually we need to fix the image code in - * Tk to use the Windows native image ordering. This - * would speed up the image code for all of the common - * sizes. - */ - - case NBBY * sizeof(pixel): - *destLongPtr++ = i; - break; -#endif - default: - XPutPixel(imagePtr, x - xStart, y - yStart, - (unsigned) i); - } - } - } else { - /* - * 1-bit monochrome window. This is similar to the multibit - * monochrome case above, except that the quantization is - * simpler (we only have black = 0 and white = 255), and we - * produce an XY-Bitmap. - */ - - word = 0; - mask = firstBit; - for (x = xStart; x < xEnd; ++x) { - /* - * If we have accumulated a whole word, store it in the - * image and start a new word. - */ - - if (mask == 0) { - *destLongPtr++ = word; - mask = firstBit; - word = 0; - } - - c = (x > 0) ? errPtr[-1] * 7: 0; - if (y > 0) { - if (x > 0) { - c += errPtr[-lineLength-1]; - } - c += errPtr[-lineLength] * 5; - if (x + 1 < masterPtr->width) { - c += errPtr[-lineLength+1] * 3; - } - } - c = ((c + 2056) >> 4) - 128; - - if ((masterPtr->flags & COLOR_IMAGE) == 0) { - c += srcPtr[0]; - } else { - c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16 - + srcPtr[2] * 5 + 16) >> 5; - } - srcPtr += 4; - - if (c < 0) { - c = 0; - } else if (c > 255) { - c = 255; - } - if (c >= 128) { - word |= mask; - *errPtr++ = c - 255; - } else { - *errPtr++ = c; - } - mask = bigEndian? (mask >> 1): (mask << 1); - } - *destLongPtr = word; - } - srcLinePtr += masterPtr->width * 4; - errLinePtr += lineLength; - dstLinePtr += bytesPerLine; - } - - /* - * Update the pixmap for this instance with the block of pixels that - * we have just computed. - */ - - TkPutImage(colorPtr->pixelMap, colorPtr->numColors, - instancePtr->display, instancePtr->pixels, - instancePtr->gc, imagePtr, 0, 0, xStart, yStart, - (unsigned) width, (unsigned) nLines); - yStart = yEnd; - } - - ckfree(imagePtr->data); - imagePtr->data = NULL; -} - -/* - *---------------------------------------------------------------------- - * * Tk_PhotoBlank -- * * This function is called to clear an entire photo image. @@ -5421,14 +3475,10 @@ Tk_PhotoBlank( */ memset(masterPtr->pix32, 0, - (size_t) (masterPtr->width * masterPtr->height * 4)); + ((size_t)masterPtr->width * masterPtr->height * 4)); for (instancePtr = masterPtr->instancePtr; instancePtr != NULL; instancePtr = instancePtr->nextPtr) { - if (instancePtr->error) { - memset(instancePtr->error, 0, - (size_t) (masterPtr->width * masterPtr->height - * 3 * sizeof(schar))); - } + TkImgResetDither(instancePtr); } /* @@ -5478,8 +3528,9 @@ Tk_PhotoExpand( if (ImgPhotoSetSize(masterPtr, MAX(width, masterPtr->width), MAX(height, masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -5552,8 +3603,9 @@ Tk_PhotoSetSize( if (ImgPhotoSetSize(masterPtr, ((width > 0) ? width: masterPtr->width), ((height > 0) ? height: masterPtr->height)) == TCL_ERROR) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, TK_PHOTO_ALLOC_FAILURE_MESSAGE, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TK_PHOTO_ALLOC_FAILURE_MESSAGE, -1)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); } return TCL_ERROR; } @@ -5668,8 +3720,14 @@ ImgGetPhoto( if ((greenOffset||blueOffset) && !(optPtr->options & OPT_GRAYSCALE)) { newPixelSize += 2; } - data = ckalloc((unsigned int) (newPixelSize * - blockPtr->width * blockPtr->height)); + + if (blockPtr->height > (int)((UINT_MAX/newPixelSize)/blockPtr->width)) { + return NULL; + } + data = attemptckalloc(newPixelSize*blockPtr->width*blockPtr->height); + if (data == NULL) { + return NULL; + } srcPtr = blockPtr->pixelPtr + blockPtr->offset[0]; destPtr = (unsigned char *) data; if (!greenOffset && !blueOffset) { @@ -5764,13 +3822,13 @@ ImgGetPhoto( blockPtr->pixelSize = newPixelSize; blockPtr->pitch = newPixelSize * blockPtr->width; blockPtr->offset[0] = 0; - if (newPixelSize>2) { - blockPtr->offset[1]= 1; - blockPtr->offset[2]= 2; + if (newPixelSize > 2) { + blockPtr->offset[1] = 1; + blockPtr->offset[2] = 2; blockPtr->offset[3]= 3; } else { - blockPtr->offset[1]= 0; - blockPtr->offset[2]= 0; + blockPtr->offset[1] = 0; + blockPtr->offset[2] = 0; blockPtr->offset[3]= 1; } return data; @@ -5801,33 +3859,31 @@ ImgStringWrite( Tcl_Obj *formatString, Tk_PhotoImageBlock *blockPtr) { - int row, col; - char *line, *linePtr; - unsigned char *pixelPtr; int greenOffset, blueOffset; - Tcl_DString data; + Tcl_Obj *data; greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; - Tcl_DStringInit(&data); + data = Tcl_NewObj(); if ((blockPtr->width > 0) && (blockPtr->height > 0)) { - line = (char *) ckalloc((unsigned int) ((8 * blockPtr->width) + 2)); + int row, col; + for (row=0; row<blockPtr->height; row++) { - pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] + - row * blockPtr->pitch; - linePtr = line; + Tcl_Obj *line = Tcl_NewObj(); + unsigned char *pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] + + row * blockPtr->pitch; + for (col=0; col<blockPtr->width; col++) { - sprintf(linePtr, " #%02x%02x%02x", *pixelPtr, + Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x", + col ? " " : "", *pixelPtr, pixelPtr[greenOffset], pixelPtr[blueOffset]); pixelPtr += blockPtr->pixelSize; - linePtr += 8; } - Tcl_DStringAppendElement(&data, line+1); + Tcl_ListObjAppendElement(NULL, data, line); } - ckfree (line); } - Tcl_DStringResult(interp, &data); + Tcl_SetObjResult(interp, data); return TCL_OK; } @@ -5874,150 +3930,6 @@ Tk_PhotoGetImage( } /* - *---------------------------------------------------------------------- - * - * PhotoOptionFind -- - * - * Finds a specific Photo option. - * - * Results: - * None. - * - * Side effects: - * After commands are removed. - * - *---------------------------------------------------------------------- - */ - -typedef struct OptionAssocData { - struct OptionAssocData *nextPtr; - /* Pointer to next OptionAssocData. */ - Tcl_ObjCmdProc *command; /* Command associated with this option. */ - char name[1]; /* Name of option (remaining chars) */ -} OptionAssocData; - -static Tcl_ObjCmdProc * -PhotoOptionFind( - Tcl_Interp *interp, /* Interpreter that is being deleted. */ - Tcl_Obj *obj) /* Name of option to be found. */ -{ - int length; - char *name = Tcl_GetStringFromObj(obj, &length); - char *prevname = NULL; - Tcl_ObjCmdProc *proc = NULL; - OptionAssocData *list = (OptionAssocData *) Tcl_GetAssocData(interp, - "photoOption", NULL); - - while (list != NULL) { - if (strncmp(name, list->name, (unsigned) length) == 0) { - if (proc != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "ambiguous option \"", name, - "\": must be ", prevname, NULL); - while (list->nextPtr != NULL) { - Tcl_AppendResult(interp, prevname, ", ",NULL); - list = list->nextPtr; - prevname = list->name; - } - Tcl_AppendResult(interp, ", or", prevname, NULL); - return NULL; - } - proc = list->command; - prevname = list->name; - } - list = list->nextPtr; - } - if (proc != NULL) { - Tcl_ResetResult(interp); - } - return proc; -} - -/* - *---------------------------------------------------------------------- - * - * PhotoOptionCleanupProc -- - * - * This function is invoked whenever an interpreter is deleted to cleanup - * the AssocData for "photoVisitor". - * - * Results: - * None. - * - * Side effects: - * Photo Visitor options are removed. - * - *---------------------------------------------------------------------- - */ - -static void -PhotoOptionCleanupProc( - ClientData clientData, /* Points to "photoVisitor" AssocData for the - * interpreter. */ - Tcl_Interp *interp) /* Interpreter that is being deleted. */ -{ - OptionAssocData *list = (OptionAssocData *) clientData; - - while (list != NULL) { - register OptionAssocData *ptr; - - list = (ptr = list)->nextPtr; - ckfree((char *) ptr); - } -} - -/* - *-------------------------------------------------------------- - * - * Tk_CreatePhotoOption -- - * - * This function may be invoked to add a new kind of photo option to the - * core photo command supported by Tk. - * - * Results: - * None. - * - * Side effects: - * From now on, the new option will be useable by the photo command. - * - *-------------------------------------------------------------- - */ - -MODULE_SCOPE void -Tk_CreatePhotoOption( - Tcl_Interp *interp, /* Interpreter. */ - CONST char *name, /* Option name. */ - Tcl_ObjCmdProc *proc) /* Function to execute command. */ -{ - OptionAssocData *typePtr2, *prevPtr, *ptr; - OptionAssocData *list = (OptionAssocData *) - Tcl_GetAssocData(interp, "photoOption", NULL); - - /* - * If there's already a photo option with the given name, remove it. - */ - - for (typePtr2 = list, prevPtr = NULL; typePtr2 != NULL; - prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) { - if (strcmp(typePtr2->name, name) == 0) { - if (prevPtr == NULL) { - list = typePtr2->nextPtr; - } else { - prevPtr->nextPtr = typePtr2->nextPtr; - } - ckfree((char *) typePtr2); - break; - } - } - ptr = (OptionAssocData *) ckalloc(sizeof(OptionAssocData) + strlen(name)); - strcpy(&(ptr->name[0]), name); - ptr->command = proc; - ptr->nextPtr = list; - Tcl_SetAssocData(interp, "photoOption", PhotoOptionCleanupProc, - (ClientData) ptr); -} - -/* *-------------------------------------------------------------- * * TkPostscriptPhoto -- @@ -6046,7 +3958,7 @@ ImgPhotoPostscript( { Tk_PhotoImageBlock block; - Tk_PhotoGetImage((Tk_PhotoHandle) clientData, &block); + Tk_PhotoGetImage(clientData, &block); block.pixelPtr += y * block.pitch + x * block.pixelSize; return Tk_PostscriptPhoto(interp, &block, psInfo, width, height); diff --git a/generic/tkImgPhoto.h b/generic/tkImgPhoto.h new file mode 100644 index 0000000..36bc6cb --- /dev/null +++ b/generic/tkImgPhoto.h @@ -0,0 +1,262 @@ +/* + * tkImgPhoto.h -- + * + * Declarations for images of type "photo" for Tk. + * + * Copyright (c) 1994 The Australian National University. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 2002-2008 Donal K. Fellows + * Copyright (c) 2003 ActiveState Corporation. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * Author: Paul Mackerras (paulus@cs.anu.edu.au), + * Department of Computer Science, + * Australian National University. + */ + +#include "tkInt.h" +#ifdef _WIN32 +#include "tkWinInt.h" +#elif defined(__CYGWIN__) +#include "tkUnixInt.h" +#endif + +/* + * Forward declarations of the structures we define. + */ + +typedef struct ColorTableId ColorTableId; +typedef struct ColorTable ColorTable; +typedef struct PhotoInstance PhotoInstance; +typedef struct PhotoMaster PhotoMaster; + +/* + * A signed 8-bit integral type. If chars are unsigned and the compiler isn't + * an ANSI one, then we have to use short instead (which wastes space) to get + * signed behavior. + */ + +#if defined(__STDC__) || defined(_AIX) + typedef signed char schar; +#else +# ifndef __CHAR_UNSIGNED__ + typedef char schar; +# else + typedef short schar; +# endif +#endif + +/* + * An unsigned 32-bit integral type, used for pixel values. We use int rather + * than long here to accommodate those systems where longs are 64 bits. + */ + +typedef unsigned int pixel; + +/* + * The maximum number of pixels to transmit to the server in a single + * XPutImage call. + */ + +#define MAX_PIXELS 65536 + +/* + * The set of colors required to display a photo image in a window depends on: + * - the visual used by the window + * - the palette, which specifies how many levels of each primary color to + * use, and + * - the gamma value for the image. + * + * Pixel values allocated for specific colors are valid only for the colormap + * in which they were allocated. Sets of pixel values allocated for displaying + * photos are re-used in other windows if possible, that is, if the display, + * colormap, palette and gamma values match. A hash table is used to locate + * these sets of pixel values, using the following data structure as key: + */ + +struct ColorTableId { + Display *display; /* Qualifies the colormap resource ID. */ + Colormap colormap; /* Colormap that the windows are using. */ + double gamma; /* Gamma exponent value for images. */ + Tk_Uid palette; /* Specifies how many shades of each primary + * we want to allocate. */ +}; + +/* + * For a particular (display, colormap, palette, gamma) combination, a data + * structure of the following type is used to store the allocated pixel values + * and other information: + */ + +struct ColorTable { + ColorTableId id; /* Information used in selecting this color + * table. */ + int flags; /* See below. */ + int refCount; /* Number of instances using this map. */ + int liveRefCount; /* Number of instances which are actually in + * use, using this map. */ + int numColors; /* Number of colors allocated for this map. */ + + XVisualInfo visualInfo; /* Information about the visual for windows + * using this color table. */ + + pixel redValues[256]; /* Maps 8-bit values of red intensity to a + * pixel value or index in pixelMap. */ + pixel greenValues[256]; /* Ditto for green intensity. */ + pixel blueValues[256]; /* Ditto for blue intensity. */ + unsigned long *pixelMap; /* Actual pixel values allocated. */ + + unsigned char colorQuant[3][256]; + /* Maps 8-bit intensities to quantized + * intensities. The first index is 0 for red, + * 1 for green, 2 for blue. */ +}; + +/* + * Bit definitions for the flags field of a ColorTable. + * BLACK_AND_WHITE: 1 means only black and white colors are + * available. + * COLOR_WINDOW: 1 means a full 3-D color cube has been + * allocated. + * DISPOSE_PENDING: 1 means a call to DisposeColorTable has been + * scheduled as an idle handler, but it hasn't + * been invoked yet. + * MAP_COLORS: 1 means pixel values should be mapped through + * pixelMap. + */ + +#ifdef COLOR_WINDOW +#undef COLOR_WINDOW +#endif + +#define BLACK_AND_WHITE 1 +#define COLOR_WINDOW 2 +#define DISPOSE_PENDING 4 +#define MAP_COLORS 8 + +/* + * Definition of the data associated with each photo image master. + */ + +struct PhotoMaster { + Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means the + * image is being deleted. */ + Tcl_Interp *interp; /* Interpreter associated with the application + * using this image. */ + Tcl_Command imageCmd; /* Token for image command (used to delete it + * when the image goes away). NULL means the + * image command has already been deleted. */ + int flags; /* Sundry flags, defined below. */ + int width, height; /* Dimensions of image. */ + int userWidth, userHeight; /* User-declared image dimensions. */ + Tk_Uid palette; /* User-specified default palette for + * instances of this image. */ + double gamma; /* Display gamma value to correct for. */ + char *fileString; /* Name of file to read into image. */ + Tcl_Obj *dataString; /* Object to use as contents of image. */ + Tcl_Obj *format; /* User-specified format of data in image file + * or string value. */ + unsigned char *pix32; /* Local storage for 32-bit image. */ + int ditherX, ditherY; /* Location of first incorrectly dithered + * pixel in image. */ + TkRegion validRegion; /* Tk region indicating which parts of the + * image have valid image data. */ + PhotoInstance *instancePtr; /* First in the list of instances associated + * with this master. */ +}; + +/* + * Bit definitions for the flags field of a PhotoMaster. + * COLOR_IMAGE: 1 means that the image has different color + * components. + * IMAGE_CHANGED: 1 means that the instances of this image need + * to be redithered. + * COMPLEX_ALPHA: 1 means that the instances of this image have + * alpha values that aren't 0 or 255, and so need + * the copy-merge-replace renderer . + */ + +#define COLOR_IMAGE 1 +#define IMAGE_CHANGED 2 +#define COMPLEX_ALPHA 4 + +/* + * Flag to OR with the compositing rule to indicate that the source, despite + * having an alpha channel, has simple alpha. + */ + +#define SOURCE_IS_SIMPLE_ALPHA_PHOTO 0x10000000 + +/* + * The following data structure represents all of the instances of a photo + * image in windows on a given screen that are using the same colormap. + */ + +struct PhotoInstance { + PhotoMaster *masterPtr; /* Pointer to master for image. */ + Display *display; /* Display for windows using this instance. */ + Colormap colormap; /* The image may only be used in windows with + * this particular colormap. */ + PhotoInstance *nextPtr; /* Pointer to the next instance in the list of + * instances associated with this master. */ + int refCount; /* Number of instances using this structure. */ + Tk_Uid palette; /* Palette for these particular instances. */ + double gamma; /* Gamma value for these instances. */ + Tk_Uid defaultPalette; /* Default palette to use if a palette is not + * specified for the master. */ + ColorTable *colorTablePtr; /* Pointer to information about colors + * allocated for image display in windows like + * this one. */ + Pixmap pixels; /* X pixmap containing dithered image. */ + int width, height; /* Dimensions of the pixmap. */ + schar *error; /* Error image, used in dithering. */ + XImage *imagePtr; /* Image structure for converted pixels. */ + XVisualInfo visualInfo; /* Information about the visual that these + * windows are using. */ + GC gc; /* Graphics context for writing images to the + * pixmap. */ +}; + +/* + * Implementation of the Porter-Duff Source-Over compositing rule. + */ + +#define PD_SRC_OVER(srcColor, srcAlpha, dstColor, dstAlpha) \ + (srcColor*srcAlpha/255) + dstAlpha*(255-srcAlpha)/255*dstColor/255 +#define PD_SRC_OVER_ALPHA(srcAlpha, dstAlpha) \ + (srcAlpha + (255-srcAlpha)*dstAlpha/255) + +#undef MIN +#define MIN(a, b) ((a) < (b)? (a): (b)) +#undef MAX +#define MAX(a, b) ((a) > (b)? (a): (b)) + +/* + * Declarations of functions shared between the different parts of the + * photo image implementation. + */ + +MODULE_SCOPE void TkImgPhotoConfigureInstance( + PhotoInstance *instancePtr); +MODULE_SCOPE void TkImgDisposeInstance(ClientData clientData); +MODULE_SCOPE void TkImgPhotoInstanceSetSize(PhotoInstance *instancePtr); +MODULE_SCOPE ClientData TkImgPhotoGet(Tk_Window tkwin, ClientData clientData); +MODULE_SCOPE void TkImgDitherInstance(PhotoInstance *instancePtr, int x, + int y, int width, int height); +MODULE_SCOPE void TkImgPhotoDisplay(ClientData clientData, + Display *display, Drawable drawable, + int imageX, int imageY, int width, int height, + int drawableX, int drawableY); +MODULE_SCOPE void TkImgPhotoFree(ClientData clientData, + Display *display); +MODULE_SCOPE void TkImgResetDither(PhotoInstance *instancePtr); + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tkImgUtil.c b/generic/tkImgUtil.c index 8ba6c0e..5487165 100644 --- a/generic/tkImgUtil.c +++ b/generic/tkImgUtil.c @@ -55,7 +55,7 @@ TkAlignImageData( dataWidth += (alignment - (dataWidth % alignment)); } - data = ckalloc((unsigned) dataWidth * image->height); + data = ckalloc(dataWidth * image->height); destPtr = data; for (i = 0; i < image->height; i++) { diff --git a/generic/tkInt.decls b/generic/tkInt.decls index f24d48c..586b407 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -17,6 +17,7 @@ library tk # Define the unsupported generic interfaces. interface tkInt +scspec EXTERN # Declare each of the functions in the unsupported internal Tcl interface. # These interfaces are allowed to changed between versions. Use at your own @@ -34,9 +35,9 @@ declare 2 { void TkBezierScreenPoints(Tk_Canvas canvas, double control[], int numSteps, XPoint *xPointPtr) } -declare 3 { - void TkBindDeadWindow(TkWindow *winPtr) -} +# +# Slot 3 unused (WAS: TkBindDeadWindow) +# declare 4 { void TkBindEventProc(TkWindow *winPtr, XEvent *eventPtr) } @@ -56,15 +57,10 @@ declare 9 { void TkComputeAnchor(Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY, int innerWidth, int innerHeight, int *xPtr, int *yPtr) } -declare 10 { - int TkCopyAndGlobalEval(Tcl_Interp *interp, char *script) -} -declare 11 { - unsigned long TkCreateBindingProcedure(Tcl_Interp *interp, - Tk_BindingTable bindingTable, ClientData object, - const char *eventString, TkBindEvalProc *evalProc, - TkBindFreeProc *freeProc, ClientData clientData) -} +# +# Slot 10 unused (WAS: TkCopyAndGlobalEval) +# Slot 11 unused (WAS: TkCreateBindingProcedure) +# declare 12 { TkCursor *TkCreateCursorFromData(Tk_Window tkwin, const char *source, const char *mask, int width, int height, @@ -72,11 +68,11 @@ declare 12 { } declare 13 { int TkCreateFrame(ClientData clientData, Tcl_Interp *interp, - int argc, char **argv, int toplevel, char *appName) + int argc, const char *const *argv, int toplevel, const char *appName) } declare 14 { Tk_Window TkCreateMainWindow(Tcl_Interp *interp, - const char *screenName, char *baseName) + const char *screenName, const char *baseName) } declare 15 { Time TkCurrentTime(TkDisplay *dispPtr) @@ -103,7 +99,7 @@ declare 21 { const TkStateMap *mapPtr, const char *strKey) } declare 22 { - char *TkFindStateString(const TkStateMap *mapPtr, int numKey) + CONST86 char *TkFindStateString(const TkStateMap *mapPtr, int numKey) } declare 23 { void TkFocusDeadWindow(TkWindow *winPtr) @@ -129,8 +125,8 @@ declare 29 { void TkpFreeCursor(TkCursor *cursorPtr) } declare 30 { - char *TkGetBitmapData(Tcl_Interp *interp, char *string, - char *fileName, int *widthPtr, int *heightPtr, + char *TkGetBitmapData(Tcl_Interp *interp, const char *string, + const char *fileName, int *widthPtr, int *heightPtr, int *hotXPtr, int *hotYPtr) } declare 31 { @@ -142,7 +138,7 @@ declare 32 { Tk_Window tkwin, Tk_Uid string) } declare 33 { - CONST84_RETURN char *TkGetDefaultScreenName(Tcl_Interp *interp, + const char *TkGetDefaultScreenName(Tcl_Interp *interp, const char *screenName) } declare 34 { @@ -186,7 +182,7 @@ declare 45 { void TkInstallFrameMenu(Tk_Window tkwin) } declare 46 { - char *TkKeysymToString(KeySym keysym) + CONST86 char *TkKeysymToString(KeySym keysym) } declare 47 { int TkLineToArea(double end1Ptr[], double end2Ptr[], double rectPtr[]) @@ -253,7 +249,7 @@ declare 66 { Window TkpMakeWindow(TkWindow *winPtr, Window parent) } declare 67 { - void TkpMenuNotifyToplevelCreate(Tcl_Interp *interp, char *menuName) + void TkpMenuNotifyToplevelCreate(Tcl_Interp *interp, const char *menuName) } declare 68 { TkDisplay *TkpOpenDisplay(const char *display_name) @@ -274,14 +270,14 @@ declare 73 { void TkpRedirectKeyEvent(TkWindow *winPtr, XEvent *eventPtr) } declare 74 { - void TkpSetMainMenubar(Tcl_Interp *interp, Tk_Window tkwin, char *menuName) + void TkpSetMainMenubar(Tcl_Interp *interp, Tk_Window tkwin, const char *menuName) } declare 75 { int TkpUseWindow(Tcl_Interp *interp, Tk_Window tkwin, const char *string) } -declare 76 { - int TkpWindowWasRecentlyDeleted(Window win, TkDisplay *dispPtr) -} +# +# Slot 76 unused (WAS: TkpWindowWasRecentlyDeleted) +# declare 77 { void TkQueueEventForAllChildren(TkWindow *winPtr, XEvent *eventPtr) } @@ -314,10 +310,10 @@ declare 83 { #} declare 85 { void TkSetWindowMenuBar(Tcl_Interp *interp, Tk_Window tkwin, - char *oldMenuName, char *menuName) + const char *oldMenuName, const char *menuName) } declare 86 { - KeySym TkStringToKeysym(char *name) + KeySym TkStringToKeysym(const char *name) } declare 87 { int TkThickPolyLineToArea(double *coordPtr, int numPoints, @@ -358,22 +354,22 @@ declare 97 { # new for 8.1 declare 98 { - Tcl_Obj *TkDebugBitmap(Tk_Window tkwin, char *name) + Tcl_Obj *TkDebugBitmap(Tk_Window tkwin, const char *name) } declare 99 { - Tcl_Obj *TkDebugBorder(Tk_Window tkwin, char *name) + Tcl_Obj *TkDebugBorder(Tk_Window tkwin, const char *name) } declare 100 { - Tcl_Obj *TkDebugCursor(Tk_Window tkwin, char *name) + Tcl_Obj *TkDebugCursor(Tk_Window tkwin, const char *name) } declare 101 { - Tcl_Obj *TkDebugColor(Tk_Window tkwin, char *name) + Tcl_Obj *TkDebugColor(Tk_Window tkwin, const char *name) } declare 102 { Tcl_Obj *TkDebugConfig(Tcl_Interp *interp, Tk_OptionTable table) } declare 103 { - Tcl_Obj *TkDebugFont(Tk_Window tkwin, char *name) + Tcl_Obj *TkDebugFont(Tk_Window tkwin, const char *name) } declare 104 { int TkFindStateNumObj(Tcl_Interp *interp, Tcl_Obj *optionPtr, @@ -393,7 +389,7 @@ declare 108 { Tcl_Obj *objPtr, Tk_Window *windowPtr) } declare 109 { - char *TkpGetString(TkWindow *winPtr, XEvent *eventPtr, Tcl_DString *dsPtr) + CONST86 char *TkpGetString(TkWindow *winPtr, XEvent *eventPtr, Tcl_DString *dsPtr) } declare 110 { void TkpGetSubFonts(Tcl_Interp *interp, Tk_Font tkfont) @@ -429,7 +425,7 @@ declare 119 { TkRegion src, TkRegion dr_return) } declare 121 aqua { - Pixmap TkpCreateNativeBitmap(Display *display, const char *source) + Pixmap TkpCreateNativeBitmap(Display *display, const void *source) } declare 122 aqua { void TkpDefineNativeBitmaps(void) @@ -510,22 +506,71 @@ declare 154 { # entries needed only by tktest: declare 156 { - int TkpTestembedCmd(ClientData clientData, Tcl_Interp *interp, int argc, - const char **argv) + int TkpTestembedCmd(ClientData clientData, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]) } declare 157 { - int TkpTesttextCmd(ClientData dummy, Tcl_Interp *interp, int argc, - const char **argv) -} - -# Next group of functions exposed due to [Bug 2768945]. Numbers are chosen so -# as to match 8.6 branch/HEAD. + int TkpTesttextCmd(ClientData dummy, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]) +} +declare 158 { + int TkSelGetSelection(Tcl_Interp *interp, Tk_Window tkwin, + Atom selection, Atom target, Tk_GetSelProc *proc, + ClientData clientData) +} +declare 159 { + int TkTextGetIndex(Tcl_Interp *interp, struct TkText *textPtr, + const char *string, struct TkTextIndex *indexPtr) +} +declare 160 { + int TkTextIndexBackBytes(const struct TkText *textPtr, + const struct TkTextIndex *srcPtr, int count, + struct TkTextIndex *dstPtr) +} +declare 161 { + int TkTextIndexForwBytes(const struct TkText *textPtr, + const struct TkTextIndex *srcPtr, int count, + struct TkTextIndex *dstPtr) +} +declare 162 { + struct TkTextIndex *TkTextMakeByteIndex(TkTextBTree tree, + const struct TkText *textPtr, int lineIndex, + int byteIndex, struct TkTextIndex *indexPtr) +} +declare 163 { + int TkTextPrintIndex(const struct TkText *textPtr, + const struct TkTextIndex *indexPtr, char *string) +} +declare 164 { + struct TkTextSegment *TkTextSetMark(struct TkText *textPtr, + const char *name, struct TkTextIndex *indexPtr) +} +declare 165 { + int TkTextXviewCmd(struct TkText *textPtr, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +} +declare 166 { + void TkTextChanged(struct TkSharedText *sharedTextPtr, + struct TkText *textPtr, const struct TkTextIndex *index1Ptr, + const struct TkTextIndex *index2Ptr) +} +declare 167 { + int TkBTreeNumLines(TkTextBTree tree, + const struct TkText *textPtr) +} +declare 168 { + void TkTextInsertDisplayProc(struct TkText *textPtr, + struct TkTextDispChunk *chunkPtr, int x, int y, + int height, int baseline, Display *display, + Drawable dst, int screenY) +} +# Next group of functions exposed due to [Bug 2768945]. declare 169 { int TkStateParseProc(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset) } declare 170 { - char *TkStatePrintProc(ClientData clientData, Tk_Window tkwin, + CONST86 char *TkStatePrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr) } declare 171 { @@ -533,7 +578,7 @@ declare 171 { Tk_Window tkwin, const char *value, char *widgRec, int offset) } declare 172 { - char *TkCanvasDashPrintProc(ClientData clientData, Tk_Window tkwin, + CONST86 char *TkCanvasDashPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr) } declare 173 { @@ -541,7 +586,7 @@ declare 173 { Tk_Window tkwin, const char *value, char *widgRec, int offset) } declare 174 { - char *TkOffsetPrintProc(ClientData clientData, Tk_Window tkwin, + CONST86 char *TkOffsetPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr) } declare 175 { @@ -549,7 +594,7 @@ declare 175 { Tk_Window tkwin, const char *value, char *widgRec, int offset) } declare 176 { - char *TkPixelPrintProc(ClientData clientData, Tk_Window tkwin, + CONST86 char *TkPixelPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr) } declare 177 { @@ -557,7 +602,7 @@ declare 177 { Tk_Window tkwin, const char *value, char *widgRec, int offset) } declare 178 { - char *TkOrientPrintProc(ClientData clientData, Tk_Window tkwin, + CONST86 char *TkOrientPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr) } declare 179 { @@ -565,11 +610,29 @@ declare 179 { Tk_Window tkwin, const char *value, char *widgRec, int offset) } declare 180 { - char *TkSmoothPrintProc(ClientData clientData, Tk_Window tkwin, + CONST86 char *TkSmoothPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr) } + +# Angled text API, exposed for Emiliano Gavilán's RBC work. +declare 181 { + void TkDrawAngledTextLayout(Display *display, Drawable drawable, GC gc, + Tk_TextLayout layout, int x, int y, double angle, int firstChar, + int lastChar) +} +declare 182 { + void TkUnderlineAngledTextLayout(Display *display, Drawable drawable, + GC gc, Tk_TextLayout layout, int x, int y, double angle, + int underline) +} +declare 183 { + int TkIntersectAngledTextLayout(Tk_TextLayout layout, int x, int y, + int width, int height, double angle) +} declare 184 { - void TkUnusedStubEntry(void) + void TkDrawAngledChars(Display *display,Drawable drawable, GC gc, + Tk_Font tkfont, const char *source, int numBytes, double x, + double y, double angle) } ############################################################################## @@ -585,12 +648,10 @@ interface tkIntPlat declare 0 x11 { void TkCreateXEventSource(void) } -declare 1 x11 { - void TkFreeWindowId(TkDisplay *dispPtr, Window w) -} -declare 2 x11 { - void TkInitXId(TkDisplay *dispPtr) -} +# +# Slot 1 unused (WAS: TkFreeWindowId) +# Slot 2 unused (WAS: TkInitXId) +# declare 3 x11 { int TkpCmapStressed(Tk_Window tkwin, Colormap colormap) } @@ -615,16 +676,16 @@ declare 9 x11 { declare 10 x11 { void TkSendCleanup(TkDisplay *dispPtr) } -declare 11 x11 { - void TkFreeXId(TkDisplay *dispPtr) -} +# +# Slot 11 unused (WAS: TkFreeXId) +# declare 12 x11 { int TkpWmSetState(TkWindow *winPtr, int state) } # only needed by tktest: declare 13 x11 { - int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int argc, - const char **argv) + int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]) } ################################ @@ -780,8 +841,8 @@ declare 44 win { } # only needed by tktest: declare 45 win { - int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int argc, - const char **argv) + int TkpTestsendCmd(ClientData clientData, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]) } ################################ @@ -793,7 +854,7 @@ declare 0 aqua { # removed duplicates from tkInt table #declare 1 aqua { -# Pixmap TkpCreateNativeBitmap(Display *display, const char *source) +# Pixmap TkpCreateNativeBitmap(Display *display, const void *source) #} # #declare 2 aqua { @@ -1359,7 +1420,7 @@ declare 106 win { int x, int y, unsigned int width, unsigned int height) } -# new for 8.4.20+/8.5.12+ Cygwin only +# New in Tk 8.6 declare 107 win { int XFlush(Display *display) } diff --git a/generic/tkInt.h b/generic/tkInt.h index 15a01c5..b644c5b 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -15,22 +15,17 @@ #ifndef _TKINT #define _TKINT -#ifndef _TK -#include "tk.h" -#endif -#ifndef _TCL -#include "tcl.h" -#endif #ifndef _TKPORT #include "tkPort.h" #endif /* - * Ensure WORDS_BIGENDIAN is defined correcly: + * Ensure WORDS_BIGENDIAN is defined correctly: * Needs to happen here in addition to configure to work with fat compiles on * Darwin (where configure runs only once for multiple architectures). */ +#include <stdio.h> #ifdef HAVE_SYS_TYPES_H # include <sys/types.h> #endif @@ -100,18 +95,11 @@ typedef struct TkpCursor_ *TkpCursor; typedef struct TkRegion_ *TkRegion; typedef struct TkStressedCmap TkStressedCmap; typedef struct TkBindInfo_ *TkBindInfo; - -/* - * Function types. - */ - -typedef int (TkBindEvalProc)(ClientData clientData, Tcl_Interp *interp, - XEvent *eventPtr, Tk_Window tkwin, KeySym keySym); -typedef void (TkBindFreeProc)(ClientData clientData); +typedef struct Busy *TkBusy; /* * One of the following structures is maintained for each cursor in use in the - * system. This structure is used by tkCursor.c and the various system + * system. This structure is used by tkCursor.c and the various system- * specific cursor files. */ @@ -397,10 +385,6 @@ typedef struct TkDisplay { int postCommandGeneration; /* - * Information used by tkOption.c only. - */ - - /* * Information used by tkPack.c only. */ @@ -469,24 +453,6 @@ typedef struct TkDisplay { * application name on each comm window. */ /* - * Information used by tkXId.c only: - */ - - struct TkIdStack *idStackPtr; - /* First in list of chunks of free resource - * identifiers, or NULL if there are no free - * resources. */ - XID (*defaultAllocProc) (Display *display); - /* Default resource allocator for display. */ - struct TkIdStack *windowStackPtr; - /* First in list of chunks of window ids that - * can't be reused right now. */ - Tcl_TimerToken idCleanupScheduled; - /* If set, it means a call to WindowIdCleanup - * has already been scheduled, 0 means it - * hasn't. */ - - /* * Information used by tkUnixWm.c and tkWinWm.c only: */ @@ -495,18 +461,6 @@ typedef struct TkDisplay { /* Points to the foreground window. */ /* - * Information maintained by tkWindow.c for use later on by tkXId.c: - */ - - int destroyCount; /* Number of Tk_DestroyWindow operations in - * progress. */ - unsigned long lastDestroyRequest; - /* Id of most recent XDestroyWindow request; - * can re-use ids in windowStackPtr when - * server has seen this request and event - * queue is empty. */ - - /* * Information used by tkVisual.c only: */ @@ -537,7 +491,9 @@ typedef struct TkDisplay { * display. */ Window mouseButtonWindow; /* Window the button state was set in, added * in Tk 8.4. */ - Window warpWindow; + Tk_Window warpWindow; + Tk_Window warpMainwin; /* For finding the root window for warping + * purposes. */ int warpX; int warpY; @@ -670,6 +626,7 @@ typedef struct TkMainInfo { * ::tk::AlwaysShowSelection variable. */ struct TkMainInfo *nextPtr; /* Next in list of all main windows managed by * this process. */ + Tcl_HashTable busyTable; /* Information used by [tk busy] command. */ } TkMainInfo; /* @@ -679,7 +636,7 @@ typedef struct TkMainInfo { */ typedef struct { - const char *source; /* Bits for bitmap. */ + const void *source; /* Bits for bitmap. */ int width, height; /* Dimensions of bitmap. */ int native; /* 0 means generic (X style) bitmap, 1 means * native style bitmap. */ @@ -804,7 +761,8 @@ typedef struct TkWindow { * Information used by tkGeometry.c for geometry management. */ - const Tk_GeomMgr *geomMgrPtr; /* Information about geometry manager for this + const Tk_GeomMgr *geomMgrPtr; + /* Information about geometry manager for this * window. */ ClientData geomData; /* Argument for geometry manager functions. */ int reqWidth, reqHeight; /* Arguments from last call to @@ -823,13 +781,14 @@ typedef struct TkWindow { struct TkWmInfo *wmInfoPtr; /* For top-level windows (and also for special * Unix menubar and wrapper windows), points * to structure with wm-related info (see - * tkWm.c). For other windows, this is NULL. */ + * tkWm.c). For other windows, this is + * NULL. */ /* * Information used by widget classes. */ - Tk_ClassProcs *classProcsPtr; + const Tk_ClassProcs *classProcsPtr; ClientData instanceData; /* @@ -849,6 +808,7 @@ typedef struct TkWindow { int minReqWidth; /* Minimum requested width. */ int minReqHeight; /* Minimum requested height. */ + char *geometryMaster; } TkWindow; /* @@ -870,6 +830,25 @@ typedef struct { } TkKeyEvent; /* + * Flags passed to TkpMakeMenuWindow's 'transient' argument. + */ + +#define TK_MAKE_MENU_TEAROFF 0 /* Only non-transient case. */ +#define TK_MAKE_MENU_POPUP 1 +#define TK_MAKE_MENU_DROPDOWN 2 + +/* + * The following structure is used with TkMakeEnsemble to create ensemble + * commands and optionally to create sub-ensembles. + */ + +typedef struct TkEnsemble { + const char *name; + Tcl_ObjCmdProc *proc; + const struct TkEnsemble *subensemble; +} TkEnsemble; + +/* * The following structure is used as a two way map between integers and * strings, usually to map between an internal C representation and the * strings used in Tcl. @@ -897,12 +876,6 @@ typedef struct TkpClipMask { #define TKP_CLIP_REGION 1 /* - * Pointer to first entry in list of all displays currently known. - */ - -extern TkDisplay *tkDisplayList; - -/* * Return values from TkGrabState: */ @@ -949,30 +922,72 @@ extern TkDisplay *tkDisplayList; * be properly registered with Tcl: */ -MODULE_SCOPE Tcl_ObjType tkBorderObjType; -MODULE_SCOPE Tcl_ObjType tkBitmapObjType; -MODULE_SCOPE Tcl_ObjType tkColorObjType; -MODULE_SCOPE Tcl_ObjType tkCursorObjType; -MODULE_SCOPE Tcl_ObjType tkFontObjType; -MODULE_SCOPE Tcl_ObjType tkOptionObjType; -MODULE_SCOPE Tcl_ObjType tkStateKeyObjType; -MODULE_SCOPE Tcl_ObjType tkTextIndexType; +MODULE_SCOPE const Tcl_ObjType tkBorderObjType; +MODULE_SCOPE const Tcl_ObjType tkBitmapObjType; +MODULE_SCOPE const Tcl_ObjType tkColorObjType; +MODULE_SCOPE const Tcl_ObjType tkCursorObjType; +MODULE_SCOPE const Tcl_ObjType tkFontObjType; +MODULE_SCOPE const Tcl_ObjType tkStateKeyObjType; +MODULE_SCOPE const Tcl_ObjType tkTextIndexType; /* * Miscellaneous variables shared among Tk modules but not exported to the * outside world: */ -MODULE_SCOPE Tk_SmoothMethod tkBezierSmoothMethod; +MODULE_SCOPE const Tk_SmoothMethod tkBezierSmoothMethod; MODULE_SCOPE Tk_ImageType tkBitmapImageType; MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtGIF; MODULE_SCOPE void (*tkHandleEventProc) (XEvent* eventPtr); +MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPNG; MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPPM; MODULE_SCOPE TkMainInfo *tkMainWindowList; MODULE_SCOPE Tk_ImageType tkPhotoImageType; MODULE_SCOPE Tcl_HashTable tkPredefBitmapTable; -MODULE_SCOPE CONST char *const tkWebColors[20]; +MODULE_SCOPE const char *const tkWebColors[20]; + +/* + * The definition of pi, at least from the perspective of double-precision + * floats. + */ + +#ifndef PI +#ifdef M_PI +#define PI M_PI +#else +#define PI 3.14159265358979323846 +#endif +#endif + +/* + * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org> + */ + +#if defined(PURIFY) && defined(__clang__) +#if __has_feature(attribute_analyzer_noreturn) && \ + !defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED) +void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); +#endif +#if !defined(CLANG_ASSERT) +#include <assert.h> +#define CLANG_ASSERT(x) assert(x) +#endif +#elif !defined(CLANG_ASSERT) +#define CLANG_ASSERT(x) +#endif /* PURIFY && __clang__ */ + +/* + * The following magic value is stored in the "send_event" field of FocusIn + * and FocusOut events. This allows us to separate "real" events coming from + * the server from those that we generated. + */ + +#define GENERATED_FOCUS_EVENT_MAGIC ((Bool) 0x547321ac) + +/* + * Exported internals. + */ #include "tkIntDecls.h" @@ -996,6 +1011,9 @@ MODULE_SCOPE int Tk_BindObjCmd(ClientData clientData, MODULE_SCOPE int Tk_BindtagsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int Tk_BusyObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_ButtonObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1014,9 +1032,6 @@ MODULE_SCOPE int Tk_ChooseColorObjCmd(ClientData clientData, MODULE_SCOPE int Tk_ChooseDirectoryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tk_ChooseFontObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_DestroyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1062,6 +1077,9 @@ MODULE_SCOPE int Tk_ListboxObjCmd(ClientData clientData, MODULE_SCOPE int Tk_LowerObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int Tk_MenuObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_MenubuttonObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1092,13 +1110,15 @@ MODULE_SCOPE int Tk_RaiseObjCmd(ClientData clientData, MODULE_SCOPE int Tk_ScaleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tk_ScrollbarCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +MODULE_SCOPE int Tk_ScrollbarObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_SelectionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tk_SendCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +MODULE_SCOPE int Tk_SendObjCmd(ClientData clientData, + Tcl_Interp *interp,int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_SendObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1108,9 +1128,6 @@ MODULE_SCOPE int Tk_SpinboxObjCmd(ClientData clientData, MODULE_SCOPE int Tk_TextObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tk_TkObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int Tk_TkwaitObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1129,12 +1146,15 @@ MODULE_SCOPE int Tk_WmObjCmd(ClientData clientData, Tcl_Interp *interp, MODULE_SCOPE int Tk_GetDoublePixelsFromObj(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr); +MODULE_SCOPE int TkSetGeometryMaster(Tcl_Interp *interp, + Tk_Window tkwin, const char *master); +MODULE_SCOPE void TkFreeGeometryMaster(Tk_Window tkwin, + const char *master); MODULE_SCOPE void TkEventInit(void); MODULE_SCOPE void TkRegisterObjTypes(void); -MODULE_SCOPE int TkCreateMenuCmd(Tcl_Interp *interp); -MODULE_SCOPE int TkDeadAppCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +MODULE_SCOPE int TkDeadAppObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const argv[]); MODULE_SCOPE int TkCanvasGetCoordObj(Tcl_Interp *interp, Tk_Canvas canvas, Tcl_Obj *obj, double *doublePtr); @@ -1155,8 +1175,8 @@ MODULE_SCOPE void TkpBuildRegionFromAlphaData(TkRegion region, unsigned x, unsigned y, unsigned width, unsigned height, unsigned char *dataPtr, unsigned pixelStride, unsigned lineStride); -MODULE_SCOPE void TkPrintPadAmount(Tcl_Interp *interp, - char *buffer, int pad1, int pad2); +MODULE_SCOPE void TkAppendPadAmount(Tcl_Obj *bufferObj, + const char *buffer, int pad1, int pad2); MODULE_SCOPE int TkParsePadAmount(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, int *pad1Ptr, int *pad2Ptr); @@ -1177,11 +1197,32 @@ MODULE_SCOPE void TkUnderlineCharsInContext(Display *display, int firstByte, int lastByte); MODULE_SCOPE void TkpGetFontAttrsForChar(Tk_Window tkwin, Tk_Font tkfont, Tcl_UniChar c, struct TkFontAttributes *faPtr); -#ifdef __WIN32__ +MODULE_SCOPE Tcl_Obj * TkNewWindowObj(Tk_Window tkwin); +MODULE_SCOPE void TkpShowBusyWindow(TkBusy busy); +MODULE_SCOPE void TkpHideBusyWindow(TkBusy busy); +MODULE_SCOPE void TkpMakeTransparentWindowExist(Tk_Window tkwin, + Window parent); +MODULE_SCOPE void TkpCreateBusy(Tk_FakeWin *winPtr, Tk_Window tkRef, + Window *parentPtr, Tk_Window tkParent, + TkBusy busy); +MODULE_SCOPE int TkBackgroundEvalObjv(Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv, int flags); +MODULE_SCOPE void TkSendVirtualEvent(Tk_Window tgtWin, + const char *eventName); +MODULE_SCOPE Tcl_Command TkMakeEnsemble(Tcl_Interp *interp, + const char *nsname, const char *name, + ClientData clientData, const TkEnsemble *map); +MODULE_SCOPE int TkInitTkCmd(Tcl_Interp *interp, + ClientData clientData); +MODULE_SCOPE int TkInitFontchooser(Tcl_Interp *interp, + ClientData clientData); +MODULE_SCOPE void TkpWarpPointer(TkDisplay *dispPtr); + +#ifdef _WIN32 #define TkParseColor XParseColor #else MODULE_SCOPE Status TkParseColor (Display * display, - Colormap map, CONST char* spec, + Colormap map, const char* spec, XColor * colorPtr); #endif #ifdef HAVE_XFT @@ -1196,8 +1237,21 @@ MODULE_SCOPE int TkUnsupported1ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -#endif /* _TKINT */ +/* + * For Tktest. + */ +MODULE_SCOPE int SquareObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); +MODULE_SCOPE int TkOldTestInit(Tcl_Interp *interp); +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) +#define TkplatformtestInit(x) TCL_OK +#else +MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); +#endif +#endif /* _TKINT */ + /* * Local Variables: * mode: c diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h index 9dea8d4..b8addbd 100644 --- a/generic/tkIntDecls.h +++ b/generic/tkIntDecls.h @@ -20,6 +20,13 @@ #define TCL_STORAGE_CLASS DLLEXPORT #endif +struct TkText; +typedef struct TkTextBTree_ *TkTextBTree; +struct TkTextDispChunk; +struct TkTextIndex; +struct TkTextSegment; +struct TkSharedText; + /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -36,702 +43,328 @@ extern "C" { * Exported function declarations: */ -#ifndef TkAllocWindow_TCL_DECLARED -#define TkAllocWindow_TCL_DECLARED /* 0 */ EXTERN TkWindow * TkAllocWindow(TkDisplay *dispPtr, int screenNum, TkWindow *parentPtr); -#endif -#ifndef TkBezierPoints_TCL_DECLARED -#define TkBezierPoints_TCL_DECLARED /* 1 */ EXTERN void TkBezierPoints(double control[], int numSteps, double *coordPtr); -#endif -#ifndef TkBezierScreenPoints_TCL_DECLARED -#define TkBezierScreenPoints_TCL_DECLARED /* 2 */ EXTERN void TkBezierScreenPoints(Tk_Canvas canvas, double control[], int numSteps, XPoint *xPointPtr); -#endif -#ifndef TkBindDeadWindow_TCL_DECLARED -#define TkBindDeadWindow_TCL_DECLARED -/* 3 */ -EXTERN void TkBindDeadWindow(TkWindow *winPtr); -#endif -#ifndef TkBindEventProc_TCL_DECLARED -#define TkBindEventProc_TCL_DECLARED +/* Slot 3 is reserved */ /* 4 */ EXTERN void TkBindEventProc(TkWindow *winPtr, XEvent *eventPtr); -#endif -#ifndef TkBindFree_TCL_DECLARED -#define TkBindFree_TCL_DECLARED /* 5 */ EXTERN void TkBindFree(TkMainInfo *mainPtr); -#endif -#ifndef TkBindInit_TCL_DECLARED -#define TkBindInit_TCL_DECLARED /* 6 */ EXTERN void TkBindInit(TkMainInfo *mainPtr); -#endif -#ifndef TkChangeEventWindow_TCL_DECLARED -#define TkChangeEventWindow_TCL_DECLARED /* 7 */ EXTERN void TkChangeEventWindow(XEvent *eventPtr, TkWindow *winPtr); -#endif -#ifndef TkClipInit_TCL_DECLARED -#define TkClipInit_TCL_DECLARED /* 8 */ EXTERN int TkClipInit(Tcl_Interp *interp, TkDisplay *dispPtr); -#endif -#ifndef TkComputeAnchor_TCL_DECLARED -#define TkComputeAnchor_TCL_DECLARED /* 9 */ EXTERN void TkComputeAnchor(Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY, int innerWidth, int innerHeight, int *xPtr, int *yPtr); -#endif -#ifndef TkCopyAndGlobalEval_TCL_DECLARED -#define TkCopyAndGlobalEval_TCL_DECLARED -/* 10 */ -EXTERN int TkCopyAndGlobalEval(Tcl_Interp *interp, char *script); -#endif -#ifndef TkCreateBindingProcedure_TCL_DECLARED -#define TkCreateBindingProcedure_TCL_DECLARED -/* 11 */ -EXTERN unsigned long TkCreateBindingProcedure(Tcl_Interp *interp, - Tk_BindingTable bindingTable, - ClientData object, CONST char *eventString, - TkBindEvalProc *evalProc, - TkBindFreeProc *freeProc, - ClientData clientData); -#endif -#ifndef TkCreateCursorFromData_TCL_DECLARED -#define TkCreateCursorFromData_TCL_DECLARED +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ /* 12 */ EXTERN TkCursor * TkCreateCursorFromData(Tk_Window tkwin, - CONST char *source, CONST char *mask, + const char *source, const char *mask, int width, int height, int xHot, int yHot, XColor fg, XColor bg); -#endif -#ifndef TkCreateFrame_TCL_DECLARED -#define TkCreateFrame_TCL_DECLARED /* 13 */ EXTERN int TkCreateFrame(ClientData clientData, - Tcl_Interp *interp, int argc, char **argv, - int toplevel, char *appName); -#endif -#ifndef TkCreateMainWindow_TCL_DECLARED -#define TkCreateMainWindow_TCL_DECLARED + Tcl_Interp *interp, int argc, + const char *const *argv, int toplevel, + const char *appName); /* 14 */ EXTERN Tk_Window TkCreateMainWindow(Tcl_Interp *interp, - CONST char *screenName, char *baseName); -#endif -#ifndef TkCurrentTime_TCL_DECLARED -#define TkCurrentTime_TCL_DECLARED + const char *screenName, const char *baseName); /* 15 */ EXTERN Time TkCurrentTime(TkDisplay *dispPtr); -#endif -#ifndef TkDeleteAllImages_TCL_DECLARED -#define TkDeleteAllImages_TCL_DECLARED /* 16 */ EXTERN void TkDeleteAllImages(TkMainInfo *mainPtr); -#endif -#ifndef TkDoConfigureNotify_TCL_DECLARED -#define TkDoConfigureNotify_TCL_DECLARED /* 17 */ EXTERN void TkDoConfigureNotify(TkWindow *winPtr); -#endif -#ifndef TkDrawInsetFocusHighlight_TCL_DECLARED -#define TkDrawInsetFocusHighlight_TCL_DECLARED /* 18 */ EXTERN void TkDrawInsetFocusHighlight(Tk_Window tkwin, GC gc, int width, Drawable drawable, int padding); -#endif -#ifndef TkEventDeadWindow_TCL_DECLARED -#define TkEventDeadWindow_TCL_DECLARED /* 19 */ EXTERN void TkEventDeadWindow(TkWindow *winPtr); -#endif -#ifndef TkFillPolygon_TCL_DECLARED -#define TkFillPolygon_TCL_DECLARED /* 20 */ EXTERN void TkFillPolygon(Tk_Canvas canvas, double *coordPtr, int numPoints, Display *display, Drawable drawable, GC gc, GC outlineGC); -#endif -#ifndef TkFindStateNum_TCL_DECLARED -#define TkFindStateNum_TCL_DECLARED /* 21 */ EXTERN int TkFindStateNum(Tcl_Interp *interp, - CONST char *option, CONST TkStateMap *mapPtr, - CONST char *strKey); -#endif -#ifndef TkFindStateString_TCL_DECLARED -#define TkFindStateString_TCL_DECLARED + const char *option, const TkStateMap *mapPtr, + const char *strKey); /* 22 */ -EXTERN char * TkFindStateString(CONST TkStateMap *mapPtr, +EXTERN CONST86 char * TkFindStateString(const TkStateMap *mapPtr, int numKey); -#endif -#ifndef TkFocusDeadWindow_TCL_DECLARED -#define TkFocusDeadWindow_TCL_DECLARED /* 23 */ EXTERN void TkFocusDeadWindow(TkWindow *winPtr); -#endif -#ifndef TkFocusFilterEvent_TCL_DECLARED -#define TkFocusFilterEvent_TCL_DECLARED /* 24 */ EXTERN int TkFocusFilterEvent(TkWindow *winPtr, XEvent *eventPtr); -#endif -#ifndef TkFocusKeyEvent_TCL_DECLARED -#define TkFocusKeyEvent_TCL_DECLARED /* 25 */ EXTERN TkWindow * TkFocusKeyEvent(TkWindow *winPtr, XEvent *eventPtr); -#endif -#ifndef TkFontPkgInit_TCL_DECLARED -#define TkFontPkgInit_TCL_DECLARED /* 26 */ EXTERN void TkFontPkgInit(TkMainInfo *mainPtr); -#endif -#ifndef TkFontPkgFree_TCL_DECLARED -#define TkFontPkgFree_TCL_DECLARED /* 27 */ EXTERN void TkFontPkgFree(TkMainInfo *mainPtr); -#endif -#ifndef TkFreeBindingTags_TCL_DECLARED -#define TkFreeBindingTags_TCL_DECLARED /* 28 */ EXTERN void TkFreeBindingTags(TkWindow *winPtr); -#endif -#ifndef TkpFreeCursor_TCL_DECLARED -#define TkpFreeCursor_TCL_DECLARED /* 29 */ EXTERN void TkpFreeCursor(TkCursor *cursorPtr); -#endif -#ifndef TkGetBitmapData_TCL_DECLARED -#define TkGetBitmapData_TCL_DECLARED /* 30 */ -EXTERN char * TkGetBitmapData(Tcl_Interp *interp, char *string, - char *fileName, int *widthPtr, - int *heightPtr, int *hotXPtr, int *hotYPtr); -#endif -#ifndef TkGetButtPoints_TCL_DECLARED -#define TkGetButtPoints_TCL_DECLARED +EXTERN char * TkGetBitmapData(Tcl_Interp *interp, + const char *string, const char *fileName, + int *widthPtr, int *heightPtr, int *hotXPtr, + int *hotYPtr); /* 31 */ EXTERN void TkGetButtPoints(double p1[], double p2[], double width, int project, double m1[], double m2[]); -#endif -#ifndef TkGetCursorByName_TCL_DECLARED -#define TkGetCursorByName_TCL_DECLARED /* 32 */ EXTERN TkCursor * TkGetCursorByName(Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid string); -#endif -#ifndef TkGetDefaultScreenName_TCL_DECLARED -#define TkGetDefaultScreenName_TCL_DECLARED /* 33 */ -EXTERN CONST84_RETURN char * TkGetDefaultScreenName(Tcl_Interp *interp, - CONST char *screenName); -#endif -#ifndef TkGetDisplay_TCL_DECLARED -#define TkGetDisplay_TCL_DECLARED +EXTERN const char * TkGetDefaultScreenName(Tcl_Interp *interp, + const char *screenName); /* 34 */ EXTERN TkDisplay * TkGetDisplay(Display *display); -#endif -#ifndef TkGetDisplayOf_TCL_DECLARED -#define TkGetDisplayOf_TCL_DECLARED /* 35 */ EXTERN int TkGetDisplayOf(Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[], Tk_Window *tkwinPtr); -#endif -#ifndef TkGetFocusWin_TCL_DECLARED -#define TkGetFocusWin_TCL_DECLARED + Tcl_Obj *const objv[], Tk_Window *tkwinPtr); /* 36 */ EXTERN TkWindow * TkGetFocusWin(TkWindow *winPtr); -#endif -#ifndef TkGetInterpNames_TCL_DECLARED -#define TkGetInterpNames_TCL_DECLARED /* 37 */ EXTERN int TkGetInterpNames(Tcl_Interp *interp, Tk_Window tkwin); -#endif -#ifndef TkGetMiterPoints_TCL_DECLARED -#define TkGetMiterPoints_TCL_DECLARED /* 38 */ EXTERN int TkGetMiterPoints(double p1[], double p2[], double p3[], double width, double m1[], double m2[]); -#endif -#ifndef TkGetPointerCoords_TCL_DECLARED -#define TkGetPointerCoords_TCL_DECLARED /* 39 */ EXTERN void TkGetPointerCoords(Tk_Window tkwin, int *xPtr, int *yPtr); -#endif -#ifndef TkGetServerInfo_TCL_DECLARED -#define TkGetServerInfo_TCL_DECLARED /* 40 */ EXTERN void TkGetServerInfo(Tcl_Interp *interp, Tk_Window tkwin); -#endif -#ifndef TkGrabDeadWindow_TCL_DECLARED -#define TkGrabDeadWindow_TCL_DECLARED /* 41 */ EXTERN void TkGrabDeadWindow(TkWindow *winPtr); -#endif -#ifndef TkGrabState_TCL_DECLARED -#define TkGrabState_TCL_DECLARED /* 42 */ EXTERN int TkGrabState(TkWindow *winPtr); -#endif -#ifndef TkIncludePoint_TCL_DECLARED -#define TkIncludePoint_TCL_DECLARED /* 43 */ EXTERN void TkIncludePoint(Tk_Item *itemPtr, double *pointPtr); -#endif -#ifndef TkInOutEvents_TCL_DECLARED -#define TkInOutEvents_TCL_DECLARED /* 44 */ EXTERN void TkInOutEvents(XEvent *eventPtr, TkWindow *sourcePtr, TkWindow *destPtr, int leaveType, int enterType, Tcl_QueuePosition position); -#endif -#ifndef TkInstallFrameMenu_TCL_DECLARED -#define TkInstallFrameMenu_TCL_DECLARED /* 45 */ EXTERN void TkInstallFrameMenu(Tk_Window tkwin); -#endif -#ifndef TkKeysymToString_TCL_DECLARED -#define TkKeysymToString_TCL_DECLARED /* 46 */ -EXTERN char * TkKeysymToString(KeySym keysym); -#endif -#ifndef TkLineToArea_TCL_DECLARED -#define TkLineToArea_TCL_DECLARED +EXTERN CONST86 char * TkKeysymToString(KeySym keysym); /* 47 */ EXTERN int TkLineToArea(double end1Ptr[], double end2Ptr[], double rectPtr[]); -#endif -#ifndef TkLineToPoint_TCL_DECLARED -#define TkLineToPoint_TCL_DECLARED /* 48 */ EXTERN double TkLineToPoint(double end1Ptr[], double end2Ptr[], double pointPtr[]); -#endif -#ifndef TkMakeBezierCurve_TCL_DECLARED -#define TkMakeBezierCurve_TCL_DECLARED /* 49 */ EXTERN int TkMakeBezierCurve(Tk_Canvas canvas, double *pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[]); -#endif -#ifndef TkMakeBezierPostscript_TCL_DECLARED -#define TkMakeBezierPostscript_TCL_DECLARED /* 50 */ EXTERN void TkMakeBezierPostscript(Tcl_Interp *interp, Tk_Canvas canvas, double *pointPtr, int numPoints); -#endif -#ifndef TkOptionClassChanged_TCL_DECLARED -#define TkOptionClassChanged_TCL_DECLARED /* 51 */ EXTERN void TkOptionClassChanged(TkWindow *winPtr); -#endif -#ifndef TkOptionDeadWindow_TCL_DECLARED -#define TkOptionDeadWindow_TCL_DECLARED /* 52 */ EXTERN void TkOptionDeadWindow(TkWindow *winPtr); -#endif -#ifndef TkOvalToArea_TCL_DECLARED -#define TkOvalToArea_TCL_DECLARED /* 53 */ EXTERN int TkOvalToArea(double *ovalPtr, double *rectPtr); -#endif -#ifndef TkOvalToPoint_TCL_DECLARED -#define TkOvalToPoint_TCL_DECLARED /* 54 */ EXTERN double TkOvalToPoint(double ovalPtr[], double width, int filled, double pointPtr[]); -#endif -#ifndef TkpChangeFocus_TCL_DECLARED -#define TkpChangeFocus_TCL_DECLARED /* 55 */ EXTERN int TkpChangeFocus(TkWindow *winPtr, int force); -#endif -#ifndef TkpCloseDisplay_TCL_DECLARED -#define TkpCloseDisplay_TCL_DECLARED /* 56 */ EXTERN void TkpCloseDisplay(TkDisplay *dispPtr); -#endif -#ifndef TkpClaimFocus_TCL_DECLARED -#define TkpClaimFocus_TCL_DECLARED /* 57 */ EXTERN void TkpClaimFocus(TkWindow *topLevelPtr, int force); -#endif -#ifndef TkpDisplayWarning_TCL_DECLARED -#define TkpDisplayWarning_TCL_DECLARED /* 58 */ -EXTERN void TkpDisplayWarning(CONST char *msg, CONST char *title); -#endif -#ifndef TkpGetAppName_TCL_DECLARED -#define TkpGetAppName_TCL_DECLARED +EXTERN void TkpDisplayWarning(const char *msg, const char *title); /* 59 */ EXTERN void TkpGetAppName(Tcl_Interp *interp, Tcl_DString *name); -#endif -#ifndef TkpGetOtherWindow_TCL_DECLARED -#define TkpGetOtherWindow_TCL_DECLARED /* 60 */ EXTERN TkWindow * TkpGetOtherWindow(TkWindow *winPtr); -#endif -#ifndef TkpGetWrapperWindow_TCL_DECLARED -#define TkpGetWrapperWindow_TCL_DECLARED /* 61 */ EXTERN TkWindow * TkpGetWrapperWindow(TkWindow *winPtr); -#endif -#ifndef TkpInit_TCL_DECLARED -#define TkpInit_TCL_DECLARED /* 62 */ EXTERN int TkpInit(Tcl_Interp *interp); -#endif -#ifndef TkpInitializeMenuBindings_TCL_DECLARED -#define TkpInitializeMenuBindings_TCL_DECLARED /* 63 */ EXTERN void TkpInitializeMenuBindings(Tcl_Interp *interp, Tk_BindingTable bindingTable); -#endif -#ifndef TkpMakeContainer_TCL_DECLARED -#define TkpMakeContainer_TCL_DECLARED /* 64 */ EXTERN void TkpMakeContainer(Tk_Window tkwin); -#endif -#ifndef TkpMakeMenuWindow_TCL_DECLARED -#define TkpMakeMenuWindow_TCL_DECLARED /* 65 */ EXTERN void TkpMakeMenuWindow(Tk_Window tkwin, int transient); -#endif -#ifndef TkpMakeWindow_TCL_DECLARED -#define TkpMakeWindow_TCL_DECLARED /* 66 */ EXTERN Window TkpMakeWindow(TkWindow *winPtr, Window parent); -#endif -#ifndef TkpMenuNotifyToplevelCreate_TCL_DECLARED -#define TkpMenuNotifyToplevelCreate_TCL_DECLARED /* 67 */ EXTERN void TkpMenuNotifyToplevelCreate(Tcl_Interp *interp, - char *menuName); -#endif -#ifndef TkpOpenDisplay_TCL_DECLARED -#define TkpOpenDisplay_TCL_DECLARED + const char *menuName); /* 68 */ -EXTERN TkDisplay * TkpOpenDisplay(CONST char *display_name); -#endif -#ifndef TkPointerEvent_TCL_DECLARED -#define TkPointerEvent_TCL_DECLARED +EXTERN TkDisplay * TkpOpenDisplay(const char *display_name); /* 69 */ EXTERN int TkPointerEvent(XEvent *eventPtr, TkWindow *winPtr); -#endif -#ifndef TkPolygonToArea_TCL_DECLARED -#define TkPolygonToArea_TCL_DECLARED /* 70 */ EXTERN int TkPolygonToArea(double *polyPtr, int numPoints, double *rectPtr); -#endif -#ifndef TkPolygonToPoint_TCL_DECLARED -#define TkPolygonToPoint_TCL_DECLARED /* 71 */ EXTERN double TkPolygonToPoint(double *polyPtr, int numPoints, double *pointPtr); -#endif -#ifndef TkPositionInTree_TCL_DECLARED -#define TkPositionInTree_TCL_DECLARED /* 72 */ EXTERN int TkPositionInTree(TkWindow *winPtr, TkWindow *treePtr); -#endif -#ifndef TkpRedirectKeyEvent_TCL_DECLARED -#define TkpRedirectKeyEvent_TCL_DECLARED /* 73 */ EXTERN void TkpRedirectKeyEvent(TkWindow *winPtr, XEvent *eventPtr); -#endif -#ifndef TkpSetMainMenubar_TCL_DECLARED -#define TkpSetMainMenubar_TCL_DECLARED /* 74 */ EXTERN void TkpSetMainMenubar(Tcl_Interp *interp, - Tk_Window tkwin, char *menuName); -#endif -#ifndef TkpUseWindow_TCL_DECLARED -#define TkpUseWindow_TCL_DECLARED + Tk_Window tkwin, const char *menuName); /* 75 */ EXTERN int TkpUseWindow(Tcl_Interp *interp, Tk_Window tkwin, - CONST char *string); -#endif -#ifndef TkpWindowWasRecentlyDeleted_TCL_DECLARED -#define TkpWindowWasRecentlyDeleted_TCL_DECLARED -/* 76 */ -EXTERN int TkpWindowWasRecentlyDeleted(Window win, - TkDisplay *dispPtr); -#endif -#ifndef TkQueueEventForAllChildren_TCL_DECLARED -#define TkQueueEventForAllChildren_TCL_DECLARED + const char *string); +/* Slot 76 is reserved */ /* 77 */ EXTERN void TkQueueEventForAllChildren(TkWindow *winPtr, XEvent *eventPtr); -#endif -#ifndef TkReadBitmapFile_TCL_DECLARED -#define TkReadBitmapFile_TCL_DECLARED /* 78 */ EXTERN int TkReadBitmapFile(Display *display, Drawable d, - CONST char *filename, + const char *filename, unsigned int *width_return, unsigned int *height_return, Pixmap *bitmap_return, int *x_hot_return, int *y_hot_return); -#endif -#ifndef TkScrollWindow_TCL_DECLARED -#define TkScrollWindow_TCL_DECLARED /* 79 */ EXTERN int TkScrollWindow(Tk_Window tkwin, GC gc, int x, int y, int width, int height, int dx, int dy, TkRegion damageRgn); -#endif -#ifndef TkSelDeadWindow_TCL_DECLARED -#define TkSelDeadWindow_TCL_DECLARED /* 80 */ EXTERN void TkSelDeadWindow(TkWindow *winPtr); -#endif -#ifndef TkSelEventProc_TCL_DECLARED -#define TkSelEventProc_TCL_DECLARED /* 81 */ EXTERN void TkSelEventProc(Tk_Window tkwin, XEvent *eventPtr); -#endif -#ifndef TkSelInit_TCL_DECLARED -#define TkSelInit_TCL_DECLARED /* 82 */ EXTERN void TkSelInit(Tk_Window tkwin); -#endif -#ifndef TkSelPropProc_TCL_DECLARED -#define TkSelPropProc_TCL_DECLARED /* 83 */ EXTERN void TkSelPropProc(XEvent *eventPtr); -#endif /* Slot 84 is reserved */ -#ifndef TkSetWindowMenuBar_TCL_DECLARED -#define TkSetWindowMenuBar_TCL_DECLARED /* 85 */ EXTERN void TkSetWindowMenuBar(Tcl_Interp *interp, - Tk_Window tkwin, char *oldMenuName, - char *menuName); -#endif -#ifndef TkStringToKeysym_TCL_DECLARED -#define TkStringToKeysym_TCL_DECLARED + Tk_Window tkwin, const char *oldMenuName, + const char *menuName); /* 86 */ -EXTERN KeySym TkStringToKeysym(char *name); -#endif -#ifndef TkThickPolyLineToArea_TCL_DECLARED -#define TkThickPolyLineToArea_TCL_DECLARED +EXTERN KeySym TkStringToKeysym(const char *name); /* 87 */ EXTERN int TkThickPolyLineToArea(double *coordPtr, int numPoints, double width, int capStyle, int joinStyle, double *rectPtr); -#endif -#ifndef TkWmAddToColormapWindows_TCL_DECLARED -#define TkWmAddToColormapWindows_TCL_DECLARED /* 88 */ EXTERN void TkWmAddToColormapWindows(TkWindow *winPtr); -#endif -#ifndef TkWmDeadWindow_TCL_DECLARED -#define TkWmDeadWindow_TCL_DECLARED /* 89 */ EXTERN void TkWmDeadWindow(TkWindow *winPtr); -#endif -#ifndef TkWmFocusToplevel_TCL_DECLARED -#define TkWmFocusToplevel_TCL_DECLARED /* 90 */ EXTERN TkWindow * TkWmFocusToplevel(TkWindow *winPtr); -#endif -#ifndef TkWmMapWindow_TCL_DECLARED -#define TkWmMapWindow_TCL_DECLARED /* 91 */ EXTERN void TkWmMapWindow(TkWindow *winPtr); -#endif -#ifndef TkWmNewWindow_TCL_DECLARED -#define TkWmNewWindow_TCL_DECLARED /* 92 */ EXTERN void TkWmNewWindow(TkWindow *winPtr); -#endif -#ifndef TkWmProtocolEventProc_TCL_DECLARED -#define TkWmProtocolEventProc_TCL_DECLARED /* 93 */ EXTERN void TkWmProtocolEventProc(TkWindow *winPtr, XEvent *evenvPtr); -#endif -#ifndef TkWmRemoveFromColormapWindows_TCL_DECLARED -#define TkWmRemoveFromColormapWindows_TCL_DECLARED /* 94 */ EXTERN void TkWmRemoveFromColormapWindows(TkWindow *winPtr); -#endif -#ifndef TkWmRestackToplevel_TCL_DECLARED -#define TkWmRestackToplevel_TCL_DECLARED /* 95 */ EXTERN void TkWmRestackToplevel(TkWindow *winPtr, int aboveBelow, TkWindow *otherPtr); -#endif -#ifndef TkWmSetClass_TCL_DECLARED -#define TkWmSetClass_TCL_DECLARED /* 96 */ EXTERN void TkWmSetClass(TkWindow *winPtr); -#endif -#ifndef TkWmUnmapWindow_TCL_DECLARED -#define TkWmUnmapWindow_TCL_DECLARED /* 97 */ EXTERN void TkWmUnmapWindow(TkWindow *winPtr); -#endif -#ifndef TkDebugBitmap_TCL_DECLARED -#define TkDebugBitmap_TCL_DECLARED /* 98 */ -EXTERN Tcl_Obj * TkDebugBitmap(Tk_Window tkwin, char *name); -#endif -#ifndef TkDebugBorder_TCL_DECLARED -#define TkDebugBorder_TCL_DECLARED +EXTERN Tcl_Obj * TkDebugBitmap(Tk_Window tkwin, const char *name); /* 99 */ -EXTERN Tcl_Obj * TkDebugBorder(Tk_Window tkwin, char *name); -#endif -#ifndef TkDebugCursor_TCL_DECLARED -#define TkDebugCursor_TCL_DECLARED +EXTERN Tcl_Obj * TkDebugBorder(Tk_Window tkwin, const char *name); /* 100 */ -EXTERN Tcl_Obj * TkDebugCursor(Tk_Window tkwin, char *name); -#endif -#ifndef TkDebugColor_TCL_DECLARED -#define TkDebugColor_TCL_DECLARED +EXTERN Tcl_Obj * TkDebugCursor(Tk_Window tkwin, const char *name); /* 101 */ -EXTERN Tcl_Obj * TkDebugColor(Tk_Window tkwin, char *name); -#endif -#ifndef TkDebugConfig_TCL_DECLARED -#define TkDebugConfig_TCL_DECLARED +EXTERN Tcl_Obj * TkDebugColor(Tk_Window tkwin, const char *name); /* 102 */ EXTERN Tcl_Obj * TkDebugConfig(Tcl_Interp *interp, Tk_OptionTable table); -#endif -#ifndef TkDebugFont_TCL_DECLARED -#define TkDebugFont_TCL_DECLARED /* 103 */ -EXTERN Tcl_Obj * TkDebugFont(Tk_Window tkwin, char *name); -#endif -#ifndef TkFindStateNumObj_TCL_DECLARED -#define TkFindStateNumObj_TCL_DECLARED +EXTERN Tcl_Obj * TkDebugFont(Tk_Window tkwin, const char *name); /* 104 */ EXTERN int TkFindStateNumObj(Tcl_Interp *interp, - Tcl_Obj *optionPtr, CONST TkStateMap *mapPtr, + Tcl_Obj *optionPtr, const TkStateMap *mapPtr, Tcl_Obj *keyPtr); -#endif -#ifndef TkGetBitmapPredefTable_TCL_DECLARED -#define TkGetBitmapPredefTable_TCL_DECLARED /* 105 */ EXTERN Tcl_HashTable * TkGetBitmapPredefTable(void); -#endif -#ifndef TkGetDisplayList_TCL_DECLARED -#define TkGetDisplayList_TCL_DECLARED /* 106 */ EXTERN TkDisplay * TkGetDisplayList(void); -#endif -#ifndef TkGetMainInfoList_TCL_DECLARED -#define TkGetMainInfoList_TCL_DECLARED /* 107 */ EXTERN TkMainInfo * TkGetMainInfoList(void); -#endif -#ifndef TkGetWindowFromObj_TCL_DECLARED -#define TkGetWindowFromObj_TCL_DECLARED /* 108 */ EXTERN int TkGetWindowFromObj(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, Tk_Window *windowPtr); -#endif -#ifndef TkpGetString_TCL_DECLARED -#define TkpGetString_TCL_DECLARED /* 109 */ -EXTERN char * TkpGetString(TkWindow *winPtr, XEvent *eventPtr, +EXTERN CONST86 char * TkpGetString(TkWindow *winPtr, XEvent *eventPtr, Tcl_DString *dsPtr); -#endif -#ifndef TkpGetSubFonts_TCL_DECLARED -#define TkpGetSubFonts_TCL_DECLARED /* 110 */ EXTERN void TkpGetSubFonts(Tcl_Interp *interp, Tk_Font tkfont); -#endif -#ifndef TkpGetSystemDefault_TCL_DECLARED -#define TkpGetSystemDefault_TCL_DECLARED /* 111 */ EXTERN Tcl_Obj * TkpGetSystemDefault(Tk_Window tkwin, - CONST char *dbName, CONST char *className); -#endif -#ifndef TkpMenuThreadInit_TCL_DECLARED -#define TkpMenuThreadInit_TCL_DECLARED + const char *dbName, const char *className); /* 112 */ EXTERN void TkpMenuThreadInit(void); -#endif -#ifndef TkClipBox_TCL_DECLARED -#define TkClipBox_TCL_DECLARED /* 113 */ EXTERN void TkClipBox(TkRegion rgn, XRectangle *rect_return); -#endif -#ifndef TkCreateRegion_TCL_DECLARED -#define TkCreateRegion_TCL_DECLARED /* 114 */ EXTERN TkRegion TkCreateRegion(void); -#endif -#ifndef TkDestroyRegion_TCL_DECLARED -#define TkDestroyRegion_TCL_DECLARED /* 115 */ EXTERN void TkDestroyRegion(TkRegion rgn); -#endif -#ifndef TkIntersectRegion_TCL_DECLARED -#define TkIntersectRegion_TCL_DECLARED /* 116 */ EXTERN void TkIntersectRegion(TkRegion sra, TkRegion srcb, TkRegion dr_return); -#endif -#ifndef TkRectInRegion_TCL_DECLARED -#define TkRectInRegion_TCL_DECLARED /* 117 */ EXTERN int TkRectInRegion(TkRegion rgn, int x, int y, unsigned int width, unsigned int height); -#endif -#ifndef TkSetRegion_TCL_DECLARED -#define TkSetRegion_TCL_DECLARED /* 118 */ EXTERN void TkSetRegion(Display *display, GC gc, TkRegion rgn); -#endif -#ifndef TkUnionRectWithRegion_TCL_DECLARED -#define TkUnionRectWithRegion_TCL_DECLARED /* 119 */ EXTERN void TkUnionRectWithRegion(XRectangle *rect, TkRegion src, TkRegion dr_return); -#endif /* Slot 120 is reserved */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef TkpCreateNativeBitmap_TCL_DECLARED -#define TkpCreateNativeBitmap_TCL_DECLARED /* 121 */ EXTERN Pixmap TkpCreateNativeBitmap(Display *display, - CONST char *source); -#endif + const void *source); #endif /* AQUA */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef TkpDefineNativeBitmaps_TCL_DECLARED -#define TkpDefineNativeBitmaps_TCL_DECLARED /* 122 */ EXTERN void TkpDefineNativeBitmaps(void); -#endif #endif /* AQUA */ /* Slot 123 is reserved */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef TkpGetNativeAppBitmap_TCL_DECLARED -#define TkpGetNativeAppBitmap_TCL_DECLARED /* 124 */ EXTERN Pixmap TkpGetNativeAppBitmap(Display *display, - CONST char *name, int *width, int *height); -#endif + const char *name, int *width, int *height); #endif /* AQUA */ /* Slot 125 is reserved */ /* Slot 126 is reserved */ @@ -743,265 +376,208 @@ EXTERN Pixmap TkpGetNativeAppBitmap(Display *display, /* Slot 132 is reserved */ /* Slot 133 is reserved */ /* Slot 134 is reserved */ -#ifndef TkpDrawHighlightBorder_TCL_DECLARED -#define TkpDrawHighlightBorder_TCL_DECLARED /* 135 */ EXTERN void TkpDrawHighlightBorder(Tk_Window tkwin, GC fgGC, GC bgGC, int highlightWidth, Drawable drawable); -#endif -#ifndef TkSetFocusWin_TCL_DECLARED -#define TkSetFocusWin_TCL_DECLARED /* 136 */ EXTERN void TkSetFocusWin(TkWindow *winPtr, int force); -#endif -#ifndef TkpSetKeycodeAndState_TCL_DECLARED -#define TkpSetKeycodeAndState_TCL_DECLARED /* 137 */ EXTERN void TkpSetKeycodeAndState(Tk_Window tkwin, KeySym keySym, XEvent *eventPtr); -#endif -#ifndef TkpGetKeySym_TCL_DECLARED -#define TkpGetKeySym_TCL_DECLARED /* 138 */ EXTERN KeySym TkpGetKeySym(TkDisplay *dispPtr, XEvent *eventPtr); -#endif -#ifndef TkpInitKeymapInfo_TCL_DECLARED -#define TkpInitKeymapInfo_TCL_DECLARED /* 139 */ EXTERN void TkpInitKeymapInfo(TkDisplay *dispPtr); -#endif -#ifndef TkPhotoGetValidRegion_TCL_DECLARED -#define TkPhotoGetValidRegion_TCL_DECLARED /* 140 */ EXTERN TkRegion TkPhotoGetValidRegion(Tk_PhotoHandle handle); -#endif -#ifndef TkWmStackorderToplevel_TCL_DECLARED -#define TkWmStackorderToplevel_TCL_DECLARED /* 141 */ EXTERN TkWindow ** TkWmStackorderToplevel(TkWindow *parentPtr); -#endif -#ifndef TkFocusFree_TCL_DECLARED -#define TkFocusFree_TCL_DECLARED /* 142 */ EXTERN void TkFocusFree(TkMainInfo *mainPtr); -#endif -#ifndef TkClipCleanup_TCL_DECLARED -#define TkClipCleanup_TCL_DECLARED /* 143 */ EXTERN void TkClipCleanup(TkDisplay *dispPtr); -#endif -#ifndef TkGCCleanup_TCL_DECLARED -#define TkGCCleanup_TCL_DECLARED /* 144 */ EXTERN void TkGCCleanup(TkDisplay *dispPtr); -#endif -#ifndef TkSubtractRegion_TCL_DECLARED -#define TkSubtractRegion_TCL_DECLARED /* 145 */ EXTERN void TkSubtractRegion(TkRegion sra, TkRegion srcb, TkRegion dr_return); -#endif -#ifndef TkStylePkgInit_TCL_DECLARED -#define TkStylePkgInit_TCL_DECLARED /* 146 */ EXTERN void TkStylePkgInit(TkMainInfo *mainPtr); -#endif -#ifndef TkStylePkgFree_TCL_DECLARED -#define TkStylePkgFree_TCL_DECLARED /* 147 */ EXTERN void TkStylePkgFree(TkMainInfo *mainPtr); -#endif -#ifndef TkToplevelWindowForCommand_TCL_DECLARED -#define TkToplevelWindowForCommand_TCL_DECLARED /* 148 */ EXTERN Tk_Window TkToplevelWindowForCommand(Tcl_Interp *interp, - CONST char *cmdName); -#endif -#ifndef TkGetOptionSpec_TCL_DECLARED -#define TkGetOptionSpec_TCL_DECLARED + const char *cmdName); /* 149 */ -EXTERN CONST Tk_OptionSpec * TkGetOptionSpec(CONST char *name, +EXTERN const Tk_OptionSpec * TkGetOptionSpec(const char *name, Tk_OptionTable optionTable); -#endif -#ifndef TkMakeRawCurve_TCL_DECLARED -#define TkMakeRawCurve_TCL_DECLARED /* 150 */ EXTERN int TkMakeRawCurve(Tk_Canvas canvas, double *pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[]); -#endif -#ifndef TkMakeRawCurvePostscript_TCL_DECLARED -#define TkMakeRawCurvePostscript_TCL_DECLARED /* 151 */ EXTERN void TkMakeRawCurvePostscript(Tcl_Interp *interp, Tk_Canvas canvas, double *pointPtr, int numPoints); -#endif -#ifndef TkpDrawFrame_TCL_DECLARED -#define TkpDrawFrame_TCL_DECLARED /* 152 */ EXTERN void TkpDrawFrame(Tk_Window tkwin, Tk_3DBorder border, int highlightWidth, int borderWidth, int relief); -#endif -#ifndef TkCreateThreadExitHandler_TCL_DECLARED -#define TkCreateThreadExitHandler_TCL_DECLARED /* 153 */ EXTERN void TkCreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData); -#endif -#ifndef TkDeleteThreadExitHandler_TCL_DECLARED -#define TkDeleteThreadExitHandler_TCL_DECLARED /* 154 */ EXTERN void TkDeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData); -#endif /* Slot 155 is reserved */ -#ifndef TkpTestembedCmd_TCL_DECLARED -#define TkpTestembedCmd_TCL_DECLARED /* 156 */ EXTERN int TkpTestembedCmd(ClientData clientData, - Tcl_Interp *interp, int argc, - CONST char **argv); -#endif -#ifndef TkpTesttextCmd_TCL_DECLARED -#define TkpTesttextCmd_TCL_DECLARED + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); /* 157 */ EXTERN int TkpTesttextCmd(ClientData dummy, Tcl_Interp *interp, - int argc, CONST char **argv); -#endif -/* Slot 158 is reserved */ -/* Slot 159 is reserved */ -/* Slot 160 is reserved */ -/* Slot 161 is reserved */ -/* Slot 162 is reserved */ -/* Slot 163 is reserved */ -/* Slot 164 is reserved */ -/* Slot 165 is reserved */ -/* Slot 166 is reserved */ -/* Slot 167 is reserved */ -/* Slot 168 is reserved */ -#ifndef TkStateParseProc_TCL_DECLARED -#define TkStateParseProc_TCL_DECLARED + int objc, Tcl_Obj *const objv[]); +/* 158 */ +EXTERN int TkSelGetSelection(Tcl_Interp *interp, + Tk_Window tkwin, Atom selection, Atom target, + Tk_GetSelProc *proc, ClientData clientData); +/* 159 */ +EXTERN int TkTextGetIndex(Tcl_Interp *interp, + struct TkText *textPtr, const char *string, + struct TkTextIndex *indexPtr); +/* 160 */ +EXTERN int TkTextIndexBackBytes(const struct TkText *textPtr, + const struct TkTextIndex *srcPtr, int count, + struct TkTextIndex *dstPtr); +/* 161 */ +EXTERN int TkTextIndexForwBytes(const struct TkText *textPtr, + const struct TkTextIndex *srcPtr, int count, + struct TkTextIndex *dstPtr); +/* 162 */ +EXTERN struct TkTextIndex * TkTextMakeByteIndex(TkTextBTree tree, + const struct TkText *textPtr, int lineIndex, + int byteIndex, struct TkTextIndex *indexPtr); +/* 163 */ +EXTERN int TkTextPrintIndex(const struct TkText *textPtr, + const struct TkTextIndex *indexPtr, + char *string); +/* 164 */ +EXTERN struct TkTextSegment * TkTextSetMark(struct TkText *textPtr, + const char *name, + struct TkTextIndex *indexPtr); +/* 165 */ +EXTERN int TkTextXviewCmd(struct TkText *textPtr, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +/* 166 */ +EXTERN void TkTextChanged(struct TkSharedText *sharedTextPtr, + struct TkText *textPtr, + const struct TkTextIndex *index1Ptr, + const struct TkTextIndex *index2Ptr); +/* 167 */ +EXTERN int TkBTreeNumLines(TkTextBTree tree, + const struct TkText *textPtr); +/* 168 */ +EXTERN void TkTextInsertDisplayProc(struct TkText *textPtr, + struct TkTextDispChunk *chunkPtr, int x, + int y, int height, int baseline, + Display *display, Drawable dst, int screenY); /* 169 */ EXTERN int TkStateParseProc(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *widgRec, int offset); -#endif -#ifndef TkStatePrintProc_TCL_DECLARED -#define TkStatePrintProc_TCL_DECLARED + const char *value, char *widgRec, int offset); /* 170 */ -EXTERN char * TkStatePrintProc(ClientData clientData, +EXTERN CONST86 char * TkStatePrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); -#endif -#ifndef TkCanvasDashParseProc_TCL_DECLARED -#define TkCanvasDashParseProc_TCL_DECLARED /* 171 */ EXTERN int TkCanvasDashParseProc(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *widgRec, int offset); -#endif -#ifndef TkCanvasDashPrintProc_TCL_DECLARED -#define TkCanvasDashPrintProc_TCL_DECLARED + const char *value, char *widgRec, int offset); /* 172 */ -EXTERN char * TkCanvasDashPrintProc(ClientData clientData, +EXTERN CONST86 char * TkCanvasDashPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); -#endif -#ifndef TkOffsetParseProc_TCL_DECLARED -#define TkOffsetParseProc_TCL_DECLARED /* 173 */ EXTERN int TkOffsetParseProc(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *widgRec, int offset); -#endif -#ifndef TkOffsetPrintProc_TCL_DECLARED -#define TkOffsetPrintProc_TCL_DECLARED + const char *value, char *widgRec, int offset); /* 174 */ -EXTERN char * TkOffsetPrintProc(ClientData clientData, +EXTERN CONST86 char * TkOffsetPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); -#endif -#ifndef TkPixelParseProc_TCL_DECLARED -#define TkPixelParseProc_TCL_DECLARED /* 175 */ EXTERN int TkPixelParseProc(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *widgRec, int offset); -#endif -#ifndef TkPixelPrintProc_TCL_DECLARED -#define TkPixelPrintProc_TCL_DECLARED + const char *value, char *widgRec, int offset); /* 176 */ -EXTERN char * TkPixelPrintProc(ClientData clientData, +EXTERN CONST86 char * TkPixelPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); -#endif -#ifndef TkOrientParseProc_TCL_DECLARED -#define TkOrientParseProc_TCL_DECLARED /* 177 */ EXTERN int TkOrientParseProc(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *widgRec, int offset); -#endif -#ifndef TkOrientPrintProc_TCL_DECLARED -#define TkOrientPrintProc_TCL_DECLARED + const char *value, char *widgRec, int offset); /* 178 */ -EXTERN char * TkOrientPrintProc(ClientData clientData, +EXTERN CONST86 char * TkOrientPrintProc(ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); -#endif -#ifndef TkSmoothParseProc_TCL_DECLARED -#define TkSmoothParseProc_TCL_DECLARED /* 179 */ EXTERN int TkSmoothParseProc(ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, - CONST char *value, char *widgRec, int offset); -#endif -#ifndef TkSmoothPrintProc_TCL_DECLARED -#define TkSmoothPrintProc_TCL_DECLARED + const char *value, char *widgRec, int offset); /* 180 */ -EXTERN char * TkSmoothPrintProc(ClientData clientData, +EXTERN CONST86 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 +/* 181 */ +EXTERN void TkDrawAngledTextLayout(Display *display, + Drawable drawable, GC gc, + Tk_TextLayout layout, int x, int y, + double angle, int firstChar, int lastChar); +/* 182 */ +EXTERN void TkUnderlineAngledTextLayout(Display *display, + Drawable drawable, GC gc, + Tk_TextLayout layout, int x, int y, + double angle, int underline); +/* 183 */ +EXTERN int TkIntersectAngledTextLayout(Tk_TextLayout layout, + int x, int y, int width, int height, + double angle); /* 184 */ -EXTERN void TkUnusedStubEntry(void); -#endif +EXTERN void TkDrawAngledChars(Display *display, + Drawable drawable, GC gc, Tk_Font tkfont, + const char *source, int numBytes, double x, + double y, double angle); typedef struct TkIntStubs { int magic; - struct TkIntStubHooks *hooks; + void *hooks; TkWindow * (*tkAllocWindow) (TkDisplay *dispPtr, int screenNum, TkWindow *parentPtr); /* 0 */ void (*tkBezierPoints) (double control[], int numSteps, double *coordPtr); /* 1 */ void (*tkBezierScreenPoints) (Tk_Canvas canvas, double control[], int numSteps, XPoint *xPointPtr); /* 2 */ - void (*tkBindDeadWindow) (TkWindow *winPtr); /* 3 */ + void (*reserved3)(void); void (*tkBindEventProc) (TkWindow *winPtr, XEvent *eventPtr); /* 4 */ void (*tkBindFree) (TkMainInfo *mainPtr); /* 5 */ void (*tkBindInit) (TkMainInfo *mainPtr); /* 6 */ void (*tkChangeEventWindow) (XEvent *eventPtr, TkWindow *winPtr); /* 7 */ int (*tkClipInit) (Tcl_Interp *interp, TkDisplay *dispPtr); /* 8 */ void (*tkComputeAnchor) (Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY, int innerWidth, int innerHeight, int *xPtr, int *yPtr); /* 9 */ - int (*tkCopyAndGlobalEval) (Tcl_Interp *interp, char *script); /* 10 */ - unsigned long (*tkCreateBindingProcedure) (Tcl_Interp *interp, Tk_BindingTable bindingTable, ClientData object, CONST char *eventString, TkBindEvalProc *evalProc, TkBindFreeProc *freeProc, ClientData clientData); /* 11 */ - TkCursor * (*tkCreateCursorFromData) (Tk_Window tkwin, CONST char *source, CONST char *mask, int width, int height, int xHot, int yHot, XColor fg, XColor bg); /* 12 */ - int (*tkCreateFrame) (ClientData clientData, Tcl_Interp *interp, int argc, char **argv, int toplevel, char *appName); /* 13 */ - Tk_Window (*tkCreateMainWindow) (Tcl_Interp *interp, CONST char *screenName, char *baseName); /* 14 */ + void (*reserved10)(void); + void (*reserved11)(void); + TkCursor * (*tkCreateCursorFromData) (Tk_Window tkwin, const char *source, const char *mask, int width, int height, int xHot, int yHot, XColor fg, XColor bg); /* 12 */ + int (*tkCreateFrame) (ClientData clientData, Tcl_Interp *interp, int argc, const char *const *argv, int toplevel, const char *appName); /* 13 */ + Tk_Window (*tkCreateMainWindow) (Tcl_Interp *interp, const char *screenName, const char *baseName); /* 14 */ Time (*tkCurrentTime) (TkDisplay *dispPtr); /* 15 */ void (*tkDeleteAllImages) (TkMainInfo *mainPtr); /* 16 */ void (*tkDoConfigureNotify) (TkWindow *winPtr); /* 17 */ void (*tkDrawInsetFocusHighlight) (Tk_Window tkwin, GC gc, int width, Drawable drawable, int padding); /* 18 */ void (*tkEventDeadWindow) (TkWindow *winPtr); /* 19 */ void (*tkFillPolygon) (Tk_Canvas canvas, double *coordPtr, int numPoints, Display *display, Drawable drawable, GC gc, GC outlineGC); /* 20 */ - int (*tkFindStateNum) (Tcl_Interp *interp, CONST char *option, CONST TkStateMap *mapPtr, CONST char *strKey); /* 21 */ - char * (*tkFindStateString) (CONST TkStateMap *mapPtr, int numKey); /* 22 */ + int (*tkFindStateNum) (Tcl_Interp *interp, const char *option, const TkStateMap *mapPtr, const char *strKey); /* 21 */ + CONST86 char * (*tkFindStateString) (const TkStateMap *mapPtr, int numKey); /* 22 */ void (*tkFocusDeadWindow) (TkWindow *winPtr); /* 23 */ int (*tkFocusFilterEvent) (TkWindow *winPtr, XEvent *eventPtr); /* 24 */ TkWindow * (*tkFocusKeyEvent) (TkWindow *winPtr, XEvent *eventPtr); /* 25 */ @@ -1009,12 +585,12 @@ typedef struct TkIntStubs { void (*tkFontPkgFree) (TkMainInfo *mainPtr); /* 27 */ void (*tkFreeBindingTags) (TkWindow *winPtr); /* 28 */ void (*tkpFreeCursor) (TkCursor *cursorPtr); /* 29 */ - char * (*tkGetBitmapData) (Tcl_Interp *interp, char *string, char *fileName, int *widthPtr, int *heightPtr, int *hotXPtr, int *hotYPtr); /* 30 */ + char * (*tkGetBitmapData) (Tcl_Interp *interp, const char *string, const char *fileName, int *widthPtr, int *heightPtr, int *hotXPtr, int *hotYPtr); /* 30 */ void (*tkGetButtPoints) (double p1[], double p2[], double width, int project, double m1[], double m2[]); /* 31 */ TkCursor * (*tkGetCursorByName) (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid string); /* 32 */ - CONST84_RETURN char * (*tkGetDefaultScreenName) (Tcl_Interp *interp, CONST char *screenName); /* 33 */ + const char * (*tkGetDefaultScreenName) (Tcl_Interp *interp, const char *screenName); /* 33 */ TkDisplay * (*tkGetDisplay) (Display *display); /* 34 */ - int (*tkGetDisplayOf) (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Tk_Window *tkwinPtr); /* 35 */ + int (*tkGetDisplayOf) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tk_Window *tkwinPtr); /* 35 */ TkWindow * (*tkGetFocusWin) (TkWindow *winPtr); /* 36 */ int (*tkGetInterpNames) (Tcl_Interp *interp, Tk_Window tkwin); /* 37 */ int (*tkGetMiterPoints) (double p1[], double p2[], double p3[], double width, double m1[], double m2[]); /* 38 */ @@ -1025,7 +601,7 @@ typedef struct TkIntStubs { void (*tkIncludePoint) (Tk_Item *itemPtr, double *pointPtr); /* 43 */ void (*tkInOutEvents) (XEvent *eventPtr, TkWindow *sourcePtr, TkWindow *destPtr, int leaveType, int enterType, Tcl_QueuePosition position); /* 44 */ void (*tkInstallFrameMenu) (Tk_Window tkwin); /* 45 */ - char * (*tkKeysymToString) (KeySym keysym); /* 46 */ + CONST86 char * (*tkKeysymToString) (KeySym keysym); /* 46 */ int (*tkLineToArea) (double end1Ptr[], double end2Ptr[], double rectPtr[]); /* 47 */ double (*tkLineToPoint) (double end1Ptr[], double end2Ptr[], double pointPtr[]); /* 48 */ int (*tkMakeBezierCurve) (Tk_Canvas canvas, double *pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[]); /* 49 */ @@ -1037,7 +613,7 @@ typedef struct TkIntStubs { int (*tkpChangeFocus) (TkWindow *winPtr, int force); /* 55 */ void (*tkpCloseDisplay) (TkDisplay *dispPtr); /* 56 */ void (*tkpClaimFocus) (TkWindow *topLevelPtr, int force); /* 57 */ - void (*tkpDisplayWarning) (CONST char *msg, CONST char *title); /* 58 */ + void (*tkpDisplayWarning) (const char *msg, const char *title); /* 58 */ void (*tkpGetAppName) (Tcl_Interp *interp, Tcl_DString *name); /* 59 */ TkWindow * (*tkpGetOtherWindow) (TkWindow *winPtr); /* 60 */ TkWindow * (*tkpGetWrapperWindow) (TkWindow *winPtr); /* 61 */ @@ -1046,26 +622,26 @@ typedef struct TkIntStubs { void (*tkpMakeContainer) (Tk_Window tkwin); /* 64 */ void (*tkpMakeMenuWindow) (Tk_Window tkwin, int transient); /* 65 */ Window (*tkpMakeWindow) (TkWindow *winPtr, Window parent); /* 66 */ - void (*tkpMenuNotifyToplevelCreate) (Tcl_Interp *interp, char *menuName); /* 67 */ - TkDisplay * (*tkpOpenDisplay) (CONST char *display_name); /* 68 */ + void (*tkpMenuNotifyToplevelCreate) (Tcl_Interp *interp, const char *menuName); /* 67 */ + TkDisplay * (*tkpOpenDisplay) (const char *display_name); /* 68 */ int (*tkPointerEvent) (XEvent *eventPtr, TkWindow *winPtr); /* 69 */ int (*tkPolygonToArea) (double *polyPtr, int numPoints, double *rectPtr); /* 70 */ double (*tkPolygonToPoint) (double *polyPtr, int numPoints, double *pointPtr); /* 71 */ int (*tkPositionInTree) (TkWindow *winPtr, TkWindow *treePtr); /* 72 */ void (*tkpRedirectKeyEvent) (TkWindow *winPtr, XEvent *eventPtr); /* 73 */ - void (*tkpSetMainMenubar) (Tcl_Interp *interp, Tk_Window tkwin, char *menuName); /* 74 */ - int (*tkpUseWindow) (Tcl_Interp *interp, Tk_Window tkwin, CONST char *string); /* 75 */ - int (*tkpWindowWasRecentlyDeleted) (Window win, TkDisplay *dispPtr); /* 76 */ + void (*tkpSetMainMenubar) (Tcl_Interp *interp, Tk_Window tkwin, const char *menuName); /* 74 */ + int (*tkpUseWindow) (Tcl_Interp *interp, Tk_Window tkwin, const char *string); /* 75 */ + void (*reserved76)(void); void (*tkQueueEventForAllChildren) (TkWindow *winPtr, XEvent *eventPtr); /* 77 */ - int (*tkReadBitmapFile) (Display *display, Drawable d, CONST char *filename, unsigned int *width_return, unsigned int *height_return, Pixmap *bitmap_return, int *x_hot_return, int *y_hot_return); /* 78 */ + int (*tkReadBitmapFile) (Display *display, Drawable d, const char *filename, unsigned int *width_return, unsigned int *height_return, Pixmap *bitmap_return, int *x_hot_return, int *y_hot_return); /* 78 */ int (*tkScrollWindow) (Tk_Window tkwin, GC gc, int x, int y, int width, int height, int dx, int dy, TkRegion damageRgn); /* 79 */ void (*tkSelDeadWindow) (TkWindow *winPtr); /* 80 */ void (*tkSelEventProc) (Tk_Window tkwin, XEvent *eventPtr); /* 81 */ void (*tkSelInit) (Tk_Window tkwin); /* 82 */ void (*tkSelPropProc) (XEvent *eventPtr); /* 83 */ - VOID *reserved84; - void (*tkSetWindowMenuBar) (Tcl_Interp *interp, Tk_Window tkwin, char *oldMenuName, char *menuName); /* 85 */ - KeySym (*tkStringToKeysym) (char *name); /* 86 */ + void (*reserved84)(void); + void (*tkSetWindowMenuBar) (Tcl_Interp *interp, Tk_Window tkwin, const char *oldMenuName, const char *menuName); /* 85 */ + KeySym (*tkStringToKeysym) (const char *name); /* 86 */ int (*tkThickPolyLineToArea) (double *coordPtr, int numPoints, double width, int capStyle, int joinStyle, double *rectPtr); /* 87 */ void (*tkWmAddToColormapWindows) (TkWindow *winPtr); /* 88 */ void (*tkWmDeadWindow) (TkWindow *winPtr); /* 89 */ @@ -1077,20 +653,20 @@ typedef struct TkIntStubs { void (*tkWmRestackToplevel) (TkWindow *winPtr, int aboveBelow, TkWindow *otherPtr); /* 95 */ void (*tkWmSetClass) (TkWindow *winPtr); /* 96 */ void (*tkWmUnmapWindow) (TkWindow *winPtr); /* 97 */ - Tcl_Obj * (*tkDebugBitmap) (Tk_Window tkwin, char *name); /* 98 */ - Tcl_Obj * (*tkDebugBorder) (Tk_Window tkwin, char *name); /* 99 */ - Tcl_Obj * (*tkDebugCursor) (Tk_Window tkwin, char *name); /* 100 */ - Tcl_Obj * (*tkDebugColor) (Tk_Window tkwin, char *name); /* 101 */ + Tcl_Obj * (*tkDebugBitmap) (Tk_Window tkwin, const char *name); /* 98 */ + Tcl_Obj * (*tkDebugBorder) (Tk_Window tkwin, const char *name); /* 99 */ + Tcl_Obj * (*tkDebugCursor) (Tk_Window tkwin, const char *name); /* 100 */ + Tcl_Obj * (*tkDebugColor) (Tk_Window tkwin, const char *name); /* 101 */ Tcl_Obj * (*tkDebugConfig) (Tcl_Interp *interp, Tk_OptionTable table); /* 102 */ - Tcl_Obj * (*tkDebugFont) (Tk_Window tkwin, char *name); /* 103 */ - int (*tkFindStateNumObj) (Tcl_Interp *interp, Tcl_Obj *optionPtr, CONST TkStateMap *mapPtr, Tcl_Obj *keyPtr); /* 104 */ + Tcl_Obj * (*tkDebugFont) (Tk_Window tkwin, const char *name); /* 103 */ + int (*tkFindStateNumObj) (Tcl_Interp *interp, Tcl_Obj *optionPtr, const TkStateMap *mapPtr, Tcl_Obj *keyPtr); /* 104 */ Tcl_HashTable * (*tkGetBitmapPredefTable) (void); /* 105 */ TkDisplay * (*tkGetDisplayList) (void); /* 106 */ TkMainInfo * (*tkGetMainInfoList) (void); /* 107 */ int (*tkGetWindowFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, Tk_Window *windowPtr); /* 108 */ - char * (*tkpGetString) (TkWindow *winPtr, XEvent *eventPtr, Tcl_DString *dsPtr); /* 109 */ + CONST86 char * (*tkpGetString) (TkWindow *winPtr, XEvent *eventPtr, Tcl_DString *dsPtr); /* 109 */ void (*tkpGetSubFonts) (Tcl_Interp *interp, Tk_Font tkfont); /* 110 */ - Tcl_Obj * (*tkpGetSystemDefault) (Tk_Window tkwin, CONST char *dbName, CONST char *className); /* 111 */ + Tcl_Obj * (*tkpGetSystemDefault) (Tk_Window tkwin, const char *dbName, const char *className); /* 111 */ void (*tkpMenuThreadInit) (void); /* 112 */ void (*tkClipBox) (TkRegion rgn, XRectangle *rect_return); /* 113 */ TkRegion (*tkCreateRegion) (void); /* 114 */ @@ -1099,48 +675,48 @@ typedef struct TkIntStubs { int (*tkRectInRegion) (TkRegion rgn, int x, int y, unsigned int width, unsigned int height); /* 117 */ void (*tkSetRegion) (Display *display, GC gc, TkRegion rgn); /* 118 */ void (*tkUnionRectWithRegion) (XRectangle *rect, TkRegion src, TkRegion dr_return); /* 119 */ - VOID *reserved120; -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */ - VOID *reserved121; + void (*reserved120)(void); +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */ + void (*reserved121)(void); #endif /* X11 */ -#if defined(__WIN32__) /* WIN */ - VOID *reserved121; +#if defined(_WIN32) /* WIN */ + void (*reserved121)(void); #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ - VOID *reserved121; /* Dummy entry for stubs table backwards compatibility */ - Pixmap (*tkpCreateNativeBitmap) (Display *display, CONST char *source); /* 121 */ + void (*reserved121)(void); /* Dummy entry for stubs table backwards compatibility */ + Pixmap (*tkpCreateNativeBitmap) (Display *display, const void *source); /* 121 */ #endif /* AQUA */ -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */ - VOID *reserved122; +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */ + void (*reserved122)(void); #endif /* X11 */ -#if defined(__WIN32__) /* WIN */ - VOID *reserved122; +#if defined(_WIN32) /* WIN */ + void (*reserved122)(void); #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ - VOID *reserved122; /* Dummy entry for stubs table backwards compatibility */ + void (*reserved122)(void); /* Dummy entry for stubs table backwards compatibility */ void (*tkpDefineNativeBitmaps) (void); /* 122 */ #endif /* AQUA */ - VOID *reserved123; -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */ - VOID *reserved124; + void (*reserved123)(void); +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */ + void (*reserved124)(void); #endif /* X11 */ -#if defined(__WIN32__) /* WIN */ - VOID *reserved124; +#if defined(_WIN32) /* WIN */ + void (*reserved124)(void); #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ - VOID *reserved124; /* Dummy entry for stubs table backwards compatibility */ - Pixmap (*tkpGetNativeAppBitmap) (Display *display, CONST char *name, int *width, int *height); /* 124 */ + void (*reserved124)(void); /* Dummy entry for stubs table backwards compatibility */ + Pixmap (*tkpGetNativeAppBitmap) (Display *display, const char *name, int *width, int *height); /* 124 */ #endif /* AQUA */ - VOID *reserved125; - VOID *reserved126; - VOID *reserved127; - VOID *reserved128; - VOID *reserved129; - VOID *reserved130; - VOID *reserved131; - VOID *reserved132; - VOID *reserved133; - VOID *reserved134; + void (*reserved125)(void); + void (*reserved126)(void); + void (*reserved127)(void); + void (*reserved128)(void); + void (*reserved129)(void); + void (*reserved130)(void); + void (*reserved131)(void); + void (*reserved132)(void); + void (*reserved133)(void); + void (*reserved134)(void); void (*tkpDrawHighlightBorder) (Tk_Window tkwin, GC fgGC, GC bgGC, int highlightWidth, Drawable drawable); /* 135 */ void (*tkSetFocusWin) (TkWindow *winPtr, int force); /* 136 */ void (*tkpSetKeycodeAndState) (Tk_Window tkwin, KeySym keySym, XEvent *eventPtr); /* 137 */ @@ -1154,553 +730,305 @@ typedef struct TkIntStubs { void (*tkSubtractRegion) (TkRegion sra, TkRegion srcb, TkRegion dr_return); /* 145 */ void (*tkStylePkgInit) (TkMainInfo *mainPtr); /* 146 */ void (*tkStylePkgFree) (TkMainInfo *mainPtr); /* 147 */ - Tk_Window (*tkToplevelWindowForCommand) (Tcl_Interp *interp, CONST char *cmdName); /* 148 */ - CONST Tk_OptionSpec * (*tkGetOptionSpec) (CONST char *name, Tk_OptionTable optionTable); /* 149 */ + Tk_Window (*tkToplevelWindowForCommand) (Tcl_Interp *interp, const char *cmdName); /* 148 */ + const Tk_OptionSpec * (*tkGetOptionSpec) (const char *name, Tk_OptionTable optionTable); /* 149 */ int (*tkMakeRawCurve) (Tk_Canvas canvas, double *pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[]); /* 150 */ void (*tkMakeRawCurvePostscript) (Tcl_Interp *interp, Tk_Canvas canvas, double *pointPtr, int numPoints); /* 151 */ void (*tkpDrawFrame) (Tk_Window tkwin, Tk_3DBorder border, int highlightWidth, int borderWidth, int relief); /* 152 */ void (*tkCreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 153 */ void (*tkDeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 154 */ - VOID *reserved155; - int (*tkpTestembedCmd) (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv); /* 156 */ - int (*tkpTesttextCmd) (ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv); /* 157 */ - VOID *reserved158; - VOID *reserved159; - VOID *reserved160; - VOID *reserved161; - VOID *reserved162; - VOID *reserved163; - VOID *reserved164; - VOID *reserved165; - VOID *reserved166; - VOID *reserved167; - VOID *reserved168; - int (*tkStateParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, CONST char *value, char *widgRec, int offset); /* 169 */ - char * (*tkStatePrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 170 */ - int (*tkCanvasDashParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, CONST char *value, char *widgRec, int offset); /* 171 */ - char * (*tkCanvasDashPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 172 */ - int (*tkOffsetParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, CONST char *value, char *widgRec, int offset); /* 173 */ - char * (*tkOffsetPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 174 */ - int (*tkPixelParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, CONST char *value, char *widgRec, int offset); /* 175 */ - char * (*tkPixelPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 176 */ - int (*tkOrientParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, CONST char *value, char *widgRec, int offset); /* 177 */ - 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 */ + void (*reserved155)(void); + int (*tkpTestembedCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 156 */ + int (*tkpTesttextCmd) (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 157 */ + int (*tkSelGetSelection) (Tcl_Interp *interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc *proc, ClientData clientData); /* 158 */ + int (*tkTextGetIndex) (Tcl_Interp *interp, struct TkText *textPtr, const char *string, struct TkTextIndex *indexPtr); /* 159 */ + int (*tkTextIndexBackBytes) (const struct TkText *textPtr, const struct TkTextIndex *srcPtr, int count, struct TkTextIndex *dstPtr); /* 160 */ + int (*tkTextIndexForwBytes) (const struct TkText *textPtr, const struct TkTextIndex *srcPtr, int count, struct TkTextIndex *dstPtr); /* 161 */ + struct TkTextIndex * (*tkTextMakeByteIndex) (TkTextBTree tree, const struct TkText *textPtr, int lineIndex, int byteIndex, struct TkTextIndex *indexPtr); /* 162 */ + int (*tkTextPrintIndex) (const struct TkText *textPtr, const struct TkTextIndex *indexPtr, char *string); /* 163 */ + struct TkTextSegment * (*tkTextSetMark) (struct TkText *textPtr, const char *name, struct TkTextIndex *indexPtr); /* 164 */ + int (*tkTextXviewCmd) (struct TkText *textPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 165 */ + void (*tkTextChanged) (struct TkSharedText *sharedTextPtr, struct TkText *textPtr, const struct TkTextIndex *index1Ptr, const struct TkTextIndex *index2Ptr); /* 166 */ + int (*tkBTreeNumLines) (TkTextBTree tree, const struct TkText *textPtr); /* 167 */ + void (*tkTextInsertDisplayProc) (struct TkText *textPtr, struct TkTextDispChunk *chunkPtr, int x, int y, int height, int baseline, Display *display, Drawable dst, int screenY); /* 168 */ + int (*tkStateParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 169 */ + CONST86 char * (*tkStatePrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 170 */ + int (*tkCanvasDashParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 171 */ + CONST86 char * (*tkCanvasDashPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 172 */ + int (*tkOffsetParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 173 */ + CONST86 char * (*tkOffsetPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 174 */ + int (*tkPixelParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 175 */ + CONST86 char * (*tkPixelPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 176 */ + int (*tkOrientParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, const char *value, char *widgRec, int offset); /* 177 */ + CONST86 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 */ + CONST86 char * (*tkSmoothPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 180 */ + void (*tkDrawAngledTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, double angle, int firstChar, int lastChar); /* 181 */ + void (*tkUnderlineAngledTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, double angle, int underline); /* 182 */ + int (*tkIntersectAngledTextLayout) (Tk_TextLayout layout, int x, int y, int width, int height, double angle); /* 183 */ + void (*tkDrawAngledChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int numBytes, double x, double y, double angle); /* 184 */ } TkIntStubs; -extern TkIntStubs *tkIntStubsPtr; +extern const TkIntStubs *tkIntStubsPtr; #ifdef __cplusplus } #endif -#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) +#if defined(USE_TK_STUBS) /* * Inline function declarations: */ -#ifndef TkAllocWindow #define TkAllocWindow \ (tkIntStubsPtr->tkAllocWindow) /* 0 */ -#endif -#ifndef TkBezierPoints #define TkBezierPoints \ (tkIntStubsPtr->tkBezierPoints) /* 1 */ -#endif -#ifndef TkBezierScreenPoints #define TkBezierScreenPoints \ (tkIntStubsPtr->tkBezierScreenPoints) /* 2 */ -#endif -#ifndef TkBindDeadWindow -#define TkBindDeadWindow \ - (tkIntStubsPtr->tkBindDeadWindow) /* 3 */ -#endif -#ifndef TkBindEventProc +/* Slot 3 is reserved */ #define TkBindEventProc \ (tkIntStubsPtr->tkBindEventProc) /* 4 */ -#endif -#ifndef TkBindFree #define TkBindFree \ (tkIntStubsPtr->tkBindFree) /* 5 */ -#endif -#ifndef TkBindInit #define TkBindInit \ (tkIntStubsPtr->tkBindInit) /* 6 */ -#endif -#ifndef TkChangeEventWindow #define TkChangeEventWindow \ (tkIntStubsPtr->tkChangeEventWindow) /* 7 */ -#endif -#ifndef TkClipInit #define TkClipInit \ (tkIntStubsPtr->tkClipInit) /* 8 */ -#endif -#ifndef TkComputeAnchor #define TkComputeAnchor \ (tkIntStubsPtr->tkComputeAnchor) /* 9 */ -#endif -#ifndef TkCopyAndGlobalEval -#define TkCopyAndGlobalEval \ - (tkIntStubsPtr->tkCopyAndGlobalEval) /* 10 */ -#endif -#ifndef TkCreateBindingProcedure -#define TkCreateBindingProcedure \ - (tkIntStubsPtr->tkCreateBindingProcedure) /* 11 */ -#endif -#ifndef TkCreateCursorFromData +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ #define TkCreateCursorFromData \ (tkIntStubsPtr->tkCreateCursorFromData) /* 12 */ -#endif -#ifndef TkCreateFrame #define TkCreateFrame \ (tkIntStubsPtr->tkCreateFrame) /* 13 */ -#endif -#ifndef TkCreateMainWindow #define TkCreateMainWindow \ (tkIntStubsPtr->tkCreateMainWindow) /* 14 */ -#endif -#ifndef TkCurrentTime #define TkCurrentTime \ (tkIntStubsPtr->tkCurrentTime) /* 15 */ -#endif -#ifndef TkDeleteAllImages #define TkDeleteAllImages \ (tkIntStubsPtr->tkDeleteAllImages) /* 16 */ -#endif -#ifndef TkDoConfigureNotify #define TkDoConfigureNotify \ (tkIntStubsPtr->tkDoConfigureNotify) /* 17 */ -#endif -#ifndef TkDrawInsetFocusHighlight #define TkDrawInsetFocusHighlight \ (tkIntStubsPtr->tkDrawInsetFocusHighlight) /* 18 */ -#endif -#ifndef TkEventDeadWindow #define TkEventDeadWindow \ (tkIntStubsPtr->tkEventDeadWindow) /* 19 */ -#endif -#ifndef TkFillPolygon #define TkFillPolygon \ (tkIntStubsPtr->tkFillPolygon) /* 20 */ -#endif -#ifndef TkFindStateNum #define TkFindStateNum \ (tkIntStubsPtr->tkFindStateNum) /* 21 */ -#endif -#ifndef TkFindStateString #define TkFindStateString \ (tkIntStubsPtr->tkFindStateString) /* 22 */ -#endif -#ifndef TkFocusDeadWindow #define TkFocusDeadWindow \ (tkIntStubsPtr->tkFocusDeadWindow) /* 23 */ -#endif -#ifndef TkFocusFilterEvent #define TkFocusFilterEvent \ (tkIntStubsPtr->tkFocusFilterEvent) /* 24 */ -#endif -#ifndef TkFocusKeyEvent #define TkFocusKeyEvent \ (tkIntStubsPtr->tkFocusKeyEvent) /* 25 */ -#endif -#ifndef TkFontPkgInit #define TkFontPkgInit \ (tkIntStubsPtr->tkFontPkgInit) /* 26 */ -#endif -#ifndef TkFontPkgFree #define TkFontPkgFree \ (tkIntStubsPtr->tkFontPkgFree) /* 27 */ -#endif -#ifndef TkFreeBindingTags #define TkFreeBindingTags \ (tkIntStubsPtr->tkFreeBindingTags) /* 28 */ -#endif -#ifndef TkpFreeCursor #define TkpFreeCursor \ (tkIntStubsPtr->tkpFreeCursor) /* 29 */ -#endif -#ifndef TkGetBitmapData #define TkGetBitmapData \ (tkIntStubsPtr->tkGetBitmapData) /* 30 */ -#endif -#ifndef TkGetButtPoints #define TkGetButtPoints \ (tkIntStubsPtr->tkGetButtPoints) /* 31 */ -#endif -#ifndef TkGetCursorByName #define TkGetCursorByName \ (tkIntStubsPtr->tkGetCursorByName) /* 32 */ -#endif -#ifndef TkGetDefaultScreenName #define TkGetDefaultScreenName \ (tkIntStubsPtr->tkGetDefaultScreenName) /* 33 */ -#endif -#ifndef TkGetDisplay #define TkGetDisplay \ (tkIntStubsPtr->tkGetDisplay) /* 34 */ -#endif -#ifndef TkGetDisplayOf #define TkGetDisplayOf \ (tkIntStubsPtr->tkGetDisplayOf) /* 35 */ -#endif -#ifndef TkGetFocusWin #define TkGetFocusWin \ (tkIntStubsPtr->tkGetFocusWin) /* 36 */ -#endif -#ifndef TkGetInterpNames #define TkGetInterpNames \ (tkIntStubsPtr->tkGetInterpNames) /* 37 */ -#endif -#ifndef TkGetMiterPoints #define TkGetMiterPoints \ (tkIntStubsPtr->tkGetMiterPoints) /* 38 */ -#endif -#ifndef TkGetPointerCoords #define TkGetPointerCoords \ (tkIntStubsPtr->tkGetPointerCoords) /* 39 */ -#endif -#ifndef TkGetServerInfo #define TkGetServerInfo \ (tkIntStubsPtr->tkGetServerInfo) /* 40 */ -#endif -#ifndef TkGrabDeadWindow #define TkGrabDeadWindow \ (tkIntStubsPtr->tkGrabDeadWindow) /* 41 */ -#endif -#ifndef TkGrabState #define TkGrabState \ (tkIntStubsPtr->tkGrabState) /* 42 */ -#endif -#ifndef TkIncludePoint #define TkIncludePoint \ (tkIntStubsPtr->tkIncludePoint) /* 43 */ -#endif -#ifndef TkInOutEvents #define TkInOutEvents \ (tkIntStubsPtr->tkInOutEvents) /* 44 */ -#endif -#ifndef TkInstallFrameMenu #define TkInstallFrameMenu \ (tkIntStubsPtr->tkInstallFrameMenu) /* 45 */ -#endif -#ifndef TkKeysymToString #define TkKeysymToString \ (tkIntStubsPtr->tkKeysymToString) /* 46 */ -#endif -#ifndef TkLineToArea #define TkLineToArea \ (tkIntStubsPtr->tkLineToArea) /* 47 */ -#endif -#ifndef TkLineToPoint #define TkLineToPoint \ (tkIntStubsPtr->tkLineToPoint) /* 48 */ -#endif -#ifndef TkMakeBezierCurve #define TkMakeBezierCurve \ (tkIntStubsPtr->tkMakeBezierCurve) /* 49 */ -#endif -#ifndef TkMakeBezierPostscript #define TkMakeBezierPostscript \ (tkIntStubsPtr->tkMakeBezierPostscript) /* 50 */ -#endif -#ifndef TkOptionClassChanged #define TkOptionClassChanged \ (tkIntStubsPtr->tkOptionClassChanged) /* 51 */ -#endif -#ifndef TkOptionDeadWindow #define TkOptionDeadWindow \ (tkIntStubsPtr->tkOptionDeadWindow) /* 52 */ -#endif -#ifndef TkOvalToArea #define TkOvalToArea \ (tkIntStubsPtr->tkOvalToArea) /* 53 */ -#endif -#ifndef TkOvalToPoint #define TkOvalToPoint \ (tkIntStubsPtr->tkOvalToPoint) /* 54 */ -#endif -#ifndef TkpChangeFocus #define TkpChangeFocus \ (tkIntStubsPtr->tkpChangeFocus) /* 55 */ -#endif -#ifndef TkpCloseDisplay #define TkpCloseDisplay \ (tkIntStubsPtr->tkpCloseDisplay) /* 56 */ -#endif -#ifndef TkpClaimFocus #define TkpClaimFocus \ (tkIntStubsPtr->tkpClaimFocus) /* 57 */ -#endif -#ifndef TkpDisplayWarning #define TkpDisplayWarning \ (tkIntStubsPtr->tkpDisplayWarning) /* 58 */ -#endif -#ifndef TkpGetAppName #define TkpGetAppName \ (tkIntStubsPtr->tkpGetAppName) /* 59 */ -#endif -#ifndef TkpGetOtherWindow #define TkpGetOtherWindow \ (tkIntStubsPtr->tkpGetOtherWindow) /* 60 */ -#endif -#ifndef TkpGetWrapperWindow #define TkpGetWrapperWindow \ (tkIntStubsPtr->tkpGetWrapperWindow) /* 61 */ -#endif -#ifndef TkpInit #define TkpInit \ (tkIntStubsPtr->tkpInit) /* 62 */ -#endif -#ifndef TkpInitializeMenuBindings #define TkpInitializeMenuBindings \ (tkIntStubsPtr->tkpInitializeMenuBindings) /* 63 */ -#endif -#ifndef TkpMakeContainer #define TkpMakeContainer \ (tkIntStubsPtr->tkpMakeContainer) /* 64 */ -#endif -#ifndef TkpMakeMenuWindow #define TkpMakeMenuWindow \ (tkIntStubsPtr->tkpMakeMenuWindow) /* 65 */ -#endif -#ifndef TkpMakeWindow #define TkpMakeWindow \ (tkIntStubsPtr->tkpMakeWindow) /* 66 */ -#endif -#ifndef TkpMenuNotifyToplevelCreate #define TkpMenuNotifyToplevelCreate \ (tkIntStubsPtr->tkpMenuNotifyToplevelCreate) /* 67 */ -#endif -#ifndef TkpOpenDisplay #define TkpOpenDisplay \ (tkIntStubsPtr->tkpOpenDisplay) /* 68 */ -#endif -#ifndef TkPointerEvent #define TkPointerEvent \ (tkIntStubsPtr->tkPointerEvent) /* 69 */ -#endif -#ifndef TkPolygonToArea #define TkPolygonToArea \ (tkIntStubsPtr->tkPolygonToArea) /* 70 */ -#endif -#ifndef TkPolygonToPoint #define TkPolygonToPoint \ (tkIntStubsPtr->tkPolygonToPoint) /* 71 */ -#endif -#ifndef TkPositionInTree #define TkPositionInTree \ (tkIntStubsPtr->tkPositionInTree) /* 72 */ -#endif -#ifndef TkpRedirectKeyEvent #define TkpRedirectKeyEvent \ (tkIntStubsPtr->tkpRedirectKeyEvent) /* 73 */ -#endif -#ifndef TkpSetMainMenubar #define TkpSetMainMenubar \ (tkIntStubsPtr->tkpSetMainMenubar) /* 74 */ -#endif -#ifndef TkpUseWindow #define TkpUseWindow \ (tkIntStubsPtr->tkpUseWindow) /* 75 */ -#endif -#ifndef TkpWindowWasRecentlyDeleted -#define TkpWindowWasRecentlyDeleted \ - (tkIntStubsPtr->tkpWindowWasRecentlyDeleted) /* 76 */ -#endif -#ifndef TkQueueEventForAllChildren +/* Slot 76 is reserved */ #define TkQueueEventForAllChildren \ (tkIntStubsPtr->tkQueueEventForAllChildren) /* 77 */ -#endif -#ifndef TkReadBitmapFile #define TkReadBitmapFile \ (tkIntStubsPtr->tkReadBitmapFile) /* 78 */ -#endif -#ifndef TkScrollWindow #define TkScrollWindow \ (tkIntStubsPtr->tkScrollWindow) /* 79 */ -#endif -#ifndef TkSelDeadWindow #define TkSelDeadWindow \ (tkIntStubsPtr->tkSelDeadWindow) /* 80 */ -#endif -#ifndef TkSelEventProc #define TkSelEventProc \ (tkIntStubsPtr->tkSelEventProc) /* 81 */ -#endif -#ifndef TkSelInit #define TkSelInit \ (tkIntStubsPtr->tkSelInit) /* 82 */ -#endif -#ifndef TkSelPropProc #define TkSelPropProc \ (tkIntStubsPtr->tkSelPropProc) /* 83 */ -#endif /* Slot 84 is reserved */ -#ifndef TkSetWindowMenuBar #define TkSetWindowMenuBar \ (tkIntStubsPtr->tkSetWindowMenuBar) /* 85 */ -#endif -#ifndef TkStringToKeysym #define TkStringToKeysym \ (tkIntStubsPtr->tkStringToKeysym) /* 86 */ -#endif -#ifndef TkThickPolyLineToArea #define TkThickPolyLineToArea \ (tkIntStubsPtr->tkThickPolyLineToArea) /* 87 */ -#endif -#ifndef TkWmAddToColormapWindows #define TkWmAddToColormapWindows \ (tkIntStubsPtr->tkWmAddToColormapWindows) /* 88 */ -#endif -#ifndef TkWmDeadWindow #define TkWmDeadWindow \ (tkIntStubsPtr->tkWmDeadWindow) /* 89 */ -#endif -#ifndef TkWmFocusToplevel #define TkWmFocusToplevel \ (tkIntStubsPtr->tkWmFocusToplevel) /* 90 */ -#endif -#ifndef TkWmMapWindow #define TkWmMapWindow \ (tkIntStubsPtr->tkWmMapWindow) /* 91 */ -#endif -#ifndef TkWmNewWindow #define TkWmNewWindow \ (tkIntStubsPtr->tkWmNewWindow) /* 92 */ -#endif -#ifndef TkWmProtocolEventProc #define TkWmProtocolEventProc \ (tkIntStubsPtr->tkWmProtocolEventProc) /* 93 */ -#endif -#ifndef TkWmRemoveFromColormapWindows #define TkWmRemoveFromColormapWindows \ (tkIntStubsPtr->tkWmRemoveFromColormapWindows) /* 94 */ -#endif -#ifndef TkWmRestackToplevel #define TkWmRestackToplevel \ (tkIntStubsPtr->tkWmRestackToplevel) /* 95 */ -#endif -#ifndef TkWmSetClass #define TkWmSetClass \ (tkIntStubsPtr->tkWmSetClass) /* 96 */ -#endif -#ifndef TkWmUnmapWindow #define TkWmUnmapWindow \ (tkIntStubsPtr->tkWmUnmapWindow) /* 97 */ -#endif -#ifndef TkDebugBitmap #define TkDebugBitmap \ (tkIntStubsPtr->tkDebugBitmap) /* 98 */ -#endif -#ifndef TkDebugBorder #define TkDebugBorder \ (tkIntStubsPtr->tkDebugBorder) /* 99 */ -#endif -#ifndef TkDebugCursor #define TkDebugCursor \ (tkIntStubsPtr->tkDebugCursor) /* 100 */ -#endif -#ifndef TkDebugColor #define TkDebugColor \ (tkIntStubsPtr->tkDebugColor) /* 101 */ -#endif -#ifndef TkDebugConfig #define TkDebugConfig \ (tkIntStubsPtr->tkDebugConfig) /* 102 */ -#endif -#ifndef TkDebugFont #define TkDebugFont \ (tkIntStubsPtr->tkDebugFont) /* 103 */ -#endif -#ifndef TkFindStateNumObj #define TkFindStateNumObj \ (tkIntStubsPtr->tkFindStateNumObj) /* 104 */ -#endif -#ifndef TkGetBitmapPredefTable #define TkGetBitmapPredefTable \ (tkIntStubsPtr->tkGetBitmapPredefTable) /* 105 */ -#endif -#ifndef TkGetDisplayList #define TkGetDisplayList \ (tkIntStubsPtr->tkGetDisplayList) /* 106 */ -#endif -#ifndef TkGetMainInfoList #define TkGetMainInfoList \ (tkIntStubsPtr->tkGetMainInfoList) /* 107 */ -#endif -#ifndef TkGetWindowFromObj #define TkGetWindowFromObj \ (tkIntStubsPtr->tkGetWindowFromObj) /* 108 */ -#endif -#ifndef TkpGetString #define TkpGetString \ (tkIntStubsPtr->tkpGetString) /* 109 */ -#endif -#ifndef TkpGetSubFonts #define TkpGetSubFonts \ (tkIntStubsPtr->tkpGetSubFonts) /* 110 */ -#endif -#ifndef TkpGetSystemDefault #define TkpGetSystemDefault \ (tkIntStubsPtr->tkpGetSystemDefault) /* 111 */ -#endif -#ifndef TkpMenuThreadInit #define TkpMenuThreadInit \ (tkIntStubsPtr->tkpMenuThreadInit) /* 112 */ -#endif -#ifndef TkClipBox #define TkClipBox \ (tkIntStubsPtr->tkClipBox) /* 113 */ -#endif -#ifndef TkCreateRegion #define TkCreateRegion \ (tkIntStubsPtr->tkCreateRegion) /* 114 */ -#endif -#ifndef TkDestroyRegion #define TkDestroyRegion \ (tkIntStubsPtr->tkDestroyRegion) /* 115 */ -#endif -#ifndef TkIntersectRegion #define TkIntersectRegion \ (tkIntStubsPtr->tkIntersectRegion) /* 116 */ -#endif -#ifndef TkRectInRegion #define TkRectInRegion \ (tkIntStubsPtr->tkRectInRegion) /* 117 */ -#endif -#ifndef TkSetRegion #define TkSetRegion \ (tkIntStubsPtr->tkSetRegion) /* 118 */ -#endif -#ifndef TkUnionRectWithRegion #define TkUnionRectWithRegion \ (tkIntStubsPtr->tkUnionRectWithRegion) /* 119 */ -#endif /* Slot 120 is reserved */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef TkpCreateNativeBitmap #define TkpCreateNativeBitmap \ (tkIntStubsPtr->tkpCreateNativeBitmap) /* 121 */ -#endif #endif /* AQUA */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef TkpDefineNativeBitmaps #define TkpDefineNativeBitmaps \ (tkIntStubsPtr->tkpDefineNativeBitmaps) /* 122 */ -#endif #endif /* AQUA */ /* Slot 123 is reserved */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef TkpGetNativeAppBitmap #define TkpGetNativeAppBitmap \ (tkIntStubsPtr->tkpGetNativeAppBitmap) /* 124 */ -#endif #endif /* AQUA */ /* Slot 125 is reserved */ /* Slot 126 is reserved */ @@ -1712,201 +1040,140 @@ extern TkIntStubs *tkIntStubsPtr; /* Slot 132 is reserved */ /* Slot 133 is reserved */ /* Slot 134 is reserved */ -#ifndef TkpDrawHighlightBorder #define TkpDrawHighlightBorder \ (tkIntStubsPtr->tkpDrawHighlightBorder) /* 135 */ -#endif -#ifndef TkSetFocusWin #define TkSetFocusWin \ (tkIntStubsPtr->tkSetFocusWin) /* 136 */ -#endif -#ifndef TkpSetKeycodeAndState #define TkpSetKeycodeAndState \ (tkIntStubsPtr->tkpSetKeycodeAndState) /* 137 */ -#endif -#ifndef TkpGetKeySym #define TkpGetKeySym \ (tkIntStubsPtr->tkpGetKeySym) /* 138 */ -#endif -#ifndef TkpInitKeymapInfo #define TkpInitKeymapInfo \ (tkIntStubsPtr->tkpInitKeymapInfo) /* 139 */ -#endif -#ifndef TkPhotoGetValidRegion #define TkPhotoGetValidRegion \ (tkIntStubsPtr->tkPhotoGetValidRegion) /* 140 */ -#endif -#ifndef TkWmStackorderToplevel #define TkWmStackorderToplevel \ (tkIntStubsPtr->tkWmStackorderToplevel) /* 141 */ -#endif -#ifndef TkFocusFree #define TkFocusFree \ (tkIntStubsPtr->tkFocusFree) /* 142 */ -#endif -#ifndef TkClipCleanup #define TkClipCleanup \ (tkIntStubsPtr->tkClipCleanup) /* 143 */ -#endif -#ifndef TkGCCleanup #define TkGCCleanup \ (tkIntStubsPtr->tkGCCleanup) /* 144 */ -#endif -#ifndef TkSubtractRegion #define TkSubtractRegion \ (tkIntStubsPtr->tkSubtractRegion) /* 145 */ -#endif -#ifndef TkStylePkgInit #define TkStylePkgInit \ (tkIntStubsPtr->tkStylePkgInit) /* 146 */ -#endif -#ifndef TkStylePkgFree #define TkStylePkgFree \ (tkIntStubsPtr->tkStylePkgFree) /* 147 */ -#endif -#ifndef TkToplevelWindowForCommand #define TkToplevelWindowForCommand \ (tkIntStubsPtr->tkToplevelWindowForCommand) /* 148 */ -#endif -#ifndef TkGetOptionSpec #define TkGetOptionSpec \ (tkIntStubsPtr->tkGetOptionSpec) /* 149 */ -#endif -#ifndef TkMakeRawCurve #define TkMakeRawCurve \ (tkIntStubsPtr->tkMakeRawCurve) /* 150 */ -#endif -#ifndef TkMakeRawCurvePostscript #define TkMakeRawCurvePostscript \ (tkIntStubsPtr->tkMakeRawCurvePostscript) /* 151 */ -#endif -#ifndef TkpDrawFrame #define TkpDrawFrame \ (tkIntStubsPtr->tkpDrawFrame) /* 152 */ -#endif -#ifndef TkCreateThreadExitHandler #define TkCreateThreadExitHandler \ (tkIntStubsPtr->tkCreateThreadExitHandler) /* 153 */ -#endif -#ifndef TkDeleteThreadExitHandler #define TkDeleteThreadExitHandler \ (tkIntStubsPtr->tkDeleteThreadExitHandler) /* 154 */ -#endif /* Slot 155 is reserved */ -#ifndef TkpTestembedCmd #define TkpTestembedCmd \ (tkIntStubsPtr->tkpTestembedCmd) /* 156 */ -#endif -#ifndef TkpTesttextCmd #define TkpTesttextCmd \ (tkIntStubsPtr->tkpTesttextCmd) /* 157 */ -#endif -/* Slot 158 is reserved */ -/* Slot 159 is reserved */ -/* Slot 160 is reserved */ -/* Slot 161 is reserved */ -/* Slot 162 is reserved */ -/* Slot 163 is reserved */ -/* Slot 164 is reserved */ -/* Slot 165 is reserved */ -/* Slot 166 is reserved */ -/* Slot 167 is reserved */ -/* Slot 168 is reserved */ -#ifndef TkStateParseProc +#define TkSelGetSelection \ + (tkIntStubsPtr->tkSelGetSelection) /* 158 */ +#define TkTextGetIndex \ + (tkIntStubsPtr->tkTextGetIndex) /* 159 */ +#define TkTextIndexBackBytes \ + (tkIntStubsPtr->tkTextIndexBackBytes) /* 160 */ +#define TkTextIndexForwBytes \ + (tkIntStubsPtr->tkTextIndexForwBytes) /* 161 */ +#define TkTextMakeByteIndex \ + (tkIntStubsPtr->tkTextMakeByteIndex) /* 162 */ +#define TkTextPrintIndex \ + (tkIntStubsPtr->tkTextPrintIndex) /* 163 */ +#define TkTextSetMark \ + (tkIntStubsPtr->tkTextSetMark) /* 164 */ +#define TkTextXviewCmd \ + (tkIntStubsPtr->tkTextXviewCmd) /* 165 */ +#define TkTextChanged \ + (tkIntStubsPtr->tkTextChanged) /* 166 */ +#define TkBTreeNumLines \ + (tkIntStubsPtr->tkBTreeNumLines) /* 167 */ +#define TkTextInsertDisplayProc \ + (tkIntStubsPtr->tkTextInsertDisplayProc) /* 168 */ #define TkStateParseProc \ (tkIntStubsPtr->tkStateParseProc) /* 169 */ -#endif -#ifndef TkStatePrintProc #define TkStatePrintProc \ (tkIntStubsPtr->tkStatePrintProc) /* 170 */ -#endif -#ifndef TkCanvasDashParseProc #define TkCanvasDashParseProc \ (tkIntStubsPtr->tkCanvasDashParseProc) /* 171 */ -#endif -#ifndef TkCanvasDashPrintProc #define TkCanvasDashPrintProc \ (tkIntStubsPtr->tkCanvasDashPrintProc) /* 172 */ -#endif -#ifndef TkOffsetParseProc #define TkOffsetParseProc \ (tkIntStubsPtr->tkOffsetParseProc) /* 173 */ -#endif -#ifndef TkOffsetPrintProc #define TkOffsetPrintProc \ (tkIntStubsPtr->tkOffsetPrintProc) /* 174 */ -#endif -#ifndef TkPixelParseProc #define TkPixelParseProc \ (tkIntStubsPtr->tkPixelParseProc) /* 175 */ -#endif -#ifndef TkPixelPrintProc #define TkPixelPrintProc \ (tkIntStubsPtr->tkPixelPrintProc) /* 176 */ -#endif -#ifndef TkOrientParseProc #define TkOrientParseProc \ (tkIntStubsPtr->tkOrientParseProc) /* 177 */ -#endif -#ifndef TkOrientPrintProc #define TkOrientPrintProc \ (tkIntStubsPtr->tkOrientPrintProc) /* 178 */ -#endif -#ifndef TkSmoothParseProc #define TkSmoothParseProc \ (tkIntStubsPtr->tkSmoothParseProc) /* 179 */ -#endif -#ifndef TkSmoothPrintProc #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 +#define TkDrawAngledTextLayout \ + (tkIntStubsPtr->tkDrawAngledTextLayout) /* 181 */ +#define TkUnderlineAngledTextLayout \ + (tkIntStubsPtr->tkUnderlineAngledTextLayout) /* 182 */ +#define TkIntersectAngledTextLayout \ + (tkIntStubsPtr->tkIntersectAngledTextLayout) /* 183 */ +#define TkDrawAngledChars \ + (tkIntStubsPtr->tkDrawAngledChars) /* 184 */ -#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ +#endif /* defined(USE_TK_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TK) - /* - * These macros are just wrappers for the equivalent X Region calls. + * On X11, these macros are just wrappers for the equivalent X Region calls. */ -# undef TkClipBox -# undef TkCreateRegion -# undef TkDestroyRegion -# undef TkIntersectRegion -# undef TkRectInRegion -# undef TkSetRegion -# undef TkSubtractRegion -# undef TkUnionRectWithRegion +#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ -# define TkClipBox(rgn, rect) XClipBox((Region) (rgn), (rect)) -# define TkCreateRegion() (TkRegion) XCreateRegion() -# define TkDestroyRegion(rgn) XDestroyRegion((Region) (rgn)) -# define TkIntersectRegion(a, b, r) XIntersectRegion((Region) (a), \ -(Region) (b), (Region) (r)) -# define TkRectInRegion(r, x, y, w, h) XRectInRegion((Region) (r), (x), (y), (w), (h)) -# define TkSetRegion(d, gc, rgn) XSetRegion((d), (gc), (Region) (rgn)) -# define TkSubtractRegion(a, b, r) XSubtractRegion((Region) (a), \ -(Region) (b), (Region) (r)) -# define TkUnionRectWithRegion(rect, src, ret) XUnionRectWithRegion((rect), \ -(Region) (src), (Region) (ret)) -#endif /* !__CYGWIN__*/ +#undef TkClipBox +#undef TkCreateRegion +#undef TkDestroyRegion +#undef TkIntersectRegion +#undef TkRectInRegion +#undef TkSetRegion +#undef TkSubtractRegion +#undef TkUnionRectWithRegion -#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 */ -#endif +#define TkClipBox(rgn, rect) XClipBox((Region) rgn, rect) +#define TkCreateRegion() (TkRegion) XCreateRegion() +#define TkDestroyRegion(rgn) XDestroyRegion((Region) rgn) +#define TkIntersectRegion(a, b, r) XIntersectRegion((Region) a, \ + (Region) b, (Region) r) +#define TkRectInRegion(r, x, y, w, h) XRectInRegion((Region) r, x, y, w, h) +#define TkSetRegion(d, gc, rgn) XSetRegion(d, gc, (Region) rgn) +#define TkSubtractRegion(a, b, r) XSubtractRegion((Region) a, \ + (Region) b, (Region) r) +#define TkUnionRectWithRegion(rect, src, ret) XUnionRectWithRegion(rect, \ + (Region) src, (Region) ret) + +#endif /* UNIX */ #endif /* _TKINTDECLS */ diff --git a/generic/tkIntPlatDecls.h b/generic/tkIntPlatDecls.h index 86127fe..e48e803 100644 --- a/generic/tkIntPlatDecls.h +++ b/generic/tkIntPlatDecls.h @@ -34,602 +34,275 @@ extern "C" { * Exported function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ -#ifndef TkAlignImageData_TCL_DECLARED -#define TkAlignImageData_TCL_DECLARED +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN char * TkAlignImageData(XImage *image, int alignment, int bitOrder); -#endif /* Slot 1 is reserved */ -#ifndef TkGenerateActivateEvents_TCL_DECLARED -#define TkGenerateActivateEvents_TCL_DECLARED /* 2 */ EXTERN void TkGenerateActivateEvents(TkWindow *winPtr, int active); -#endif -#ifndef TkpGetMS_TCL_DECLARED -#define TkpGetMS_TCL_DECLARED /* 3 */ EXTERN unsigned long TkpGetMS(void); -#endif -#ifndef TkPointerDeadWindow_TCL_DECLARED -#define TkPointerDeadWindow_TCL_DECLARED /* 4 */ EXTERN void TkPointerDeadWindow(TkWindow *winPtr); -#endif -#ifndef TkpPrintWindowId_TCL_DECLARED -#define TkpPrintWindowId_TCL_DECLARED /* 5 */ EXTERN void TkpPrintWindowId(char *buf, Window window); -#endif -#ifndef TkpScanWindowId_TCL_DECLARED -#define TkpScanWindowId_TCL_DECLARED /* 6 */ EXTERN int TkpScanWindowId(Tcl_Interp *interp, - CONST char *string, Window *idPtr); -#endif -#ifndef TkpSetCapture_TCL_DECLARED -#define TkpSetCapture_TCL_DECLARED + const char *string, Window *idPtr); /* 7 */ EXTERN void TkpSetCapture(TkWindow *winPtr); -#endif -#ifndef TkpSetCursor_TCL_DECLARED -#define TkpSetCursor_TCL_DECLARED /* 8 */ EXTERN void TkpSetCursor(TkpCursor cursor); -#endif -#ifndef TkpWmSetState_TCL_DECLARED -#define TkpWmSetState_TCL_DECLARED /* 9 */ EXTERN int TkpWmSetState(TkWindow *winPtr, int state); -#endif -#ifndef TkSetPixmapColormap_TCL_DECLARED -#define TkSetPixmapColormap_TCL_DECLARED /* 10 */ EXTERN void TkSetPixmapColormap(Pixmap pixmap, Colormap colormap); -#endif -#ifndef TkWinCancelMouseTimer_TCL_DECLARED -#define TkWinCancelMouseTimer_TCL_DECLARED /* 11 */ EXTERN void TkWinCancelMouseTimer(void); -#endif -#ifndef TkWinClipboardRender_TCL_DECLARED -#define TkWinClipboardRender_TCL_DECLARED /* 12 */ EXTERN void TkWinClipboardRender(TkDisplay *dispPtr, UINT format); -#endif -#ifndef TkWinEmbeddedEventProc_TCL_DECLARED -#define TkWinEmbeddedEventProc_TCL_DECLARED /* 13 */ EXTERN LRESULT TkWinEmbeddedEventProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); -#endif -#ifndef TkWinFillRect_TCL_DECLARED -#define TkWinFillRect_TCL_DECLARED /* 14 */ EXTERN void TkWinFillRect(HDC dc, int x, int y, int width, int height, int pixel); -#endif -#ifndef TkWinGetBorderPixels_TCL_DECLARED -#define TkWinGetBorderPixels_TCL_DECLARED /* 15 */ EXTERN COLORREF TkWinGetBorderPixels(Tk_Window tkwin, Tk_3DBorder border, int which); -#endif -#ifndef TkWinGetDrawableDC_TCL_DECLARED -#define TkWinGetDrawableDC_TCL_DECLARED /* 16 */ EXTERN HDC TkWinGetDrawableDC(Display *display, Drawable d, TkWinDCState *state); -#endif -#ifndef TkWinGetModifierState_TCL_DECLARED -#define TkWinGetModifierState_TCL_DECLARED /* 17 */ EXTERN int TkWinGetModifierState(void); -#endif -#ifndef TkWinGetSystemPalette_TCL_DECLARED -#define TkWinGetSystemPalette_TCL_DECLARED /* 18 */ EXTERN HPALETTE TkWinGetSystemPalette(void); -#endif -#ifndef TkWinGetWrapperWindow_TCL_DECLARED -#define TkWinGetWrapperWindow_TCL_DECLARED /* 19 */ EXTERN HWND TkWinGetWrapperWindow(Tk_Window tkwin); -#endif -#ifndef TkWinHandleMenuEvent_TCL_DECLARED -#define TkWinHandleMenuEvent_TCL_DECLARED /* 20 */ EXTERN int TkWinHandleMenuEvent(HWND *phwnd, UINT *pMessage, WPARAM *pwParam, LPARAM *plParam, LRESULT *plResult); -#endif -#ifndef TkWinIndexOfColor_TCL_DECLARED -#define TkWinIndexOfColor_TCL_DECLARED /* 21 */ EXTERN int TkWinIndexOfColor(XColor *colorPtr); -#endif -#ifndef TkWinReleaseDrawableDC_TCL_DECLARED -#define TkWinReleaseDrawableDC_TCL_DECLARED /* 22 */ EXTERN void TkWinReleaseDrawableDC(Drawable d, HDC hdc, TkWinDCState *state); -#endif -#ifndef TkWinResendEvent_TCL_DECLARED -#define TkWinResendEvent_TCL_DECLARED /* 23 */ EXTERN LRESULT TkWinResendEvent(WNDPROC wndproc, HWND hwnd, XEvent *eventPtr); -#endif -#ifndef TkWinSelectPalette_TCL_DECLARED -#define TkWinSelectPalette_TCL_DECLARED /* 24 */ EXTERN HPALETTE TkWinSelectPalette(HDC dc, Colormap colormap); -#endif -#ifndef TkWinSetMenu_TCL_DECLARED -#define TkWinSetMenu_TCL_DECLARED /* 25 */ EXTERN void TkWinSetMenu(Tk_Window tkwin, HMENU hMenu); -#endif -#ifndef TkWinSetWindowPos_TCL_DECLARED -#define TkWinSetWindowPos_TCL_DECLARED /* 26 */ EXTERN void TkWinSetWindowPos(HWND hwnd, HWND siblingHwnd, int pos); -#endif -#ifndef TkWinWmCleanup_TCL_DECLARED -#define TkWinWmCleanup_TCL_DECLARED /* 27 */ EXTERN void TkWinWmCleanup(HINSTANCE hInstance); -#endif -#ifndef TkWinXCleanup_TCL_DECLARED -#define TkWinXCleanup_TCL_DECLARED /* 28 */ EXTERN void TkWinXCleanup(ClientData clientData); -#endif -#ifndef TkWinXInit_TCL_DECLARED -#define TkWinXInit_TCL_DECLARED /* 29 */ EXTERN void TkWinXInit(HINSTANCE hInstance); -#endif -#ifndef TkWinSetForegroundWindow_TCL_DECLARED -#define TkWinSetForegroundWindow_TCL_DECLARED /* 30 */ EXTERN void TkWinSetForegroundWindow(TkWindow *winPtr); -#endif -#ifndef TkWinDialogDebug_TCL_DECLARED -#define TkWinDialogDebug_TCL_DECLARED /* 31 */ EXTERN void TkWinDialogDebug(int debug); -#endif -#ifndef TkWinGetMenuSystemDefault_TCL_DECLARED -#define TkWinGetMenuSystemDefault_TCL_DECLARED /* 32 */ EXTERN Tcl_Obj * TkWinGetMenuSystemDefault(Tk_Window tkwin, - CONST char *dbName, CONST char *className); -#endif -#ifndef TkWinGetPlatformId_TCL_DECLARED -#define TkWinGetPlatformId_TCL_DECLARED + const char *dbName, const char *className); /* 33 */ EXTERN int TkWinGetPlatformId(void); -#endif -#ifndef TkWinSetHINSTANCE_TCL_DECLARED -#define TkWinSetHINSTANCE_TCL_DECLARED /* 34 */ EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance); -#endif -#ifndef TkWinGetPlatformTheme_TCL_DECLARED -#define TkWinGetPlatformTheme_TCL_DECLARED /* 35 */ EXTERN int TkWinGetPlatformTheme(void); -#endif -#ifndef TkWinChildProc_TCL_DECLARED -#define TkWinChildProc_TCL_DECLARED /* 36 */ EXTERN LRESULT __stdcall TkWinChildProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); -#endif -#ifndef TkCreateXEventSource_TCL_DECLARED -#define TkCreateXEventSource_TCL_DECLARED /* 37 */ EXTERN void TkCreateXEventSource(void); -#endif -#ifndef TkpCmapStressed_TCL_DECLARED -#define TkpCmapStressed_TCL_DECLARED /* 38 */ EXTERN int TkpCmapStressed(Tk_Window tkwin, Colormap colormap); -#endif -#ifndef TkpSync_TCL_DECLARED -#define TkpSync_TCL_DECLARED /* 39 */ EXTERN void TkpSync(Display *display); -#endif -#ifndef TkUnixContainerId_TCL_DECLARED -#define TkUnixContainerId_TCL_DECLARED /* 40 */ EXTERN Window TkUnixContainerId(TkWindow *winPtr); -#endif -#ifndef TkUnixDoOneXEvent_TCL_DECLARED -#define TkUnixDoOneXEvent_TCL_DECLARED /* 41 */ EXTERN int TkUnixDoOneXEvent(Tcl_Time *timePtr); -#endif -#ifndef TkUnixSetMenubar_TCL_DECLARED -#define TkUnixSetMenubar_TCL_DECLARED /* 42 */ EXTERN void TkUnixSetMenubar(Tk_Window tkwin, Tk_Window menubar); -#endif -#ifndef TkWmCleanup_TCL_DECLARED -#define TkWmCleanup_TCL_DECLARED /* 43 */ EXTERN void TkWmCleanup(TkDisplay *dispPtr); -#endif -#ifndef TkSendCleanup_TCL_DECLARED -#define TkSendCleanup_TCL_DECLARED /* 44 */ EXTERN void TkSendCleanup(TkDisplay *dispPtr); -#endif -#ifndef TkpTestsendCmd_TCL_DECLARED -#define TkpTestsendCmd_TCL_DECLARED /* 45 */ EXTERN int TkpTestsendCmd(ClientData clientData, - Tcl_Interp *interp, int argc, - CONST char **argv); -#endif + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef TkGenerateActivateEvents_TCL_DECLARED -#define TkGenerateActivateEvents_TCL_DECLARED /* 0 */ EXTERN void TkGenerateActivateEvents(TkWindow *winPtr, int active); -#endif /* Slot 1 is reserved */ /* Slot 2 is reserved */ -#ifndef TkPointerDeadWindow_TCL_DECLARED -#define TkPointerDeadWindow_TCL_DECLARED /* 3 */ EXTERN void TkPointerDeadWindow(TkWindow *winPtr); -#endif -#ifndef TkpSetCapture_TCL_DECLARED -#define TkpSetCapture_TCL_DECLARED /* 4 */ EXTERN void TkpSetCapture(TkWindow *winPtr); -#endif -#ifndef TkpSetCursor_TCL_DECLARED -#define TkpSetCursor_TCL_DECLARED /* 5 */ EXTERN void TkpSetCursor(TkpCursor cursor); -#endif -#ifndef TkpWmSetState_TCL_DECLARED -#define TkpWmSetState_TCL_DECLARED /* 6 */ EXTERN void TkpWmSetState(TkWindow *winPtr, int state); -#endif -#ifndef TkAboutDlg_TCL_DECLARED -#define TkAboutDlg_TCL_DECLARED /* 7 */ EXTERN void TkAboutDlg(void); -#endif -#ifndef TkMacOSXButtonKeyState_TCL_DECLARED -#define TkMacOSXButtonKeyState_TCL_DECLARED /* 8 */ EXTERN unsigned int TkMacOSXButtonKeyState(void); -#endif -#ifndef TkMacOSXClearMenubarActive_TCL_DECLARED -#define TkMacOSXClearMenubarActive_TCL_DECLARED /* 9 */ EXTERN void TkMacOSXClearMenubarActive(void); -#endif -#ifndef TkMacOSXDispatchMenuEvent_TCL_DECLARED -#define TkMacOSXDispatchMenuEvent_TCL_DECLARED /* 10 */ EXTERN int TkMacOSXDispatchMenuEvent(int menuID, int index); -#endif -#ifndef TkMacOSXInstallCursor_TCL_DECLARED -#define TkMacOSXInstallCursor_TCL_DECLARED /* 11 */ EXTERN void TkMacOSXInstallCursor(int resizeOverride); -#endif -#ifndef TkMacOSXHandleTearoffMenu_TCL_DECLARED -#define TkMacOSXHandleTearoffMenu_TCL_DECLARED /* 12 */ EXTERN void TkMacOSXHandleTearoffMenu(void); -#endif /* Slot 13 is reserved */ -#ifndef TkMacOSXDoHLEvent_TCL_DECLARED -#define TkMacOSXDoHLEvent_TCL_DECLARED /* 14 */ -EXTERN int TkMacOSXDoHLEvent(VOID *theEvent); -#endif +EXTERN int TkMacOSXDoHLEvent(void *theEvent); /* Slot 15 is reserved */ -#ifndef TkMacOSXGetXWindow_TCL_DECLARED -#define TkMacOSXGetXWindow_TCL_DECLARED /* 16 */ -EXTERN Window TkMacOSXGetXWindow(VOID *macWinPtr); -#endif -#ifndef TkMacOSXGrowToplevel_TCL_DECLARED -#define TkMacOSXGrowToplevel_TCL_DECLARED +EXTERN Window TkMacOSXGetXWindow(void *macWinPtr); /* 17 */ -EXTERN int TkMacOSXGrowToplevel(VOID *whichWindow, XPoint start); -#endif -#ifndef TkMacOSXHandleMenuSelect_TCL_DECLARED -#define TkMacOSXHandleMenuSelect_TCL_DECLARED +EXTERN int TkMacOSXGrowToplevel(void *whichWindow, XPoint start); /* 18 */ EXTERN void TkMacOSXHandleMenuSelect(short theMenu, unsigned short theItem, int optionKeyPressed); -#endif /* Slot 19 is reserved */ /* Slot 20 is reserved */ -#ifndef TkMacOSXInvalidateWindow_TCL_DECLARED -#define TkMacOSXInvalidateWindow_TCL_DECLARED /* 21 */ EXTERN void TkMacOSXInvalidateWindow(MacDrawable *macWin, int flag); -#endif -#ifndef TkMacOSXIsCharacterMissing_TCL_DECLARED -#define TkMacOSXIsCharacterMissing_TCL_DECLARED /* 22 */ EXTERN int TkMacOSXIsCharacterMissing(Tk_Font tkfont, unsigned int searchChar); -#endif -#ifndef TkMacOSXMakeRealWindowExist_TCL_DECLARED -#define TkMacOSXMakeRealWindowExist_TCL_DECLARED /* 23 */ EXTERN void TkMacOSXMakeRealWindowExist(TkWindow *winPtr); -#endif -#ifndef TkMacOSXMakeStippleMap_TCL_DECLARED -#define TkMacOSXMakeStippleMap_TCL_DECLARED /* 24 */ -EXTERN VOID * TkMacOSXMakeStippleMap(Drawable d1, Drawable d2); -#endif -#ifndef TkMacOSXMenuClick_TCL_DECLARED -#define TkMacOSXMenuClick_TCL_DECLARED +EXTERN void * TkMacOSXMakeStippleMap(Drawable d1, Drawable d2); /* 25 */ EXTERN void TkMacOSXMenuClick(void); -#endif -#ifndef TkMacOSXRegisterOffScreenWindow_TCL_DECLARED -#define TkMacOSXRegisterOffScreenWindow_TCL_DECLARED /* 26 */ EXTERN void TkMacOSXRegisterOffScreenWindow(Window window, - VOID *portPtr); -#endif -#ifndef TkMacOSXResizable_TCL_DECLARED -#define TkMacOSXResizable_TCL_DECLARED + void *portPtr); /* 27 */ EXTERN int TkMacOSXResizable(TkWindow *winPtr); -#endif -#ifndef TkMacOSXSetHelpMenuItemCount_TCL_DECLARED -#define TkMacOSXSetHelpMenuItemCount_TCL_DECLARED /* 28 */ EXTERN void TkMacOSXSetHelpMenuItemCount(void); -#endif -#ifndef TkMacOSXSetScrollbarGrow_TCL_DECLARED -#define TkMacOSXSetScrollbarGrow_TCL_DECLARED /* 29 */ EXTERN void TkMacOSXSetScrollbarGrow(TkWindow *winPtr, int flag); -#endif -#ifndef TkMacOSXSetUpClippingRgn_TCL_DECLARED -#define TkMacOSXSetUpClippingRgn_TCL_DECLARED /* 30 */ EXTERN void TkMacOSXSetUpClippingRgn(Drawable drawable); -#endif -#ifndef TkMacOSXSetUpGraphicsPort_TCL_DECLARED -#define TkMacOSXSetUpGraphicsPort_TCL_DECLARED /* 31 */ -EXTERN void TkMacOSXSetUpGraphicsPort(GC gc, VOID *destPort); -#endif -#ifndef TkMacOSXUpdateClipRgn_TCL_DECLARED -#define TkMacOSXUpdateClipRgn_TCL_DECLARED +EXTERN void TkMacOSXSetUpGraphicsPort(GC gc, void *destPort); /* 32 */ EXTERN void TkMacOSXUpdateClipRgn(TkWindow *winPtr); -#endif -#ifndef TkMacOSXUnregisterMacWindow_TCL_DECLARED -#define TkMacOSXUnregisterMacWindow_TCL_DECLARED /* 33 */ -EXTERN void TkMacOSXUnregisterMacWindow(VOID *portPtr); -#endif -#ifndef TkMacOSXUseMenuID_TCL_DECLARED -#define TkMacOSXUseMenuID_TCL_DECLARED +EXTERN void TkMacOSXUnregisterMacWindow(void *portPtr); /* 34 */ EXTERN int TkMacOSXUseMenuID(short macID); -#endif -#ifndef TkMacOSXVisableClipRgn_TCL_DECLARED -#define TkMacOSXVisableClipRgn_TCL_DECLARED /* 35 */ EXTERN TkRegion TkMacOSXVisableClipRgn(TkWindow *winPtr); -#endif -#ifndef TkMacOSXWinBounds_TCL_DECLARED -#define TkMacOSXWinBounds_TCL_DECLARED /* 36 */ -EXTERN void TkMacOSXWinBounds(TkWindow *winPtr, VOID *geometry); -#endif -#ifndef TkMacOSXWindowOffset_TCL_DECLARED -#define TkMacOSXWindowOffset_TCL_DECLARED +EXTERN void TkMacOSXWinBounds(TkWindow *winPtr, void *geometry); /* 37 */ -EXTERN void TkMacOSXWindowOffset(VOID *wRef, int *xOffset, +EXTERN void TkMacOSXWindowOffset(void *wRef, int *xOffset, int *yOffset); -#endif -#ifndef TkSetMacColor_TCL_DECLARED -#define TkSetMacColor_TCL_DECLARED /* 38 */ -EXTERN int TkSetMacColor(unsigned long pixel, VOID *macColor); -#endif -#ifndef TkSetWMName_TCL_DECLARED -#define TkSetWMName_TCL_DECLARED +EXTERN int TkSetMacColor(unsigned long pixel, void *macColor); /* 39 */ EXTERN void TkSetWMName(TkWindow *winPtr, Tk_Uid titleUid); -#endif -#ifndef TkSuspendClipboard_TCL_DECLARED -#define TkSuspendClipboard_TCL_DECLARED /* 40 */ EXTERN void TkSuspendClipboard(void); -#endif -#ifndef TkMacOSXZoomToplevel_TCL_DECLARED -#define TkMacOSXZoomToplevel_TCL_DECLARED /* 41 */ -EXTERN int TkMacOSXZoomToplevel(VOID *whichWindow, +EXTERN int TkMacOSXZoomToplevel(void *whichWindow, short zoomPart); -#endif -#ifndef Tk_TopCoordsToWindow_TCL_DECLARED -#define Tk_TopCoordsToWindow_TCL_DECLARED /* 42 */ EXTERN Tk_Window Tk_TopCoordsToWindow(Tk_Window tkwin, int rootX, int rootY, int *newX, int *newY); -#endif -#ifndef TkMacOSXContainerId_TCL_DECLARED -#define TkMacOSXContainerId_TCL_DECLARED /* 43 */ EXTERN MacDrawable * TkMacOSXContainerId(TkWindow *winPtr); -#endif -#ifndef TkMacOSXGetHostToplevel_TCL_DECLARED -#define TkMacOSXGetHostToplevel_TCL_DECLARED /* 44 */ EXTERN MacDrawable * TkMacOSXGetHostToplevel(TkWindow *winPtr); -#endif -#ifndef TkMacOSXPreprocessMenu_TCL_DECLARED -#define TkMacOSXPreprocessMenu_TCL_DECLARED /* 45 */ EXTERN void TkMacOSXPreprocessMenu(void); -#endif -#ifndef TkpIsWindowFloating_TCL_DECLARED -#define TkpIsWindowFloating_TCL_DECLARED /* 46 */ -EXTERN int TkpIsWindowFloating(VOID *window); -#endif -#ifndef TkMacOSXGetCapture_TCL_DECLARED -#define TkMacOSXGetCapture_TCL_DECLARED +EXTERN int TkpIsWindowFloating(void *window); /* 47 */ EXTERN Tk_Window TkMacOSXGetCapture(void); -#endif /* Slot 48 is reserved */ -#ifndef TkGetTransientMaster_TCL_DECLARED -#define TkGetTransientMaster_TCL_DECLARED /* 49 */ EXTERN Window TkGetTransientMaster(TkWindow *winPtr); -#endif -#ifndef TkGenerateButtonEvent_TCL_DECLARED -#define TkGenerateButtonEvent_TCL_DECLARED /* 50 */ EXTERN int TkGenerateButtonEvent(int x, int y, Window window, unsigned int state); -#endif -#ifndef TkGenWMDestroyEvent_TCL_DECLARED -#define TkGenWMDestroyEvent_TCL_DECLARED /* 51 */ EXTERN void TkGenWMDestroyEvent(Tk_Window tkwin); -#endif -#ifndef TkMacOSXSetDrawingEnabled_TCL_DECLARED -#define TkMacOSXSetDrawingEnabled_TCL_DECLARED /* 52 */ EXTERN void TkMacOSXSetDrawingEnabled(TkWindow *winPtr, int flag); -#endif -#ifndef TkpGetMS_TCL_DECLARED -#define TkpGetMS_TCL_DECLARED /* 53 */ EXTERN unsigned long TkpGetMS(void); -#endif -#ifndef TkMacOSXDrawable_TCL_DECLARED -#define TkMacOSXDrawable_TCL_DECLARED /* 54 */ -EXTERN VOID * TkMacOSXDrawable(Drawable drawable); -#endif -#ifndef TkpScanWindowId_TCL_DECLARED -#define TkpScanWindowId_TCL_DECLARED +EXTERN void * TkMacOSXDrawable(Drawable drawable); /* 55 */ EXTERN int TkpScanWindowId(Tcl_Interp *interp, - CONST char *string, Window *idPtr); -#endif + const char *string, Window *idPtr); #endif /* AQUA */ -#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ -#ifndef TkCreateXEventSource_TCL_DECLARED -#define TkCreateXEventSource_TCL_DECLARED +#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ /* 0 */ EXTERN void TkCreateXEventSource(void); -#endif -#ifndef TkFreeWindowId_TCL_DECLARED -#define TkFreeWindowId_TCL_DECLARED -/* 1 */ -EXTERN void TkFreeWindowId(TkDisplay *dispPtr, Window w); -#endif -#ifndef TkInitXId_TCL_DECLARED -#define TkInitXId_TCL_DECLARED -/* 2 */ -EXTERN void TkInitXId(TkDisplay *dispPtr); -#endif -#ifndef TkpCmapStressed_TCL_DECLARED -#define TkpCmapStressed_TCL_DECLARED +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ /* 3 */ EXTERN int TkpCmapStressed(Tk_Window tkwin, Colormap colormap); -#endif -#ifndef TkpSync_TCL_DECLARED -#define TkpSync_TCL_DECLARED /* 4 */ EXTERN void TkpSync(Display *display); -#endif -#ifndef TkUnixContainerId_TCL_DECLARED -#define TkUnixContainerId_TCL_DECLARED /* 5 */ EXTERN Window TkUnixContainerId(TkWindow *winPtr); -#endif -#ifndef TkUnixDoOneXEvent_TCL_DECLARED -#define TkUnixDoOneXEvent_TCL_DECLARED /* 6 */ EXTERN int TkUnixDoOneXEvent(Tcl_Time *timePtr); -#endif -#ifndef TkUnixSetMenubar_TCL_DECLARED -#define TkUnixSetMenubar_TCL_DECLARED /* 7 */ EXTERN void TkUnixSetMenubar(Tk_Window tkwin, Tk_Window menubar); -#endif -#ifndef TkpScanWindowId_TCL_DECLARED -#define TkpScanWindowId_TCL_DECLARED /* 8 */ EXTERN int TkpScanWindowId(Tcl_Interp *interp, - CONST char *string, Window *idPtr); -#endif -#ifndef TkWmCleanup_TCL_DECLARED -#define TkWmCleanup_TCL_DECLARED + const char *string, Window *idPtr); /* 9 */ EXTERN void TkWmCleanup(TkDisplay *dispPtr); -#endif -#ifndef TkSendCleanup_TCL_DECLARED -#define TkSendCleanup_TCL_DECLARED /* 10 */ EXTERN void TkSendCleanup(TkDisplay *dispPtr); -#endif -#ifndef TkFreeXId_TCL_DECLARED -#define TkFreeXId_TCL_DECLARED -/* 11 */ -EXTERN void TkFreeXId(TkDisplay *dispPtr); -#endif -#ifndef TkpWmSetState_TCL_DECLARED -#define TkpWmSetState_TCL_DECLARED +/* Slot 11 is reserved */ /* 12 */ EXTERN int TkpWmSetState(TkWindow *winPtr, int state); -#endif -#ifndef TkpTestsendCmd_TCL_DECLARED -#define TkpTestsendCmd_TCL_DECLARED /* 13 */ EXTERN int TkpTestsendCmd(ClientData clientData, - Tcl_Interp *interp, int argc, - CONST char **argv); -#endif + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); #endif /* X11 */ typedef struct TkIntPlatStubs { int magic; - struct TkIntPlatStubHooks *hooks; + void *hooks; -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ char * (*tkAlignImageData) (XImage *image, int alignment, int bitOrder); /* 0 */ - VOID *reserved1; + void (*reserved1)(void); void (*tkGenerateActivateEvents) (TkWindow *winPtr, int active); /* 2 */ unsigned long (*tkpGetMS) (void); /* 3 */ void (*tkPointerDeadWindow) (TkWindow *winPtr); /* 4 */ void (*tkpPrintWindowId) (char *buf, Window window); /* 5 */ - int (*tkpScanWindowId) (Tcl_Interp *interp, CONST char *string, Window *idPtr); /* 6 */ + int (*tkpScanWindowId) (Tcl_Interp *interp, const char *string, Window *idPtr); /* 6 */ void (*tkpSetCapture) (TkWindow *winPtr); /* 7 */ void (*tkpSetCursor) (TkpCursor cursor); /* 8 */ int (*tkpWmSetState) (TkWindow *winPtr, int state); /* 9 */ @@ -655,7 +328,7 @@ typedef struct TkIntPlatStubs { void (*tkWinXInit) (HINSTANCE hInstance); /* 29 */ void (*tkWinSetForegroundWindow) (TkWindow *winPtr); /* 30 */ void (*tkWinDialogDebug) (int debug); /* 31 */ - Tcl_Obj * (*tkWinGetMenuSystemDefault) (Tk_Window tkwin, CONST char *dbName, CONST char *className); /* 32 */ + Tcl_Obj * (*tkWinGetMenuSystemDefault) (Tk_Window tkwin, const char *dbName, const char *className); /* 32 */ int (*tkWinGetPlatformId) (void); /* 33 */ void (*tkWinSetHINSTANCE) (HINSTANCE hInstance); /* 34 */ int (*tkWinGetPlatformTheme) (void); /* 35 */ @@ -668,12 +341,12 @@ typedef struct TkIntPlatStubs { void (*tkUnixSetMenubar) (Tk_Window tkwin, Tk_Window menubar); /* 42 */ void (*tkWmCleanup) (TkDisplay *dispPtr); /* 43 */ void (*tkSendCleanup) (TkDisplay *dispPtr); /* 44 */ - int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv); /* 45 */ + int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 45 */ #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ void (*tkGenerateActivateEvents) (TkWindow *winPtr, int active); /* 0 */ - VOID *reserved1; - VOID *reserved2; + void (*reserved1)(void); + void (*reserved2)(void); void (*tkPointerDeadWindow) (TkWindow *winPtr); /* 3 */ void (*tkpSetCapture) (TkWindow *winPtr); /* 4 */ void (*tkpSetCursor) (TkpCursor cursor); /* 5 */ @@ -684,545 +357,313 @@ typedef struct TkIntPlatStubs { int (*tkMacOSXDispatchMenuEvent) (int menuID, int index); /* 10 */ void (*tkMacOSXInstallCursor) (int resizeOverride); /* 11 */ void (*tkMacOSXHandleTearoffMenu) (void); /* 12 */ - VOID *reserved13; - int (*tkMacOSXDoHLEvent) (VOID *theEvent); /* 14 */ - VOID *reserved15; - Window (*tkMacOSXGetXWindow) (VOID *macWinPtr); /* 16 */ - int (*tkMacOSXGrowToplevel) (VOID *whichWindow, XPoint start); /* 17 */ + void (*reserved13)(void); + int (*tkMacOSXDoHLEvent) (void *theEvent); /* 14 */ + void (*reserved15)(void); + Window (*tkMacOSXGetXWindow) (void *macWinPtr); /* 16 */ + int (*tkMacOSXGrowToplevel) (void *whichWindow, XPoint start); /* 17 */ void (*tkMacOSXHandleMenuSelect) (short theMenu, unsigned short theItem, int optionKeyPressed); /* 18 */ - VOID *reserved19; - VOID *reserved20; + void (*reserved19)(void); + void (*reserved20)(void); void (*tkMacOSXInvalidateWindow) (MacDrawable *macWin, int flag); /* 21 */ int (*tkMacOSXIsCharacterMissing) (Tk_Font tkfont, unsigned int searchChar); /* 22 */ void (*tkMacOSXMakeRealWindowExist) (TkWindow *winPtr); /* 23 */ - VOID * (*tkMacOSXMakeStippleMap) (Drawable d1, Drawable d2); /* 24 */ + void * (*tkMacOSXMakeStippleMap) (Drawable d1, Drawable d2); /* 24 */ void (*tkMacOSXMenuClick) (void); /* 25 */ - void (*tkMacOSXRegisterOffScreenWindow) (Window window, VOID *portPtr); /* 26 */ + void (*tkMacOSXRegisterOffScreenWindow) (Window window, void *portPtr); /* 26 */ int (*tkMacOSXResizable) (TkWindow *winPtr); /* 27 */ void (*tkMacOSXSetHelpMenuItemCount) (void); /* 28 */ void (*tkMacOSXSetScrollbarGrow) (TkWindow *winPtr, int flag); /* 29 */ void (*tkMacOSXSetUpClippingRgn) (Drawable drawable); /* 30 */ - void (*tkMacOSXSetUpGraphicsPort) (GC gc, VOID *destPort); /* 31 */ + void (*tkMacOSXSetUpGraphicsPort) (GC gc, void *destPort); /* 31 */ void (*tkMacOSXUpdateClipRgn) (TkWindow *winPtr); /* 32 */ - void (*tkMacOSXUnregisterMacWindow) (VOID *portPtr); /* 33 */ + void (*tkMacOSXUnregisterMacWindow) (void *portPtr); /* 33 */ int (*tkMacOSXUseMenuID) (short macID); /* 34 */ TkRegion (*tkMacOSXVisableClipRgn) (TkWindow *winPtr); /* 35 */ - void (*tkMacOSXWinBounds) (TkWindow *winPtr, VOID *geometry); /* 36 */ - void (*tkMacOSXWindowOffset) (VOID *wRef, int *xOffset, int *yOffset); /* 37 */ - int (*tkSetMacColor) (unsigned long pixel, VOID *macColor); /* 38 */ + void (*tkMacOSXWinBounds) (TkWindow *winPtr, void *geometry); /* 36 */ + void (*tkMacOSXWindowOffset) (void *wRef, int *xOffset, int *yOffset); /* 37 */ + int (*tkSetMacColor) (unsigned long pixel, void *macColor); /* 38 */ void (*tkSetWMName) (TkWindow *winPtr, Tk_Uid titleUid); /* 39 */ void (*tkSuspendClipboard) (void); /* 40 */ - int (*tkMacOSXZoomToplevel) (VOID *whichWindow, short zoomPart); /* 41 */ + int (*tkMacOSXZoomToplevel) (void *whichWindow, short zoomPart); /* 41 */ Tk_Window (*tk_TopCoordsToWindow) (Tk_Window tkwin, int rootX, int rootY, int *newX, int *newY); /* 42 */ MacDrawable * (*tkMacOSXContainerId) (TkWindow *winPtr); /* 43 */ MacDrawable * (*tkMacOSXGetHostToplevel) (TkWindow *winPtr); /* 44 */ void (*tkMacOSXPreprocessMenu) (void); /* 45 */ - int (*tkpIsWindowFloating) (VOID *window); /* 46 */ + int (*tkpIsWindowFloating) (void *window); /* 46 */ Tk_Window (*tkMacOSXGetCapture) (void); /* 47 */ - VOID *reserved48; + void (*reserved48)(void); Window (*tkGetTransientMaster) (TkWindow *winPtr); /* 49 */ int (*tkGenerateButtonEvent) (int x, int y, Window window, unsigned int state); /* 50 */ void (*tkGenWMDestroyEvent) (Tk_Window tkwin); /* 51 */ void (*tkMacOSXSetDrawingEnabled) (TkWindow *winPtr, int flag); /* 52 */ unsigned long (*tkpGetMS) (void); /* 53 */ - VOID * (*tkMacOSXDrawable) (Drawable drawable); /* 54 */ - int (*tkpScanWindowId) (Tcl_Interp *interp, CONST char *string, Window *idPtr); /* 55 */ + void * (*tkMacOSXDrawable) (Drawable drawable); /* 54 */ + int (*tkpScanWindowId) (Tcl_Interp *interp, const char *string, Window *idPtr); /* 55 */ #endif /* AQUA */ -#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ +#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ void (*tkCreateXEventSource) (void); /* 0 */ - void (*tkFreeWindowId) (TkDisplay *dispPtr, Window w); /* 1 */ - void (*tkInitXId) (TkDisplay *dispPtr); /* 2 */ + void (*reserved1)(void); + void (*reserved2)(void); int (*tkpCmapStressed) (Tk_Window tkwin, Colormap colormap); /* 3 */ void (*tkpSync) (Display *display); /* 4 */ Window (*tkUnixContainerId) (TkWindow *winPtr); /* 5 */ int (*tkUnixDoOneXEvent) (Tcl_Time *timePtr); /* 6 */ void (*tkUnixSetMenubar) (Tk_Window tkwin, Tk_Window menubar); /* 7 */ - int (*tkpScanWindowId) (Tcl_Interp *interp, CONST char *string, Window *idPtr); /* 8 */ + int (*tkpScanWindowId) (Tcl_Interp *interp, const char *string, Window *idPtr); /* 8 */ void (*tkWmCleanup) (TkDisplay *dispPtr); /* 9 */ void (*tkSendCleanup) (TkDisplay *dispPtr); /* 10 */ - void (*tkFreeXId) (TkDisplay *dispPtr); /* 11 */ + void (*reserved11)(void); int (*tkpWmSetState) (TkWindow *winPtr, int state); /* 12 */ - int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv); /* 13 */ + int (*tkpTestsendCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 13 */ #endif /* X11 */ } TkIntPlatStubs; -extern TkIntPlatStubs *tkIntPlatStubsPtr; +extern const TkIntPlatStubs *tkIntPlatStubsPtr; #ifdef __cplusplus } #endif -#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) +#if defined(USE_TK_STUBS) /* * Inline function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ -#ifndef TkAlignImageData +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define TkAlignImageData \ (tkIntPlatStubsPtr->tkAlignImageData) /* 0 */ -#endif /* Slot 1 is reserved */ -#ifndef TkGenerateActivateEvents #define TkGenerateActivateEvents \ (tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 2 */ -#endif -#ifndef TkpGetMS #define TkpGetMS \ (tkIntPlatStubsPtr->tkpGetMS) /* 3 */ -#endif -#ifndef TkPointerDeadWindow #define TkPointerDeadWindow \ (tkIntPlatStubsPtr->tkPointerDeadWindow) /* 4 */ -#endif -#ifndef TkpPrintWindowId #define TkpPrintWindowId \ (tkIntPlatStubsPtr->tkpPrintWindowId) /* 5 */ -#endif -#ifndef TkpScanWindowId #define TkpScanWindowId \ (tkIntPlatStubsPtr->tkpScanWindowId) /* 6 */ -#endif -#ifndef TkpSetCapture #define TkpSetCapture \ (tkIntPlatStubsPtr->tkpSetCapture) /* 7 */ -#endif -#ifndef TkpSetCursor #define TkpSetCursor \ (tkIntPlatStubsPtr->tkpSetCursor) /* 8 */ -#endif -#ifndef TkpWmSetState #define TkpWmSetState \ (tkIntPlatStubsPtr->tkpWmSetState) /* 9 */ -#endif -#ifndef TkSetPixmapColormap #define TkSetPixmapColormap \ (tkIntPlatStubsPtr->tkSetPixmapColormap) /* 10 */ -#endif -#ifndef TkWinCancelMouseTimer #define TkWinCancelMouseTimer \ (tkIntPlatStubsPtr->tkWinCancelMouseTimer) /* 11 */ -#endif -#ifndef TkWinClipboardRender #define TkWinClipboardRender \ (tkIntPlatStubsPtr->tkWinClipboardRender) /* 12 */ -#endif -#ifndef TkWinEmbeddedEventProc #define TkWinEmbeddedEventProc \ (tkIntPlatStubsPtr->tkWinEmbeddedEventProc) /* 13 */ -#endif -#ifndef TkWinFillRect #define TkWinFillRect \ (tkIntPlatStubsPtr->tkWinFillRect) /* 14 */ -#endif -#ifndef TkWinGetBorderPixels #define TkWinGetBorderPixels \ (tkIntPlatStubsPtr->tkWinGetBorderPixels) /* 15 */ -#endif -#ifndef TkWinGetDrawableDC #define TkWinGetDrawableDC \ (tkIntPlatStubsPtr->tkWinGetDrawableDC) /* 16 */ -#endif -#ifndef TkWinGetModifierState #define TkWinGetModifierState \ (tkIntPlatStubsPtr->tkWinGetModifierState) /* 17 */ -#endif -#ifndef TkWinGetSystemPalette #define TkWinGetSystemPalette \ (tkIntPlatStubsPtr->tkWinGetSystemPalette) /* 18 */ -#endif -#ifndef TkWinGetWrapperWindow #define TkWinGetWrapperWindow \ (tkIntPlatStubsPtr->tkWinGetWrapperWindow) /* 19 */ -#endif -#ifndef TkWinHandleMenuEvent #define TkWinHandleMenuEvent \ (tkIntPlatStubsPtr->tkWinHandleMenuEvent) /* 20 */ -#endif -#ifndef TkWinIndexOfColor #define TkWinIndexOfColor \ (tkIntPlatStubsPtr->tkWinIndexOfColor) /* 21 */ -#endif -#ifndef TkWinReleaseDrawableDC #define TkWinReleaseDrawableDC \ (tkIntPlatStubsPtr->tkWinReleaseDrawableDC) /* 22 */ -#endif -#ifndef TkWinResendEvent #define TkWinResendEvent \ (tkIntPlatStubsPtr->tkWinResendEvent) /* 23 */ -#endif -#ifndef TkWinSelectPalette #define TkWinSelectPalette \ (tkIntPlatStubsPtr->tkWinSelectPalette) /* 24 */ -#endif -#ifndef TkWinSetMenu #define TkWinSetMenu \ (tkIntPlatStubsPtr->tkWinSetMenu) /* 25 */ -#endif -#ifndef TkWinSetWindowPos #define TkWinSetWindowPos \ (tkIntPlatStubsPtr->tkWinSetWindowPos) /* 26 */ -#endif -#ifndef TkWinWmCleanup #define TkWinWmCleanup \ (tkIntPlatStubsPtr->tkWinWmCleanup) /* 27 */ -#endif -#ifndef TkWinXCleanup #define TkWinXCleanup \ (tkIntPlatStubsPtr->tkWinXCleanup) /* 28 */ -#endif -#ifndef TkWinXInit #define TkWinXInit \ (tkIntPlatStubsPtr->tkWinXInit) /* 29 */ -#endif -#ifndef TkWinSetForegroundWindow #define TkWinSetForegroundWindow \ (tkIntPlatStubsPtr->tkWinSetForegroundWindow) /* 30 */ -#endif -#ifndef TkWinDialogDebug #define TkWinDialogDebug \ (tkIntPlatStubsPtr->tkWinDialogDebug) /* 31 */ -#endif -#ifndef TkWinGetMenuSystemDefault #define TkWinGetMenuSystemDefault \ (tkIntPlatStubsPtr->tkWinGetMenuSystemDefault) /* 32 */ -#endif -#ifndef TkWinGetPlatformId #define TkWinGetPlatformId \ (tkIntPlatStubsPtr->tkWinGetPlatformId) /* 33 */ -#endif -#ifndef TkWinSetHINSTANCE #define TkWinSetHINSTANCE \ (tkIntPlatStubsPtr->tkWinSetHINSTANCE) /* 34 */ -#endif -#ifndef TkWinGetPlatformTheme #define TkWinGetPlatformTheme \ (tkIntPlatStubsPtr->tkWinGetPlatformTheme) /* 35 */ -#endif -#ifndef TkWinChildProc #define TkWinChildProc \ (tkIntPlatStubsPtr->tkWinChildProc) /* 36 */ -#endif -#ifndef TkCreateXEventSource #define TkCreateXEventSource \ (tkIntPlatStubsPtr->tkCreateXEventSource) /* 37 */ -#endif -#ifndef TkpCmapStressed #define TkpCmapStressed \ (tkIntPlatStubsPtr->tkpCmapStressed) /* 38 */ -#endif -#ifndef TkpSync #define TkpSync \ (tkIntPlatStubsPtr->tkpSync) /* 39 */ -#endif -#ifndef TkUnixContainerId #define TkUnixContainerId \ (tkIntPlatStubsPtr->tkUnixContainerId) /* 40 */ -#endif -#ifndef TkUnixDoOneXEvent #define TkUnixDoOneXEvent \ (tkIntPlatStubsPtr->tkUnixDoOneXEvent) /* 41 */ -#endif -#ifndef TkUnixSetMenubar #define TkUnixSetMenubar \ (tkIntPlatStubsPtr->tkUnixSetMenubar) /* 42 */ -#endif -#ifndef TkWmCleanup #define TkWmCleanup \ (tkIntPlatStubsPtr->tkWmCleanup) /* 43 */ -#endif -#ifndef TkSendCleanup #define TkSendCleanup \ (tkIntPlatStubsPtr->tkSendCleanup) /* 44 */ -#endif -#ifndef TkpTestsendCmd #define TkpTestsendCmd \ (tkIntPlatStubsPtr->tkpTestsendCmd) /* 45 */ -#endif #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef TkGenerateActivateEvents #define TkGenerateActivateEvents \ (tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 0 */ -#endif /* Slot 1 is reserved */ /* Slot 2 is reserved */ -#ifndef TkPointerDeadWindow #define TkPointerDeadWindow \ (tkIntPlatStubsPtr->tkPointerDeadWindow) /* 3 */ -#endif -#ifndef TkpSetCapture #define TkpSetCapture \ (tkIntPlatStubsPtr->tkpSetCapture) /* 4 */ -#endif -#ifndef TkpSetCursor #define TkpSetCursor \ (tkIntPlatStubsPtr->tkpSetCursor) /* 5 */ -#endif -#ifndef TkpWmSetState #define TkpWmSetState \ (tkIntPlatStubsPtr->tkpWmSetState) /* 6 */ -#endif -#ifndef TkAboutDlg #define TkAboutDlg \ (tkIntPlatStubsPtr->tkAboutDlg) /* 7 */ -#endif -#ifndef TkMacOSXButtonKeyState #define TkMacOSXButtonKeyState \ (tkIntPlatStubsPtr->tkMacOSXButtonKeyState) /* 8 */ -#endif -#ifndef TkMacOSXClearMenubarActive #define TkMacOSXClearMenubarActive \ (tkIntPlatStubsPtr->tkMacOSXClearMenubarActive) /* 9 */ -#endif -#ifndef TkMacOSXDispatchMenuEvent #define TkMacOSXDispatchMenuEvent \ (tkIntPlatStubsPtr->tkMacOSXDispatchMenuEvent) /* 10 */ -#endif -#ifndef TkMacOSXInstallCursor #define TkMacOSXInstallCursor \ (tkIntPlatStubsPtr->tkMacOSXInstallCursor) /* 11 */ -#endif -#ifndef TkMacOSXHandleTearoffMenu #define TkMacOSXHandleTearoffMenu \ (tkIntPlatStubsPtr->tkMacOSXHandleTearoffMenu) /* 12 */ -#endif /* Slot 13 is reserved */ -#ifndef TkMacOSXDoHLEvent #define TkMacOSXDoHLEvent \ (tkIntPlatStubsPtr->tkMacOSXDoHLEvent) /* 14 */ -#endif /* Slot 15 is reserved */ -#ifndef TkMacOSXGetXWindow #define TkMacOSXGetXWindow \ (tkIntPlatStubsPtr->tkMacOSXGetXWindow) /* 16 */ -#endif -#ifndef TkMacOSXGrowToplevel #define TkMacOSXGrowToplevel \ (tkIntPlatStubsPtr->tkMacOSXGrowToplevel) /* 17 */ -#endif -#ifndef TkMacOSXHandleMenuSelect #define TkMacOSXHandleMenuSelect \ (tkIntPlatStubsPtr->tkMacOSXHandleMenuSelect) /* 18 */ -#endif /* Slot 19 is reserved */ /* Slot 20 is reserved */ -#ifndef TkMacOSXInvalidateWindow #define TkMacOSXInvalidateWindow \ (tkIntPlatStubsPtr->tkMacOSXInvalidateWindow) /* 21 */ -#endif -#ifndef TkMacOSXIsCharacterMissing #define TkMacOSXIsCharacterMissing \ (tkIntPlatStubsPtr->tkMacOSXIsCharacterMissing) /* 22 */ -#endif -#ifndef TkMacOSXMakeRealWindowExist #define TkMacOSXMakeRealWindowExist \ (tkIntPlatStubsPtr->tkMacOSXMakeRealWindowExist) /* 23 */ -#endif -#ifndef TkMacOSXMakeStippleMap #define TkMacOSXMakeStippleMap \ (tkIntPlatStubsPtr->tkMacOSXMakeStippleMap) /* 24 */ -#endif -#ifndef TkMacOSXMenuClick #define TkMacOSXMenuClick \ (tkIntPlatStubsPtr->tkMacOSXMenuClick) /* 25 */ -#endif -#ifndef TkMacOSXRegisterOffScreenWindow #define TkMacOSXRegisterOffScreenWindow \ (tkIntPlatStubsPtr->tkMacOSXRegisterOffScreenWindow) /* 26 */ -#endif -#ifndef TkMacOSXResizable #define TkMacOSXResizable \ (tkIntPlatStubsPtr->tkMacOSXResizable) /* 27 */ -#endif -#ifndef TkMacOSXSetHelpMenuItemCount #define TkMacOSXSetHelpMenuItemCount \ (tkIntPlatStubsPtr->tkMacOSXSetHelpMenuItemCount) /* 28 */ -#endif -#ifndef TkMacOSXSetScrollbarGrow #define TkMacOSXSetScrollbarGrow \ (tkIntPlatStubsPtr->tkMacOSXSetScrollbarGrow) /* 29 */ -#endif -#ifndef TkMacOSXSetUpClippingRgn #define TkMacOSXSetUpClippingRgn \ (tkIntPlatStubsPtr->tkMacOSXSetUpClippingRgn) /* 30 */ -#endif -#ifndef TkMacOSXSetUpGraphicsPort #define TkMacOSXSetUpGraphicsPort \ (tkIntPlatStubsPtr->tkMacOSXSetUpGraphicsPort) /* 31 */ -#endif -#ifndef TkMacOSXUpdateClipRgn #define TkMacOSXUpdateClipRgn \ (tkIntPlatStubsPtr->tkMacOSXUpdateClipRgn) /* 32 */ -#endif -#ifndef TkMacOSXUnregisterMacWindow #define TkMacOSXUnregisterMacWindow \ (tkIntPlatStubsPtr->tkMacOSXUnregisterMacWindow) /* 33 */ -#endif -#ifndef TkMacOSXUseMenuID #define TkMacOSXUseMenuID \ (tkIntPlatStubsPtr->tkMacOSXUseMenuID) /* 34 */ -#endif -#ifndef TkMacOSXVisableClipRgn #define TkMacOSXVisableClipRgn \ (tkIntPlatStubsPtr->tkMacOSXVisableClipRgn) /* 35 */ -#endif -#ifndef TkMacOSXWinBounds #define TkMacOSXWinBounds \ (tkIntPlatStubsPtr->tkMacOSXWinBounds) /* 36 */ -#endif -#ifndef TkMacOSXWindowOffset #define TkMacOSXWindowOffset \ (tkIntPlatStubsPtr->tkMacOSXWindowOffset) /* 37 */ -#endif -#ifndef TkSetMacColor #define TkSetMacColor \ (tkIntPlatStubsPtr->tkSetMacColor) /* 38 */ -#endif -#ifndef TkSetWMName #define TkSetWMName \ (tkIntPlatStubsPtr->tkSetWMName) /* 39 */ -#endif -#ifndef TkSuspendClipboard #define TkSuspendClipboard \ (tkIntPlatStubsPtr->tkSuspendClipboard) /* 40 */ -#endif -#ifndef TkMacOSXZoomToplevel #define TkMacOSXZoomToplevel \ (tkIntPlatStubsPtr->tkMacOSXZoomToplevel) /* 41 */ -#endif -#ifndef Tk_TopCoordsToWindow #define Tk_TopCoordsToWindow \ (tkIntPlatStubsPtr->tk_TopCoordsToWindow) /* 42 */ -#endif -#ifndef TkMacOSXContainerId #define TkMacOSXContainerId \ (tkIntPlatStubsPtr->tkMacOSXContainerId) /* 43 */ -#endif -#ifndef TkMacOSXGetHostToplevel #define TkMacOSXGetHostToplevel \ (tkIntPlatStubsPtr->tkMacOSXGetHostToplevel) /* 44 */ -#endif -#ifndef TkMacOSXPreprocessMenu #define TkMacOSXPreprocessMenu \ (tkIntPlatStubsPtr->tkMacOSXPreprocessMenu) /* 45 */ -#endif -#ifndef TkpIsWindowFloating #define TkpIsWindowFloating \ (tkIntPlatStubsPtr->tkpIsWindowFloating) /* 46 */ -#endif -#ifndef TkMacOSXGetCapture #define TkMacOSXGetCapture \ (tkIntPlatStubsPtr->tkMacOSXGetCapture) /* 47 */ -#endif /* Slot 48 is reserved */ -#ifndef TkGetTransientMaster #define TkGetTransientMaster \ (tkIntPlatStubsPtr->tkGetTransientMaster) /* 49 */ -#endif -#ifndef TkGenerateButtonEvent #define TkGenerateButtonEvent \ (tkIntPlatStubsPtr->tkGenerateButtonEvent) /* 50 */ -#endif -#ifndef TkGenWMDestroyEvent #define TkGenWMDestroyEvent \ (tkIntPlatStubsPtr->tkGenWMDestroyEvent) /* 51 */ -#endif -#ifndef TkMacOSXSetDrawingEnabled #define TkMacOSXSetDrawingEnabled \ (tkIntPlatStubsPtr->tkMacOSXSetDrawingEnabled) /* 52 */ -#endif -#ifndef TkpGetMS #define TkpGetMS \ (tkIntPlatStubsPtr->tkpGetMS) /* 53 */ -#endif -#ifndef TkMacOSXDrawable #define TkMacOSXDrawable \ (tkIntPlatStubsPtr->tkMacOSXDrawable) /* 54 */ -#endif -#ifndef TkpScanWindowId #define TkpScanWindowId \ (tkIntPlatStubsPtr->tkpScanWindowId) /* 55 */ -#endif #endif /* AQUA */ -#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ -#ifndef TkCreateXEventSource +#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ #define TkCreateXEventSource \ (tkIntPlatStubsPtr->tkCreateXEventSource) /* 0 */ -#endif -#ifndef TkFreeWindowId -#define TkFreeWindowId \ - (tkIntPlatStubsPtr->tkFreeWindowId) /* 1 */ -#endif -#ifndef TkInitXId -#define TkInitXId \ - (tkIntPlatStubsPtr->tkInitXId) /* 2 */ -#endif -#ifndef TkpCmapStressed +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ #define TkpCmapStressed \ (tkIntPlatStubsPtr->tkpCmapStressed) /* 3 */ -#endif -#ifndef TkpSync #define TkpSync \ (tkIntPlatStubsPtr->tkpSync) /* 4 */ -#endif -#ifndef TkUnixContainerId #define TkUnixContainerId \ (tkIntPlatStubsPtr->tkUnixContainerId) /* 5 */ -#endif -#ifndef TkUnixDoOneXEvent #define TkUnixDoOneXEvent \ (tkIntPlatStubsPtr->tkUnixDoOneXEvent) /* 6 */ -#endif -#ifndef TkUnixSetMenubar #define TkUnixSetMenubar \ (tkIntPlatStubsPtr->tkUnixSetMenubar) /* 7 */ -#endif -#ifndef TkpScanWindowId #define TkpScanWindowId \ (tkIntPlatStubsPtr->tkpScanWindowId) /* 8 */ -#endif -#ifndef TkWmCleanup #define TkWmCleanup \ (tkIntPlatStubsPtr->tkWmCleanup) /* 9 */ -#endif -#ifndef TkSendCleanup #define TkSendCleanup \ (tkIntPlatStubsPtr->tkSendCleanup) /* 10 */ -#endif -#ifndef TkFreeXId -#define TkFreeXId \ - (tkIntPlatStubsPtr->tkFreeXId) /* 11 */ -#endif -#ifndef TkpWmSetState +/* Slot 11 is reserved */ #define TkpWmSetState \ (tkIntPlatStubsPtr->tkpWmSetState) /* 12 */ -#endif -#ifndef TkpTestsendCmd #define TkpTestsendCmd \ (tkIntPlatStubsPtr->tkpTestsendCmd) /* 13 */ -#endif #endif /* X11 */ -#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ +#endif /* defined(USE_TK_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#ifdef __CYGWIN__ - void TkFreeXId(TkDisplay *dispPtr); - void TkFreeWindowId(TkDisplay *dispPtr, Window w); - void TkInitXId(TkDisplay *dispPtr); -#endif - -#ifdef __WIN32__ -#undef TkpCmapStressed -#undef TkpSync -#define TkpCmapStressed(tkwin,colormap) (0) -#define TkpSync(display) -#endif - #endif /* _TKINTPLATDECLS */ diff --git a/generic/tkIntXlibDecls.h b/generic/tkIntXlibDecls.h index b978561..6ac7ccb 100644 --- a/generic/tkIntXlibDecls.h +++ b/generic/tkIntXlibDecls.h @@ -19,12 +19,12 @@ * in the generic/tkInt.decls script. */ -#ifdef MAC_TCL -#include "Xutil.h" -#else -#include "X11/Xutil.h" +#ifndef _TCL +# include <tcl.h> #endif +#include "X11/Xutil.h" + #ifdef BUILD_tk #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT @@ -44,1207 +44,589 @@ extern "C" { * Exported function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ -#ifndef XSetDashes_TCL_DECLARED -#define XSetDashes_TCL_DECLARED +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN int XSetDashes(Display *display, GC gc, int dash_offset, _Xconst char *dash_list, int n); -#endif -#ifndef XGetModifierMapping_TCL_DECLARED -#define XGetModifierMapping_TCL_DECLARED /* 1 */ EXTERN XModifierKeymap * XGetModifierMapping(Display *d); -#endif -#ifndef XCreateImage_TCL_DECLARED -#define XCreateImage_TCL_DECLARED /* 2 */ EXTERN XImage * XCreateImage(Display *d, Visual *v, unsigned int ui1, int i1, int i2, char *cp, unsigned int ui2, unsigned int ui3, int i3, int i4); -#endif -#ifndef XGetImage_TCL_DECLARED -#define XGetImage_TCL_DECLARED /* 3 */ EXTERN XImage * XGetImage(Display *d, Drawable dr, int i1, int i2, unsigned int ui1, unsigned int ui2, unsigned long ul, int i3); -#endif -#ifndef XGetAtomName_TCL_DECLARED -#define XGetAtomName_TCL_DECLARED /* 4 */ EXTERN char * XGetAtomName(Display *d, Atom a); -#endif -#ifndef XKeysymToString_TCL_DECLARED -#define XKeysymToString_TCL_DECLARED /* 5 */ EXTERN char * XKeysymToString(KeySym k); -#endif -#ifndef XCreateColormap_TCL_DECLARED -#define XCreateColormap_TCL_DECLARED /* 6 */ EXTERN Colormap XCreateColormap(Display *d, Window w, Visual *v, int i); -#endif -#ifndef XCreatePixmapCursor_TCL_DECLARED -#define XCreatePixmapCursor_TCL_DECLARED /* 7 */ EXTERN Cursor XCreatePixmapCursor(Display *d, Pixmap p1, Pixmap p2, XColor *x1, XColor *x2, unsigned int ui1, unsigned int ui2); -#endif -#ifndef XCreateGlyphCursor_TCL_DECLARED -#define XCreateGlyphCursor_TCL_DECLARED /* 8 */ EXTERN Cursor XCreateGlyphCursor(Display *d, Font f1, Font f2, unsigned int ui1, unsigned int ui2, XColor _Xconst *x1, XColor _Xconst *x2); -#endif -#ifndef XGContextFromGC_TCL_DECLARED -#define XGContextFromGC_TCL_DECLARED /* 9 */ EXTERN GContext XGContextFromGC(GC g); -#endif -#ifndef XListHosts_TCL_DECLARED -#define XListHosts_TCL_DECLARED /* 10 */ EXTERN XHostAddress * XListHosts(Display *d, int *i, Bool *b); -#endif -#ifndef XKeycodeToKeysym_TCL_DECLARED -#define XKeycodeToKeysym_TCL_DECLARED /* 11 */ EXTERN KeySym XKeycodeToKeysym(Display *d, unsigned int k, int i); -#endif -#ifndef XStringToKeysym_TCL_DECLARED -#define XStringToKeysym_TCL_DECLARED /* 12 */ EXTERN KeySym XStringToKeysym(_Xconst char *c); -#endif -#ifndef XRootWindow_TCL_DECLARED -#define XRootWindow_TCL_DECLARED /* 13 */ EXTERN Window XRootWindow(Display *d, int i); -#endif -#ifndef XSetErrorHandler_TCL_DECLARED -#define XSetErrorHandler_TCL_DECLARED /* 14 */ EXTERN XErrorHandler XSetErrorHandler(XErrorHandler x); -#endif -#ifndef XIconifyWindow_TCL_DECLARED -#define XIconifyWindow_TCL_DECLARED /* 15 */ EXTERN Status XIconifyWindow(Display *d, Window w, int i); -#endif -#ifndef XWithdrawWindow_TCL_DECLARED -#define XWithdrawWindow_TCL_DECLARED /* 16 */ EXTERN Status XWithdrawWindow(Display *d, Window w, int i); -#endif -#ifndef XGetWMColormapWindows_TCL_DECLARED -#define XGetWMColormapWindows_TCL_DECLARED /* 17 */ EXTERN Status XGetWMColormapWindows(Display *d, Window w, Window **wpp, int *ip); -#endif -#ifndef XAllocColor_TCL_DECLARED -#define XAllocColor_TCL_DECLARED /* 18 */ EXTERN Status XAllocColor(Display *d, Colormap c, XColor *xp); -#endif -#ifndef XBell_TCL_DECLARED -#define XBell_TCL_DECLARED /* 19 */ EXTERN int XBell(Display *d, int i); -#endif -#ifndef XChangeProperty_TCL_DECLARED -#define XChangeProperty_TCL_DECLARED /* 20 */ EXTERN int XChangeProperty(Display *d, Window w, Atom a1, Atom a2, int i1, int i2, _Xconst unsigned char *c, int i3); -#endif -#ifndef XChangeWindowAttributes_TCL_DECLARED -#define XChangeWindowAttributes_TCL_DECLARED /* 21 */ EXTERN int XChangeWindowAttributes(Display *d, Window w, unsigned long ul, XSetWindowAttributes *x); -#endif -#ifndef XClearWindow_TCL_DECLARED -#define XClearWindow_TCL_DECLARED /* 22 */ EXTERN int XClearWindow(Display *d, Window w); -#endif -#ifndef XConfigureWindow_TCL_DECLARED -#define XConfigureWindow_TCL_DECLARED /* 23 */ EXTERN int XConfigureWindow(Display *d, Window w, unsigned int i, XWindowChanges *x); -#endif -#ifndef XCopyArea_TCL_DECLARED -#define XCopyArea_TCL_DECLARED /* 24 */ EXTERN int XCopyArea(Display *d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); -#endif -#ifndef XCopyPlane_TCL_DECLARED -#define XCopyPlane_TCL_DECLARED /* 25 */ EXTERN int XCopyPlane(Display *d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4, unsigned long ul); -#endif -#ifndef XCreateBitmapFromData_TCL_DECLARED -#define XCreateBitmapFromData_TCL_DECLARED /* 26 */ EXTERN Pixmap XCreateBitmapFromData(Display *display, Drawable d, _Xconst char *data, unsigned int width, unsigned int height); -#endif -#ifndef XDefineCursor_TCL_DECLARED -#define XDefineCursor_TCL_DECLARED /* 27 */ EXTERN int XDefineCursor(Display *d, Window w, Cursor c); -#endif -#ifndef XDeleteProperty_TCL_DECLARED -#define XDeleteProperty_TCL_DECLARED /* 28 */ EXTERN int XDeleteProperty(Display *d, Window w, Atom a); -#endif -#ifndef XDestroyWindow_TCL_DECLARED -#define XDestroyWindow_TCL_DECLARED /* 29 */ EXTERN int XDestroyWindow(Display *d, Window w); -#endif -#ifndef XDrawArc_TCL_DECLARED -#define XDrawArc_TCL_DECLARED /* 30 */ EXTERN int XDrawArc(Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); -#endif -#ifndef XDrawLines_TCL_DECLARED -#define XDrawLines_TCL_DECLARED /* 31 */ EXTERN int XDrawLines(Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2); -#endif -#ifndef XDrawRectangle_TCL_DECLARED -#define XDrawRectangle_TCL_DECLARED /* 32 */ EXTERN int XDrawRectangle(Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2); -#endif -#ifndef XFillArc_TCL_DECLARED -#define XFillArc_TCL_DECLARED /* 33 */ EXTERN int XFillArc(Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); -#endif -#ifndef XFillPolygon_TCL_DECLARED -#define XFillPolygon_TCL_DECLARED /* 34 */ EXTERN int XFillPolygon(Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2, int i3); -#endif -#ifndef XFillRectangles_TCL_DECLARED -#define XFillRectangles_TCL_DECLARED /* 35 */ EXTERN int XFillRectangles(Display *d, Drawable dr, GC g, XRectangle *x, int i); -#endif -#ifndef XForceScreenSaver_TCL_DECLARED -#define XForceScreenSaver_TCL_DECLARED /* 36 */ EXTERN int XForceScreenSaver(Display *d, int i); -#endif -#ifndef XFreeColormap_TCL_DECLARED -#define XFreeColormap_TCL_DECLARED /* 37 */ EXTERN int XFreeColormap(Display *d, Colormap c); -#endif -#ifndef XFreeColors_TCL_DECLARED -#define XFreeColors_TCL_DECLARED /* 38 */ EXTERN int XFreeColors(Display *d, Colormap c, unsigned long *ulp, int i, unsigned long ul); -#endif -#ifndef XFreeCursor_TCL_DECLARED -#define XFreeCursor_TCL_DECLARED /* 39 */ EXTERN int XFreeCursor(Display *d, Cursor c); -#endif -#ifndef XFreeModifiermap_TCL_DECLARED -#define XFreeModifiermap_TCL_DECLARED /* 40 */ EXTERN int XFreeModifiermap(XModifierKeymap *x); -#endif -#ifndef XGetGeometry_TCL_DECLARED -#define XGetGeometry_TCL_DECLARED /* 41 */ EXTERN Status XGetGeometry(Display *d, Drawable dr, Window *w, int *i1, int *i2, unsigned int *ui1, unsigned int *ui2, unsigned int *ui3, unsigned int *ui4); -#endif -#ifndef XGetInputFocus_TCL_DECLARED -#define XGetInputFocus_TCL_DECLARED /* 42 */ EXTERN int XGetInputFocus(Display *d, Window *w, int *i); -#endif -#ifndef XGetWindowProperty_TCL_DECLARED -#define XGetWindowProperty_TCL_DECLARED /* 43 */ EXTERN int XGetWindowProperty(Display *d, Window w, Atom a1, long l1, long l2, Bool b, Atom a2, Atom *ap, int *ip, unsigned long *ulp1, unsigned long *ulp2, unsigned char **cpp); -#endif -#ifndef XGetWindowAttributes_TCL_DECLARED -#define XGetWindowAttributes_TCL_DECLARED /* 44 */ EXTERN Status XGetWindowAttributes(Display *d, Window w, XWindowAttributes *x); -#endif -#ifndef XGrabKeyboard_TCL_DECLARED -#define XGrabKeyboard_TCL_DECLARED /* 45 */ EXTERN int XGrabKeyboard(Display *d, Window w, Bool b, int i1, int i2, Time t); -#endif -#ifndef XGrabPointer_TCL_DECLARED -#define XGrabPointer_TCL_DECLARED /* 46 */ EXTERN int XGrabPointer(Display *d, Window w1, Bool b, unsigned int ui, int i1, int i2, Window w2, Cursor c, Time t); -#endif -#ifndef XKeysymToKeycode_TCL_DECLARED -#define XKeysymToKeycode_TCL_DECLARED /* 47 */ EXTERN KeyCode XKeysymToKeycode(Display *d, KeySym k); -#endif -#ifndef XLookupColor_TCL_DECLARED -#define XLookupColor_TCL_DECLARED /* 48 */ EXTERN Status XLookupColor(Display *d, Colormap c1, _Xconst char *c2, XColor *x1, XColor *x2); -#endif -#ifndef XMapWindow_TCL_DECLARED -#define XMapWindow_TCL_DECLARED /* 49 */ EXTERN int XMapWindow(Display *d, Window w); -#endif -#ifndef XMoveResizeWindow_TCL_DECLARED -#define XMoveResizeWindow_TCL_DECLARED /* 50 */ EXTERN int XMoveResizeWindow(Display *d, Window w, int i1, int i2, unsigned int ui1, unsigned int ui2); -#endif -#ifndef XMoveWindow_TCL_DECLARED -#define XMoveWindow_TCL_DECLARED /* 51 */ EXTERN int XMoveWindow(Display *d, Window w, int i1, int i2); -#endif -#ifndef XNextEvent_TCL_DECLARED -#define XNextEvent_TCL_DECLARED /* 52 */ EXTERN int XNextEvent(Display *d, XEvent *x); -#endif -#ifndef XPutBackEvent_TCL_DECLARED -#define XPutBackEvent_TCL_DECLARED /* 53 */ EXTERN int XPutBackEvent(Display *d, XEvent *x); -#endif -#ifndef XQueryColors_TCL_DECLARED -#define XQueryColors_TCL_DECLARED /* 54 */ EXTERN int XQueryColors(Display *d, Colormap c, XColor *x, int i); -#endif -#ifndef XQueryPointer_TCL_DECLARED -#define XQueryPointer_TCL_DECLARED /* 55 */ EXTERN Bool XQueryPointer(Display *d, Window w1, Window *w2, Window *w3, int *i1, int *i2, int *i3, int *i4, unsigned int *ui); -#endif -#ifndef XQueryTree_TCL_DECLARED -#define XQueryTree_TCL_DECLARED /* 56 */ EXTERN Status XQueryTree(Display *d, Window w1, Window *w2, Window *w3, Window **w4, unsigned int *ui); -#endif -#ifndef XRaiseWindow_TCL_DECLARED -#define XRaiseWindow_TCL_DECLARED /* 57 */ EXTERN int XRaiseWindow(Display *d, Window w); -#endif -#ifndef XRefreshKeyboardMapping_TCL_DECLARED -#define XRefreshKeyboardMapping_TCL_DECLARED /* 58 */ EXTERN int XRefreshKeyboardMapping(XMappingEvent *x); -#endif -#ifndef XResizeWindow_TCL_DECLARED -#define XResizeWindow_TCL_DECLARED /* 59 */ EXTERN int XResizeWindow(Display *d, Window w, unsigned int ui1, unsigned int ui2); -#endif -#ifndef XSelectInput_TCL_DECLARED -#define XSelectInput_TCL_DECLARED /* 60 */ EXTERN int XSelectInput(Display *d, Window w, long l); -#endif -#ifndef XSendEvent_TCL_DECLARED -#define XSendEvent_TCL_DECLARED /* 61 */ EXTERN Status XSendEvent(Display *d, Window w, Bool b, long l, XEvent *x); -#endif -#ifndef XSetCommand_TCL_DECLARED -#define XSetCommand_TCL_DECLARED /* 62 */ EXTERN int XSetCommand(Display *d, Window w, char **c, int i); -#endif -#ifndef XSetIconName_TCL_DECLARED -#define XSetIconName_TCL_DECLARED /* 63 */ EXTERN int XSetIconName(Display *d, Window w, _Xconst char *c); -#endif -#ifndef XSetInputFocus_TCL_DECLARED -#define XSetInputFocus_TCL_DECLARED /* 64 */ EXTERN int XSetInputFocus(Display *d, Window w, int i, Time t); -#endif -#ifndef XSetSelectionOwner_TCL_DECLARED -#define XSetSelectionOwner_TCL_DECLARED /* 65 */ EXTERN int XSetSelectionOwner(Display *d, Atom a, Window w, Time t); -#endif -#ifndef XSetWindowBackground_TCL_DECLARED -#define XSetWindowBackground_TCL_DECLARED /* 66 */ EXTERN int XSetWindowBackground(Display *d, Window w, unsigned long ul); -#endif -#ifndef XSetWindowBackgroundPixmap_TCL_DECLARED -#define XSetWindowBackgroundPixmap_TCL_DECLARED /* 67 */ EXTERN int XSetWindowBackgroundPixmap(Display *d, Window w, Pixmap p); -#endif -#ifndef XSetWindowBorder_TCL_DECLARED -#define XSetWindowBorder_TCL_DECLARED /* 68 */ EXTERN int XSetWindowBorder(Display *d, Window w, unsigned long ul); -#endif -#ifndef XSetWindowBorderPixmap_TCL_DECLARED -#define XSetWindowBorderPixmap_TCL_DECLARED /* 69 */ EXTERN int XSetWindowBorderPixmap(Display *d, Window w, Pixmap p); -#endif -#ifndef XSetWindowBorderWidth_TCL_DECLARED -#define XSetWindowBorderWidth_TCL_DECLARED /* 70 */ EXTERN int XSetWindowBorderWidth(Display *d, Window w, unsigned int ui); -#endif -#ifndef XSetWindowColormap_TCL_DECLARED -#define XSetWindowColormap_TCL_DECLARED /* 71 */ EXTERN int XSetWindowColormap(Display *d, Window w, Colormap c); -#endif -#ifndef XTranslateCoordinates_TCL_DECLARED -#define XTranslateCoordinates_TCL_DECLARED /* 72 */ EXTERN Bool XTranslateCoordinates(Display *d, Window w1, Window w2, int i1, int i2, int *i3, int *i4, Window *w3); -#endif -#ifndef XUngrabKeyboard_TCL_DECLARED -#define XUngrabKeyboard_TCL_DECLARED /* 73 */ EXTERN int XUngrabKeyboard(Display *d, Time t); -#endif -#ifndef XUngrabPointer_TCL_DECLARED -#define XUngrabPointer_TCL_DECLARED /* 74 */ EXTERN int XUngrabPointer(Display *d, Time t); -#endif -#ifndef XUnmapWindow_TCL_DECLARED -#define XUnmapWindow_TCL_DECLARED /* 75 */ EXTERN int XUnmapWindow(Display *d, Window w); -#endif -#ifndef XWindowEvent_TCL_DECLARED -#define XWindowEvent_TCL_DECLARED /* 76 */ EXTERN int XWindowEvent(Display *d, Window w, long l, XEvent *x); -#endif -#ifndef XDestroyIC_TCL_DECLARED -#define XDestroyIC_TCL_DECLARED /* 77 */ EXTERN void XDestroyIC(XIC x); -#endif -#ifndef XFilterEvent_TCL_DECLARED -#define XFilterEvent_TCL_DECLARED /* 78 */ EXTERN Bool XFilterEvent(XEvent *x, Window w); -#endif -#ifndef XmbLookupString_TCL_DECLARED -#define XmbLookupString_TCL_DECLARED /* 79 */ EXTERN int XmbLookupString(XIC xi, XKeyPressedEvent *xk, char *c, int i, KeySym *k, Status *s); -#endif -#ifndef TkPutImage_TCL_DECLARED -#define TkPutImage_TCL_DECLARED /* 80 */ EXTERN int TkPutImage(unsigned long *colors, int ncolors, Display *display, Drawable d, GC gc, XImage *image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height); -#endif /* Slot 81 is reserved */ -#ifndef XParseColor_TCL_DECLARED -#define XParseColor_TCL_DECLARED /* 82 */ EXTERN Status XParseColor(Display *display, Colormap map, _Xconst char *spec, XColor *colorPtr); -#endif -#ifndef XCreateGC_TCL_DECLARED -#define XCreateGC_TCL_DECLARED /* 83 */ EXTERN GC XCreateGC(Display *display, Drawable d, unsigned long valuemask, XGCValues *values); -#endif -#ifndef XFreeGC_TCL_DECLARED -#define XFreeGC_TCL_DECLARED /* 84 */ EXTERN int XFreeGC(Display *display, GC gc); -#endif -#ifndef XInternAtom_TCL_DECLARED -#define XInternAtom_TCL_DECLARED /* 85 */ EXTERN Atom XInternAtom(Display *display, _Xconst char *atom_name, Bool only_if_exists); -#endif -#ifndef XSetBackground_TCL_DECLARED -#define XSetBackground_TCL_DECLARED /* 86 */ EXTERN int XSetBackground(Display *display, GC gc, unsigned long foreground); -#endif -#ifndef XSetForeground_TCL_DECLARED -#define XSetForeground_TCL_DECLARED /* 87 */ EXTERN int XSetForeground(Display *display, GC gc, unsigned long foreground); -#endif -#ifndef XSetClipMask_TCL_DECLARED -#define XSetClipMask_TCL_DECLARED /* 88 */ EXTERN int XSetClipMask(Display *display, GC gc, Pixmap pixmap); -#endif -#ifndef XSetClipOrigin_TCL_DECLARED -#define XSetClipOrigin_TCL_DECLARED /* 89 */ EXTERN int XSetClipOrigin(Display *display, GC gc, int clip_x_origin, int clip_y_origin); -#endif -#ifndef XSetTSOrigin_TCL_DECLARED -#define XSetTSOrigin_TCL_DECLARED /* 90 */ EXTERN int XSetTSOrigin(Display *display, GC gc, int ts_x_origin, int ts_y_origin); -#endif -#ifndef XChangeGC_TCL_DECLARED -#define XChangeGC_TCL_DECLARED /* 91 */ EXTERN int XChangeGC(Display *d, GC gc, unsigned long mask, XGCValues *values); -#endif -#ifndef XSetFont_TCL_DECLARED -#define XSetFont_TCL_DECLARED /* 92 */ EXTERN int XSetFont(Display *display, GC gc, Font font); -#endif -#ifndef XSetArcMode_TCL_DECLARED -#define XSetArcMode_TCL_DECLARED /* 93 */ EXTERN int XSetArcMode(Display *display, GC gc, int arc_mode); -#endif -#ifndef XSetStipple_TCL_DECLARED -#define XSetStipple_TCL_DECLARED /* 94 */ EXTERN int XSetStipple(Display *display, GC gc, Pixmap stipple); -#endif -#ifndef XSetFillRule_TCL_DECLARED -#define XSetFillRule_TCL_DECLARED /* 95 */ EXTERN int XSetFillRule(Display *display, GC gc, int fill_rule); -#endif -#ifndef XSetFillStyle_TCL_DECLARED -#define XSetFillStyle_TCL_DECLARED /* 96 */ EXTERN int XSetFillStyle(Display *display, GC gc, int fill_style); -#endif -#ifndef XSetFunction_TCL_DECLARED -#define XSetFunction_TCL_DECLARED /* 97 */ EXTERN int XSetFunction(Display *display, GC gc, int function); -#endif -#ifndef XSetLineAttributes_TCL_DECLARED -#define XSetLineAttributes_TCL_DECLARED /* 98 */ EXTERN int XSetLineAttributes(Display *display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style); -#endif -#ifndef _XInitImageFuncPtrs_TCL_DECLARED -#define _XInitImageFuncPtrs_TCL_DECLARED /* 99 */ EXTERN int _XInitImageFuncPtrs(XImage *image); -#endif -#ifndef XCreateIC_TCL_DECLARED -#define XCreateIC_TCL_DECLARED /* 100 */ EXTERN XIC XCreateIC(XIM xim, ...); -#endif -#ifndef XGetVisualInfo_TCL_DECLARED -#define XGetVisualInfo_TCL_DECLARED /* 101 */ EXTERN XVisualInfo * XGetVisualInfo(Display *display, long vinfo_mask, XVisualInfo *vinfo_template, int *nitems_return); -#endif -#ifndef XSetWMClientMachine_TCL_DECLARED -#define XSetWMClientMachine_TCL_DECLARED /* 102 */ EXTERN void XSetWMClientMachine(Display *display, Window w, XTextProperty *text_prop); -#endif -#ifndef XStringListToTextProperty_TCL_DECLARED -#define XStringListToTextProperty_TCL_DECLARED /* 103 */ EXTERN Status XStringListToTextProperty(char **list, int count, XTextProperty *text_prop_return); -#endif -#ifndef XDrawLine_TCL_DECLARED -#define XDrawLine_TCL_DECLARED /* 104 */ EXTERN int XDrawLine(Display *d, Drawable dr, GC g, int x1, int y1, int x2, int y2); -#endif -#ifndef XWarpPointer_TCL_DECLARED -#define XWarpPointer_TCL_DECLARED /* 105 */ EXTERN int XWarpPointer(Display *d, Window s, Window dw, int sx, int sy, unsigned int sw, unsigned int sh, int dx, int dy); -#endif -#ifndef XFillRectangle_TCL_DECLARED -#define XFillRectangle_TCL_DECLARED /* 106 */ EXTERN int XFillRectangle(Display *display, Drawable d, GC gc, int x, int y, unsigned int width, unsigned int height); -#endif -#ifndef XFlush_TCL_DECLARED -#define XFlush_TCL_DECLARED /* 107 */ EXTERN int XFlush(Display *display); -#endif -#ifndef XGrabServer_TCL_DECLARED -#define XGrabServer_TCL_DECLARED /* 108 */ EXTERN int XGrabServer(Display *display); -#endif -#ifndef XUngrabServer_TCL_DECLARED -#define XUngrabServer_TCL_DECLARED /* 109 */ EXTERN int XUngrabServer(Display *display); -#endif -#ifndef XFree_TCL_DECLARED -#define XFree_TCL_DECLARED /* 110 */ -EXTERN int XFree(VOID *data); -#endif -#ifndef XNoOp_TCL_DECLARED -#define XNoOp_TCL_DECLARED +EXTERN int XFree(void *data); /* 111 */ EXTERN int XNoOp(Display *display); -#endif -#ifndef XSynchronize_TCL_DECLARED -#define XSynchronize_TCL_DECLARED /* 112 */ EXTERN XAfterFunction XSynchronize(Display *display, Bool onoff); -#endif -#ifndef XSync_TCL_DECLARED -#define XSync_TCL_DECLARED /* 113 */ EXTERN int XSync(Display *display, Bool discard); -#endif -#ifndef XVisualIDFromVisual_TCL_DECLARED -#define XVisualIDFromVisual_TCL_DECLARED /* 114 */ EXTERN VisualID XVisualIDFromVisual(Visual *visual); -#endif #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef XSetDashes_TCL_DECLARED -#define XSetDashes_TCL_DECLARED /* 0 */ EXTERN int XSetDashes(Display *display, GC gc, int dash_offset, _Xconst char *dash_list, int n); -#endif -#ifndef XGetModifierMapping_TCL_DECLARED -#define XGetModifierMapping_TCL_DECLARED /* 1 */ EXTERN XModifierKeymap * XGetModifierMapping(Display *d); -#endif -#ifndef XCreateImage_TCL_DECLARED -#define XCreateImage_TCL_DECLARED /* 2 */ EXTERN XImage * XCreateImage(Display *d, Visual *v, unsigned int ui1, int i1, int i2, char *cp, unsigned int ui2, unsigned int ui3, int i3, int i4); -#endif -#ifndef XGetImage_TCL_DECLARED -#define XGetImage_TCL_DECLARED /* 3 */ EXTERN XImage * XGetImage(Display *d, Drawable dr, int i1, int i2, unsigned int ui1, unsigned int ui2, unsigned long ul, int i3); -#endif -#ifndef XGetAtomName_TCL_DECLARED -#define XGetAtomName_TCL_DECLARED /* 4 */ EXTERN char * XGetAtomName(Display *d, Atom a); -#endif -#ifndef XKeysymToString_TCL_DECLARED -#define XKeysymToString_TCL_DECLARED /* 5 */ EXTERN char * XKeysymToString(KeySym k); -#endif -#ifndef XCreateColormap_TCL_DECLARED -#define XCreateColormap_TCL_DECLARED /* 6 */ EXTERN Colormap XCreateColormap(Display *d, Window w, Visual *v, int i); -#endif -#ifndef XGContextFromGC_TCL_DECLARED -#define XGContextFromGC_TCL_DECLARED /* 7 */ EXTERN GContext XGContextFromGC(GC g); -#endif -#ifndef XKeycodeToKeysym_TCL_DECLARED -#define XKeycodeToKeysym_TCL_DECLARED /* 8 */ EXTERN KeySym XKeycodeToKeysym(Display *d, KeyCode k, int i); -#endif -#ifndef XStringToKeysym_TCL_DECLARED -#define XStringToKeysym_TCL_DECLARED /* 9 */ EXTERN KeySym XStringToKeysym(_Xconst char *c); -#endif -#ifndef XRootWindow_TCL_DECLARED -#define XRootWindow_TCL_DECLARED /* 10 */ EXTERN Window XRootWindow(Display *d, int i); -#endif -#ifndef XSetErrorHandler_TCL_DECLARED -#define XSetErrorHandler_TCL_DECLARED /* 11 */ EXTERN XErrorHandler XSetErrorHandler(XErrorHandler x); -#endif -#ifndef XAllocColor_TCL_DECLARED -#define XAllocColor_TCL_DECLARED /* 12 */ EXTERN Status XAllocColor(Display *d, Colormap c, XColor *xp); -#endif -#ifndef XBell_TCL_DECLARED -#define XBell_TCL_DECLARED /* 13 */ EXTERN int XBell(Display *d, int i); -#endif -#ifndef XChangeProperty_TCL_DECLARED -#define XChangeProperty_TCL_DECLARED /* 14 */ EXTERN void XChangeProperty(Display *d, Window w, Atom a1, Atom a2, int i1, int i2, _Xconst unsigned char *c, int i3); -#endif -#ifndef XChangeWindowAttributes_TCL_DECLARED -#define XChangeWindowAttributes_TCL_DECLARED /* 15 */ EXTERN void XChangeWindowAttributes(Display *d, Window w, unsigned long ul, XSetWindowAttributes *x); -#endif -#ifndef XConfigureWindow_TCL_DECLARED -#define XConfigureWindow_TCL_DECLARED /* 16 */ EXTERN void XConfigureWindow(Display *d, Window w, unsigned int i, XWindowChanges *x); -#endif -#ifndef XCopyArea_TCL_DECLARED -#define XCopyArea_TCL_DECLARED /* 17 */ EXTERN void XCopyArea(Display *d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); -#endif -#ifndef XCopyPlane_TCL_DECLARED -#define XCopyPlane_TCL_DECLARED /* 18 */ EXTERN void XCopyPlane(Display *d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4, unsigned long ul); -#endif -#ifndef XCreateBitmapFromData_TCL_DECLARED -#define XCreateBitmapFromData_TCL_DECLARED /* 19 */ EXTERN Pixmap XCreateBitmapFromData(Display *display, Drawable d, _Xconst char *data, unsigned int width, unsigned int height); -#endif -#ifndef XDefineCursor_TCL_DECLARED -#define XDefineCursor_TCL_DECLARED /* 20 */ EXTERN int XDefineCursor(Display *d, Window w, Cursor c); -#endif -#ifndef XDestroyWindow_TCL_DECLARED -#define XDestroyWindow_TCL_DECLARED /* 21 */ EXTERN void XDestroyWindow(Display *d, Window w); -#endif -#ifndef XDrawArc_TCL_DECLARED -#define XDrawArc_TCL_DECLARED /* 22 */ EXTERN void XDrawArc(Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); -#endif -#ifndef XDrawLines_TCL_DECLARED -#define XDrawLines_TCL_DECLARED /* 23 */ EXTERN int XDrawLines(Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2); -#endif -#ifndef XDrawRectangle_TCL_DECLARED -#define XDrawRectangle_TCL_DECLARED /* 24 */ EXTERN void XDrawRectangle(Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2); -#endif -#ifndef XFillArc_TCL_DECLARED -#define XFillArc_TCL_DECLARED /* 25 */ EXTERN void XFillArc(Display *d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4); -#endif -#ifndef XFillPolygon_TCL_DECLARED -#define XFillPolygon_TCL_DECLARED /* 26 */ EXTERN void XFillPolygon(Display *d, Drawable dr, GC g, XPoint *x, int i1, int i2, int i3); -#endif -#ifndef XFillRectangles_TCL_DECLARED -#define XFillRectangles_TCL_DECLARED /* 27 */ EXTERN int XFillRectangles(Display *d, Drawable dr, GC g, XRectangle *x, int i); -#endif -#ifndef XFreeColormap_TCL_DECLARED -#define XFreeColormap_TCL_DECLARED /* 28 */ EXTERN int XFreeColormap(Display *d, Colormap c); -#endif -#ifndef XFreeColors_TCL_DECLARED -#define XFreeColors_TCL_DECLARED /* 29 */ EXTERN int XFreeColors(Display *d, Colormap c, unsigned long *ulp, int i, unsigned long ul); -#endif -#ifndef XFreeModifiermap_TCL_DECLARED -#define XFreeModifiermap_TCL_DECLARED /* 30 */ EXTERN int XFreeModifiermap(XModifierKeymap *x); -#endif -#ifndef XGetGeometry_TCL_DECLARED -#define XGetGeometry_TCL_DECLARED /* 31 */ EXTERN Status XGetGeometry(Display *d, Drawable dr, Window *w, int *i1, int *i2, unsigned int *ui1, unsigned int *ui2, unsigned int *ui3, unsigned int *ui4); -#endif -#ifndef XGetWindowProperty_TCL_DECLARED -#define XGetWindowProperty_TCL_DECLARED /* 32 */ EXTERN int XGetWindowProperty(Display *d, Window w, Atom a1, long l1, long l2, Bool b, Atom a2, Atom *ap, int *ip, unsigned long *ulp1, unsigned long *ulp2, unsigned char **cpp); -#endif -#ifndef XGrabKeyboard_TCL_DECLARED -#define XGrabKeyboard_TCL_DECLARED /* 33 */ EXTERN int XGrabKeyboard(Display *d, Window w, Bool b, int i1, int i2, Time t); -#endif -#ifndef XGrabPointer_TCL_DECLARED -#define XGrabPointer_TCL_DECLARED /* 34 */ EXTERN int XGrabPointer(Display *d, Window w1, Bool b, unsigned int ui, int i1, int i2, Window w2, Cursor c, Time t); -#endif -#ifndef XKeysymToKeycode_TCL_DECLARED -#define XKeysymToKeycode_TCL_DECLARED /* 35 */ EXTERN KeyCode XKeysymToKeycode(Display *d, KeySym k); -#endif -#ifndef XMapWindow_TCL_DECLARED -#define XMapWindow_TCL_DECLARED /* 36 */ EXTERN void XMapWindow(Display *d, Window w); -#endif -#ifndef XMoveResizeWindow_TCL_DECLARED -#define XMoveResizeWindow_TCL_DECLARED /* 37 */ EXTERN void XMoveResizeWindow(Display *d, Window w, int i1, int i2, unsigned int ui1, unsigned int ui2); -#endif -#ifndef XMoveWindow_TCL_DECLARED -#define XMoveWindow_TCL_DECLARED /* 38 */ EXTERN void XMoveWindow(Display *d, Window w, int i1, int i2); -#endif -#ifndef XQueryPointer_TCL_DECLARED -#define XQueryPointer_TCL_DECLARED /* 39 */ EXTERN Bool XQueryPointer(Display *d, Window w1, Window *w2, Window *w3, int *i1, int *i2, int *i3, int *i4, unsigned int *ui); -#endif -#ifndef XRaiseWindow_TCL_DECLARED -#define XRaiseWindow_TCL_DECLARED /* 40 */ EXTERN void XRaiseWindow(Display *d, Window w); -#endif -#ifndef XRefreshKeyboardMapping_TCL_DECLARED -#define XRefreshKeyboardMapping_TCL_DECLARED /* 41 */ EXTERN void XRefreshKeyboardMapping(XMappingEvent *x); -#endif -#ifndef XResizeWindow_TCL_DECLARED -#define XResizeWindow_TCL_DECLARED /* 42 */ EXTERN void XResizeWindow(Display *d, Window w, unsigned int ui1, unsigned int ui2); -#endif -#ifndef XSelectInput_TCL_DECLARED -#define XSelectInput_TCL_DECLARED /* 43 */ EXTERN void XSelectInput(Display *d, Window w, long l); -#endif -#ifndef XSendEvent_TCL_DECLARED -#define XSendEvent_TCL_DECLARED /* 44 */ EXTERN Status XSendEvent(Display *d, Window w, Bool b, long l, XEvent *x); -#endif -#ifndef XSetIconName_TCL_DECLARED -#define XSetIconName_TCL_DECLARED /* 45 */ EXTERN void XSetIconName(Display *d, Window w, _Xconst char *c); -#endif -#ifndef XSetInputFocus_TCL_DECLARED -#define XSetInputFocus_TCL_DECLARED /* 46 */ EXTERN void XSetInputFocus(Display *d, Window w, int i, Time t); -#endif -#ifndef XSetSelectionOwner_TCL_DECLARED -#define XSetSelectionOwner_TCL_DECLARED /* 47 */ EXTERN int XSetSelectionOwner(Display *d, Atom a, Window w, Time t); -#endif -#ifndef XSetWindowBackground_TCL_DECLARED -#define XSetWindowBackground_TCL_DECLARED /* 48 */ EXTERN void XSetWindowBackground(Display *d, Window w, unsigned long ul); -#endif -#ifndef XSetWindowBackgroundPixmap_TCL_DECLARED -#define XSetWindowBackgroundPixmap_TCL_DECLARED /* 49 */ EXTERN void XSetWindowBackgroundPixmap(Display *d, Window w, Pixmap p); -#endif -#ifndef XSetWindowBorder_TCL_DECLARED -#define XSetWindowBorder_TCL_DECLARED /* 50 */ EXTERN void XSetWindowBorder(Display *d, Window w, unsigned long ul); -#endif -#ifndef XSetWindowBorderPixmap_TCL_DECLARED -#define XSetWindowBorderPixmap_TCL_DECLARED /* 51 */ EXTERN void XSetWindowBorderPixmap(Display *d, Window w, Pixmap p); -#endif -#ifndef XSetWindowBorderWidth_TCL_DECLARED -#define XSetWindowBorderWidth_TCL_DECLARED /* 52 */ EXTERN void XSetWindowBorderWidth(Display *d, Window w, unsigned int ui); -#endif -#ifndef XSetWindowColormap_TCL_DECLARED -#define XSetWindowColormap_TCL_DECLARED /* 53 */ EXTERN void XSetWindowColormap(Display *d, Window w, Colormap c); -#endif -#ifndef XUngrabKeyboard_TCL_DECLARED -#define XUngrabKeyboard_TCL_DECLARED /* 54 */ EXTERN void XUngrabKeyboard(Display *d, Time t); -#endif -#ifndef XUngrabPointer_TCL_DECLARED -#define XUngrabPointer_TCL_DECLARED /* 55 */ EXTERN int XUngrabPointer(Display *d, Time t); -#endif -#ifndef XUnmapWindow_TCL_DECLARED -#define XUnmapWindow_TCL_DECLARED /* 56 */ EXTERN void XUnmapWindow(Display *d, Window w); -#endif -#ifndef TkPutImage_TCL_DECLARED -#define TkPutImage_TCL_DECLARED /* 57 */ EXTERN int TkPutImage(unsigned long *colors, int ncolors, Display *display, Drawable d, GC gc, XImage *image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height); -#endif -#ifndef XParseColor_TCL_DECLARED -#define XParseColor_TCL_DECLARED /* 58 */ EXTERN Status XParseColor(Display *display, Colormap map, _Xconst char *spec, XColor *colorPtr); -#endif -#ifndef XCreateGC_TCL_DECLARED -#define XCreateGC_TCL_DECLARED /* 59 */ EXTERN GC XCreateGC(Display *display, Drawable d, unsigned long valuemask, XGCValues *values); -#endif -#ifndef XFreeGC_TCL_DECLARED -#define XFreeGC_TCL_DECLARED /* 60 */ EXTERN int XFreeGC(Display *display, GC gc); -#endif -#ifndef XInternAtom_TCL_DECLARED -#define XInternAtom_TCL_DECLARED /* 61 */ EXTERN Atom XInternAtom(Display *display, _Xconst char *atom_name, Bool only_if_exists); -#endif -#ifndef XSetBackground_TCL_DECLARED -#define XSetBackground_TCL_DECLARED /* 62 */ EXTERN int XSetBackground(Display *display, GC gc, unsigned long foreground); -#endif -#ifndef XSetForeground_TCL_DECLARED -#define XSetForeground_TCL_DECLARED /* 63 */ EXTERN int XSetForeground(Display *display, GC gc, unsigned long foreground); -#endif -#ifndef XSetClipMask_TCL_DECLARED -#define XSetClipMask_TCL_DECLARED /* 64 */ EXTERN int XSetClipMask(Display *display, GC gc, Pixmap pixmap); -#endif -#ifndef XSetClipOrigin_TCL_DECLARED -#define XSetClipOrigin_TCL_DECLARED /* 65 */ EXTERN int XSetClipOrigin(Display *display, GC gc, int clip_x_origin, int clip_y_origin); -#endif -#ifndef XSetTSOrigin_TCL_DECLARED -#define XSetTSOrigin_TCL_DECLARED /* 66 */ EXTERN int XSetTSOrigin(Display *display, GC gc, int ts_x_origin, int ts_y_origin); -#endif -#ifndef XChangeGC_TCL_DECLARED -#define XChangeGC_TCL_DECLARED /* 67 */ EXTERN int XChangeGC(Display *d, GC gc, unsigned long mask, XGCValues *values); -#endif -#ifndef XSetFont_TCL_DECLARED -#define XSetFont_TCL_DECLARED /* 68 */ EXTERN int XSetFont(Display *display, GC gc, Font font); -#endif -#ifndef XSetArcMode_TCL_DECLARED -#define XSetArcMode_TCL_DECLARED /* 69 */ EXTERN int XSetArcMode(Display *display, GC gc, int arc_mode); -#endif -#ifndef XSetStipple_TCL_DECLARED -#define XSetStipple_TCL_DECLARED /* 70 */ EXTERN int XSetStipple(Display *display, GC gc, Pixmap stipple); -#endif -#ifndef XSetFillRule_TCL_DECLARED -#define XSetFillRule_TCL_DECLARED /* 71 */ EXTERN int XSetFillRule(Display *display, GC gc, int fill_rule); -#endif -#ifndef XSetFillStyle_TCL_DECLARED -#define XSetFillStyle_TCL_DECLARED /* 72 */ EXTERN int XSetFillStyle(Display *display, GC gc, int fill_style); -#endif -#ifndef XSetFunction_TCL_DECLARED -#define XSetFunction_TCL_DECLARED /* 73 */ EXTERN int XSetFunction(Display *display, GC gc, int function); -#endif -#ifndef XSetLineAttributes_TCL_DECLARED -#define XSetLineAttributes_TCL_DECLARED /* 74 */ EXTERN int XSetLineAttributes(Display *display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style); -#endif -#ifndef _XInitImageFuncPtrs_TCL_DECLARED -#define _XInitImageFuncPtrs_TCL_DECLARED /* 75 */ EXTERN int _XInitImageFuncPtrs(XImage *image); -#endif -#ifndef XCreateIC_TCL_DECLARED -#define XCreateIC_TCL_DECLARED /* 76 */ EXTERN XIC XCreateIC(void); -#endif -#ifndef XGetVisualInfo_TCL_DECLARED -#define XGetVisualInfo_TCL_DECLARED /* 77 */ EXTERN XVisualInfo * XGetVisualInfo(Display *display, long vinfo_mask, XVisualInfo *vinfo_template, int *nitems_return); -#endif -#ifndef XSetWMClientMachine_TCL_DECLARED -#define XSetWMClientMachine_TCL_DECLARED /* 78 */ EXTERN void XSetWMClientMachine(Display *display, Window w, XTextProperty *text_prop); -#endif -#ifndef XStringListToTextProperty_TCL_DECLARED -#define XStringListToTextProperty_TCL_DECLARED /* 79 */ EXTERN Status XStringListToTextProperty(char **list, int count, XTextProperty *text_prop_return); -#endif -#ifndef XDrawSegments_TCL_DECLARED -#define XDrawSegments_TCL_DECLARED /* 80 */ EXTERN void XDrawSegments(Display *display, Drawable d, GC gc, XSegment *segments, int nsegments); -#endif -#ifndef XForceScreenSaver_TCL_DECLARED -#define XForceScreenSaver_TCL_DECLARED /* 81 */ EXTERN void XForceScreenSaver(Display *display, int mode); -#endif -#ifndef XDrawLine_TCL_DECLARED -#define XDrawLine_TCL_DECLARED /* 82 */ EXTERN int XDrawLine(Display *d, Drawable dr, GC g, int x1, int y1, int x2, int y2); -#endif -#ifndef XFillRectangle_TCL_DECLARED -#define XFillRectangle_TCL_DECLARED /* 83 */ EXTERN int XFillRectangle(Display *display, Drawable d, GC gc, int x, int y, unsigned int width, unsigned int height); -#endif -#ifndef XClearWindow_TCL_DECLARED -#define XClearWindow_TCL_DECLARED /* 84 */ EXTERN void XClearWindow(Display *d, Window w); -#endif -#ifndef XDrawPoint_TCL_DECLARED -#define XDrawPoint_TCL_DECLARED /* 85 */ EXTERN void XDrawPoint(Display *display, Drawable d, GC gc, int x, int y); -#endif -#ifndef XDrawPoints_TCL_DECLARED -#define XDrawPoints_TCL_DECLARED /* 86 */ EXTERN void XDrawPoints(Display *display, Drawable d, GC gc, XPoint *points, int npoints, int mode); -#endif -#ifndef XWarpPointer_TCL_DECLARED -#define XWarpPointer_TCL_DECLARED /* 87 */ EXTERN int XWarpPointer(Display *display, Window src_w, Window dest_w, int src_x, int src_y, unsigned int src_width, unsigned int src_height, int dest_x, int dest_y); -#endif -#ifndef XQueryColor_TCL_DECLARED -#define XQueryColor_TCL_DECLARED /* 88 */ EXTERN void XQueryColor(Display *display, Colormap colormap, XColor *def_in_out); -#endif -#ifndef XQueryColors_TCL_DECLARED -#define XQueryColors_TCL_DECLARED /* 89 */ EXTERN void XQueryColors(Display *display, Colormap colormap, XColor *defs_in_out, int ncolors); -#endif -#ifndef XQueryTree_TCL_DECLARED -#define XQueryTree_TCL_DECLARED /* 90 */ EXTERN Status XQueryTree(Display *d, Window w1, Window *w2, Window *w3, Window **w4, unsigned int *ui); -#endif -#ifndef XSync_TCL_DECLARED -#define XSync_TCL_DECLARED /* 91 */ EXTERN int XSync(Display *display, Bool flag); -#endif #endif /* AQUA */ typedef struct TkIntXlibStubs { int magic; - struct TkIntXlibStubHooks *hooks; + void *hooks; -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ int (*xSetDashes) (Display *display, GC gc, int dash_offset, _Xconst char *dash_list, int n); /* 0 */ XModifierKeymap * (*xGetModifierMapping) (Display *d); /* 1 */ XImage * (*xCreateImage) (Display *d, Visual *v, unsigned int ui1, int i1, int i2, char *cp, unsigned int ui2, unsigned int ui3, int i3, int i4); /* 2 */ @@ -1326,7 +708,7 @@ typedef struct TkIntXlibStubs { Bool (*xFilterEvent) (XEvent *x, Window w); /* 78 */ int (*xmbLookupString) (XIC xi, XKeyPressedEvent *xk, char *c, int i, KeySym *k, Status *s); /* 79 */ int (*tkPutImage) (unsigned long *colors, int ncolors, Display *display, Drawable d, GC gc, XImage *image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height); /* 80 */ - VOID *reserved81; + void (*reserved81)(void); Status (*xParseColor) (Display *display, Colormap map, _Xconst char *spec, XColor *colorPtr); /* 82 */ GC (*xCreateGC) (Display *display, Drawable d, unsigned long valuemask, XGCValues *values); /* 83 */ int (*xFreeGC) (Display *display, GC gc); /* 84 */ @@ -1355,7 +737,7 @@ typedef struct TkIntXlibStubs { int (*xFlush) (Display *display); /* 107 */ int (*xGrabServer) (Display *display); /* 108 */ int (*xUngrabServer) (Display *display); /* 109 */ - int (*xFree) (VOID *data); /* 110 */ + int (*xFree) (void *data); /* 110 */ int (*xNoOp) (Display *display); /* 111 */ XAfterFunction (*xSynchronize) (Display *display, Bool onoff); /* 112 */ int (*xSync) (Display *display, Bool discard); /* 113 */ @@ -1457,914 +839,441 @@ typedef struct TkIntXlibStubs { #endif /* AQUA */ } TkIntXlibStubs; -extern TkIntXlibStubs *tkIntXlibStubsPtr; +extern const TkIntXlibStubs *tkIntXlibStubsPtr; #ifdef __cplusplus } #endif -#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) +#if defined(USE_TK_STUBS) /* * Inline function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ -#ifndef XSetDashes +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define XSetDashes \ (tkIntXlibStubsPtr->xSetDashes) /* 0 */ -#endif -#ifndef XGetModifierMapping #define XGetModifierMapping \ (tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */ -#endif -#ifndef XCreateImage #define XCreateImage \ (tkIntXlibStubsPtr->xCreateImage) /* 2 */ -#endif -#ifndef XGetImage #define XGetImage \ (tkIntXlibStubsPtr->xGetImage) /* 3 */ -#endif -#ifndef XGetAtomName #define XGetAtomName \ (tkIntXlibStubsPtr->xGetAtomName) /* 4 */ -#endif -#ifndef XKeysymToString #define XKeysymToString \ (tkIntXlibStubsPtr->xKeysymToString) /* 5 */ -#endif -#ifndef XCreateColormap #define XCreateColormap \ (tkIntXlibStubsPtr->xCreateColormap) /* 6 */ -#endif -#ifndef XCreatePixmapCursor #define XCreatePixmapCursor \ (tkIntXlibStubsPtr->xCreatePixmapCursor) /* 7 */ -#endif -#ifndef XCreateGlyphCursor #define XCreateGlyphCursor \ (tkIntXlibStubsPtr->xCreateGlyphCursor) /* 8 */ -#endif -#ifndef XGContextFromGC #define XGContextFromGC \ (tkIntXlibStubsPtr->xGContextFromGC) /* 9 */ -#endif -#ifndef XListHosts #define XListHosts \ (tkIntXlibStubsPtr->xListHosts) /* 10 */ -#endif -#ifndef XKeycodeToKeysym #define XKeycodeToKeysym \ (tkIntXlibStubsPtr->xKeycodeToKeysym) /* 11 */ -#endif -#ifndef XStringToKeysym #define XStringToKeysym \ (tkIntXlibStubsPtr->xStringToKeysym) /* 12 */ -#endif -#ifndef XRootWindow #define XRootWindow \ (tkIntXlibStubsPtr->xRootWindow) /* 13 */ -#endif -#ifndef XSetErrorHandler #define XSetErrorHandler \ (tkIntXlibStubsPtr->xSetErrorHandler) /* 14 */ -#endif -#ifndef XIconifyWindow #define XIconifyWindow \ (tkIntXlibStubsPtr->xIconifyWindow) /* 15 */ -#endif -#ifndef XWithdrawWindow #define XWithdrawWindow \ (tkIntXlibStubsPtr->xWithdrawWindow) /* 16 */ -#endif -#ifndef XGetWMColormapWindows #define XGetWMColormapWindows \ (tkIntXlibStubsPtr->xGetWMColormapWindows) /* 17 */ -#endif -#ifndef XAllocColor #define XAllocColor \ (tkIntXlibStubsPtr->xAllocColor) /* 18 */ -#endif -#ifndef XBell #define XBell \ (tkIntXlibStubsPtr->xBell) /* 19 */ -#endif -#ifndef XChangeProperty #define XChangeProperty \ (tkIntXlibStubsPtr->xChangeProperty) /* 20 */ -#endif -#ifndef XChangeWindowAttributes #define XChangeWindowAttributes \ (tkIntXlibStubsPtr->xChangeWindowAttributes) /* 21 */ -#endif -#ifndef XClearWindow #define XClearWindow \ (tkIntXlibStubsPtr->xClearWindow) /* 22 */ -#endif -#ifndef XConfigureWindow #define XConfigureWindow \ (tkIntXlibStubsPtr->xConfigureWindow) /* 23 */ -#endif -#ifndef XCopyArea #define XCopyArea \ (tkIntXlibStubsPtr->xCopyArea) /* 24 */ -#endif -#ifndef XCopyPlane #define XCopyPlane \ (tkIntXlibStubsPtr->xCopyPlane) /* 25 */ -#endif -#ifndef XCreateBitmapFromData #define XCreateBitmapFromData \ (tkIntXlibStubsPtr->xCreateBitmapFromData) /* 26 */ -#endif -#ifndef XDefineCursor #define XDefineCursor \ (tkIntXlibStubsPtr->xDefineCursor) /* 27 */ -#endif -#ifndef XDeleteProperty #define XDeleteProperty \ (tkIntXlibStubsPtr->xDeleteProperty) /* 28 */ -#endif -#ifndef XDestroyWindow #define XDestroyWindow \ (tkIntXlibStubsPtr->xDestroyWindow) /* 29 */ -#endif -#ifndef XDrawArc #define XDrawArc \ (tkIntXlibStubsPtr->xDrawArc) /* 30 */ -#endif -#ifndef XDrawLines #define XDrawLines \ (tkIntXlibStubsPtr->xDrawLines) /* 31 */ -#endif -#ifndef XDrawRectangle #define XDrawRectangle \ (tkIntXlibStubsPtr->xDrawRectangle) /* 32 */ -#endif -#ifndef XFillArc #define XFillArc \ (tkIntXlibStubsPtr->xFillArc) /* 33 */ -#endif -#ifndef XFillPolygon #define XFillPolygon \ (tkIntXlibStubsPtr->xFillPolygon) /* 34 */ -#endif -#ifndef XFillRectangles #define XFillRectangles \ (tkIntXlibStubsPtr->xFillRectangles) /* 35 */ -#endif -#ifndef XForceScreenSaver #define XForceScreenSaver \ (tkIntXlibStubsPtr->xForceScreenSaver) /* 36 */ -#endif -#ifndef XFreeColormap #define XFreeColormap \ (tkIntXlibStubsPtr->xFreeColormap) /* 37 */ -#endif -#ifndef XFreeColors #define XFreeColors \ (tkIntXlibStubsPtr->xFreeColors) /* 38 */ -#endif -#ifndef XFreeCursor #define XFreeCursor \ (tkIntXlibStubsPtr->xFreeCursor) /* 39 */ -#endif -#ifndef XFreeModifiermap #define XFreeModifiermap \ (tkIntXlibStubsPtr->xFreeModifiermap) /* 40 */ -#endif -#ifndef XGetGeometry #define XGetGeometry \ (tkIntXlibStubsPtr->xGetGeometry) /* 41 */ -#endif -#ifndef XGetInputFocus #define XGetInputFocus \ (tkIntXlibStubsPtr->xGetInputFocus) /* 42 */ -#endif -#ifndef XGetWindowProperty #define XGetWindowProperty \ (tkIntXlibStubsPtr->xGetWindowProperty) /* 43 */ -#endif -#ifndef XGetWindowAttributes #define XGetWindowAttributes \ (tkIntXlibStubsPtr->xGetWindowAttributes) /* 44 */ -#endif -#ifndef XGrabKeyboard #define XGrabKeyboard \ (tkIntXlibStubsPtr->xGrabKeyboard) /* 45 */ -#endif -#ifndef XGrabPointer #define XGrabPointer \ (tkIntXlibStubsPtr->xGrabPointer) /* 46 */ -#endif -#ifndef XKeysymToKeycode #define XKeysymToKeycode \ (tkIntXlibStubsPtr->xKeysymToKeycode) /* 47 */ -#endif -#ifndef XLookupColor #define XLookupColor \ (tkIntXlibStubsPtr->xLookupColor) /* 48 */ -#endif -#ifndef XMapWindow #define XMapWindow \ (tkIntXlibStubsPtr->xMapWindow) /* 49 */ -#endif -#ifndef XMoveResizeWindow #define XMoveResizeWindow \ (tkIntXlibStubsPtr->xMoveResizeWindow) /* 50 */ -#endif -#ifndef XMoveWindow #define XMoveWindow \ (tkIntXlibStubsPtr->xMoveWindow) /* 51 */ -#endif -#ifndef XNextEvent #define XNextEvent \ (tkIntXlibStubsPtr->xNextEvent) /* 52 */ -#endif -#ifndef XPutBackEvent #define XPutBackEvent \ (tkIntXlibStubsPtr->xPutBackEvent) /* 53 */ -#endif -#ifndef XQueryColors #define XQueryColors \ (tkIntXlibStubsPtr->xQueryColors) /* 54 */ -#endif -#ifndef XQueryPointer #define XQueryPointer \ (tkIntXlibStubsPtr->xQueryPointer) /* 55 */ -#endif -#ifndef XQueryTree #define XQueryTree \ (tkIntXlibStubsPtr->xQueryTree) /* 56 */ -#endif -#ifndef XRaiseWindow #define XRaiseWindow \ (tkIntXlibStubsPtr->xRaiseWindow) /* 57 */ -#endif -#ifndef XRefreshKeyboardMapping #define XRefreshKeyboardMapping \ (tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 58 */ -#endif -#ifndef XResizeWindow #define XResizeWindow \ (tkIntXlibStubsPtr->xResizeWindow) /* 59 */ -#endif -#ifndef XSelectInput #define XSelectInput \ (tkIntXlibStubsPtr->xSelectInput) /* 60 */ -#endif -#ifndef XSendEvent #define XSendEvent \ (tkIntXlibStubsPtr->xSendEvent) /* 61 */ -#endif -#ifndef XSetCommand #define XSetCommand \ (tkIntXlibStubsPtr->xSetCommand) /* 62 */ -#endif -#ifndef XSetIconName #define XSetIconName \ (tkIntXlibStubsPtr->xSetIconName) /* 63 */ -#endif -#ifndef XSetInputFocus #define XSetInputFocus \ (tkIntXlibStubsPtr->xSetInputFocus) /* 64 */ -#endif -#ifndef XSetSelectionOwner #define XSetSelectionOwner \ (tkIntXlibStubsPtr->xSetSelectionOwner) /* 65 */ -#endif -#ifndef XSetWindowBackground #define XSetWindowBackground \ (tkIntXlibStubsPtr->xSetWindowBackground) /* 66 */ -#endif -#ifndef XSetWindowBackgroundPixmap #define XSetWindowBackgroundPixmap \ (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 67 */ -#endif -#ifndef XSetWindowBorder #define XSetWindowBorder \ (tkIntXlibStubsPtr->xSetWindowBorder) /* 68 */ -#endif -#ifndef XSetWindowBorderPixmap #define XSetWindowBorderPixmap \ (tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 69 */ -#endif -#ifndef XSetWindowBorderWidth #define XSetWindowBorderWidth \ (tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 70 */ -#endif -#ifndef XSetWindowColormap #define XSetWindowColormap \ (tkIntXlibStubsPtr->xSetWindowColormap) /* 71 */ -#endif -#ifndef XTranslateCoordinates #define XTranslateCoordinates \ (tkIntXlibStubsPtr->xTranslateCoordinates) /* 72 */ -#endif -#ifndef XUngrabKeyboard #define XUngrabKeyboard \ (tkIntXlibStubsPtr->xUngrabKeyboard) /* 73 */ -#endif -#ifndef XUngrabPointer #define XUngrabPointer \ (tkIntXlibStubsPtr->xUngrabPointer) /* 74 */ -#endif -#ifndef XUnmapWindow #define XUnmapWindow \ (tkIntXlibStubsPtr->xUnmapWindow) /* 75 */ -#endif -#ifndef XWindowEvent #define XWindowEvent \ (tkIntXlibStubsPtr->xWindowEvent) /* 76 */ -#endif -#ifndef XDestroyIC #define XDestroyIC \ (tkIntXlibStubsPtr->xDestroyIC) /* 77 */ -#endif -#ifndef XFilterEvent #define XFilterEvent \ (tkIntXlibStubsPtr->xFilterEvent) /* 78 */ -#endif -#ifndef XmbLookupString #define XmbLookupString \ (tkIntXlibStubsPtr->xmbLookupString) /* 79 */ -#endif -#ifndef TkPutImage #define TkPutImage \ (tkIntXlibStubsPtr->tkPutImage) /* 80 */ -#endif /* Slot 81 is reserved */ -#ifndef XParseColor #define XParseColor \ (tkIntXlibStubsPtr->xParseColor) /* 82 */ -#endif -#ifndef XCreateGC #define XCreateGC \ (tkIntXlibStubsPtr->xCreateGC) /* 83 */ -#endif -#ifndef XFreeGC #define XFreeGC \ (tkIntXlibStubsPtr->xFreeGC) /* 84 */ -#endif -#ifndef XInternAtom #define XInternAtom \ (tkIntXlibStubsPtr->xInternAtom) /* 85 */ -#endif -#ifndef XSetBackground #define XSetBackground \ (tkIntXlibStubsPtr->xSetBackground) /* 86 */ -#endif -#ifndef XSetForeground #define XSetForeground \ (tkIntXlibStubsPtr->xSetForeground) /* 87 */ -#endif -#ifndef XSetClipMask #define XSetClipMask \ (tkIntXlibStubsPtr->xSetClipMask) /* 88 */ -#endif -#ifndef XSetClipOrigin #define XSetClipOrigin \ (tkIntXlibStubsPtr->xSetClipOrigin) /* 89 */ -#endif -#ifndef XSetTSOrigin #define XSetTSOrigin \ (tkIntXlibStubsPtr->xSetTSOrigin) /* 90 */ -#endif -#ifndef XChangeGC #define XChangeGC \ (tkIntXlibStubsPtr->xChangeGC) /* 91 */ -#endif -#ifndef XSetFont #define XSetFont \ (tkIntXlibStubsPtr->xSetFont) /* 92 */ -#endif -#ifndef XSetArcMode #define XSetArcMode \ (tkIntXlibStubsPtr->xSetArcMode) /* 93 */ -#endif -#ifndef XSetStipple #define XSetStipple \ (tkIntXlibStubsPtr->xSetStipple) /* 94 */ -#endif -#ifndef XSetFillRule #define XSetFillRule \ (tkIntXlibStubsPtr->xSetFillRule) /* 95 */ -#endif -#ifndef XSetFillStyle #define XSetFillStyle \ (tkIntXlibStubsPtr->xSetFillStyle) /* 96 */ -#endif -#ifndef XSetFunction #define XSetFunction \ (tkIntXlibStubsPtr->xSetFunction) /* 97 */ -#endif -#ifndef XSetLineAttributes #define XSetLineAttributes \ (tkIntXlibStubsPtr->xSetLineAttributes) /* 98 */ -#endif -#ifndef _XInitImageFuncPtrs #define _XInitImageFuncPtrs \ (tkIntXlibStubsPtr->_XInitImageFuncPtrs) /* 99 */ -#endif -#ifndef XCreateIC #define XCreateIC \ (tkIntXlibStubsPtr->xCreateIC) /* 100 */ -#endif -#ifndef XGetVisualInfo #define XGetVisualInfo \ (tkIntXlibStubsPtr->xGetVisualInfo) /* 101 */ -#endif -#ifndef XSetWMClientMachine #define XSetWMClientMachine \ (tkIntXlibStubsPtr->xSetWMClientMachine) /* 102 */ -#endif -#ifndef XStringListToTextProperty #define XStringListToTextProperty \ (tkIntXlibStubsPtr->xStringListToTextProperty) /* 103 */ -#endif -#ifndef XDrawLine #define XDrawLine \ (tkIntXlibStubsPtr->xDrawLine) /* 104 */ -#endif -#ifndef XWarpPointer #define XWarpPointer \ (tkIntXlibStubsPtr->xWarpPointer) /* 105 */ -#endif -#ifndef XFillRectangle #define XFillRectangle \ (tkIntXlibStubsPtr->xFillRectangle) /* 106 */ -#endif -#ifndef XFlush #define XFlush \ (tkIntXlibStubsPtr->xFlush) /* 107 */ -#endif -#ifndef XGrabServer #define XGrabServer \ (tkIntXlibStubsPtr->xGrabServer) /* 108 */ -#endif -#ifndef XUngrabServer #define XUngrabServer \ (tkIntXlibStubsPtr->xUngrabServer) /* 109 */ -#endif -#ifndef XFree #define XFree \ (tkIntXlibStubsPtr->xFree) /* 110 */ -#endif -#ifndef XNoOp #define XNoOp \ (tkIntXlibStubsPtr->xNoOp) /* 111 */ -#endif -#ifndef XSynchronize #define XSynchronize \ (tkIntXlibStubsPtr->xSynchronize) /* 112 */ -#endif -#ifndef XSync #define XSync \ (tkIntXlibStubsPtr->xSync) /* 113 */ -#endif -#ifndef XVisualIDFromVisual #define XVisualIDFromVisual \ (tkIntXlibStubsPtr->xVisualIDFromVisual) /* 114 */ -#endif #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef XSetDashes #define XSetDashes \ (tkIntXlibStubsPtr->xSetDashes) /* 0 */ -#endif -#ifndef XGetModifierMapping #define XGetModifierMapping \ (tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */ -#endif -#ifndef XCreateImage #define XCreateImage \ (tkIntXlibStubsPtr->xCreateImage) /* 2 */ -#endif -#ifndef XGetImage #define XGetImage \ (tkIntXlibStubsPtr->xGetImage) /* 3 */ -#endif -#ifndef XGetAtomName #define XGetAtomName \ (tkIntXlibStubsPtr->xGetAtomName) /* 4 */ -#endif -#ifndef XKeysymToString #define XKeysymToString \ (tkIntXlibStubsPtr->xKeysymToString) /* 5 */ -#endif -#ifndef XCreateColormap #define XCreateColormap \ (tkIntXlibStubsPtr->xCreateColormap) /* 6 */ -#endif -#ifndef XGContextFromGC #define XGContextFromGC \ (tkIntXlibStubsPtr->xGContextFromGC) /* 7 */ -#endif -#ifndef XKeycodeToKeysym #define XKeycodeToKeysym \ (tkIntXlibStubsPtr->xKeycodeToKeysym) /* 8 */ -#endif -#ifndef XStringToKeysym #define XStringToKeysym \ (tkIntXlibStubsPtr->xStringToKeysym) /* 9 */ -#endif -#ifndef XRootWindow #define XRootWindow \ (tkIntXlibStubsPtr->xRootWindow) /* 10 */ -#endif -#ifndef XSetErrorHandler #define XSetErrorHandler \ (tkIntXlibStubsPtr->xSetErrorHandler) /* 11 */ -#endif -#ifndef XAllocColor #define XAllocColor \ (tkIntXlibStubsPtr->xAllocColor) /* 12 */ -#endif -#ifndef XBell #define XBell \ (tkIntXlibStubsPtr->xBell) /* 13 */ -#endif -#ifndef XChangeProperty #define XChangeProperty \ (tkIntXlibStubsPtr->xChangeProperty) /* 14 */ -#endif -#ifndef XChangeWindowAttributes #define XChangeWindowAttributes \ (tkIntXlibStubsPtr->xChangeWindowAttributes) /* 15 */ -#endif -#ifndef XConfigureWindow #define XConfigureWindow \ (tkIntXlibStubsPtr->xConfigureWindow) /* 16 */ -#endif -#ifndef XCopyArea #define XCopyArea \ (tkIntXlibStubsPtr->xCopyArea) /* 17 */ -#endif -#ifndef XCopyPlane #define XCopyPlane \ (tkIntXlibStubsPtr->xCopyPlane) /* 18 */ -#endif -#ifndef XCreateBitmapFromData #define XCreateBitmapFromData \ (tkIntXlibStubsPtr->xCreateBitmapFromData) /* 19 */ -#endif -#ifndef XDefineCursor #define XDefineCursor \ (tkIntXlibStubsPtr->xDefineCursor) /* 20 */ -#endif -#ifndef XDestroyWindow #define XDestroyWindow \ (tkIntXlibStubsPtr->xDestroyWindow) /* 21 */ -#endif -#ifndef XDrawArc #define XDrawArc \ (tkIntXlibStubsPtr->xDrawArc) /* 22 */ -#endif -#ifndef XDrawLines #define XDrawLines \ (tkIntXlibStubsPtr->xDrawLines) /* 23 */ -#endif -#ifndef XDrawRectangle #define XDrawRectangle \ (tkIntXlibStubsPtr->xDrawRectangle) /* 24 */ -#endif -#ifndef XFillArc #define XFillArc \ (tkIntXlibStubsPtr->xFillArc) /* 25 */ -#endif -#ifndef XFillPolygon #define XFillPolygon \ (tkIntXlibStubsPtr->xFillPolygon) /* 26 */ -#endif -#ifndef XFillRectangles #define XFillRectangles \ (tkIntXlibStubsPtr->xFillRectangles) /* 27 */ -#endif -#ifndef XFreeColormap #define XFreeColormap \ (tkIntXlibStubsPtr->xFreeColormap) /* 28 */ -#endif -#ifndef XFreeColors #define XFreeColors \ (tkIntXlibStubsPtr->xFreeColors) /* 29 */ -#endif -#ifndef XFreeModifiermap #define XFreeModifiermap \ (tkIntXlibStubsPtr->xFreeModifiermap) /* 30 */ -#endif -#ifndef XGetGeometry #define XGetGeometry \ (tkIntXlibStubsPtr->xGetGeometry) /* 31 */ -#endif -#ifndef XGetWindowProperty #define XGetWindowProperty \ (tkIntXlibStubsPtr->xGetWindowProperty) /* 32 */ -#endif -#ifndef XGrabKeyboard #define XGrabKeyboard \ (tkIntXlibStubsPtr->xGrabKeyboard) /* 33 */ -#endif -#ifndef XGrabPointer #define XGrabPointer \ (tkIntXlibStubsPtr->xGrabPointer) /* 34 */ -#endif -#ifndef XKeysymToKeycode #define XKeysymToKeycode \ (tkIntXlibStubsPtr->xKeysymToKeycode) /* 35 */ -#endif -#ifndef XMapWindow #define XMapWindow \ (tkIntXlibStubsPtr->xMapWindow) /* 36 */ -#endif -#ifndef XMoveResizeWindow #define XMoveResizeWindow \ (tkIntXlibStubsPtr->xMoveResizeWindow) /* 37 */ -#endif -#ifndef XMoveWindow #define XMoveWindow \ (tkIntXlibStubsPtr->xMoveWindow) /* 38 */ -#endif -#ifndef XQueryPointer #define XQueryPointer \ (tkIntXlibStubsPtr->xQueryPointer) /* 39 */ -#endif -#ifndef XRaiseWindow #define XRaiseWindow \ (tkIntXlibStubsPtr->xRaiseWindow) /* 40 */ -#endif -#ifndef XRefreshKeyboardMapping #define XRefreshKeyboardMapping \ (tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 41 */ -#endif -#ifndef XResizeWindow #define XResizeWindow \ (tkIntXlibStubsPtr->xResizeWindow) /* 42 */ -#endif -#ifndef XSelectInput #define XSelectInput \ (tkIntXlibStubsPtr->xSelectInput) /* 43 */ -#endif -#ifndef XSendEvent #define XSendEvent \ (tkIntXlibStubsPtr->xSendEvent) /* 44 */ -#endif -#ifndef XSetIconName #define XSetIconName \ (tkIntXlibStubsPtr->xSetIconName) /* 45 */ -#endif -#ifndef XSetInputFocus #define XSetInputFocus \ (tkIntXlibStubsPtr->xSetInputFocus) /* 46 */ -#endif -#ifndef XSetSelectionOwner #define XSetSelectionOwner \ (tkIntXlibStubsPtr->xSetSelectionOwner) /* 47 */ -#endif -#ifndef XSetWindowBackground #define XSetWindowBackground \ (tkIntXlibStubsPtr->xSetWindowBackground) /* 48 */ -#endif -#ifndef XSetWindowBackgroundPixmap #define XSetWindowBackgroundPixmap \ (tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 49 */ -#endif -#ifndef XSetWindowBorder #define XSetWindowBorder \ (tkIntXlibStubsPtr->xSetWindowBorder) /* 50 */ -#endif -#ifndef XSetWindowBorderPixmap #define XSetWindowBorderPixmap \ (tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 51 */ -#endif -#ifndef XSetWindowBorderWidth #define XSetWindowBorderWidth \ (tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 52 */ -#endif -#ifndef XSetWindowColormap #define XSetWindowColormap \ (tkIntXlibStubsPtr->xSetWindowColormap) /* 53 */ -#endif -#ifndef XUngrabKeyboard #define XUngrabKeyboard \ (tkIntXlibStubsPtr->xUngrabKeyboard) /* 54 */ -#endif -#ifndef XUngrabPointer #define XUngrabPointer \ (tkIntXlibStubsPtr->xUngrabPointer) /* 55 */ -#endif -#ifndef XUnmapWindow #define XUnmapWindow \ (tkIntXlibStubsPtr->xUnmapWindow) /* 56 */ -#endif -#ifndef TkPutImage #define TkPutImage \ (tkIntXlibStubsPtr->tkPutImage) /* 57 */ -#endif -#ifndef XParseColor #define XParseColor \ (tkIntXlibStubsPtr->xParseColor) /* 58 */ -#endif -#ifndef XCreateGC #define XCreateGC \ (tkIntXlibStubsPtr->xCreateGC) /* 59 */ -#endif -#ifndef XFreeGC #define XFreeGC \ (tkIntXlibStubsPtr->xFreeGC) /* 60 */ -#endif -#ifndef XInternAtom #define XInternAtom \ (tkIntXlibStubsPtr->xInternAtom) /* 61 */ -#endif -#ifndef XSetBackground #define XSetBackground \ (tkIntXlibStubsPtr->xSetBackground) /* 62 */ -#endif -#ifndef XSetForeground #define XSetForeground \ (tkIntXlibStubsPtr->xSetForeground) /* 63 */ -#endif -#ifndef XSetClipMask #define XSetClipMask \ (tkIntXlibStubsPtr->xSetClipMask) /* 64 */ -#endif -#ifndef XSetClipOrigin #define XSetClipOrigin \ (tkIntXlibStubsPtr->xSetClipOrigin) /* 65 */ -#endif -#ifndef XSetTSOrigin #define XSetTSOrigin \ (tkIntXlibStubsPtr->xSetTSOrigin) /* 66 */ -#endif -#ifndef XChangeGC #define XChangeGC \ (tkIntXlibStubsPtr->xChangeGC) /* 67 */ -#endif -#ifndef XSetFont #define XSetFont \ (tkIntXlibStubsPtr->xSetFont) /* 68 */ -#endif -#ifndef XSetArcMode #define XSetArcMode \ (tkIntXlibStubsPtr->xSetArcMode) /* 69 */ -#endif -#ifndef XSetStipple #define XSetStipple \ (tkIntXlibStubsPtr->xSetStipple) /* 70 */ -#endif -#ifndef XSetFillRule #define XSetFillRule \ (tkIntXlibStubsPtr->xSetFillRule) /* 71 */ -#endif -#ifndef XSetFillStyle #define XSetFillStyle \ (tkIntXlibStubsPtr->xSetFillStyle) /* 72 */ -#endif -#ifndef XSetFunction #define XSetFunction \ (tkIntXlibStubsPtr->xSetFunction) /* 73 */ -#endif -#ifndef XSetLineAttributes #define XSetLineAttributes \ (tkIntXlibStubsPtr->xSetLineAttributes) /* 74 */ -#endif -#ifndef _XInitImageFuncPtrs #define _XInitImageFuncPtrs \ (tkIntXlibStubsPtr->_XInitImageFuncPtrs) /* 75 */ -#endif -#ifndef XCreateIC #define XCreateIC \ (tkIntXlibStubsPtr->xCreateIC) /* 76 */ -#endif -#ifndef XGetVisualInfo #define XGetVisualInfo \ (tkIntXlibStubsPtr->xGetVisualInfo) /* 77 */ -#endif -#ifndef XSetWMClientMachine #define XSetWMClientMachine \ (tkIntXlibStubsPtr->xSetWMClientMachine) /* 78 */ -#endif -#ifndef XStringListToTextProperty #define XStringListToTextProperty \ (tkIntXlibStubsPtr->xStringListToTextProperty) /* 79 */ -#endif -#ifndef XDrawSegments #define XDrawSegments \ (tkIntXlibStubsPtr->xDrawSegments) /* 80 */ -#endif -#ifndef XForceScreenSaver #define XForceScreenSaver \ (tkIntXlibStubsPtr->xForceScreenSaver) /* 81 */ -#endif -#ifndef XDrawLine #define XDrawLine \ (tkIntXlibStubsPtr->xDrawLine) /* 82 */ -#endif -#ifndef XFillRectangle #define XFillRectangle \ (tkIntXlibStubsPtr->xFillRectangle) /* 83 */ -#endif -#ifndef XClearWindow #define XClearWindow \ (tkIntXlibStubsPtr->xClearWindow) /* 84 */ -#endif -#ifndef XDrawPoint #define XDrawPoint \ (tkIntXlibStubsPtr->xDrawPoint) /* 85 */ -#endif -#ifndef XDrawPoints #define XDrawPoints \ (tkIntXlibStubsPtr->xDrawPoints) /* 86 */ -#endif -#ifndef XWarpPointer #define XWarpPointer \ (tkIntXlibStubsPtr->xWarpPointer) /* 87 */ -#endif -#ifndef XQueryColor #define XQueryColor \ (tkIntXlibStubsPtr->xQueryColor) /* 88 */ -#endif -#ifndef XQueryColors #define XQueryColors \ (tkIntXlibStubsPtr->xQueryColors) /* 89 */ -#endif -#ifndef XQueryTree #define XQueryTree \ (tkIntXlibStubsPtr->xQueryTree) /* 90 */ -#endif -#ifndef XSync #define XSync \ (tkIntXlibStubsPtr->xSync) /* 91 */ -#endif #endif /* AQUA */ -#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ +#endif /* defined(USE_TK_STUBS) */ /* !END!: Do not edit above this line. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#if defined(__WIN32__) - -#undef XFlush -#undef XGrabServer -#undef XUngrabServer -#undef XFree -#undef XNoOp -#undef XSynchronize -#undef XSync -#undef XVisualIDFromVisual - -#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) -/* - * The following stubs implement various calls that don't do anything - * under Windows. In win32 tclsh 8.4 and 8.5 holds: - * tkIntStubsPtr->tkBindDeadWindow != NULL - * Then the following macros don't do anything. But when running Tcl win32 - * version 8.6 or Cygwin (8.4, 8.5 or 8.6) then the functions are available in - * the stub table. The real function from the stub table will be called, - * even though it might be doing nothing. - */ - -#define XFlush(display) (tkIntStubsPtr->tkBindDeadWindow? 0: tkIntXlibStubsPtr->xFlush(display)) -#define XGrabServer(display) (tkIntStubsPtr->tkBindDeadWindow? 0: tkIntXlibStubsPtr->xGrabServer(display)) -#define XUngrabServer(display) (tkIntStubsPtr->tkBindDeadWindow? 0: tkIntXlibStubsPtr->xUngrabServer(display)) - -/* - * The following functions are implemented as macros under Windows. - */ - - -#define XFree(data) (tkIntStubsPtr->tkBindDeadWindow? ((data)? (ckfree((char *) (data)), 0): 0): tkIntXlibStubsPtr->xFree(data)) -#define XNoOp(display) (tkIntStubsPtr->tkBindDeadWindow? 0: tkIntXlibStubsPtr->xNoOp(display)) -#define XSynchronize(display, bool) (tkIntStubsPtr->tkBindDeadWindow? 0: tkIntXlibStubsPtr->xSynchronize(display, bool)) -#define XSync(display, bool) (tkIntStubsPtr->tkBindDeadWindow? 0: tkIntXlibStubsPtr->xSync(display, bool)) -#define XVisualIDFromVisual(visual) (tkIntStubsPtr->tkBindDeadWindow? ((visual)->visualid): tkIntXlibStubsPtr->xVisualIDFromVisual(visual)) - -#else /* !USE_TK_STUBS */ -/* - * The following stubs implement various calls that don't do anything - * under Windows. - */ - -#define XFlush(display) -#define XGrabServer(display) -#define XUngrabServer(display) - -/* - * The following functions are implemented as macros under Windows. - */ - -#define XFree(data) {if ((data) != NULL) ckfree((char *) (data));} -#define XNoOp(display) {display->request++;} -#define XSynchronize(display, bool) {display->request++;} -#define XSync(display, bool) {display->request++;} -#define XVisualIDFromVisual(visual) (visual->visualid) - -#endif /* !USE_TK_STUBS */ - -#endif /* __WIN32__ */ - #endif /* _TKINTXLIBDECLS */ diff --git a/generic/tkListbox.c b/generic/tkListbox.c index 248dd7b..1843bbb 100644 --- a/generic/tkListbox.c +++ b/generic/tkListbox.c @@ -15,7 +15,7 @@ #include "default.h" #include "tkInt.h" -#ifdef WIN32 +#ifdef _WIN32 #include "tkWinInt.h" #endif @@ -24,7 +24,7 @@ typedef struct { /* Table defining configuration options * available for the listbox. */ Tk_OptionTable itemAttrOptionTable; - /* Table definining configuration options + /* Table defining configuration options * available for listbox items. */ } ListboxOptionTables; @@ -168,6 +168,13 @@ typedef struct { } Listbox; /* + * How to encode the keys for the hash tables used to store what items are + * selected and what the attributes are. + */ + +#define KEY(i) ((char *) INT2PTR(i)) + +/* * ItemAttr structures are used to store item configuration information for * the items in a listbox */ @@ -231,14 +238,14 @@ static const char *const activeStyleStrings[] = { static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_STRING_TABLE, "-activestyle", "activeStyle", "ActiveStyle", DEF_LISTBOX_ACTIVE_STYLE, -1, Tk_Offset(Listbox, activeStyle), - 0, (ClientData) activeStyleStrings, 0}, + 0, activeStyleStrings, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_LISTBOX_BG_COLOR, -1, Tk_Offset(Listbox, normalBorder), - 0, (ClientData) DEF_LISTBOX_BG_MONO, 0}, + 0, DEF_LISTBOX_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_LISTBOX_BORDER_WIDTH, -1, Tk_Offset(Listbox, borderWidth), 0, 0, 0}, @@ -252,7 +259,7 @@ static const Tk_OptionSpec optionSpecs[] = { "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION, -1, Tk_Offset(Listbox, exportSelection), 0, 0, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_LISTBOX_FONT, -1, Tk_Offset(Listbox, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", @@ -272,13 +279,13 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_LISTBOX_RELIEF, -1, Tk_Offset(Listbox, relief), 0, 0, 0}, {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground", DEF_LISTBOX_SELECT_COLOR, -1, Tk_Offset(Listbox, selBorder), - 0, (ClientData) DEF_LISTBOX_SELECT_MONO, 0}, + 0, DEF_LISTBOX_SELECT_MONO, 0}, {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", DEF_LISTBOX_SELECT_BD, -1, Tk_Offset(Listbox, selBorderWidth), 0, 0, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", DEF_LISTBOX_SELECT_FG_COLOR, -1, Tk_Offset(Listbox, selFgColorPtr), - TK_CONFIG_NULL_OK, (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0}, + TK_CONFIG_NULL_OK, DEF_LISTBOX_SELECT_FG_MONO, 0}, {TK_OPTION_STRING, "-selectmode", "selectMode", "SelectMode", DEF_LISTBOX_SELECT_MODE, -1, Tk_Offset(Listbox, selectMode), TK_OPTION_NULL_OK, 0, 0}, @@ -286,7 +293,7 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_LISTBOX_SET_GRID, -1, Tk_Offset(Listbox, setGrid), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_LISTBOX_STATE, -1, Tk_Offset(Listbox, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_LISTBOX_TAKE_FOCUS, -1, Tk_Offset(Listbox, takeFocus), TK_OPTION_NULL_OK, 0, 0}, @@ -313,22 +320,22 @@ static const Tk_OptionSpec itemAttrOptionSpecs[] = { {TK_OPTION_BORDER, "-background", "background", "Background", NULL, -1, Tk_Offset(ItemAttr, border), TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, - (ClientData) DEF_LISTBOX_BG_MONO, 0}, + DEF_LISTBOX_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", NULL, -1, Tk_Offset(ItemAttr, fgColor), TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, 0, 0}, {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground", NULL, -1, Tk_Offset(ItemAttr, selBorder), TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, - (ClientData) DEF_LISTBOX_SELECT_MONO, 0}, + DEF_LISTBOX_SELECT_MONO, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", NULL, -1, Tk_Offset(ItemAttr, selFgColor), TK_OPTION_NULL_OK|TK_OPTION_DONT_SET_DEFAULT, - (ClientData) DEF_LISTBOX_SELECT_FG_MONO, 0}, + DEF_LISTBOX_SELECT_FG_MONO, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, 0, 0} }; @@ -338,7 +345,7 @@ static const Tk_OptionSpec itemAttrOptionSpecs[] = { * dispatch the listbox widget command. */ -static const char *commandNames[] = { +static const char *const commandNames[] = { "activate", "bbox", "cget", "configure", "curselection", "delete", "get", "index", "insert", "itemcget", "itemconfigure", "nearest", "scan", "see", "selection", "size", "xview", "yview", NULL @@ -351,21 +358,21 @@ enum command { COMMAND_SIZE, COMMAND_XVIEW, COMMAND_YVIEW }; -static const char *selCommandNames[] = { +static const char *const selCommandNames[] = { "anchor", "clear", "includes", "set", NULL }; enum selcommand { SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET }; -static const char *scanCommandNames[] = { +static const char *const scanCommandNames[] = { "mark", "dragto", NULL }; enum scancommand { SCAN_MARK, SCAN_DRAGTO }; -static const char *indexNames[] = { +static const char *const indexNames[] = { "active", "anchor", "end", NULL }; enum indices { @@ -385,7 +392,7 @@ static int ConfigureListboxItem(Tcl_Interp *interp, Tcl_Obj *const objv[], int index); static int ListboxDeleteSubCmd(Listbox *listPtr, int first, int last); -static void DestroyListbox(char *memPtr); +static void DestroyListbox(void *memPtr); static void DestroyListboxOptionTables(ClientData clientData, Tcl_Interp *interp); static void DisplayListbox(ClientData clientData); @@ -401,6 +408,7 @@ static void ListboxEventProc(ClientData clientData, static int ListboxFetchSelection(ClientData clientData, int offset, char *buffer, int maxBytes); static void ListboxLostSelection(ClientData clientData); +static void GenerateListboxSelectEvent(Listbox *listPtr); static void EventuallyRedrawRange(Listbox *listPtr, int first, int last); static void ListboxScanTo(Listbox *listPtr, int x, int y); @@ -434,11 +442,11 @@ static void MigrateHashEntries(Tcl_HashTable *table, * that can be invoked from generic window code. */ -static Tk_ClassProcs listboxClass = { +static const Tk_ClassProcs listboxClass = { sizeof(Tk_ClassProcs), /* size */ ListboxWorldChanged, /* worldChangedProc */ - NULL, /* createProc */ - NULL /* modalProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -470,7 +478,7 @@ Tk_ListboxObjCmd( ListboxOptionTables *optionTables; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -480,8 +488,7 @@ Tk_ListboxObjCmd( return TCL_ERROR; } - optionTables = (ListboxOptionTables *) - Tcl_GetAssocData(interp, "ListboxOptionTables", NULL); + optionTables = Tcl_GetAssocData(interp, "ListboxOptionTables", NULL); if (optionTables == NULL) { /* * We haven't created the option tables for this widget class yet. Do @@ -489,15 +496,14 @@ Tk_ListboxObjCmd( * command, so future invocations will have access to it. */ - optionTables = (ListboxOptionTables *) - ckalloc(sizeof(ListboxOptionTables)); + optionTables = ckalloc(sizeof(ListboxOptionTables)); /* * Set up an exit handler to free the optionTables struct. */ Tcl_SetAssocData(interp, "ListboxOptionTables", - DestroyListboxOptionTables, (ClientData) optionTables); + DestroyListboxOptionTables, optionTables); /* * Create the listbox option table and the listbox item option table. @@ -515,22 +521,20 @@ Tk_ListboxObjCmd( * already (e.g. resource pointers). */ - listPtr = (Listbox *) ckalloc(sizeof(Listbox)); - memset(listPtr, 0, (sizeof(Listbox))); + listPtr = ckalloc(sizeof(Listbox)); + memset(listPtr, 0, sizeof(Listbox)); listPtr->tkwin = tkwin; listPtr->display = Tk_Display(tkwin); listPtr->interp = interp; listPtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(listPtr->tkwin), ListboxWidgetObjCmd, - (ClientData) listPtr, ListboxCmdDeletedProc); + Tk_PathName(listPtr->tkwin), ListboxWidgetObjCmd, listPtr, + ListboxCmdDeletedProc); listPtr->optionTable = optionTables->listboxOptionTable; listPtr->itemAttrOptionTable = optionTables->itemAttrOptionTable; - listPtr->selection = (Tcl_HashTable *) - ckalloc(sizeof(Tcl_HashTable)); + listPtr->selection = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(listPtr->selection, TCL_ONE_WORD_KEYS); - listPtr->itemAttrTable = (Tcl_HashTable *) - ckalloc(sizeof(Tcl_HashTable)); + listPtr->itemAttrTable = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(listPtr->itemAttrTable, TCL_ONE_WORD_KEYS); listPtr->relief = TK_RELIEF_RAISED; listPtr->textGC = None; @@ -548,15 +552,15 @@ Tk_ListboxObjCmd( * otherwise Tk might free it while we still need it. */ - Tcl_Preserve((ClientData) listPtr->tkwin); + Tcl_Preserve(listPtr->tkwin); Tk_SetClass(listPtr->tkwin, "Listbox"); - Tk_SetClassProcs(listPtr->tkwin, &listboxClass, (ClientData) listPtr); + Tk_SetClassProcs(listPtr->tkwin, &listboxClass, listPtr); Tk_CreateEventHandler(listPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - ListboxEventProc, (ClientData) listPtr); + ListboxEventProc, listPtr); Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING, - ListboxFetchSelection, (ClientData) listPtr, XA_STRING); + ListboxFetchSelection, listPtr, XA_STRING); if (Tk_InitOptions(interp, (char *)listPtr, optionTables->listboxOptionTable, tkwin) != TCL_OK) { Tk_DestroyWindow(listPtr->tkwin); @@ -568,7 +572,7 @@ Tk_ListboxObjCmd( return TCL_ERROR; } - Tcl_SetResult(interp, Tk_PathName(listPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(listPtr->tkwin)); return TCL_OK; } @@ -597,12 +601,13 @@ ListboxWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Arguments as Tcl_Obj's. */ { - register Listbox *listPtr = (Listbox *) clientData; + register Listbox *listPtr = clientData; int cmdIndex, index; int result = TCL_OK; + Tcl_Obj *objPtr; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } @@ -617,7 +622,7 @@ ListboxWidgetObjCmd( return result; } - Tcl_Preserve((ClientData)listPtr); + Tcl_Preserve(listPtr); /* * The subcommand was valid, so continue processing. @@ -664,9 +669,7 @@ ListboxWidgetObjCmd( result = ListboxBboxSubCmd(interp, listPtr, index); break; - case COMMAND_CGET: { - Tcl_Obj *objPtr; - + case COMMAND_CGET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "option"); result = TCL_ERROR; @@ -682,11 +685,8 @@ ListboxWidgetObjCmd( Tcl_SetObjResult(interp, objPtr); result = TCL_OK; break; - } - - case COMMAND_CONFIGURE: { - Tcl_Obj *objPtr; + case COMMAND_CONFIGURE: if (objc <= 3) { objPtr = Tk_GetOptionInfo(interp, (char *) listPtr, listPtr->optionTable, @@ -694,18 +694,15 @@ ListboxWidgetObjCmd( if (objPtr == NULL) { result = TCL_ERROR; break; - } else { - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; } + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; } else { result = ConfigureListbox(interp, listPtr, objc-2, objv+2, 0); } break; - } case COMMAND_CURSELECTION: { - char indexStringRep[TCL_INTEGER_SPACE]; int i; if (objc != 2) { @@ -722,12 +719,13 @@ ListboxWidgetObjCmd( * selected. */ + objPtr = Tcl_NewObj(); for (i = 0; i < listPtr->nElements; i++) { - if (Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i))) { - sprintf(indexStringRep, "%d", i); - Tcl_AppendElement(interp, indexStringRep); + if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) { + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(i)); } } + Tcl_SetObjResult(interp, objPtr); result = TCL_OK; break; } @@ -820,8 +818,8 @@ ListboxWidgetObjCmd( Tcl_SetObjResult(interp, elemPtrs[first]); } else { - Tcl_SetListObj(Tcl_GetObjResult(interp), (last - first + 1), - &(elemPtrs[first])); + Tcl_SetObjResult(interp, + Tcl_NewListObj(last-first+1, elemPtrs+first)); } result = TCL_OK; break; @@ -843,7 +841,7 @@ ListboxWidgetObjCmd( case COMMAND_INSERT: if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "index ?element element ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "index ?element ...?"); result = TCL_ERROR; break; } @@ -861,7 +859,6 @@ ListboxWidgetObjCmd( break; case COMMAND_ITEMCGET: { - Tcl_Obj *objPtr; ItemAttr *attrPtr; if (objc != 4) { @@ -876,8 +873,10 @@ ListboxWidgetObjCmd( } if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", - Tcl_GetString(objv[2]), "\" out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item number \"%s\" out of range", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", NULL); result = TCL_ERROR; break; } @@ -896,12 +895,11 @@ ListboxWidgetObjCmd( } case COMMAND_ITEMCONFIGURE: { - Tcl_Obj *objPtr; ItemAttr *attrPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, - "index ?option? ?value? ?option value ...?"); + "index ?-option? ?value? ?-option value ...?"); result = TCL_ERROR; break; } @@ -912,8 +910,10 @@ ListboxWidgetObjCmd( } if (index < 0 || index >= listPtr->nElements) { - Tcl_AppendResult(interp, "item number \"", Tcl_GetString(objv[2]), - "\" out of range", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "item number \"%s\" out of range", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "LISTBOX", "ITEM_INDEX", NULL); result = TCL_ERROR; break; } @@ -926,10 +926,9 @@ ListboxWidgetObjCmd( if (objPtr == NULL) { result = TCL_ERROR; break; - } else { - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; } + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; } else { result = ConfigureListboxItem(interp, listPtr, attrPtr, objc-3, objv+3, index); @@ -1011,7 +1010,7 @@ ListboxWidgetObjCmd( } diff = listPtr->topIndex - index; if (diff > 0) { - if (diff <= (listPtr->fullLines/3)) { + if (diff <= listPtr->fullLines / 3) { ChangeListboxView(listPtr, index); } else { ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2); @@ -1019,7 +1018,7 @@ ListboxWidgetObjCmd( } else { diff = index - (listPtr->topIndex + listPtr->fullLines - 1); if (diff > 0) { - if (diff <= (listPtr->fullLines/3)) { + if (diff <= listPtr->fullLines / 3) { ChangeListboxView(listPtr, listPtr->topIndex + diff); } else { ChangeListboxView(listPtr, index-(listPtr->fullLines-1)/2); @@ -1049,7 +1048,7 @@ ListboxWidgetObjCmd( result = ListboxYviewSubCmd(interp, listPtr, objc, objv); break; } - Tcl_Release((ClientData)listPtr); + Tcl_Release(listPtr); return result; } @@ -1094,9 +1093,8 @@ ListboxBboxSubCmd( */ if ((listPtr->topIndex <= index) && (index < lastVisibleIndex)) { - char buf[TCL_INTEGER_SPACE * 4]; - Tcl_Obj *el; - char *stringRep; + Tcl_Obj *el, *results[4]; + const char *stringRep; int pixelWidth, stringLen, x, y, result; Tk_FontMetrics fm; @@ -1116,8 +1114,11 @@ ListboxBboxSubCmd( x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset; y = ((index - listPtr->topIndex)*listPtr->lineHeight) + listPtr->inset + listPtr->selBorderWidth; - sprintf(buf, "%d %d %d %d", x, y, pixelWidth, fm.linespace); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(x); + results[1] = Tcl_NewIntObj(y); + results[2] = Tcl_NewIntObj(pixelWidth); + results[3] = Tcl_NewIntObj(fm.linespace); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1202,9 +1203,8 @@ ListboxSelectionSubCmd( Tcl_WrongNumArgs(interp, 3, objv, "index"); return TCL_ERROR; } - Tcl_SetObjResult(interp, - Tcl_NewBooleanObj((Tcl_FindHashEntry(listPtr->selection, - (char *) INT2PTR(first)) != NULL))); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + Tcl_FindHashEntry(listPtr->selection, KEY(first)) != NULL)); result = TCL_OK; break; case SELECTION_SET: @@ -1237,45 +1237,45 @@ ListboxXviewSubCmd( int objc, /* Number of arguments in the objv array */ Tcl_Obj *const objv[]) /* Array of arguments to the procedure */ { - - int index, count, type, windowWidth, windowUnits; + int index, count, windowWidth, windowUnits; int offset = 0; /* Initialized to stop gcc warnings. */ - double fraction, fraction2; + double fraction; windowWidth = Tk_Width(listPtr->tkwin) - 2*(listPtr->inset + listPtr->selBorderWidth); if (objc == 2) { + Tcl_Obj *results[2]; + if (listPtr->maxWidth == 0) { - Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); + results[0] = Tcl_NewDoubleObj(0.0); + results[1] = Tcl_NewDoubleObj(1.0); } else { - char buf[TCL_DOUBLE_SPACE]; + double fraction2; - fraction = listPtr->xOffset/((double) listPtr->maxWidth); + fraction = listPtr->xOffset / (double) listPtr->maxWidth; fraction2 = (listPtr->xOffset + windowWidth) - / ((double) listPtr->maxWidth); + / (double) listPtr->maxWidth; if (fraction2 > 1.0) { fraction2 = 1.0; } - Tcl_PrintDouble(NULL, fraction, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, fraction2, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + results[0] = Tcl_NewDoubleObj(fraction); + results[1] = Tcl_NewDoubleObj(fraction2); } + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } else if (objc == 3) { if (Tcl_GetIntFromObj(interp, objv[2], &index) != TCL_OK) { return TCL_ERROR; } ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit); } else { - type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count); - switch (type) { + switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) { case TK_SCROLL_ERROR: return TCL_ERROR; case TK_SCROLL_MOVETO: offset = (int) (fraction*listPtr->maxWidth + 0.5); break; case TK_SCROLL_PAGES: - windowUnits = windowWidth/listPtr->xScrollUnit; + windowUnits = windowWidth / listPtr->xScrollUnit; if (windowUnits > 2) { offset = listPtr->xOffset + count*listPtr->xScrollUnit*(windowUnits-2); @@ -1315,34 +1315,34 @@ ListboxYviewSubCmd( int objc, /* Number of arguments in the objv array */ Tcl_Obj *const objv[]) /* Array of arguments to the procedure */ { - int index, count, type; - double fraction, fraction2; + int index, count; + double fraction; if (objc == 2) { + Tcl_Obj *results[2]; + if (listPtr->nElements == 0) { - Tcl_SetResult(interp, "0.0 1.0", TCL_STATIC); + results[0] = Tcl_NewDoubleObj(0.0); + results[1] = Tcl_NewDoubleObj(1.0); } else { - char buf[TCL_DOUBLE_SPACE]; + double fraction2, numEls = (double) listPtr->nElements; - fraction = listPtr->topIndex/((double) listPtr->nElements); - fraction2 = (listPtr->topIndex+listPtr->fullLines) - /((double) listPtr->nElements); + fraction = listPtr->topIndex / numEls; + fraction2 = (listPtr->topIndex+listPtr->fullLines) / numEls; if (fraction2 > 1.0) { fraction2 = 1.0; } - Tcl_PrintDouble(NULL, fraction, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - Tcl_PrintDouble(NULL, fraction2, buf); - Tcl_AppendResult(interp, " ", buf, NULL); + results[0] = Tcl_NewDoubleObj(fraction); + results[1] = Tcl_NewDoubleObj(fraction2); } + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } else if (objc == 3) { if (GetListboxIndex(interp, listPtr, objv[2], 0, &index) != TCL_OK) { return TCL_ERROR; } ChangeListboxView(listPtr, index); } else { - type = Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count); - switch (type) { + switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) { case TK_SCROLL_MOVETO: index = (int) (listPtr->nElements*fraction + 0.5); break; @@ -1393,19 +1393,19 @@ ListboxGetItemAttributes( Tcl_HashEntry *entry; ItemAttr *attrs; - entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, - (char *) INT2PTR(index), &isNew); + entry = Tcl_CreateHashEntry(listPtr->itemAttrTable, KEY(index), &isNew); if (isNew) { - attrs = (ItemAttr *) ckalloc(sizeof(ItemAttr)); + attrs = ckalloc(sizeof(ItemAttr)); attrs->border = NULL; attrs->selBorder = NULL; attrs->fgColor = NULL; attrs->selFgColor = NULL; Tk_InitOptions(interp, (char *)attrs, listPtr->itemAttrOptionTable, listPtr->tkwin); - Tcl_SetHashValue(entry, (ClientData) attrs); + Tcl_SetHashValue(entry, attrs); + } else { + attrs = Tcl_GetHashValue(entry); } - attrs = (ItemAttr *)Tcl_GetHashValue(entry); return attrs; } @@ -1429,9 +1429,9 @@ ListboxGetItemAttributes( static void DestroyListbox( - char *memPtr) /* Info about listbox widget. */ + void *memPtr) /* Info about listbox widget. */ { - register Listbox *listPtr = (Listbox *) memPtr; + register Listbox *listPtr = memPtr; Tcl_HashEntry *entry; Tcl_HashSearch search; @@ -1445,9 +1445,9 @@ DestroyListbox( } if (listPtr->listVarName != NULL) { - Tcl_UntraceVar(listPtr->interp, listPtr->listVarName, + Tcl_UntraceVar2(listPtr->interp, listPtr->listVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ListboxListVarProc, (ClientData) listPtr); + ListboxListVarProc, listPtr); } /* @@ -1455,7 +1455,7 @@ DestroyListbox( */ Tcl_DeleteHashTable(listPtr->selection); - ckfree((char *)listPtr->selection); + ckfree(listPtr->selection); /* * Free the item attribute hash table. @@ -1463,10 +1463,10 @@ DestroyListbox( for (entry = Tcl_FirstHashEntry(listPtr->itemAttrTable, &search); entry != NULL; entry = Tcl_NextHashEntry(&search)) { - ckfree((char *)Tcl_GetHashValue(entry)); + ckfree(Tcl_GetHashValue(entry)); } Tcl_DeleteHashTable(listPtr->itemAttrTable); - ckfree((char *)listPtr->itemAttrTable); + ckfree(listPtr->itemAttrTable); /* * Free up all the stuff that requires special handling, then let @@ -1483,11 +1483,11 @@ DestroyListbox( Tk_FreeBitmap(Tk_Display(listPtr->tkwin), listPtr->gray); } - Tk_FreeConfigOptions((char *)listPtr, listPtr->optionTable, + Tk_FreeConfigOptions((char *) listPtr, listPtr->optionTable, listPtr->tkwin); - Tcl_Release((ClientData) listPtr->tkwin); + Tcl_Release(listPtr->tkwin); listPtr->tkwin = NULL; - ckfree((char *) listPtr); + ckfree(listPtr); } /* @@ -1513,7 +1513,7 @@ DestroyListboxOptionTables( ClientData clientData, /* Pointer to the OptionTables struct */ Tcl_Interp *interp) /* Pointer to the calling interp */ { - ckfree((char *) clientData); + ckfree(clientData); return; } @@ -1553,9 +1553,9 @@ ConfigureListbox( oldExport = listPtr->exportSelection; if (listPtr->listVarName != NULL) { - Tcl_UntraceVar(interp, listPtr->listVarName, + Tcl_UntraceVar2(interp, listPtr->listVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ListboxListVarProc, (ClientData) listPtr); + ListboxListVarProc, listPtr); } for (error = 0; error <= 1; error++) { @@ -1598,8 +1598,8 @@ ConfigureListbox( if (listPtr->exportSelection && !oldExport && (listPtr->numSelected != 0)) { - Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection, - (ClientData) listPtr); + Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, + ListboxLostSelection, listPtr); } /* @@ -1646,9 +1646,9 @@ ConfigureListbox( } listPtr->listObj = listVarObj; - Tcl_TraceVar(listPtr->interp, listPtr->listVarName, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ListboxListVarProc, (ClientData) listPtr); + Tcl_TraceVar2(listPtr->interp, listPtr->listVarName, + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ListboxListVarProc, listPtr); } else if (listPtr->listObj == NULL) { listPtr->listObj = Tcl_NewObj(); } @@ -1672,10 +1672,9 @@ ConfigureListbox( Tcl_SetObjResult(interp, errorResult); Tcl_DecrRefCount(errorResult); return TCL_ERROR; - } else { - ListboxWorldChanged((ClientData) listPtr); - return TCL_OK; } + ListboxWorldChanged(listPtr); + return TCL_OK; } /* @@ -1752,7 +1751,7 @@ ListboxWorldChanged( XGCValues gcValues; GC gc; unsigned long mask; - Listbox *listPtr = (Listbox *) instanceData; + Listbox *listPtr = instanceData; if (listPtr->state & STATE_NORMAL) { gcValues.foreground = listPtr->fgColorPtr->pixel; @@ -1823,14 +1822,14 @@ static void DisplayListbox( ClientData clientData) /* Information about window. */ { - register Listbox *listPtr = (Listbox *) clientData; + register Listbox *listPtr = clientData; register Tk_Window tkwin = listPtr->tkwin; GC gc; int i, limit, x, y, prevSelected, freeGC, stringLen; Tk_FontMetrics fm; Tcl_Obj *curElement; Tcl_HashEntry *entry; - char *stringRep; + const char *stringRep; ItemAttr *attrs; Tk_3DBorder selectedBg; XGCValues gcValues; @@ -1851,23 +1850,23 @@ DisplayListbox( listPtr->flags |= UPDATE_H_SCROLLBAR; } - Tcl_Preserve((ClientData) listPtr); + Tcl_Preserve(listPtr); if (listPtr->flags & UPDATE_V_SCROLLBAR) { ListboxUpdateVScrollbar(listPtr); if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) { - Tcl_Release((ClientData) listPtr); + Tcl_Release(listPtr); return; } } if (listPtr->flags & UPDATE_H_SCROLLBAR) { ListboxUpdateHScrollbar(listPtr); if ((listPtr->flags & LISTBOX_DELETED) || !Tk_IsMapped(tkwin)) { - Tcl_Release((ClientData) listPtr); + Tcl_Release(listPtr); return; } } listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR); - Tcl_Release((ClientData) listPtr); + Tcl_Release(listPtr); #ifndef TK_NO_DOUBLE_BUFFERING /* @@ -1917,7 +1916,7 @@ DisplayListbox( * special foreground/background colors. */ - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); /* * If the listbox is enabled, items may be drawn differently; they may @@ -1926,7 +1925,7 @@ DisplayListbox( */ if (listPtr->state & STATE_NORMAL) { - if (Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i))) { + if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) { /* * Selected items are drawn differently. */ @@ -1941,7 +1940,7 @@ DisplayListbox( */ if (entry != NULL) { - attrs = (ItemAttr *)Tcl_GetHashValue(entry); + attrs = Tcl_GetHashValue(entry); /* * Default GC has the values from the widget at large. @@ -2008,8 +2007,7 @@ DisplayListbox( } /* Draw bottom bevel */ if (i + 1 == listPtr->nElements || - Tcl_FindHashEntry(listPtr->selection, - (char *) INT2PTR(i + 1)) == NULL ) { + !Tcl_FindHashEntry(listPtr->selection, KEY(i + 1))) { Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg, x-left, y + listPtr->lineHeight - listPtr->selBorderWidth, width+left+right, listPtr->selBorderWidth, 0, 0, 0, @@ -2023,7 +2021,7 @@ DisplayListbox( */ if (entry != NULL) { - attrs = (ItemAttr *)Tcl_GetHashValue(entry); + attrs = Tcl_GetHashValue(entry); gcValues.foreground = listPtr->fgColorPtr->pixel; gcValues.font = Tk_FontId(listPtr->tkfont); gcValues.graphics_exposures = False; @@ -2080,7 +2078,7 @@ DisplayListbox( Tk_UnderlineChars(listPtr->display, pixmap, gc, listPtr->tkfont, stringRep, x, y, 0, stringLen); } else if (listPtr->activeStyle == ACTIVE_STYLE_DOTBOX) { -#ifdef WIN32 +#ifdef _WIN32 /* * This provides for exact default look and feel on Windows. */ @@ -2097,7 +2095,7 @@ DisplayListbox( rect.bottom = rect.top + listPtr->lineHeight; DrawFocusRect(dc, &rect); TkWinReleaseDrawableDC(pixmap, dc, &state); -#else /* !WIN32 */ +#else /* !_WIN32 */ /* * Draw a dotted box around the text. */ @@ -2136,7 +2134,7 @@ DisplayListbox( gcValues.line_style = LineSolid; XChangeGC(listPtr->display, gc, GCLineStyle, &gcValues); } -#endif /* WIN32 */ +#endif /* _WIN32 */ } } @@ -2213,7 +2211,7 @@ ListboxComputeGeometry( int width, height, pixelWidth, pixelHeight, textLength, i, result; Tk_FontMetrics fm; Tcl_Obj *element; - char *text; + const char *text; if (fontChanged || maxIsStale) { listPtr->xScrollUnit = Tk_TextWidth(listPtr->tkfont, "0", 1); @@ -2245,7 +2243,7 @@ ListboxComputeGeometry( width = listPtr->width; if (width <= 0) { width = (listPtr->maxWidth + listPtr->xScrollUnit - 1) - /listPtr->xScrollUnit; + / listPtr->xScrollUnit; if (width < 1) { width = 1; } @@ -2299,7 +2297,7 @@ ListboxInsertSubCmd( { int i, oldMaxWidth, pixelWidth, result, length; Tcl_Obj *newListObj; - char *stringRep; + const char *stringRep; oldMaxWidth = listPtr->maxWidth; for (i = 0; i < objc; i++) { @@ -2413,7 +2411,7 @@ ListboxDeleteSubCmd( { int count, i, widthChanged, length, result, pixelWidth; Tcl_Obj *newListObj, *element; - char *stringRep; + const char *stringRep; Tcl_HashEntry *entry; /* @@ -2446,15 +2444,15 @@ ListboxDeleteSubCmd( * Remove selection information. */ - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); } - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); if (entry != NULL) { - ckfree((char *)Tcl_GetHashValue(entry)); + ckfree(Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); } @@ -2584,7 +2582,7 @@ ListboxEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - Listbox *listPtr = (Listbox *) clientData; + Listbox *listPtr = clientData; if (eventPtr->type == Expose) { EventuallyRedrawRange(listPtr, @@ -2601,7 +2599,7 @@ ListboxEventProc( if (listPtr->flags & REDRAW_PENDING) { Tcl_CancelIdleCall(DisplayListbox, clientData); } - Tcl_EventuallyFree(clientData, DestroyListbox); + Tcl_EventuallyFree(clientData, (Tcl_FreeProc *) DestroyListbox); } } else if (eventPtr->type == ConfigureNotify) { int vertSpace; @@ -2659,7 +2657,7 @@ static void ListboxCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - Listbox *listPtr = (Listbox *) clientData; + Listbox *listPtr = clientData; /* * This procedure could be invoked either because the window was destroyed @@ -2703,7 +2701,7 @@ GetListboxIndex( int *indexPtr) /* Where to store converted index. */ { int result, index; - char *stringRep; + const char *stringRep; /* * First see if the index is one of the named indices. @@ -2740,23 +2738,18 @@ GetListboxIndex( if (stringRep[0] == '@') { /* @x,y index */ int y; - char *start, *end; + const char *start; + char *end; start = stringRep + 1; y = strtol(start, &end, 0); if ((start == end) || (*end != ',')) { - Tcl_AppendResult(interp, "bad listbox index \"", stringRep, - "\": must be active, anchor, end, @x,y, or a number", - NULL); - return TCL_ERROR; + goto badIndex; } start = end+1; y = strtol(start, &end, 0); if ((start == end) || (*end != '\0')) { - Tcl_AppendResult(interp, "bad listbox index \"", stringRep, - "\": must be active, anchor, end, @x,y, or a number", - NULL); - return TCL_ERROR; + goto badIndex; } *indexPtr = NearestListboxElement(listPtr, y); return TCL_OK; @@ -2774,10 +2767,11 @@ GetListboxIndex( * Everything failed, nothing matched. Throw up an error message. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad listbox index \"", - Tcl_GetString(indexObj), "\": must be active, anchor, ", - "end, @x,y, or a number", NULL); + badIndex: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad listbox index \"%s\": must be active, anchor, end, @x,y," + " or a number", Tcl_GetString(indexObj))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "LISTBOX_INDEX", NULL); return TCL_ERROR; } @@ -2909,7 +2903,7 @@ ListboxScanTo( */ newTopIndex = listPtr->scanMarkYIndex - - (10*(y - listPtr->scanMarkY))/listPtr->lineHeight; + - (10*(y - listPtr->scanMarkY)) / listPtr->lineHeight; if (newTopIndex > maxIndex) { newTopIndex = listPtr->scanMarkYIndex = maxIndex; listPtr->scanMarkY = y; @@ -2961,7 +2955,7 @@ NearestListboxElement( { int index; - index = (y - listPtr->inset)/listPtr->lineHeight; + index = (y - listPtr->inset) / listPtr->lineHeight; if (index >= (listPtr->fullLines + listPtr->partialLine)) { index = listPtr->fullLines + listPtr->partialLine - 1; } @@ -3032,7 +3026,7 @@ ListboxSelect( */ for (i = first; i <= last; i++) { - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { if (!select) { Tcl_DeleteHashEntry(entry); @@ -3043,9 +3037,9 @@ ListboxSelect( } } else { if (select) { - entry = Tcl_CreateHashEntry(listPtr->selection, - (char *) INT2PTR(i), &isNew); - Tcl_SetHashValue(entry, (ClientData) NULL); + entry = Tcl_CreateHashEntry(listPtr->selection, KEY(i), + &isNew); + Tcl_SetHashValue(entry, NULL); listPtr->numSelected++; if (firstRedisplay < 0) { firstRedisplay = i; @@ -3058,9 +3052,9 @@ ListboxSelect( EventuallyRedrawRange(listPtr, first, last); } if ((oldCount == 0) && (listPtr->numSelected > 0) - && (listPtr->exportSelection)) { - Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection, - (ClientData) listPtr); + && listPtr->exportSelection) { + Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, + ListboxLostSelection, listPtr); } return TCL_OK; } @@ -3097,11 +3091,11 @@ ListboxFetchSelection( * not including terminating NULL * character. */ { - register Listbox *listPtr = (Listbox *) clientData; + register Listbox *listPtr = clientData; Tcl_DString selection; int length, count, needNewline, stringLen, i; Tcl_Obj *curElement; - char *stringRep; + const char *stringRep; Tcl_HashEntry *entry; if (!listPtr->exportSelection) { @@ -3115,7 +3109,7 @@ ListboxFetchSelection( needNewline = 0; Tcl_DStringInit(&selection); for (i = 0; i < listPtr->nElements; i++) { - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { if (needNewline) { Tcl_DStringAppend(&selection, "\n", 1); @@ -3173,16 +3167,50 @@ static void ListboxLostSelection( ClientData clientData) /* Information about listbox widget. */ { - register Listbox *listPtr = (Listbox *) clientData; + register Listbox *listPtr = clientData; if ((listPtr->exportSelection) && (listPtr->nElements > 0)) { ListboxSelect(listPtr, 0, listPtr->nElements-1, 0); + GenerateListboxSelectEvent(listPtr); } } /* *---------------------------------------------------------------------- * + * GenerateListboxSelectEvent -- + * + * Send an event that the listbox selection was updated. This is + * equivalent to event generate $listboxWidget <<ListboxSelect>> + * + * Results: + * None + * + * Side effects: + * Any side effect possible, depending on bindings to this event. + * + *---------------------------------------------------------------------- + */ + +static void +GenerateListboxSelectEvent( + Listbox *listPtr) /* Information about widget. */ +{ + union {XEvent general; XVirtualEvent virtual;} event; + + memset(&event, 0, sizeof(event)); + event.general.xany.type = VirtualEvent; + event.general.xany.serial = NextRequest(Tk_Display(listPtr->tkwin)); + event.general.xany.send_event = False; + event.general.xany.window = Tk_WindowId(listPtr->tkwin); + event.general.xany.display = Tk_Display(listPtr->tkwin); + event.virtual.name = Tk_GetUid("ListboxSelect"); + Tk_HandleEvent(&event.general); +} + +/* + *---------------------------------------------------------------------- + * * EventuallyRedrawRange -- * * Ensure that a given range of elements is eventually redrawn on the @@ -3217,7 +3245,7 @@ EventuallyRedrawRange( return; } listPtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr); + Tcl_DoWhenIdle(DisplayListbox, listPtr); } /* @@ -3244,10 +3272,11 @@ static void ListboxUpdateVScrollbar( register Listbox *listPtr) /* Information about widget. */ { - char firstStr[TCL_DOUBLE_SPACE+1], lastStr[TCL_DOUBLE_SPACE+1]; + char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE]; double first, last; int result; Tcl_Interp *interp; + Tcl_DString buf; if (listPtr->yScrollCmd == NULL) { return; @@ -3263,9 +3292,8 @@ ListboxUpdateVScrollbar( last = 1.0; } } - firstStr[0] = lastStr[0] = ' '; - Tcl_PrintDouble(NULL, first, firstStr+1); - Tcl_PrintDouble(NULL, last, lastStr+1); + Tcl_PrintDouble(NULL, first, firstStr); + Tcl_PrintDouble(NULL, last, lastStr); /* * We must hold onto the interpreter from the listPtr because the data at @@ -3274,12 +3302,18 @@ ListboxUpdateVScrollbar( interp = listPtr->interp; Tcl_Preserve(interp); - result = Tcl_VarEval(interp, listPtr->yScrollCmd, firstStr, lastStr, - NULL); + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, listPtr->yScrollCmd, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, firstStr, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, lastStr, -1); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (vertical scrolling command executed by listbox)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_Release(interp); } @@ -3308,31 +3342,30 @@ static void ListboxUpdateHScrollbar( register Listbox *listPtr) /* Information about widget. */ { - char firstStr[TCL_DOUBLE_SPACE+1], lastStr[TCL_DOUBLE_SPACE+1]; + char firstStr[TCL_DOUBLE_SPACE], lastStr[TCL_DOUBLE_SPACE]; int result, windowWidth; double first, last; Tcl_Interp *interp; + Tcl_DString buf; if (listPtr->xScrollCmd == NULL) { return; } - windowWidth = Tk_Width(listPtr->tkwin) - 2*(listPtr->inset - + listPtr->selBorderWidth); + + windowWidth = Tk_Width(listPtr->tkwin) + - 2*(listPtr->inset + listPtr->selBorderWidth); if (listPtr->maxWidth == 0) { first = 0; last = 1.0; } else { - register double maxWide = (double) listPtr->maxWidth; - - first = listPtr->xOffset / maxWide; - last = (listPtr->xOffset + windowWidth) / maxWide; + first = listPtr->xOffset / (double) listPtr->maxWidth; + last = (listPtr->xOffset + windowWidth) / (double) listPtr->maxWidth; if (last > 1.0) { last = 1.0; } } - firstStr[0] = lastStr[0] = ' '; - Tcl_PrintDouble(NULL, first, firstStr+1); - Tcl_PrintDouble(NULL, last, lastStr+1); + Tcl_PrintDouble(NULL, first, firstStr); + Tcl_PrintDouble(NULL, last, lastStr); /* * We must hold onto the interpreter because the data referred to at @@ -3341,12 +3374,18 @@ ListboxUpdateHScrollbar( interp = listPtr->interp; Tcl_Preserve(interp); - result = Tcl_VarEval(interp, listPtr->xScrollCmd, firstStr, lastStr, - NULL); + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, listPtr->xScrollCmd, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, firstStr, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, lastStr, -1); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (horizontal scrolling command executed by listbox)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_Release(interp); } @@ -3375,7 +3414,7 @@ ListboxListVarProc( const char *name2, /* Not used. */ int flags) /* Information about what happened. */ { - Listbox *listPtr = (Listbox *)clientData; + Listbox *listPtr = clientData; Tcl_Obj *oldListObj, *varListObj; int oldLength, i; Tcl_HashEntry *entry; @@ -3388,8 +3427,8 @@ ListboxListVarProc( if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL, listPtr->listObj, TCL_GLOBAL_ONLY); - Tcl_TraceVar(interp, listPtr->listVarName, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + Tcl_TraceVar2(interp, listPtr->listVarName, + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ListboxListVarProc, clientData); return NULL; } @@ -3438,7 +3477,7 @@ ListboxListVarProc( * Clean up selection. */ - entry = Tcl_FindHashEntry(listPtr->selection, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->selection, KEY(i)); if (entry != NULL) { listPtr->numSelected--; Tcl_DeleteHashEntry(entry); @@ -3448,10 +3487,9 @@ ListboxListVarProc( * Clean up attributes. */ - entry = Tcl_FindHashEntry(listPtr->itemAttrTable, - (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(listPtr->itemAttrTable, KEY(i)); if (entry != NULL) { - ckfree((char *) Tcl_GetHashValue(entry)); + ckfree(Tcl_GetHashValue(entry)); Tcl_DeleteHashEntry(entry); } } @@ -3523,23 +3561,21 @@ MigrateHashEntries( if (offset > 0) { for (i = last; i >= first; i--) { - entry = Tcl_FindHashEntry(table, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(table, KEY(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); - entry = Tcl_CreateHashEntry(table, - (char *) INT2PTR(i + offset), &isNew); + entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } } else { for (i = first; i <= last; i++) { - entry = Tcl_FindHashEntry(table, (char *) INT2PTR(i)); + entry = Tcl_FindHashEntry(table, KEY(i)); if (entry != NULL) { clientData = Tcl_GetHashValue(entry); Tcl_DeleteHashEntry(entry); - entry = Tcl_CreateHashEntry(table, - (char *) INT2PTR(i + offset), &isNew); + entry = Tcl_CreateHashEntry(table, KEY(i + offset), &isNew); Tcl_SetHashValue(entry, clientData); } } diff --git a/generic/tkMacWinMenu.c b/generic/tkMacWinMenu.c index 9351de1..9449838 100644 --- a/generic/tkMacWinMenu.c +++ b/generic/tkMacWinMenu.c @@ -43,10 +43,10 @@ PreprocessMenu( TkMenu *menuPtr) { int index, result, finished; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - Tcl_Preserve((ClientData) menuPtr); + Tcl_Preserve(menuPtr); /* * First, let's process the post command on ourselves. If this command @@ -91,7 +91,7 @@ PreprocessMenu( } while (!finished); done: - Tcl_Release((ClientData) menuPtr); + Tcl_Release(menuPtr); return result; } @@ -129,7 +129,7 @@ int TkPreprocessMenu( TkMenu *menuPtr) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->postCommandGeneration++; diff --git a/generic/tkMain.c b/generic/tkMain.c index 00ac165..1b21223 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -14,29 +14,87 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tclInt.h" +/** + * On Windows, this file needs to be compiled twice, once with + * TK_ASCII_MAIN defined. This way both Tk_MainEx and Tk_MainExW + * can be implemented, sharing the same source code. + */ +#if defined(TK_ASCII_MAIN) +# ifdef UNICODE +# undef UNICODE +# undef _UNICODE +# else +# define UNICODE +# define _UNICODE +# endif +#endif + #include "tkInt.h" -#ifdef __WIN32__ -#include "tkWinInt.h" -#include "../win/tclWinPort.h" +#include <ctype.h> +#include <stdio.h> +#include <string.h> +#ifdef NO_STDLIB_H +# include "../compat/stdlib.h" +#else +# include <stdlib.h> +#endif + +extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *); + +/* + * The default prompt used when the user has not overridden it. + */ + +#define DEFAULT_PRIMARY_PROMPT "% " + +/* + * This file can be compiled on Windows in UNICODE mode, as well as + * on all other platforms using the native encoding. This is done + * by using the normal Windows functions like _tcscmp, but on + * platforms which don't have <tchar.h> we have to translate that + * to strcmp here. + */ +#ifdef _WIN32 +/* Little hack to eliminate the need for "tclInt.h" here: + Just copy a small portion of TclIntPlatStubs, just + enough to make it work. See [600b72bfbc] */ +typedef struct { + int magic; + void *hooks; + void (*dummy[16]) (void); /* dummy entries 0-15, not used */ + int (*tclpIsAtty) (int fd); /* 16 */ +} TclIntPlatStubs; +extern const TclIntPlatStubs *tclIntPlatStubsPtr; +# include "tkWinInt.h" +#else +# define TCHAR char +# define TEXT(arg) arg +# define _tcscmp strcmp +# define _tcslen strlen +# define _tcsncmp strncmp #endif + #ifdef MAC_OSX_TK #include "tkMacOSXInt.h" #endif -extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *); - -typedef struct ThreadSpecificData { - Tcl_Interp *interp; /* Interpreter for this thread. */ - Tcl_DString command; /* Used to assemble lines of terminal input - * into Tcl commands. */ - Tcl_DString line; /* Used to read the next line from the - * terminal input. */ - int tty; /* Non-zero means standard input is a - * terminal-like device. Zero means it's a - * file. */ -} ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; +/* + * Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj, + * while otherwise NewNativeObj is needed (which provides proper + * conversion from native encoding to UTF-8). + */ +#ifdef UNICODE +# define NewNativeObj Tcl_NewUnicodeObj +#else /* !UNICODE */ + static Tcl_Obj *NewNativeObj(char *string, int length) { + Tcl_Obj *obj; + Tcl_DString ds; + Tcl_ExternalToUtfDString(NULL, string, length, &ds); + obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); + return obj; +} +#endif /* !UNICODE */ /* * Declarations for various library functions and variables (don't want to @@ -46,54 +104,57 @@ static Tcl_ThreadDataKey dataKey; * it will conflict with a declaration elsewhere on some systems. */ -#if defined(__WIN32__) || defined(_WIN32) +#if defined(_WIN32) #define isatty WinIsTty static int WinIsTty(int fd) { HANDLE handle; /* * For now, under Windows, we assume we are not running as a console mode - * app, so we need to use the GUI console. In order to enable this, we - * always claim to be running on a tty. This probably isn't the right - * way to do it. + * app, so we need to use the GUI console. In order to enable this, we + * always claim to be running on a tty. This probably isn't the right way + * to do it. */ #if !defined(STATIC_BUILD) - if (tclStubsPtr->reserved9 && TclpIsAtty) { + if (tclStubsPtr->reserved9 && tclIntPlatStubsPtr->tclpIsAtty) { /* We are running on Cygwin */ - return TclpIsAtty(fd); + return tclIntPlatStubsPtr->tclpIsAtty(fd); } #endif handle = GetStdHandle(STD_INPUT_HANDLE + fd); - - if ((handle == INVALID_HANDLE_VALUE) || (handle == 0) - || (GetFileType(handle) == FILE_TYPE_UNKNOWN)) { /* - * If it's a bad or closed handle, then it's been connected - * to a wish console window. + * If it's a bad or closed handle, then it's been connected to a wish + * console window. A character file handle is a tty by definition. */ - - return 1; - } else if (GetFileType(handle) == FILE_TYPE_CHAR) { - /* - * A character file handle is a tty by definition. - */ - - return 1; - } else { - return 0; - } + return (handle == INVALID_HANDLE_VALUE) || (handle == 0) + || (GetFileType(handle) == FILE_TYPE_UNKNOWN) + || (GetFileType(handle) == FILE_TYPE_CHAR); } #else extern int isatty(int fd); -extern char * strrchr(CONST char *string, int c); #endif +typedef struct InteractiveState { + Tcl_Channel input; /* The standard input channel from which lines + * are read. */ + int tty; /* Non-zero means standard input is a + * terminal-like device. Zero means it's a + * file. */ + Tcl_DString command; /* Used to assemble lines of terminal input + * into Tcl commands. */ + Tcl_DString line; /* Used to read the next line from the + * terminal input. */ + int gotPartial; + Tcl_Interp *interp; /* Interpreter that evaluates interactive + * commands. */ +} InteractiveState; + /* * Forward declarations for functions defined later in this file. */ -static void Prompt(Tcl_Interp *interp, int partial); +static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr); static void StdinProc(ClientData clientData, int mask); /* @@ -105,7 +166,7 @@ static void StdinProc(ClientData clientData, int mask); * * Results: * None. This function never returns (it exits the process when it's - * done. + * done). * * Side effects: * This function initializes the Tk world and then starts interpreting @@ -114,36 +175,36 @@ static void StdinProc(ClientData clientData, int mask); * *---------------------------------------------------------------------- */ + void Tk_MainEx( int argc, /* Number of arguments. */ - char **argv, /* Array of argument strings. */ + TCHAR **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc, /* Application-specific initialization * function to call after most initialization * but before starting to execute commands. */ Tcl_Interp *interp) { - Tcl_Obj *path, *argvPtr; - CONST char *encodingName; + Tcl_Obj *path, *argvPtr, *appName; + const char *encodingName; int code, nullStdin = 0; - Tcl_Channel inChannel, outChannel; - ThreadSpecificData *tsdPtr; - Tcl_DString appName; + Tcl_Channel chan; + InteractiveState is; /* * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { abort(); } else { - Tcl_Panic("%s", Tcl_GetStringResult(interp)); + Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); } } -#if defined(__WIN32__) && !defined(STATIC_BUILD) +#if defined(_WIN32) && !defined(UNICODE) && !defined(STATIC_BUILD) if (tclStubsPtr->reserved9) { /* We are running win32 Tk under Cygwin, so let's check @@ -160,7 +221,7 @@ Tk_MainEx( int i; for (i = 1; i < argc; ++i) { - if (!strcmp(argv[i], "-display")) { + if (!_tcscmp(argv[i], TEXT("-display"))) { goto loadCygwinTk; } } @@ -168,19 +229,13 @@ Tk_MainEx( } #endif - tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_InitMemory(interp); - Tcl_FindExecutable(argv[0]); - tsdPtr->interp = interp; - Tcl_Preserve((ClientData) interp); + is.interp = interp; + is.gotPartial = 0; + Tcl_Preserve(interp); -#if defined(__WIN32__) && !defined(STATIC_BUILD) - if (!tclStubsPtr->reserved9) { - /* Only initialize console when not running under cygwin */ - Tk_InitConsoleChannels(interp); - } -#elif defined(__WIN32__) +#if defined(_WIN32) && !defined(__CYGWIN__) Tk_InitConsoleChannels(interp); #endif @@ -190,10 +245,6 @@ Tk_MainEx( } #endif -#ifdef TCL_MEM_DEBUG - Tcl_InitMemory(interp); -#endif - /* * If the application has not already set a startup script, parse the * first few command line arguments to determine the script path and @@ -205,44 +256,40 @@ Tk_MainEx( /* * Check whether first 3 args (argv[1] - argv[3]) look like - * -encoding ENCODING FILENAME + * -encoding ENCODING FILENAME * or like - * FILENAME + * FILENAME * or like - * -file FILENAME (ancient history support only) + * -file FILENAME (ancient history support only) */ - if ((argc > 3) && (0 == strcmp("-encoding", argv[1])) - && ('-' != argv[3][0])) { - Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]); + if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) + && (TEXT('-') != argv[3][0])) { + Tcl_Obj *value = NewNativeObj(argv[2], -1); + Tcl_SetStartupScript(NewNativeObj(argv[3], -1), Tcl_GetString(value)); + Tcl_DecrRefCount(value); argc -= 3; argv += 3; - } else if ((argc > 1) && ('-' != argv[1][0])) { - Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL); + } else if ((argc > 1) && (TEXT('-') != argv[1][0])) { + Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); argc--; argv++; - } else if ((argc > 2) && (length = strlen(argv[1])) - && (length > 1) && (0 == strncmp("-file", argv[1], length)) - && ('-' != argv[2][0])) { - Tcl_SetStartupScript(Tcl_NewStringObj(argv[2], -1), NULL); + } else if ((argc > 2) && (length = _tcslen(argv[1])) + && (length > 1) && (0 == _tcsncmp(TEXT("-file"), argv[1], length)) + && (TEXT('-') != argv[2][0])) { + Tcl_SetStartupScript(NewNativeObj(argv[2], -1), NULL); argc -= 2; argv += 2; } } path = Tcl_GetStartupScript(&encodingName); - if (NULL == path) { - Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); + if (path == NULL) { + appName = NewNativeObj(argv[0], -1); } else { - int numBytes; - CONST char *pathName = Tcl_GetStringFromObj(path, &numBytes); - - Tcl_ExternalToUtfDString(NULL, pathName, numBytes, &appName); - path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1); - Tcl_SetStartupScript(path, encodingName); + appName = path; } - Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); - Tcl_DStringFree(&appName); + Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY); argc--; argv++; @@ -250,12 +297,7 @@ Tk_MainEx( argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { - Tcl_DString ds; - - Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds); - Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( - Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); - Tcl_DStringFree(&ds); + Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1)); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); @@ -263,32 +305,30 @@ Tk_MainEx( * Set the "tcl_interactive" variable. */ - tsdPtr->tty = isatty(0); - + is.tty = isatty(0); #if defined(MAC_OSX_TK) /* * On TkAqua, if we don't have a TTY and stdin is a special character file * of length 0, (e.g. /dev/null, which is what Finder sets when double * clicking Wish) then use the GUI console. */ - - if (!tsdPtr->tty) { + + if (!is.tty) { struct stat st; nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks); } #endif - Tcl_SetVar(interp, "tcl_interactive", - ((path == NULL) && (tsdPtr->tty || nullStdin)) ? "1" : "0", - TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, + Tcl_NewIntObj(!path && (is.tty || nullStdin)), TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. */ - if ((*appInitProc)(interp) != TCL_OK) { - TkpDisplayWarning(Tcl_GetStringResult(interp), - "Application initialization failed"); + if (appInitProc(interp) != TCL_OK) { + TkpDisplayWarning(Tcl_GetString(Tcl_GetObjResult(interp)), + "application-specific initialization failed"); } /* @@ -307,12 +347,12 @@ Tk_MainEx( */ Tcl_AddErrorInfo(interp, ""); - TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo", + TkpDisplayWarning(Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY), "Error in startup script"); Tcl_DeleteInterp(interp); Tcl_Exit(1); } - tsdPtr->tty = 0; + is.tty = 0; } else { /* @@ -325,22 +365,21 @@ Tk_MainEx( * Establish a channel handler for stdin. */ - inChannel = Tcl_GetStdChannel(TCL_STDIN); - if (inChannel) { - Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, - (ClientData) inChannel); + is.input = Tcl_GetStdChannel(TCL_STDIN); + if (is.input) { + Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is); } - if (tsdPtr->tty) { - Prompt(interp, 0); + if (is.tty) { + Prompt(interp, &is); } } - outChannel = Tcl_GetStdChannel(TCL_STDOUT); - if (outChannel) { - Tcl_Flush(outChannel); + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan) { + Tcl_Flush(chan); } - Tcl_DStringInit(&tsdPtr->command); - Tcl_DStringInit(&tsdPtr->line); + Tcl_DStringInit(&is.command); + Tcl_DStringInit(&is.line); Tcl_ResetResult(interp); /* @@ -350,7 +389,7 @@ Tk_MainEx( Tk_MainLoop(); Tcl_DeleteInterp(interp); - Tcl_Release((ClientData) interp); + Tcl_Release(interp); Tcl_SetStartupScript(NULL, NULL); Tcl_Exit(0); } @@ -377,37 +416,34 @@ Tk_MainEx( /* ARGSUSED */ static void StdinProc( - ClientData clientData, /* Not used. */ + ClientData clientData, /* The state of interactive cmd line */ int mask) /* Not used. */ { - static int gotPartial = 0; char *cmd; int code, count; - Tcl_Channel chan = (Tcl_Channel) clientData; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - Tcl_Interp *interp = tsdPtr->interp; + InteractiveState *isPtr = clientData; + Tcl_Channel chan = isPtr->input; + Tcl_Interp *interp = isPtr->interp; - count = Tcl_Gets(chan, &tsdPtr->line); + count = Tcl_Gets(chan, &isPtr->line); - if (count < 0 && !gotPartial) { - if (tsdPtr->tty) { + if (count < 0 && !isPtr->gotPartial) { + if (isPtr->tty) { Tcl_Exit(0); } else { - Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); + Tcl_DeleteChannelHandler(chan, StdinProc, isPtr); } return; } - (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue( - &tsdPtr->line), -1); - cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1); - Tcl_DStringFree(&tsdPtr->line); + Tcl_DStringAppend(&isPtr->command, Tcl_DStringValue(&isPtr->line), -1); + cmd = Tcl_DStringAppend(&isPtr->command, "\n", -1); + Tcl_DStringFree(&isPtr->line); if (!Tcl_CommandComplete(cmd)) { - gotPartial = 1; + isPtr->gotPartial = 1; goto prompt; } - gotPartial = 0; + isPtr->gotPartial = 0; /* * Disable the stdin channel handler while evaluating the command; @@ -416,18 +452,17 @@ StdinProc( * things, this will trash the text of the command being evaluated. */ - Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan); + Tcl_CreateChannelHandler(chan, 0, StdinProc, isPtr); code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); - chan = Tcl_GetStdChannel(TCL_STDIN); - if (chan) { - Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, - (ClientData) chan); + isPtr->input = Tcl_GetStdChannel(TCL_STDIN); + if (isPtr->input) { + Tcl_CreateChannelHandler(isPtr->input, TCL_READABLE, StdinProc, isPtr); } - Tcl_DStringFree(&tsdPtr->command); - if (Tcl_GetStringResult(interp)[0] != '\0') { - if ((code != TCL_OK) || (tsdPtr->tty)) { - chan = Tcl_GetStdChannel(TCL_STDOUT); + Tcl_DStringFree(&isPtr->command); + if (Tcl_GetString(Tcl_GetObjResult(interp))[0] != '\0') { + if ((code != TCL_OK) || (isPtr->tty)) { + chan = Tcl_GetStdChannel((code != TCL_OK) ? TCL_STDERR : TCL_STDOUT); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); @@ -436,12 +471,12 @@ StdinProc( } /* - * Output a prompt. + * If a tty stdin is still around, output a prompt. */ prompt: - if (tsdPtr->tty) { - Prompt(interp, gotPartial); + if (isPtr->tty && (isPtr->input != NULL)) { + Prompt(interp, isPtr); } Tcl_ResetResult(interp); } @@ -466,53 +501,42 @@ StdinProc( static void Prompt( Tcl_Interp *interp, /* Interpreter to use for prompting. */ - int partial) /* Non-zero means there already exists a - * partial command, so use the secondary - * prompt. */ + InteractiveState *isPtr) /* InteractiveState. */ { - Tcl_Obj *promptCmd; + Tcl_Obj *promptCmdPtr; int code; - Tcl_Channel outChannel, errChannel; + Tcl_Channel chan; - promptCmd = Tcl_GetVar2Ex(interp, - partial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY); - if (promptCmd == NULL) { + promptCmdPtr = Tcl_GetVar2Ex(interp, + isPtr->gotPartial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY); + if (promptCmdPtr == NULL) { defaultPrompt: - if (!partial) { - /* - * We must check that outChannel is a real channel - it is - * possible that someone has transferred stdout out of this - * interpreter with "interp transfer". - */ - - outChannel = Tcl_GetChannel(interp, "stdout", NULL); - if (outChannel != (Tcl_Channel) NULL) { - Tcl_WriteChars(outChannel, "% ", 2); + if (!isPtr->gotPartial) { + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan != NULL) { + Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT, + strlen(DEFAULT_PRIMARY_PROMPT)); } } } else { - code = Tcl_EvalObjEx(interp, promptCmd, TCL_EVAL_GLOBAL); + code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (script that generates prompt)"); - - /* - * We must check that errChannel is a real channel - it is - * possible that someone has transferred stderr out of this - * interpreter with "interp transfer". - */ - - errChannel = Tcl_GetChannel(interp, "stderr", NULL); - if (errChannel != (Tcl_Channel) NULL) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); + if (Tcl_GetString(Tcl_GetObjResult(interp))[0] != '\0') { + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan != NULL) { + Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + Tcl_WriteChars(chan, "\n", 1); + } } goto defaultPrompt; } } - outChannel = Tcl_GetChannel(interp, "stdout", NULL); - if (outChannel != (Tcl_Channel) NULL) { - Tcl_Flush(outChannel); + + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan != NULL) { + Tcl_Flush(chan); } } diff --git a/generic/tkMenu.c b/generic/tkMenu.c index b35be24..d24516f 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -81,6 +81,10 @@ typedef struct ThreadSpecificData { int menusInitialized; /* Flag indicates whether thread-specific * elements of the Windows Menu module have * been initialized. */ + Tk_OptionTable menuOptionTable; + /* The option table for menus. */ + Tk_OptionTable entryOptionTables[6]; + /* The tables for menu entries. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -97,9 +101,9 @@ TCL_DECLARE_MUTEX(menuMutex) * to update code in TkpMenuInit that changes the font string entry. */ -const char *tkMenuStateStrings[] = {"active", "normal", "disabled", NULL}; +static const char *const menuStateStrings[] = {"active", "normal", "disabled", NULL}; -static const char *menuEntryTypeStrings[] = { +static const char *const menuEntryTypeStrings[] = { "cascade", "checkbutton", "command", "radiobutton", "separator", NULL }; @@ -108,128 +112,128 @@ static const char *menuEntryTypeStrings[] = { * is used with the "enum compound" declaration in tkMenu.h */ -static const char *compoundStrings[] = { +static const char *const compoundStrings[] = { "bottom", "center", "left", "none", "right", "top", NULL }; static const Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = { {TK_OPTION_BORDER, "-activebackground", NULL, NULL, DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1, - TK_OPTION_NULL_OK}, + TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_COLOR, "-activeforeground", NULL, NULL, DEF_MENU_ENTRY_ACTIVE_FG, - Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING, "-accelerator", NULL, NULL, DEF_MENU_ENTRY_ACCELERATOR, - Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_BORDER, "-background", NULL, NULL, DEF_MENU_ENTRY_BG, - Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_BITMAP, "-bitmap", NULL, NULL, DEF_MENU_ENTRY_BITMAP, - Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_BOOLEAN, "-columnbreak", NULL, NULL, DEF_MENU_ENTRY_COLUMN_BREAK, - -1, Tk_Offset(TkMenuEntry, columnBreak)}, + -1, Tk_Offset(TkMenuEntry, columnBreak), 0, NULL, 0}, {TK_OPTION_STRING, "-command", NULL, NULL, DEF_MENU_ENTRY_COMMAND, - Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", DEF_MENU_ENTRY_COMPOUND, -1, Tk_Offset(TkMenuEntry, compound), 0, (ClientData) compoundStrings, 0}, {TK_OPTION_FONT, "-font", NULL, NULL, DEF_MENU_ENTRY_FONT, - Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_COLOR, "-foreground", NULL, NULL, DEF_MENU_ENTRY_FG, - Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_BOOLEAN, "-hidemargin", NULL, NULL, DEF_MENU_ENTRY_HIDE_MARGIN, - -1, Tk_Offset(TkMenuEntry, hideMargin)}, + -1, Tk_Offset(TkMenuEntry, hideMargin), 0, NULL, 0}, {TK_OPTION_STRING, "-image", NULL, NULL, DEF_MENU_ENTRY_IMAGE, - Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING, "-label", NULL, NULL, DEF_MENU_ENTRY_LABEL, - Tk_Offset(TkMenuEntry, labelPtr), -1, 0}, + Tk_Offset(TkMenuEntry, labelPtr), -1, 0, NULL, 0}, {TK_OPTION_STRING_TABLE, "-state", NULL, NULL, DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0, - (ClientData) tkMenuStateStrings}, + (ClientData) menuStateStrings, 0}, {TK_OPTION_INT, "-underline", NULL, NULL, - DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline)}, - {TK_OPTION_END} + DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline), 0, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0} }; static const Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = { {TK_OPTION_BORDER, "-background", NULL, NULL, DEF_MENU_ENTRY_BG, - Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, - {TK_OPTION_END} + Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0} }; static const Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = { {TK_OPTION_BOOLEAN, "-indicatoron", NULL, NULL, DEF_MENU_ENTRY_INDICATOR, - -1, Tk_Offset(TkMenuEntry, indicatorOn)}, + -1, Tk_Offset(TkMenuEntry, indicatorOn), 0, NULL, 0}, {TK_OPTION_STRING, "-offvalue", NULL, NULL, DEF_MENU_ENTRY_OFF_VALUE, - Tk_Offset(TkMenuEntry, offValuePtr), -1}, + Tk_Offset(TkMenuEntry, offValuePtr), -1, 0, NULL, 0}, {TK_OPTION_STRING, "-onvalue", NULL, NULL, DEF_MENU_ENTRY_ON_VALUE, - Tk_Offset(TkMenuEntry, onValuePtr), -1}, + Tk_Offset(TkMenuEntry, onValuePtr), -1, 0, NULL, 0}, {TK_OPTION_COLOR, "-selectcolor", NULL, NULL, DEF_MENU_ENTRY_SELECT, - Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING, "-selectimage", NULL, NULL, DEF_MENU_ENTRY_SELECT_IMAGE, - Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING, "-variable", NULL, NULL, DEF_MENU_ENTRY_CHECK_VARIABLE, - Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, - NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} + NULL, 0, -1, 0, tkBasicMenuEntryConfigSpecs, 0} }; static const Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = { {TK_OPTION_BOOLEAN, "-indicatoron", NULL, NULL, DEF_MENU_ENTRY_INDICATOR, - -1, Tk_Offset(TkMenuEntry, indicatorOn)}, + -1, Tk_Offset(TkMenuEntry, indicatorOn), 0, NULL, 0}, {TK_OPTION_COLOR, "-selectcolor", NULL, NULL, DEF_MENU_ENTRY_SELECT, - Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING, "-selectimage", NULL, NULL, DEF_MENU_ENTRY_SELECT_IMAGE, - Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING, "-value", NULL, NULL, DEF_MENU_ENTRY_VALUE, - Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING, "-variable", NULL, NULL, DEF_MENU_ENTRY_RADIO_VARIABLE, - Tk_Offset(TkMenuEntry, namePtr), -1, 0}, + Tk_Offset(TkMenuEntry, namePtr), -1, 0, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, - NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} + NULL, 0, -1, 0, tkBasicMenuEntryConfigSpecs, 0} }; static const Tk_OptionSpec tkCascadeEntryConfigSpecs[] = { {TK_OPTION_STRING, "-menu", NULL, NULL, DEF_MENU_ENTRY_MENU, - Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, - NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs} + NULL, 0, -1, 0, tkBasicMenuEntryConfigSpecs, 0} }; static const Tk_OptionSpec tkTearoffEntryConfigSpecs[] = { {TK_OPTION_BORDER, "-background", NULL, NULL, DEF_MENU_ENTRY_BG, - Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING_TABLE, "-state", NULL, NULL, DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0, - (ClientData) tkMenuStateStrings}, - {TK_OPTION_END} + (ClientData) menuStateStrings, 0}, + {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0} }; -static const Tk_OptionSpec *const specsArray[] = { +static const Tk_OptionSpec *specsArray[] = { tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs, tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs, tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs @@ -239,7 +243,7 @@ static const Tk_OptionSpec *const specsArray[] = { * Menu type strings for use with Tcl_GetIndexFromObj. */ -static const char *menuTypeStrings[] = { +static const char *const menuTypeStrings[] = { "normal", "tearoff", "menubar", NULL }; @@ -247,60 +251,60 @@ static const Tk_OptionSpec tkMenuConfigSpecs[] = { {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground", DEF_MENU_ACTIVE_BG_COLOR, Tk_Offset(TkMenu, activeBorderPtr), -1, 0, - (ClientData) DEF_MENU_ACTIVE_BG_MONO}, + (ClientData) DEF_MENU_ACTIVE_BG_MONO, 0}, {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth", "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH, - Tk_Offset(TkMenu, activeBorderWidthPtr), -1}, + Tk_Offset(TkMenu, activeBorderWidthPtr), -1, 0, NULL, 0}, {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background", DEF_MENU_ACTIVE_FG_COLOR, Tk_Offset(TkMenu, activeFgPtr), -1, 0, - (ClientData) DEF_MENU_ACTIVE_FG_MONO}, + (ClientData) DEF_MENU_ACTIVE_FG_MONO, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, borderPtr), -1, 0, - (ClientData) DEF_MENU_BG_MONO}, + (ClientData) DEF_MENU_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth"}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background"}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_MENU_BORDER_WIDTH, - Tk_Offset(TkMenu, borderWidthPtr), -1, 0}, + Tk_Offset(TkMenu, borderWidthPtr), -1, 0, NULL, 0}, {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", DEF_MENU_CURSOR, - Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground", "DisabledForeground", DEF_MENU_DISABLED_FG_COLOR, Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK, - (ClientData) DEF_MENU_DISABLED_FG_MONO}, + (ClientData) DEF_MENU_DISABLED_FG_MONO, 0}, {TK_OPTION_SYNONYM, "-fg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-foreground"}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", - DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1}, + DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1, 0, NULL, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", - DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1}, + DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1, 0, NULL, 0}, {TK_OPTION_STRING, "-postcommand", "postCommand", "Command", DEF_MENU_POST_COMMAND, - Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", - DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1}, + DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1, 0, NULL, 0}, {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background", DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0, - (ClientData) DEF_MENU_SELECT_MONO}, + (ClientData) DEF_MENU_SELECT_MONO, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_MENU_TAKE_FOCUS, - Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff", - DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff)}, + DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff), 0, NULL, 0}, {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand", "TearOffCommand", DEF_MENU_TEAROFF_CMD, - Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK}, + Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING, "-title", "title", "Title", DEF_MENU_TITLE, Tk_Offset(TkMenu, titlePtr), -1, - TK_OPTION_NULL_OK}, + TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_STRING_TABLE, "-type", "type", "Type", DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK, - (ClientData) menuTypeStrings}, - {TK_OPTION_END} + (ClientData) menuTypeStrings, 0}, + {TK_OPTION_END, NULL, NULL, NULL, 0, 0, 0, 0, NULL, 0} }; /* @@ -308,7 +312,7 @@ static const Tk_OptionSpec tkMenuConfigSpecs[] = { * with MenuWidgetObjCmd. */ -static const char *menuOptions[] = { +static const char *const menuOptions[] = { "activate", "add", "cget", "clone", "configure", "delete", "entrycget", "entryconfigure", "index", "insert", "invoke", "post", "postcascade", "type", "unpost", "xposition", "yposition", NULL @@ -338,9 +342,10 @@ static void DeleteMenuCloneEntries(TkMenu *menuPtr, static void DestroyMenuHashTable(ClientData clientData, Tcl_Interp *interp); static void DestroyMenuInstance(TkMenu *menuPtr); -static void DestroyMenuEntry(char *memPtr); -static int GetIndexFromCoords(Tcl_Interp *interp, TkMenu *menuPtr, - char *string, int *indexPtr); +static void DestroyMenuEntry(void *memPtr); +static int GetIndexFromCoords(Tcl_Interp *interp, + TkMenu *menuPtr, const char *string, + int *indexPtr); static int MenuDoYPosition(Tcl_Interp *interp, TkMenu *menuPtr, Tcl_Obj *objPtr); static int MenuDoXPosition(Tcl_Interp *interp, @@ -348,8 +353,6 @@ static int MenuDoXPosition(Tcl_Interp *interp, static int MenuAddOrInsert(Tcl_Interp *interp, TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc, Tcl_Obj *const objv[]); -static int MenuCmd(ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); static void MenuCmdDeletedProc(ClientData clientData); static TkMenuEntry * MenuNewEntry(TkMenu *menuPtr, int index, int type); static char * MenuVarProc(ClientData clientData, @@ -370,72 +373,17 @@ static void TkMenuCleanup(ClientData unused); * geometry proc to be called. */ -static Tk_ClassProcs menuClass = { +static const Tk_ClassProcs menuClass = { sizeof(Tk_ClassProcs), /* size */ - MenuWorldChanged /* worldChangedProc */ + MenuWorldChanged, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* *-------------------------------------------------------------- * - * TkCreateMenuCmd -- - * - * Called by Tk at initialization time to create the menu command. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * See the user documentation. - * - *-------------------------------------------------------------- - */ - -static void -FreeOptionTables( - ClientData clientData, - Tcl_Interp *interp) -{ - ckfree(clientData); -} - -int -TkCreateMenuCmd( - Tcl_Interp *interp) /* Interpreter we are creating the command - * in. */ -{ - TkMenuOptionTables *optionTablesPtr = - (TkMenuOptionTables *) ckalloc(sizeof(TkMenuOptionTables)); - - optionTablesPtr->menuOptionTable = - Tk_CreateOptionTable(interp, tkMenuConfigSpecs); - optionTablesPtr->entryOptionTables[TEAROFF_ENTRY] = - Tk_CreateOptionTable(interp, specsArray[TEAROFF_ENTRY]); - optionTablesPtr->entryOptionTables[COMMAND_ENTRY] = - Tk_CreateOptionTable(interp, specsArray[COMMAND_ENTRY]); - optionTablesPtr->entryOptionTables[CASCADE_ENTRY] = - Tk_CreateOptionTable(interp, specsArray[CASCADE_ENTRY]); - optionTablesPtr->entryOptionTables[SEPARATOR_ENTRY] = - Tk_CreateOptionTable(interp, specsArray[SEPARATOR_ENTRY]); - optionTablesPtr->entryOptionTables[RADIO_BUTTON_ENTRY] = - Tk_CreateOptionTable(interp, specsArray[RADIO_BUTTON_ENTRY]); - optionTablesPtr->entryOptionTables[CHECK_BUTTON_ENTRY] = - Tk_CreateOptionTable(interp, specsArray[CHECK_BUTTON_ENTRY]); - - Tcl_CreateObjCommand(interp, "menu", MenuCmd, optionTablesPtr, 0); - Tcl_CallWhenDeleted(interp, FreeOptionTables, optionTablesPtr); - - if (Tcl_IsSafe(interp)) { - Tcl_HideCommand(interp, "menu", "menu"); - } - - return TCL_OK; -} - -/* - *-------------------------------------------------------------- - * - * MenuCmd -- + * Tk_MenuObjCmd -- * * This function is invoked to process the "menu" Tcl command. See the * user documentation for details on what it does. @@ -449,24 +397,25 @@ TkCreateMenuCmd( *-------------------------------------------------------------- */ -static int -MenuCmd( +int +Tk_MenuObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - Tk_Window tkwin = Tk_MainWindow(interp); + Tk_Window tkwin = clientData; Tk_Window newWin; register TkMenu *menuPtr; TkMenuReferences *menuRefPtr; int i, index, toplevel; - char *windowName; - static const char *typeStringList[] = {"-type", NULL}; - TkMenuOptionTables *optionTablesPtr = (TkMenuOptionTables *) clientData; + const char *windowName; + static const char *const typeStringList[] = {"-type", NULL}; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -474,10 +423,10 @@ MenuCmd( toplevel = 1; for (i = 2; i < (objc - 1); i++) { - if (Tcl_GetIndexFromObj(NULL, objv[i], typeStringList, NULL, 0, &index) - != TCL_ERROR) { - if ((Tcl_GetIndexFromObj(NULL, objv[i + 1], menuTypeStrings, NULL, - 0, &index) == TCL_OK) && (index == MENUBAR)) { + if (Tcl_GetIndexFromObjStruct(NULL, objv[i], typeStringList, + sizeof(char *), NULL, 0, &index) != TCL_ERROR) { + if ((Tcl_GetIndexFromObjStruct(NULL, objv[i + 1], menuTypeStrings, + sizeof(char *), NULL, 0, &index) == TCL_OK) && (index == MENUBAR)) { toplevel = 0; } break; @@ -497,28 +446,27 @@ MenuCmd( * Tcl_EventuallyFree is called. */ - menuPtr = (TkMenu *) ckalloc(sizeof(TkMenu)); + menuPtr = ckalloc(sizeof(TkMenu)); memset(menuPtr, 0, sizeof(TkMenu)); menuPtr->tkwin = newWin; menuPtr->display = Tk_Display(newWin); menuPtr->interp = interp; menuPtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd, - (ClientData) menuPtr, MenuCmdDeletedProc); + Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd, menuPtr, + MenuCmdDeletedProc); menuPtr->active = -1; menuPtr->cursorPtr = None; menuPtr->masterMenuPtr = menuPtr; menuPtr->menuType = UNKNOWN_TYPE; - menuPtr->optionTablesPtr = optionTablesPtr; TkMenuInitializeDrawingFields(menuPtr); Tk_SetClass(menuPtr->tkwin, "Menu"); - Tk_SetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr); + Tk_SetClassProcs(menuPtr->tkwin, &menuClass, menuPtr); Tk_CreateEventHandler(newWin, ExposureMask|StructureNotifyMask|ActivateMask, - TkMenuEventProc, (ClientData) menuPtr); + TkMenuEventProc, menuPtr); if (Tk_InitOptions(interp, (char *) menuPtr, - menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin) + tsdPtr->menuOptionTable, menuPtr->tkwin) != TCL_OK) { Tk_DestroyWindow(menuPtr->tkwin); return TCL_ERROR; @@ -578,7 +526,7 @@ MenuCmd( && ((cascadeListPtr->menuPtr->masterMenuPtr == cascadeListPtr->menuPtr)))) { newObjv[0] = Tcl_NewStringObj("-menu", -1); - newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1); + newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin),-1); Tcl_IncrRefCount(newObjv[0]); Tcl_IncrRefCount(newObjv[1]); ConfigureMenuEntry(cascadeListPtr, 2, newObjv); @@ -640,7 +588,7 @@ MenuCmd( } } - Tcl_SetResult(interp, Tk_PathName(menuPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(menuPtr->tkwin)); return TCL_OK; } @@ -669,20 +617,22 @@ MenuWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - register TkMenu *menuPtr = (TkMenu *) clientData; + register TkMenu *menuPtr = clientData; register TkMenuEntry *mePtr; int result = TCL_OK; int option; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], menuOptions, "option", 0, - &option) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], menuOptions, + sizeof(char *), "option", 0, &option) != TCL_OK) { return TCL_ERROR; } - Tcl_Preserve((ClientData) menuPtr); + Tcl_Preserve(menuPtr); switch ((enum options) option) { case MENU_ACTIVATE: { @@ -707,11 +657,11 @@ MenuWidgetObjCmd( } case MENU_ADD: if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "type ?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "type ?-option value ...?"); goto error; } - if (MenuAddOrInsert(interp, menuPtr, NULL, objc-2, objv+2) != TCL_OK) { + if (MenuAddOrInsert(interp, menuPtr, NULL, objc-2, objv+2) != TCL_OK){ goto error; } break; @@ -723,7 +673,7 @@ MenuWidgetObjCmd( goto error; } resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr, - menuPtr->optionTablesPtr->menuOptionTable, objv[2], + tsdPtr->menuOptionTable, objv[2], menuPtr->tkwin); if (resultPtr == NULL) { goto error; @@ -743,7 +693,7 @@ MenuWidgetObjCmd( if (objc == 2) { resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr, - menuPtr->optionTablesPtr->menuOptionTable, NULL, + tsdPtr->menuOptionTable, NULL, menuPtr->tkwin); if (resultPtr == NULL) { result = TCL_ERROR; @@ -753,7 +703,7 @@ MenuWidgetObjCmd( } } else if (objc == 3) { resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr, - menuPtr->optionTablesPtr->menuOptionTable, objv[2], + tsdPtr->menuOptionTable, objv[2], menuPtr->tkwin); if (resultPtr == NULL) { result = TCL_ERROR; @@ -825,10 +775,10 @@ MenuWidgetObjCmd( goto done; } mePtr = menuPtr->entries[index]; - Tcl_Preserve((ClientData) mePtr); + Tcl_Preserve(mePtr); resultPtr = Tk_GetOptionValue(interp, (char *) mePtr, mePtr->optionTable, objv[3], menuPtr->tkwin); - Tcl_Release((ClientData) mePtr); + Tcl_Release(mePtr); if (resultPtr == NULL) { goto error; } @@ -840,7 +790,7 @@ MenuWidgetObjCmd( Tcl_Obj *resultPtr; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "index ?option value ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "index ?-option value ...?"); goto error; } if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) { @@ -850,7 +800,7 @@ MenuWidgetObjCmd( goto done; } mePtr = menuPtr->entries[index]; - Tcl_Preserve((ClientData) mePtr); + Tcl_Preserve(mePtr); if (objc == 3) { resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr, mePtr->optionTable, NULL, menuPtr->tkwin); @@ -873,7 +823,7 @@ MenuWidgetObjCmd( result = ConfigureMenuCloneEntries(interp, menuPtr, index, objc-3, objv+3); } - Tcl_Release((ClientData) mePtr); + Tcl_Release(mePtr); break; } case MENU_INDEX: { @@ -887,15 +837,16 @@ MenuWidgetObjCmd( goto error; } if (index < 0) { - Tcl_SetResult(interp, "none", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); } else { - Tcl_SetIntObj(Tcl_GetObjResult(interp), index); + Tcl_SetObjResult(interp, Tcl_NewIntObj(index)); } break; } case MENU_INSERT: if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "index type ?options?"); + Tcl_WrongNumArgs(interp, 2, objv, + "index type ?-option value ...?"); goto error; } if (MenuAddOrInsert(interp,menuPtr,objv[2],objc-3,objv+3) != TCL_OK) { @@ -968,6 +919,7 @@ MenuWidgetObjCmd( } case MENU_TYPE: { int index; + const char *typeStr; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -980,11 +932,11 @@ MenuWidgetObjCmd( goto done; } if (menuPtr->entries[index]->type == TEAROFF_ENTRY) { - Tcl_SetResult(interp, "tearoff", TCL_STATIC); + typeStr = "tearoff"; } else { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - menuEntryTypeStrings[menuPtr->entries[index]->type], -1); + typeStr = menuEntryTypeStrings[menuPtr->entries[index]->type]; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1)); break; } case MENU_UNPOST: @@ -1011,11 +963,11 @@ MenuWidgetObjCmd( break; } done: - Tcl_Release((ClientData) menuPtr); + Tcl_Release(menuPtr); return result; error: - Tcl_Release((ClientData) menuPtr); + Tcl_Release(menuPtr); return TCL_ERROR; } @@ -1054,13 +1006,15 @@ TkInvokeMenu( if (mePtr->state == ENTRY_DISABLED) { goto done; } - Tcl_Preserve((ClientData) mePtr); + + Tcl_Preserve(mePtr); if (mePtr->type == TEAROFF_ENTRY) { Tcl_DString ds; + Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, "tk::TearOffMenu ", -1); Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1); - result = Tcl_Eval(interp, Tcl_DStringValue(&ds)); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0); Tcl_DStringFree(&ds); } else if ((mePtr->type == CHECK_BUTTON_ENTRY) && (mePtr->namePtr != NULL)) { @@ -1109,7 +1063,8 @@ TkInvokeMenu( result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(commandPtr); } - Tcl_Release((ClientData) mePtr); + Tcl_Release(mePtr); + done: return result; } @@ -1142,6 +1097,8 @@ DestroyMenuInstance( Tcl_Obj *newObjv[2]; TkMenu *parentMasterMenuPtr; TkMenuEntry *parentMasterEntryPtr; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * If the menu has any cascade menu entries pointing to it, the cascade @@ -1207,7 +1164,7 @@ DestroyMenuInstance( } } } else if (menuPtr->nextInstancePtr != NULL) { - Tcl_Panic("Attempting to delete master menu when there are still clones."); + Tcl_Panic("Attempting to delete master menu when there are still clones"); } /* @@ -1223,17 +1180,18 @@ DestroyMenuInstance( * for menu entries (i+1)...numEntries. */ - DestroyMenuEntry((char *) menuPtr->entries[i]); + DestroyMenuEntry(menuPtr->entries[i]); menuPtr->numEntries = i; } if (menuPtr->entries != NULL) { - ckfree((char *) menuPtr->entries); + ckfree(menuPtr->entries); } TkMenuFreeDrawOptions(menuPtr); Tk_FreeConfigOptions((char *) menuPtr, - menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin); + tsdPtr->menuOptionTable, menuPtr->tkwin); if (menuPtr->tkwin != NULL) { Tk_Window tkwin = menuPtr->tkwin; + menuPtr->tkwin = NULL; Tk_DestroyWindow(tkwin); } @@ -1420,9 +1378,9 @@ UnhookCascadeEntry( static void DestroyMenuEntry( - char *memPtr) /* Pointer to entry to be freed. */ + void *memPtr) /* Pointer to entry to be freed. */ { - register TkMenuEntry *mePtr = (TkMenuEntry *) memPtr; + register TkMenuEntry *mePtr = memPtr; TkMenu *menuPtr = mePtr->menuPtr; if (menuPtr->postedCascade == mePtr) { @@ -1443,13 +1401,13 @@ DestroyMenuEntry( if (mePtr->type == CASCADE_ENTRY) { if (menuPtr->masterMenuPtr != menuPtr) { TkMenu *destroyThis = NULL; + TkMenuReferences *menuRefPtr = mePtr->childMenuRefPtr; + /* * The menu as a whole is a clone. We must delete the clone of the * cascaded menu for the particular entry we are destroying. */ - TkMenuReferences *menuRefPtr = mePtr->childMenuRefPtr; - if (menuRefPtr != NULL) { destroyThis = menuRefPtr->menuPtr; @@ -1488,16 +1446,16 @@ DestroyMenuEntry( if (((mePtr->type == CHECK_BUTTON_ENTRY) || (mePtr->type == RADIO_BUTTON_ENTRY)) && (mePtr->namePtr != NULL)) { - char *varName = Tcl_GetString(mePtr->namePtr); + const char *varName = Tcl_GetString(mePtr->namePtr); - Tcl_UntraceVar(menuPtr->interp, varName, + Tcl_UntraceVar2(menuPtr->interp, varName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuVarProc, (ClientData) mePtr); + MenuVarProc, mePtr); } TkpDestroyMenuEntry(mePtr); TkMenuEntryFreeDrawOptions(mePtr); Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin); - ckfree((char *) mePtr); + ckfree(mePtr); } /* @@ -1522,7 +1480,7 @@ static void MenuWorldChanged( ClientData instanceData) /* Information about widget. */ { - TkMenu *menuPtr = (TkMenu *) instanceData; + TkMenu *menuPtr = instanceData; int i; TkMenuConfigureDrawOptions(menuPtr); @@ -1564,25 +1522,26 @@ ConfigureMenu( int i; TkMenu *menuListPtr, *cleanupPtr; int result; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL; menuListPtr = menuListPtr->nextInstancePtr) { - menuListPtr->errorStructPtr = (Tk_SavedOptions *) - ckalloc(sizeof(Tk_SavedOptions)); + menuListPtr->errorStructPtr = ckalloc(sizeof(Tk_SavedOptions)); result = Tk_SetOptions(interp, (char *) menuListPtr, - menuListPtr->optionTablesPtr->menuOptionTable, objc, objv, + tsdPtr->menuOptionTable, objc, objv, menuListPtr->tkwin, menuListPtr->errorStructPtr, NULL); if (result != TCL_OK) { for (cleanupPtr = menuPtr->masterMenuPtr; cleanupPtr != menuListPtr; cleanupPtr = cleanupPtr->nextInstancePtr) { Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr); - ckfree((char *) cleanupPtr->errorStructPtr); + ckfree(cleanupPtr->errorStructPtr); cleanupPtr->errorStructPtr = NULL; } if (menuListPtr->errorStructPtr != NULL) { Tk_RestoreSavedOptions(menuListPtr->errorStructPtr); - ckfree((char *) menuListPtr->errorStructPtr); + ckfree(menuListPtr->errorStructPtr); menuListPtr->errorStructPtr = NULL; } return TCL_ERROR; @@ -1596,8 +1555,8 @@ ConfigureMenu( */ if (menuListPtr->menuType == UNKNOWN_TYPE) { - Tcl_GetIndexFromObj(NULL, menuListPtr->menuTypePtr, - menuTypeStrings, NULL, 0, &menuListPtr->menuType); + Tcl_GetIndexFromObjStruct(NULL, menuListPtr->menuTypePtr, + menuTypeStrings, sizeof(char *), NULL, 0, &menuListPtr->menuType); /* * Configure the new window to be either a pop-up menu or a @@ -1608,13 +1567,31 @@ ConfigureMenu( */ if (menuListPtr->menuType == MASTER_MENU) { - TkpMakeMenuWindow(menuListPtr->tkwin, 1); + int typeFlag = TK_MAKE_MENU_POPUP; + Tk_Window tkwin = menuPtr->tkwin; + + /* + * Work out if we are the child of a menubar or a popup. + */ + + while (1) { + Tk_Window parent = Tk_Parent(tkwin); + + if (Tk_Class(parent) != Tk_Class(menuPtr->tkwin)) { + break; + } + tkwin = parent; + } + if (((TkMenu *) tkwin)->menuType == MENUBAR) { + typeFlag = TK_MAKE_MENU_DROPDOWN; + } + + TkpMakeMenuWindow(menuListPtr->tkwin, typeFlag); } else if (menuListPtr->menuType == TEAROFF_MENU) { - TkpMakeMenuWindow(menuListPtr->tkwin, 0); + TkpMakeMenuWindow(menuListPtr->tkwin, TK_MAKE_MENU_TEAROFF); } } - /* * Depending on the -tearOff option, make sure that there is or isn't * an initial tear-off entry at the beginning of the menu. @@ -1625,15 +1602,15 @@ ConfigureMenu( || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) { if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) { for (cleanupPtr = menuPtr->masterMenuPtr; - cleanupPtr != menuListPtr; - cleanupPtr = cleanupPtr->nextInstancePtr) { + cleanupPtr != menuListPtr; + cleanupPtr = cleanupPtr->nextInstancePtr) { Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr); - ckfree((char *) cleanupPtr->errorStructPtr); + ckfree(cleanupPtr->errorStructPtr); cleanupPtr->errorStructPtr = NULL; } if (menuListPtr->errorStructPtr != NULL) { Tk_RestoreSavedOptions(menuListPtr->errorStructPtr); - ckfree((char *) menuListPtr->errorStructPtr); + ckfree(menuListPtr->errorStructPtr); menuListPtr->errorStructPtr = NULL; } return TCL_ERROR; @@ -1643,8 +1620,7 @@ ConfigureMenu( && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) { int i; - Tcl_EventuallyFree((ClientData) menuListPtr->entries[0], - DestroyMenuEntry); + Tcl_EventuallyFree(menuListPtr->entries[0], (Tcl_FreeProc *) DestroyMenuEntry); for (i = 0; i < menuListPtr->numEntries - 1; i++) { menuListPtr->entries[i] = menuListPtr->entries[i + 1]; @@ -1652,7 +1628,7 @@ ConfigureMenu( } menuListPtr->numEntries--; if (menuListPtr->numEntries == 0) { - ckfree((char *) menuListPtr->entries); + ckfree(menuListPtr->entries); menuListPtr->entries = NULL; } } @@ -1679,7 +1655,7 @@ ConfigureMenu( for (cleanupPtr = menuPtr->masterMenuPtr; cleanupPtr != NULL; cleanupPtr = cleanupPtr->nextInstancePtr) { Tk_FreeSavedOptions(cleanupPtr->errorStructPtr); - ckfree((char *) cleanupPtr->errorStructPtr); + ckfree(cleanupPtr->errorStructPtr); cleanupPtr->errorStructPtr = NULL; } @@ -1712,7 +1688,7 @@ PostProcessEntry( { TkMenu *menuPtr = mePtr->menuPtr; int index = mePtr->index; - char *name; + const char *name; Tk_Image image; /* @@ -1724,12 +1700,12 @@ PostProcessEntry( if (mePtr->labelPtr == NULL) { mePtr->labelLength = 0; } else { - Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength); + (void)Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength); } if (mePtr->accelPtr == NULL) { mePtr->accelLength = 0; } else { - Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength); + (void)Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength); } /* @@ -1805,10 +1781,10 @@ PostProcessEntry( */ if (mePtr->imagePtr != NULL) { - char *imageString = Tcl_GetString(mePtr->imagePtr); + const char *imageString = Tcl_GetString(mePtr->imagePtr); image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, imageString, - TkMenuImageProc, (ClientData) mePtr); + TkMenuImageProc, mePtr); if (image == NULL) { return TCL_ERROR; } @@ -1820,10 +1796,10 @@ PostProcessEntry( } mePtr->image = image; if (mePtr->selectImagePtr != NULL) { - char *selectImageString = Tcl_GetString(mePtr->selectImagePtr); + const char *selectImageString = Tcl_GetString(mePtr->selectImagePtr); image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, selectImageString, - TkMenuSelectImageProc, (ClientData) mePtr); + TkMenuSelectImageProc, mePtr); if (image == NULL) { return TCL_ERROR; } @@ -1838,7 +1814,7 @@ PostProcessEntry( if ((mePtr->type == CHECK_BUTTON_ENTRY) || (mePtr->type == RADIO_BUTTON_ENTRY)) { Tcl_Obj *valuePtr; - char *name; + const char *name; if (mePtr->namePtr == NULL) { if (mePtr->labelPtr == NULL) { @@ -1872,8 +1848,8 @@ PostProcessEntry( mePtr->entryFlags &= ~ENTRY_SELECTED; if (valuePtr != NULL) { if (mePtr->onValuePtr != NULL) { - char *value = Tcl_GetString(valuePtr); - char *onValue = Tcl_GetString(mePtr->onValuePtr); + const char *value = Tcl_GetString(valuePtr); + const char *onValue = Tcl_GetString(mePtr->onValuePtr); if (strcmp(value, onValue) == 0) { mePtr->entryFlags |= ENTRY_SELECTED; @@ -1888,9 +1864,9 @@ PostProcessEntry( } if (mePtr->namePtr != NULL) { name = Tcl_GetString(mePtr->namePtr); - Tcl_TraceVar(menuPtr->interp, name, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuVarProc, (ClientData) mePtr); + Tcl_TraceVar2(menuPtr->interp, name, + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + MenuVarProc, mePtr); } } @@ -1939,11 +1915,11 @@ ConfigureMenuEntry( if ((mePtr->namePtr != NULL) && ((mePtr->type == CHECK_BUTTON_ENTRY) || (mePtr->type == RADIO_BUTTON_ENTRY))) { - char *name = Tcl_GetString(mePtr->namePtr); + const char *name = Tcl_GetString(mePtr->namePtr); - Tcl_UntraceVar(menuPtr->interp, name, + Tcl_UntraceVar2(menuPtr->interp, name, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuVarProc, (ClientData) mePtr); + MenuVarProc, mePtr); } result = TCL_OK; @@ -1997,7 +1973,7 @@ ConfigureMenuCloneEntries( int cascadeEntryChanged = 0; TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL; Tcl_Obj *oldCascadePtr = NULL; - char *newCascadeName; + const char *newCascadeName; /* * Cascades are kind of tricky here. This is special case #3 in the @@ -2021,7 +1997,7 @@ ConfigureMenuCloneEntries( } if (mePtr->type == CASCADE_ENTRY) { - char *oldCascadeName; + const char *oldCascadeName; if (mePtr->namePtr != NULL) { newCascadeName = Tcl_GetString(mePtr->namePtr); @@ -2074,7 +2050,7 @@ ConfigureMenuCloneEntries( } if (cascadeEntryChanged && (mePtr->namePtr != NULL)) { - if (cascadeMenuRefPtr->menuPtr != NULL) { + if (cascadeMenuRefPtr && cascadeMenuRefPtr->menuPtr != NULL) { Tcl_Obj *newObjv[2]; Tcl_Obj *newCloneNamePtr; Tcl_Obj *pathNamePtr = Tcl_NewStringObj( @@ -2137,7 +2113,7 @@ TkGetMenuIndex( int *indexPtr) /* Where to store converted index. */ { int i; - char *string = Tcl_GetString(objPtr); + const char *string = Tcl_GetString(objPtr); if ((string[0] == 'a') && (strcmp(string, "active") == 0)) { *indexPtr = menuPtr->active; @@ -2176,12 +2152,12 @@ TkGetMenuIndex( *indexPtr = i; goto success; } - Tcl_SetResult(interp, NULL, TCL_STATIC); + Tcl_ResetResult(interp); } for (i = 0; i < menuPtr->numEntries; i++) { Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr; - char *label = (labelPtr == NULL) ? NULL : Tcl_GetString(labelPtr); + const char *label = (labelPtr == NULL) ? NULL : Tcl_GetString(labelPtr); if ((label != NULL) && (Tcl_StringMatch(label, string))) { *indexPtr = i; @@ -2189,7 +2165,9 @@ TkGetMenuIndex( } } - Tcl_AppendResult(interp, "bad menu entry index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad menu entry index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL); return TCL_ERROR; success: @@ -2218,7 +2196,7 @@ static void MenuCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - TkMenu *menuPtr = (TkMenu *) clientData; + TkMenu *menuPtr = clientData; Tk_Window tkwin = menuPtr->tkwin; /* @@ -2267,13 +2245,14 @@ MenuNewEntry( TkMenuEntry *mePtr; TkMenuEntry **newEntries; int i; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Create a new array of entries with an empty slot for the new entry. */ - newEntries = (TkMenuEntry **) ckalloc((unsigned) - ((menuPtr->numEntries+1)*sizeof(TkMenuEntry *))); + newEntries = ckalloc((menuPtr->numEntries+1) * sizeof(TkMenuEntry *)); for (i = 0; i < index; i++) { newEntries[i] = menuPtr->entries[i]; } @@ -2282,14 +2261,14 @@ MenuNewEntry( newEntries[i+1]->index = i + 1; } if (menuPtr->numEntries != 0) { - ckfree((char *) menuPtr->entries); + ckfree(menuPtr->entries); } menuPtr->entries = newEntries; menuPtr->numEntries++; - mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry)); + mePtr = ckalloc(sizeof(TkMenuEntry)); menuPtr->entries[index] = mePtr; mePtr->type = type; - mePtr->optionTable = menuPtr->optionTablesPtr->entryOptionTables[type]; + mePtr->optionTable = tsdPtr->entryOptionTables[type]; mePtr->menuPtr = menuPtr; mePtr->labelPtr = NULL; mePtr->labelLength = 0; @@ -2321,14 +2300,14 @@ MenuNewEntry( mePtr->nextCascadePtr = NULL; if (Tk_InitOptions(menuPtr->interp, (char *) mePtr, mePtr->optionTable, menuPtr->tkwin) != TCL_OK) { - ckfree((char *) mePtr); + ckfree(mePtr); return NULL; } TkMenuInitializeEntryDrawingFields(mePtr); if (TkpMenuNewEntry(mePtr) != TCL_OK) { Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin); - ckfree((char *) mePtr); + ckfree(mePtr); return NULL; } @@ -2374,8 +2353,9 @@ MenuAddOrInsert( index = menuPtr->numEntries; } if (index < 0) { - char *indexString = Tcl_GetString(indexPtr); - Tcl_AppendResult(interp, "bad index \"", indexString, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\"", Tcl_GetString(indexPtr))); + Tcl_SetErrorCode(interp, "TK", "MENU", "INDEX", NULL); return TCL_ERROR; } if (menuPtr->tearoff && (index == 0)) { @@ -2386,8 +2366,8 @@ MenuAddOrInsert( * Figure out the type of the new entry. */ - if (Tcl_GetIndexFromObj(interp, objv[0], menuEntryTypeStrings, - "menu entry type", 0, &type) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[0], menuEntryTypeStrings, + sizeof(char *), "menu entry type", 0, &type) != TCL_OK) { return TCL_ERROR; } @@ -2409,15 +2389,15 @@ MenuAddOrInsert( for (errorMenuPtr = menuPtr->masterMenuPtr; errorMenuPtr != NULL; errorMenuPtr = errorMenuPtr->nextInstancePtr) { - Tcl_EventuallyFree((ClientData) errorMenuPtr->entries[index], - DestroyMenuEntry); + Tcl_EventuallyFree(errorMenuPtr->entries[index], + (Tcl_FreeProc *) DestroyMenuEntry); for (i = index; i < errorMenuPtr->numEntries - 1; i++) { errorMenuPtr->entries[i] = errorMenuPtr->entries[i + 1]; errorMenuPtr->entries[i]->index = i; } errorMenuPtr->numEntries--; if (errorMenuPtr->numEntries == 0) { - ckfree((char *) errorMenuPtr->entries); + ckfree(errorMenuPtr->entries); errorMenuPtr->entries = NULL; } if (errorMenuPtr == menuListPtr) { @@ -2458,7 +2438,7 @@ MenuAddOrInsert( menuRefPtr = TkFindMenuReferencesObj(menuListPtr->interp, newCascadePtr); if (menuRefPtr == NULL) { - Tcl_Panic("CloneMenu failed inside of MenuAddOrInsert."); + Tcl_Panic("CloneMenu failed inside of MenuAddOrInsert"); } newObjv[0] = menuNamePtr; newObjv[1] = newCascadePtr; @@ -2501,11 +2481,10 @@ MenuVarProc( const char *name2, /* Second part of variable's name. */ int flags) /* Describes what just happened. */ { - TkMenuEntry *mePtr = (TkMenuEntry *) clientData; + TkMenuEntry *mePtr = clientData; TkMenu *menuPtr; const char *value; - char *name; - char *onValue; + const char *name, *onValue; if (flags & TCL_INTERP_DESTROYED) { /* @@ -2525,7 +2504,7 @@ MenuVarProc( if (flags & TCL_TRACE_UNSETS) { mePtr->entryFlags &= ~ENTRY_SELECTED; if (flags & TCL_TRACE_DESTROYED) { - Tcl_TraceVar(interp, name, + Tcl_TraceVar2(interp, name, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuVarProc, clientData); } @@ -2539,7 +2518,7 @@ MenuVarProc( * entry. */ - value = Tcl_GetVar(interp, name, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2(interp, name, NULL, TCL_GLOBAL_ONLY); if (value == NULL) { value = ""; } @@ -2692,8 +2671,8 @@ CloneMenu( if (newMenuTypePtr == NULL) { menuType = MASTER_MENU; } else { - if (Tcl_GetIndexFromObj(menuPtr->interp, newMenuTypePtr, - menuTypeStrings, "menu type", 0, &menuType) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(menuPtr->interp, newMenuTypePtr, + menuTypeStrings, sizeof(char *), "menu type", 0, &menuType) != TCL_OK) { return TCL_ERROR; } } @@ -2709,7 +2688,7 @@ CloneMenu( for (i = 0; i < 4; i++) { Tcl_IncrRefCount(menuDupCommandArray[i]); } - Tcl_Preserve((ClientData) menuPtr); + Tcl_Preserve(menuPtr); returnResult = Tcl_EvalObjv(menuPtr->interp, 4, menuDupCommandArray, 0); for (i = 0; i < 4; i++) { Tcl_DecrRefCount(menuDupCommandArray[i]); @@ -2755,9 +2734,9 @@ CloneMenu( newObjv[1] = Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin), -1); Tcl_IncrRefCount(newObjv[0]); Tcl_IncrRefCount(newObjv[1]); - if (Tk_BindtagsObjCmd((ClientData)newMenuPtr->tkwin, - newMenuPtr->interp, 2, newObjv) == TCL_OK) { - char *windowName; + if (Tk_BindtagsObjCmd(newMenuPtr->tkwin, newMenuPtr->interp, 2, + newObjv) == TCL_OK) { + const char *windowName; Tcl_Obj *bindingsPtr = Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp)); Tcl_Obj *elementPtr; @@ -2781,8 +2760,8 @@ CloneMenu( Tcl_ListObjReplace(menuPtr->interp, bindingsPtr, i + 1, 0, 1, &newElementPtr); newObjv[2] = bindingsPtr; - Tk_BindtagsObjCmd((ClientData)newMenuPtr->tkwin, - menuPtr->interp, 3, newObjv); + Tk_BindtagsObjCmd(newMenuPtr->tkwin, menuPtr->interp, 3, + newObjv); break; } } @@ -2834,7 +2813,7 @@ CloneMenu( } else { returnResult = TCL_ERROR; } - Tcl_Release((ClientData) menuPtr); + Tcl_Release(menuPtr); return returnResult; } @@ -2939,11 +2918,12 @@ static int GetIndexFromCoords( Tcl_Interp *interp, /* Interpreter of menu. */ TkMenu *menuPtr, /* The menu we are searching. */ - char *string, /* The @string we are parsing. */ + const char *string, /* The @string we are parsing. */ int *indexPtr) /* The index of the item that matches. */ { int x, y, i; - char *p, *end; + const char *p; + char *end; int x2, borderwidth, max; TkRecomputeMenu(menuPtr); @@ -2967,10 +2947,10 @@ GetIndexFromCoords( *indexPtr = -1; - /* set the width of the final column to the remainder of the window + /* set the width of the final column to the remainder of the window * being aware of windows that may not be mapped yet. */ - max = Tk_IsMapped(menuPtr->tkwin) + max = Tk_IsMapped(menuPtr->tkwin) ? Tk_Width(menuPtr->tkwin) : Tk_ReqWidth(menuPtr->tkwin); max -= borderwidth; @@ -2991,7 +2971,7 @@ GetIndexFromCoords( return TCL_OK; error: - Tcl_SetResult(interp, NULL, TCL_STATIC); + Tcl_ResetResult(interp); return TCL_ERROR; } @@ -3070,10 +3050,9 @@ TkNewMenuName( char *destString; int i; int doDot; - Tcl_CmdInfo cmdInfo; Tcl_HashTable *nameTablePtr = NULL; TkWindow *winPtr = (TkWindow *) menuPtr->tkwin; - char *parentName = Tcl_GetString(parentPtr); + const char *parentName = Tcl_GetString(parentPtr); if (winPtr->mainPtr != NULL) { nameTablePtr = &(winPtr->mainPtr->nameTable); @@ -3110,7 +3089,7 @@ TkNewMenuName( Tcl_DecrRefCount(intPtr); } destString = Tcl_GetString(resultPtr); - if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0) + if ((Tcl_FindCommand(interp, destString, NULL, 0) == NULL) && ((nameTablePtr == NULL) || (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) { break; @@ -3142,10 +3121,10 @@ void TkSetWindowMenuBar( Tcl_Interp *interp, /* The interpreter the toplevel lives in. */ Tk_Window tkwin, /* The toplevel window. */ - char *oldMenuName, /* The name of the menubar previously set in + const char *oldMenuName, /* The name of the menubar previously set in * this toplevel. NULL means no menu was set * previously. */ - char *menuName) /* The name of the new menubar that the + const char *menuName) /* The name of the new menubar that the * toplevel needs to be set to. NULL means * that their is no menu now. */ { @@ -3208,7 +3187,7 @@ TkSetWindowMenuBar( } else { prevTopLevelPtr->nextPtr = topLevelListPtr->nextPtr; } - ckfree((char *) topLevelListPtr); + ckfree(topLevelListPtr); TkFreeMenuReferences(menuRefPtr); } } @@ -3248,6 +3227,7 @@ TkSetWindowMenuBar( && (cloneMenuRefPtr->menuPtr != NULL)) { Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1); Tcl_Obj *nullPtr = Tcl_NewObj(); + cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin; menuBarPtr = cloneMenuRefPtr->menuPtr; newObjv[0] = cursorPtr; @@ -3273,8 +3253,7 @@ TkSetWindowMenuBar( * menu. */ - topLevelListPtr = (TkMenuTopLevelList *) - ckalloc(sizeof(TkMenuTopLevelList)); + topLevelListPtr = ckalloc(sizeof(TkMenuTopLevelList)); topLevelListPtr->tkwin = tkwin; topLevelListPtr->nextPtr = menuRefPtr->topLevelListPtr; menuRefPtr->topLevelListPtr = topLevelListPtr; @@ -3306,8 +3285,8 @@ DestroyMenuHashTable( ClientData clientData, /* The menu hash table we are destroying. */ Tcl_Interp *interp) /* The interpreter we are destroying. */ { - Tcl_DeleteHashTable((Tcl_HashTable *) clientData); - ckfree((char *) clientData); + Tcl_DeleteHashTable(clientData); + ckfree(clientData); } /* @@ -3332,15 +3311,14 @@ Tcl_HashTable * TkGetMenuHashTable( Tcl_Interp *interp) /* The interp we need the hash table in.*/ { - Tcl_HashTable *menuTablePtr; - - menuTablePtr = (Tcl_HashTable *) + Tcl_HashTable *menuTablePtr = Tcl_GetAssocData(interp, MENU_HASH_KEY, NULL); + if (menuTablePtr == NULL) { - menuTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + menuTablePtr = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(menuTablePtr, TCL_STRING_KEYS); Tcl_SetAssocData(interp, MENU_HASH_KEY, DestroyMenuHashTable, - (ClientData) menuTablePtr); + menuTablePtr); } return menuTablePtr; } @@ -3369,7 +3347,7 @@ TkGetMenuHashTable( TkMenuReferences * TkCreateMenuReferences( Tcl_Interp *interp, - char *pathName) /* The path of the menu widget. */ + const char *pathName) /* The path of the menu widget. */ { Tcl_HashEntry *hashEntryPtr; TkMenuReferences *menuRefPtr; @@ -3378,14 +3356,14 @@ TkCreateMenuReferences( hashEntryPtr = Tcl_CreateHashEntry(menuTablePtr, pathName, &newEntry); if (newEntry) { - menuRefPtr = (TkMenuReferences *) ckalloc(sizeof(TkMenuReferences)); + menuRefPtr = ckalloc(sizeof(TkMenuReferences)); menuRefPtr->menuPtr = NULL; menuRefPtr->topLevelListPtr = NULL; menuRefPtr->parentEntryPtr = NULL; menuRefPtr->hashEntryPtr = hashEntryPtr; - Tcl_SetHashValue(hashEntryPtr, (char *) menuRefPtr); + Tcl_SetHashValue(hashEntryPtr, menuRefPtr); } else { - menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr); + menuRefPtr = Tcl_GetHashValue(hashEntryPtr); } return menuRefPtr; } @@ -3413,7 +3391,7 @@ TkCreateMenuReferences( TkMenuReferences * TkFindMenuReferences( Tcl_Interp *interp, /* The interp the menu is living in. */ - char *pathName) /* The path of the menu widget. */ + const char *pathName) /* The path of the menu widget. */ { Tcl_HashEntry *hashEntryPtr; TkMenuReferences *menuRefPtr = NULL; @@ -3422,7 +3400,7 @@ TkFindMenuReferences( menuTablePtr = TkGetMenuHashTable(interp); hashEntryPtr = Tcl_FindHashEntry(menuTablePtr, pathName); if (hashEntryPtr != NULL) { - menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr); + menuRefPtr = Tcl_GetHashValue(hashEntryPtr); } return menuRefPtr; } @@ -3452,7 +3430,8 @@ TkFindMenuReferencesObj( Tcl_Interp *interp, /* The interp the menu is living in. */ Tcl_Obj *objPtr) /* The path of the menu widget. */ { - char *pathName = Tcl_GetString(objPtr); + const char *pathName = Tcl_GetString(objPtr); + return TkFindMenuReferences(interp, pathName); } @@ -3483,7 +3462,7 @@ TkFreeMenuReferences( && (menuRefPtr->parentEntryPtr == NULL) && (menuRefPtr->topLevelListPtr == NULL)) { Tcl_DeleteHashEntry(menuRefPtr->hashEntryPtr); - ckfree((char *) menuRefPtr); + ckfree(menuRefPtr); return 1; } return 0; @@ -3520,8 +3499,7 @@ DeleteMenuCloneEntries( for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL; menuListPtr = menuListPtr->nextInstancePtr) { for (i = last; i >= first; i--) { - Tcl_EventuallyFree((ClientData) menuListPtr->entries[i], - DestroyMenuEntry); + Tcl_EventuallyFree(menuListPtr->entries[i], (Tcl_FreeProc *) DestroyMenuEntry); } for (i = last + 1; i < menuListPtr->numEntries; i++) { j = i - numDeleted; @@ -3530,7 +3508,7 @@ DeleteMenuCloneEntries( } menuListPtr->numEntries -= numDeleted; if (menuListPtr->numEntries == 0) { - ckfree((char *) menuListPtr->entries); + ckfree(menuListPtr->entries); menuListPtr->entries = NULL; } if ((menuListPtr->active >= first) @@ -3587,7 +3565,7 @@ TkMenuCleanup( void TkMenuInit(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!menusInitialized) { @@ -3606,6 +3584,20 @@ TkMenuInit(void) } if (!tsdPtr->menusInitialized) { TkpMenuThreadInit(); + tsdPtr->menuOptionTable = + Tk_CreateOptionTable(NULL, tkMenuConfigSpecs); + tsdPtr->entryOptionTables[TEAROFF_ENTRY] = + Tk_CreateOptionTable(NULL, specsArray[TEAROFF_ENTRY]); + tsdPtr->entryOptionTables[COMMAND_ENTRY] = + Tk_CreateOptionTable(NULL, specsArray[COMMAND_ENTRY]); + tsdPtr->entryOptionTables[CASCADE_ENTRY] = + Tk_CreateOptionTable(NULL, specsArray[CASCADE_ENTRY]); + tsdPtr->entryOptionTables[SEPARATOR_ENTRY] = + Tk_CreateOptionTable(NULL, specsArray[SEPARATOR_ENTRY]); + tsdPtr->entryOptionTables[RADIO_BUTTON_ENTRY] = + Tk_CreateOptionTable(NULL, specsArray[RADIO_BUTTON_ENTRY]); + tsdPtr->entryOptionTables[CHECK_BUTTON_ENTRY] = + Tk_CreateOptionTable(NULL, specsArray[CHECK_BUTTON_ENTRY]); tsdPtr->menusInitialized = 1; } } diff --git a/generic/tkMenu.h b/generic/tkMenu.h index e8470ca..bac51aa 100644 --- a/generic/tkMenu.h +++ b/generic/tkMenu.h @@ -25,11 +25,6 @@ #include "default.h" #endif -#ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif - /* * Dummy types used by the platform menu code. */ @@ -252,8 +247,6 @@ typedef struct TkMenuEntry { * Menu states */ -MODULE_SCOPE const char *tkMenuStateStrings[]; - #define ENTRY_ACTIVE 0 #define ENTRY_NORMAL 1 #define ENTRY_DISABLED 2 @@ -366,10 +359,7 @@ typedef struct TkMenu { /* A pointer to the original menu for this * clone chain. Points back to this structure * if this menu is a master menu. */ - struct TkMenuOptionTables *optionTablesPtr; - /* A pointer to the collection of option - * tables that work with menus and menu - * entries. */ + void *reserved1; /* not used any more. */ Tk_Window parentTopLevelPtr;/* If this menu is a menubar, this is the * toplevel that owns the menu. Only * applicable for menubar clones. */ @@ -438,17 +428,6 @@ typedef struct TkMenuReferences { } TkMenuReferences; /* - * This structure contains all of the option tables that are needed by menus. - */ - -typedef struct TkMenuOptionTables { - Tk_OptionTable menuOptionTable; - /* The option table for menus. */ - Tk_OptionTable entryOptionTables[6]; - /* The tables for menu entries. */ -} TkMenuOptionTables; - -/* * Flag bits for menus: * * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has @@ -505,12 +484,12 @@ typedef struct TkMenuOptionTables { MODULE_SCOPE int TkActivateMenuEntry(TkMenu *menuPtr, int index); MODULE_SCOPE void TkBindMenu(Tk_Window tkwin, TkMenu *menuPtr); MODULE_SCOPE TkMenuReferences*TkCreateMenuReferences(Tcl_Interp *interp, - char *name); + const char *name); MODULE_SCOPE void TkDestroyMenu(TkMenu *menuPtr); MODULE_SCOPE void TkEventuallyRecomputeMenu(TkMenu *menuPtr); MODULE_SCOPE void TkEventuallyRedrawMenu(TkMenu *menuPtr, TkMenuEntry *mePtr); -MODULE_SCOPE TkMenuReferences*TkFindMenuReferences(Tcl_Interp *interp, char *name); +MODULE_SCOPE TkMenuReferences*TkFindMenuReferences(Tcl_Interp *interp, const char *name); MODULE_SCOPE TkMenuReferences*TkFindMenuReferencesObj(Tcl_Interp *interp, Tcl_Obj *namePtr); MODULE_SCOPE int TkFreeMenuReferences(TkMenuReferences *menuRefPtr); @@ -567,7 +546,4 @@ MODULE_SCOPE int TkpPostMenu(Tcl_Interp *interp, TkMenu *menuPtr, int x, int y); MODULE_SCOPE void TkpSetWindowMenuBar(Tk_Window tkwin, TkMenu *menuPtr); -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TKMENU */ diff --git a/generic/tkMenuDraw.c b/generic/tkMenuDraw.c index c49f513..1abe1c4 100644 --- a/generic/tkMenuDraw.c +++ b/generic/tkMenuDraw.c @@ -432,7 +432,7 @@ TkEventuallyRecomputeMenu( { if (!(menuPtr->menuFlags & RESIZE_PENDING)) { menuPtr->menuFlags |= RESIZE_PENDING; - Tcl_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr); + Tcl_DoWhenIdle(ComputeMenuGeometry, menuPtr); } } @@ -458,8 +458,8 @@ TkRecomputeMenu( TkMenu *menuPtr) { if (menuPtr->menuFlags & RESIZE_PENDING) { - Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr); - ComputeMenuGeometry((ClientData) menuPtr); + Tcl_CancelIdleCall(ComputeMenuGeometry, menuPtr); + ComputeMenuGeometry(menuPtr); } } @@ -503,7 +503,7 @@ TkEventuallyRedrawMenu( || (menuPtr->menuFlags & REDRAW_PENDING)) { return; } - Tcl_DoWhenIdle(DisplayMenu, (ClientData) menuPtr); + Tcl_DoWhenIdle(DisplayMenu, menuPtr); menuPtr->menuFlags |= REDRAW_PENDING; } @@ -530,7 +530,7 @@ static void ComputeMenuGeometry( ClientData clientData) /* Structure describing menu. */ { - TkMenu *menuPtr = (TkMenu *) clientData; + TkMenu *menuPtr = clientData; if (menuPtr->tkwin == NULL) { return; @@ -586,12 +586,12 @@ TkMenuSelectImageProc( * <=0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkMenuEntry *mePtr = (TkMenuEntry *) clientData; + register TkMenuEntry *mePtr = clientData; if ((mePtr->entryFlags & ENTRY_SELECTED) && !(mePtr->menuPtr->menuFlags & REDRAW_PENDING)) { mePtr->menuPtr->menuFlags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayMenu, (ClientData) mePtr->menuPtr); + Tcl_DoWhenIdle(DisplayMenu, mePtr->menuPtr); } } @@ -615,7 +615,7 @@ static void DisplayMenu( ClientData clientData) /* Information about widget. */ { - register TkMenu *menuPtr = (TkMenu *) clientData; + register TkMenu *menuPtr = clientData; register TkMenuEntry *mePtr; register Tk_Window tkwin = menuPtr->tkwin; int index, strictMotif; @@ -745,7 +745,7 @@ TkMenuEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - TkMenu *menuPtr = (TkMenu *) clientData; + TkMenu *menuPtr = clientData; if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) { TkEventuallyRedrawMenu(menuPtr, NULL); @@ -772,14 +772,14 @@ TkMenuEventProc( menuPtr->widgetCmd = NULL; } if (menuPtr->menuFlags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayMenu, (ClientData) menuPtr); + Tcl_CancelIdleCall(DisplayMenu, menuPtr); menuPtr->menuFlags &= ~REDRAW_PENDING; } if (menuPtr->menuFlags & RESIZE_PENDING) { - Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr); + Tcl_CancelIdleCall(ComputeMenuGeometry, menuPtr); menuPtr->menuFlags &= ~RESIZE_PENDING; } - Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(menuPtr, TCL_DYNAMIC); } } @@ -810,11 +810,11 @@ TkMenuImageProc( * <=0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkMenu *menuPtr = ((TkMenuEntry *)clientData)->menuPtr; + register TkMenu *menuPtr = ((TkMenuEntry *) clientData)->menuPtr; if ((menuPtr->tkwin != NULL) && !(menuPtr->menuFlags & RESIZE_PENDING)) { menuPtr->menuFlags |= RESIZE_PENDING; - Tcl_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr); + Tcl_DoWhenIdle(ComputeMenuGeometry, menuPtr); } } diff --git a/generic/tkMenubutton.c b/generic/tkMenubutton.c index 94ac8b2..1a4d5ae 100644 --- a/generic/tkMenubutton.c +++ b/generic/tkMenubutton.c @@ -16,6 +16,18 @@ #include "default.h" /* + * The structure below defines menubutton class behavior by means of + * procedures that can be invoked from generic window code. + */ + +static const Tk_ClassProcs menubuttonClass = { + sizeof(Tk_ClassProcs), /* size */ + TkMenuButtonWorldChanged, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ +}; + +/* * The following table defines the legal values for the -direction option. It * is used together with the "enum direction" declaration in tkMenubutton.h. */ @@ -54,13 +66,13 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background", DEF_MENUBUTTON_ACTIVE_FG_COLOR, -1, Tk_Offset(TkMenuButton, activeFg), - 0, (ClientData) DEF_MENUBUTTON_ACTIVE_FG_MONO, 0}, + 0, DEF_MENUBUTTON_ACTIVE_FG_MONO, 0}, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", DEF_MENUBUTTON_ANCHOR, -1, Tk_Offset(TkMenuButton, anchor), 0, 0, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_MENUBUTTON_BG_COLOR, -1, Tk_Offset(TkMenuButton, normalBorder), - 0, (ClientData) DEF_MENUBUTTON_BG_MONO, 0}, + 0, DEF_MENUBUTTON_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, NULL, 0, -1, 0, @@ -76,7 +88,7 @@ static const Tk_OptionSpec optionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-direction", "direction", "Direction", DEF_MENUBUTTON_DIRECTION, -1, Tk_Offset(TkMenuButton, direction), - 0, (ClientData) directionStrings, 0}, + 0, directionStrings, 0}, {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground", "DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_COLOR, -1, Tk_Offset(TkMenuButton, disabledFg), TK_OPTION_NULL_OK, @@ -121,10 +133,10 @@ static const Tk_OptionSpec optionSpecs[] = { 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound", DEF_BUTTON_COMPOUND, -1, Tk_Offset(TkMenuButton, compound), 0, - (ClientData) compoundStrings, 0}, + compoundStrings, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_MENUBUTTON_STATE, -1, Tk_Offset(TkMenuButton, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_MENUBUTTON_TAKE_FOCUS, -1, Tk_Offset(TkMenuButton, takeFocus), TK_OPTION_NULL_OK, 0, 0}, @@ -142,7 +154,7 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", DEF_MENUBUTTON_WRAP_LENGTH, -1, Tk_Offset(TkMenuButton, wrapLength), 0, 0, 0}, - {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0} + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; /* @@ -151,7 +163,7 @@ static const Tk_OptionSpec optionSpecs[] = { * dispatch the scale widget command. */ -static const char *commandNames[] = { +static const char *const commandNames[] = { "cget", "configure", NULL }; @@ -210,7 +222,7 @@ Tk_MenubuttonObjCmd( Tk_Window tkwin; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -234,18 +246,18 @@ Tk_MenubuttonObjCmd( Tk_SetClass(tkwin, "Menubutton"); mbPtr = TkpCreateMenuButton(tkwin); - Tk_SetClassProcs(tkwin, &tkpMenubuttonClass, (ClientData) mbPtr); + Tk_SetClassProcs(tkwin, &menubuttonClass, mbPtr); /* * Initialize the data structure for the button. */ mbPtr->tkwin = tkwin; - mbPtr->display = Tk_Display (tkwin); + mbPtr->display = Tk_Display(tkwin); mbPtr->interp = interp; mbPtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(mbPtr->tkwin), MenuButtonWidgetObjCmd, - (ClientData) mbPtr, MenuButtonCmdDeletedProc); + Tk_PathName(mbPtr->tkwin), MenuButtonWidgetObjCmd, mbPtr, + MenuButtonCmdDeletedProc); mbPtr->optionTable = optionTable; mbPtr->menuName = NULL; mbPtr->text = NULL; @@ -294,7 +306,7 @@ Tk_MenubuttonObjCmd( Tk_CreateEventHandler(mbPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - MenuButtonEventProc, (ClientData) mbPtr); + MenuButtonEventProc, mbPtr); if (Tk_InitOptions(interp, (char *) mbPtr, optionTable, tkwin) != TCL_OK) { Tk_DestroyWindow(mbPtr->tkwin); @@ -306,7 +318,7 @@ Tk_MenubuttonObjCmd( return TCL_ERROR; } - Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(mbPtr->tkwin), -1); + Tcl_SetObjResult(interp, TkNewWindowObj(mbPtr->tkwin)); return TCL_OK; } @@ -335,20 +347,20 @@ MenuButtonWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register TkMenuButton *mbPtr = (TkMenuButton *) clientData; + register TkMenuButton *mbPtr = clientData; int result, index; Tcl_Obj *objPtr; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, "option", 0, - &index); + result = Tcl_GetIndexFromObjStruct(interp, objv[1], commandNames, + sizeof(char *), "option", 0, &index); if (result != TCL_OK) { return result; } - Tcl_Preserve((ClientData) mbPtr); + Tcl_Preserve(mbPtr); switch (index) { case COMMAND_CGET: @@ -361,9 +373,8 @@ MenuButtonWidgetObjCmd( mbPtr->optionTable, objv[2], mbPtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); break; case COMMAND_CONFIGURE: @@ -373,19 +384,18 @@ MenuButtonWidgetObjCmd( mbPtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { result = ConfigureMenuButton(interp, mbPtr, objc-2, objv+2); } break; } - Tcl_Release((ClientData) mbPtr); + Tcl_Release(mbPtr); return result; error: - Tcl_Release((ClientData) mbPtr); + Tcl_Release(mbPtr); return TCL_ERROR; } @@ -416,7 +426,7 @@ DestroyMenuButton( TkpDestroyMenuButton(mbPtr); if (mbPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(TkpDisplayMenuButton, (ClientData) mbPtr); + Tcl_CancelIdleCall(TkpDisplayMenuButton, mbPtr); } /* @@ -426,9 +436,9 @@ DestroyMenuButton( Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd); if (mbPtr->textVarName != NULL) { - Tcl_UntraceVar(mbPtr->interp, mbPtr->textVarName, + Tcl_UntraceVar2(mbPtr->interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuButtonTextVarProc, (ClientData) mbPtr); + MenuButtonTextVarProc, mbPtr); } if (mbPtr->image != NULL) { Tk_FreeImage(mbPtr->image); @@ -453,7 +463,7 @@ DestroyMenuButton( } Tk_FreeConfigOptions((char *) mbPtr, mbPtr->optionTable, mbPtr->tkwin); mbPtr->tkwin = NULL; - Tcl_EventuallyFree((ClientData) mbPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(mbPtr, TCL_DYNAMIC); } /* @@ -496,9 +506,9 @@ ConfigureMenuButton( */ if (mbPtr->textVarName != NULL) { - Tcl_UntraceVar(interp, mbPtr->textVarName, + Tcl_UntraceVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuButtonTextVarProc, (ClientData) mbPtr); + MenuButtonTextVarProc, mbPtr); } /* @@ -561,8 +571,7 @@ ConfigureMenuButton( if (mbPtr->imageString != NULL) { image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin, - mbPtr->imageString, MenuButtonImageProc, - (ClientData) mbPtr); + mbPtr->imageString, MenuButtonImageProc, mbPtr); if (image == NULL) { return TCL_ERROR; } @@ -616,23 +625,23 @@ ConfigureMenuButton( */ const char *value; - value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY); if (value == NULL) { - Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text, + Tcl_SetVar2(interp, mbPtr->textVarName, NULL, mbPtr->text, TCL_GLOBAL_ONLY); } else { if (mbPtr->text != NULL) { ckfree(mbPtr->text); } - mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1)); + mbPtr->text = ckalloc(strlen(value) + 1); strcpy(mbPtr->text, value); } - Tcl_TraceVar(interp, mbPtr->textVarName, + Tcl_TraceVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MenuButtonTextVarProc, (ClientData) mbPtr); + MenuButtonTextVarProc, mbPtr); } - TkMenuButtonWorldChanged((ClientData) mbPtr); + TkMenuButtonWorldChanged(mbPtr); if (error) { Tcl_SetObjResult(interp, errorResult); Tcl_DecrRefCount(errorResult); @@ -666,9 +675,7 @@ TkMenuButtonWorldChanged( XGCValues gcValues; GC gc; unsigned long mask; - TkMenuButton *mbPtr; - - mbPtr = (TkMenuButton *) instanceData; + TkMenuButton *mbPtr = instanceData; gcValues.font = Tk_FontId(mbPtr->tkfont); gcValues.foreground = mbPtr->normalFg->pixel; @@ -741,7 +748,7 @@ TkMenuButtonWorldChanged( */ if (Tk_IsMapped(mbPtr->tkwin) && !(mbPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr); + Tcl_DoWhenIdle(TkpDisplayMenuButton, mbPtr); mbPtr->flags |= REDRAW_PENDING; } } @@ -769,7 +776,8 @@ MenuButtonEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - TkMenuButton *mbPtr = (TkMenuButton *) clientData; + TkMenuButton *mbPtr = clientData; + if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) { goto redraw; } else if (eventPtr->type == ConfigureNotify) { @@ -800,7 +808,7 @@ MenuButtonEventProc( redraw: if ((mbPtr->tkwin != NULL) && !(mbPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr); + Tcl_DoWhenIdle(TkpDisplayMenuButton, mbPtr); mbPtr->flags |= REDRAW_PENDING; } } @@ -827,7 +835,7 @@ static void MenuButtonCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - TkMenuButton *mbPtr = (TkMenuButton *) clientData; + TkMenuButton *mbPtr = clientData; Tk_Window tkwin = mbPtr->tkwin; /* @@ -869,7 +877,7 @@ MenuButtonTextVarProc( const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - register TkMenuButton *mbPtr = (TkMenuButton *) clientData; + register TkMenuButton *mbPtr = clientData; const char *value; unsigned len; @@ -880,16 +888,16 @@ MenuButtonTextVarProc( if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text, + Tcl_SetVar2(interp, mbPtr->textVarName, NULL, mbPtr->text, TCL_GLOBAL_ONLY); - Tcl_TraceVar(interp, mbPtr->textVarName, + Tcl_TraceVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MenuButtonTextVarProc, clientData); } return NULL; } - value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2(interp, mbPtr->textVarName, NULL, TCL_GLOBAL_ONLY); if (value == NULL) { value = ""; } @@ -897,13 +905,13 @@ MenuButtonTextVarProc( ckfree(mbPtr->text); } len = 1 + (unsigned) strlen(value); - mbPtr->text = (char *) ckalloc(len); + mbPtr->text = ckalloc(len); memcpy(mbPtr->text, value, len); TkpComputeMenuButtonGeometry(mbPtr); if ((mbPtr->tkwin != NULL) && Tk_IsMapped(mbPtr->tkwin) && !(mbPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr); + Tcl_DoWhenIdle(TkpDisplayMenuButton, mbPtr); mbPtr->flags |= REDRAW_PENDING; } return NULL; @@ -936,12 +944,12 @@ MenuButtonImageProc( * 0). */ int imgWidth, int imgHeight)/* New dimensions of image. */ { - register TkMenuButton *mbPtr = (TkMenuButton *) clientData; + register TkMenuButton *mbPtr = clientData; if (mbPtr->tkwin != NULL) { TkpComputeMenuButtonGeometry(mbPtr); if (Tk_IsMapped(mbPtr->tkwin) && !(mbPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr); + Tcl_DoWhenIdle(TkpDisplayMenuButton, mbPtr); mbPtr->flags |= REDRAW_PENDING; } } diff --git a/generic/tkMenubutton.h b/generic/tkMenubutton.h index 41af675..e8dc12f 100644 --- a/generic/tkMenubutton.h +++ b/generic/tkMenubutton.h @@ -21,11 +21,6 @@ #include "tkMenu.h" #endif -#ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif - /* * Legal values for the "orient" field of TkMenubutton records. */ @@ -209,12 +204,6 @@ typedef struct { #define INDICATOR_HEIGHT 17 /* - * Declaration of variables shared between the files in the button module. - */ - -MODULE_SCOPE Tk_ClassProcs tkpMenubuttonClass; - -/* * Declaration of procedures used in the implementation of the button widget. */ @@ -224,7 +213,4 @@ MODULE_SCOPE void TkpDisplayMenuButton(ClientData clientData); MODULE_SCOPE void TkpDestroyMenuButton(TkMenuButton *mbPtr); MODULE_SCOPE void TkMenuButtonWorldChanged(ClientData instanceData); -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TKMENUBUTTON */ diff --git a/generic/tkMessage.c b/generic/tkMessage.c index 0fd57a9..2b71998 100644 --- a/generic/tkMessage.c +++ b/generic/tkMessage.c @@ -114,11 +114,11 @@ static const Tk_OptionSpec optionSpecs[] = { -1, Tk_Offset(Message, aspect), 0, 0, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_MESSAGE_BG_COLOR, -1, Tk_Offset(Message, border), 0, - (ClientData) DEF_MESSAGE_BG_MONO, 0}, + DEF_MESSAGE_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, NULL, - 0, -1, 0, (ClientData) "-borderwidth", 0}, + 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, NULL, - 0, -1, 0, (ClientData) "-background", 0}, + 0, -1, 0, "-background", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_MESSAGE_BORDER_WIDTH, -1, Tk_Offset(Message, borderWidth), 0, 0, 0}, @@ -126,14 +126,14 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_MESSAGE_CURSOR, -1, Tk_Offset(Message, cursor), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_SYNONYM, "-fg", NULL, NULL, NULL, - 0, -1, 0, (ClientData) "-foreground", 0}, + 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_MESSAGE_FONT, -1, Tk_Offset(Message, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", DEF_MESSAGE_FG, -1, Tk_Offset(Message, fgColorPtr), 0, 0, 0}, {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground", "HighlightBackground", DEF_MESSAGE_HIGHLIGHT_BG, -1, - Tk_Offset(Message, highlightBgColorPtr), 0, 0}, + Tk_Offset(Message, highlightBgColorPtr), 0, 0, 0}, {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", DEF_MESSAGE_HIGHLIGHT, -1, Tk_Offset(Message, highlightColorPtr), 0, 0, 0}, @@ -160,7 +160,7 @@ static const Tk_OptionSpec optionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_PIXELS, "-width", "width", "Width", DEF_MESSAGE_WIDTH, -1, Tk_Offset(Message, width), 0, 0 ,0}, - {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0} + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} }; /* @@ -171,15 +171,15 @@ static void MessageCmdDeletedProc(ClientData clientData); static void MessageEventProc(ClientData clientData, XEvent *eventPtr); static char * MessageTextVarProc(ClientData clientData, - Tcl_Interp *interp, CONST char *name1, - CONST char *name2, int flags); + Tcl_Interp *interp, const char *name1, + const char *name2, int flags); static int MessageWidgetObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static void MessageWorldChanged(ClientData instanceData); static void ComputeMessageGeometry(Message *msgPtr); static int ConfigureMessage(Tcl_Interp *interp, Message *msgPtr, - int objc, Tcl_Obj *CONST objv[], int flags); + int objc, Tcl_Obj *const objv[], int flags); static void DestroyMessage(char *memPtr); static void DisplayMessage(ClientData clientData); @@ -188,9 +188,11 @@ static void DisplayMessage(ClientData clientData); * that can be invoked from generic window code. */ -static Tk_ClassProcs messageClass = { +static const Tk_ClassProcs messageClass = { sizeof(Tk_ClassProcs), /* size */ MessageWorldChanged, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -215,14 +217,14 @@ Tk_MessageObjCmd( ClientData clientData, /* NULL. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument strings. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { register Message *msgPtr; Tk_OptionTable optionTable; Tk_Window tkwin; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -239,7 +241,7 @@ Tk_MessageObjCmd( optionTable = Tk_CreateOptionTable(interp, optionSpecs); - msgPtr = (Message *) ckalloc(sizeof(Message)); + msgPtr = ckalloc(sizeof(Message)); memset(msgPtr, 0, (size_t) sizeof(Message)); /* @@ -250,8 +252,8 @@ Tk_MessageObjCmd( msgPtr->display = Tk_Display(tkwin); msgPtr->interp = interp; msgPtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(msgPtr->tkwin), MessageWidgetObjCmd, - (ClientData) msgPtr, MessageCmdDeletedProc); + Tk_PathName(msgPtr->tkwin), MessageWidgetObjCmd, msgPtr, + MessageCmdDeletedProc); msgPtr->optionTable = optionTable; msgPtr->relief = TK_RELIEF_FLAT; msgPtr->textGC = None; @@ -261,10 +263,10 @@ Tk_MessageObjCmd( msgPtr->cursor = None; Tk_SetClass(msgPtr->tkwin, "Message"); - Tk_SetClassProcs(msgPtr->tkwin, &messageClass, (ClientData) msgPtr); + Tk_SetClassProcs(msgPtr->tkwin, &messageClass, msgPtr); Tk_CreateEventHandler(msgPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - MessageEventProc, (ClientData) msgPtr); + MessageEventProc, msgPtr); if (Tk_InitOptions(interp, (char *)msgPtr, optionTable, tkwin) != TCL_OK) { Tk_DestroyWindow(msgPtr->tkwin); return TCL_ERROR; @@ -275,7 +277,7 @@ Tk_MessageObjCmd( return TCL_ERROR; } - Tcl_SetResult(interp, Tk_PathName(msgPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(msgPtr->tkwin)); return TCL_OK; } @@ -302,26 +304,26 @@ MessageWidgetObjCmd( ClientData clientData, /* Information about message widget. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument strings. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { - register Message *msgPtr = (Message *) clientData; - static CONST char *optionStrings[] = { "cget", "configure", NULL }; + register Message *msgPtr = clientData; + static const char *const optionStrings[] = { "cget", "configure", NULL }; enum options { MESSAGE_CGET, MESSAGE_CONFIGURE }; int index; int result = TCL_OK; Tcl_Obj *objPtr; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } - Tcl_Preserve((ClientData) msgPtr); + Tcl_Preserve(msgPtr); switch ((enum options) index) { case MESSAGE_CGET: @@ -356,7 +358,7 @@ MessageWidgetObjCmd( break; } - Tcl_Release((ClientData) msgPtr); + Tcl_Release(msgPtr); return result; } @@ -388,7 +390,7 @@ DestroyMessage( Tcl_DeleteCommandFromToken(msgPtr->interp, msgPtr->widgetCmd); if (msgPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayMessage, (ClientData) msgPtr); + Tcl_CancelIdleCall(DisplayMessage, msgPtr); } /* @@ -403,13 +405,13 @@ DestroyMessage( Tk_FreeTextLayout(msgPtr->textLayout); } if (msgPtr->textVarName != NULL) { - Tcl_UntraceVar(msgPtr->interp, msgPtr->textVarName, + Tcl_UntraceVar2(msgPtr->interp, msgPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MessageTextVarProc, (ClientData) msgPtr); + MessageTextVarProc, msgPtr); } Tk_FreeConfigOptions((char *) msgPtr, msgPtr->optionTable, msgPtr->tkwin); msgPtr->tkwin = NULL; - ckfree((char *) msgPtr); + ckfree(msgPtr); } /* @@ -438,7 +440,7 @@ ConfigureMessage( register Message *msgPtr, /* Information about widget; may or may not * already have values for some fields. */ int objc, /* Number of valid entries in argv. */ - Tcl_Obj *CONST objv[], /* Arguments. */ + Tcl_Obj *const objv[], /* Arguments. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { Tk_SavedOptions savedOptions; @@ -448,9 +450,9 @@ ConfigureMessage( */ if (msgPtr->textVarName != NULL) { - Tcl_UntraceVar(interp, msgPtr->textVarName, + Tcl_UntraceVar2(interp, msgPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MessageTextVarProc, (ClientData) msgPtr); + MessageTextVarProc, msgPtr); } if (Tk_SetOptions(interp, (char *) msgPtr, msgPtr->optionTable, objc, objv, @@ -466,11 +468,11 @@ ConfigureMessage( */ if (msgPtr->textVarName != NULL) { - CONST char *value; + const char *value; - value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2(interp, msgPtr->textVarName, NULL, TCL_GLOBAL_ONLY); if (value == NULL) { - Tcl_SetVar(interp, msgPtr->textVarName, msgPtr->string, + Tcl_SetVar2(interp, msgPtr->textVarName, NULL, msgPtr->string, TCL_GLOBAL_ONLY); } else { if (msgPtr->string != NULL) { @@ -478,9 +480,9 @@ ConfigureMessage( } msgPtr->string = strcpy(ckalloc(strlen(value) + 1), value); } - Tcl_TraceVar(interp, msgPtr->textVarName, + Tcl_TraceVar2(interp, msgPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - MessageTextVarProc, (ClientData) msgPtr); + MessageTextVarProc, msgPtr); } /* @@ -496,7 +498,7 @@ ConfigureMessage( } Tk_FreeSavedOptions(&savedOptions); - MessageWorldChanged((ClientData) msgPtr); + MessageWorldChanged(msgPtr); return TCL_OK; } @@ -525,9 +527,7 @@ MessageWorldChanged( XGCValues gcValues; GC gc = None; Tk_FontMetrics fm; - Message *msgPtr; - - msgPtr = (Message *) instanceData; + Message *msgPtr = instanceData; if (msgPtr->border != NULL) { Tk_SetBackgroundFromBorder(msgPtr->tkwin, msgPtr->border); @@ -557,7 +557,7 @@ MessageWorldChanged( ComputeMessageGeometry(msgPtr); if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin) && !(msgPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr); + Tcl_DoWhenIdle(DisplayMessage, msgPtr); msgPtr->flags |= REDRAW_PENDING; } } @@ -666,7 +666,7 @@ static void DisplayMessage( ClientData clientData) /* Information about window. */ { - register Message *msgPtr = (Message *) clientData; + register Message *msgPtr = clientData; register Tk_Window tkwin = msgPtr->tkwin; int x, y; int borderWidth = msgPtr->highlightWidth; @@ -742,13 +742,13 @@ MessageEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - Message *msgPtr = (Message *) clientData; + Message *msgPtr = clientData; if (((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) || (eventPtr->type == ConfigureNotify)) { goto redraw; } else if (eventPtr->type == DestroyNotify) { - DestroyMessage((char *) clientData); + DestroyMessage(clientData); } else if (eventPtr->type == FocusIn) { if (eventPtr->xfocus.detail != NotifyInferior) { msgPtr->flags |= GOT_FOCUS; @@ -768,7 +768,7 @@ MessageEventProc( redraw: if ((msgPtr->tkwin != NULL) && !(msgPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr); + Tcl_DoWhenIdle(DisplayMessage, msgPtr); msgPtr->flags |= REDRAW_PENDING; } } @@ -795,7 +795,7 @@ static void MessageCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - Message *msgPtr = (Message *) clientData; + Message *msgPtr = clientData; /* * This function could be invoked either because the window was destroyed @@ -831,12 +831,12 @@ static char * MessageTextVarProc( ClientData clientData, /* Information about message. */ Tcl_Interp *interp, /* Interpreter containing variable. */ - CONST char *name1, /* Name of variable. */ - CONST char *name2, /* Second part of variable name. */ + const char *name1, /* Name of variable. */ + const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - register Message *msgPtr = (Message *) clientData; - CONST char *value; + register Message *msgPtr = clientData; + const char *value; /* * If the variable is unset, then immediately recreate it unless the whole @@ -845,16 +845,16 @@ MessageTextVarProc( if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_SetVar(interp, msgPtr->textVarName, msgPtr->string, + Tcl_SetVar2(interp, msgPtr->textVarName, NULL, msgPtr->string, TCL_GLOBAL_ONLY); - Tcl_TraceVar(interp, msgPtr->textVarName, + Tcl_TraceVar2(interp, msgPtr->textVarName, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, MessageTextVarProc, clientData); } return NULL; } - value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY); + value = Tcl_GetVar2(interp, msgPtr->textVarName, NULL, TCL_GLOBAL_ONLY); if (value == NULL) { value = ""; } @@ -862,13 +862,13 @@ MessageTextVarProc( ckfree(msgPtr->string); } msgPtr->numChars = Tcl_NumUtfChars(value, -1); - msgPtr->string = (char *) ckalloc((unsigned) (strlen(value) + 1)); + msgPtr->string = ckalloc(strlen(value) + 1); strcpy(msgPtr->string, value); ComputeMessageGeometry(msgPtr); if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin) && !(msgPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr); + Tcl_DoWhenIdle(DisplayMessage, msgPtr); msgPtr->flags |= REDRAW_PENDING; } return NULL; diff --git a/generic/tkObj.c b/generic/tkObj.c index f30742b..7c09656 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -33,8 +33,8 @@ typedef struct PixelRep { (PTR2INT((objPtr)->internalRep.twoPtrValue.ptr1)) #define SET_COMPLEXPIXEL(objPtr, repPtr) \ - (objPtr)->internalRep.twoPtrValue.ptr1 = 0; \ - (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr + (objPtr)->internalRep.twoPtrValue.ptr1 = NULL; \ + (objPtr)->internalRep.twoPtrValue.ptr2 = repPtr #define GET_COMPLEXPIXEL(objPtr) \ ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2) @@ -82,8 +82,8 @@ typedef struct WindowRep { */ static void DupMMInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void DupPixelInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void DupWindowInternalRep(Tcl_Obj *srcPtr,Tcl_Obj *copyPtr); +static void DupPixelInternalRep(Tcl_Obj *srcPtr, Tcl_Obj*copyPtr); +static void DupWindowInternalRep(Tcl_Obj *srcPtr,Tcl_Obj*copyPtr); static void FreeMMInternalRep(Tcl_Obj *objPtr); static void FreePixelInternalRep(Tcl_Obj *objPtr); static void FreeWindowInternalRep(Tcl_Obj *objPtr); @@ -99,7 +99,7 @@ static int SetWindowFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); * initial display-independant settings. */ -static Tcl_ObjType pixelObjType = { +static const Tcl_ObjType pixelObjType = { "pixel", /* name */ FreePixelInternalRep, /* freeIntRepProc */ DupPixelInternalRep, /* dupIntRepProc */ @@ -113,7 +113,7 @@ static Tcl_ObjType pixelObjType = { * initial display-independant settings. */ -static Tcl_ObjType mmObjType = { +static const Tcl_ObjType mmObjType = { "mm", /* name */ FreeMMInternalRep, /* freeIntRepProc */ DupMMInternalRep, /* dupIntRepProc */ @@ -126,7 +126,7 @@ static Tcl_ObjType mmObjType = { * Tcl object. */ -static Tcl_ObjType windowObjType = { +static const Tcl_ObjType windowObjType = { "window", /* name */ FreeWindowInternalRep, /* freeIntRepProc */ DupWindowInternalRep, /* dupIntRepProc */ @@ -147,9 +147,9 @@ static Tcl_ObjType windowObjType = { */ static ThreadSpecificData * -GetTypeCache() +GetTypeCache(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->doubleTypePtr == NULL) { @@ -192,7 +192,7 @@ GetPixelsFromObjEx( int result, fresh; double d; PixelRep *pixelPtr; - static double bias[] = { + static const double bias[] = { 1.0, 10.0, 25.4, 0.35278 /*25.4 / 72.0*/ }; @@ -371,7 +371,7 @@ FreePixelInternalRep( if (!SIMPLE_PIXELREP(objPtr)) { PixelRep *pixelPtr = GET_COMPLEXPIXEL(objPtr); - ckfree((char *) pixelPtr); + ckfree(pixelPtr); } SET_SIMPLEPIXEL(objPtr, 0); objPtr->typePtr = NULL; @@ -408,7 +408,7 @@ DupPixelInternalRep( PixelRep *oldPtr, *newPtr; oldPtr = GET_COMPLEXPIXEL(srcPtr); - newPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); + newPtr = ckalloc(sizeof(PixelRep)); newPtr->value = oldPtr->value; newPtr->units = oldPtr->units; newPtr->tkwin = oldPtr->tkwin; @@ -442,7 +442,8 @@ SetPixelFromAny( Tcl_Obj *objPtr) /* The object to convert. */ { const Tcl_ObjType *typePtr; - char *string, *rest; + const char *string; + char *rest; double d; int i, units; @@ -482,7 +483,7 @@ SetPixelFromAny( typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &pixelObjType; @@ -491,7 +492,7 @@ SetPixelFromAny( if ((units < 0) && (i == d)) { SET_SIMPLEPIXEL(objPtr, i); } else { - PixelRep *pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); + PixelRep *pixelPtr = ckalloc(sizeof(PixelRep)); pixelPtr->value = d; pixelPtr->units = units; @@ -503,16 +504,9 @@ SetPixelFromAny( error: if (interp != NULL) { - /* - * Must copy string before resetting the result in case a caller is - * trying to convert the interpreter's result to pixels. - */ - - char buf[100]; - - sprintf(buf, "bad screen distance \"%.50s\"", string); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, buf, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%.50s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL); } return TCL_ERROR; } @@ -548,7 +542,7 @@ Tk_GetMMFromObj( int result; double d; MMRep *mmPtr; - static double bias[] = { + static const double bias[] = { 10.0, 25.4, 1.0, 0.35278 /*25.4 / 72.0*/ }; @@ -559,7 +553,7 @@ Tk_GetMMFromObj( } } - mmPtr = (MMRep *) objPtr->internalRep.twoPtrValue.ptr1; + mmPtr = objPtr->internalRep.twoPtrValue.ptr1; if (mmPtr->tkwin != tkwin) { d = mmPtr->value; if (mmPtr->units == -1) { @@ -598,7 +592,7 @@ static void FreeMMInternalRep( Tcl_Obj *objPtr) /* MM object with internal rep to free. */ { - ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1); + ckfree(objPtr->internalRep.twoPtrValue.ptr1); objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->typePtr = NULL; } @@ -629,13 +623,13 @@ DupMMInternalRep( MMRep *oldPtr, *newPtr; copyPtr->typePtr = srcPtr->typePtr; - oldPtr = (MMRep *) srcPtr->internalRep.twoPtrValue.ptr1; - newPtr = (MMRep *) ckalloc(sizeof(MMRep)); + oldPtr = srcPtr->internalRep.twoPtrValue.ptr1; + newPtr = ckalloc(sizeof(MMRep)); newPtr->value = oldPtr->value; newPtr->units = oldPtr->units; newPtr->tkwin = oldPtr->tkwin; newPtr->returnValue = oldPtr->returnValue; - copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) newPtr; + copyPtr->internalRep.twoPtrValue.ptr1 = newPtr; } /* @@ -665,7 +659,7 @@ UpdateStringOfMM( char buffer[TCL_DOUBLE_SPACE]; register int len; - mmPtr = (MMRep *) objPtr->internalRep.twoPtrValue.ptr1; + mmPtr = objPtr->internalRep.twoPtrValue.ptr1; /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */ if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) { Tcl_Panic("UpdateStringOfMM: false precondition"); @@ -674,7 +668,7 @@ UpdateStringOfMM( Tcl_PrintDouble(NULL, mmPtr->value, buffer); len = (int)strlen(buffer); - objPtr->bytes = (char *) ckalloc((unsigned) len + 1); + objPtr->bytes = ckalloc(len + 1); strcpy(objPtr->bytes, buffer); objPtr->length = len; } @@ -705,7 +699,8 @@ SetMMFromAny( { ThreadSpecificData *typeCache = GetTypeCache(); const Tcl_ObjType *typePtr; - char *string, *rest; + const char *string; + char *rest; double d; int units; MMRep *mmPtr; @@ -740,8 +735,9 @@ SetMMFromAny( */ error: - Tcl_AppendResult(interp, "bad screen distance \"", string, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "DISTANCE", NULL); return TCL_ERROR; } while ((*rest != '\0') && isspace(UCHAR(*rest))) { @@ -775,18 +771,18 @@ SetMMFromAny( typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &mmObjType; - mmPtr = (MMRep *) ckalloc(sizeof(MMRep)); + mmPtr = ckalloc(sizeof(MMRep)); mmPtr->value = d; mmPtr->units = units; mmPtr->tkwin = NULL; mmPtr->returnValue = d; - objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mmPtr; + objPtr->internalRep.twoPtrValue.ptr1 = mmPtr; return TCL_OK; } @@ -821,19 +817,19 @@ TkGetWindowFromObj( { TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr; register WindowRep *winPtr; - int result; - result = Tcl_ConvertToType(interp, objPtr, &windowObjType); - if (result != TCL_OK) { - return result; + if (objPtr->typePtr != &windowObjType) { + int result = SetWindowFromAny(interp, objPtr); + if (result != TCL_OK) { + return result; + } } - winPtr = (WindowRep *) objPtr->internalRep.twoPtrValue.ptr1; + winPtr = objPtr->internalRep.twoPtrValue.ptr1; if (winPtr->tkwin == NULL || winPtr->mainPtr == NULL || winPtr->mainPtr != mainPtr - || winPtr->epoch != mainPtr->deletionEpoch) - { + || winPtr->epoch != mainPtr->deletionEpoch) { /* * Cache is invalid. */ @@ -888,15 +884,15 @@ SetWindowFromAny( (void)Tcl_GetString(objPtr); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } - winPtr = (WindowRep *) ckalloc(sizeof(WindowRep)); + winPtr = ckalloc(sizeof(WindowRep)); winPtr->tkwin = NULL; winPtr->mainPtr = NULL; winPtr->epoch = 0; - objPtr->internalRep.twoPtrValue.ptr1 = (VOID*)winPtr; + objPtr->internalRep.twoPtrValue.ptr1 = winPtr; objPtr->typePtr = &windowObjType; return TCL_OK; @@ -928,11 +924,11 @@ DupWindowInternalRep( register WindowRep *oldPtr, *newPtr; oldPtr = srcPtr->internalRep.twoPtrValue.ptr1; - newPtr = (WindowRep *) ckalloc(sizeof(WindowRep)); + newPtr = ckalloc(sizeof(WindowRep)); newPtr->tkwin = oldPtr->tkwin; newPtr->mainPtr = oldPtr->mainPtr; newPtr->epoch = oldPtr->epoch; - copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *)newPtr; + copyPtr->internalRep.twoPtrValue.ptr1 = newPtr; copyPtr->typePtr = srcPtr->typePtr; } @@ -958,7 +954,7 @@ static void FreeWindowInternalRep( Tcl_Obj *objPtr) /* Window object with internal rep to free. */ { - ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1); + ckfree(objPtr->internalRep.twoPtrValue.ptr1); objPtr->internalRep.twoPtrValue.ptr1 = NULL; objPtr->typePtr = NULL; } @@ -966,6 +962,40 @@ FreeWindowInternalRep( /* *---------------------------------------------------------------------- * + * TkNewWindowObj -- + * + * This function allocates a new Tcl_Obj that refers to a particular to a + * particular Tk window. + * + * Results: + * A standard Tcl object reference, with refcount 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkNewWindowObj( + Tk_Window tkwin) +{ + Tcl_Obj *objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1); + TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr; + register WindowRep *winPtr; + + SetWindowFromAny(NULL, objPtr); + + winPtr = objPtr->internalRep.twoPtrValue.ptr1; + winPtr->tkwin = tkwin; + winPtr->mainPtr = mainPtr; + winPtr->epoch = mainPtr->deletionEpoch; + return objPtr; +} + +/* + *---------------------------------------------------------------------- + * * TkParsePadAmount -- * * This function parses a padding specification and returns the @@ -1004,11 +1034,11 @@ TkParsePadAmount( */ if (specObj->typePtr == &pixelObjType) { - if (Tk_GetPixelsFromObj(interp, tkwin, specObj, &firstInt) != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad pad value \"", - Tcl_GetString(specObj), - "\": must be positive screen distance", NULL); + if (Tk_GetPixelsFromObj(interp, tkwin, specObj, &firstInt) != TCL_OK){ + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad pad value \"%s\": must be positive screen distance", + Tcl_GetString(specObj))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } secondInt = firstInt; @@ -1024,8 +1054,9 @@ TkParsePadAmount( return TCL_ERROR; } if (objc != 1 && objc != 2) { - Tcl_AppendResult(interp, - "wrong number of parts to pad specification", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong number of parts to pad specification", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "PARTS", NULL); return TCL_ERROR; } @@ -1035,9 +1066,10 @@ TkParsePadAmount( if (Tk_GetPixelsFromObj(interp, tkwin, objv[0], &firstInt) != TCL_OK || (firstInt < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(objv[0]), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad pad value \"%s\": must be positive screen distance", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } @@ -1050,10 +1082,10 @@ TkParsePadAmount( secondInt = firstInt; } else if (Tk_GetPixelsFromObj(interp, tkwin, objv[1], &secondInt) != TCL_OK || (secondInt < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad 2nd pad value \"", - Tcl_GetString(objv[1]), - "\": must be positive screen distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad 2nd pad value \"%s\": must be positive screen distance", + Tcl_GetString(objv[1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PADDING", "DIST", NULL); return TCL_ERROR; } @@ -1095,7 +1127,6 @@ TkRegisterObjTypes(void) Tcl_RegisterObjType(&tkCursorObjType); Tcl_RegisterObjType(&tkFontObjType); Tcl_RegisterObjType(&mmObjType); - Tcl_RegisterObjType(&tkOptionObjType); Tcl_RegisterObjType(&pixelObjType); Tcl_RegisterObjType(&tkStateKeyObjType); Tcl_RegisterObjType(&windowObjType); diff --git a/generic/tkOldConfig.c b/generic/tkOldConfig.c index d7a33f7..920d93e 100644 --- a/generic/tkOldConfig.c +++ b/generic/tkOldConfig.c @@ -12,7 +12,7 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tkPort.h" +#include "tkInt.h" /* * Values for "flags" field of Tk_ConfigSpec structures. Be sure to coordinate @@ -33,12 +33,12 @@ static int DoConfig(Tcl_Interp *interp, Tk_Window tkwin, Tk_ConfigSpec *specPtr, Tk_Uid value, int valueIsUid, char *widgRec); static Tk_ConfigSpec * FindConfigSpec(Tcl_Interp *interp, - Tk_ConfigSpec *specs, CONST char *argvName, + Tk_ConfigSpec *specs, const char *argvName, int needFlags, int hateFlags); static char * FormatConfigInfo(Tcl_Interp *interp, Tk_Window tkwin, - Tk_ConfigSpec *specPtr, char *widgRec); -static CONST char * FormatConfigValue(Tcl_Interp *interp, Tk_Window tkwin, - Tk_ConfigSpec *specPtr, char *widgRec, + const Tk_ConfigSpec *specPtr, char *widgRec); +static const char * FormatConfigValue(Tcl_Interp *interp, Tk_Window tkwin, + const Tk_ConfigSpec *specPtr, char *widgRec, char *buffer, Tcl_FreeProc **freeProcPtr); static Tk_ConfigSpec * GetCachedSpecs(Tcl_Interp *interp, const Tk_ConfigSpec *staticSpecs); @@ -72,9 +72,9 @@ Tk_ConfigureWidget( Tcl_Interp *interp, /* Interpreter for error reporting. */ Tk_Window tkwin, /* Window containing widget (needed to set up * X resources). */ - Tk_ConfigSpec *specs, /* Describes legal options. */ + const Tk_ConfigSpec *specs, /* Describes legal options. */ int argc, /* Number of elements in argv. */ - CONST char **argv, /* Command-line options. */ + const char **argv, /* Command-line options. */ char *widgRec, /* Record whose fields are to be modified. * Values must be properly initialized. */ int flags) /* Used to specify additional flags that must @@ -82,7 +82,7 @@ Tk_ConfigureWidget( * considered. Also, may have * TK_CONFIG_ARGV_ONLY set. */ { - register Tk_ConfigSpec *specPtr; + register Tk_ConfigSpec *specPtr, *staticSpecs; Tk_Uid value; /* Value of option from database. */ int needFlags; /* Specs must contain this set of flags or * else they are not considered. */ @@ -95,7 +95,8 @@ Tk_ConfigureWidget( * we're on our way out of the application */ - Tcl_AppendResult(interp, "NULL main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return TCL_ERROR; } @@ -110,10 +111,10 @@ Tk_ConfigureWidget( * Get the build of the config for this interpreter. */ - specs = GetCachedSpecs(interp, specs); + staticSpecs = GetCachedSpecs(interp, specs); - for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { - specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED; + for (specPtr = staticSpecs; specPtr->type != TK_CONFIG_END; specPtr++) { + specPtr->specFlags &= ~TK_CONFIG_OPTION_SPECIFIED; } /* @@ -122,14 +123,14 @@ Tk_ConfigureWidget( */ for ( ; argc > 0; argc -= 2, argv += 2) { - CONST char *arg; + const char *arg; if (flags & TK_CONFIG_OBJS) { - arg = Tcl_GetStringFromObj((Tcl_Obj *) *argv, NULL); + arg = Tcl_GetString((Tcl_Obj *) *argv); } else { arg = *argv; } - specPtr = FindConfigSpec(interp, specs, arg, needFlags, hateFlags); + specPtr = FindConfigSpec(interp, staticSpecs, arg, needFlags, hateFlags); if (specPtr == NULL) { return TCL_ERROR; } @@ -139,7 +140,9 @@ Tk_ConfigureWidget( */ if (argc < 2) { - Tcl_AppendResult(interp, "value for \"", arg, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", arg)); + Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); return TCL_ERROR; } if (flags & TK_CONFIG_OBJS) { @@ -148,11 +151,8 @@ Tk_ConfigureWidget( arg = argv[1]; } if (DoConfig(interp, tkwin, specPtr, arg, 0, widgRec) != TCL_OK) { - char msg[100]; - - sprintf(msg, "\n (processing \"%.40s\" option)", - specPtr->argvName); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (processing \"%.40s\" option)",specPtr->argvName)); return TCL_ERROR; } if (!(flags & TK_CONFIG_ARGV_ONLY)) { @@ -167,7 +167,7 @@ Tk_ConfigureWidget( */ if (!(flags & TK_CONFIG_ARGV_ONLY)) { - for (specPtr=specs; specPtr->type!=TK_CONFIG_END; specPtr++) { + for (specPtr = staticSpecs; specPtr->type != TK_CONFIG_END; specPtr++) { if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED) || (specPtr->argvName == NULL) || (specPtr->type == TK_CONFIG_SYNONYM)) { @@ -184,12 +184,10 @@ Tk_ConfigureWidget( if (value != NULL) { if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != TCL_OK) { - char msg[200]; - - sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")", - "database entry for", - specPtr->dbName, Tk_PathName(tkwin)); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (%s \"%.50s\" in widget \"%.50s\")", + "database entry for", specPtr->dbName, + Tk_PathName(tkwin))); return TCL_ERROR; } } else { @@ -202,13 +200,10 @@ Tk_ConfigureWidget( & TK_CONFIG_DONT_SET_DEFAULT)) { if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) != TCL_OK) { - char msg[200]; - - sprintf(msg, + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (%s \"%.50s\" in widget \"%.50s\")", - "default value for", - specPtr->dbName, Tk_PathName(tkwin)); - Tcl_AddErrorInfo(interp, msg); + "default value for", specPtr->dbName, + Tk_PathName(tkwin))); return TCL_ERROR; } } @@ -243,7 +238,7 @@ FindConfigSpec( Tcl_Interp *interp, /* Used for reporting errors. */ Tk_ConfigSpec *specs, /* Pointer to table of configuration * specifications for a widget. */ - CONST char *argvName, /* Name (suitable for use in a "config" + const char *argvName, /* Name (suitable for use in a "config" * command) identifying particular option. */ int needFlags, /* Flags that must be present in matching * entry. */ @@ -275,15 +270,18 @@ FindConfigSpec( goto gotMatch; } if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", argvName, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous option \"%s\"", argvName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName,NULL); return NULL; } matchPtr = specPtr; } if (matchPtr == NULL) { - Tcl_AppendResult(interp, "unknown option \"", argvName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\"", argvName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, NULL); return NULL; } @@ -297,8 +295,11 @@ FindConfigSpec( if (specPtr->type == TK_CONFIG_SYNONYM) { for (specPtr = specs; ; specPtr++) { if (specPtr->type == TK_CONFIG_END) { - Tcl_AppendResult(interp, "couldn't find synonym for option \"", - argvName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't find synonym for option \"%s\"", + argvName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", argvName, + NULL); return NULL; } if ((specPtr->dbName == matchPtr->dbName) @@ -375,7 +376,7 @@ DoConfig( if (nullValue) { newStr = NULL; } else { - newStr = (char *) ckalloc((unsigned) (strlen(value) + 1)); + newStr = ckalloc(strlen(value) + 1); strcpy(newStr, value); } oldStr = *((char **) ptr); @@ -544,20 +545,17 @@ DoConfig( break; } case TK_CONFIG_CUSTOM: - if ((*specPtr->customPtr->parseProc)( - specPtr->customPtr->clientData, interp, tkwin, value, - widgRec, specPtr->offset) != TCL_OK) { + if (specPtr->customPtr->parseProc(specPtr->customPtr->clientData, + interp, tkwin, value, widgRec, specPtr->offset)!=TCL_OK) { return TCL_ERROR; } break; - default: { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad config table: unknown type %d", specPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad config table: unknown type %d", specPtr->type)); + Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL); return TCL_ERROR; } - } specPtr++; } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END)); return TCL_OK; @@ -595,20 +593,20 @@ int Tk_ConfigureInfo( Tcl_Interp *interp, /* Interpreter for error reporting. */ Tk_Window tkwin, /* Window corresponding to widgRec. */ - Tk_ConfigSpec *specs, /* Describes legal options. */ + const Tk_ConfigSpec *specs, /* Describes legal options. */ char *widgRec, /* Record whose fields contain current values * for options. */ - CONST char *argvName, /* If non-NULL, indicates a single option + const char *argvName, /* If non-NULL, indicates a single option * whose info is to be returned. Otherwise * info is returned for all options. */ int flags) /* Used to specify additional flags that must * be present in config specs for them to be * considered. */ { - register Tk_ConfigSpec *specPtr; + register Tk_ConfigSpec *specPtr, *staticSpecs; int needFlags, hateFlags; char *list; - char *leader = "{"; + const char *leader = "{"; needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); if (Tk_Depth(tkwin) <= 1) { @@ -621,22 +619,23 @@ Tk_ConfigureInfo( * Get the build of the config for this interpreter. */ - specs = GetCachedSpecs(interp, specs); + staticSpecs = GetCachedSpecs(interp, specs); /* * If information is only wanted for a single configuration spec, then * handle that one spec specially. */ - Tcl_SetResult(interp, NULL, TCL_STATIC); + Tcl_ResetResult(interp); if (argvName != NULL) { - specPtr = FindConfigSpec(interp, specs, argvName, needFlags,hateFlags); + specPtr = FindConfigSpec(interp, staticSpecs, argvName, needFlags, + hateFlags); if (specPtr == NULL) { return TCL_ERROR; } - Tcl_SetResult(interp, - FormatConfigInfo(interp, tkwin, specPtr, widgRec), - TCL_DYNAMIC); + list = FormatConfigInfo(interp, tkwin, specPtr, widgRec); + Tcl_SetObjResult(interp, Tcl_NewStringObj(list, -1)); + ckfree(list); return TCL_OK; } @@ -645,7 +644,7 @@ Tk_ConfigureInfo( * information. */ - for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { + for (specPtr = staticSpecs; specPtr->type != TK_CONFIG_END; specPtr++) { if ((argvName != NULL) && (specPtr->argvName != argvName)) { continue; } @@ -687,13 +686,13 @@ FormatConfigInfo( Tcl_Interp *interp, /* Interpreter to use for things like * floating-point precision. */ Tk_Window tkwin, /* Window corresponding to widget. */ - register Tk_ConfigSpec *specPtr, + register const Tk_ConfigSpec *specPtr, /* Pointer to information describing * option. */ char *widgRec) /* Pointer to record holding current values of * info for widget. */ { - CONST char *argv[6]; + const char *argv[6]; char *result; char buffer[200]; Tcl_FreeProc *freeProc = NULL; @@ -722,9 +721,9 @@ FormatConfigInfo( result = Tcl_Merge(5, argv); if (freeProc != NULL) { if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) { - ckfree((char *)argv[4]); + ckfree((char *) argv[4]); } else { - (*freeProc)((char *)argv[4]); + freeProc((char *) argv[4]); } } return result; @@ -750,11 +749,11 @@ FormatConfigInfo( *---------------------------------------------------------------------- */ -static CONST char * +static const char * FormatConfigValue( Tcl_Interp *interp, /* Interpreter for use in real conversions. */ Tk_Window tkwin, /* Window corresponding to widget. */ - Tk_ConfigSpec *specPtr, /* Pointer to information describing option. + const Tk_ConfigSpec *specPtr, /* Pointer to information describing option. * Must not point to a synonym option. */ char *widgRec, /* Pointer to record holding current values of * info for widget. */ @@ -764,7 +763,7 @@ FormatConfigValue( * function to free the result, or NULL if * result is static. */ { - CONST char *ptr, *result; + const char *ptr, *result; *freeProcPtr = NULL; ptr = widgRec + specPtr->offset; @@ -873,9 +872,8 @@ FormatConfigValue( break; } case TK_CONFIG_CUSTOM: - result = (*specPtr->customPtr->printProc)( - specPtr->customPtr->clientData, tkwin, widgRec, - specPtr->offset, freeProcPtr); + result = specPtr->customPtr->printProc(specPtr->customPtr->clientData, + tkwin, widgRec, specPtr->offset, freeProcPtr); break; default: result = "?? unknown type ??"; @@ -907,10 +905,10 @@ int Tk_ConfigureValue( Tcl_Interp *interp, /* Interpreter for error reporting. */ Tk_Window tkwin, /* Window corresponding to widgRec. */ - Tk_ConfigSpec *specs, /* Describes legal options. */ + const Tk_ConfigSpec *specs, /* Describes legal options. */ char *widgRec, /* Record whose fields contain current values * for options. */ - CONST char *argvName, /* Gives the command-line name for the option + const char *argvName, /* Gives the command-line name for the option * whose value is to be returned. */ int flags) /* Used to specify additional flags that must * be present in config specs for them to be @@ -919,7 +917,7 @@ Tk_ConfigureValue( Tk_ConfigSpec *specPtr; int needFlags, hateFlags; Tcl_FreeProc *freeProc; - CONST char *result; + const char *result; char buffer[200]; needFlags = flags & ~(TK_CONFIG_USER_BIT - 1); @@ -933,20 +931,20 @@ Tk_ConfigureValue( * Get the build of the config for this interpreter. */ - specs = GetCachedSpecs(interp, specs); + specPtr = GetCachedSpecs(interp, specs); - specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags); + specPtr = FindConfigSpec(interp, specPtr, argvName, needFlags, hateFlags); if (specPtr == NULL) { return TCL_ERROR; } result = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, &freeProc); - Tcl_SetResult(interp, (char *) result, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); if (freeProc != NULL) { if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) { - ckfree((char *)result); + ckfree((char *) result); } else { - (*freeProc)((char *)result); + freeProc((char *) result); } } return TCL_OK; @@ -976,7 +974,7 @@ Tk_ConfigureValue( /* ARGSUSED */ void Tk_FreeOptions( - Tk_ConfigSpec *specs, /* Describes legal options. */ + const Tk_ConfigSpec *specs, /* Describes legal options. */ char *widgRec, /* Record whose fields contain current values * for options. */ Display *display, /* X display; needed for freeing some @@ -985,7 +983,7 @@ Tk_FreeOptions( * be present in config specs for them to be * considered. */ { - register Tk_ConfigSpec *specPtr; + register const Tk_ConfigSpec *specPtr; char *ptr; for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) { @@ -1073,13 +1071,13 @@ GetCachedSpecs( * self-initializing code. */ - specCacheTablePtr = (Tcl_HashTable *) + specCacheTablePtr = Tcl_GetAssocData(interp, "tkConfigSpec.threadTable", NULL); if (specCacheTablePtr == NULL) { - specCacheTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + specCacheTablePtr = ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(specCacheTablePtr, TCL_ONE_WORD_KEYS); Tcl_SetAssocData(interp, "tkConfigSpec.threadTable", - DeleteSpecCacheTable, (ClientData) specCacheTablePtr); + DeleteSpecCacheTable, specCacheTablePtr); } /* @@ -1109,9 +1107,9 @@ GetCachedSpecs( * from the master copy. */ - cachedSpecs = (Tk_ConfigSpec *) ckalloc(entrySpace); + cachedSpecs = ckalloc(entrySpace); memcpy(cachedSpecs, staticSpecs, entrySpace); - Tcl_SetHashValue(entryPtr, (ClientData) cachedSpecs); + Tcl_SetHashValue(entryPtr, cachedSpecs); /* * Finally, go through and replace database names, database classes @@ -1133,7 +1131,7 @@ GetCachedSpecs( } } } else { - cachedSpecs = (Tk_ConfigSpec *) Tcl_GetHashValue(entryPtr); + cachedSpecs = Tcl_GetHashValue(entryPtr); } return cachedSpecs; @@ -1161,7 +1159,7 @@ DeleteSpecCacheTable( ClientData clientData, Tcl_Interp *interp) { - Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData; + Tcl_HashTable *tablePtr = clientData; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; @@ -1171,10 +1169,10 @@ DeleteSpecCacheTable( * Someone else deallocates the Tk_Uids themselves. */ - ckfree((char *) Tcl_GetHashValue(entryPtr)); + ckfree(Tcl_GetHashValue(entryPtr)); } Tcl_DeleteHashTable(tablePtr); - ckfree((char *) tablePtr); + ckfree(tablePtr); } /* diff --git a/generic/tkOldTest.c b/generic/tkOldTest.c index cfbce23..df1bb6c 100644 --- a/generic/tkOldTest.c +++ b/generic/tkOldTest.c @@ -16,6 +16,12 @@ */ #define USE_OLD_IMAGE +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif +#ifndef USE_TK_STUBS +# define USE_TK_STUBS +#endif #include "tkInt.h" /* @@ -67,16 +73,17 @@ static Tk_ImageType imageType = { ImageFree, /* freeProc */ ImageDelete, /* deleteProc */ NULL, /* postscriptPtr */ - NULL /* nextPtr */ + NULL, /* nextPtr */ + NULL }; /* * Forward declarations for functions defined later in this file: */ -static int ImageCmd(ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv); -MODULE_SCOPE int TkOldTestInit(Tcl_Interp *interp); +static int ImageObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); /* @@ -142,7 +149,7 @@ ImageCreate( * will be returned in later callbacks. */ { TImageMaster *timPtr; - char *varName; + const char *varName; int i; varName = "log"; @@ -160,17 +167,17 @@ ImageCreate( varName = argv[i+1]; } - timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster)); + timPtr = ckalloc(sizeof(TImageMaster)); timPtr->master = master; timPtr->interp = interp; timPtr->width = 30; timPtr->height = 15; - timPtr->imageName = (char *) ckalloc((unsigned) (strlen(name) + 1)); + timPtr->imageName = ckalloc((unsigned) (strlen(name) + 1)); strcpy(timPtr->imageName, name); - timPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1)); + timPtr->varName = ckalloc((unsigned) (strlen(varName) + 1)); strcpy(timPtr->varName, varName); - Tcl_CreateCommand(interp, name, ImageCmd, (ClientData) timPtr, NULL); - *clientDataPtr = (ClientData) timPtr; + Tcl_CreateObjCommand(interp, name, ImageObjCmd, timPtr, NULL); + *clientDataPtr = timPtr; Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15); return TCL_OK; } @@ -178,7 +185,7 @@ ImageCreate( /* *---------------------------------------------------------------------- * - * ImageCmd -- + * ImageObjCmd -- * * This function implements the commands corresponding to individual * images. @@ -194,38 +201,37 @@ ImageCreate( /* ARGSUSED */ static int -ImageCmd( +ImageObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { - TImageMaster *timPtr = (TImageMaster *) clientData; + TImageMaster *timPtr = clientData; int x, y, width, height; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], "option ?arg arg ...?", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (strcmp(argv[1], "changed") == 0) { - if (argc != 8) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " changed x y width height imageWidth imageHeight", NULL); + if (strcmp(Tcl_GetString(objv[1]), "changed") == 0) { + if (objc != 8) { + Tcl_WrongNumArgs(interp, 1, objv, "changed x y width height" + " imageWidth imageHeight"); return TCL_ERROR; } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &width) != TCL_OK) - || (Tcl_GetInt(interp, argv[5], &height) != TCL_OK) - || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK) - || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[5], &height) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[6], &timPtr->width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[7], &timPtr->height) != TCL_OK)) { return TCL_ERROR; } Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width, timPtr->height); } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be changed", NULL); return TCL_ERROR; } @@ -256,21 +262,21 @@ ImageGet( * used. */ ClientData clientData) /* Pointer to TImageMaster for image. */ { - TImageMaster *timPtr = (TImageMaster *) clientData; + TImageMaster *timPtr = clientData; TImageInstance *instPtr; char buffer[100]; XGCValues gcValues; sprintf(buffer, "%s get", timPtr->imageName); - Tcl_SetVar(timPtr->interp, timPtr->varName, buffer, + Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); - instPtr = (TImageInstance *) ckalloc(sizeof(TImageInstance)); + instPtr = ckalloc(sizeof(TImageInstance)); instPtr->masterPtr = timPtr; instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000"); gcValues.foreground = instPtr->fg->pixel; instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues); - return (ClientData) instPtr; + return instPtr; } /* @@ -303,14 +309,14 @@ ImageDisplay( /* Coordinates in drawable corresponding to * imageX and imageY. */ { - TImageInstance *instPtr = (TImageInstance *) clientData; + TImageInstance *instPtr = clientData; char buffer[200 + TCL_INTEGER_SPACE * 6]; sprintf(buffer, "%s display %d %d %d %d %d %d", instPtr->masterPtr->imageName, imageX, imageY, width, height, drawableX, drawableY); - Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer, - TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL, + buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); if (width > (instPtr->masterPtr->width - imageX)) { width = instPtr->masterPtr->width - imageX; } @@ -348,15 +354,15 @@ ImageFree( ClientData clientData, /* Pointer to TImageInstance for instance. */ Display *display) /* Display where image was to be drawn. */ { - TImageInstance *instPtr = (TImageInstance *) clientData; + TImageInstance *instPtr = clientData; char buffer[200]; sprintf(buffer, "%s free", instPtr->masterPtr->imageName); - Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer, - TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL, + buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); Tk_FreeColor(instPtr->fg); Tk_FreeGC(display, instPtr->gc); - ckfree((char *) instPtr); + ckfree(instPtr); } /* @@ -382,17 +388,17 @@ ImageDelete( * this function is called, no more instances * exist. */ { - TImageMaster *timPtr = (TImageMaster *) clientData; + TImageMaster *timPtr = clientData; char buffer[100]; sprintf(buffer, "%s delete", timPtr->imageName); - Tcl_SetVar(timPtr->interp, timPtr->varName, buffer, + Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); Tcl_DeleteCommand(timPtr->interp, timPtr->imageName); ckfree(timPtr->imageName); ckfree(timPtr->varName); - ckfree((char *) timPtr); + ckfree(timPtr); } /* diff --git a/generic/tkOption.c b/generic/tkOption.c index bff799b..d758b6f 100644 --- a/generic/tkOption.c +++ b/generic/tkOption.c @@ -221,9 +221,9 @@ static int GetDefaultOptions(Tcl_Interp *interp, static ElArray * NewArray(int numEls); static void OptionThreadExitProc(ClientData clientData); static void OptionInit(TkMainInfo *mainPtr); -static int ParsePriority(Tcl_Interp *interp, char *string); +static int ParsePriority(Tcl_Interp *interp, const char *string); static int ReadOptionFile(Tcl_Interp *interp, Tk_Window tkwin, - char *fileName, int priority); + const char *fileName, int priority); static void SetupStacks(TkWindow *winPtr, int leaf); /* @@ -246,8 +246,8 @@ void Tk_AddOption( Tk_Window tkwin, /* Window token; option will be associated * with main window for this window. */ - CONST char *name, /* Multi-element name of option. */ - CONST char *value, /* String value for option. */ + const char *name, /* Multi-element name of option. */ + const char *value, /* String value for option. */ int priority) /* Overall priority level to use for this * option, such as TK_USER_DEFAULT_PRIO or * TK_INTERACTIVE_PRIO. Must be between 0 and @@ -257,13 +257,13 @@ Tk_AddOption( register ElArray **arrayPtrPtr; register Element *elPtr; Element newEl; - register CONST char *p; - CONST char *field; + register const char *p; + const char *field; int count, firstField; ptrdiff_t length; #define TMP_SIZE 100 char tmp[TMP_SIZE+1]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->mainPtr->optionRootPtr == NULL) { @@ -400,8 +400,8 @@ Tk_Uid Tk_GetOption( Tk_Window tkwin, /* Token for window that option is associated * with. */ - CONST char *name, /* Name of option. */ - CONST char *className) /* Class of option. NULL means there is no + const char *name, /* Name of option. */ + const char *className) /* Class of option. NULL means there is no * class for this option: just check for * name. */ { @@ -411,7 +411,7 @@ Tk_GetOption( register int count; StackLevel *levelPtr; int stackDepth[NUM_STACKS]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -475,16 +475,16 @@ Tk_GetOption( */ for (elPtr = tsdPtr->stacks[EXACT_LEAF_NAME]->els, - count = stackDepth[EXACT_LEAF_NAME]; count > 0; - elPtr++, count--) { + count = stackDepth[EXACT_LEAF_NAME]; count > 0; + elPtr++, count--) { if ((elPtr->nameUid == nameId) && (elPtr->priority > bestPtr->priority)) { bestPtr = elPtr; } } for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_NAME]->els, - count = stackDepth[WILDCARD_LEAF_NAME]; count > 0; - elPtr++, count--) { + count = stackDepth[WILDCARD_LEAF_NAME]; count > 0; + elPtr++, count--) { if ((elPtr->nameUid == nameId) && (elPtr->priority > bestPtr->priority)) { bestPtr = elPtr; @@ -494,16 +494,16 @@ Tk_GetOption( if (className != NULL) { classId = Tk_GetUid(className); for (elPtr = tsdPtr->stacks[EXACT_LEAF_CLASS]->els, - count = stackDepth[EXACT_LEAF_CLASS]; count > 0; - elPtr++, count--) { + count = stackDepth[EXACT_LEAF_CLASS]; count > 0; + elPtr++, count--) { if ((elPtr->nameUid == classId) && (elPtr->priority > bestPtr->priority)) { bestPtr = elPtr; } } for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->els, - count = stackDepth[WILDCARD_LEAF_CLASS]; count > 0; - elPtr++, count--) { + count = stackDepth[WILDCARD_LEAF_CLASS]; count > 0; + elPtr++, count--) { if ((elPtr->nameUid == classId) && (elPtr->priority > bestPtr->priority)) { bestPtr = elPtr; @@ -523,24 +523,25 @@ Tk_GetOption( Tk_Uid nodeId, winClassId, winNameId; unsigned int classNameLength; register Element *nodePtr, *leafPtr; - static int searchOrder[] = { + static const int searchOrder[] = { EXACT_NODE_NAME, WILDCARD_NODE_NAME, EXACT_NODE_CLASS, WILDCARD_NODE_CLASS, -1 }; - int *currentPtr, currentStack, leafCount; + const int *currentPtr; + int currentStack, leafCount; /* * Extract the masquerade class name from the name field. */ - classNameLength = (unsigned int)(masqName - name); - masqClass = (char *) ckalloc(classNameLength + 1); + classNameLength = (unsigned) (masqName - name); + masqClass = ckalloc(classNameLength + 1); strncpy(masqClass, name, classNameLength); masqClass[classNameLength] = '\0'; winClassId = Tk_GetUid(masqClass); ckfree(masqClass); - winNameId = ((TkWindow *)tkwin)->nameUid; + winNameId = ((TkWindow *) tkwin)->nameUid; levelPtr = &tsdPtr->levels[tsdPtr->curLevel]; @@ -612,17 +613,15 @@ Tk_OptionObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of Tcl_Obj arguments. */ - Tcl_Obj *CONST objv[]) /* Tcl_Obj arguments. */ + Tcl_Obj *const objv[]) /* Tcl_Obj arguments. */ { - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = clientData; int index, result; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - - static CONST char *optionCmds[] = { + static const char *const optionCmds[] = { "add", "clear", "get", "readfile", NULL }; - enum optionVals { OPTION_ADD, OPTION_CLEAR, OPTION_GET, OPTION_READFILE }; @@ -632,8 +631,8 @@ Tk_OptionObjCmd( return TCL_ERROR; } - result = Tcl_GetIndexFromObj(interp, objv[1], optionCmds, "option", 0, - &index); + result = Tcl_GetIndexFromObjStruct(interp, objv[1], optionCmds, + sizeof(char *), "option", 0, &index); if (result != TCL_OK) { return result; } @@ -642,6 +641,7 @@ Tk_OptionObjCmd( switch ((enum optionVals) index) { case OPTION_ADD: { int priority; + if ((objc != 4) && (objc != 5)) { Tcl_WrongNumArgs(interp, 2, objv, "pattern value ?priority?"); return TCL_ERROR; @@ -661,13 +661,12 @@ Tk_OptionObjCmd( } case OPTION_CLEAR: { - TkMainInfo *mainPtr; + TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } - mainPtr = ((TkWindow *) tkwin)->mainPtr; if (mainPtr->optionRootPtr != NULL) { ClearOptionTree(mainPtr->optionRootPtr); mainPtr->optionRootPtr = NULL; @@ -691,7 +690,7 @@ Tk_OptionObjCmd( value = Tk_GetOption(window, Tcl_GetString(objv[3]), Tcl_GetString(objv[4])); if (value != NULL) { - Tcl_SetResult(interp, (char *)value, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1)); } break; } @@ -741,7 +740,7 @@ void TkOptionDeadWindow( register TkWindow *winPtr) /* Window to be cleaned up. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -797,7 +796,7 @@ TkOptionClassChanged( { int i, j, *basePtr; ElArray *arrayPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->optionLevel == -1) { @@ -852,7 +851,7 @@ TkOptionClassChanged( static int ParsePriority( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ - char *string) /* Describes a priority level, either + const char *string) /* Describes a priority level, either * symbolically or numerically. */ { int priority, c; @@ -878,9 +877,11 @@ ParsePriority( priority = strtoul(string, &end, 0); if ((end == string) || (*end != 0) || (priority < 0) || (priority > 100)) { - Tcl_AppendResult(interp, "bad priority level \"", string, - "\": must be widgetDefault, startupFile, userDefault, ", - "interactive, or a number between 0 and 100", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad priority level \"%s\": must be " + "widgetDefault, startupFile, userDefault, " + "interactive, or a number between 0 and 100", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PRIORITY", NULL); return -1; } } @@ -928,7 +929,6 @@ AddFromString( src = string; lineNum = 1; while (1) { - /* * Skip leading white space and empty lines and comment lines, and * check for the end of the spec. @@ -963,10 +963,9 @@ AddFromString( dst = name = src; while (*src != ':') { if ((*src == '\0') || (*src == '\n')) { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "missing colon on line %d", lineNum); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing colon on line %d", lineNum)); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "COLON", NULL); return TCL_ERROR; } if ((src[0] == '\\') && (src[1] == '\n')) { @@ -998,10 +997,9 @@ AddFromString( src++; } if (*src == '\0') { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "missing value on line %d", lineNum); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing value on line %d", lineNum)); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "VALUE", NULL); return TCL_ERROR; } @@ -1013,10 +1011,9 @@ AddFromString( dst = value = src; while (*src != '\n') { if (*src == '\0') { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "missing newline on line %d", lineNum); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing newline on line %d", lineNum)); + Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "NEWLINE", NULL); return TCL_ERROR; } if (*src == '\\'){ @@ -1076,13 +1073,13 @@ ReadOptionFile( Tcl_Interp *interp, /* Interpreter to use for reporting results. */ Tk_Window tkwin, /* Token for window: options are entered for * this window's main window. */ - char *fileName, /* Name of file containing options. */ + const char *fileName, /* Name of file containing options. */ int priority) /* Priority level to use for options in this * file, such as TK_USER_DEFAULT_PRIO or * TK_INTERACTIVE_PRIO. Must be between 0 and * TK_MAX_PRIO. */ { - CONST char *realName; + const char *realName; char *buffer; int result, bufferSize; Tcl_Channel chan; @@ -1093,8 +1090,9 @@ ReadOptionFile( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't read options from a file in a", - " safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't read options from a file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "OPTION_FILE", NULL); return TCL_ERROR; } @@ -1105,9 +1103,8 @@ ReadOptionFile( chan = Tcl_OpenFileChannel(interp, realName, "r", 0); Tcl_DStringFree(&newName); if (chan == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't open \"", fileName, - "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't open \"%s\": %s", + fileName, Tcl_PosixError(interp))); return TCL_ERROR; } @@ -1117,20 +1114,22 @@ ReadOptionFile( */ bufferSize = (int) Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_END); - (void) Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_SET); + Tcl_Seek(chan, (Tcl_WideInt) 0, SEEK_SET); if (bufferSize < 0) { - Tcl_AppendResult(interp, "error seeking to end of file \"", - fileName, "\":", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error seeking to end of file \"%s\": %s", + fileName, Tcl_PosixError(interp))); Tcl_Close(NULL, chan); return TCL_ERROR; - } - buffer = (char *) ckalloc((unsigned) bufferSize+1); + + buffer = ckalloc(bufferSize + 1); bufferSize = Tcl_Read(chan, buffer, bufferSize); if (bufferSize < 0) { - Tcl_AppendResult(interp, "error reading file \"", fileName, "\":", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading file \"%s\": %s", + fileName, Tcl_PosixError(interp))); Tcl_Close(NULL, chan); return TCL_ERROR; } @@ -1171,9 +1170,8 @@ static ElArray * NewArray( int numEls) /* How many elements of space to allocate. */ { - register ElArray *arrayPtr; + register ElArray *arrayPtr = ckalloc(EL_ARRAY_SIZE(numEls)); - arrayPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(numEls)); arrayPtr->arraySize = numEls; arrayPtr->numUsed = 0; arrayPtr->nextToUse = arrayPtr->els; @@ -1207,16 +1205,11 @@ ExtendArray( */ if (arrayPtr->numUsed >= arrayPtr->arraySize) { - register ElArray *newPtr; - - newPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(2*arrayPtr->arraySize)); - newPtr->arraySize = 2*arrayPtr->arraySize; - newPtr->numUsed = arrayPtr->numUsed; - newPtr->nextToUse = &newPtr->els[newPtr->numUsed]; - memcpy(newPtr->els, arrayPtr->els, - arrayPtr->arraySize * sizeof(Element)); - ckfree((char *) arrayPtr); - arrayPtr = newPtr; + register int newSize = 2*arrayPtr->arraySize; + + arrayPtr = ckrealloc(arrayPtr, EL_ARRAY_SIZE(newSize)); + arrayPtr->arraySize = newSize; + arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed]; } *arrayPtr->nextToUse = *elPtr; @@ -1251,10 +1244,11 @@ SetupStacks( * being probed. Zero means this is an * ancestor of the desired leaf. */ { - int level, i, *iPtr; + int level, i; + const int *iPtr; register StackLevel *levelPtr; register ElArray *arrayPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1266,7 +1260,7 @@ SetupStacks( * differently. */ - static int searchOrder[] = {WILDCARD_NODE_CLASS, WILDCARD_NODE_NAME, + static const int searchOrder[] = {WILDCARD_NODE_CLASS, WILDCARD_NODE_NAME, EXACT_NODE_CLASS, EXACT_NODE_NAME, -1}; if (winPtr->mainPtr->optionRootPtr == NULL) { @@ -1331,13 +1325,12 @@ SetupStacks( */ if (tsdPtr->curLevel >= tsdPtr->numLevels) { - StackLevel *newLevels; + StackLevel *newLevels = + ckalloc(tsdPtr->numLevels * 2 * sizeof(StackLevel)); - newLevels = (StackLevel *) ckalloc((unsigned) - (tsdPtr->numLevels * 2 * sizeof(StackLevel))); memcpy(newLevels, tsdPtr->levels, tsdPtr->numLevels * sizeof(StackLevel)); - ckfree((char *) tsdPtr->levels); + ckfree(tsdPtr->levels); tsdPtr->numLevels *= 2; tsdPtr->levels = newLevels; } @@ -1416,7 +1409,7 @@ ExtendStacks( { register int count; register Element *elPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (elPtr = arrayPtr->els, count = arrayPtr->numUsed; @@ -1449,16 +1442,16 @@ static void OptionThreadExitProc( ClientData clientData) /* not used */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->initialized) { int i; for (i = 0; i < NUM_STACKS; i++) { - ckfree((char *) tsdPtr->stacks[i]); + ckfree(tsdPtr->stacks[i]); } - ckfree((char *) tsdPtr->levels); + ckfree(tsdPtr->levels); tsdPtr->initialized = 0; } } @@ -1487,7 +1480,7 @@ OptionInit( { int i; Tcl_Interp *interp; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Element *defaultMatchPtr = &tsdPtr->defaultMatch; @@ -1502,8 +1495,7 @@ OptionInit( tsdPtr->curLevel = -1; tsdPtr->serial = 0; - tsdPtr->levels = (StackLevel *) - ckalloc((unsigned) (5*sizeof(StackLevel))); + tsdPtr->levels = ckalloc(5 * sizeof(StackLevel)); for (i = 0; i < NUM_STACKS; i++) { tsdPtr->stacks[i] = NewArray(10); tsdPtr->levels[0].bases[i] = 0; @@ -1523,7 +1515,7 @@ OptionInit( mainPtr->optionRootPtr = NewArray(20); interp = Tcl_CreateInterp(); - (void) GetDefaultOptions(interp, mainPtr->winPtr); + GetDefaultOptions(interp, mainPtr->winPtr); Tcl_DeleteInterp(interp); } @@ -1559,7 +1551,7 @@ ClearOptionTree( ClearOptionTree(elPtr->child.arrayPtr); } } - ckfree((char *) arrayPtr); + ckfree(arrayPtr); } /* diff --git a/generic/tkPack.c b/generic/tkPack.c index 47eddd6..88a4b2d 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -14,14 +14,14 @@ #include "tkInt.h" typedef enum {TOP, BOTTOM, LEFT, RIGHT} Side; -static CONST char *sideNames[] = { +static const char *const sideNames[] = { "top", "bottom", "left", "right", NULL }; -/* For each window that the packer cares about (either because - * the window is managed by the packer or because the window - * has slaves that are managed by the packer), there is a - * structure of the following type: +/* + * For each window that the packer cares about (either because the window is + * managed by the packer or because the window has slaves that are managed by + * the packer), there is a structure of the following type: */ typedef struct Packer { @@ -32,9 +32,9 @@ typedef struct Packer { struct Packer *masterPtr; /* Master window within which this window is * packed (NULL means this window isn't * managed by the packer). */ - struct Packer *nextPtr; /* Next window packed within same master. - * List is priority-ordered: first on list - * gets packed first. */ + struct Packer *nextPtr; /* Next window packed within same master. List + * is priority-ordered: first on list gets + * packed first. */ struct Packer *slavePtr; /* First in list of slaves packed inside this * window (NULL means no packed slaves). */ Side side; /* Side of master against which this window is @@ -87,6 +87,8 @@ typedef struct Packer { * size. 0 means if this window is a master then * Tk will set its requested size to fit the * needs of its slaves. + * ALLOCED_MASTER 1 means that Pack has allocated itself as + * geometry master for this window. */ #define REQUESTED_REPACK 1 @@ -95,6 +97,7 @@ typedef struct Packer { #define EXPAND 8 #define OLD_STYLE 16 #define DONT_PROPAGATE 32 +#define ALLOCED_MASTER 64 /* * The following structure is the official type record for the packer: @@ -116,11 +119,11 @@ static const Tk_GeomMgr packerType = { static void ArrangePacking(ClientData clientData); static int ConfigureSlaves(Tcl_Interp *interp, Tk_Window tkwin, - int objc, Tcl_Obj *CONST objv[]); -static void DestroyPacker(char *memPtr); + int objc, Tcl_Obj *const objv[]); +static void DestroyPacker(void *memPtr); static Packer * GetPacker(Tk_Window tkwin); static int PackAfter(Tcl_Interp *interp, Packer *prevPtr, - Packer *masterPtr, int objc,Tcl_Obj *CONST objv[]); + Packer *masterPtr, int objc,Tcl_Obj *const objv[]); static void PackStructureProc(ClientData clientData, XEvent *eventPtr); static void Unlink(Packer *packPtr); @@ -128,13 +131,13 @@ static int XExpansion(Packer *slavePtr, int cavityWidth); static int YExpansion(Packer *slavePtr, int cavityHeight); /* - *-------------------------------------------------------------- + *------------------------------------------------------------------------ * - * TkPrintPadAmount -- + * TkAppendPadAmount -- * * This function generates a text value that describes one of the -padx, * -pady, -ipadx, or -ipady configuration options. The text value - * generated is appended to the interpreter result. + * generated is appended to the given Tcl_Obj. * * Results: * None. @@ -142,29 +145,33 @@ static int YExpansion(Packer *slavePtr, int cavityHeight); * Side effects: * None. * - *-------------------------------------------------------------- + *------------------------------------------------------------------------ */ void -TkPrintPadAmount( - Tcl_Interp *interp, /* The interpreter into which the result is +TkAppendPadAmount( + Tcl_Obj *bufferObj, /* The interpreter into which the result is * written. */ - char *switchName, /* One of "padx", "pady", "ipadx" or "ipady" */ + const char *switchName, /* One of "padx", "pady", "ipadx" or + * "ipady" */ int halfSpace, /* The left or top padding amount */ int allSpace) /* The total amount of padding */ { - char buffer[60 + 2*TCL_INTEGER_SPACE]; + Tcl_Obj *padding[2]; + if (halfSpace*2 == allSpace) { - sprintf(buffer, " -%.10s %d", switchName, halfSpace); + Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1), + Tcl_NewIntObj(halfSpace)); } else { - sprintf(buffer, " -%.10s {%d %d}", switchName, halfSpace, - allSpace - halfSpace); + padding[0] = Tcl_NewIntObj(halfSpace); + padding[1] = Tcl_NewIntObj(allSpace - halfSpace); + Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1), + Tcl_NewListObj(2, padding)); } - Tcl_AppendResult(interp, buffer, NULL); } /* - *-------------------------------------------------------------- + *------------------------------------------------------------------------ * * Tk_PackCmd -- * @@ -177,7 +184,7 @@ TkPrintPadAmount( * Side effects: * See the user documentation. * - *-------------------------------------------------------------- + *------------------------------------------------------------------------ */ int @@ -185,11 +192,11 @@ Tk_PackObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; - char *argv2; - static CONST char *optionStrings[] = { + Tk_Window tkwin = clientData; + const char *argv2; + static const char *const optionStrings[] = { /* after, append, before and unpack are deprecated */ "after", "append", "before", "unpack", "configure", "forget", "info", "propagate", "slaves", NULL }; @@ -199,7 +206,8 @@ Tk_PackObjCmd( int index; if (objc >= 2) { - char *string = Tcl_GetString(objv[1]); + const char *string = Tcl_GetString(objv[1]); + if (string[0] == '.') { return ConfigureSlaves(interp, tkwin, objc-1, objv+1); } @@ -209,8 +217,8 @@ Tk_PackObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { /* * Call it again without the deprecated ones to get a proper error * message. This works well since there can't be any ambiguity between @@ -218,8 +226,8 @@ Tk_PackObjCmd( */ Tcl_ResetResult(interp); - Tcl_GetIndexFromObj(interp, objv[1], &optionStrings[4], "option", 0, - &index); + Tcl_GetIndexFromObjStruct(interp, objv[1], &optionStrings[4], + sizeof(char *), "option", 0, &index); return TCL_ERROR; } @@ -234,8 +242,9 @@ Tk_PackObjCmd( } prevPtr = GetPacker(tkwin2); if (prevPtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } return PackAfter(interp, prevPtr, prevPtr->masterPtr, objc-3, objv+3); @@ -267,8 +276,9 @@ Tk_PackObjCmd( } packPtr = GetPacker(tkwin2); if (packPtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } masterPtr = packPtr->masterPtr; @@ -289,8 +299,9 @@ Tk_PackObjCmd( } case PACK_CONFIGURE: if (argv2[0] != '.') { - Tcl_AppendResult(interp, "bad argument \"", argv2, - "\": must be name of window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be name of window", argv2)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL); return TCL_ERROR; } return ConfigureSlaves(interp, tkwin, objc-2, objv+2); @@ -305,8 +316,7 @@ Tk_PackObjCmd( } slavePtr = GetPacker(slave); if ((slavePtr != NULL) && (slavePtr->masterPtr != NULL)) { - Tk_ManageGeometry(slave, NULL, - (ClientData) NULL); + Tk_ManageGeometry(slave, NULL, NULL); if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) { Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin); @@ -320,6 +330,7 @@ Tk_PackObjCmd( case PACK_INFO: { register Packer *slavePtr; Tk_Window slave; + Tcl_Obj *infoObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -330,35 +341,44 @@ Tk_PackObjCmd( } slavePtr = GetPacker(slave); if (slavePtr->masterPtr == NULL) { - Tcl_AppendResult(interp, "window \"", argv2, - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", argv2)); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", NULL); return TCL_ERROR; } - Tcl_AppendElement(interp, "-in"); - Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin)); - Tcl_AppendElement(interp, "-anchor"); - Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor)); - Tcl_AppendResult(interp, " -expand ", - (slavePtr->flags & EXPAND) ? "1" : "0", " -fill ", NULL); + + infoObj = Tcl_NewObj(); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1), + TkNewWindowObj(slavePtr->masterPtr->tkwin)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-anchor", -1), + Tcl_NewStringObj(Tk_NameOfAnchor(slavePtr->anchor), -1)); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-expand", -1), + Tcl_NewBooleanObj(slavePtr->flags & EXPAND)); switch (slavePtr->flags & (FILLX|FILLY)) { case 0: - Tcl_AppendResult(interp, "none", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("none", -1)); break; case FILLX: - Tcl_AppendResult(interp, "x", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("x", -1)); break; case FILLY: - Tcl_AppendResult(interp, "y", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("y", -1)); break; case FILLX|FILLY: - Tcl_AppendResult(interp, "both", NULL); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-fill", -1), + Tcl_NewStringObj("both", -1)); break; } - TkPrintPadAmount(interp, "ipadx", slavePtr->iPadX/2, slavePtr->iPadX); - TkPrintPadAmount(interp, "ipady", slavePtr->iPadY/2, slavePtr->iPadY); - TkPrintPadAmount(interp, "padx", slavePtr->padLeft, slavePtr->padX); - TkPrintPadAmount(interp, "pady", slavePtr->padTop, slavePtr->padY); - Tcl_AppendResult(interp, " -side ", sideNames[slavePtr->side], NULL); + TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX); + TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY); + TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft,slavePtr->padX); + TkAppendPadAmount(infoObj, "-pady", slavePtr->padTop, slavePtr->padY); + Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-side", -1), + Tcl_NewStringObj(sideNames[slavePtr->side], -1)); + Tcl_SetObjResult(interp, infoObj); break; } case PACK_PROPAGATE: { @@ -383,6 +403,16 @@ Tk_PackObjCmd( return TCL_ERROR; } if (propagate) { + /* + * If we have slaves, we need to register as geometry master. + */ + + if (masterPtr->slavePtr != NULL) { + if (TkSetGeometryMaster(interp, master, "pack") != TCL_OK) { + return TCL_ERROR; + } + masterPtr->flags |= ALLOCED_MASTER; + } masterPtr->flags &= ~DONT_PROPAGATE; /* @@ -395,9 +425,13 @@ Tk_PackObjCmd( } if (!(masterPtr->flags & REQUESTED_REPACK)) { masterPtr->flags |= REQUESTED_REPACK; - Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangePacking, masterPtr); } } else { + if (masterPtr->flags & ALLOCED_MASTER) { + TkFreeGeometryMaster(master, "pack"); + masterPtr->flags &= ~ALLOCED_MASTER; + } masterPtr->flags |= DONT_PROPAGATE; } break; @@ -405,6 +439,7 @@ Tk_PackObjCmd( case PACK_SLAVES: { Tk_Window master; Packer *masterPtr, *slavePtr; + Tcl_Obj *resultObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -413,11 +448,14 @@ Tk_PackObjCmd( if (TkGetWindowFromObj(interp, tkwin, objv[2], &master) != TCL_OK) { return TCL_ERROR; } + resultObj = Tcl_NewObj(); masterPtr = GetPacker(master); for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin)); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj(slavePtr->tkwin)); } + Tcl_SetObjResult(interp, resultObj); break; } case PACK_UNPACK: { @@ -433,8 +471,7 @@ Tk_PackObjCmd( } packPtr = GetPacker(tkwin2); if ((packPtr != NULL) && (packPtr->masterPtr != NULL)) { - Tk_ManageGeometry(tkwin2, NULL, - (ClientData) NULL); + Tk_ManageGeometry(tkwin2, NULL, NULL); if (packPtr->masterPtr->tkwin != Tk_Parent(packPtr->tkwin)) { Tk_UnmaintainGeometry(packPtr->tkwin, packPtr->masterPtr->tkwin); @@ -450,7 +487,7 @@ Tk_PackObjCmd( } /* - *-------------------------------------------------------------- + *------------------------------------------------------------------------ * * PackReqProc -- * @@ -464,7 +501,7 @@ Tk_PackObjCmd( * Arranges for tkwin, and all its managed siblings, to be re-packed at * the next idle point. * - *-------------------------------------------------------------- + *------------------------------------------------------------------------ */ /* ARGSUSED */ @@ -475,17 +512,17 @@ PackReqProc( Tk_Window tkwin) /* Other Tk-related information about the * window. */ { - register Packer *packPtr = (Packer *) clientData; + register Packer *packPtr = clientData; packPtr = packPtr->masterPtr; if (!(packPtr->flags & REQUESTED_REPACK)) { packPtr->flags |= REQUESTED_REPACK; - Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr); + Tcl_DoWhenIdle(ArrangePacking, packPtr); } } /* - *-------------------------------------------------------------- + *------------------------------------------------------------------------ * * PackLostSlaveProc -- * @@ -498,7 +535,7 @@ PackReqProc( * Side effects: * Forgets all packer-related information about the slave. * - *-------------------------------------------------------------- + *------------------------------------------------------------------------ */ /* ARGSUSED */ @@ -508,7 +545,7 @@ PackLostSlaveProc( * stolen away. */ Tk_Window tkwin) /* Tk's handle for the slave window. */ { - register Packer *slavePtr = (Packer *) clientData; + register Packer *slavePtr = clientData; if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) { Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin); @@ -518,7 +555,7 @@ PackLostSlaveProc( } /* - *-------------------------------------------------------------- + *------------------------------------------------------------------------ * * ArrangePacking -- * @@ -533,7 +570,7 @@ PackLostSlaveProc( * Side effects: * The packed slaves of masterPtr may get resized or moved. * - *-------------------------------------------------------------- + *------------------------------------------------------------------------ */ static void @@ -541,7 +578,7 @@ ArrangePacking( ClientData clientData) /* Structure describing master whose slaves * are to be re-layed out. */ { - register Packer *masterPtr = (Packer *) clientData; + register Packer *masterPtr = clientData; register Packer *slavePtr; int cavityX, cavityY, cavityWidth, cavityHeight; /* These variables keep track of the @@ -581,7 +618,7 @@ ArrangePacking( } masterPtr->abortPtr = &abort; abort = 0; - Tcl_Preserve((ClientData) masterPtr); + Tcl_Preserve(masterPtr); /* * Pass #1: scan all the slaves to figure out the total amount of space @@ -650,7 +687,7 @@ ArrangePacking( && !(masterPtr->flags & DONT_PROPAGATE)) { Tk_GeometryRequest(masterPtr->tkwin, maxWidth, maxHeight); masterPtr->flags |= REQUESTED_REPACK; - Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangePacking, masterPtr); goto done; } @@ -841,7 +878,7 @@ ArrangePacking( done: masterPtr->abortPtr = NULL; - Tcl_Release((ClientData) masterPtr); + Tcl_Release(masterPtr); } /* @@ -888,9 +925,11 @@ XExpansion( childWidth = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw + slavePtr->padX + slavePtr->iPadX; if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) { - curExpand = (cavityWidth - childWidth)/numExpand; - if (curExpand < minExpand) { - minExpand = curExpand; + if (numExpand) { + curExpand = (cavityWidth - childWidth)/numExpand; + if (curExpand < minExpand) { + minExpand = curExpand; + } } } else { cavityWidth -= childWidth; @@ -899,9 +938,11 @@ XExpansion( } } } - curExpand = cavityWidth/numExpand; - if (curExpand < minExpand) { - minExpand = curExpand; + if (numExpand) { + curExpand = cavityWidth/numExpand; + if (curExpand < minExpand) { + minExpand = curExpand; + } } return (minExpand < 0) ? 0 : minExpand; } @@ -943,9 +984,11 @@ YExpansion( childHeight = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw + slavePtr->padY + slavePtr->iPadY; if ((slavePtr->side == LEFT) || (slavePtr->side == RIGHT)) { - curExpand = (cavityHeight - childHeight)/numExpand; - if (curExpand < minExpand) { - minExpand = curExpand; + if (numExpand) { + curExpand = (cavityHeight - childHeight)/numExpand; + if (curExpand < minExpand) { + minExpand = curExpand; + } } } else { cavityHeight -= childHeight; @@ -954,15 +997,17 @@ YExpansion( } } } - curExpand = cavityHeight/numExpand; - if (curExpand < minExpand) { - minExpand = curExpand; + if (numExpand) { + curExpand = cavityHeight/numExpand; + if (curExpand < minExpand) { + minExpand = curExpand; + } } return (minExpand < 0) ? 0 : minExpand; } /* - *-------------------------------------------------------------- + *------------------------------------------------------------------------ * * GetPacker -- * @@ -977,7 +1022,7 @@ YExpansion( * A new packer structure may be created. If so, then a callback is set * up to clean things up when the window is deleted. * - *-------------------------------------------------------------- + *------------------------------------------------------------------------ */ static Packer * @@ -1003,9 +1048,9 @@ GetPacker( hPtr = Tcl_CreateHashEntry(&dispPtr->packerHashTable, (char *) tkwin, &isNew); if (!isNew) { - return (Packer *) Tcl_GetHashValue(hPtr); + return Tcl_GetHashValue(hPtr); } - packPtr = (Packer *) ckalloc(sizeof(Packer)); + packPtr = ckalloc(sizeof(Packer)); packPtr->tkwin = tkwin; packPtr->masterPtr = NULL; packPtr->nextPtr = NULL; @@ -1020,12 +1065,12 @@ GetPacker( packPtr->flags = 0; Tcl_SetHashValue(hPtr, packPtr); Tk_CreateEventHandler(tkwin, StructureNotifyMask, - PackStructureProc, (ClientData) packPtr); + PackStructureProc, packPtr); return packPtr; } /* - *-------------------------------------------------------------- + *------------------------------------------------------------------------ * * PackAfter -- * @@ -1039,7 +1084,7 @@ GetPacker( * The geometry of the specified windows may change, both now and again * in the future. * - *-------------------------------------------------------------- + *------------------------------------------------------------------------ */ static int @@ -1050,13 +1095,12 @@ PackAfter( * masterPtr. */ Packer *masterPtr, /* Master in which to pack windows. */ int objc, /* Number of elements in objv. */ - Tcl_Obj *CONST objv[]) /* Array of lists, each containing 2 elements: + Tcl_Obj *const objv[]) /* Array of lists, each containing 2 elements: * window name and side against which to * pack. */ { register Packer *packPtr; Tk_Window tkwin, ancestor, parent; - int length; Tcl_Obj **options; int index, optionCount, c; @@ -1068,9 +1112,10 @@ PackAfter( for ( ; objc > 0; objc -= 2, objv += 2, prevPtr = packPtr) { if (objc < 2) { - Tcl_AppendResult(interp, "wrong # args: window \"", - Tcl_GetString(objv[0]), "\" should be followed by options", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: window \"%s\" should be followed by options", + Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -1092,8 +1137,10 @@ PackAfter( } if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_HIERARCHY) { badWindow: - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[0]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside %s", Tcl_GetString(objv[0]), + Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); return TCL_ERROR; } } @@ -1122,24 +1169,25 @@ PackAfter( packPtr->flags |= OLD_STYLE; for (index = 0 ; index < optionCount; index++) { Tcl_Obj *curOptPtr = options[index]; - char *curOpt = Tcl_GetStringFromObj(curOptPtr, &length); + const char *curOpt = Tcl_GetString(curOptPtr); + size_t length = curOptPtr->length; c = curOpt[0]; if ((c == 't') - && (strncmp(curOpt, "top", (size_t) length)) == 0) { + && (strncmp(curOpt, "top", length)) == 0) { packPtr->side = TOP; } else if ((c == 'b') - && (strncmp(curOpt, "bottom", (size_t) length)) == 0) { + && (strncmp(curOpt, "bottom", length)) == 0) { packPtr->side = BOTTOM; } else if ((c == 'l') - && (strncmp(curOpt, "left", (size_t) length)) == 0) { + && (strncmp(curOpt, "left", length)) == 0) { packPtr->side = LEFT; } else if ((c == 'r') - && (strncmp(curOpt, "right", (size_t) length)) == 0) { + && (strncmp(curOpt, "right", length)) == 0) { packPtr->side = RIGHT; } else if ((c == 'e') - && (strncmp(curOpt, "expand", (size_t) length)) == 0) { + && (strncmp(curOpt, "expand", length)) == 0) { packPtr->flags |= EXPAND; } else if ((c == 'f') && (strcmp(curOpt, "fill")) == 0) { @@ -1151,8 +1199,10 @@ PackAfter( } else if ((c == 'p') && (strcmp(curOpt, "padx")) == 0) { if (optionCount < (index+2)) { missingPad: - Tcl_AppendResult(interp, "wrong # args: \"", curOpt, - "\" option must be followed by screen distance", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: \"%s\" option must be" + " followed by screen distance", curOpt)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", NULL); return TCL_ERROR; } @@ -1179,8 +1229,11 @@ PackAfter( } else if ((c == 'f') && (length > 1) && (strncmp(curOpt, "frame", (size_t) length) == 0)) { if (optionCount < (index+2)) { - Tcl_AppendResult(interp, "wrong # args: \"frame\" ", - "option must be followed by anchor point", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong # args: \"frame\"" + " option must be followed by anchor point", -1)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", + NULL); return TCL_ERROR; } if (Tk_GetAnchorFromObj(interp, options[index+1], @@ -1189,15 +1242,17 @@ PackAfter( } index++; } else { - Tcl_AppendResult(interp, "bad option \"", curOpt, - "\": should be top, bottom, left, right, expand, ", - "fill, fillx, filly, padx, pady, or frame", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": should be top, bottom, left," + " right, expand, fill, fillx, filly, padx, pady, or" + " frame", curOpt)); + Tcl_SetErrorCode(interp, "TK", "OLDPACK", "BAD_PARAMETER", + NULL); return TCL_ERROR; } } if (packPtr != prevPtr) { - /* * Unpack this window if it's currently packed. */ @@ -1225,7 +1280,17 @@ PackAfter( packPtr->nextPtr = prevPtr->nextPtr; prevPtr->nextPtr = packPtr; } - Tk_ManageGeometry(tkwin, &packerType, (ClientData) packPtr); + Tk_ManageGeometry(tkwin, &packerType, packPtr); + + if (!(masterPtr->flags & DONT_PROPAGATE)) { + if (TkSetGeometryMaster(interp, masterPtr->tkwin, "pack") + != TCL_OK) { + Tk_ManageGeometry(tkwin, NULL, NULL); + Unlink(packPtr); + return TCL_ERROR; + } + masterPtr->flags |= ALLOCED_MASTER; + } } } @@ -1238,7 +1303,7 @@ PackAfter( } if (!(masterPtr->flags & REQUESTED_REPACK)) { masterPtr->flags |= REQUESTED_REPACK; - Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangePacking, masterPtr); } return TCL_OK; } @@ -1284,13 +1349,24 @@ Unlink( } if (!(masterPtr->flags & REQUESTED_REPACK)) { masterPtr->flags |= REQUESTED_REPACK; - Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangePacking, masterPtr); } if (masterPtr->abortPtr != NULL) { *masterPtr->abortPtr = 1; } packPtr->masterPtr = NULL; + + /* + * If we have emptied this master from slaves it means we are no longer + * handling it and should mark it as free. + */ + + if (masterPtr->slavePtr == NULL && masterPtr->flags & ALLOCED_MASTER) { + TkFreeGeometryMaster(masterPtr->tkwin, "pack"); + masterPtr->flags &= ~ALLOCED_MASTER; + } + } /* @@ -1313,11 +1389,12 @@ Unlink( static void DestroyPacker( - char *memPtr) /* Info about packed window that is now + void *memPtr) /* Info about packed window that is now * dead. */ { - register Packer *packPtr = (Packer *) memPtr; - ckfree((char *) packPtr); + register Packer *packPtr = memPtr; + + ckfree(packPtr); } /* @@ -1344,20 +1421,20 @@ PackStructureProc( * eventPtr. */ XEvent *eventPtr) /* Describes what just happened. */ { - register Packer *packPtr = (Packer *) clientData; + register Packer *packPtr = clientData; if (eventPtr->type == ConfigureNotify) { if ((packPtr->slavePtr != NULL) && !(packPtr->flags & REQUESTED_REPACK)) { packPtr->flags |= REQUESTED_REPACK; - Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr); + Tcl_DoWhenIdle(ArrangePacking, packPtr); } if ((packPtr->masterPtr != NULL) && (packPtr->doubleBw != 2*Tk_Changes(packPtr->tkwin)->border_width)) { if (!(packPtr->masterPtr->flags & REQUESTED_REPACK)) { packPtr->doubleBw = 2*Tk_Changes(packPtr->tkwin)->border_width; packPtr->masterPtr->flags |= REQUESTED_REPACK; - Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr->masterPtr); + Tcl_DoWhenIdle(ArrangePacking, packPtr->masterPtr); } } } else if (eventPtr->type == DestroyNotify) { @@ -1369,8 +1446,7 @@ PackStructureProc( for (slavePtr = packPtr->slavePtr; slavePtr != NULL; slavePtr = nextPtr) { - Tk_ManageGeometry(slavePtr->tkwin, NULL, - (ClientData) NULL); + Tk_ManageGeometry(slavePtr->tkwin, NULL, NULL); Tk_UnmapWindow(slavePtr->tkwin); slavePtr->masterPtr = NULL; nextPtr = slavePtr->nextPtr; @@ -1384,10 +1460,10 @@ PackStructureProc( } if (packPtr->flags & REQUESTED_REPACK) { - Tcl_CancelIdleCall(ArrangePacking, (ClientData) packPtr); + Tcl_CancelIdleCall(ArrangePacking, packPtr); } packPtr->tkwin = NULL; - Tcl_EventuallyFree((ClientData) packPtr, DestroyPacker); + Tcl_EventuallyFree(packPtr, (Tcl_FreeProc *) DestroyPacker); } else if (eventPtr->type == MapNotify) { /* * When a master gets mapped, must redo the geometry computation so @@ -1397,7 +1473,7 @@ PackStructureProc( if ((packPtr->slavePtr != NULL) && !(packPtr->flags & REQUESTED_REPACK)) { packPtr->flags |= REQUESTED_REPACK; - Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr); + Tcl_DoWhenIdle(ArrangePacking, packPtr); } } else if (eventPtr->type == UnmapNotify) { register Packer *packPtr2; @@ -1439,7 +1515,7 @@ ConfigureSlaves( Tk_Window tkwin, /* Any window in application containing * slaves. Used to look up slave names. */ int objc, /* Number of elements in argv. */ - Tcl_Obj *CONST objv[]) /* Argument objects: contains one or more + Tcl_Obj *const objv[]) /* Argument objects: contains one or more * window names followed by any number of * "option value" pairs. Caller must make sure * that there is at least one window name. */ @@ -1447,8 +1523,8 @@ ConfigureSlaves( Packer *masterPtr, *slavePtr, *prevPtr, *otherPtr; Tk_Window other, slave, parent, ancestor; int i, j, numWindows, tmp, positionGiven; - char *string; - static CONST char *optionStrings[] = { + const char *string; + static const char *const optionStrings[] = { "-after", "-anchor", "-before", "-expand", "-fill", "-in", "-ipadx", "-ipady", "-padx", "-pady", "-side", NULL }; enum options { @@ -1485,8 +1561,10 @@ ConfigureSlaves( return TCL_ERROR; } if (Tk_TopWinHierarchy(slave)) { - Tcl_AppendResult(interp, "can't pack \"", Tcl_GetString(objv[j]), - "\": it's a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack \"%s\": it's a top-level window", + Tcl_GetString(objv[j]))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } slavePtr = GetPacker(slave); @@ -1509,13 +1587,14 @@ ConfigureSlaves( for (i = numWindows; i < objc; i+=2) { if ((i+2) > objc) { - Tcl_AppendResult(interp, "extra option \"", - Tcl_GetString(objv[i]), - "\" (option with no value?)", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "extra option \"%s\" (option with no value?)", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "PACK", "BAD_PARAMETER", NULL); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1529,9 +1608,11 @@ ConfigureSlaves( prevPtr = GetPacker(other); if (prevPtr->masterPtr == NULL) { notPacked: - Tcl_AppendResult(interp, "window \"", - Tcl_GetString(objv[i+1]), - "\" isn't packed", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't packed", + Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "PACK", "NOT_PACKED", + NULL); return TCL_ERROR; } masterPtr = prevPtr->masterPtr; @@ -1586,8 +1667,10 @@ ConfigureSlaves( } else if (strcmp(string, "both") == 0) { slavePtr->flags |= FILLX|FILLY; } else { - Tcl_AppendResult(interp, "bad fill style \"", string, - "\": must be none, x, y, or both", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad fill style \"%s\": must be " + "none, x, y, or both", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "FILL", NULL); return TCL_ERROR; } break; @@ -1609,24 +1692,22 @@ ConfigureSlaves( break; case CONF_IPADX: if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp) - != TCL_OK) - || (tmp < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad ipadx value \"", - Tcl_GetString(objv[i+1]), - "\": must be positive screen distance", NULL); + != TCL_OK) || (tmp < 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipadx value \"%s\": must be positive screen" + " distance", Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadX = tmp * 2; break; case CONF_IPADY: if ((Tk_GetPixelsFromObj(interp, slave, objv[i+1], &tmp) - != TCL_OK) - || (tmp < 0)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad ipady value \"", - Tcl_GetString(objv[i+1]), - "\": must be positive screen distance", NULL); + != TCL_OK) || (tmp < 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad ipady value \"%s\": must be positive screen" + " distance", Tcl_GetString(objv[i+1]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "INT_PAD", NULL); return TCL_ERROR; } slavePtr->iPadY = tmp * 2; @@ -1644,8 +1725,8 @@ ConfigureSlaves( } break; case CONF_SIDE: - if (Tcl_GetIndexFromObj(interp, objv[i+1], sideNames, "side", - TCL_EXACT, &side) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i+1], sideNames, + sizeof(char *), "side", TCL_EXACT, &side) != TCL_OK) { return TCL_ERROR; } slavePtr->side = (Side) side; @@ -1703,14 +1784,17 @@ ConfigureSlaves( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]), - " inside ", Tk_PathName(masterPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside %s", Tcl_GetString(objv[j]), + Tk_PathName(masterPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); return TCL_ERROR; } } if (slave == masterPtr->tkwin) { - Tcl_AppendResult(interp, "can't pack ", Tcl_GetString(objv[j]), - " inside itself", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't pack %s inside itself", Tcl_GetString(objv[j]))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } @@ -1728,6 +1812,7 @@ ConfigureSlaves( } Unlink(slavePtr); } + slavePtr->masterPtr = masterPtr; if (prevPtr == NULL) { slavePtr->nextPtr = masterPtr->slavePtr; @@ -1736,9 +1821,19 @@ ConfigureSlaves( slavePtr->nextPtr = prevPtr->nextPtr; prevPtr->nextPtr = slavePtr; } - Tk_ManageGeometry(slave, &packerType, (ClientData) slavePtr); + Tk_ManageGeometry(slave, &packerType, slavePtr); prevPtr = slavePtr; + if (!(masterPtr->flags & DONT_PROPAGATE)) { + if (TkSetGeometryMaster(interp, masterPtr->tkwin, "pack") + != TCL_OK) { + Tk_ManageGeometry(slave, NULL, NULL); + Unlink(slavePtr); + return TCL_ERROR; + } + masterPtr->flags |= ALLOCED_MASTER; + } + /* * Arrange for the master to be re-packed at the first idle moment. */ @@ -1749,7 +1844,7 @@ ConfigureSlaves( } if (!(masterPtr->flags & REQUESTED_REPACK)) { masterPtr->flags |= REQUESTED_REPACK; - Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr); + Tcl_DoWhenIdle(ArrangePacking, masterPtr); } } return TCL_OK; diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c index 99ed179..2451647 100644 --- a/generic/tkPanedWindow.c +++ b/generic/tkPanedWindow.c @@ -276,11 +276,11 @@ static const Tk_ObjCustomOption stickyOption = { static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_BORDER, "-background", "background", "Background", DEF_PANEDWINDOW_BG_COLOR, -1, Tk_Offset(PanedWindow, background), 0, - (ClientData) DEF_PANEDWINDOW_BG_MONO}, + DEF_PANEDWINDOW_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth"}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background"}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_PANEDWINDOW_BORDERWIDTH, -1, Tk_Offset(PanedWindow, borderWidth), 0, 0, GEOMETRY}, @@ -301,7 +301,7 @@ static const Tk_OptionSpec optionSpecs[] = { Tk_Offset(PanedWindow, resizeOpaque), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", DEF_PANEDWINDOW_ORIENT, -1, Tk_Offset(PanedWindow, orient), - 0, (ClientData) orientStrings, GEOMETRY}, + 0, orientStrings, GEOMETRY}, {TK_OPTION_BORDER, "-proxybackground", "proxyBackground", "ProxyBackground", 0, -1, Tk_Offset(PanedWindow, proxyBackground), TK_OPTION_NULL_OK, (ClientData) DEF_PANEDWINDOW_BG_MONO}, @@ -331,7 +331,7 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_PIXELS, "-width", "width", "Width", DEF_PANEDWINDOW_WIDTH, Tk_Offset(PanedWindow, widthPtr), Tk_Offset(PanedWindow, width), TK_OPTION_NULL_OK, 0, GEOMETRY}, - {TK_OPTION_END} + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} }; static const Tk_OptionSpec slaveOptionSpecs[] = { @@ -354,14 +354,14 @@ static const Tk_OptionSpec slaveOptionSpecs[] = { DEF_PANEDWINDOW_PANE_PADY, -1, Tk_Offset(Slave, pady), 0, 0, 0}, {TK_OPTION_CUSTOM, "-sticky", NULL, NULL, DEF_PANEDWINDOW_PANE_STICKY, -1, Tk_Offset(Slave, sticky), 0, - (ClientData) &stickyOption, 0}, + &stickyOption, 0}, {TK_OPTION_STRING_TABLE, "-stretch", "stretch", "Stretch", DEF_PANEDWINDOW_PANE_STRETCH, -1, Tk_Offset(Slave, stretch), 0, (ClientData) stretchStrings, 0}, {TK_OPTION_PIXELS, "-width", NULL, NULL, DEF_PANEDWINDOW_PANE_WIDTH, Tk_Offset(Slave, widthPtr), Tk_Offset(Slave, width), TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_END} + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} }; /* @@ -394,12 +394,12 @@ Tk_PanedWindowObjCmd( XSetWindowAttributes atts; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), - Tcl_GetStringFromObj(objv[1], NULL), NULL); + Tcl_GetString(objv[1]), NULL); if (tkwin == NULL) { return TCL_ERROR; } @@ -414,14 +414,14 @@ Tk_PanedWindowObjCmd( * easy access to it in the future. */ - pwOpts = (OptionTables *) ckalloc(sizeof(OptionTables)); + pwOpts = ckalloc(sizeof(OptionTables)); /* * Set up an exit handler to free the optionTables struct. */ Tcl_SetAssocData(interp, "PanedWindowOptionTables", - DestroyOptionTables, (ClientData) pwOpts); + DestroyOptionTables, pwOpts); /* * Create the paned window option tables. @@ -437,14 +437,14 @@ Tk_PanedWindowObjCmd( * Allocate and initialize the widget record. */ - pwPtr = (PanedWindow *) ckalloc(sizeof(PanedWindow)); + pwPtr = ckalloc(sizeof(PanedWindow)); memset((void *)pwPtr, 0, (sizeof(PanedWindow))); pwPtr->tkwin = tkwin; pwPtr->display = Tk_Display(tkwin); pwPtr->interp = interp; pwPtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(pwPtr->tkwin), PanedWindowWidgetObjCmd, - (ClientData) pwPtr, PanedWindowCmdDeletedProc); + Tk_PathName(pwPtr->tkwin), PanedWindowWidgetObjCmd, pwPtr, + PanedWindowCmdDeletedProc); pwPtr->optionTable = pwOpts->pwOptions; pwPtr->slaveOpts = pwOpts->slaveOpts; pwPtr->relief = TK_RELIEF_RAISED; @@ -457,7 +457,7 @@ Tk_PanedWindowObjCmd( * otherwise Tk might free it while we still need it. */ - Tcl_Preserve((ClientData) pwPtr->tkwin); + Tcl_Preserve(pwPtr->tkwin); if (Tk_InitOptions(interp, (char *) pwPtr, pwOpts->pwOptions, tkwin) != TCL_OK) { @@ -466,7 +466,7 @@ Tk_PanedWindowObjCmd( } Tk_CreateEventHandler(pwPtr->tkwin, ExposureMask|StructureNotifyMask, - PanedWindowEventProc, (ClientData) pwPtr); + PanedWindowEventProc, pwPtr); /* * Find the toplevel ancestor of the panedwindow, and make a proxy win as @@ -496,7 +496,7 @@ Tk_PanedWindowObjCmd( Tk_SetWindowVisual(pwPtr->proxywin, Tk_Visual(tkwin), Tk_Depth(tkwin), Tk_Colormap(tkwin)); Tk_CreateEventHandler(pwPtr->proxywin, ExposureMask, ProxyWindowEventProc, - (ClientData) pwPtr); + pwPtr); atts.save_under = True; Tk_ChangeWindowAttributes(pwPtr->proxywin, CWSaveUnder, &atts); @@ -506,7 +506,7 @@ Tk_PanedWindowObjCmd( return TCL_ERROR; } - Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(pwPtr->tkwin), -1); + Tcl_SetObjResult(interp, TkNewWindowObj(pwPtr->tkwin)); return TCL_OK; } @@ -535,9 +535,9 @@ PanedWindowWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj * const objv[]) /* Argument objects. */ { - PanedWindow *pwPtr = (PanedWindow *) clientData; + PanedWindow *pwPtr = clientData; int result = TCL_OK; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "add", "cget", "configure", "forget", "identify", "panecget", "paneconfigure", "panes", "proxy", "sash", NULL }; @@ -560,7 +560,7 @@ PanedWindowWidgetObjCmd( return TCL_ERROR; } - Tcl_Preserve((ClientData) pwPtr); + Tcl_Preserve(pwPtr); switch ((enum options) index) { case PW_ADD: @@ -618,16 +618,17 @@ PanedWindowWidgetObjCmd( for (count = 0, i = 2; i < objc; i++) { Tk_Window slave = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), pwPtr->tkwin); + if (slave == NULL) { continue; } slavePtr = GetPane(pwPtr, slave); if ((slavePtr != NULL) && (slavePtr->masterPtr != NULL)) { count++; - Tk_ManageGeometry(slave, NULL, (ClientData)NULL); + Tk_ManageGeometry(slave, NULL, NULL); Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin); Tk_DeleteEventHandler(slavePtr->tkwin, StructureNotifyMask, - SlaveStructureProc, (ClientData) slavePtr); + SlaveStructureProc, slavePtr); Tk_UnmapWindow(slavePtr->tkwin); Unlink(slavePtr); } @@ -672,10 +673,13 @@ PanedWindowWidgetObjCmd( objv[3], tkwin); } } - if (i == pwPtr->numSlaves) { - Tcl_SetResult(interp, "not managed by this window", TCL_STATIC); - } if (resultObj == NULL) { + if (i == pwPtr->numSlaves) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not managed by this window", -1)); + Tcl_SetErrorCode(interp, "TK", "PANEDWINDOW", "UNMANAGED", + NULL); + } result = TCL_ERROR; } else { Tcl_SetObjResult(interp, resultObj); @@ -723,15 +727,11 @@ PanedWindowWidgetObjCmd( case PW_PANES: resultObj = Tcl_NewObj(); - - Tcl_IncrRefCount(resultObj); - for (i = 0; i < pwPtr->numSlaves; i++) { - Tcl_ListObjAppendElement(interp, resultObj, - Tcl_NewStringObj(Tk_PathName(pwPtr->slaves[i]->tkwin),-1)); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj(pwPtr->slaves[i]->tkwin)); } Tcl_SetObjResult(interp, resultObj); - Tcl_DecrRefCount(resultObj); break; case PW_PROXY: @@ -742,7 +742,7 @@ PanedWindowWidgetObjCmd( result = PanedWindowSashCommand(pwPtr, interp, objc, objv); break; } - Tcl_Release((ClientData) pwPtr); + Tcl_Release(pwPtr); return result; } @@ -775,7 +775,7 @@ ConfigureSlaves( Tk_Window tkwin = NULL, ancestor, parent; Slave *slavePtr, **inserts, **newSlaves; Slave options; - char *arg; + const char *arg; /* * Find the non-window name arguments; these are the configure options for @@ -801,18 +801,19 @@ ConfigureSlaves( * A panedwindow cannot manage itself. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add ", arg, " to itself", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add %s to itself", arg)); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "SELF", NULL); return TCL_ERROR; } else if (Tk_IsTopLevel(tkwin)) { /* * A panedwindow cannot manage a toplevel. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add toplevel ", arg, " to ", - Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add toplevel %s to %s", arg, + Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } else { /* @@ -826,9 +827,11 @@ ConfigureSlaves( break; } if (Tk_IsTopLevel(ancestor)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "can't add ", arg, " to ", - Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't add %s to %s", arg, + Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", + "HIERARCHY", NULL); return TCL_ERROR; } } @@ -885,9 +888,10 @@ ConfigureSlaves( */ if (haveLoc && index == -1) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", Tk_PathName(tkwin), - "\" is not managed by ", Tk_PathName(pwPtr->tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not managed by %s", + Tk_PathName(tkwin), Tk_PathName(pwPtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "PANEDWINDOW", "UNMANAGED", NULL); Tk_FreeConfigOptions((char *) &options, pwPtr->slaveOpts, pwPtr->tkwin); return TCL_ERROR; @@ -899,7 +903,7 @@ ConfigureSlaves( * structures may already have existed, some may be new. */ - inserts = (Slave **)ckalloc(sizeof(Slave *) * (firstOptionArg - 2)); + inserts = ckalloc(sizeof(Slave *) * (firstOptionArg - 2)); insertIndex = 0; /* @@ -966,7 +970,7 @@ ConfigureSlaves( * out with their "natural" dimensions. */ - slavePtr = (Slave *) ckalloc(sizeof(Slave)); + slavePtr = ckalloc(sizeof(Slave)); memset(slavePtr, 0, sizeof(Slave)); Tk_InitOptions(interp, (char *)slavePtr, pwPtr->slaveOpts, pwPtr->tkwin); @@ -995,9 +999,8 @@ ConfigureSlaves( */ Tk_CreateEventHandler(slavePtr->tkwin, StructureNotifyMask, - SlaveStructureProc, (ClientData) slavePtr); - Tk_ManageGeometry(slavePtr->tkwin, &panedWindowMgrType, - (ClientData) slavePtr); + SlaveStructureProc, slavePtr); + Tk_ManageGeometry(slavePtr->tkwin, &panedWindowMgrType, slavePtr); inserts[insertIndex++] = slavePtr; numNewSlaves++; } @@ -1006,8 +1009,8 @@ ConfigureSlaves( * Allocate the new slaves array, then copy the slaves into it, in order. */ - i = sizeof(Slave *) * (pwPtr->numSlaves+numNewSlaves); - newSlaves = (Slave **)ckalloc((unsigned) i); + i = sizeof(Slave *) * (pwPtr->numSlaves + numNewSlaves); + newSlaves = ckalloc(i); memset(newSlaves, 0, (size_t) i); if (index == -1) { /* @@ -1050,8 +1053,8 @@ ConfigureSlaves( * Make the new slaves array the paned window's slave array, and clean up. */ - ckfree((void *)pwPtr->slaves); - ckfree((void *)inserts); + ckfree(pwPtr->slaves); + ckfree(inserts); pwPtr->slaves = newSlaves; /* @@ -1090,7 +1093,7 @@ PanedWindowSashCommand( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *sashOptionStrings[] = { + static const char *const sashOptionStrings[] = { "coord", "dragto", "mark", "place", NULL }; enum sashOptions { @@ -1110,7 +1113,6 @@ PanedWindowSashCommand( return TCL_ERROR; } - Tcl_ResetResult(interp); switch ((enum sashOptions) index) { case SASH_COORD: if (objc != 4) { @@ -1123,15 +1125,16 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL); return TCL_ERROR; } slavePtr = pwPtr->slaves[sash]; coords[0] = Tcl_NewIntObj(slavePtr->sashx); coords[1] = Tcl_NewIntObj(slavePtr->sashy); - Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords)); break; case SASH_MARK: @@ -1145,8 +1148,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL); return TCL_ERROR; } @@ -1164,7 +1168,7 @@ PanedWindowSashCommand( } else { coords[0] = Tcl_NewIntObj(pwPtr->slaves[sash]->markx); coords[1] = Tcl_NewIntObj(pwPtr->slaves[sash]->marky); - Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords)); } break; @@ -1180,8 +1184,9 @@ PanedWindowSashCommand( } if (!ValidSashIndex(pwPtr, sash)) { - Tcl_ResetResult(interp); - Tcl_SetResult(interp, "invalid sash index", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid sash index", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SASH_INDEX", NULL); return TCL_ERROR; } @@ -1252,7 +1257,7 @@ ConfigurePanedWindow( Tk_FreeSavedOptions(&savedOptions); - PanedWindowWorldChanged((ClientData) pwPtr); + PanedWindowWorldChanged(pwPtr); /* * If an option that affects geometry has changed, make a re-layout @@ -1290,7 +1295,7 @@ PanedWindowWorldChanged( { XGCValues gcValues; GC newGC; - PanedWindow *pwPtr = (PanedWindow *) instanceData; + PanedWindow *pwPtr = instanceData; /* * Allocated a graphics context for drawing the paned window widget @@ -1319,7 +1324,7 @@ PanedWindowWorldChanged( */ if (Tk_IsMapped(pwPtr->tkwin) && !(pwPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr); + Tcl_DoWhenIdle(DisplayPanedWindow, pwPtr); pwPtr->flags |= REDRAW_PENDING; } } @@ -1347,18 +1352,18 @@ PanedWindowEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - PanedWindow *pwPtr = (PanedWindow *) clientData; + PanedWindow *pwPtr = clientData; int i; if (eventPtr->type == Expose) { if (pwPtr->tkwin != NULL && !(pwPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr); + Tcl_DoWhenIdle(DisplayPanedWindow, pwPtr); pwPtr->flags |= REDRAW_PENDING; } } else if (eventPtr->type == ConfigureNotify) { pwPtr->flags |= REQUESTED_RELAYOUT; if (pwPtr->tkwin != NULL && !(pwPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr); + Tcl_DoWhenIdle(DisplayPanedWindow, pwPtr); pwPtr->flags |= REDRAW_PENDING; } } else if (eventPtr->type == DestroyNotify) { @@ -1396,7 +1401,7 @@ static void PanedWindowCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - PanedWindow *pwPtr = (PanedWindow *) clientData; + PanedWindow *pwPtr = clientData; /* * This function could be invoked either because the window was destroyed @@ -1433,7 +1438,7 @@ static void DisplayPanedWindow( ClientData clientData) /* Information about window. */ { - PanedWindow *pwPtr = (PanedWindow *) clientData; + PanedWindow *pwPtr = clientData; Slave *slavePtr; Pixmap pixmap; Tk_Window tkwin = pwPtr->tkwin; @@ -1553,10 +1558,10 @@ DestroyPanedWindow( */ if (pwPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayPanedWindow, (ClientData) pwPtr); + Tcl_CancelIdleCall(DisplayPanedWindow, pwPtr); } if (pwPtr->flags & RESIZE_PENDING) { - Tcl_CancelIdleCall(ArrangePanes, (ClientData) pwPtr); + Tcl_CancelIdleCall(ArrangePanes, pwPtr); } /* @@ -1568,15 +1573,15 @@ DestroyPanedWindow( for (i = 0; i < pwPtr->numSlaves; i++) { Tk_DeleteEventHandler(pwPtr->slaves[i]->tkwin, StructureNotifyMask, - SlaveStructureProc, (ClientData) pwPtr->slaves[i]); + SlaveStructureProc, pwPtr->slaves[i]); Tk_ManageGeometry(pwPtr->slaves[i]->tkwin, NULL, NULL); - Tk_FreeConfigOptions((char *)pwPtr->slaves[i], pwPtr->slaveOpts, + Tk_FreeConfigOptions((char *) pwPtr->slaves[i], pwPtr->slaveOpts, pwPtr->tkwin); - ckfree((void *)pwPtr->slaves[i]); + ckfree(pwPtr->slaves[i]); pwPtr->slaves[i] = NULL; } if (pwPtr->slaves) { - ckfree((char *) pwPtr->slaves); + ckfree(pwPtr->slaves); } /* @@ -1590,10 +1595,10 @@ DestroyPanedWindow( */ Tk_FreeConfigOptions((char *) pwPtr, pwPtr->optionTable, pwPtr->tkwin); - Tcl_Release((ClientData) pwPtr->tkwin); + Tcl_Release(pwPtr->tkwin); pwPtr->tkwin = NULL; - Tcl_EventuallyFree((ClientData) pwPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(pwPtr, TCL_DYNAMIC); } /* @@ -1621,12 +1626,13 @@ PanedWindowReqProc( Tk_Window tkwin) /* Other Tk-related information about the * window. */ { - Slave *slavePtr = (Slave *) clientData; - PanedWindow *pwPtr = (PanedWindow *) (slavePtr->masterPtr); + Slave *slavePtr = clientData; + PanedWindow *pwPtr = (PanedWindow *) slavePtr->masterPtr; + if (Tk_IsMapped(pwPtr->tkwin)) { if (!(pwPtr->flags & RESIZE_PENDING)) { pwPtr->flags |= RESIZE_PENDING; - Tcl_DoWhenIdle(ArrangePanes, (ClientData) pwPtr); + Tcl_DoWhenIdle(ArrangePanes, pwPtr); } } else { int doubleBw = 2 * Tk_Changes(slavePtr->tkwin)->border_width; @@ -1665,18 +1671,18 @@ PanedWindowLostSlaveProc( * stolen away. */ Tk_Window tkwin) /* Tk's handle for the slave window. */ { - register Slave *slavePtr = (Slave *) clientData; - PanedWindow *pwPtr = (PanedWindow *) (slavePtr->masterPtr); + register Slave *slavePtr = clientData; + PanedWindow *pwPtr = (PanedWindow *) slavePtr->masterPtr; if (pwPtr->tkwin != Tk_Parent(slavePtr->tkwin)) { Tk_UnmaintainGeometry(slavePtr->tkwin, pwPtr->tkwin); } Unlink(slavePtr); Tk_DeleteEventHandler(slavePtr->tkwin, StructureNotifyMask, - SlaveStructureProc, (ClientData) slavePtr); + SlaveStructureProc, slavePtr); Tk_UnmapWindow(slavePtr->tkwin); slavePtr->tkwin = NULL; - ckfree((void *)slavePtr); + ckfree(slavePtr); ComputeGeometry(pwPtr); } @@ -1704,7 +1710,7 @@ ArrangePanes( ClientData clientData) /* Structure describing parent whose slaves * are to be re-layed out. */ { - register PanedWindow *pwPtr = (PanedWindow *) clientData; + register PanedWindow *pwPtr = clientData; register Slave *slavePtr; int i, slaveWidth, slaveHeight, slaveX, slaveY; int paneWidth, paneHeight, paneSize, paneMinSize; @@ -1731,7 +1737,7 @@ ArrangePanes( return; } - Tcl_Preserve((ClientData) pwPtr); + Tcl_Preserve(pwPtr); /* * Find index of first and last visible panes. @@ -1967,7 +1973,7 @@ ArrangePanes( } sashCount--; } - Tcl_Release((ClientData) pwPtr); + Tcl_Release(pwPtr); } /* @@ -2028,7 +2034,7 @@ Unlink( masterPtr->flags |= REQUESTED_RELAYOUT; if (!(masterPtr->flags & REDRAW_PENDING)) { masterPtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) masterPtr); + Tcl_DoWhenIdle(DisplayPanedWindow, masterPtr); } /* @@ -2134,13 +2140,13 @@ SlaveStructureProc( ClientData clientData, /* Pointer to record describing window item. */ XEvent *eventPtr) /* Describes what just happened. */ { - Slave *slavePtr = (Slave *) clientData; + Slave *slavePtr = clientData; PanedWindow *pwPtr = slavePtr->masterPtr; if (eventPtr->type == DestroyNotify) { Unlink(slavePtr); slavePtr->tkwin = NULL; - ckfree((void *)slavePtr); + ckfree(slavePtr); ComputeGeometry(pwPtr); } } @@ -2319,7 +2325,7 @@ ComputeGeometry( Tk_GeometryRequest(pwPtr->tkwin, reqWidth, reqHeight); if (Tk_IsMapped(pwPtr->tkwin) && !(pwPtr->flags & REDRAW_PENDING)) { pwPtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayPanedWindow, (ClientData) pwPtr); + Tcl_DoWhenIdle(DisplayPanedWindow, pwPtr); } } @@ -2346,8 +2352,7 @@ DestroyOptionTables( ClientData clientData, /* Pointer to the OptionTables struct */ Tcl_Interp *interp) /* Pointer to the calling interp */ { - ckfree((char *)clientData); - return; + ckfree(clientData); } /* @@ -2376,22 +2381,22 @@ GetSticky( * sticky value. */ { int sticky = *(int *)(recordPtr + internalOffset); - static char buffer[5]; - int count = 0; + char buffer[5]; + char *p = &buffer[0]; if (sticky & STICK_NORTH) { - buffer[count++] = 'n'; + *p++ = 'n'; } if (sticky & STICK_EAST) { - buffer[count++] = 'e'; + *p++ = 'e'; } if (sticky & STICK_SOUTH) { - buffer[count++] = 's'; + *p++ = 's'; } if (sticky & STICK_WEST) { - buffer[count++] = 'w'; + *p++ = 'w'; } - buffer[count] = '\0'; + *p = '\0'; return Tcl_NewStringObj(buffer, -1); } @@ -2430,7 +2435,8 @@ SetSticky( int flags) /* Flags for the option, set Tk_SetOptions. */ { int sticky = 0; - char c, *string, *internalPtr; + char c, *internalPtr; + const char *string; internalPtr = ComputeSlotAddress(recordPtr, internalOffset); @@ -2460,10 +2466,11 @@ SetSticky( case ' ': case ',': case '\t': case '\r': case '\n': break; default: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad stickyness value \"", - Tcl_GetString(*value), "\": must be a string ", - "containing zero or more of n, e, s, and w", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad stickyness value \"%s\": must be a string" + " containing zero or more of n, e, s, and w", + Tcl_GetString(*value))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STICKY", NULL); return TCL_ERROR; } } @@ -2716,7 +2723,7 @@ MoveSash( * None. * * Side effects: - * When the window gets deleted, internal structures get cleaned up. Whena + * When the window gets deleted, internal structures get cleaned up. When * it gets exposed, it is redisplayed. * *-------------------------------------------------------------- @@ -2727,11 +2734,11 @@ ProxyWindowEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - PanedWindow *pwPtr = (PanedWindow *) clientData; + PanedWindow *pwPtr = clientData; if (eventPtr->type == Expose) { if (pwPtr->proxywin != NULL &&!(pwPtr->flags & PROXY_REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayProxyWindow, (ClientData) pwPtr); + Tcl_DoWhenIdle(DisplayProxyWindow, pwPtr); pwPtr->flags |= PROXY_REDRAW_PENDING; } } @@ -2759,7 +2766,7 @@ static void DisplayProxyWindow( ClientData clientData) /* Information about window. */ { - PanedWindow *pwPtr = (PanedWindow *) clientData; + PanedWindow *pwPtr = clientData; Pixmap pixmap; Tk_Window tkwin = pwPtr->proxywin; pwPtr->flags &= ~PROXY_REDRAW_PENDING; @@ -2822,7 +2829,7 @@ PanedWindowProxyCommand( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "coord", "forget", "place", NULL }; enum options { @@ -2851,7 +2858,7 @@ PanedWindowProxyCommand( coords[0] = Tcl_NewIntObj(pwPtr->proxyx); coords[1] = Tcl_NewIntObj(pwPtr->proxyy); - Tcl_SetListObj(Tcl_GetObjResult(interp), 2, coords); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords)); break; case PROXY_FORGET: @@ -2906,12 +2913,12 @@ PanedWindowProxyCommand( (2 * Tk_InternalBorderWidth(pwPtr->tkwin)); } - if (sashWidth < 1) { - sashWidth = 1; - } - if (sashHeight < 1) { - sashHeight = 1; - } + if (sashWidth < 1) { + sashWidth = 1; + } + if (sashHeight < 1) { + sashHeight = 1; + } /* * Stash the proxy coordinates for future "proxy coord" calls. @@ -2973,7 +2980,7 @@ ObjectIsEmpty( if (objPtr->bytes != NULL) { return (objPtr->length == 0); } - Tcl_GetStringFromObj(objPtr, &length); + (void)Tcl_GetStringFromObj(objPtr, &length); return (length == 0); } @@ -3032,11 +3039,9 @@ PanedWindowIdentifyCoords( Tcl_Interp *interp, /* Interpreter in which to store result. */ int x, int y) /* Coordinates of the point to identify. */ { - Tcl_Obj *list; int i, sashHeight, sashWidth, thisx, thisy; int found, isHandle, lpad, rpad, tpad, bpad; int first, last; - list = Tcl_NewObj(); if (pwPtr->orient == ORIENT_HORIZONTAL) { if (Tk_IsMapped(pwPtr->tkwin)) { @@ -3112,16 +3117,17 @@ PanedWindowIdentifyCoords( } /* - * Set results. + * Set results. Note that the empty string is the default (this function + * is called inside the implementation of a command). */ if (found != -1) { - Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(found)); - Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj( - (isHandle ? "handle" : "sash"), -1)); - } + Tcl_Obj *list[2]; - Tcl_SetObjResult(interp, list); + list[0] = Tcl_NewIntObj(found); + list[1] = Tcl_NewStringObj((isHandle ? "handle" : "sash"), -1); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, list)); + } return TCL_OK; } diff --git a/generic/tkPlace.c b/generic/tkPlace.c index 2f527ba..9fa406a 100644 --- a/generic/tkPlace.c +++ b/generic/tkPlace.c @@ -24,7 +24,7 @@ * actual window size. */ -static CONST char *borderModeStrings[] = { +static const char *const borderModeStrings[] = { "inside", "outside", "ignore", NULL }; @@ -84,7 +84,7 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_ANCHOR, "-anchor", NULL, NULL, "nw", -1, Tk_Offset(Slave, anchor), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-bordermode", NULL, NULL, "inside", -1, - Tk_Offset(Slave, borderMode), 0, (ClientData) borderModeStrings, 0}, + Tk_Offset(Slave, borderMode), 0, borderModeStrings, 0}, {TK_OPTION_PIXELS, "-height", NULL, NULL, "", Tk_Offset(Slave, heightPtr), Tk_Offset(Slave, height), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_WINDOW, "-in", NULL, NULL, "", -1, Tk_Offset(Slave, inTkwin), @@ -172,7 +172,7 @@ static void SlaveStructureProc(ClientData clientData, XEvent *eventPtr); static int ConfigureSlave(Tcl_Interp *interp, Tk_Window tkwin, Tk_OptionTable table, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int PlaceInfoCommand(Tcl_Interp *interp, Tk_Window tkwin); static Slave * CreateSlave(Tk_Window tkwin, Tk_OptionTable table); static void FreeSlave(Slave *slavePtr); @@ -203,17 +203,17 @@ static void UnlinkSlave(Slave *slavePtr); int Tk_PlaceObjCmd( - ClientData clientData, /* NULL. */ + ClientData clientData, /* Interpreter main window. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { + Tk_Window main_win = clientData; Tk_Window tkwin; Slave *slavePtr; - char *string; TkDisplay *dispPtr; Tk_OptionTable optionTable; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "configure", "forget", "info", "slaves", NULL }; enum options { PLACE_CONFIGURE, PLACE_FORGET, PLACE_INFO, PLACE_SLAVES }; @@ -235,10 +235,9 @@ Tk_PlaceObjCmd( * Handle special shortcut where window name is first argument. */ - string = Tcl_GetString(objv[1]); - if (string[0] == '.') { - tkwin = Tk_NameToWindow(interp, string, Tk_MainWindow(interp)); - if (tkwin == NULL) { + if (Tcl_GetString(objv[1])[0] == '.') { + if (TkGetWindowFromObj(interp, main_win, objv[1], + &tkwin) != TCL_OK) { return TCL_ERROR; } @@ -261,9 +260,8 @@ Tk_PlaceObjCmd( * possible additional arguments. */ - tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), - Tk_MainWindow(interp)); - if (tkwin == NULL) { + if (TkGetWindowFromObj(interp, main_win, objv[2], + &tkwin) != TCL_OK) { return TCL_ERROR; } @@ -278,8 +276,8 @@ Tk_PlaceObjCmd( dispPtr->placeInit = 1; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -319,8 +317,8 @@ Tk_PlaceObjCmd( Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin)); Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc, - (ClientData) slavePtr); - Tk_ManageGeometry(tkwin, NULL, (ClientData) NULL); + slavePtr); + Tk_ManageGeometry(tkwin, NULL, NULL); Tk_UnmapWindow(tkwin); FreeSlave(slavePtr); break; @@ -345,8 +343,8 @@ Tk_PlaceObjCmd( for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(Tk_PathName(slavePtr->tkwin),-1)); + Tcl_ListObjAppendElement(NULL, listPtr, + TkNewWindowObj(slavePtr->tkwin)); } Tcl_SetObjResult(interp, listPtr); } @@ -386,7 +384,7 @@ CreateSlave( hPtr = Tcl_CreateHashEntry(&dispPtr->slaveTable, (char *) tkwin, &isNew); if (!isNew) { - return (Slave *) Tcl_GetHashValue(hPtr); + return Tcl_GetHashValue(hPtr); } /* @@ -394,7 +392,7 @@ CreateSlave( * populate it with some default values. */ - slavePtr = (Slave *) ckalloc(sizeof(Slave)); + slavePtr = ckalloc(sizeof(Slave)); memset(slavePtr, 0, sizeof(Slave)); slavePtr->tkwin = tkwin; slavePtr->inTkwin = None; @@ -403,7 +401,7 @@ CreateSlave( slavePtr->optionTable = table; Tcl_SetHashValue(hPtr, slavePtr); Tk_CreateEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc, - (ClientData) slavePtr); + slavePtr); return slavePtr; } @@ -429,7 +427,7 @@ FreeSlave( { Tk_FreeConfigOptions((char *) slavePtr, slavePtr->optionTable, slavePtr->tkwin); - ckfree((char *) slavePtr); + ckfree(slavePtr); } /* @@ -454,16 +452,14 @@ static Slave * FindSlave( Tk_Window tkwin) /* Token for desired slave. */ { - Tcl_HashEntry *hPtr; - register Slave *slavePtr; + register Tcl_HashEntry *hPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin); if (hPtr == NULL) { return NULL; } - slavePtr = (Slave *) Tcl_GetHashValue(hPtr); - return slavePtr; + return Tcl_GetHashValue(hPtr); } /* @@ -507,7 +503,7 @@ UnlinkSlave( } } } - + if (masterPtr->abortPtr != NULL) { *masterPtr->abortPtr = 1; } @@ -542,16 +538,16 @@ CreateMaster( hPtr = Tcl_CreateHashEntry(&dispPtr->masterTable, (char *) tkwin, &isNew); if (isNew) { - masterPtr = (Master *) ckalloc(sizeof(Master)); + masterPtr = ckalloc(sizeof(Master)); masterPtr->tkwin = tkwin; masterPtr->slavePtr = NULL; masterPtr->abortPtr = NULL; masterPtr->flags = 0; Tcl_SetHashValue(hPtr, masterPtr); Tk_CreateEventHandler(masterPtr->tkwin, StructureNotifyMask, - MasterStructureProc, (ClientData) masterPtr); + MasterStructureProc, masterPtr); } else { - masterPtr = (Master *) Tcl_GetHashValue(hPtr); + masterPtr = Tcl_GetHashValue(hPtr); } return masterPtr; } @@ -579,16 +575,14 @@ static Master * FindMaster( Tk_Window tkwin) /* Token for desired master. */ { - Tcl_HashEntry *hPtr; - register Master *masterPtr; + register Tcl_HashEntry *hPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; hPtr = Tcl_FindHashEntry(&dispPtr->masterTable, (char *) tkwin); if (hPtr == NULL) { return NULL; } - masterPtr = (Master *) Tcl_GetHashValue(hPtr); - return masterPtr; + return Tcl_GetHashValue(hPtr); } /* @@ -616,7 +610,7 @@ ConfigureSlave( Tk_Window tkwin, /* Token for the window to manipulate. */ Tk_OptionTable table, /* Token for option table. */ int objc, /* Number of config arguments. */ - Tcl_Obj *CONST objv[]) /* Object values for arguments. */ + Tcl_Obj *const objv[]) /* Object values for arguments. */ { register Master *masterPtr; Tk_SavedOptions savedOptions; @@ -625,8 +619,10 @@ ConfigureSlave( Tk_Window masterWin = (Tk_Window) NULL; if (Tk_TopWinHierarchy(tkwin)) { - Tcl_AppendResult(interp, "can't use placer on top-level window \"", - Tk_PathName(tkwin), "\"; use wm command instead", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use placer on top-level window \"%s\"; use " + "wm command instead", Tk_PathName(tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL); return TCL_ERROR; } @@ -658,7 +654,7 @@ ConfigureSlave( slavePtr->flags |= CHILD_WIDTH; } - if (((mask & IN_MASK) == 0) && (slavePtr->masterPtr != NULL)) { + if (!(mask & IN_MASK) && (slavePtr->masterPtr != NULL)) { /* * If no -in option was passed and the slave is already placed then * just recompute the placement. @@ -684,16 +680,18 @@ ConfigureSlave( break; } if (Tk_TopWinHierarchy(ancestor)) { - Tcl_AppendResult(interp, "can't place ", - Tk_PathName(slavePtr->tkwin), " relative to ", - Tk_PathName(tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't place %s relative to %s", + Tk_PathName(slavePtr->tkwin), Tk_PathName(tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); goto error; } } if (slavePtr->tkwin == tkwin) { - Tcl_AppendResult(interp, "can't place ", - Tk_PathName(slavePtr->tkwin), " relative to itself", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't place %s relative to itself", + Tk_PathName(slavePtr->tkwin))); + Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); goto error; } if ((slavePtr->masterPtr != NULL) @@ -730,7 +728,7 @@ ConfigureSlave( slavePtr->masterPtr = masterPtr; slavePtr->nextPtr = masterPtr->slavePtr; masterPtr->slavePtr = slavePtr; - Tk_ManageGeometry(slavePtr->tkwin, &placerType, (ClientData) slavePtr); + Tk_ManageGeometry(slavePtr->tkwin, &placerType, slavePtr); /* * Arrange for the master to be re-arranged at the first idle moment. @@ -741,7 +739,7 @@ ConfigureSlave( if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) { masterPtr->flags |= PARENT_RECONFIG_PENDING; - Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr); + Tcl_DoWhenIdle(RecomputePlacement, masterPtr); } return TCL_OK; @@ -777,54 +775,50 @@ PlaceInfoCommand( Tcl_Interp *interp, /* Interp into which to place result. */ Tk_Window tkwin) /* Token for the window to get info on. */ { - char buffer[32 + TCL_INTEGER_SPACE]; Slave *slavePtr; + Tcl_Obj *infoObj; slavePtr = FindSlave(tkwin); if (slavePtr == NULL) { return TCL_OK; } + infoObj = Tcl_NewObj(); if (slavePtr->masterPtr != NULL) { - Tcl_AppendElement(interp, "-in"); - Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin)); + Tcl_AppendToObj(infoObj, "-in", -1); + Tcl_ListObjAppendElement(NULL, infoObj, + TkNewWindowObj(slavePtr->masterPtr->tkwin)); + Tcl_AppendToObj(infoObj, " ", -1); } - sprintf(buffer, " -x %d", slavePtr->x); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, " -relx %.4g", slavePtr->relX); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, " -y %d", slavePtr->y); - Tcl_AppendResult(interp, buffer, NULL); - sprintf(buffer, " -rely %.4g", slavePtr->relY); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, + "-x %d -relx %.4g -y %d -rely %.4g", + slavePtr->x, slavePtr->relX, slavePtr->y, slavePtr->relY); if (slavePtr->flags & CHILD_WIDTH) { - sprintf(buffer, " -width %d", slavePtr->width); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, " -width %d", slavePtr->width); } else { - Tcl_AppendResult(interp, " -width {}", NULL); + Tcl_AppendToObj(infoObj, " -width {}", -1); } if (slavePtr->flags & CHILD_REL_WIDTH) { - sprintf(buffer, " -relwidth %.4g", slavePtr->relWidth); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, + " -relwidth %.4g", slavePtr->relWidth); } else { - Tcl_AppendResult(interp, " -relwidth {}", NULL); + Tcl_AppendToObj(infoObj, " -relwidth {}", -1); } if (slavePtr->flags & CHILD_HEIGHT) { - sprintf(buffer, " -height %d", slavePtr->height); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, " -height %d", slavePtr->height); } else { - Tcl_AppendResult(interp, " -height {}", NULL); + Tcl_AppendToObj(infoObj, " -height {}", -1); } if (slavePtr->flags & CHILD_REL_HEIGHT) { - sprintf(buffer, " -relheight %.4g", slavePtr->relHeight); - Tcl_AppendResult(interp, buffer, NULL); + Tcl_AppendPrintfToObj(infoObj, + " -relheight %.4g", slavePtr->relHeight); } else { - Tcl_AppendResult(interp, " -relheight {}", NULL); + Tcl_AppendToObj(infoObj, " -relheight {}", -1); } - Tcl_AppendElement(interp, "-anchor"); - Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor)); - Tcl_AppendElement(interp, "-bordermode"); - Tcl_AppendElement(interp, borderModeStrings[slavePtr->borderMode]); + Tcl_AppendPrintfToObj(infoObj, " -anchor %s -bordermode %s", + Tk_NameOfAnchor(slavePtr->anchor), + borderModeStrings[slavePtr->borderMode]); + Tcl_SetObjResult(interp, infoObj); return TCL_OK; } @@ -849,21 +843,20 @@ static void RecomputePlacement( ClientData clientData) /* Pointer to Master record. */ { - register Master *masterPtr = (Master *) clientData; + register Master *masterPtr = clientData; register Slave *slavePtr; int x, y, width, height, tmp; int masterWidth, masterHeight, masterX, masterY; double x1, y1, x2, y2; - int abort; /* May get set to non-zero to abort this * placement operation. */ masterPtr->flags &= ~PARENT_RECONFIG_PENDING; - + /* * Abort any nested call to RecomputePlacement for this window, since - * we'll do everything necessary here, and set up so this call - * can be aborted if necessary. + * we'll do everything necessary here, and set up so this call can be + * aborted if necessary. */ if (masterPtr->abortPtr != NULL) { @@ -871,13 +864,13 @@ RecomputePlacement( } masterPtr->abortPtr = &abort; abort = 0; - Tcl_Preserve((ClientData) masterPtr); + Tcl_Preserve(masterPtr); /* * Iterate over all the slaves for the master. Each slave's geometry can * be computed independently of the other slaves. Changes to the window's * structure could cause almost anything to happen, including deleting the - * parent or child. If this happens, we'll be told to abort. + * parent or child. If this happens, we'll be told to abort. */ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL && !abort; @@ -1044,7 +1037,7 @@ RecomputePlacement( } masterPtr->abortPtr = NULL; - Tcl_Release((ClientData) masterPtr); + Tcl_Release(masterPtr); } /* @@ -1071,17 +1064,19 @@ MasterStructureProc( * referred to by eventPtr. */ XEvent *eventPtr) /* Describes what just happened. */ { - register Master *masterPtr = (Master *) clientData; + register Master *masterPtr = clientData; register Slave *slavePtr, *nextPtr; TkDisplay *dispPtr = ((TkWindow *) masterPtr->tkwin)->dispPtr; - if (eventPtr->type == ConfigureNotify) { + switch (eventPtr->type) { + case ConfigureNotify: if ((masterPtr->slavePtr != NULL) && !(masterPtr->flags & PARENT_RECONFIG_PENDING)) { masterPtr->flags |= PARENT_RECONFIG_PENDING; - Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr); + Tcl_DoWhenIdle(RecomputePlacement, masterPtr); } - } else if (eventPtr->type == DestroyNotify) { + return; + case DestroyNotify: for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = nextPtr) { slavePtr->masterPtr = NULL; @@ -1091,14 +1086,15 @@ MasterStructureProc( Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->masterTable, (char *) masterPtr->tkwin)); if (masterPtr->flags & PARENT_RECONFIG_PENDING) { - Tcl_CancelIdleCall(RecomputePlacement, (ClientData) masterPtr); + Tcl_CancelIdleCall(RecomputePlacement, masterPtr); } masterPtr->tkwin = NULL; if (masterPtr->abortPtr != NULL) { *masterPtr->abortPtr = 1; } - Tcl_EventuallyFree((ClientData) masterPtr, TCL_DYNAMIC); - } else if (eventPtr->type == MapNotify) { + Tcl_EventuallyFree(masterPtr, TCL_DYNAMIC); + return; + case MapNotify: /* * When a master gets mapped, must redo the geometry computation so * that all of its slaves get remapped. @@ -1107,9 +1103,10 @@ MasterStructureProc( if ((masterPtr->slavePtr != NULL) && !(masterPtr->flags & PARENT_RECONFIG_PENDING)) { masterPtr->flags |= PARENT_RECONFIG_PENDING; - Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr); + Tcl_DoWhenIdle(RecomputePlacement, masterPtr); } - } else if (eventPtr->type == UnmapNotify) { + return; + case UnmapNotify: /* * Unmap all of the slaves when the master gets unmapped, so that they * don't keep redisplaying themselves. @@ -1119,6 +1116,7 @@ MasterStructureProc( slavePtr = slavePtr->nextPtr) { Tk_UnmapWindow(slavePtr->tkwin); } + return; } } @@ -1145,7 +1143,7 @@ SlaveStructureProc( * referred to by eventPtr. */ XEvent *eventPtr) /* Describes what just happened. */ { - register Slave *slavePtr = (Slave *) clientData; + register Slave *slavePtr = clientData; TkDisplay *dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr; if (eventPtr->type == DestroyNotify) { @@ -1182,11 +1180,11 @@ PlaceRequestProc( ClientData clientData, /* Pointer to our record for slave. */ Tk_Window tkwin) /* Window that changed its desired size. */ { - Slave *slavePtr = (Slave *) clientData; + Slave *slavePtr = clientData; Master *masterPtr; - if (((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) != 0) - && ((slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT)) != 0)) { + if ((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) + && (slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT))) { return; } masterPtr = slavePtr->masterPtr; @@ -1195,7 +1193,7 @@ PlaceRequestProc( } if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) { masterPtr->flags |= PARENT_RECONFIG_PENDING; - Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr); + Tcl_DoWhenIdle(RecomputePlacement, masterPtr); } } @@ -1223,7 +1221,7 @@ PlaceLostSlaveProc( * stolen away. */ Tk_Window tkwin) /* Tk's handle for the slave window. */ { - register Slave *slavePtr = (Slave *) clientData; + register Slave *slavePtr = clientData; TkDisplay *dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr; if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) { @@ -1234,7 +1232,7 @@ PlaceLostSlaveProc( Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin)); Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc, - (ClientData) slavePtr); + slavePtr); FreeSlave(slavePtr); } diff --git a/generic/tkPlatDecls.h b/generic/tkPlatDecls.h index eb3d74d..1e69c88 100644 --- a/generic/tkPlatDecls.h +++ b/generic/tkPlatDecls.h @@ -23,6 +23,10 @@ * in the generic/tk.decls script. */ +#ifdef __cplusplus +extern "C" { +#endif + /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus @@ -33,43 +37,23 @@ extern "C" { * Exported function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ -#ifndef Tk_AttachHWND_TCL_DECLARED -#define Tk_AttachHWND_TCL_DECLARED +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN Window Tk_AttachHWND(Tk_Window tkwin, HWND hwnd); -#endif -#ifndef Tk_GetHINSTANCE_TCL_DECLARED -#define Tk_GetHINSTANCE_TCL_DECLARED /* 1 */ EXTERN HINSTANCE Tk_GetHINSTANCE(void); -#endif -#ifndef Tk_GetHWND_TCL_DECLARED -#define Tk_GetHWND_TCL_DECLARED /* 2 */ EXTERN HWND Tk_GetHWND(Window window); -#endif -#ifndef Tk_HWNDToWindow_TCL_DECLARED -#define Tk_HWNDToWindow_TCL_DECLARED /* 3 */ EXTERN Tk_Window Tk_HWNDToWindow(HWND hwnd); -#endif -#ifndef Tk_PointerEvent_TCL_DECLARED -#define Tk_PointerEvent_TCL_DECLARED /* 4 */ EXTERN void Tk_PointerEvent(HWND hwnd, int x, int y); -#endif -#ifndef Tk_TranslateWinEvent_TCL_DECLARED -#define Tk_TranslateWinEvent_TCL_DECLARED /* 5 */ EXTERN int Tk_TranslateWinEvent(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam, LRESULT *result); -#endif #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef Tk_MacOSXSetEmbedHandler_TCL_DECLARED -#define Tk_MacOSXSetEmbedHandler_TCL_DECLARED /* 0 */ EXTERN void Tk_MacOSXSetEmbedHandler( Tk_MacOSXEmbedRegisterWinProc *registerWinProcPtr, @@ -77,65 +61,34 @@ EXTERN void Tk_MacOSXSetEmbedHandler( Tk_MacOSXEmbedMakeContainerExistProc *containerExistProcPtr, Tk_MacOSXEmbedGetClipProc *getClipProc, Tk_MacOSXEmbedGetOffsetInParentProc *getOffsetProc); -#endif -#ifndef Tk_MacOSXTurnOffMenus_TCL_DECLARED -#define Tk_MacOSXTurnOffMenus_TCL_DECLARED /* 1 */ EXTERN void Tk_MacOSXTurnOffMenus(void); -#endif -#ifndef Tk_MacOSXTkOwnsCursor_TCL_DECLARED -#define Tk_MacOSXTkOwnsCursor_TCL_DECLARED /* 2 */ EXTERN void Tk_MacOSXTkOwnsCursor(int tkOwnsIt); -#endif -#ifndef TkMacOSXInitMenus_TCL_DECLARED -#define TkMacOSXInitMenus_TCL_DECLARED /* 3 */ EXTERN void TkMacOSXInitMenus(Tcl_Interp *interp); -#endif -#ifndef TkMacOSXInitAppleEvents_TCL_DECLARED -#define TkMacOSXInitAppleEvents_TCL_DECLARED /* 4 */ EXTERN void TkMacOSXInitAppleEvents(Tcl_Interp *interp); -#endif -#ifndef TkGenWMConfigureEvent_TCL_DECLARED -#define TkGenWMConfigureEvent_TCL_DECLARED /* 5 */ EXTERN void TkGenWMConfigureEvent(Tk_Window tkwin, int x, int y, int width, int height, int flags); -#endif -#ifndef TkMacOSXInvalClipRgns_TCL_DECLARED -#define TkMacOSXInvalClipRgns_TCL_DECLARED /* 6 */ EXTERN void TkMacOSXInvalClipRgns(Tk_Window tkwin); -#endif -#ifndef TkMacOSXGetDrawablePort_TCL_DECLARED -#define TkMacOSXGetDrawablePort_TCL_DECLARED /* 7 */ -EXTERN VOID * TkMacOSXGetDrawablePort(Drawable drawable); -#endif -#ifndef TkMacOSXGetRootControl_TCL_DECLARED -#define TkMacOSXGetRootControl_TCL_DECLARED +EXTERN void * TkMacOSXGetDrawablePort(Drawable drawable); /* 8 */ -EXTERN VOID * TkMacOSXGetRootControl(Drawable drawable); -#endif -#ifndef Tk_MacOSXSetupTkNotifier_TCL_DECLARED -#define Tk_MacOSXSetupTkNotifier_TCL_DECLARED +EXTERN void * TkMacOSXGetRootControl(Drawable drawable); /* 9 */ EXTERN void Tk_MacOSXSetupTkNotifier(void); -#endif -#ifndef Tk_MacOSXIsAppInFront_TCL_DECLARED -#define Tk_MacOSXIsAppInFront_TCL_DECLARED /* 10 */ EXTERN int Tk_MacOSXIsAppInFront(void); -#endif #endif /* AQUA */ typedef struct TkPlatStubs { int magic; - struct TkPlatStubHooks *hooks; + void *hooks; -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ Window (*tk_AttachHWND) (Tk_Window tkwin, HWND hwnd); /* 0 */ HINSTANCE (*tk_GetHINSTANCE) (void); /* 1 */ HWND (*tk_GetHWND) (Window window); /* 2 */ @@ -151,102 +104,72 @@ typedef struct TkPlatStubs { void (*tkMacOSXInitAppleEvents) (Tcl_Interp *interp); /* 4 */ void (*tkGenWMConfigureEvent) (Tk_Window tkwin, int x, int y, int width, int height, int flags); /* 5 */ void (*tkMacOSXInvalClipRgns) (Tk_Window tkwin); /* 6 */ - VOID * (*tkMacOSXGetDrawablePort) (Drawable drawable); /* 7 */ - VOID * (*tkMacOSXGetRootControl) (Drawable drawable); /* 8 */ + void * (*tkMacOSXGetDrawablePort) (Drawable drawable); /* 7 */ + void * (*tkMacOSXGetRootControl) (Drawable drawable); /* 8 */ void (*tk_MacOSXSetupTkNotifier) (void); /* 9 */ int (*tk_MacOSXIsAppInFront) (void); /* 10 */ #endif /* AQUA */ } TkPlatStubs; -extern TkPlatStubs *tkPlatStubsPtr; +extern const TkPlatStubs *tkPlatStubsPtr; #ifdef __cplusplus } #endif -#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) +#if defined(USE_TK_STUBS) /* * Inline function declarations: */ -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ -#ifndef Tk_AttachHWND +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define Tk_AttachHWND \ (tkPlatStubsPtr->tk_AttachHWND) /* 0 */ -#endif -#ifndef Tk_GetHINSTANCE #define Tk_GetHINSTANCE \ (tkPlatStubsPtr->tk_GetHINSTANCE) /* 1 */ -#endif -#ifndef Tk_GetHWND #define Tk_GetHWND \ (tkPlatStubsPtr->tk_GetHWND) /* 2 */ -#endif -#ifndef Tk_HWNDToWindow #define Tk_HWNDToWindow \ (tkPlatStubsPtr->tk_HWNDToWindow) /* 3 */ -#endif -#ifndef Tk_PointerEvent #define Tk_PointerEvent \ (tkPlatStubsPtr->tk_PointerEvent) /* 4 */ -#endif -#ifndef Tk_TranslateWinEvent #define Tk_TranslateWinEvent \ (tkPlatStubsPtr->tk_TranslateWinEvent) /* 5 */ -#endif #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ -#ifndef Tk_MacOSXSetEmbedHandler #define Tk_MacOSXSetEmbedHandler \ (tkPlatStubsPtr->tk_MacOSXSetEmbedHandler) /* 0 */ -#endif -#ifndef Tk_MacOSXTurnOffMenus #define Tk_MacOSXTurnOffMenus \ (tkPlatStubsPtr->tk_MacOSXTurnOffMenus) /* 1 */ -#endif -#ifndef Tk_MacOSXTkOwnsCursor #define Tk_MacOSXTkOwnsCursor \ (tkPlatStubsPtr->tk_MacOSXTkOwnsCursor) /* 2 */ -#endif -#ifndef TkMacOSXInitMenus #define TkMacOSXInitMenus \ (tkPlatStubsPtr->tkMacOSXInitMenus) /* 3 */ -#endif -#ifndef TkMacOSXInitAppleEvents #define TkMacOSXInitAppleEvents \ (tkPlatStubsPtr->tkMacOSXInitAppleEvents) /* 4 */ -#endif -#ifndef TkGenWMConfigureEvent #define TkGenWMConfigureEvent \ (tkPlatStubsPtr->tkGenWMConfigureEvent) /* 5 */ -#endif -#ifndef TkMacOSXInvalClipRgns #define TkMacOSXInvalClipRgns \ (tkPlatStubsPtr->tkMacOSXInvalClipRgns) /* 6 */ -#endif -#ifndef TkMacOSXGetDrawablePort #define TkMacOSXGetDrawablePort \ (tkPlatStubsPtr->tkMacOSXGetDrawablePort) /* 7 */ -#endif -#ifndef TkMacOSXGetRootControl #define TkMacOSXGetRootControl \ (tkPlatStubsPtr->tkMacOSXGetRootControl) /* 8 */ -#endif -#ifndef Tk_MacOSXSetupTkNotifier #define Tk_MacOSXSetupTkNotifier \ (tkPlatStubsPtr->tk_MacOSXSetupTkNotifier) /* 9 */ -#endif -#ifndef Tk_MacOSXIsAppInFront #define Tk_MacOSXIsAppInFront \ (tkPlatStubsPtr->tk_MacOSXIsAppInFront) /* 10 */ -#endif #endif /* AQUA */ -#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ +#endif /* defined(USE_TK_STUBS) */ /* !END!: Do not edit above this line. */ +#ifdef __cplusplus +} +#endif + #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT diff --git a/generic/tkPointer.c b/generic/tkPointer.c index dd4f7e6..0141b64 100644 --- a/generic/tkPointer.c +++ b/generic/tkPointer.c @@ -14,7 +14,7 @@ #include "tkInt.h" -#ifdef __WIN32__ +#ifdef _WIN32 #include "tkWinInt.h" #endif @@ -30,7 +30,7 @@ #define ALL_BUTTONS \ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask) -static unsigned int buttonMasks[] = { +static const unsigned int buttonMasks[] = { Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask }; #define ButtonMask(b) (buttonMasks[(b)-Button1]) @@ -54,7 +54,7 @@ static Tcl_ThreadDataKey dataKey; static int GenerateEnterLeave(TkWindow *winPtr, int x, int y, int state); -static void InitializeEvent(XEvent* eventPtr, TkWindow *winPtr, +static void InitializeEvent(XEvent *eventPtr, TkWindow *winPtr, int type, int x, int y, int state, int detail); static void UpdateCursor(TkWindow *winPtr); @@ -138,7 +138,7 @@ GenerateEnterLeave( int state) /* State flags. */ { int crossed = 0; /* 1 if mouse crossed a window boundary */ - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); TkWindow *restrictWinPtr = tsdPtr->restrictWinPtr; TkWindow *lastWinPtr = tsdPtr->lastWinPtr; @@ -231,7 +231,7 @@ Tk_UpdatePointer( int x, int y, /* Pointer location in root coords. */ int state) /* Modifier state mask. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); TkWindow *winPtr = (TkWindow *)tkwin; TkWindow *targetWinPtr; @@ -286,7 +286,7 @@ Tk_UpdatePointer( tsdPtr->restrictWinPtr = winPtr; TkpSetCapture(tsdPtr->restrictWinPtr); - } else if ((tsdPtr->lastState & ALL_BUTTONS) == 0) { + } else if (!(tsdPtr->lastState & ALL_BUTTONS)) { /* * Mouse is in a non-button grab, so ensure the button * grab is inside the grab tree. @@ -436,7 +436,7 @@ XGrabPointer( Cursor cursor, Time time) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); display->request++; @@ -471,7 +471,7 @@ XUngrabPointer( Display *display, Time time) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); display->request++; @@ -502,7 +502,7 @@ void TkPointerDeadWindow( TkWindow *winPtr) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr == tsdPtr->lastWinPtr) { @@ -541,7 +541,7 @@ UpdateCursor( TkWindow *winPtr) { Cursor cursor = None; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -586,8 +586,8 @@ XDefineCursor( Window w, Cursor cursor) { - TkWindow *winPtr = (TkWindow *)Tk_IdToWindow(display, w); - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TkWindow *winPtr = (TkWindow *) Tk_IdToWindow(display, w); + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->cursorWinPtr == winPtr) { diff --git a/generic/tkPort.h b/generic/tkPort.h index 00c49fd..d6db449 100644 --- a/generic/tkPort.h +++ b/generic/tkPort.h @@ -14,16 +14,13 @@ #ifndef _TKPORT #define _TKPORT -#ifndef _TK -#include "tk.h" +#if defined(_WIN32) +# include "tkWinPort.h" #endif -#ifndef _TCL -#include "tcl.h" +#ifndef _TK +# include "tk.h" #endif - -#if defined(__WIN32__) || defined(_WIN32) -# include "tkWinPort.h" -#else +#if !defined(_WIN32) # if defined(MAC_OSX_TK) # include "tkMacOSXPort.h" # else diff --git a/generic/tkRectOval.c b/generic/tkRectOval.c index c9cd7cb..50b5f1a 100644 --- a/generic/tkRectOval.c +++ b/generic/tkRectOval.c @@ -10,7 +10,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <stdio.h> #include "tkInt.h" #include "tkCanvas.h" @@ -43,40 +42,35 @@ typedef struct RectOvalItem { * Information used for parsing configuration specs: */ -static Tk_CustomOption stateOption = { - (Tk_OptionParseProc *) TkStateParseProc, - TkStatePrintProc, (ClientData) 2 +static const Tk_CustomOption stateOption = { + TkStateParseProc, TkStatePrintProc, INT2PTR(2) }; -static Tk_CustomOption tagsOption = { - (Tk_OptionParseProc *) Tk_CanvasTagsParseProc, - Tk_CanvasTagsPrintProc, (ClientData) NULL +static const Tk_CustomOption tagsOption = { + Tk_CanvasTagsParseProc, Tk_CanvasTagsPrintProc, NULL }; -static Tk_CustomOption dashOption = { - (Tk_OptionParseProc *) TkCanvasDashParseProc, - TkCanvasDashPrintProc, (ClientData) NULL +static const Tk_CustomOption dashOption = { + TkCanvasDashParseProc, TkCanvasDashPrintProc, NULL }; -static Tk_CustomOption offsetOption = { - (Tk_OptionParseProc *) TkOffsetParseProc, - TkOffsetPrintProc, (ClientData) TK_OFFSET_RELATIVE +static const Tk_CustomOption offsetOption = { + TkOffsetParseProc, TkOffsetPrintProc, INT2PTR(TK_OFFSET_RELATIVE) }; -static Tk_CustomOption pixelOption = { - (Tk_OptionParseProc *) TkPixelParseProc, - TkPixelPrintProc, (ClientData) NULL +static const Tk_CustomOption pixelOption = { + TkPixelParseProc, TkPixelPrintProc, NULL }; -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_CUSTOM, "-activedash", NULL, NULL, NULL, Tk_Offset(RectOvalItem, outline.activeDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-activefill", NULL, NULL, - NULL, Tk_Offset(RectOvalItem, activeFillColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(RectOvalItem, activeFillColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-activeoutline", NULL, NULL, - NULL, Tk_Offset(RectOvalItem, outline.activeColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(RectOvalItem, outline.activeColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-activeoutlinestipple", NULL, NULL, NULL, Tk_Offset(RectOvalItem, outline.activeStipple), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-activestipple", NULL, NULL, - NULL, Tk_Offset(RectOvalItem, activeFillStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(RectOvalItem, activeFillStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-activewidth", NULL, NULL, "0.0", Tk_Offset(RectOvalItem, outline.activeWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, @@ -85,45 +79,45 @@ static Tk_ConfigSpec configSpecs[] = { TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_PIXELS, "-dashoffset", NULL, NULL, "0", Tk_Offset(RectOvalItem, outline.offset), - TK_CONFIG_DONT_SET_DEFAULT}, + TK_CONFIG_DONT_SET_DEFAULT, NULL}, {TK_CONFIG_CUSTOM, "-disableddash", NULL, NULL, NULL, Tk_Offset(RectOvalItem, outline.disabledDash), TK_CONFIG_NULL_OK, &dashOption}, {TK_CONFIG_COLOR, "-disabledfill", NULL, NULL, - NULL, Tk_Offset(RectOvalItem, disabledFillColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(RectOvalItem, disabledFillColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-disabledoutline", NULL, NULL, NULL, Tk_Offset(RectOvalItem, outline.disabledColor), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-disabledoutlinestipple", NULL, NULL, NULL, Tk_Offset(RectOvalItem, outline.disabledStipple), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_BITMAP, "-disabledstipple", NULL, NULL, - NULL, Tk_Offset(RectOvalItem, disabledFillStipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(RectOvalItem, disabledFillStipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_PIXELS, "-disabledwidth", NULL, NULL, "0.0", Tk_Offset(RectOvalItem, outline.disabledWidth), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, {TK_CONFIG_COLOR, "-fill", NULL, NULL, - NULL, Tk_Offset(RectOvalItem, fillColor), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(RectOvalItem, fillColor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-offset", NULL, NULL, "0,0", Tk_Offset(RectOvalItem, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_COLOR, "-outline", NULL, NULL, - "black", Tk_Offset(RectOvalItem, outline.color), TK_CONFIG_NULL_OK}, + "black", Tk_Offset(RectOvalItem, outline.color), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-outlineoffset", NULL, NULL, "0,0", Tk_Offset(RectOvalItem, outline.tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_BITMAP, "-outlinestipple", NULL, NULL, - NULL, Tk_Offset(RectOvalItem, outline.stipple), TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(RectOvalItem, outline.stipple), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-state", NULL, NULL, NULL, Tk_Offset(Tk_Item, state),TK_CONFIG_NULL_OK, &stateOption}, {TK_CONFIG_BITMAP, "-stipple", NULL, NULL, - NULL, Tk_Offset(RectOvalItem, fillStipple),TK_CONFIG_NULL_OK}, + NULL, Tk_Offset(RectOvalItem, fillStipple),TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_CUSTOM, "-tags", NULL, NULL, NULL, 0, TK_CONFIG_NULL_OK, &tagsOption}, {TK_CONFIG_CUSTOM, "-width", NULL, NULL, "1.0", Tk_Offset(RectOvalItem, outline.width), TK_CONFIG_DONT_SET_DEFAULT, &pixelOption}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -133,10 +127,10 @@ static Tk_ConfigSpec configSpecs[] = { static void ComputeRectOvalBbox(Tk_Canvas canvas, RectOvalItem *rectOvalPtr); static int ConfigureRectOval(Tcl_Interp *interp, Tk_Canvas canvas, - Tk_Item *itemPtr, int objc, Tcl_Obj *CONST objv[], + Tk_Item *itemPtr, int objc, Tcl_Obj *const objv[], int flags); static int CreateRectOval(Tcl_Interp *interp, Tk_Canvas canvas, - Tk_Item *itemPtr, int objc, Tcl_Obj *CONST objv[]); + Tk_Item *itemPtr, int objc, Tcl_Obj *const objv[]); static void DeleteRectOval(Tk_Canvas canvas, Tk_Item *itemPtr, Display *display); static void DisplayRectOval(Tk_Canvas canvas, Tk_Item *itemPtr, @@ -147,7 +141,7 @@ static int OvalToArea(Tk_Canvas canvas, Tk_Item *itemPtr, static double OvalToPoint(Tk_Canvas canvas, Tk_Item *itemPtr, double *pointPtr); static int RectOvalCoords(Tcl_Interp *interp, Tk_Canvas canvas, - Tk_Item *itemPtr, int objc, Tcl_Obj *CONST objv[]); + Tk_Item *itemPtr, int objc, Tcl_Obj *const objv[]); static int RectOvalToPostscript(Tcl_Interp *interp, Tk_Canvas canvas, Tk_Item *itemPtr, int prepass); static int RectToArea(Tk_Canvas canvas, Tk_Item *itemPtr, @@ -186,6 +180,7 @@ Tk_ItemType tkRectangleType = { NULL, /* insertProc */ NULL, /* dTextProc */ NULL, /* nextPtr */ + NULL, 0, NULL, NULL }; Tk_ItemType tkOvalType = { @@ -209,6 +204,7 @@ Tk_ItemType tkOvalType = { NULL, /* insertProc */ NULL, /* dTextProc */ NULL, /* nextPtr */ + NULL, 0, NULL, NULL }; /* @@ -238,13 +234,13 @@ CreateRectOval( Tk_Item *itemPtr, /* Record to hold new item; header has been * initialized by caller. */ int objc, /* Number of arguments in objv. */ - Tcl_Obj *CONST objv[]) /* Arguments describing rectangle. */ + Tcl_Obj *const objv[]) /* Arguments describing rectangle. */ { RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; int i; if (objc == 0) { - Tcl_Panic("canvas did not pass any coords\n"); + Tcl_Panic("canvas did not pass any coords"); } /* @@ -269,7 +265,7 @@ CreateRectOval( */ for (i = 1; i < objc; i++) { - char *arg = Tcl_GetString(objv[i]); + const char *arg = Tcl_GetString(objv[i]); if ((arg[0] == '-') && (arg[1] >= 'a') && (arg[1] <= 'z')) { break; @@ -313,7 +309,7 @@ RectOvalCoords( Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ - Tcl_Obj *CONST objv[]) /* Array of coordinates: x1,y1,x2,y2,... */ + Tcl_Obj *const objv[]) /* Array of coordinates: x1,y1,x2,y2,... */ { RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; @@ -322,17 +318,13 @@ RectOvalCoords( */ if (objc == 0) { - Tcl_Obj *obj = Tcl_NewObj(); - - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[0])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[1])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[2])); - Tcl_ListObjAppendElement(NULL, obj, - Tcl_NewDoubleObj(rectOvalPtr->bbox[3])); - Tcl_SetObjResult(interp, obj); + Tcl_Obj *bbox[4]; + + bbox[0] = Tcl_NewDoubleObj(rectOvalPtr->bbox[0]); + bbox[1] = Tcl_NewDoubleObj(rectOvalPtr->bbox[1]); + bbox[2] = Tcl_NewDoubleObj(rectOvalPtr->bbox[2]); + bbox[3] = Tcl_NewDoubleObj(rectOvalPtr->bbox[3]); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox)); return TCL_OK; } @@ -352,10 +344,11 @@ RectOvalCoords( */ if (objc != 4) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", objc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # coordinates: expected 0 or 4, got %d", objc)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", + (rectOvalPtr->header.typePtr == &tkRectangleType + ? "RECTANGLE" : "OVAL"), NULL); return TCL_ERROR; } @@ -402,7 +395,7 @@ ConfigureRectOval( Tk_Canvas canvas, /* Canvas containing itemPtr. */ Tk_Item *itemPtr, /* Rectangle item to reconfigure. */ int objc, /* Number of elements in objv. */ - Tcl_Obj *CONST objv[], /* Arguments describing things to configure. */ + Tcl_Obj *const objv[], /* Arguments describing things to configure. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; @@ -418,7 +411,7 @@ ConfigureRectOval( tkwin = Tk_CanvasTkwin(canvas); if (TCL_OK != Tk_ConfigureWidget(interp, tkwin, configSpecs, objc, - (CONST char **)objv, (char *) rectOvalPtr, flags|TK_CONFIG_OBJS)) { + (const char **)objv, (char *) rectOvalPtr, flags|TK_CONFIG_OBJS)) { return TCL_ERROR; } state = itemPtr->state; @@ -481,7 +474,7 @@ ConfigureRectOval( rectOvalPtr->outline.gc = newGC; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } if (state == TK_STATE_HIDDEN) { ComputeRectOvalBbox(canvas, rectOvalPtr); @@ -490,7 +483,7 @@ ConfigureRectOval( color = rectOvalPtr->fillColor; stipple = rectOvalPtr->fillStipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (rectOvalPtr->activeFillColor!=NULL) { color = rectOvalPtr->activeFillColor; } @@ -519,9 +512,10 @@ ConfigureRectOval( } #ifdef MAC_OSX_TK /* - * Mac OS X CG drawing needs access to the outline linewidth - * even for fills (as linewidth controls antialiasing). + * Mac OS X CG drawing needs access to the outline linewidth even for + * fills (as linewidth controls antialiasing). */ + gcValues.line_width = rectOvalPtr->outline.gc != None ? rectOvalPtr->outline.gc->line_width : 0; mask |= GCLineWidth; @@ -634,7 +628,7 @@ ComputeRectOvalBbox( Tk_State state = rectOvalPtr->header.state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = rectOvalPtr->outline.width; @@ -643,7 +637,7 @@ ComputeRectOvalBbox( rectOvalPtr->header.x2 = rectOvalPtr->header.y2 = -1; return; } - if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)rectOvalPtr) { + if (Canvas(canvas)->currentItemPtr == (Tk_Item *) rectOvalPtr) { if (rectOvalPtr->outline.activeWidth>width) { width = rectOvalPtr->outline.activeWidth; } @@ -677,11 +671,11 @@ ComputeRectOvalBbox( * correct place to solve it, but it works. */ -#ifdef __WIN32__ +#ifdef _WIN32 bloat = 1; #else bloat = 0; -#endif +#endif /* _WIN32 */ } else { #ifdef MAC_OSX_TK /* @@ -693,7 +687,7 @@ ComputeRectOvalBbox( bloat = (int) (width+1.5)/2; #else bloat = (int) (width+1)/2; -#endif +#endif /* MAC_OSX_TK */ } /* @@ -761,9 +755,9 @@ DisplayRectOval( * will die if it isn't. */ - Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0], rectOvalPtr->bbox[1], + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0],rectOvalPtr->bbox[1], &x1, &y1); - Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2], rectOvalPtr->bbox[3], + Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2],rectOvalPtr->bbox[3], &x2, &y2); if (x2 <= x1) { x2 = x1+1; @@ -779,10 +773,10 @@ DisplayRectOval( */ if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } fillStipple = rectOvalPtr->fillStipple; - if (((TkCanvas *)canvas)->currentItemPtr == (Tk_Item *)rectOvalPtr) { + if (Canvas(canvas)->currentItemPtr == (Tk_Item *) rectOvalPtr) { if (rectOvalPtr->activeFillStipple != None) { fillStipple = rectOvalPtr->activeFillStipple; } @@ -884,11 +878,11 @@ RectToPoint( Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = rectPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (rectPtr->outline.activeWidth>width) { width = rectPtr->outline.activeWidth; } @@ -1004,11 +998,11 @@ OvalToPoint( Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = (double) ovalPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (ovalPtr->outline.activeWidth>width) { width = (double) ovalPtr->outline.activeWidth; } @@ -1060,16 +1054,16 @@ RectToArea( Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = rectPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (rectPtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (rectPtr->outline.activeWidth > width) { width = rectPtr->outline.activeWidth; } } else if (state == TK_STATE_DISABLED) { - if (rectPtr->outline.disabledWidth>0) { + if (rectPtr->outline.disabledWidth > 0) { width = rectPtr->outline.disabledWidth; } } @@ -1129,22 +1123,21 @@ OvalToArea( * y1, x2, y2) describing rectangular area. */ { RectOvalItem *ovalPtr = (RectOvalItem *) itemPtr; - double oval[4], halfWidth; + double oval[4], halfWidth, width; int result; - double width; Tk_State state = itemPtr->state; if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } width = ovalPtr->outline.width; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { - if (ovalPtr->outline.activeWidth>width) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { + if (ovalPtr->outline.activeWidth > width) { width = ovalPtr->outline.activeWidth; } } else if (state == TK_STATE_DISABLED) { - if (ovalPtr->outline.disabledWidth>0) { + if (ovalPtr->outline.disabledWidth > 0) { width = ovalPtr->outline.disabledWidth; } } @@ -1298,13 +1291,14 @@ RectOvalToPostscript( * information; 0 means final Postscript is * being created. */ { - char pathCmd[500]; + Tcl_Obj *pathObj, *psObj; RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr; double y1, y2; XColor *color; XColor *fillColor; Pixmap fillStipple; Tk_State state = itemPtr->state; + Tcl_InterpState interpState; y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]); y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]); @@ -1315,23 +1309,34 @@ RectOvalToPostscript( */ if (rectOvalPtr->header.typePtr == &tkRectangleType) { - sprintf(pathCmd, "%.15g %.15g moveto %.15g 0 rlineto 0 %.15g rlineto %.15g 0 rlineto closepath\n", + pathObj = Tcl_ObjPrintf( + "%.15g %.15g moveto " + "%.15g 0 rlineto " + "0 %.15g rlineto " + "%.15g 0 rlineto " + "closepath\n", rectOvalPtr->bbox[0], y1, - rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], y2-y1, + rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], + y2-y1, rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]); } else { - sprintf(pathCmd, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n", + pathObj = Tcl_ObjPrintf( + "matrix currentmatrix\n" + "%.15g %.15g translate " + "%.15g %.15g scale " + "1 0 moveto 0 0 1 0 360 arc\n" + "setmatrix\n", (rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2, (rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2); } if (state == TK_STATE_NULL) { - state = ((TkCanvas *)canvas)->canvas_state; + state = Canvas(canvas)->canvas_state; } color = rectOvalPtr->outline.color; fillColor = rectOvalPtr->fillColor; fillStipple = rectOvalPtr->fillStipple; - if (((TkCanvas *)canvas)->currentItemPtr == itemPtr) { + if (Canvas(canvas)->currentItemPtr == itemPtr) { if (rectOvalPtr->outline.activeColor!=NULL) { color = rectOvalPtr->outline.activeColor; } @@ -1354,24 +1359,38 @@ RectOvalToPostscript( } /* + * Make our working space. + */ + + psObj = Tcl_NewObj(); + interpState = Tcl_SaveInterpState(interp, TCL_OK); + + /* * First draw the filled area of the rectangle. */ if (fillColor != NULL) { - Tcl_AppendResult(interp, pathCmd, NULL); + Tcl_AppendObjToObj(psObj, pathObj); + + Tcl_ResetResult(interp); if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + if (fillStipple != None) { - Tcl_AppendResult(interp, "clip ", NULL); + Tcl_AppendToObj(psObj, "clip ", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsStipple(interp, canvas, fillStipple) != TCL_OK) { - return TCL_ERROR; + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); if (color != NULL) { - Tcl_AppendResult(interp, "grestore gsave\n", NULL); + Tcl_AppendToObj(psObj, "grestore gsave\n", -1); } } else { - Tcl_AppendResult(interp, "fill\n", NULL); + Tcl_AppendToObj(psObj, "fill\n", -1); } } @@ -1380,14 +1399,32 @@ RectOvalToPostscript( */ if (color != NULL) { - Tcl_AppendResult(interp, pathCmd, "0 setlinejoin 2 setlinecap\n", - NULL); + Tcl_AppendObjToObj(psObj, pathObj); + Tcl_AppendToObj(psObj, "0 setlinejoin 2 setlinecap\n", -1); + + Tcl_ResetResult(interp); if (Tk_CanvasPsOutline(canvas, itemPtr, - &(rectOvalPtr->outline))!= TCL_OK) { - return TCL_ERROR; + &rectOvalPtr->outline)!= TCL_OK) { + goto error; } + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); } + + /* + * Plug the accumulated postscript back into the result. + */ + + (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); + Tcl_DecrRefCount(pathObj); return TCL_OK; + + error: + Tcl_DiscardInterpState(interpState); + Tcl_DecrRefCount(psObj); + Tcl_DecrRefCount(pathObj); + return TCL_ERROR; } /* diff --git a/generic/tkScale.c b/generic/tkScale.c index 69a7d91..cc7c294 100644 --- a/generic/tkScale.c +++ b/generic/tkScale.c @@ -42,17 +42,17 @@ static const char *const stateStrings[] = { static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground", DEF_SCALE_ACTIVE_BG_COLOR, -1, Tk_Offset(TkScale, activeBorder), - 0, (ClientData) DEF_SCALE_ACTIVE_BG_MONO, 0}, + 0, DEF_SCALE_ACTIVE_BG_MONO, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_SCALE_BG_COLOR, -1, Tk_Offset(TkScale, bgBorder), - 0, (ClientData) DEF_SCALE_BG_MONO, 0}, + 0, DEF_SCALE_BG_MONO, 0}, {TK_OPTION_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement", DEF_SCALE_BIG_INCREMENT, -1, Tk_Offset(TkScale, bigIncrement), 0, 0, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, + NULL, 0, -1, 0, "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", DEF_SCALE_BORDER_WIDTH, -1, Tk_Offset(TkScale, borderWidth), 0, 0, 0}, @@ -66,7 +66,7 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_SCALE_DIGITS, -1, Tk_Offset(TkScale, digits), 0, 0, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_SCALE_FONT, -1, Tk_Offset(TkScale, tkfont), 0, 0, 0}, {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", @@ -77,7 +77,7 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground", "HighlightBackground", DEF_SCALE_HIGHLIGHT_BG_COLOR, -1, Tk_Offset(TkScale, highlightBorder), - 0, (ClientData) DEF_SCALE_HIGHLIGHT_BG_MONO, 0}, + 0, DEF_SCALE_HIGHLIGHT_BG_MONO, 0}, {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", DEF_SCALE_HIGHLIGHT, -1, Tk_Offset(TkScale, highlightColorPtr), 0, 0, 0}, @@ -91,7 +91,7 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_SCALE_LENGTH, -1, Tk_Offset(TkScale, length), 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", DEF_SCALE_ORIENT, -1, Tk_Offset(TkScale, orient), - 0, (ClientData) orientStrings, 0}, + 0, orientStrings, 0}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", DEF_SCALE_RELIEF, -1, Tk_Offset(TkScale, relief), 0, 0, 0}, {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay", @@ -114,7 +114,7 @@ static const Tk_OptionSpec optionSpecs[] = { 0, 0, 0}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_SCALE_STATE, -1, Tk_Offset(TkScale, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocusPtr), -1, TK_OPTION_NULL_OK, 0, 0}, @@ -125,7 +125,7 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_SCALE_TO, -1, Tk_Offset(TkScale, toValue), 0, 0, 0}, {TK_OPTION_COLOR, "-troughcolor", "troughColor", "Background", DEF_SCALE_TROUGH_COLOR, -1, Tk_Offset(TkScale, troughColorPtr), - 0, (ClientData) DEF_SCALE_TROUGH_MONO, 0}, + 0, DEF_SCALE_TROUGH_MONO, 0}, {TK_OPTION_STRING, "-variable", "variable", "Variable", DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varNamePtr), -1, TK_OPTION_NULL_OK, 0, 0}, @@ -140,7 +140,7 @@ static const Tk_OptionSpec optionSpecs[] = { * scale widget command. */ -static const char *commandNames[] = { +static const char *const commandNames[] = { "cget", "configure", "coords", "get", "identify", "set", NULL }; @@ -175,9 +175,11 @@ static void ScaleSetVariable(TkScale *scalePtr); * that can be invoked from generic window code. */ -static Tk_ClassProcs scaleClass = { +static const Tk_ClassProcs scaleClass = { sizeof(Tk_ClassProcs), /* size */ ScaleWorldChanged, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -209,7 +211,7 @@ Tk_ScaleObjCmd( Tk_Window tkwin; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -240,7 +242,7 @@ Tk_ScaleObjCmd( scalePtr->interp = interp; scalePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(scalePtr->tkwin), ScaleWidgetObjCmd, - (ClientData) scalePtr, ScaleCmdDeletedProc); + scalePtr, ScaleCmdDeletedProc); scalePtr->optionTable = optionTable; scalePtr->orient = ORIENT_VERTICAL; scalePtr->width = 0; @@ -289,10 +291,10 @@ Tk_ScaleObjCmd( scalePtr->takeFocusPtr = NULL; scalePtr->flags = NEVER_SET; - Tk_SetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr); + Tk_SetClassProcs(scalePtr->tkwin, &scaleClass, scalePtr); Tk_CreateEventHandler(scalePtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - ScaleEventProc, (ClientData) scalePtr); + ScaleEventProc, scalePtr); if ((Tk_InitOptions(interp, (char *) scalePtr, optionTable, tkwin) != TCL_OK) || @@ -301,7 +303,7 @@ Tk_ScaleObjCmd( return TCL_ERROR; } - Tcl_SetResult(interp, Tk_PathName(scalePtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(scalePtr->tkwin)); return TCL_OK; } @@ -330,20 +332,20 @@ ScaleWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - TkScale *scalePtr = (TkScale *) clientData; + TkScale *scalePtr = clientData; Tcl_Obj *objPtr; int index, result; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, - "option", 0, &index); + result = Tcl_GetIndexFromObjStruct(interp, objv[1], commandNames, + sizeof(char *), "option", 0, &index); if (result != TCL_OK) { return result; } - Tcl_Preserve((ClientData) scalePtr); + Tcl_Preserve(scalePtr); switch (index) { case COMMAND_CGET: @@ -355,9 +357,8 @@ ScaleWidgetObjCmd( scalePtr->optionTable, objv[2], scalePtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); break; case COMMAND_CONFIGURE: if (objc <= 3) { @@ -366,17 +367,16 @@ ScaleWidgetObjCmd( (objc == 3) ? objv[2] : NULL, scalePtr->tkwin); if (objPtr == NULL) { goto error; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { result = ConfigureScale(interp, scalePtr, objc-2, objv+2); } break; case COMMAND_COORDS: { - int x, y ; + int x, y; double value; - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *coords[2]; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?"); @@ -398,14 +398,14 @@ ScaleWidgetObjCmd( y = scalePtr->horizTroughY + scalePtr->width/2 + scalePtr->borderWidth; } - sprintf(buf, "%d %d", x, y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + coords[0] = Tcl_NewIntObj(x); + coords[1] = Tcl_NewIntObj(y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords)); break; } case COMMAND_GET: { double value; int x, y; - char buf[TCL_DOUBLE_SPACE]; if ((objc != 2) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?"); @@ -420,12 +420,12 @@ ScaleWidgetObjCmd( } value = TkScalePixelToValue(scalePtr, x, y); } - sprintf(buf, scalePtr->format, value); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf(scalePtr->format, value)); break; } case COMMAND_IDENTIFY: { - int x, y, thing; + int x, y; + const char *zone = ""; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "identify x y"); @@ -435,18 +435,12 @@ ScaleWidgetObjCmd( || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { goto error; } - thing = TkpScaleElement(scalePtr, x,y); - switch (thing) { - case TROUGH1: - Tcl_SetResult(interp, "trough1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case TROUGH2: - Tcl_SetResult(interp, "trough2", TCL_STATIC); - break; + switch (TkpScaleElement(scalePtr, x, y)) { + case TROUGH1: zone = "trough1"; break; + case SLIDER: zone = "slider"; break; + case TROUGH2: zone = "trough2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); break; } case COMMAND_SET: { @@ -465,11 +459,11 @@ ScaleWidgetObjCmd( break; } } - Tcl_Release((ClientData) scalePtr); + Tcl_Release(scalePtr); return result; error: - Tcl_Release((ClientData) scalePtr); + Tcl_Release(scalePtr); return TCL_ERROR; } @@ -501,7 +495,7 @@ DestroyScale( Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd); if (scalePtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(TkpDisplayScale, (ClientData) scalePtr); + Tcl_CancelIdleCall(TkpDisplayScale, scalePtr); } /* @@ -510,9 +504,9 @@ DestroyScale( */ if (scalePtr->varNamePtr != NULL) { - Tcl_UntraceVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ScaleVarProc, (ClientData) scalePtr); + Tcl_UntraceVar2(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ScaleVarProc, scalePtr); } if (scalePtr->troughGC != None) { Tk_FreeGC(scalePtr->display, scalePtr->troughGC); @@ -567,9 +561,9 @@ ConfigureScale( */ if (scalePtr->varNamePtr != NULL) { - Tcl_UntraceVar(interp, Tcl_GetString(scalePtr->varNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ScaleVarProc, (ClientData) scalePtr); + Tcl_UntraceVar2(interp, Tcl_GetString(scalePtr->varNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ScaleVarProc, scalePtr); } for (error = 0; error <= 1; error++) { @@ -579,8 +573,8 @@ ConfigureScale( */ if (Tk_SetOptions(interp, (char *) scalePtr, - scalePtr->optionTable, objc, objv, - scalePtr->tkwin, &savedOptions, NULL) != TCL_OK) { + scalePtr->optionTable, objc, objv, scalePtr->tkwin, + &savedOptions, NULL) != TCL_OK) { continue; } } else { @@ -683,12 +677,12 @@ ConfigureScale( ScaleSetVariable(scalePtr); } } - Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - ScaleVarProc, (ClientData) scalePtr); + Tcl_TraceVar2(interp, Tcl_GetString(scalePtr->varNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + ScaleVarProc, scalePtr); } - ScaleWorldChanged((ClientData) scalePtr); + ScaleWorldChanged(scalePtr); if (error) { Tcl_SetObjResult(interp, errorResult); Tcl_DecrRefCount(errorResult); @@ -721,9 +715,7 @@ ScaleWorldChanged( { XGCValues gcValues; GC gc; - TkScale *scalePtr; - - scalePtr = (TkScale *) instanceData; + TkScale *scalePtr = instanceData; gcValues.foreground = scalePtr->troughColorPtr->pixel; gc = Tk_GetGC(scalePtr->tkwin, GCForeground, &gcValues); @@ -1008,12 +1000,12 @@ ScaleEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - TkScale *scalePtr = (TkScale *) clientData; + TkScale *scalePtr = clientData; if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) { TkEventuallyRedrawScale(scalePtr, REDRAW_ALL); } else if (eventPtr->type == DestroyNotify) { - DestroyScale((char *) clientData); + DestroyScale(clientData); } else if (eventPtr->type == ConfigureNotify) { ComputeScaleGeometry(scalePtr); TkEventuallyRedrawScale(scalePtr, REDRAW_ALL); @@ -1056,7 +1048,7 @@ static void ScaleCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - TkScale *scalePtr = (TkScale *) clientData; + TkScale *scalePtr = clientData; Tk_Window tkwin = scalePtr->tkwin; /* @@ -1103,7 +1095,7 @@ TkEventuallyRedrawScale( } if (!(scalePtr->flags & REDRAW_PENDING)) { scalePtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(TkpDisplayScale, (ClientData) scalePtr); + Tcl_DoWhenIdle(TkpDisplayScale, scalePtr); } scalePtr->flags |= what; } @@ -1178,8 +1170,8 @@ ScaleVarProc( const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - register TkScale *scalePtr = (TkScale *) clientData; - char *resultStr; + register TkScale *scalePtr = clientData; + const char *resultStr; double value; Tcl_Obj *valuePtr; int result; @@ -1191,8 +1183,8 @@ ScaleVarProc( if (flags & TCL_TRACE_UNSETS) { if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { - Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + Tcl_TraceVar2(interp, Tcl_GetString(scalePtr->varNamePtr), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, ScaleVarProc, clientData); scalePtr->flags |= NEVER_SET; TkScaleSetValue(scalePtr, scalePtr->value, 1, 0); @@ -1230,7 +1222,7 @@ ScaleVarProc( } TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER); - return resultStr; + return (char *) resultStr; } /* diff --git a/generic/tkScale.h b/generic/tkScale.h index a2c5f2b..4fd9995 100644 --- a/generic/tkScale.h +++ b/generic/tkScale.h @@ -18,11 +18,6 @@ #include "tkInt.h" #endif -#ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif - /* * Legal values for the "orient" field of TkScale records. */ @@ -234,7 +229,4 @@ MODULE_SCOPE void TkScaleSetValue(TkScale *scalePtr, double value, MODULE_SCOPE double TkScalePixelToValue(TkScale *scalePtr, int x, int y); MODULE_SCOPE int TkScaleValueToPixel(TkScale *scalePtr, double value); -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TKSCALE */ diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c index 3fff58d..5017d30 100644 --- a/generic/tkScrollbar.c +++ b/generic/tkScrollbar.c @@ -20,10 +20,8 @@ * Custom option for handling "-orient" */ -static Tk_CustomOption orientOption = { - (Tk_OptionParseProc *) TkOrientParseProc, - TkOrientPrintProc, - (ClientData) NULL +static const Tk_CustomOption orientOption = { + TkOrientParseProc, TkOrientPrintProc, NULL }; /* non-const space for "-width" default value for scrollbars */ @@ -33,65 +31,65 @@ char tkDefScrollbarWidth[TCL_INTEGER_SPACE] = DEF_SCROLLBAR_WIDTH; * Information used for argv parsing. */ -static Tk_ConfigSpec configSpecs[] = { +static const Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", DEF_SCROLLBAR_ACTIVE_BG_COLOR, Tk_Offset(TkScrollbar, activeBorder), - TK_CONFIG_COLOR_ONLY}, + TK_CONFIG_COLOR_ONLY, NULL}, {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground", DEF_SCROLLBAR_ACTIVE_BG_MONO, Tk_Offset(TkScrollbar, activeBorder), - TK_CONFIG_MONO_ONLY}, + TK_CONFIG_MONO_ONLY, NULL}, {TK_CONFIG_RELIEF, "-activerelief", "activeRelief", "Relief", - DEF_SCROLLBAR_ACTIVE_RELIEF, Tk_Offset(TkScrollbar, activeRelief), 0}, + DEF_SCROLLBAR_ACTIVE_RELIEF, Tk_Offset(TkScrollbar, activeRelief), 0, NULL}, {TK_CONFIG_BORDER, "-background", "background", "Background", DEF_SCROLLBAR_BG_COLOR, Tk_Offset(TkScrollbar, bgBorder), - TK_CONFIG_COLOR_ONLY}, + TK_CONFIG_COLOR_ONLY, NULL}, {TK_CONFIG_BORDER, "-background", "background", "Background", DEF_SCROLLBAR_BG_MONO, Tk_Offset(TkScrollbar, bgBorder), - TK_CONFIG_MONO_ONLY}, - {TK_CONFIG_SYNONYM, "-bd", "borderWidth", NULL, NULL, 0, 0}, - {TK_CONFIG_SYNONYM, "-bg", "background", NULL, NULL, 0, 0}, + TK_CONFIG_MONO_ONLY, NULL}, + {TK_CONFIG_SYNONYM, "-bd", "borderWidth", NULL, NULL, 0, 0, NULL}, + {TK_CONFIG_SYNONYM, "-bg", "background", NULL, NULL, 0, 0, NULL}, {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - DEF_SCROLLBAR_BORDER_WIDTH, Tk_Offset(TkScrollbar, borderWidth), 0}, + DEF_SCROLLBAR_BORDER_WIDTH, Tk_Offset(TkScrollbar, borderWidth), 0, NULL}, {TK_CONFIG_STRING, "-command", "command", "Command", DEF_SCROLLBAR_COMMAND, Tk_Offset(TkScrollbar, command), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", - DEF_SCROLLBAR_CURSOR, Tk_Offset(TkScrollbar, cursor), TK_CONFIG_NULL_OK}, + DEF_SCROLLBAR_CURSOR, Tk_Offset(TkScrollbar, cursor), TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_PIXELS, "-elementborderwidth", "elementBorderWidth", "BorderWidth", DEF_SCROLLBAR_EL_BORDER_WIDTH, - Tk_Offset(TkScrollbar, elementBorderWidth), 0}, + Tk_Offset(TkScrollbar, elementBorderWidth), 0, NULL}, {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", "HighlightBackground", DEF_SCROLLBAR_HIGHLIGHT_BG, - Tk_Offset(TkScrollbar, highlightBgColorPtr), 0}, + Tk_Offset(TkScrollbar, highlightBgColorPtr), 0, NULL}, {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", DEF_SCROLLBAR_HIGHLIGHT, - Tk_Offset(TkScrollbar, highlightColorPtr), 0}, + Tk_Offset(TkScrollbar, highlightColorPtr), 0, NULL}, {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", "HighlightThickness", - DEF_SCROLLBAR_HIGHLIGHT_WIDTH, Tk_Offset(TkScrollbar, highlightWidth), 0}, + DEF_SCROLLBAR_HIGHLIGHT_WIDTH, Tk_Offset(TkScrollbar, highlightWidth), 0, NULL}, {TK_CONFIG_BOOLEAN, "-jump", "jump", "Jump", - DEF_SCROLLBAR_JUMP, Tk_Offset(TkScrollbar, jump), 0}, + DEF_SCROLLBAR_JUMP, Tk_Offset(TkScrollbar, jump), 0, NULL}, {TK_CONFIG_CUSTOM, "-orient", "orient", "Orient", DEF_SCROLLBAR_ORIENT, Tk_Offset(TkScrollbar, vertical), 0, &orientOption}, {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", - DEF_SCROLLBAR_RELIEF, Tk_Offset(TkScrollbar, relief), 0}, + DEF_SCROLLBAR_RELIEF, Tk_Offset(TkScrollbar, relief), 0, NULL}, {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay", - DEF_SCROLLBAR_REPEAT_DELAY, Tk_Offset(TkScrollbar, repeatDelay), 0}, + DEF_SCROLLBAR_REPEAT_DELAY, Tk_Offset(TkScrollbar, repeatDelay), 0, NULL}, {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval", - DEF_SCROLLBAR_REPEAT_INTERVAL, Tk_Offset(TkScrollbar, repeatInterval), 0}, + DEF_SCROLLBAR_REPEAT_INTERVAL, Tk_Offset(TkScrollbar, repeatInterval), 0, NULL}, {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_SCROLLBAR_TAKE_FOCUS, Tk_Offset(TkScrollbar, takeFocus), - TK_CONFIG_NULL_OK}, + TK_CONFIG_NULL_OK, NULL}, {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background", DEF_SCROLLBAR_TROUGH_COLOR, Tk_Offset(TkScrollbar, troughColorPtr), - TK_CONFIG_COLOR_ONLY}, + TK_CONFIG_COLOR_ONLY, NULL}, {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background", DEF_SCROLLBAR_TROUGH_MONO, Tk_Offset(TkScrollbar, troughColorPtr), - TK_CONFIG_MONO_ONLY}, + TK_CONFIG_MONO_ONLY, NULL}, {TK_CONFIG_PIXELS, "-width", "width", "Width", - tkDefScrollbarWidth, Tk_Offset(TkScrollbar, width), 0}, - {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} + tkDefScrollbarWidth, Tk_Offset(TkScrollbar, width), 0, NULL}, + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* @@ -99,16 +97,16 @@ static Tk_ConfigSpec configSpecs[] = { */ static int ConfigureScrollbar(Tcl_Interp *interp, - TkScrollbar *scrollPtr, int argc, - CONST char **argv, int flags); + TkScrollbar *scrollPtr, int objc, + Tcl_Obj *const objv[], int flags); static void ScrollbarCmdDeletedProc(ClientData clientData); -static int ScrollbarWidgetCmd(ClientData clientData, - Tcl_Interp *, int argc, CONST char **argv); +static int ScrollbarWidgetObjCmd(ClientData clientData, + Tcl_Interp *, int objc, Tcl_Obj *const objv[]); /* *-------------------------------------------------------------- * - * Tk_ScrollbarCmd -- + * Tk_ScrollbarObjCmd -- * * This function is invoked to process the "scrollbar" Tcl command. See * the user documentation for details on what it does. @@ -123,23 +121,22 @@ static int ScrollbarWidgetCmd(ClientData clientData, */ int -Tk_ScrollbarCmd( +Tk_ScrollbarObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = clientData; register TkScrollbar *scrollPtr; Tk_Window newWin; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " pathName ?options?\"", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } - newWin = Tk_CreateWindowFromPath(interp, tkwin, argv[1], NULL); + newWin = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]), NULL); if (newWin == NULL) { return TCL_ERROR; } @@ -147,7 +144,7 @@ Tk_ScrollbarCmd( Tk_SetClass(newWin, "Scrollbar"); scrollPtr = TkpCreateScrollbar(newWin); - Tk_SetClassProcs(newWin, &tkpScrollbarProcs, (ClientData) scrollPtr); + Tk_SetClassProcs(newWin, &tkpScrollbarProcs, scrollPtr); /* * Initialize fields that won't be initialized by ConfigureScrollbar, or @@ -158,9 +155,9 @@ Tk_ScrollbarCmd( scrollPtr->tkwin = newWin; scrollPtr->display = Tk_Display(newWin); scrollPtr->interp = interp; - scrollPtr->widgetCmd = Tcl_CreateCommand(interp, - Tk_PathName(scrollPtr->tkwin), ScrollbarWidgetCmd, - (ClientData) scrollPtr, ScrollbarCmdDeletedProc); + scrollPtr->widgetCmd = Tcl_CreateObjCommand(interp, + Tk_PathName(scrollPtr->tkwin), ScrollbarWidgetObjCmd, + scrollPtr, ScrollbarCmdDeletedProc); scrollPtr->vertical = 0; scrollPtr->width = 0; scrollPtr->command = NULL; @@ -192,19 +189,19 @@ Tk_ScrollbarCmd( scrollPtr->takeFocus = NULL; scrollPtr->flags = 0; - if (ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, 0) != TCL_OK) { + if (ConfigureScrollbar(interp, scrollPtr, objc-2, objv+2, 0) != TCL_OK) { Tk_DestroyWindow(scrollPtr->tkwin); return TCL_ERROR; } - Tcl_SetResult(interp, Tk_PathName(scrollPtr->tkwin), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(scrollPtr->tkwin)); return TCL_OK; } /* *-------------------------------------------------------------- * - * ScrollbarWidgetCmd -- + * ScrollbarWidgetObjCmd -- * * This function is invoked to process the Tcl command that corresponds * to a widget managed by this module. See the user documentation for @@ -220,54 +217,65 @@ Tk_ScrollbarCmd( */ static int -ScrollbarWidgetCmd( +ScrollbarWidgetObjCmd( ClientData clientData, /* Information about scrollbar widget. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { - register TkScrollbar *scrollPtr = (TkScrollbar *) clientData; + register TkScrollbar *scrollPtr = clientData; int result = TCL_OK; - size_t length; - int c; - - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option ?arg arg ...?\"", NULL); + int length, cmdIndex; + static const char *const commandNames[] = { + "activate", "cget", "configure", "delta", "fraction", + "get", "identify", "set", NULL + }; + enum command { + COMMAND_ACTIVATE, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELTA, + COMMAND_FRACTION, COMMAND_GET, COMMAND_IDENTIFY, COMMAND_SET + }; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - Tcl_Preserve((ClientData) scrollPtr); - c = argv[1][0]; - length = strlen(argv[1]); - if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) { - int oldActiveField; - if (argc == 2) { + /* + * Parse the command by looking up the second argument in the list of + * valid subcommand names + */ + + result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, + "option", 0, &cmdIndex); + if (result != TCL_OK) { + return result; + } + Tcl_Preserve(scrollPtr); + switch (cmdIndex) { + case COMMAND_ACTIVATE: { + int oldActiveField, c; + + if (objc == 2) { + const char *zone = ""; + switch (scrollPtr->activeField) { - case TOP_ARROW: - Tcl_SetResult(interp, "arrow1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case BOTTOM_ARROW: - Tcl_SetResult(interp, "arrow2", TCL_STATIC); - break; + case TOP_ARROW: zone = "arrow1"; break; + case SLIDER: zone = "slider"; break; + case BOTTOM_ARROW: zone = "arrow2"; break; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); goto done; } - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " activate element\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "activate element"); goto error; } - c = argv[2][0]; - length = strlen(argv[2]); + c = Tcl_GetStringFromObj(objv[2], &length)[0]; oldActiveField = scrollPtr->activeField; - if ((c == 'a') && (strcmp(argv[2], "arrow1") == 0)) { + if ((c == 'a') && (strcmp(Tcl_GetString(objv[2]), "arrow1") == 0)) { scrollPtr->activeField = TOP_ARROW; - } else if ((c == 'a') && (strcmp(argv[2], "arrow2") == 0)) { + } else if ((c == 'a') && (strcmp(Tcl_GetString(objv[2]), "arrow2") == 0)) { scrollPtr->activeField = BOTTOM_ARROW; - } else if ((c == 's') && (strncmp(argv[2], "slider", length) == 0)) { + } else if ((c == 's') && (strncmp(Tcl_GetString(objv[2]), "slider", length) == 0)) { scrollPtr->activeField = SLIDER; } else { scrollPtr->activeField = OUTSIDE; @@ -275,40 +283,40 @@ ScrollbarWidgetCmd( if (oldActiveField != scrollPtr->activeField) { TkScrollbarEventuallyRedraw(scrollPtr); } - } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0) - && (length >= 2)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " cget option\"", - NULL); + break; + } + case COMMAND_CGET: { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); goto error; } result = Tk_ConfigureValue(interp, scrollPtr->tkwin, - configSpecs, (char *) scrollPtr, argv[2], 0); - } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0) - && (length >= 2)) { - if (argc == 2) { + configSpecs, (char *) scrollPtr, Tcl_GetString(objv[2]), 0); + break; + } + case COMMAND_CONFIGURE: { + if (objc == 2) { result = Tk_ConfigureInfo(interp, scrollPtr->tkwin, configSpecs, (char *) scrollPtr, NULL, 0); - } else if (argc == 3) { + } else if (objc == 3) { result = Tk_ConfigureInfo(interp, scrollPtr->tkwin, - configSpecs, (char *) scrollPtr, argv[2], 0); + configSpecs, (char *) scrollPtr, Tcl_GetString(objv[2]), 0); } else { - result = ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, - TK_CONFIG_ARGV_ONLY); + result = ConfigureScrollbar(interp, scrollPtr, objc-2, + objv+2, TK_CONFIG_ARGV_ONLY); } - } else if ((c == 'd') && (strncmp(argv[1], "delta", length) == 0)) { + break; + } + case COMMAND_DELTA: { int xDelta, yDelta, pixels, length; double fraction; - char buf[TCL_DOUBLE_SPACE]; - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " delta xDelta yDelta\"", NULL); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "delta xDelta yDelta"); goto error; } - if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &yDelta) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &xDelta) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &yDelta) != TCL_OK)) { goto error; } if (scrollPtr->vertical) { @@ -325,20 +333,19 @@ ScrollbarWidgetCmd( } else { fraction = ((double) pixels / (double) length); } - Tcl_PrintDouble(NULL, fraction, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else if ((c == 'f') && (strncmp(argv[1], "fraction", length) == 0)) { + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction)); + break; + } + case COMMAND_FRACTION: { int x, y, pos, length; double fraction; - char buf[TCL_DOUBLE_SPACE]; - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " fraction x y\"", NULL); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "fraction x y"); goto error; } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { goto error; } if (scrollPtr->vertical) { @@ -360,68 +367,61 @@ ScrollbarWidgetCmd( } else if (fraction > 1.0) { fraction = 1.0; } - Tcl_PrintDouble(NULL, fraction, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " get\"", NULL); + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction)); + break; + } + case COMMAND_GET: { + Tcl_Obj *resObjs[4]; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "get"); goto error; } if (scrollPtr->flags & NEW_STYLE_COMMANDS) { - char first[TCL_DOUBLE_SPACE], last[TCL_DOUBLE_SPACE]; - - Tcl_PrintDouble(interp, scrollPtr->firstFraction, first); - Tcl_PrintDouble(interp, scrollPtr->lastFraction, last); - Tcl_AppendResult(interp, first, " ", last, NULL); + resObjs[0] = Tcl_NewDoubleObj(scrollPtr->firstFraction); + resObjs[1] = Tcl_NewDoubleObj(scrollPtr->lastFraction); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, resObjs)); } else { - char buf[TCL_INTEGER_SPACE * 4]; - - sprintf(buf, "%d %d %d %d", scrollPtr->totalUnits, - scrollPtr->windowUnits, scrollPtr->firstUnit, - scrollPtr->lastUnit); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + resObjs[0] = Tcl_NewIntObj(scrollPtr->totalUnits); + resObjs[1] = Tcl_NewIntObj(scrollPtr->windowUnits); + resObjs[2] = Tcl_NewIntObj(scrollPtr->firstUnit); + resObjs[3] = Tcl_NewIntObj(scrollPtr->lastUnit); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, resObjs)); } - } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) { - int x, y, thing; + break; + } + case COMMAND_IDENTIFY: { + int x, y; + const char *zone = ""; - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " identify x y\"", NULL); + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "identify x y"); goto error; } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { goto error; } - thing = TkpScrollbarPosition(scrollPtr, x,y); - switch (thing) { - case TOP_ARROW: - Tcl_SetResult(interp, "arrow1", TCL_STATIC); - break; - case TOP_GAP: - Tcl_SetResult(interp, "trough1", TCL_STATIC); - break; - case SLIDER: - Tcl_SetResult(interp, "slider", TCL_STATIC); - break; - case BOTTOM_GAP: - Tcl_SetResult(interp, "trough2", TCL_STATIC); - break; - case BOTTOM_ARROW: - Tcl_SetResult(interp, "arrow2", TCL_STATIC); - break; + switch (TkpScrollbarPosition(scrollPtr, x, y)) { + case TOP_ARROW: zone = "arrow1"; break; + case TOP_GAP: zone = "trough1"; break; + case SLIDER: zone = "slider"; break; + case BOTTOM_GAP: zone = "trough2"; break; + case BOTTOM_ARROW: zone = "arrow2"; break; } - } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1)); + break; + } + case COMMAND_SET: { int totalUnits, windowUnits, firstUnit, lastUnit; - if (argc == 4) { + if (objc == 4) { double first, last; - if (Tcl_GetDouble(interp, argv[2], &first) != TCL_OK) { + if (Tcl_GetDoubleFromObj(interp, objv[2], &first) != TCL_OK) { goto error; } - if (Tcl_GetDouble(interp, argv[3], &last) != TCL_OK) { + if (Tcl_GetDoubleFromObj(interp, objv[3], &last) != TCL_OK) { goto error; } if (first < 0) { @@ -439,23 +439,23 @@ ScrollbarWidgetCmd( scrollPtr->lastFraction = last; } scrollPtr->flags |= NEW_STYLE_COMMANDS; - } else if (argc == 6) { - if (Tcl_GetInt(interp, argv[2], &totalUnits) != TCL_OK) { + } else if (objc == 6) { + if (Tcl_GetIntFromObj(interp, objv[2], &totalUnits) != TCL_OK) { goto error; } if (totalUnits < 0) { totalUnits = 0; } - if (Tcl_GetInt(interp, argv[3], &windowUnits) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[3], &windowUnits) != TCL_OK) { goto error; } if (windowUnits < 0) { windowUnits = 0; } - if (Tcl_GetInt(interp, argv[4], &firstUnit) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[4], &firstUnit) != TCL_OK) { goto error; } - if (Tcl_GetInt(interp, argv[5], &lastUnit) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[5], &lastUnit) != TCL_OK) { goto error; } if (totalUnits > 0) { @@ -478,27 +478,23 @@ ScrollbarWidgetCmd( } scrollPtr->flags &= ~NEW_STYLE_COMMANDS; } else { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " set firstFraction lastFraction\" or \"", - argv[0], - " set totalUnits windowUnits firstUnit lastUnit\"", NULL); + Tcl_WrongNumArgs(interp, 1, objv, "set firstFraction lastFraction"); + Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]), + " set totalUnits windowUnits firstUnit lastUnit\"", NULL); goto error; } TkpComputeScrollbarGeometry(scrollPtr); TkScrollbarEventuallyRedraw(scrollPtr); - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be activate, cget, configure, delta, fraction, ", - "get, identify, or set", NULL); - goto error; + break; + } } done: - Tcl_Release((ClientData) scrollPtr); + Tcl_Release(scrollPtr); return result; error: - Tcl_Release((ClientData) scrollPtr); + Tcl_Release(scrollPtr); return TCL_ERROR; } @@ -528,12 +524,12 @@ ConfigureScrollbar( register TkScrollbar *scrollPtr, /* Information about widget; may or may not * already have values for some fields. */ - int argc, /* Number of valid entries in argv. */ - CONST char **argv, /* Arguments. */ + int objc, /* Number of valid entries in argv. */ + Tcl_Obj *const objv[], /* Arguments. */ int flags) /* Flags to pass to Tk_ConfigureWidget. */ { - if (Tk_ConfigureWidget(interp, scrollPtr->tkwin, configSpecs, - argc, argv, (char *) scrollPtr, flags) != TCL_OK) { + if (Tk_ConfigureWidget(interp, scrollPtr->tkwin, configSpecs, objc, + (const char **)objv, (char *) scrollPtr, flags|TK_CONFIG_OBJS) != TCL_OK) { return TCL_ERROR; } @@ -543,7 +539,7 @@ ConfigureScrollbar( */ if (scrollPtr->command != NULL) { - scrollPtr->commandSize = (int)strlen(scrollPtr->command); + scrollPtr->commandSize = (int) strlen(scrollPtr->command); } else { scrollPtr->commandSize = 0; } @@ -588,7 +584,7 @@ TkScrollbarEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - TkScrollbar *scrollPtr = (TkScrollbar *) clientData; + TkScrollbar *scrollPtr = clientData; if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) { TkScrollbarEventuallyRedraw(scrollPtr); @@ -600,16 +596,15 @@ TkScrollbarEventProc( scrollPtr->widgetCmd); } if (scrollPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(TkpDisplayScrollbar, (ClientData) scrollPtr); + Tcl_CancelIdleCall(TkpDisplayScrollbar, scrollPtr); } /* * Free up all the stuff that requires special handling, then let * Tk_FreeOptions handle all the standard option-related stuff. */ - Tk_FreeOptions(configSpecs, (char *) scrollPtr, - scrollPtr->display, 0); - Tcl_EventuallyFree((ClientData) scrollPtr, TCL_DYNAMIC); + Tk_FreeOptions(configSpecs, (char*) scrollPtr, scrollPtr->display, 0); + Tcl_EventuallyFree(scrollPtr, TCL_DYNAMIC); } else if (eventPtr->type == ConfigureNotify) { TkpComputeScrollbarGeometry(scrollPtr); TkScrollbarEventuallyRedraw(scrollPtr); @@ -627,6 +622,8 @@ TkScrollbarEventProc( TkScrollbarEventuallyRedraw(scrollPtr); } } + } else if (eventPtr->type == MapNotify) { + TkScrollbarEventuallyRedraw(scrollPtr); } } @@ -652,7 +649,7 @@ static void ScrollbarCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - TkScrollbar *scrollPtr = (TkScrollbar *) clientData; + TkScrollbar *scrollPtr = clientData; Tk_Window tkwin = scrollPtr->tkwin; /* @@ -688,11 +685,11 @@ void TkScrollbarEventuallyRedraw( TkScrollbar *scrollPtr) /* Information about widget. */ { - if ((scrollPtr->tkwin == NULL) || (!Tk_IsMapped(scrollPtr->tkwin))) { + if ((scrollPtr->tkwin == NULL) || !Tk_IsMapped(scrollPtr->tkwin)) { return; } - if ((scrollPtr->flags & REDRAW_PENDING) == 0) { - Tcl_DoWhenIdle(TkpDisplayScrollbar, (ClientData) scrollPtr); + if (!(scrollPtr->flags & REDRAW_PENDING)) { + Tcl_DoWhenIdle(TkpDisplayScrollbar, scrollPtr); scrollPtr->flags |= REDRAW_PENDING; } } diff --git a/generic/tkScrollbar.h b/generic/tkScrollbar.h index 126d590..b0cd085 100644 --- a/generic/tkScrollbar.h +++ b/generic/tkScrollbar.h @@ -161,7 +161,7 @@ typedef struct TkScrollbar { * and default scrollbar width, for use in configSpec. */ -MODULE_SCOPE Tk_ClassProcs tkpScrollbarProcs; +MODULE_SCOPE const Tk_ClassProcs tkpScrollbarProcs; MODULE_SCOPE char tkDefScrollbarWidth[TCL_INTEGER_SPACE]; /* diff --git a/generic/tkSelect.c b/generic/tkSelect.c index 7c96b94..ab9018a 100644 --- a/generic/tkSelect.c +++ b/generic/tkSelect.c @@ -28,7 +28,7 @@ typedef struct { * chunk. */ char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character * that is split across chunks. */ - char command[4]; /* Command to invoke. Actual space is + char command[1]; /* Command to invoke. Actual space is * allocated as large as necessary. This must * be the last entry in the structure. */ } CommandInfo; @@ -41,9 +41,7 @@ typedef struct { typedef struct LostCommand { Tcl_Interp *interp; /* Interpreter in which to invoke command. */ - char command[4]; /* Command to invoke. Actual space is - * allocated as large as necessary. This must - * be the last entry in the structure. */ + Tcl_Obj *cmdObj; /* Reference to command to invoke. */ } LostCommand; /* @@ -65,7 +63,7 @@ static int HandleTclCommand(ClientData clientData, int offset, char *buffer, int maxBytes); static void LostSelection(ClientData clientData); static int SelGetProc(ClientData clientData, - Tcl_Interp *interp, char *portion); + Tcl_Interp *interp, const char *portion); /* *-------------------------------------------------------------- @@ -141,7 +139,7 @@ Tk_CreateSelHandler( for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) { if (selPtr == NULL) { - selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler)); + selPtr = ckalloc(sizeof(TkSelHandler)); selPtr->nextPtr = winPtr->selHandlerList; winPtr->selHandlerList = selPtr; break; @@ -154,7 +152,7 @@ Tk_CreateSelHandler( */ if (selPtr->proc == HandleTclCommand) { - ckfree((char *) selPtr->clientData); + ckfree(selPtr->clientData); } break; } @@ -179,7 +177,7 @@ Tk_CreateSelHandler( target = winPtr->dispPtr->utf8Atom; for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) { if (selPtr == NULL) { - selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler)); + selPtr = ckalloc(sizeof(TkSelHandler)); selPtr->nextPtr = winPtr->selHandlerList; winPtr->selHandlerList = selPtr; selPtr->selection = selection; @@ -192,10 +190,10 @@ Tk_CreateSelHandler( * should make a copy for this selPtr. */ - unsigned cmdInfoLen = sizeof(CommandInfo) + - ((CommandInfo*)clientData)->cmdLength - 3; + unsigned cmdInfoLen = Tk_Offset(CommandInfo, command) + + ((CommandInfo *)clientData)->cmdLength + 1; - selPtr->clientData = (ClientData)ckalloc(cmdInfoLen); + selPtr->clientData = ckalloc(cmdInfoLen); memcpy(selPtr->clientData, clientData, cmdInfoLen); } else { selPtr->clientData = clientData; @@ -243,7 +241,7 @@ Tk_DeleteSelHandler( TkWindow *winPtr = (TkWindow *) tkwin; register TkSelHandler *selPtr, *prevPtr; register TkSelInProgress *ipPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -319,10 +317,10 @@ Tk_DeleteSelHandler( * Mark the CommandInfo as deleted and free it if we can. */ - ((CommandInfo*)selPtr->clientData)->interp = NULL; + ((CommandInfo *) selPtr->clientData)->interp = NULL; Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC); } - ckfree((char *) selPtr); + ckfree(selPtr); } /* @@ -384,7 +382,7 @@ Tk_OwnSelection( } } if (infoPtr == NULL) { - infoPtr = (TkSelectionInfo*) ckalloc(sizeof(TkSelectionInfo)); + infoPtr = ckalloc(sizeof(TkSelectionInfo)); infoPtr->selection = selection; infoPtr->nextPtr = dispPtr->selectionInfoPtr; dispPtr->selectionInfoPtr = infoPtr; @@ -399,7 +397,7 @@ Tk_OwnSelection( * memory leak. */ - ckfree((char *) infoPtr->clearData); + ckfree(infoPtr->clearData); } } @@ -433,7 +431,7 @@ Tk_OwnSelection( */ if (clearProc != NULL) { - (*clearProc)(clearData); + clearProc(clearData); } } @@ -492,12 +490,12 @@ Tk_ClearSelection( if (infoPtr != NULL) { clearProc = infoPtr->clearProc; clearData = infoPtr->clearData; - ckfree((char *) infoPtr); + ckfree(infoPtr); } XSetSelectionOwner(winPtr->display, selection, None, CurrentTime); if (clearProc != NULL) { - (*clearProc)(clearData); + clearProc(clearData); } } @@ -558,7 +556,7 @@ Tk_GetSelection( TkWindow *winPtr = (TkWindow *) tkwin; TkDisplay *dispPtr = winPtr->dispPtr; TkSelectionInfo *infoPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (dispPtr->multipleAtom == None) { @@ -602,7 +600,7 @@ Tk_GetSelection( goto cantget; } buffer[count] = 0; - result = (*proc)(clientData, interp, buffer); + result = proc(clientData, interp, buffer); } else { offset = 0; result = TCL_OK; @@ -610,7 +608,7 @@ Tk_GetSelection( ip.nextPtr = tsdPtr->pendingPtr; tsdPtr->pendingPtr = &ip; while (1) { - count = (selPtr->proc)(selPtr->clientData, offset, buffer, + count = selPtr->proc(selPtr->clientData, offset, buffer, TK_SEL_BYTES_AT_ONCE); if ((count < 0) || (ip.selPtr == NULL)) { tsdPtr->pendingPtr = ip.nextPtr; @@ -620,7 +618,7 @@ Tk_GetSelection( Tcl_Panic("selection handler returned too many bytes"); } buffer[count] = '\0'; - result = (*proc)(clientData, interp, buffer); + result = proc(clientData, interp, buffer); if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE) || (ip.selPtr == NULL)) { break; @@ -640,9 +638,10 @@ Tk_GetSelection( clientData); cantget: - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, target), "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", + Tk_GetAtomName(tkwin, selection), + Tk_GetAtomName(tkwin, target))); return TCL_ERROR; } @@ -669,15 +668,16 @@ Tk_SelectionObjCmd( * interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; - char *path = NULL; + Tk_Window tkwin = clientData; + const char *path = NULL; Atom selection; - char *selName = NULL, *string; + const char *selName = NULL; + const char *string; int count, index; Tcl_Obj **objs; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "clear", "get", "handle", "own", NULL }; enum options { @@ -685,7 +685,7 @@ Tk_SelectionObjCmd( }; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } @@ -696,7 +696,7 @@ Tk_SelectionObjCmd( switch ((enum options) index) { case SELECTION_CLEAR: { - static CONST char *clearOptionStrings[] = { + static const char *const clearOptionStrings[] = { "-displayof", "-selection", NULL }; enum clearOptions { CLEAR_DISPLAYOF, CLEAR_SELECTION }; @@ -709,8 +709,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -731,7 +732,7 @@ Tk_SelectionObjCmd( if (count == 1) { path = Tcl_GetString(objs[0]); } else if (count > 1) { - Tcl_WrongNumArgs(interp, 2, objv, "?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?"); return TCL_ERROR; } if (path != NULL) { @@ -752,10 +753,10 @@ Tk_SelectionObjCmd( case SELECTION_GET: { Atom target; - char *targetName = NULL; + const char *targetName = NULL; Tcl_DString selBytes; int result; - static CONST char *getOptionStrings[] = { + static const char *const getOptionStrings[] = { "-displayof", "-selection", "-type", NULL }; enum getOptions { GET_DISPLAYOF, GET_SELECTION, GET_TYPE }; @@ -768,8 +769,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -803,7 +805,7 @@ Tk_SelectionObjCmd( selection = XA_PRIMARY; } if (count > 1) { - Tcl_WrongNumArgs(interp, 2, objv, "?options?"); + Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?"); return TCL_ERROR; } else if (count == 1) { target = Tk_InternAtom(tkwin, Tcl_GetString(objs[0])); @@ -815,7 +817,7 @@ Tk_SelectionObjCmd( Tcl_DStringInit(&selBytes); result = Tk_GetSelection(interp, tkwin, selection, target, - SelGetProc, (ClientData) &selBytes); + SelGetProc, &selBytes); if (result == TCL_OK) { Tcl_DStringResult(interp, &selBytes); } else { @@ -826,11 +828,11 @@ Tk_SelectionObjCmd( case SELECTION_HANDLE: { Atom target, format; - char *targetName = NULL; - char *formatName = NULL; + const char *targetName = NULL; + const char *formatName = NULL; register CommandInfo *cmdInfoPtr; int cmdLength; - static CONST char *handleOptionStrings[] = { + static const char *const handleOptionStrings[] = { "-format", "-selection", "-type", NULL }; enum handleOptions { @@ -845,8 +847,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -869,7 +872,8 @@ Tk_SelectionObjCmd( } if ((count < 2) || (count > 4)) { - Tcl_WrongNumArgs(interp, 2, objv, "?options? window command"); + Tcl_WrongNumArgs(interp, 2, objv, + "?-option value ...? window command"); return TCL_ERROR; } tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin); @@ -900,8 +904,8 @@ Tk_SelectionObjCmd( if (cmdLength == 0) { Tk_DeleteSelHandler(tkwin, selection, target); } else { - cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) ( - sizeof(CommandInfo) - 3 + cmdLength)); + cmdInfoPtr = ckalloc(Tk_Offset(CommandInfo, command) + + 1 + cmdLength); cmdInfoPtr->interp = interp; cmdInfoPtr->charOffset = 0; cmdInfoPtr->byteOffset = 0; @@ -909,16 +913,15 @@ Tk_SelectionObjCmd( cmdInfoPtr->cmdLength = cmdLength; memcpy(cmdInfoPtr->command, string, cmdLength + 1); Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand, - (ClientData) cmdInfoPtr, format); + cmdInfoPtr, format); } return TCL_OK; } case SELECTION_OWN: { register LostCommand *lostPtr; - char *script = NULL; - int cmdLength; - static CONST char *ownOptionStrings[] = { + Tcl_Obj *commandObj = NULL; + static const char *const ownOptionStrings[] = { "-command", "-displayof", "-selection", NULL }; enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION }; @@ -931,8 +934,9 @@ Tk_SelectionObjCmd( break; } if (count < 2) { - Tcl_AppendResult(interp, "value for \"", string, - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", string)); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL); return TCL_ERROR; } @@ -943,7 +947,7 @@ Tk_SelectionObjCmd( switch ((enum ownOptions) ownIndex) { case OWN_COMMAND: - script = Tcl_GetString(objs[1]); + commandObj = objs[1]; break; case OWN_DISPLAYOF: path = Tcl_GetString(objs[1]); @@ -955,7 +959,7 @@ Tk_SelectionObjCmd( } if (count > 2) { - Tcl_WrongNumArgs(interp, 2, objv, "?options? ?window?"); + Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? ?window?"); return TCL_ERROR; } if (selName != NULL) { @@ -974,7 +978,7 @@ Tk_SelectionObjCmd( if (tkwin == NULL) { return TCL_ERROR; } - winPtr = (TkWindow *)tkwin; + winPtr = (TkWindow *) tkwin; for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->selection == selection) { @@ -988,7 +992,7 @@ Tk_SelectionObjCmd( if ((infoPtr != NULL) && (infoPtr->owner != winPtr->dispPtr->clipWindow)) { - Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(infoPtr->owner)); } return TCL_OK; } @@ -998,18 +1002,17 @@ Tk_SelectionObjCmd( return TCL_ERROR; } if (count == 2) { - script = Tcl_GetString(objs[1]); + commandObj = objs[1]; } - if (script == NULL) { - Tk_OwnSelection(tkwin, selection, NULL, (ClientData) NULL); + if (commandObj == NULL) { + Tk_OwnSelection(tkwin, selection, NULL, NULL); return TCL_OK; } - cmdLength = strlen(script); - lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand) - -3 + cmdLength)); + lostPtr = ckalloc(sizeof(LostCommand)); lostPtr->interp = interp; - strcpy(lostPtr->command, script); - Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr); + lostPtr->cmdObj = commandObj; + Tcl_IncrRefCount(commandObj); + Tk_OwnSelection(tkwin, selection, LostSelection, lostPtr); return TCL_OK; } } @@ -1037,7 +1040,7 @@ Tk_SelectionObjCmd( TkSelInProgress * TkSelGetInProgress(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); return tsdPtr->pendingPtr; @@ -1064,7 +1067,7 @@ void TkSelSetInProgress( TkSelInProgress *pendingPtr) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->pendingPtr = pendingPtr; @@ -1094,7 +1097,7 @@ TkSelDeadWindow( register TkSelHandler *selPtr; register TkSelInProgress *ipPtr; TkSelectionInfo *infoPtr, *prevPtr, *nextPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1117,10 +1120,10 @@ TkSelDeadWindow( * Mark the CommandInfo as deleted and free it when we can. */ - ((CommandInfo*)selPtr->clientData)->interp = NULL; + ((CommandInfo *) selPtr->clientData)->interp = NULL; Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC); } - ckfree((char *) selPtr); + ckfree(selPtr); } /* @@ -1132,9 +1135,9 @@ TkSelDeadWindow( nextPtr = infoPtr->nextPtr; if (infoPtr->owner == (Tk_Window) winPtr) { if (infoPtr->clearProc == LostSelection) { - ckfree((char *) infoPtr->clearData); + ckfree(infoPtr->clearData); } - ckfree((char *) infoPtr); + ckfree(infoPtr); infoPtr = prevPtr; if (prevPtr == NULL) { winPtr->dispPtr->selectionInfoPtr = nextPtr; @@ -1190,7 +1193,7 @@ TkSelInit( * http://www.cl.cam.ac.uk/~mgk25/unicode.html#x11 */ -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) +#if !defined(_WIN32) dispPtr->utf8Atom = Tk_InternAtom(tkwin, "UTF8_STRING"); #else dispPtr->utf8Atom = (Atom) 0; @@ -1257,9 +1260,9 @@ TkSelClearSelection( */ if (infoPtr->clearProc != NULL) { - (*infoPtr->clearProc)(infoPtr->clearData); + infoPtr->clearProc(infoPtr->clearData); } - ckfree((char *) infoPtr); + ckfree(infoPtr); } } @@ -1288,9 +1291,9 @@ SelGetProc( * selection. */ Tcl_Interp *interp, /* Interpreter used for error reporting (not * used). */ - char *portion) /* New information to be appended. */ + const char *portion) /* New information to be appended. */ { - Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1); + Tcl_DStringAppend(clientData, portion, -1); return TCL_OK; } @@ -1322,16 +1325,14 @@ HandleTclCommand( char *buffer, /* Place to store converted selection. */ int maxBytes) /* Maximum # of bytes to store at buffer. */ { - CommandInfo *cmdInfoPtr = (CommandInfo *) clientData; - int spaceNeeded, length; -#define MAX_STATIC_SIZE 100 - char staticSpace[MAX_STATIC_SIZE]; - char *command, *string; + CommandInfo *cmdInfoPtr = clientData; + int length; + Tcl_Obj *command; + const char *string; Tcl_Interp *interp = cmdInfoPtr->interp; - Tcl_DString oldResult; - Tcl_Obj *objPtr; - int extraBytes, charOffset, count, numChars; - CONST char *p; + Tcl_InterpState savedState; + int extraBytes, charOffset, count, numChars, code; + const char *p; /* * We must also protect the interpreter and the command from being deleted @@ -1339,7 +1340,7 @@ HandleTclCommand( */ Tcl_Preserve(clientData); - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); /* * Compute the proper byte offset in the case where the last chunk split a @@ -1366,24 +1367,24 @@ HandleTclCommand( * the offset and maximum # of bytes. */ - spaceNeeded = cmdInfoPtr->cmdLength + 30; - if (spaceNeeded < MAX_STATIC_SIZE) { - command = staticSpace; - } else { - command = (char *) ckalloc((unsigned) spaceNeeded); - } - sprintf(command, "%s %d %d", cmdInfoPtr->command, charOffset, maxBytes); + command = Tcl_ObjPrintf("%s %d %d", + cmdInfoPtr->command, charOffset, maxBytes); + Tcl_IncrRefCount(command); /* * Execute the command. Be sure to restore the state of the interpreter * after executing the command. */ - Tcl_DStringInit(&oldResult); - Tcl_DStringGetResult(interp, &oldResult); - if (TkCopyAndGlobalEval(interp, command) == TCL_OK) { - objPtr = Tcl_GetObjResult(interp); - string = Tcl_GetStringFromObj(objPtr, &length); + savedState = Tcl_SaveInterpState(interp, TCL_OK); + code = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(command); + if (code == TCL_OK) { + /* + * TODO: This assumes that bytes are characters; that's not true! + */ + + string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); count = (length > maxBytes) ? maxBytes : length; memcpy(buffer, string, (size_t) count); buffer[count] = '\0'; @@ -1416,16 +1417,21 @@ HandleTclCommand( } count += extraBytes; } else { - count = -1; - } - Tcl_DStringResult(interp, &oldResult); + /* + * Something went wrong. Log errors as background errors, and silently + * drop everything else. + */ - if (command != staticSpace) { - ckfree(command); + if (code == TCL_ERROR) { + Tcl_AddErrorInfo(interp, "\n (command handling selection)"); + Tcl_BackgroundException(interp, code); + } + count = -1; } + (void) Tcl_RestoreInterpState(interp, savedState); Tcl_Release(clientData); - Tcl_Release((ClientData) interp); + Tcl_Release(interp); return count; } @@ -1490,8 +1496,9 @@ TkSelDefaultSelection( if ((selPtr->selection == infoPtr->selection) && (selPtr->target != dispPtr->applicationAtom) && (selPtr->target != dispPtr->windowAtom)) { - CONST char *atomString = Tk_GetAtomName((Tk_Window) winPtr, + const char *atomString = Tk_GetAtomName((Tk_Window) winPtr, selPtr->target); + Tcl_DStringAppendElement(&ds, atomString); } } @@ -1557,36 +1564,33 @@ static void LostSelection( ClientData clientData) /* Pointer to LostCommand structure. */ { - LostCommand *lostPtr = (LostCommand *) clientData; - Tcl_Obj *objPtr; - Tcl_Interp *interp; + LostCommand *lostPtr = clientData; + Tcl_Interp *interp = lostPtr->interp; + Tcl_InterpState savedState; + int code; - interp = lostPtr->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); /* * Execute the command. Save the interpreter's result, if any, and restore * it after executing the command. */ - objPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(objPtr); + savedState = Tcl_SaveInterpState(interp, TCL_OK); Tcl_ResetResult(interp); - - if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) { - Tcl_BackgroundError(interp); + code = Tcl_EvalObjEx(interp, lostPtr->cmdObj, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { + Tcl_BackgroundException(interp, code); } - - Tcl_SetObjResult(interp, objPtr); - Tcl_DecrRefCount(objPtr); - - Tcl_Release((ClientData) interp); + (void) Tcl_RestoreInterpState(interp, savedState); /* * Free the storage for the command, since we're done with it now. */ - ckfree((char *) lostPtr); + Tcl_DecrRefCount(lostPtr->cmdObj); + ckfree(lostPtr); + Tcl_Release(interp); } /* diff --git a/generic/tkSelect.h b/generic/tkSelect.h index b9d7d2d..74326d0 100644 --- a/generic/tkSelect.h +++ b/generic/tkSelect.h @@ -75,8 +75,7 @@ typedef struct TkSelRetrievalInfo { Atom selection; /* Selection being requested. */ Atom property; /* Property where selection will appear. */ Atom target; /* Desired form for selection. */ - int (*proc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, - char *portion)); /* Procedure to call to handle pieces of + Tk_GetSelProc *proc; /* Procedure to call to handle pieces of * selection. */ ClientData clientData; /* Argument for proc. */ int result; /* Initially -1. Set to a Tcl return value @@ -160,9 +159,6 @@ MODULE_SCOPE void TkSelClearSelection(Tk_Window tkwin, XEvent *eventPtr); MODULE_SCOPE int TkSelDefaultSelection(TkSelectionInfo *infoPtr, Atom target, char *buffer, int maxBytes, Atom *typePtr); -MODULE_SCOPE int TkSelGetSelection(Tcl_Interp *interp, Tk_Window tkwin, - Atom selection, Atom target, Tk_GetSelProc *proc, - ClientData clientData); #ifndef TkSelUpdateClipboard MODULE_SCOPE void TkSelUpdateClipboard(TkWindow *winPtr, TkClipboardTarget *targetPtr); diff --git a/generic/tkSquare.c b/generic/tkSquare.c index a35832a..36d2d6e 100644 --- a/generic/tkSquare.c +++ b/generic/tkSquare.c @@ -16,6 +16,12 @@ #if 0 #define __NO_OLD_CONFIG #endif +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif +#ifndef USE_TK_STUBS +# define USE_TK_STUBS +#endif #include "tkInt.h" /* @@ -61,47 +67,44 @@ typedef struct { static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_BORDER, "-background", "background", "Background", "#d9d9d9", Tk_Offset(Square, bgBorderPtr), -1, 0, - (ClientData) "white"}, + "white", 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, NULL, 0, -1, 0, - (ClientData) "-borderwidth"}, + "-borderwidth", 0}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, NULL, 0, -1, 0, - (ClientData) "-background"}, + "-background", 0}, {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", - "2", Tk_Offset(Square, borderWidthPtr), -1}, + "2", Tk_Offset(Square, borderWidthPtr), -1, 0, NULL, 0}, {TK_OPTION_BOOLEAN, "-dbl", "doubleBuffer", "DoubleBuffer", - "1", Tk_Offset(Square, doubleBufferPtr), -1}, + "1", Tk_Offset(Square, doubleBufferPtr), -1, 0 , NULL, 0}, {TK_OPTION_SYNONYM, "-fg", NULL, NULL, NULL, 0, -1, 0, - (ClientData) "-foreground"}, + "-foreground", 0}, {TK_OPTION_BORDER, "-foreground", "foreground", "Foreground", "#b03060", Tk_Offset(Square, fgBorderPtr), -1, 0, - (ClientData) "black"}, + "black", 0}, {TK_OPTION_PIXELS, "-posx", "posx", "PosX", "0", - Tk_Offset(Square, xPtr), -1}, + Tk_Offset(Square, xPtr), -1, 0, NULL, 0}, {TK_OPTION_PIXELS, "-posy", "posy", "PosY", "0", - Tk_Offset(Square, yPtr), -1}, + Tk_Offset(Square, yPtr), -1, 0, NULL, 0}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", - "raised", Tk_Offset(Square, reliefPtr), -1}, + "raised", Tk_Offset(Square, reliefPtr), -1, 0, NULL, 0}, {TK_OPTION_PIXELS, "-size", "size", "Size", "20", - Tk_Offset(Square, sizeObjPtr), -1}, - {TK_OPTION_END} + Tk_Offset(Square, sizeObjPtr), -1, 0, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; /* * Forward declarations for procedures defined later in this file: */ -int SquareObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[]); static void SquareDeletedProc(ClientData clientData); static int SquareConfigure(Tcl_Interp *interp, Square *squarePtr); -static void SquareDestroy(char *memPtr); +static void SquareDestroy(void *memPtr); static void SquareDisplay(ClientData clientData); static void KeepInWindow(Square *squarePtr); static void SquareObjEventProc(ClientData clientData, XEvent *eventPtr); static int SquareWidgetObjCmd(ClientData clientData, - Tcl_Interp *, int objc, Tcl_Obj * CONST objv[]); + Tcl_Interp *, int objc, Tcl_Obj * const objv[]); /* *-------------------------------------------------------------- @@ -125,14 +128,14 @@ SquareObjCmd( ClientData clientData, /* NULL. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Square *squarePtr; Tk_Window tkwin; Tk_OptionTable optionTable; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -157,27 +160,27 @@ SquareObjCmd( * just the non-NULL/0 items. */ - squarePtr = (Square *) ckalloc(sizeof(Square)); - memset((void *) squarePtr, 0, (sizeof(Square))); + squarePtr = ckalloc(sizeof(Square)); + memset(squarePtr, 0, sizeof(Square)); squarePtr->tkwin = tkwin; squarePtr->display = Tk_Display(tkwin); squarePtr->interp = interp; squarePtr->widgetCmd = Tcl_CreateObjCommand(interp, - Tk_PathName(squarePtr->tkwin), SquareWidgetObjCmd, - (ClientData) squarePtr, SquareDeletedProc); + Tk_PathName(squarePtr->tkwin), SquareWidgetObjCmd, squarePtr, + SquareDeletedProc); squarePtr->gc = None; squarePtr->optionTable = optionTable; if (Tk_InitOptions(interp, (char *) squarePtr, optionTable, tkwin) != TCL_OK) { Tk_DestroyWindow(squarePtr->tkwin); - ckfree((char *) squarePtr); + ckfree(squarePtr); return TCL_ERROR; } Tk_CreateEventHandler(squarePtr->tkwin, ExposureMask|StructureNotifyMask, - SquareObjEventProc, (ClientData) squarePtr); + SquareObjEventProc, squarePtr); if (Tk_SetOptions(interp, (char *) squarePtr, optionTable, objc - 2, objv + 2, tkwin, NULL, NULL) != TCL_OK) { goto error; @@ -218,11 +221,11 @@ SquareWidgetObjCmd( ClientData clientData, /* Information about square widget. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj * CONST objv[]) /* Argument objects. */ + Tcl_Obj * const objv[]) /* Argument objects. */ { - Square *squarePtr = (Square *) clientData; + Square *squarePtr = clientData; int result = TCL_OK; - static CONST char *squareOptions[] = {"cget", "configure", NULL}; + static const char *const squareOptions[] = {"cget", "configure", NULL}; enum { SQUARE_CGET, SQUARE_CONFIGURE }; @@ -234,12 +237,12 @@ SquareWidgetObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], squareOptions, "command", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], squareOptions, + sizeof(char *), "command", 0, &index) != TCL_OK) { return TCL_ERROR; } - Tcl_Preserve((ClientData) squarePtr); + Tcl_Preserve(squarePtr); switch (index) { case SQUARE_CGET: @@ -277,7 +280,7 @@ SquareWidgetObjCmd( result = SquareConfigure(interp, squarePtr); } if (!squarePtr->updatePending) { - Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr); + Tcl_DoWhenIdle(SquareDisplay, squarePtr); squarePtr->updatePending = 1; } } @@ -285,11 +288,11 @@ SquareWidgetObjCmd( Tcl_SetObjResult(interp, resultObjPtr); } } - Tcl_Release((ClientData) squarePtr); + Tcl_Release(squarePtr); return result; error: - Tcl_Release((ClientData) squarePtr); + Tcl_Release(squarePtr); return TCL_ERROR; } @@ -350,7 +353,7 @@ SquareConfigure( &borderWidth); Tk_SetInternalBorder(squarePtr->tkwin, borderWidth); if (!squarePtr->updatePending) { - Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr); + Tcl_DoWhenIdle(SquareDisplay, squarePtr); squarePtr->updatePending = 1; } KeepInWindow(squarePtr); @@ -380,17 +383,17 @@ SquareObjEventProc( ClientData clientData, /* Information about window. */ XEvent *eventPtr) /* Information about event. */ { - Square *squarePtr = (Square *) clientData; + Square *squarePtr = clientData; if (eventPtr->type == Expose) { if (!squarePtr->updatePending) { - Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr); + Tcl_DoWhenIdle(SquareDisplay, squarePtr); squarePtr->updatePending = 1; } } else if (eventPtr->type == ConfigureNotify) { KeepInWindow(squarePtr); if (!squarePtr->updatePending) { - Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr); + Tcl_DoWhenIdle(SquareDisplay, squarePtr); squarePtr->updatePending = 1; } } else if (eventPtr->type == DestroyNotify) { @@ -405,9 +408,9 @@ SquareObjEventProc( squarePtr->widgetCmd); } if (squarePtr->updatePending) { - Tcl_CancelIdleCall(SquareDisplay, (ClientData) squarePtr); + Tcl_CancelIdleCall(SquareDisplay, squarePtr); } - Tcl_EventuallyFree((ClientData) squarePtr, SquareDestroy); + Tcl_EventuallyFree(squarePtr, (Tcl_FreeProc *) SquareDestroy); } } @@ -433,7 +436,7 @@ static void SquareDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - Square *squarePtr = (Square *) clientData; + Square *squarePtr = clientData; Tk_Window tkwin = squarePtr->tkwin; /* @@ -470,7 +473,7 @@ static void SquareDisplay( ClientData clientData) /* Information about window. */ { - Square *squarePtr = (Square *) clientData; + Square *squarePtr = clientData; Tk_Window tkwin = squarePtr->tkwin; Pixmap pm = None; Drawable d; @@ -551,11 +554,11 @@ SquareDisplay( static void SquareDestroy( - char *memPtr) /* Info about square widget. */ + void *memPtr) /* Info about square widget. */ { - Square *squarePtr = (Square *) memPtr; + Square *squarePtr = memPtr; - ckfree((char *) squarePtr); + ckfree(squarePtr); } /* diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index 90a124f..f08d7f4 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -11,13 +11,13 @@ #include "tkInt.h" -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* UNIX */ #define UNIX_TK #include "tkUnixInt.h" #endif -#ifdef __WIN32__ +#ifdef _WIN32 #include "tkWinInt.h" #endif @@ -30,71 +30,43 @@ #include "tkPlatDecls.h" #include "tkIntXlibDecls.h" -#define TkUnusedStubEntry NULL +static const TkIntStubs tkIntStubs; +MODULE_SCOPE const TkStubs tkStubs; -#ifdef __WIN32__ +/* + * Remove macro that might interfere with the definition below. + */ + +#undef Tk_MainEx -static int -doNothing(void) +#ifdef _WIN32 + +int +TkpCmapStressed(Tk_Window tkwin, Colormap colormap) { /* dummy implementation, no need to do anything */ return 0; } - -#define TkCreateXEventSource TkPlatCreateXEventSource -static void -TkCreateXEventSource(void) -{ - TkWinXInit(Tk_GetHINSTANCE()); -} - -#undef XFree -#define XFree TkPlatXFree -static int -XFree(void *data) +void +TkpSync(Display *display) { - if (data != NULL) { - ckfree((char *) data); - } - return 0; + /* dummy implementation, no need to do anything */ } -#undef XVisualIDFromVisual -#define XVisualIDFromVisual TkPlatXVisualIDFromVisual -static VisualID -XVisualIDFromVisual(Visual *visual) +void +TkCreateXEventSource(void) { - return visual->visualid; + TkWinXInit(Tk_GetHINSTANCE()); } -/* - * Remove macros that will interfere with the definitions below. - */ -# undef TkpCmapStressed -# undef TkpSync -# undef XFlush -# undef XGrabServer -# undef XUngrabServer -# undef XNoOp -# undef XSynchronize -# undef XSync - -# define TkpCmapStressed (int (*) (Tk_Window, Colormap)) doNothing -# define TkpSync (void (*) (Display *)) doNothing # define TkUnixContainerId 0 # define TkUnixDoOneXEvent 0 # define TkUnixSetMenubar 0 -# define TkWmCleanup (void (*) (TkDisplay *)) doNothing -# define TkSendCleanup (void (*) (TkDisplay *)) doNothing +# define TkWmCleanup (void (*)(TkDisplay *)) TkpSync +# define TkSendCleanup (void (*)(TkDisplay *)) TkpSync # define TkpTestsendCmd 0 -# define XFlush (int (*) (Display *)) doNothing -# define XGrabServer (int (*) (Display *)) doNothing -# define XUngrabServer (int (*) (Display *)) doNothing -# define XNoOp (int (*) (Display *)) doNothing -# define XSynchronize (XAfterFunction (*) (Display *, Bool)) doNothing -# define XSync (int (*) (Display *, Bool)) doNothing -#else /* !__WIN32__ */ +#else /* !_WIN32 */ /* * Make sure that extensions which call XParseColor through the stub @@ -104,8 +76,6 @@ XVisualIDFromVisual(Visual *visual) # ifdef __CYGWIN__ - TkIntStubs tkIntStubs; - /* * Trick, so we don't have to include <windows.h> here, which in any * case lacks this function anyway. @@ -136,7 +106,7 @@ TkpPrintWindowId( * the hex representation of a pointer. */ Window window) /* Window to be printed into buffer. */ { - sprintf(buf, "%#08lx", (unsigned long) (window)); + sprintf(buf, "%#08lx", (unsigned long) (window)); } int @@ -235,8 +205,6 @@ void TkSubtractRegion (TkRegion a, TkRegion b, TkRegion c) # define TkWinGetPlatformTheme 0 # define TkWinChildProc 0 -# define TkBindDeadWindow 0 /* On purpose not in Cygwin's stub table */ - # elif !defined(MAC_OSX_TK) /* UNIX */ # undef TkClipBox @@ -257,7 +225,7 @@ void TkSubtractRegion (TkRegion a, TkRegion b, TkRegion c) # define TkUnionRectWithRegion (void (*) (XRectangle *, TkRegion, TkRegion)) XUnionRectWithRegion # define TkSubtractRegion (void (*) (TkRegion, TkRegion, TkRegion)) XSubtractRegion # endif -#endif /* !__WIN32__ */ +#endif /* !_WIN32 */ /* * WARNING: The contents of this file is automatically generated by the @@ -267,21 +235,21 @@ void TkSubtractRegion (TkRegion a, TkRegion b, TkRegion c) /* !BEGIN!: Do not edit below this line. */ -TkIntStubs tkIntStubs = { +static const TkIntStubs tkIntStubs = { TCL_STUB_MAGIC, - NULL, + 0, TkAllocWindow, /* 0 */ TkBezierPoints, /* 1 */ TkBezierScreenPoints, /* 2 */ - TkBindDeadWindow, /* 3 */ + 0, /* 3 */ TkBindEventProc, /* 4 */ TkBindFree, /* 5 */ TkBindInit, /* 6 */ TkChangeEventWindow, /* 7 */ TkClipInit, /* 8 */ TkComputeAnchor, /* 9 */ - TkCopyAndGlobalEval, /* 10 */ - TkCreateBindingProcedure, /* 11 */ + 0, /* 10 */ + 0, /* 11 */ TkCreateCursorFromData, /* 12 */ TkCreateFrame, /* 13 */ TkCreateMainWindow, /* 14 */ @@ -346,7 +314,7 @@ TkIntStubs tkIntStubs = { TkpRedirectKeyEvent, /* 73 */ TkpSetMainMenubar, /* 74 */ TkpUseWindow, /* 75 */ - TkpWindowWasRecentlyDeleted, /* 76 */ + 0, /* 76 */ TkQueueEventForAllChildren, /* 77 */ TkReadBitmapFile, /* 78 */ TkScrollWindow, /* 79 */ @@ -354,7 +322,7 @@ TkIntStubs tkIntStubs = { TkSelEventProc, /* 81 */ TkSelInit, /* 82 */ TkSelPropProc, /* 83 */ - NULL, /* 84 */ + 0, /* 84 */ TkSetWindowMenuBar, /* 85 */ TkStringToKeysym, /* 86 */ TkThickPolyLineToArea, /* 87 */ @@ -390,48 +358,48 @@ TkIntStubs tkIntStubs = { TkRectInRegion, /* 117 */ TkSetRegion, /* 118 */ TkUnionRectWithRegion, /* 119 */ - NULL, /* 120 */ -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */ - NULL, /* 121 */ + 0, /* 120 */ +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */ + 0, /* 121 */ #endif /* X11 */ -#if defined(__WIN32__) /* WIN */ - NULL, /* 121 */ +#if defined(_WIN32) /* WIN */ + 0, /* 121 */ #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ - NULL, /* 121 */ /* Dummy entry for stubs table backwards compatibility */ + 0, /* 121 */ /* Dummy entry for stubs table backwards compatibility */ TkpCreateNativeBitmap, /* 121 */ #endif /* AQUA */ -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */ - NULL, /* 122 */ +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */ + 0, /* 122 */ #endif /* X11 */ -#if defined(__WIN32__) /* WIN */ - NULL, /* 122 */ +#if defined(_WIN32) /* WIN */ + 0, /* 122 */ #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ - NULL, /* 122 */ /* Dummy entry for stubs table backwards compatibility */ + 0, /* 122 */ /* Dummy entry for stubs table backwards compatibility */ TkpDefineNativeBitmaps, /* 122 */ #endif /* AQUA */ - NULL, /* 123 */ -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */ - NULL, /* 124 */ + 0, /* 123 */ +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) /* X11 */ + 0, /* 124 */ #endif /* X11 */ -#if defined(__WIN32__) /* WIN */ - NULL, /* 124 */ +#if defined(_WIN32) /* WIN */ + 0, /* 124 */ #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ - NULL, /* 124 */ /* Dummy entry for stubs table backwards compatibility */ + 0, /* 124 */ /* Dummy entry for stubs table backwards compatibility */ TkpGetNativeAppBitmap, /* 124 */ #endif /* AQUA */ - NULL, /* 125 */ - NULL, /* 126 */ - NULL, /* 127 */ - NULL, /* 128 */ - NULL, /* 129 */ - NULL, /* 130 */ - NULL, /* 131 */ - NULL, /* 132 */ - NULL, /* 133 */ - NULL, /* 134 */ + 0, /* 125 */ + 0, /* 126 */ + 0, /* 127 */ + 0, /* 128 */ + 0, /* 129 */ + 0, /* 130 */ + 0, /* 131 */ + 0, /* 132 */ + 0, /* 133 */ + 0, /* 134 */ TkpDrawHighlightBorder, /* 135 */ TkSetFocusWin, /* 136 */ TkpSetKeycodeAndState, /* 137 */ @@ -452,20 +420,20 @@ TkIntStubs tkIntStubs = { TkpDrawFrame, /* 152 */ TkCreateThreadExitHandler, /* 153 */ TkDeleteThreadExitHandler, /* 154 */ - NULL, /* 155 */ + 0, /* 155 */ TkpTestembedCmd, /* 156 */ TkpTesttextCmd, /* 157 */ - NULL, /* 158 */ - NULL, /* 159 */ - NULL, /* 160 */ - NULL, /* 161 */ - NULL, /* 162 */ - NULL, /* 163 */ - NULL, /* 164 */ - NULL, /* 165 */ - NULL, /* 166 */ - NULL, /* 167 */ - NULL, /* 168 */ + TkSelGetSelection, /* 158 */ + TkTextGetIndex, /* 159 */ + TkTextIndexBackBytes, /* 160 */ + TkTextIndexForwBytes, /* 161 */ + TkTextMakeByteIndex, /* 162 */ + TkTextPrintIndex, /* 163 */ + TkTextSetMark, /* 164 */ + TkTextXviewCmd, /* 165 */ + TkTextChanged, /* 166 */ + TkBTreeNumLines, /* 167 */ + TkTextInsertDisplayProc, /* 168 */ TkStateParseProc, /* 169 */ TkStatePrintProc, /* 170 */ TkCanvasDashParseProc, /* 171 */ @@ -478,18 +446,18 @@ TkIntStubs tkIntStubs = { TkOrientPrintProc, /* 178 */ TkSmoothParseProc, /* 179 */ TkSmoothPrintProc, /* 180 */ - NULL, /* 181 */ - NULL, /* 182 */ - NULL, /* 183 */ - TkUnusedStubEntry, /* 184 */ + TkDrawAngledTextLayout, /* 181 */ + TkUnderlineAngledTextLayout, /* 182 */ + TkIntersectAngledTextLayout, /* 183 */ + TkDrawAngledChars, /* 184 */ }; -TkIntPlatStubs tkIntPlatStubs = { +static const TkIntPlatStubs tkIntPlatStubs = { TCL_STUB_MAGIC, - NULL, -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ + 0, +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ TkAlignImageData, /* 0 */ - NULL, /* 1 */ + 0, /* 1 */ TkGenerateActivateEvents, /* 2 */ TkpGetMS, /* 3 */ TkPointerDeadWindow, /* 4 */ @@ -537,8 +505,8 @@ TkIntPlatStubs tkIntPlatStubs = { #endif /* WIN */ #ifdef MAC_OSX_TK /* AQUA */ TkGenerateActivateEvents, /* 0 */ - NULL, /* 1 */ - NULL, /* 2 */ + 0, /* 1 */ + 0, /* 2 */ TkPointerDeadWindow, /* 3 */ TkpSetCapture, /* 4 */ TkpSetCursor, /* 5 */ @@ -549,14 +517,14 @@ TkIntPlatStubs tkIntPlatStubs = { TkMacOSXDispatchMenuEvent, /* 10 */ TkMacOSXInstallCursor, /* 11 */ TkMacOSXHandleTearoffMenu, /* 12 */ - NULL, /* 13 */ + 0, /* 13 */ TkMacOSXDoHLEvent, /* 14 */ - NULL, /* 15 */ + 0, /* 15 */ TkMacOSXGetXWindow, /* 16 */ TkMacOSXGrowToplevel, /* 17 */ TkMacOSXHandleMenuSelect, /* 18 */ - NULL, /* 19 */ - NULL, /* 20 */ + 0, /* 19 */ + 0, /* 20 */ TkMacOSXInvalidateWindow, /* 21 */ TkMacOSXIsCharacterMissing, /* 22 */ TkMacOSXMakeRealWindowExist, /* 23 */ @@ -584,7 +552,7 @@ TkIntPlatStubs tkIntPlatStubs = { TkMacOSXPreprocessMenu, /* 45 */ TkpIsWindowFloating, /* 46 */ TkMacOSXGetCapture, /* 47 */ - NULL, /* 48 */ + 0, /* 48 */ TkGetTransientMaster, /* 49 */ TkGenerateButtonEvent, /* 50 */ TkGenWMDestroyEvent, /* 51 */ @@ -593,10 +561,10 @@ TkIntPlatStubs tkIntPlatStubs = { TkMacOSXDrawable, /* 54 */ TkpScanWindowId, /* 55 */ #endif /* AQUA */ -#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ +#if !(defined(_WIN32) || defined(__CYGWIN__) || defined(MAC_OSX_TK)) /* X11 */ TkCreateXEventSource, /* 0 */ - TkFreeWindowId, /* 1 */ - TkInitXId, /* 2 */ + 0, /* 1 */ + 0, /* 2 */ TkpCmapStressed, /* 3 */ TkpSync, /* 4 */ TkUnixContainerId, /* 5 */ @@ -605,16 +573,16 @@ TkIntPlatStubs tkIntPlatStubs = { TkpScanWindowId, /* 8 */ TkWmCleanup, /* 9 */ TkSendCleanup, /* 10 */ - TkFreeXId, /* 11 */ + 0, /* 11 */ TkpWmSetState, /* 12 */ TkpTestsendCmd, /* 13 */ #endif /* X11 */ }; -TkIntXlibStubs tkIntXlibStubs = { +static const TkIntXlibStubs tkIntXlibStubs = { TCL_STUB_MAGIC, - NULL, -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ + 0, +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ XSetDashes, /* 0 */ XGetModifierMapping, /* 1 */ XCreateImage, /* 2 */ @@ -696,7 +664,7 @@ TkIntXlibStubs tkIntXlibStubs = { XFilterEvent, /* 78 */ XmbLookupString, /* 79 */ TkPutImage, /* 80 */ - NULL, /* 81 */ + 0, /* 81 */ XParseColor, /* 82 */ XCreateGC, /* 83 */ XFreeGC, /* 84 */ @@ -827,10 +795,10 @@ TkIntXlibStubs tkIntXlibStubs = { #endif /* AQUA */ }; -TkPlatStubs tkPlatStubs = { +static const TkPlatStubs tkPlatStubs = { TCL_STUB_MAGIC, - NULL, -#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ + 0, +#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ Tk_AttachHWND, /* 0 */ Tk_GetHINSTANCE, /* 1 */ Tk_GetHWND, /* 2 */ @@ -853,14 +821,14 @@ TkPlatStubs tkPlatStubs = { #endif /* AQUA */ }; -static TkStubHooks tkStubHooks = { +static const TkStubHooks tkStubHooks = { &tkPlatStubs, &tkIntStubs, &tkIntPlatStubs, &tkIntXlibStubs }; -TkStubs tkStubs = { +const TkStubs tkStubs = { TCL_STUB_MAGIC, &tkStubHooks, Tk_MainLoop, /* 0 */ @@ -1081,8 +1049,8 @@ TkStubs tkStubs = { Tk_InitConsoleChannels, /* 215 */ Tk_CreateConsoleWindow, /* 216 */ Tk_CreateSmoothMethod, /* 217 */ - NULL, /* 218 */ - NULL, /* 219 */ + 0, /* 218 */ + 0, /* 219 */ Tk_GetDash, /* 220 */ Tk_CreateOutline, /* 221 */ Tk_DeleteOutline, /* 222 */ @@ -1137,11 +1105,6 @@ TkStubs tkStubs = { Tk_Interp, /* 271 */ Tk_CreateOldImageType, /* 272 */ Tk_CreateOldPhotoImageFormat, /* 273 */ - NULL, /* 274 */ - TkUnusedStubEntry, /* 275 */ }; /* !END!: Do not edit above this line. */ - -#undef UNIX_TK -#undef MAC_OSX_TK diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c index f605b5d..ea48894 100644 --- a/generic/tkStubLib.c +++ b/generic/tkStubLib.c @@ -13,7 +13,7 @@ #include "tkInt.h" -#ifdef __WIN32__ +#ifdef _WIN32 #include "tkWinInt.h" #endif @@ -21,7 +21,7 @@ #include "tkMacOSXInt.h" #endif -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) #include "tkUnixInt.h" #endif @@ -29,11 +29,17 @@ #include "tkPlatDecls.h" #include "tkIntXlibDecls.h" -TkStubs *tkStubsPtr = NULL; -TkPlatStubs *tkPlatStubsPtr = NULL; -TkIntStubs *tkIntStubsPtr = NULL; -TkIntPlatStubs *tkIntPlatStubsPtr = NULL; -TkIntXlibStubs *tkIntXlibStubsPtr = NULL; +MODULE_SCOPE const TkStubs *tkStubsPtr; +MODULE_SCOPE const TkPlatStubs *tkPlatStubsPtr; +MODULE_SCOPE const TkIntStubs *tkIntStubsPtr; +MODULE_SCOPE const TkIntPlatStubs *tkIntPlatStubsPtr; +MODULE_SCOPE const TkIntXlibStubs *tkIntXlibStubsPtr; + +const TkStubs *tkStubsPtr = NULL; +const TkPlatStubs *tkPlatStubsPtr = NULL; +const TkIntStubs *tkIntStubsPtr = NULL; +const TkIntPlatStubs *tkIntPlatStubsPtr = NULL; +const TkIntXlibStubs *tkIntXlibStubsPtr = NULL; /* * Use our own isdigit to avoid linking to libc on windows @@ -63,32 +69,32 @@ isDigit(const int c) *---------------------------------------------------------------------- */ #undef Tk_InitStubs -CONST char * +MODULE_SCOPE const char * Tk_InitStubs( Tcl_Interp *interp, - CONST char *version, + const char *version, int exact) { const char *packageName = "Tk"; const char *errMsg = NULL; ClientData clientData = NULL; - CONST char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, + const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, 0, &clientData); - TkStubs *stubsPtr = (TkStubs *)clientData; + const TkStubs *stubsPtr = clientData; if (actualVersion == NULL) { return NULL; } if (exact) { - CONST char *p = version; + const char *p = version; int count = 0; while (*p) { count += !isDigit(*p++); } if (count == 1) { - CONST char *q = actualVersion; + const char *q = actualVersion; p = version; while (*p && (*p == *q)) { @@ -96,11 +102,11 @@ Tk_InitStubs( } if (*p || isDigit(*q)) { /* Construct error message */ - tclStubsPtr->tcl_PkgRequireEx(interp, "Tk", version, 1, NULL); + tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, 1, NULL); return NULL; } } else { - actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, "Tk", + actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, 1, NULL); if (actualVersion == NULL) { return NULL; diff --git a/generic/tkStyle.c b/generic/tkStyle.c index c2eed8f..e7401df 100644 --- a/generic/tkStyle.c +++ b/generic/tkStyle.c @@ -146,11 +146,11 @@ 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.twoPtrValue.ptr1 field of each style - * object points to the Style structure for the stylefont, or NULL. + * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of each + * style object points to the Style structure for the stylefont, or NULL. */ -static Tcl_ObjType styleObjType = { +static const Tcl_ObjType styleObjType = { "style", /* name */ FreeStyleObjProc, /* freeIntRepProc */ DupStyleObjProc, /* dupIntRepProc */ @@ -180,7 +180,7 @@ void TkStylePkgInit( TkMainInfo *mainPtr) /* The application being created. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->nbInit != 0) { @@ -208,8 +208,7 @@ TkStylePkgInit( * Create the default system style. */ - Tk_CreateStyle(NULL, (Tk_StyleEngine) tsdPtr->defaultEnginePtr, - (ClientData) 0); + Tk_CreateStyle(NULL, (Tk_StyleEngine) tsdPtr->defaultEnginePtr, NULL); tsdPtr->nbInit++; } @@ -236,7 +235,7 @@ void TkStylePkgFree( TkMainInfo *mainPtr) /* The application being deleted. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_HashSearch search; Tcl_HashEntry *entryPtr; @@ -254,7 +253,7 @@ TkStylePkgFree( entryPtr = Tcl_FirstHashEntry(&tsdPtr->styleTable, &search); while (entryPtr != NULL) { - ckfree((char *) Tcl_GetHashValue(entryPtr)); + ckfree(Tcl_GetHashValue(entryPtr)); entryPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&tsdPtr->styleTable); @@ -265,9 +264,9 @@ TkStylePkgFree( entryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search); while (entryPtr != NULL) { - enginePtr = (StyleEngine *) Tcl_GetHashValue(entryPtr); + enginePtr = Tcl_GetHashValue(entryPtr); FreeStyleEngine(enginePtr); - ckfree((char *) enginePtr); + ckfree(enginePtr); entryPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&tsdPtr->engineTable); @@ -280,7 +279,7 @@ TkStylePkgFree( FreeElement(tsdPtr->elements+i); } Tcl_DeleteHashTable(&tsdPtr->elementTable); - ckfree((char *) tsdPtr->elements); + ckfree(tsdPtr->elements); } /* @@ -308,7 +307,7 @@ Tk_RegisterStyleEngine( Tk_StyleEngine parent) /* The engine's parent. NULL means the default * system engine. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_HashEntry *entryPtr; int newEntry; @@ -332,10 +331,10 @@ Tk_RegisterStyleEngine( * Allocate and intitialize a new engine. */ - enginePtr = (StyleEngine *) ckalloc(sizeof(StyleEngine)); + enginePtr = ckalloc(sizeof(StyleEngine)); InitStyleEngine(enginePtr, Tcl_GetHashKey(&tsdPtr->engineTable, entryPtr), (StyleEngine *) parent); - Tcl_SetHashValue(entryPtr, (ClientData) enginePtr); + Tcl_SetHashValue(entryPtr, enginePtr); return (Tk_StyleEngine) enginePtr; } @@ -365,7 +364,7 @@ InitStyleEngine( StyleEngine *parentPtr) /* The engine's parent. NULL means the default * system engine. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); int elementId; @@ -390,7 +389,7 @@ InitStyleEngine( */ if (tsdPtr->nbElements > 0) { - enginePtr->elements = (StyledElement *) ckalloc( + enginePtr->elements = ckalloc( sizeof(StyledElement) * tsdPtr->nbElements); for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) { InitStyledElement(enginePtr->elements+elementId); @@ -420,7 +419,7 @@ static void FreeStyleEngine( StyleEngine *enginePtr) /* The style engine to free. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); int elementId; @@ -431,7 +430,7 @@ FreeStyleEngine( for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) { FreeStyledElement(enginePtr->elements+elementId); } - ckfree((char *) enginePtr->elements); + ckfree(enginePtr->elements); } /* @@ -455,7 +454,7 @@ Tk_GetStyleEngine( const char *name) /* Name of the engine to retrieve. NULL or * empty means the default system engine. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_HashEntry *entryPtr; @@ -468,7 +467,7 @@ Tk_GetStyleEngine( return NULL; } - return (Tk_StyleEngine) Tcl_GetHashValue(entryPtr); + return Tcl_GetHashValue(entryPtr); } /* @@ -579,7 +578,7 @@ FreeStyledElement( for (i = 0; i < elementPtr->nbWidgetSpecs; i++) { FreeWidgetSpec(elementPtr->widgetSpecs+i); } - ckfree((char *) elementPtr->widgetSpecs); + ckfree(elementPtr->widgetSpecs); } /* @@ -605,7 +604,7 @@ CreateElement( * created explicitly (being registered) or * implicitly (by a derived element). */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_HashEntry *entryPtr, *engineEntryPtr; Tcl_HashSearch search; @@ -637,13 +636,13 @@ CreateElement( } elementId = tsdPtr->nbElements++; - Tcl_SetHashValue(entryPtr, (ClientData) INT2PTR(elementId)); + Tcl_SetHashValue(entryPtr, INT2PTR(elementId)); /* * Reallocate element table. */ - tsdPtr->elements = (Element *) ckrealloc((char *) tsdPtr->elements, + tsdPtr->elements = ckrealloc(tsdPtr->elements, sizeof(Element) * tsdPtr->nbElements); InitElement(tsdPtr->elements+elementId, Tcl_GetHashKey(&tsdPtr->elementTable, entryPtr), elementId, @@ -655,10 +654,9 @@ CreateElement( engineEntryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search); while (engineEntryPtr != NULL) { - enginePtr = (StyleEngine *) Tcl_GetHashValue(engineEntryPtr); + enginePtr = Tcl_GetHashValue(engineEntryPtr); - enginePtr->elements = (StyledElement *) ckrealloc( - (char *) enginePtr->elements, + enginePtr->elements = ckrealloc(enginePtr->elements, sizeof(StyledElement) * tsdPtr->nbElements); InitStyledElement(enginePtr->elements+elementId); @@ -688,7 +686,7 @@ int Tk_GetElementId( const char *name) /* Name of the element. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_HashEntry *entryPtr; int genericId = -1; @@ -788,7 +786,7 @@ Tk_RegisterStyledElement( elementPtr = ((StyleEngine *) engine)->elements+elementId; - specPtr = (Tk_ElementSpec *) ckalloc(sizeof(Tk_ElementSpec)); + specPtr = ckalloc(sizeof(Tk_ElementSpec)); specPtr->version = templatePtr->version; specPtr->name = ckalloc(strlen(templatePtr->name)+1); strcpy(specPtr->name, templatePtr->name); @@ -797,7 +795,7 @@ Tk_RegisterStyledElement( srcOptions->name != NULL; nbOptions++, srcOptions++) { /* empty body */ } - specPtr->options = (Tk_ElementOptionSpec *) + specPtr->options = ckalloc(sizeof(Tk_ElementOptionSpec) * (nbOptions+1)); for (srcOptions = templatePtr->options, dstOptions = specPtr->options; /* End condition within loop */; srcOptions++, dstOptions++) { @@ -846,7 +844,7 @@ GetStyledElement( int elementId) /* Unique element ID */ { StyledElement *elementPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); StyleEngine *enginePtr2; @@ -925,7 +923,7 @@ InitWidgetSpec( * Build the widget option list. */ - widgetSpecPtr->optionsPtr = (const Tk_OptionSpec **) + widgetSpecPtr->optionsPtr = ckalloc(sizeof(Tk_OptionSpec *) * nbOptions); for (i = 0, elementOptionPtr = elementPtr->specPtr->options; i < nbOptions; i++, elementOptionPtr++) { @@ -966,7 +964,7 @@ FreeWidgetSpec( StyledWidgetSpec *widgetSpecPtr) /* The widget spec to free. */ { - ckfree((char *) widgetSpecPtr->optionsPtr); + ckfree(widgetSpecPtr->optionsPtr); } /* @@ -1010,8 +1008,7 @@ GetWidgetSpec( */ i = elementPtr->nbWidgetSpecs++; - elementPtr->widgetSpecs = (StyledWidgetSpec *) ckrealloc( - (char *) elementPtr->widgetSpecs, + elementPtr->widgetSpecs = ckrealloc(elementPtr->widgetSpecs, sizeof(StyledWidgetSpec) * elementPtr->nbWidgetSpecs); widgetSpecPtr = elementPtr->widgetSpecs+i; InitWidgetSpec(widgetSpecPtr, elementPtr, optionTable); @@ -1232,7 +1229,7 @@ Tk_CreateStyle( Tk_StyleEngine engine, /* The style engine. */ ClientData clientData) /* Private data passed as is to engine code. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_HashEntry *entryPtr; int newEntry; @@ -1256,11 +1253,11 @@ Tk_CreateStyle( * Allocate and intitialize a new style. */ - stylePtr = (Style *) ckalloc(sizeof(Style)); + stylePtr = 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); + Tcl_SetHashValue(entryPtr, stylePtr); return (Tk_Style) stylePtr; } @@ -1347,7 +1344,7 @@ Tk_GetStyle( const char *name) /* Name of the style to retrieve. NULL or empty * means the default system style. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_HashEntry *entryPtr; Style *stylePtr; @@ -1359,12 +1356,13 @@ Tk_GetStyle( entryPtr = Tcl_FindHashEntry(&tsdPtr->styleTable, (name!=NULL?name:"")); if (entryPtr == NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "style \"", name, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "style \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "STYLE", name, NULL); } return (Tk_Style) NULL; } - stylePtr = (Style *) Tcl_GetHashValue(entryPtr); + stylePtr = Tcl_GetHashValue(entryPtr); return (Tk_Style) stylePtr; } @@ -1412,7 +1410,7 @@ Tk_AllocStyleFromObj( if (objPtr->typePtr != &styleObjType) { SetStyleFromAny(interp, objPtr); } - stylePtr = (Style *) objPtr->internalRep.twoPtrValue.ptr1; + stylePtr = objPtr->internalRep.twoPtrValue.ptr1; return (Tk_Style) stylePtr; } @@ -1444,7 +1442,7 @@ Tk_GetStyleFromObj( SetStyleFromAny(NULL, objPtr); } - return (Tk_Style) objPtr->internalRep.twoPtrValue.ptr1; + return objPtr->internalRep.twoPtrValue.ptr1; } /* @@ -1495,11 +1493,11 @@ SetStyleFromAny( name = Tcl_GetString(objPtr); typePtr = objPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(objPtr); + typePtr->freeIntRepProc(objPtr); } objPtr->typePtr = &styleObjType; - objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) Tk_GetStyle(interp, name); + objPtr->internalRep.twoPtrValue.ptr1 = Tk_GetStyle(interp, name); return TCL_OK; } diff --git a/generic/tkTest.c b/generic/tkTest.c index d06769d..fa9e073 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -14,10 +14,17 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#undef STATIC_BUILD +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif +#ifndef USE_TK_STUBS +# define USE_TK_STUBS +#endif #include "tkInt.h" #include "tkText.h" -#ifdef __WIN32__ +#ifdef _WIN32 #include "tkWinInt.h" #endif @@ -31,6 +38,15 @@ #endif /* + * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the + * Tcltest_Init declaration is in the source file itself, which is only + * accessed when we are building a library. + */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT +EXTERN int Tktest_Init(Tcl_Interp *interp); +/* * The following data structure represents the master for a test image: */ @@ -59,8 +75,8 @@ typedef struct TImageInstance { */ static int ImageCreate(Tcl_Interp *interp, - char *name, int argc, Tcl_Obj *const objv[], - Tk_ImageType *typePtr, Tk_ImageMaster master, + const char *name, int argc, Tcl_Obj *const objv[], + const Tk_ImageType *typePtr, Tk_ImageMaster master, ClientData *clientDataPtr); static ClientData ImageGet(Tk_Window tkwin, ClientData clientData); static void ImageDisplay(ClientData clientData, @@ -79,7 +95,8 @@ static Tk_ImageType imageType = { ImageFree, /* freeProc */ ImageDelete, /* deleteProc */ NULL, /* postscriptPtr */ - NULL /* nextPtr */ + NULL, /* nextPtr */ + NULL }; /* @@ -96,25 +113,11 @@ typedef struct NewApp { static NewApp *newAppPtr = NULL;/* First in list of all new interpreters. */ /* - * Declaration for the square widget's class command function: - */ - -extern int SquareObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj * const objv[]); - -typedef struct CBinding { - Tcl_Interp *interp; - char *command; - char *delete; -} CBinding; - -/* * Header for trivial configuration command items. */ -#define ODD TK_CONFIG_USER_BIT -#define EVEN (TK_CONFIG_USER_BIT << 1) +#define ODD TK_CONFIG_USER_BIT +#define EVEN (TK_CONFIG_USER_BIT << 1) enum { NONE, @@ -136,15 +139,9 @@ typedef struct TrivialCommandHeader { * Forward declarations for functions defined later in this file: */ -static int CBindingEvalProc(ClientData clientData, - Tcl_Interp *interp, XEvent *eventPtr, - Tk_Window tkwin, KeySym keySym); -static void CBindingFreeProc(ClientData clientData); -int Tktest_Init(Tcl_Interp *interp); -static int ImageCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -static int TestcbindCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int ImageObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); static int TestbitmapObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); @@ -157,20 +154,24 @@ static int TestcolorObjCmd(ClientData dummy, static int TestcursorObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); -static int TestdeleteappsCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestdeleteappsObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); static int TestfontObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestmakeexistCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -#if !(defined(__WIN32__) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) -static int TestmenubarCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestmakeexistObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) +static int TestmenubarObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); #endif -#if defined(__WIN32__) || defined(MAC_OSX_TK) -static int TestmetricsCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +#if defined(_WIN32) || defined(MAC_OSX_TK) +static int TestmetricsObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); #endif static int TestobjconfigObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, @@ -188,11 +189,13 @@ static void CustomOptionRestore(ClientData clientData, char *saveInternalPtr); static void CustomOptionFree(ClientData clientData, Tk_Window tkwin, char *internalPtr); -static int TestpropCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); -#if !(defined(__WIN32__) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) -static int TestwrapperCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestpropObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); +#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) +static int TestwrapperObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); #endif static void TrivialCmdDeletedProc(ClientData clientData); static int TrivialConfigObjCmd(ClientData dummy, @@ -200,21 +203,6 @@ static int TrivialConfigObjCmd(ClientData dummy, Tcl_Obj * const objv[]); static void TrivialEventProc(ClientData clientData, XEvent *eventPtr); - -/* - * External (platform specific) initialization routine: - */ - -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) -#define TkplatformtestInit(x) TCL_OK -#else -MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); -#endif - -/* - * External legacy testing initialization routine: - */ -MODULE_SCOPE int TkOldTestInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -239,18 +227,22 @@ Tktest_Init( { static int initialized = 0; + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + return TCL_ERROR; + } + if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) { + return TCL_ERROR; + } + /* * Create additional commands for testing Tk. */ - if (Tcl_PkgProvide(interp, "Tktest", TK_VERSION) == TCL_ERROR) { + if (Tcl_PkgProvideEx(interp, "Tktest", TK_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "square", SquareObjCmd, - (ClientData) NULL, NULL); - Tcl_CreateCommand(interp, "testcbind", TestcbindCmd, - (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd, @@ -259,32 +251,32 @@ Tktest_Init( (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testcursor", TestcursorObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd, + Tcl_CreateObjCommand(interp, "testdeleteapps", TestdeleteappsObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd, + Tcl_CreateObjCommand(interp, "testembed", TkpTestembedCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testobjconfig", TestobjconfigObjCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd, + Tcl_CreateObjCommand(interp, "testmakeexist", TestmakeexistObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testprop", TestpropCmd, + Tcl_CreateObjCommand(interp, "testprop", TestpropObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testtext", TkpTesttextCmd, + Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd, (ClientData) Tk_MainWindow(interp), NULL); -#if defined(__WIN32__) || defined(MAC_OSX_TK) - Tcl_CreateCommand(interp, "testmetrics", TestmetricsCmd, +#if defined(_WIN32) || defined(MAC_OSX_TK) + Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd, (ClientData) Tk_MainWindow(interp), NULL); #elif !defined(__CYGWIN__) - Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd, + Tcl_CreateObjCommand(interp, "testmenubar", TestmenubarObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testsend", TkpTestsendCmd, + Tcl_CreateObjCommand(interp, "testsend", TkpTestsendCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testwrapper", TestwrapperCmd, + Tcl_CreateObjCommand(interp, "testwrapper", TestwrapperObjCmd, (ClientData) Tk_MainWindow(interp), NULL); -#endif /* __WIN32__ || MAC_OSX_TK */ +#endif /* _WIN32 || MAC_OSX_TK */ /* * Create test image type. @@ -313,113 +305,6 @@ Tktest_Init( /* *---------------------------------------------------------------------- * - * TestcbindCmd -- - * - * This function implements the "testcbinding" command. It provides a set - * of functions for testing C bindings in tkBind.c. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Depends on option; see below. - * - *---------------------------------------------------------------------- - */ - -static int -TestcbindCmd( - ClientData clientData, /* Main window for application. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ -{ - TkWindow *winPtr; - Tk_Window tkwin; - ClientData object; - CBinding *cbindPtr; - - - if (argc < 4 || argc > 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " bindtag pattern command ?deletecommand?", NULL); - return TCL_ERROR; - } - - tkwin = (Tk_Window) clientData; - - if (argv[1][0] == '.') { - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin); - if (winPtr == NULL) { - return TCL_ERROR; - } - object = (ClientData) winPtr->pathName; - } else { - winPtr = (TkWindow *) clientData; - object = (ClientData) Tk_GetUid(argv[1]); - } - - if (argv[3][0] == '\0') { - return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable, - object, argv[2]); - } - - cbindPtr = (CBinding *) ckalloc(sizeof(CBinding)); - cbindPtr->interp = interp; - cbindPtr->command = - strcpy((char *) ckalloc(strlen(argv[3]) + 1), argv[3]); - if (argc == 4) { - cbindPtr->delete = NULL; - } else { - cbindPtr->delete = - strcpy((char *) ckalloc(strlen(argv[4]) + 1), argv[4]); - } - - if (TkCreateBindingProcedure(interp, winPtr->mainPtr->bindingTable, - object, argv[2], CBindingEvalProc, CBindingFreeProc, - (ClientData) cbindPtr) == 0) { - ckfree((char *) cbindPtr->command); - if (cbindPtr->delete != NULL) { - ckfree((char *) cbindPtr->delete); - } - ckfree((char *) cbindPtr); - return TCL_ERROR; - } - return TCL_OK; -} - -static int -CBindingEvalProc( - ClientData clientData, - Tcl_Interp *interp, - XEvent *eventPtr, - Tk_Window tkwin, - KeySym keySym) -{ - CBinding *cbindPtr; - - cbindPtr = (CBinding *) clientData; - - return Tcl_EvalEx(interp, cbindPtr->command, -1, TCL_EVAL_GLOBAL); -} - -static void -CBindingFreeProc( - ClientData clientData) -{ - CBinding *cbindPtr = (CBinding *) clientData; - - if (cbindPtr->delete != NULL) { - Tcl_EvalEx(cbindPtr->interp, cbindPtr->delete, -1, TCL_EVAL_GLOBAL); - ckfree((char *) cbindPtr->delete); - } - ckfree((char *) cbindPtr->command); - ckfree((char *) cbindPtr); -} - -/* - *---------------------------------------------------------------------- - * * TestbitmapObjCmd -- * * This function implements the "testbitmap" command, which is used to @@ -558,7 +443,7 @@ TestcursorObjCmd( /* *---------------------------------------------------------------------- * - * TestdeleteappsCmd -- + * TestdeleteappsObjCmd -- * * This function implements the "testdeleteapps" command. It cleans up * all the interpreters left behind by the "testnewapp" command. @@ -575,18 +460,18 @@ TestcursorObjCmd( /* ARGSUSED */ static int -TestdeleteappsCmd( +TestdeleteappsObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { NewApp *nextPtr; while (newAppPtr != NULL) { nextPtr = newAppPtr->nextPtr; Tcl_DeleteInterp(newAppPtr->interp); - ckfree((char *) newAppPtr); + ckfree(newAppPtr); newAppPtr = nextPtr; } @@ -618,12 +503,12 @@ TestobjconfigObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *options[] = { - "alltypes", "chain1", "chain2", "configerror", "delete", "info", + static const char *const options[] = { + "alltypes", "chain1", "chain2", "chain3", "configerror", "delete", "info", "internal", "new", "notenoughparams", "twowindows", NULL }; enum { - ALL_TYPES, CHAIN1, CHAIN2, CONFIG_ERROR, + ALL_TYPES, CHAIN1, CHAIN2, CHAIN3, CONFIG_ERROR, DEL, /* Can't use DELETE: VC++ compiler barfs. */ INFO, INTERNAL, NEW, NOT_ENOUGH_PARAMS, TWO_WINDOWS }; @@ -637,7 +522,7 @@ TestobjconfigObjCmd( CustomOptionGet, CustomOptionRestore, CustomOptionFree, - (ClientData) 1 + INT2PTR(1) }; Tk_Window mainWin = (Tk_Window) clientData; Tk_Window tkwin; @@ -658,10 +543,10 @@ TestobjconfigObjCmd( } ExtensionWidgetRecord; static const Tk_OptionSpec baseSpecs[] = { {TK_OPTION_STRING, "-one", "one", "One", "one", - Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1}, + Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1, 0, NULL, 0}, {TK_OPTION_STRING, "-two", "two", "Two", "two", - Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1}, - {TK_OPTION_END} + Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; if (objc < 2) { @@ -669,8 +554,8 @@ TestobjconfigObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "command", 0, &index)!= TCL_OK) { return TCL_ERROR; } @@ -697,7 +582,7 @@ TestobjconfigObjCmd( Tcl_Obj *customPtr; } TypesRecord; TypesRecord *recordPtr; - static const char *stringTable[] = { + static const char *const stringTable[] = { "one", "two", "three", "four", NULL }; static const Tk_OptionSpec typesSpecs[] = { @@ -713,10 +598,10 @@ TestobjconfigObjCmd( {TK_OPTION_STRING_TABLE, "-stringtable", "StringTable", "stringTable", "one", Tk_Offset(TypesRecord, stringTablePtr), -1, - TK_CONFIG_NULL_OK, (ClientData) stringTable, 0x10}, + TK_CONFIG_NULL_OK, stringTable, 0x10}, {TK_OPTION_COLOR, "-color", "color", "Color", "red", Tk_Offset(TypesRecord, colorPtr), -1, - TK_CONFIG_NULL_OK, (ClientData) "black", 0x20}, + TK_CONFIG_NULL_OK, "black", 0x20}, {TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12", Tk_Offset(TypesRecord, fontPtr), -1, TK_CONFIG_NULL_OK, 0, 0x40}, @@ -725,7 +610,7 @@ TestobjconfigObjCmd( TK_CONFIG_NULL_OK, 0, 0x80}, {TK_OPTION_BORDER, "-border", "border", "Border", "blue", Tk_Offset(TypesRecord, borderPtr), -1, - TK_CONFIG_NULL_OK, (ClientData) "white", 0x100}, + TK_CONFIG_NULL_OK, "white", 0x100}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", "raised", Tk_Offset(TypesRecord, reliefPtr), -1, TK_CONFIG_NULL_OK, 0, 0x200}, @@ -743,10 +628,10 @@ TestobjconfigObjCmd( TK_CONFIG_NULL_OK, 0, 0x2000}, {TK_OPTION_CUSTOM, "-custom", NULL, NULL, "", Tk_Offset(TypesRecord, customPtr), -1, - TK_CONFIG_NULL_OK, (ClientData)&CustomOption, 0x4000}, + TK_CONFIG_NULL_OK, &CustomOption, 0x4000}, {TK_OPTION_SYNONYM, "-synonym", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-color", 0x8000}, - {TK_OPTION_END} + NULL, 0, -1, 0, "-color", 0x8000}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; Tk_OptionTable optionTable; Tk_Window tkwin; @@ -760,7 +645,7 @@ TestobjconfigObjCmd( } Tk_SetClass(tkwin, "Test"); - recordPtr = (TypesRecord *) ckalloc(sizeof(TypesRecord)); + recordPtr = ckalloc(sizeof(TypesRecord)); recordPtr->header.interp = interp; recordPtr->header.optionTable = optionTable; recordPtr->header.tkwin = tkwin; @@ -795,7 +680,7 @@ TestobjconfigObjCmd( } } else { Tk_DestroyWindow(tkwin); - ckfree((char *) recordPtr); + ckfree(recordPtr); } if (result == TCL_OK) { Tcl_SetObjResult(interp, objv[2]); @@ -817,8 +702,7 @@ TestobjconfigObjCmd( optionTable = Tk_CreateOptionTable(interp, baseSpecs); tables[index] = optionTable; - recordPtr = (ExtensionWidgetRecord *) - ckalloc(sizeof(ExtensionWidgetRecord)); + recordPtr = ckalloc(sizeof(ExtensionWidgetRecord)); recordPtr->header.interp = interp; recordPtr->header.optionTable = optionTable; recordPtr->header.tkwin = tkwin; @@ -843,20 +727,21 @@ TestobjconfigObjCmd( break; } - case CHAIN2: { + case CHAIN2: + case CHAIN3: { ExtensionWidgetRecord *recordPtr; static const Tk_OptionSpec extensionSpecs[] = { {TK_OPTION_STRING, "-three", "three", "Three", "three", - Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1}, + Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1, 0, NULL, 0}, {TK_OPTION_STRING, "-four", "four", "Four", "four", - Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1}, + Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1, 0, NULL, 0}, {TK_OPTION_STRING, "-two", "two", "Two", "two and a half", - Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1}, + Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1, 0, NULL, 0}, {TK_OPTION_STRING, "-oneAgain", "oneAgain", "OneAgain", "one again", - Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr), -1}, + Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr), -1, 0, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, -1, 0, - (ClientData) baseSpecs} + (ClientData) baseSpecs, 0} }; Tk_Window tkwin; Tk_OptionTable optionTable; @@ -870,8 +755,7 @@ TestobjconfigObjCmd( optionTable = Tk_CreateOptionTable(interp, extensionSpecs); tables[index] = optionTable; - recordPtr = (ExtensionWidgetRecord *) ckalloc( - sizeof(ExtensionWidgetRecord)); + recordPtr = ckalloc(sizeof(ExtensionWidgetRecord)); recordPtr->header.interp = interp; recordPtr->header.optionTable = optionTable; recordPtr->header.tkwin = tkwin; @@ -904,8 +788,8 @@ TestobjconfigObjCmd( ErrorWidgetRecord widgetRecord; static const Tk_OptionSpec errorSpecs[] = { {TK_OPTION_INT, "-int", "integer", "Integer", "bogus", - Tk_Offset(ErrorWidgetRecord, intPtr)}, - {TK_OPTION_END} + Tk_Offset(ErrorWidgetRecord, intPtr), 0, 0, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; Tk_OptionTable optionTable; @@ -921,12 +805,15 @@ TestobjconfigObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "tableName"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], options, + sizeof(char *), "table", 0, &index) != TCL_OK) { return TCL_ERROR; } if (tables[index] != NULL) { Tk_DeleteOptionTable(tables[index]); + /* Make sure that Tk_DeleteOptionTable() is never done + * twice for the same table. */ + tables[index] = NULL; } break; @@ -935,8 +822,8 @@ TestobjconfigObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "tableName"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], options, + sizeof(char *), "table", 0, &index) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index])); @@ -986,10 +873,10 @@ TestobjconfigObjCmd( {TK_OPTION_STRING_TABLE, "-stringtable", "StringTable", "stringTable", "one", -1, Tk_Offset(InternalRecord, index), - TK_CONFIG_NULL_OK, (ClientData) internalStringTable, 0x10}, + TK_CONFIG_NULL_OK, internalStringTable, 0x10}, {TK_OPTION_COLOR, "-color", "color", "Color", "red", -1, Tk_Offset(InternalRecord, colorPtr), - TK_CONFIG_NULL_OK, (ClientData) "black", 0x20}, + TK_CONFIG_NULL_OK, "black", 0x20}, {TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12", -1, Tk_Offset(InternalRecord, tkfont), TK_CONFIG_NULL_OK, 0, 0x40}, @@ -998,7 +885,7 @@ TestobjconfigObjCmd( TK_CONFIG_NULL_OK, 0, 0x80}, {TK_OPTION_BORDER, "-border", "border", "Border", "blue", -1, Tk_Offset(InternalRecord, border), - TK_CONFIG_NULL_OK, (ClientData) "white", 0x100}, + TK_CONFIG_NULL_OK, "white", 0x100}, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", "raised", -1, Tk_Offset(InternalRecord, relief), TK_CONFIG_NULL_OK, 0, 0x200}, @@ -1019,10 +906,10 @@ TestobjconfigObjCmd( TK_CONFIG_NULL_OK, 0, 0}, {TK_OPTION_CUSTOM, "-custom", NULL, NULL, "", -1, Tk_Offset(InternalRecord, custom), - TK_CONFIG_NULL_OK, (ClientData)&CustomOption, 0x4000}, + TK_CONFIG_NULL_OK, &CustomOption, 0x4000}, {TK_OPTION_SYNONYM, "-synonym", NULL, NULL, - NULL, -1, -1, 0, (ClientData) "-color", 0x8000}, - {TK_OPTION_END} + NULL, -1, -1, 0, "-color", 0x8000}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; Tk_OptionTable optionTable; Tk_Window tkwin; @@ -1036,7 +923,7 @@ TestobjconfigObjCmd( } Tk_SetClass(tkwin, "Test"); - recordPtr = (InternalRecord *) ckalloc(sizeof(InternalRecord)); + recordPtr = ckalloc(sizeof(InternalRecord)); recordPtr->header.interp = interp; recordPtr->header.optionTable = optionTable; recordPtr->header.tkwin = tkwin; @@ -1062,9 +949,9 @@ TestobjconfigObjCmd( if (result == TCL_OK) { recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, Tcl_GetString(objv[2]), TrivialConfigObjCmd, - (ClientData) recordPtr, TrivialCmdDeletedProc); + recordPtr, TrivialCmdDeletedProc); Tk_CreateEventHandler(tkwin, StructureNotifyMask, - TrivialEventProc, (ClientData) recordPtr); + TrivialEventProc, recordPtr); result = Tk_SetOptions(interp, (char *) recordPtr, optionTable, objc - 3, objv + 3, tkwin, NULL, NULL); if (result != TCL_OK) { @@ -1072,7 +959,7 @@ TestobjconfigObjCmd( } } else { Tk_DestroyWindow(tkwin); - ckfree((char *) recordPtr); + ckfree(recordPtr); } if (result == TCL_OK) { Tcl_SetObjResult(interp, objv[2]); @@ -1092,24 +979,24 @@ TestobjconfigObjCmd( FiveRecord *recordPtr; static const Tk_OptionSpec smallSpecs[] = { {TK_OPTION_INT, "-one", "one", "One", "1", - Tk_Offset(FiveRecord, one), -1}, + Tk_Offset(FiveRecord, one), -1, 0, NULL, 0}, {TK_OPTION_INT, "-two", "two", "Two", "2", - Tk_Offset(FiveRecord, two), -1}, + Tk_Offset(FiveRecord, two), -1, 0, NULL, 0}, {TK_OPTION_INT, "-three", "three", "Three", "3", - Tk_Offset(FiveRecord, three), -1}, + Tk_Offset(FiveRecord, three), -1, 0, NULL, 0}, {TK_OPTION_INT, "-four", "four", "Four", "4", - Tk_Offset(FiveRecord, four), -1}, + Tk_Offset(FiveRecord, four), -1, 0, NULL, 0}, {TK_OPTION_STRING, "-five", NULL, NULL, NULL, - Tk_Offset(FiveRecord, five), -1}, - {TK_OPTION_END} + Tk_Offset(FiveRecord, five), -1, 0, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "new name ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "new name ?-option value ...?"); return TCL_ERROR; } - recordPtr = (FiveRecord *) ckalloc(sizeof(FiveRecord)); + recordPtr = ckalloc(sizeof(FiveRecord)); recordPtr->header.interp = interp; recordPtr->header.optionTable = Tk_CreateOptionTable(interp, smallSpecs); @@ -1134,7 +1021,7 @@ TestobjconfigObjCmd( } } if (result != TCL_OK) { - ckfree((char *) recordPtr); + ckfree(recordPtr); } break; @@ -1146,8 +1033,8 @@ TestobjconfigObjCmd( NotEnoughRecord record; static const Tk_OptionSpec errorSpecs[] = { {TK_OPTION_INT, "-foo", "foo", "Foo", "0", - Tk_Offset(NotEnoughRecord, fooObjPtr)}, - {TK_OPTION_END} + Tk_Offset(NotEnoughRecord, fooObjPtr), 0, 0, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; Tcl_Obj *newObjPtr = Tcl_NewStringObj("-foo", -1); Tk_OptionTable optionTable; @@ -1177,8 +1064,8 @@ TestobjconfigObjCmd( SlaveRecord *recordPtr; static const Tk_OptionSpec slaveSpecs[] = { {TK_OPTION_WINDOW, "-window", "window", "Window", ".bar", - Tk_Offset(SlaveRecord, windowPtr), -1, TK_CONFIG_NULL_OK}, - {TK_OPTION_END} + Tk_Offset(SlaveRecord, windowPtr), -1, TK_CONFIG_NULL_OK, NULL, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; Tk_Window tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, Tcl_GetString(objv[2]), NULL); @@ -1188,7 +1075,7 @@ TestobjconfigObjCmd( } Tk_SetClass(tkwin, "Test"); - recordPtr = (SlaveRecord *) ckalloc(sizeof(SlaveRecord)); + recordPtr = ckalloc(sizeof(SlaveRecord)); recordPtr->header.interp = interp; recordPtr->header.optionTable = Tk_CreateOptionTable(interp, slaveSpecs); @@ -1205,9 +1092,9 @@ TestobjconfigObjCmd( if (result == TCL_OK) { recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, Tcl_GetString(objv[2]), TrivialConfigObjCmd, - (ClientData) recordPtr, TrivialCmdDeletedProc); + recordPtr, TrivialCmdDeletedProc); Tk_CreateEventHandler(tkwin, StructureNotifyMask, - TrivialEventProc, (ClientData) recordPtr); + TrivialEventProc, recordPtr); Tcl_SetObjResult(interp, objv[2]); } else { Tk_FreeConfigOptions((char *) recordPtr, @@ -1216,7 +1103,7 @@ TestobjconfigObjCmd( } if (result != TCL_OK) { Tk_DestroyWindow(tkwin); - ckfree((char *) recordPtr); + ckfree(recordPtr); } } } @@ -1250,7 +1137,7 @@ TrivialConfigObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int result = TCL_OK; - static const char *options[] = { + static const char *const options[] = { "cget", "configure", "csave", NULL }; enum { @@ -1267,8 +1154,8 @@ TrivialConfigObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "command", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1312,7 +1199,7 @@ TrivialConfigObjCmd( headerPtr->optionTable, objc - 2, objv + 2, tkwin, NULL, &mask); if (result == TCL_OK) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), mask); + Tcl_SetObjResult(interp, Tcl_NewIntObj(mask)); } } break; @@ -1322,7 +1209,7 @@ TrivialConfigObjCmd( tkwin, &saved, &mask); Tk_FreeSavedOptions(&saved); if (result == TCL_OK) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), mask); + Tcl_SetObjResult(interp, Tcl_NewIntObj(mask)); } break; } @@ -1432,7 +1319,7 @@ TestfontObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *options[] = {"counts", "subfonts", NULL}; + static const char *const options[] = {"counts", "subfonts", NULL}; enum option {COUNTS, SUBFONTS}; int index; Tk_Window tkwin; @@ -1445,8 +1332,8 @@ TestfontObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "command", 0, &index)!= TCL_OK) { return TCL_ERROR; } @@ -1489,18 +1376,18 @@ static int ImageCreate( Tcl_Interp *interp, /* Interpreter for application containing * image. */ - char *name, /* Name to use for image. */ + const char *name, /* Name to use for image. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument strings for options (doesn't * include image name or type). */ - Tk_ImageType *typePtr, /* Pointer to our type record (not used). */ + const Tk_ImageType *typePtr, /* Pointer to our type record (not used). */ Tk_ImageMaster master, /* Token for image, to be used by us in later * callbacks. */ ClientData *clientDataPtr) /* Store manager's token for image here; it * will be returned in later callbacks. */ { TImageMaster *timPtr; - char *varName; + const char *varName; int i; varName = "log"; @@ -1518,17 +1405,17 @@ ImageCreate( varName = Tcl_GetString(objv[i+1]); } - timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster)); + timPtr = ckalloc(sizeof(TImageMaster)); timPtr->master = master; timPtr->interp = interp; timPtr->width = 30; timPtr->height = 15; - timPtr->imageName = (char *) ckalloc((unsigned) (strlen(name) + 1)); + timPtr->imageName = ckalloc(strlen(name) + 1); strcpy(timPtr->imageName, name); - timPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1)); + timPtr->varName = ckalloc(strlen(varName) + 1); strcpy(timPtr->varName, varName); - Tcl_CreateCommand(interp, name, ImageCmd, (ClientData) timPtr, NULL); - *clientDataPtr = (ClientData) timPtr; + Tcl_CreateObjCommand(interp, name, ImageObjCmd, timPtr, NULL); + *clientDataPtr = timPtr; Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15); return TCL_OK; } @@ -1536,7 +1423,7 @@ ImageCreate( /* *---------------------------------------------------------------------- * - * ImageCmd -- + * ImageObjCmd -- * * This function implements the commands corresponding to individual * images. @@ -1552,38 +1439,37 @@ ImageCreate( /* ARGSUSED */ static int -ImageCmd( +ImageObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { TImageMaster *timPtr = (TImageMaster *) clientData; int x, y, width, height; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], "option ?arg arg ...?", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (strcmp(argv[1], "changed") == 0) { - if (argc != 8) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " changed x y width height imageWidth imageHeight", NULL); + if (strcmp(Tcl_GetString(objv[1]), "changed") == 0) { + if (objc != 8) { + Tcl_WrongNumArgs(interp, 1, objv, "changed x y width height" + " imageWidth imageHeight"); return TCL_ERROR; } - if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) - || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK) - || (Tcl_GetInt(interp, argv[4], &width) != TCL_OK) - || (Tcl_GetInt(interp, argv[5], &height) != TCL_OK) - || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK) - || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) { + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[4], &width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[5], &height) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[6], &timPtr->width) != TCL_OK) + || (Tcl_GetIntFromObj(interp, objv[7], &timPtr->height) != TCL_OK)) { return TCL_ERROR; } Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width, timPtr->height); } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be changed", NULL); return TCL_ERROR; } @@ -1620,15 +1506,15 @@ ImageGet( XGCValues gcValues; sprintf(buffer, "%s get", timPtr->imageName); - Tcl_SetVar(timPtr->interp, timPtr->varName, buffer, + Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); - instPtr = (TImageInstance *) ckalloc(sizeof(TImageInstance)); + instPtr = ckalloc(sizeof(TImageInstance)); instPtr->masterPtr = timPtr; instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000"); gcValues.foreground = instPtr->fg->pixel; instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues); - return (ClientData) instPtr; + return instPtr; } /* @@ -1667,8 +1553,8 @@ ImageDisplay( sprintf(buffer, "%s display %d %d %d %d %d %d", instPtr->masterPtr->imageName, imageX, imageY, width, height, drawableX, drawableY); - Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer, - TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL, + buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); if (width > (instPtr->masterPtr->width - imageX)) { width = instPtr->masterPtr->width - imageX; } @@ -1710,11 +1596,11 @@ ImageFree( char buffer[200]; sprintf(buffer, "%s free", instPtr->masterPtr->imageName); - Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer, - TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); + Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL, + buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); Tk_FreeColor(instPtr->fg); Tk_FreeGC(display, instPtr->gc); - ckfree((char *) instPtr); + ckfree(instPtr); } /* @@ -1744,19 +1630,19 @@ ImageDelete( char buffer[100]; sprintf(buffer, "%s delete", timPtr->imageName); - Tcl_SetVar(timPtr->interp, timPtr->varName, buffer, + Tcl_SetVar2(timPtr->interp, timPtr->varName, NULL, buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); Tcl_DeleteCommand(timPtr->interp, timPtr->imageName); ckfree(timPtr->imageName); ckfree(timPtr->varName); - ckfree((char *) timPtr); + ckfree(timPtr); } /* *---------------------------------------------------------------------- * - * TestmakeexistCmd -- + * TestmakeexistObjCmd -- * * This function implements the "testmakeexist" command. It calls * Tk_MakeWindowExist on each of its arguments to force the windows to be @@ -1773,18 +1659,18 @@ ImageDelete( /* ARGSUSED */ static int -TestmakeexistCmd( +TestmakeexistObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { Tk_Window mainWin = (Tk_Window) clientData; int i; Tk_Window tkwin; - for (i = 1; i < argc; i++) { - tkwin = Tk_NameToWindow(interp, argv[i], mainWin); + for (i = 1; i < objc; i++) { + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), mainWin); if (tkwin == NULL) { return TCL_ERROR; } @@ -1797,7 +1683,7 @@ TestmakeexistCmd( /* *---------------------------------------------------------------------- * - * TestmenubarCmd -- + * TestmenubarObjCmd -- * * This function implements the "testmenubar" command. It is used to test * the Unix facilities for creating space above a toplevel window for a @@ -1813,53 +1699,50 @@ TestmakeexistCmd( */ /* ARGSUSED */ -#if !(defined(__WIN32__) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) +#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) static int -TestmenubarCmd( +TestmenubarObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { #ifdef __UNIX__ Tk_Window mainWin = (Tk_Window) clientData; Tk_Window tkwin, menubar; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option ?arg ...?\"", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (strcmp(argv[1], "window") == 0) { - if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - "window toplevel menubar\"", NULL); + if (strcmp(Tcl_GetString(objv[1]), "window") == 0) { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "windows toplevel menubar"); return TCL_ERROR; } - tkwin = Tk_NameToWindow(interp, argv[2], mainWin); + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainWin); if (tkwin == NULL) { return TCL_ERROR; } - if (argv[3][0] == 0) { + if (Tcl_GetString(objv[3])[0] == 0) { TkUnixSetMenubar(tkwin, NULL); } else { - menubar = Tk_NameToWindow(interp, argv[3], mainWin); + menubar = Tk_NameToWindow(interp, Tcl_GetString(objv[3]), mainWin); if (menubar == NULL) { return TCL_ERROR; } TkUnixSetMenubar(tkwin, menubar); } } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be window", NULL); return TCL_ERROR; } return TCL_OK; #else - Tcl_SetResult(interp, "testmenubar is supported only under Unix", - TCL_STATIC); + Tcl_AppendResult(interp, "testmenubar is supported only under Unix", NULL); return TCL_ERROR; #endif } @@ -1868,7 +1751,7 @@ TestmenubarCmd( /* *---------------------------------------------------------------------- * - * TestmetricsCmd -- + * TestmetricsObjCmd -- * * This function implements the testmetrics command. It provides a way to * determine the size of various widget components. @@ -1882,53 +1765,51 @@ TestmenubarCmd( *---------------------------------------------------------------------- */ -#if defined(__WIN32__) || defined(MAC_OSX_TK) +#if defined(_WIN32) || defined(MAC_OSX_TK) static int -TestmetricsCmd( +TestmetricsObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { char buf[TCL_INTEGER_SPACE]; int val; -#ifdef __WIN32__ - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option ?arg ...?\"", NULL); +#ifdef _WIN32 + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } #else Tk_Window tkwin = (Tk_Window) clientData; TkWindow *winPtr; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option window\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "option window"); return TCL_ERROR; } - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin); + winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); if (winPtr == NULL) { return TCL_ERROR; } #endif - if (strcmp(argv[1], "cyvscroll") == 0) { -#ifdef __WIN32__ + if (strcmp(Tcl_GetString(objv[1]), "cyvscroll") == 0) { +#ifdef _WIN32 val = GetSystemMetrics(SM_CYVSCROLL); #else val = ((TkScrollbar *) winPtr->instanceData)->width; #endif - } else if (strcmp(argv[1], "cxhscroll") == 0) { -#ifdef __WIN32__ + } else if (strcmp(Tcl_GetString(objv[1]), "cxhscroll") == 0) { +#ifdef _WIN32 val = GetSystemMetrics(SM_CXHSCROLL); #else val = ((TkScrollbar *) winPtr->instanceData)->width; #endif } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be cxhscroll or cyvscroll", NULL); return TCL_ERROR; } @@ -1941,7 +1822,7 @@ TestmetricsCmd( /* *---------------------------------------------------------------------- * - * TestpropCmd -- + * TestpropObjCmd -- * * This function implements the "testprop" command. It fetches and prints * the value of a property on a window. @@ -1957,11 +1838,11 @@ TestmetricsCmd( /* ARGSUSED */ static int -TestpropCmd( +TestpropObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { Tk_Window mainWin = (Tk_Window) clientData; int result, actualFormat; @@ -1972,14 +1853,13 @@ TestpropCmd( Window w; char buffer[30]; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " window property\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "window property"); return TCL_ERROR; } - w = strtoul(argv[1], &end, 0); - propName = Tk_InternAtom(mainWin, argv[2]); + w = strtoul(Tcl_GetString(objv[1]), &end, 0); + propName = Tk_InternAtom(mainWin, Tcl_GetString(objv[2])); property = NULL; result = XGetWindowProperty(Tk_Display(mainWin), w, propName, 0, 100000, False, AnyPropertyType, @@ -1992,7 +1872,7 @@ TestpropCmd( *p = '\n'; } } - Tcl_SetResult(interp, (/*!unsigned*/char*)property, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj((/*!unsigned*/char*)property, -1)); } else { for (p = property; length > 0; length--) { if (actualFormat == 32) { @@ -2016,11 +1896,11 @@ TestpropCmd( return TCL_OK; } -#if !(defined(__WIN32__) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) +#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) /* *---------------------------------------------------------------------- * - * TestwrapperCmd -- + * TestwrapperObjCmd -- * * This function implements the "testwrapper" command. It provides a way * from Tcl to determine the extra window Tk adds in between the toplevel @@ -2037,23 +1917,22 @@ TestpropCmd( /* ARGSUSED */ static int -TestwrapperCmd( +TestwrapperObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { TkWindow *winPtr, *wrapperPtr; Tk_Window tkwin; - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " window\"", NULL); + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "window"); return TCL_ERROR; } tkwin = (Tk_Window) clientData; - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin); + winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[1]), tkwin); if (winPtr == NULL) { return TCL_ERROR; } @@ -2063,7 +1942,7 @@ TestwrapperCmd( char buf[TCL_INTEGER_SPACE]; TkpPrintWindowId(buf, Tk_WindowId(wrapperPtr)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); } return TCL_OK; } @@ -2106,7 +1985,7 @@ CustomOptionSet( char *saveInternalPtr, int flags) { - int objEmpty, length; + int objEmpty; char *newStr, *string, *internalPtr; objEmpty = 0; @@ -2123,28 +2002,28 @@ CustomOptionSet( if (value == NULL) { objEmpty = 1; + CLANG_ASSERT(value); } else if ((*value)->bytes != NULL) { objEmpty = ((*value)->length == 0); } else { - Tcl_GetStringFromObj((*value), &length); - objEmpty = (length == 0); + (void)Tcl_GetString(*value); + objEmpty = ((*value)->length == 0); } if ((flags & TK_OPTION_NULL_OK) && objEmpty) { *value = NULL; } else { - string = Tcl_GetStringFromObj((*value), &length); + string = Tcl_GetString(*value); Tcl_UtfToUpper(string); if (strcmp(string, "BAD") == 0) { - Tcl_SetResult(interp, "expected good value, got \"BAD\"", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("expected good value, got \"BAD\"", -1)); return TCL_ERROR; } } if (internalPtr != NULL) { - if ((*value) != NULL) { - string = Tcl_GetStringFromObj((*value), &length); - newStr = ckalloc((size_t) (length + 1)); + if (*value != NULL) { + string = Tcl_GetString(*value); + newStr = ckalloc((*value)->length + 1); strcpy(newStr, string); } else { newStr = NULL; diff --git a/generic/tkText.c b/generic/tkText.c index 6e982b0..4edf652 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -73,6 +73,16 @@ static const char *const tabStyleStrings[] = { }; /* + * The 'TkTextInsertUnfocussed' enum in tkText.h is used to define a type for + * the -insertunfocussed option of the Text widget. These values are used as + * indice into the string table below. + */ + +static const char *const insertUnfocussedStrings[] = { + "hollow", "none", "solid", NULL +}; + +/* * The following functions and custom option type are used to define the * "line" option type, and thereby handle the text widget '-startline', * '-endline' configuration options which are of that type. @@ -115,12 +125,12 @@ static const Tk_OptionSpec optionSpecs[] = { Tk_Offset(TkText, autoSeparators), 0, 0, 0}, {TK_OPTION_BORDER, "-background", "background", "Background", DEF_TEXT_BG_COLOR, -1, Tk_Offset(TkText, border), - 0, (ClientData) DEF_TEXT_BG_MONO, 0}, + 0, DEF_TEXT_BG_MONO, 0}, {TK_OPTION_SYNONYM, "-bd", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-borderwidth", + NULL, 0, -1, 0, "-borderwidth", TK_TEXT_LINE_GEOMETRY}, {TK_OPTION_SYNONYM, "-bg", NULL, NULL, - NULL, 0, -1, 0, (ClientData) "-background", 0}, + NULL, 0, -1, 0, "-background", 0}, {TK_OPTION_BOOLEAN, "-blockcursor", "blockCursor", "BlockCursor", DEF_TEXT_BLOCK_CURSOR, -1, Tk_Offset(TkText, insertCursorType), 0, 0, 0}, @@ -132,12 +142,12 @@ static const Tk_OptionSpec optionSpecs[] = { TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_CUSTOM, "-endline", NULL, NULL, NULL, -1, Tk_Offset(TkText, end), TK_OPTION_NULL_OK, - (ClientData) &lineOption, TK_TEXT_LINE_RANGE}, + &lineOption, TK_TEXT_LINE_RANGE}, {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection", "ExportSelection", DEF_TEXT_EXPORT_SELECTION, -1, Tk_Offset(TkText, exportSelection), 0, 0, 0}, {TK_OPTION_SYNONYM, "-fg", "foreground", NULL, - NULL, 0, -1, 0, (ClientData) "-foreground", 0}, + NULL, 0, -1, 0, "-foreground", 0}, {TK_OPTION_FONT, "-font", "font", "Font", DEF_TEXT_FONT, -1, Tk_Offset(TkText, tkfont), 0, 0, TK_TEXT_LINE_GEOMETRY}, @@ -160,7 +170,7 @@ static const Tk_OptionSpec optionSpecs[] = { "Foreground", DEF_TEXT_INACTIVE_SELECT_COLOR, -1, Tk_Offset(TkText, inactiveSelBorder), - TK_OPTION_NULL_OK, (ClientData) DEF_TEXT_SELECT_MONO, 0}, + TK_OPTION_NULL_OK, DEF_TEXT_SELECT_MONO, 0}, {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground", DEF_TEXT_INSERT_BG, -1, Tk_Offset(TkText, insertBorder), @@ -175,6 +185,10 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime", DEF_TEXT_INSERT_ON_TIME, -1, Tk_Offset(TkText, insertOnTime), 0, 0, 0}, + {TK_OPTION_STRING_TABLE, + "-insertunfocussed", "insertUnfocussed", "InsertUnfocussed", + DEF_TEXT_INSERT_UNFOCUSSED, -1, Tk_Offset(TkText, insertUnfocussed), + 0, insertUnfocussedStrings, 0}, {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", DEF_TEXT_INSERT_WIDTH, -1, Tk_Offset(TkText, insertWidth), 0, 0, 0}, @@ -189,15 +203,15 @@ static const Tk_OptionSpec optionSpecs[] = { DEF_TEXT_RELIEF, -1, Tk_Offset(TkText, relief), 0, 0, 0}, {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground", DEF_TEXT_SELECT_COLOR, -1, Tk_Offset(TkText, selBorder), - 0, (ClientData) DEF_TEXT_SELECT_MONO, 0}, + 0, DEF_TEXT_SELECT_MONO, 0}, {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth", DEF_TEXT_SELECT_BD_COLOR, Tk_Offset(TkText, selBorderWidthPtr), Tk_Offset(TkText, selBorderWidth), - TK_OPTION_NULL_OK, (ClientData) DEF_TEXT_SELECT_BD_MONO, 0}, + TK_OPTION_NULL_OK, DEF_TEXT_SELECT_BD_MONO, 0}, {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background", DEF_TEXT_SELECT_FG_COLOR, -1, Tk_Offset(TkText, selFgColorPtr), - TK_CONFIG_NULL_OK, (ClientData) DEF_TEXT_SELECT_FG_MONO, 0}, + TK_CONFIG_NULL_OK, DEF_TEXT_SELECT_FG_MONO, 0}, {TK_OPTION_BOOLEAN, "-setgrid", "setGrid", "SetGrid", DEF_TEXT_SET_GRID, -1, Tk_Offset(TkText, setGrid), 0, 0, 0}, {TK_OPTION_PIXELS, "-spacing1", "spacing1", "Spacing", @@ -211,16 +225,16 @@ static const Tk_OptionSpec optionSpecs[] = { TK_OPTION_DONT_SET_DEFAULT, 0 , TK_TEXT_LINE_GEOMETRY }, {TK_OPTION_CUSTOM, "-startline", NULL, NULL, NULL, -1, Tk_Offset(TkText, start), TK_OPTION_NULL_OK, - (ClientData) &lineOption, TK_TEXT_LINE_RANGE}, + &lineOption, TK_TEXT_LINE_RANGE}, {TK_OPTION_STRING_TABLE, "-state", "state", "State", DEF_TEXT_STATE, -1, Tk_Offset(TkText, state), - 0, (ClientData) stateStrings, 0}, + 0, stateStrings, 0}, {TK_OPTION_STRING, "-tabs", "tabs", "Tabs", DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionPtr), -1, TK_OPTION_NULL_OK, 0, TK_TEXT_LINE_GEOMETRY}, {TK_OPTION_STRING_TABLE, "-tabstyle", "tabStyle", "TabStyle", DEF_TEXT_TABSTYLE, -1, Tk_Offset(TkText, tabStyle), - 0, (ClientData) tabStyleStrings, TK_TEXT_LINE_GEOMETRY}, + 0, tabStyleStrings, TK_TEXT_LINE_GEOMETRY}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_TEXT_TAKE_FOCUS, -1, Tk_Offset(TkText, takeFocus), TK_OPTION_NULL_OK, 0, 0}, @@ -231,7 +245,7 @@ static const Tk_OptionSpec optionSpecs[] = { TK_TEXT_LINE_GEOMETRY}, {TK_OPTION_STRING_TABLE, "-wrap", "wrap", "Wrap", DEF_TEXT_WRAP, -1, Tk_Offset(TkText, wrapMode), - 0, (ClientData) wrapStrings, TK_TEXT_LINE_GEOMETRY}, + 0, wrapStrings, TK_TEXT_LINE_GEOMETRY}, {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", DEF_TEXT_XSCROLL_COMMAND, -1, Tk_Offset(TkText, xScrollCmd), TK_OPTION_NULL_OK, 0, 0}, @@ -412,7 +426,7 @@ static SearchLineIndexProc TextSearchGetLineIndex; * can be invoked from generic window code. */ -static Tk_ClassProcs textClass = { +static const Tk_ClassProcs textClass = { sizeof(Tk_ClassProcs), /* size */ TextWorldChangedCallback, /* worldChangedProc */ NULL, /* createProc */ @@ -443,10 +457,10 @@ Tk_TextObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; + Tk_Window tkwin = clientData; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } @@ -505,7 +519,7 @@ CreateWidget( * and 'insert', 'current' mark pointers are all NULL to start. */ - textPtr = (TkText *) ckalloc(sizeof(TkText)); + textPtr = ckalloc(sizeof(TkText)); memset(textPtr, 0, sizeof(TkText)); textPtr->tkwin = newWin; @@ -513,10 +527,10 @@ CreateWidget( textPtr->interp = interp; textPtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(textPtr->tkwin), TextWidgetObjCmd, - (ClientData) textPtr, TextCmdDeletedProc); + textPtr, TextCmdDeletedProc); if (sharedPtr == NULL) { - sharedPtr = (TkSharedText *) ckalloc(sizeof(TkSharedText)); + sharedPtr = ckalloc(sizeof(TkSharedText)); memset(sharedPtr, 0, sizeof(TkSharedText)); sharedPtr->refCount = 0; @@ -614,7 +628,7 @@ CreateWidget( */ textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel", NULL); - textPtr->selTagPtr->reliefString = (char *) + textPtr->selTagPtr->reliefString = ckalloc(sizeof(DEF_TEXT_SELECT_RELIEF)); strcpy(textPtr->selTagPtr->reliefString, DEF_TEXT_SELECT_RELIEF); Tk_GetRelief(interp, DEF_TEXT_SELECT_RELIEF, &textPtr->selTagPtr->relief); @@ -629,18 +643,18 @@ CreateWidget( optionTable = Tk_CreateOptionTable(interp, optionSpecs); Tk_SetClass(textPtr->tkwin, "Text"); - Tk_SetClassProcs(textPtr->tkwin, &textClass, (ClientData) textPtr); + Tk_SetClassProcs(textPtr->tkwin, &textClass, textPtr); textPtr->optionTable = optionTable; Tk_CreateEventHandler(textPtr->tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - TextEventProc, (ClientData) textPtr); + TextEventProc, textPtr); Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask |ButtonPressMask|ButtonReleaseMask|EnterWindowMask |LeaveWindowMask|PointerMotionMask|VirtualEventMask, - TkTextBindProc, (ClientData) textPtr); + TkTextBindProc, textPtr); Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING, - TextFetchSelection, (ClientData) textPtr, XA_STRING); + TextFetchSelection, textPtr, XA_STRING); if (Tk_InitOptions(interp, (char *) textPtr, optionTable, textPtr->tkwin) != TCL_OK) { @@ -652,8 +666,7 @@ CreateWidget( return TCL_ERROR; } - Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tk_PathName(textPtr->tkwin),-1)); + Tcl_SetObjResult(interp, TkNewWindowObj(textPtr->tkwin)); return TCL_OK; } @@ -682,11 +695,11 @@ TextWidgetObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register TkText *textPtr = (TkText *) clientData; + register TkText *textPtr = clientData; int result = TCL_OK; int index; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "bbox", "cget", "compare", "configure", "count", "debug", "delete", "dlineinfo", "dump", "edit", "get", "image", "index", "insert", "mark", "peer", "replace", "scan", "search", "see", "tag", "window", @@ -701,12 +714,12 @@ TextWidgetObjCmd( }; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } textPtr->refCount++; @@ -747,13 +760,13 @@ TextWidgetObjCmd( } else { Tcl_Obj *objPtr = Tk_GetOptionValue(interp, (char *) textPtr, textPtr->optionTable, objv[2], textPtr->tkwin); + if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); - result = TCL_OK; } + Tcl_SetObjResult(interp, objPtr); + result = TCL_OK; } break; case TEXT_COMPARE: { @@ -779,12 +792,7 @@ TextWidgetObjCmd( if ((p[1] == '=') && (p[2] == 0)) { value = (relation <= 0); } else if (p[1] != 0) { - compareError: - Tcl_AppendResult(interp, "bad comparison operator \"", - Tcl_GetString(objv[3]), - "\": must be <, <=, ==, >=, >, or !=", NULL); - result = TCL_ERROR; - goto done; + goto compareError; } } else if (p[0] == '>') { value = (relation > 0); @@ -802,18 +810,26 @@ TextWidgetObjCmd( } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); break; + + compareError: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad comparison operator \"%s\": must be" + " <, <=, ==, >=, >, or !=", Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "COMPARISON", NULL); + result = TCL_ERROR; + goto done; } case TEXT_CONFIGURE: if (objc <= 3) { Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) textPtr, textPtr->optionTable, ((objc == 3) ? objv[2] : NULL), textPtr->tkwin); + if (objPtr == NULL) { result = TCL_ERROR; goto done; - } else { - Tcl_SetObjResult(interp, objPtr); } + Tcl_SetObjResult(interp, objPtr); } else { result = ConfigureText(interp, textPtr, objc-2, objv+2); } @@ -824,7 +840,8 @@ TextWidgetObjCmd( Tcl_Obj *objPtr = NULL; if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "?options? index1 index2"); + Tcl_WrongNumArgs(interp, 2, objv, + "?-option value ...? index1 index2"); result = TCL_ERROR; goto done; } @@ -842,19 +859,12 @@ TextWidgetObjCmd( for (i = 2; i < objc-2; i++) { int value, length; - const char *option = Tcl_GetStringFromObj(objv[i], &length); + const char *option = Tcl_GetString(objv[i]); char c; + length = objv[i]->length; if (length < 2 || option[0] != '-') { - badOption: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad option \"", - Tcl_GetString(objv[i]), - "\" must be -chars, -displaychars, -displayindices, ", - "-displaylines, -indices, -lines, -update, ", - "-xpixels, or -ypixels", NULL); - result = TCL_ERROR; - goto done; + goto badOption; } c = option[1]; if (c == 'c' && !strncmp("-chars", option, (unsigned) length)) { @@ -921,7 +931,7 @@ TextWidgetObjCmd( /* * Now we need to adjust the count to: - * - subtract off the number of display lines between + * - subtract off the number of display lines between * indexToPtr and index2, since we might have skipped past * indexToPtr, if we have several logical lines in a * single display line @@ -1033,6 +1043,15 @@ TextWidgetObjCmd( Tcl_SetObjResult(interp, objPtr); } break; + + badOption: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\" must be -chars, -displaychars, " + "-displayindices, -displaylines, -indices, -lines, -update, " + "-xpixels, or -ypixels", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_OPTION", NULL); + result = TCL_ERROR; + goto done; } case TEXT_DEBUG: if (objc > 3) { @@ -1101,8 +1120,7 @@ TextWidgetObjCmd( objc -= 2; objv += 2; - indices = (TkTextIndex *) - ckalloc((objc + 1) * sizeof(TkTextIndex)); + indices = ckalloc((objc + 1) * sizeof(TkTextIndex)); /* * First pass verifies that all indices are valid. @@ -1114,7 +1132,7 @@ TextWidgetObjCmd( if (indexPtr == NULL) { result = TCL_ERROR; - ckfree((char *) indices); + ckfree(indices); goto done; } indices[i] = *indexPtr; @@ -1130,7 +1148,7 @@ TextWidgetObjCmd( COUNT_INDICES); objc++; } - useIdx = (char *) ckalloc((unsigned) objc); + useIdx = ckalloc(objc); memset(useIdx, 0, (unsigned) objc); /* @@ -1194,7 +1212,7 @@ TextWidgetObjCmd( &indices[i+1], 1); } } - ckfree((char *) indices); + ckfree(indices); } } break; @@ -1252,12 +1270,14 @@ TextWidgetObjCmd( i = 2; if (objc > 3) { - name = Tcl_GetStringFromObj(objv[i], &length); + name = Tcl_GetString(objv[i]); + length = objv[i]->length; if (length > 1 && name[0] == '-') { - if (strncmp("-displaychars", name, (unsigned)length)==0) { + if (strncmp("-displaychars", name, (unsigned) length) == 0) { i++; visible = 1; - name = Tcl_GetStringFromObj(objv[i], &length); + name = Tcl_GetString(objv[i]); + length = objv[i]->length; } if ((i < objc-1) && (length == 2) && !strcmp("--", name)) { i++; @@ -1392,9 +1412,10 @@ TextWidgetObjCmd( goto done; } if (TkTextIndexCmp(indexFromPtr, indexToPtr) > 0) { - Tcl_AppendResult(interp, "Index \"", Tcl_GetString(objv[3]), - "\" before \"", Tcl_GetString(objv[2]), - "\" in the text", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" before \"%s\" in the text", + Tcl_GetString(objv[3]), Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL); result = TCL_ERROR; goto done; } @@ -1502,7 +1523,7 @@ TextWidgetObjCmd( done: textPtr->refCount--; if (textPtr->refCount == 0) { - ckfree((char *) textPtr); + ckfree(textPtr); } return result; } @@ -1534,11 +1555,11 @@ SharedTextObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - register TkSharedText *sharedPtr = (TkSharedText *) clientData; + register TkSharedText *sharedPtr = clientData; int result = TCL_OK; int index; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "delete", "insert", NULL }; enum options { @@ -1546,12 +1567,12 @@ SharedTextObjCmd( }; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1643,7 +1664,7 @@ TextPeerCmd( Tk_Window tkwin = textPtr->tkwin; int index; - static const char *peerOptionStrings[] = { + static const char *const peerOptionStrings[] = { "create", "names", NULL }; enum peerOptions { @@ -1651,36 +1672,40 @@ TextPeerCmd( }; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], peerOptionStrings, - "peer option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], peerOptionStrings, + sizeof(char *), "peer option", 0, &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum peerOptions)index) { + switch ((enum peerOptions) index) { case PEER_CREATE: if (objc < 4) { - Tcl_WrongNumArgs(interp, 3, objv, "pathName ?options?"); + Tcl_WrongNumArgs(interp, 3, objv, "pathName ?-option value ...?"); return TCL_ERROR; } return CreateWidget(textPtr->sharedTextPtr, tkwin, interp, textPtr, objc-2, objv+2); case PEER_NAMES: { TkText *tPtr = textPtr->sharedTextPtr->peers; + Tcl_Obj *peersObj; if (objc > 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } + peersObj = Tcl_NewObj(); while (tPtr != NULL) { if (tPtr != textPtr) { - Tcl_AppendElement(interp, Tk_PathName(tPtr->tkwin)); + Tcl_ListObjAppendElement(NULL, peersObj, + TkNewWindowObj(tPtr->tkwin)); } tPtr = tPtr->next; } + Tcl_SetObjResult(interp, peersObj); } } @@ -1877,10 +1902,10 @@ DestroyText( TkTextDeleteTag(textPtr, textPtr->selTagPtr); TkBTreeUnlinkSegment(textPtr->insertMarkPtr, textPtr->insertMarkPtr->body.mark.linePtr); - ckfree((char *) textPtr->insertMarkPtr); + ckfree(textPtr->insertMarkPtr); TkBTreeUnlinkSegment(textPtr->currentMarkPtr, textPtr->currentMarkPtr->body.mark.linePtr); - ckfree((char *) textPtr->currentMarkPtr); + ckfree(textPtr->currentMarkPtr); /* * Now we've cleaned up everything of relevance to us in the B-tree, so we @@ -1902,7 +1927,7 @@ DestroyText( for (hPtr = Tcl_FirstHashEntry(&sharedTextPtr->windowTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { TkTextEmbWindowClient *loop; - TkTextSegment *ewPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + TkTextSegment *ewPtr = Tcl_GetHashValue(hPtr); loop = ewPtr->body.ew.clients; if (loop->textPtr == textPtr) { @@ -1934,7 +1959,7 @@ DestroyText( for (hPtr = Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr); + tagPtr = Tcl_GetHashValue(hPtr); /* * No need to use 'TkTextDeleteTag' since we've already removed @@ -1946,7 +1971,7 @@ DestroyText( Tcl_DeleteHashTable(&sharedTextPtr->tagTable); for (hPtr = Tcl_FirstHashEntry(&sharedTextPtr->markTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - ckfree((char *) Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(&sharedTextPtr->markTable); TkUndoFreeStack(sharedTextPtr->undoStack); @@ -1957,11 +1982,11 @@ DestroyText( if (sharedTextPtr->bindingTable != NULL) { Tk_DeleteBindingTable(sharedTextPtr->bindingTable); } - ckfree((char *) sharedTextPtr); + ckfree(sharedTextPtr); } if (textPtr->tabArrayPtr != NULL) { - ckfree((char *) textPtr->tabArrayPtr); + ckfree(textPtr->tabArrayPtr); } if (textPtr->insertBlinkHandler != NULL) { Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler); @@ -1971,7 +1996,7 @@ DestroyText( textPtr->refCount--; Tcl_DeleteCommandFromToken(textPtr->interp, textPtr->widgetCmd); if (textPtr->refCount == 0) { - ckfree((char *) textPtr); + ckfree(textPtr); } } @@ -2051,9 +2076,9 @@ ConfigureText( end = TkBTreeNumLines(textPtr->sharedTextPtr->tree, NULL); } if (start > end) { - Tcl_AppendResult(interp, - "-startline must be less than or equal to -endline", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-startline must be less than or equal to -endline", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "INDEX_ORDER", NULL); Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } @@ -2086,6 +2111,7 @@ ConfigureText( /* Nothing tagged with "sel" */ } else { int line = TkBTreeLinesTo(NULL, search.curIndex.linePtr); + if (line < start) { selChanged = 1; } else { @@ -2158,7 +2184,7 @@ ConfigureText( */ if (textPtr->tabArrayPtr != NULL) { - ckfree((char *) textPtr->tabArrayPtr); + ckfree(textPtr->tabArrayPtr); textPtr->tabArrayPtr = NULL; } if (textPtr->tabOptionPtr != NULL) { @@ -2230,7 +2256,7 @@ ConfigureText( if (TkBTreeCharTagged(&first, textPtr->selTagPtr) || TkBTreeNextTag(&search)) { Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection, - (ClientData) textPtr); + textPtr); textPtr->flags |= GOT_SELECTION; } } @@ -2241,8 +2267,8 @@ ConfigureText( if (textPtr->flags & GOT_FOCUS) { Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler); - textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL; - TextBlinkProc((ClientData) textPtr); + textPtr->insertBlinkHandler = NULL; + TextBlinkProc(textPtr); } /* @@ -2285,9 +2311,8 @@ static void TextWorldChangedCallback( ClientData instanceData) /* Information about widget. */ { - TkText *textPtr; + TkText *textPtr = instanceData; - textPtr = (TkText *) instanceData; TextWorldChanged(textPtr, TK_TEXT_LINE_GEOMETRY); } @@ -2377,7 +2402,7 @@ TextEventProc( ClientData clientData, /* Information about window. */ register XEvent *eventPtr) /* Information about event. */ { - register TkText *textPtr = (TkText *) clientData; + register TkText *textPtr = clientData; TkTextIndex index, index2; if (eventPtr->type == Expose) { @@ -2437,12 +2462,11 @@ TextEventProc( textPtr->flags |= GOT_FOCUS | INSERT_ON; if (textPtr->insertOffTime != 0) { textPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - textPtr->insertOnTime, TextBlinkProc, - (ClientData) textPtr); + textPtr->insertOnTime, TextBlinkProc, textPtr); } } else { textPtr->flags &= ~(GOT_FOCUS | INSERT_ON); - textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL; + textPtr->insertBlinkHandler = NULL; } if (textPtr->inactiveSelBorder != textPtr->selBorder) { TkTextRedrawTag(NULL, textPtr, NULL, NULL, textPtr->selTagPtr, @@ -2487,7 +2511,7 @@ static void TextCmdDeletedProc( ClientData clientData) /* Pointer to widget record for widget. */ { - TkText *textPtr = (TkText *) clientData; + TkText *textPtr = clientData; Tk_Window tkwin = textPtr->tkwin; /* @@ -2544,9 +2568,9 @@ InsertChars( int *lineAndByteIndex; int resetViewCount; int pixels[2*PIXEL_CLIENTS]; + const char *string = Tcl_GetString(stringPtr); - const char *string = Tcl_GetStringFromObj(stringPtr, &length); - + length = stringPtr->length; if (sharedTextPtr == NULL) { sharedTextPtr = textPtr->sharedTextPtr; } @@ -2572,8 +2596,7 @@ InsertChars( resetViewCount = 0; if (sharedTextPtr->refCount > PIXEL_CLIENTS) { - lineAndByteIndex = (int *) - ckalloc(sizeof(int) * 2 * sharedTextPtr->refCount); + lineAndByteIndex = ckalloc(sizeof(int) * 2 * sharedTextPtr->refCount); } else { lineAndByteIndex = pixels; } @@ -2635,7 +2658,7 @@ InsertChars( resetViewCount += 2; } if (sharedTextPtr->refCount > PIXEL_CLIENTS) { - ckfree((char *) lineAndByteIndex); + ckfree(lineAndByteIndex); } /* @@ -2755,13 +2778,13 @@ TextPushUndoAction( * underlying data shared by all peers. */ - iAtom = TkUndoMakeSubAtom(&TextUndoRedoCallback, - (ClientData)textPtr->sharedTextPtr, insertCmdObj, NULL); + iAtom = TkUndoMakeSubAtom(&TextUndoRedoCallback, textPtr->sharedTextPtr, + insertCmdObj, NULL); TkUndoMakeCmdSubAtom(NULL, markSet2InsertObj, iAtom); TkUndoMakeCmdSubAtom(NULL, seeInsertObj, iAtom); - dAtom = TkUndoMakeSubAtom(&TextUndoRedoCallback, - (ClientData)textPtr->sharedTextPtr, deleteCmdObj, NULL); + dAtom = TkUndoMakeSubAtom(&TextUndoRedoCallback, textPtr->sharedTextPtr, + deleteCmdObj, NULL); TkUndoMakeCmdSubAtom(NULL, markSet1InsertObj, dAtom); TkUndoMakeCmdSubAtom(NULL, seeInsertObj, dAtom); @@ -2810,7 +2833,7 @@ TextUndoRedoCallback( Tcl_Obj *objPtr) /* Arguments of a command to be handled by the * shared text data structure. */ { - TkSharedText *sharedPtr = (TkSharedText *) clientData; + TkSharedText *sharedPtr = clientData; int res, objc; Tcl_Obj **objv; TkText *textPtr; @@ -2875,7 +2898,7 @@ TextUndoRedoCallback( * the Tcl level. */ - return SharedTextObjCmd((ClientData)sharedPtr, interp, objc+1, objv-1); + return SharedTextObjCmd(sharedPtr, interp, objc+1, objv-1); } /* @@ -3025,7 +3048,7 @@ DeleteIndexRange( for (i = 0; i < arraySize; i++) { TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0); } - ckfree((char *) arrayPtr); + ckfree(arrayPtr); } } @@ -3042,7 +3065,7 @@ DeleteIndexRange( for (i=0, hPtr=Tcl_FirstHashEntry(&sharedTextPtr->tagTable, &search); hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) { - TkTextTag *tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr); + TkTextTag *tagPtr = Tcl_GetHashValue(hPtr); TkBTreeTag(&index1, &index2, tagPtr, 0); } @@ -3079,8 +3102,7 @@ DeleteIndexRange( resetViewCount = 0; if (sharedTextPtr->refCount > PIXEL_CLIENTS) { - lineAndByteIndex = (int *) - ckalloc(sizeof(int) * 2 * sharedTextPtr->refCount); + lineAndByteIndex = ckalloc(sizeof(int) * 2 * sharedTextPtr->refCount); } else { lineAndByteIndex = pixels; } @@ -3141,7 +3163,7 @@ DeleteIndexRange( } else { lineAndByteIndex[resetViewCount] = -1; } - resetViewCount+=2; + resetViewCount += 2; } /* @@ -3221,7 +3243,7 @@ DeleteIndexRange( resetViewCount += 2; } if (sharedTextPtr->refCount > PIXEL_CLIENTS) { - ckfree((char *) lineAndByteIndex); + ckfree(lineAndByteIndex); } if (line1 >= line2) { @@ -3269,7 +3291,7 @@ TextFetchSelection( * not including terminating NULL * character. */ { - register TkText *textPtr = (TkText *) clientData; + register TkText *textPtr = clientData; TkTextIndex eof; int count, chunkSize, offsetInSeg; TkTextSearch search; @@ -3400,7 +3422,7 @@ void TkTextLostSelection( ClientData clientData) /* Information about text widget. */ { - register TkText *textPtr = (TkText *) clientData; + register TkText *textPtr = clientData; if (TkpAlwaysShowSelection(textPtr->tkwin)) { TkTextIndex start, end; @@ -3494,12 +3516,22 @@ static void TextBlinkProc( ClientData clientData) /* Pointer to record describing text. */ { - register TkText *textPtr = (TkText *) clientData; + register TkText *textPtr = clientData; TkTextIndex index; int x, y, w, h, charWidth; if ((textPtr->state == TK_TEXT_STATE_DISABLED) || !(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) { + if (!(textPtr->flags & GOT_FOCUS) && + (textPtr->insertUnfocussed != TK_TEXT_INSERT_NOFOCUS_NONE)) { + /* + * The widget doesn't have the focus yet it is configured to + * display the cursor when it doesn't have the focus. Act now! + */ + + textPtr->flags |= INSERT_ON; + goto redrawInsert; + } if ((textPtr->insertOffTime == 0) && !(textPtr->flags & INSERT_ON)) { /* * The widget was configured to have zero offtime while the @@ -3514,11 +3546,11 @@ TextBlinkProc( if (textPtr->flags & INSERT_ON) { textPtr->flags &= ~INSERT_ON; textPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - textPtr->insertOffTime, TextBlinkProc, (ClientData) textPtr); + textPtr->insertOffTime, TextBlinkProc, textPtr); } else { textPtr->flags |= INSERT_ON; textPtr->insertBlinkHandler = Tcl_CreateTimerHandler( - textPtr->insertOnTime, TextBlinkProc, (ClientData) textPtr); + textPtr->insertOnTime, TextBlinkProc, textPtr); } redrawInsert: TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index); @@ -3597,7 +3629,7 @@ TextInsertCmd( for (i = 0; i < numTags; i++) { TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0); } - ckfree((char *) oldTagArrayPtr); + ckfree(oldTagArrayPtr); } if (Tcl_ListObjGetElements(interp, objv[j+1], &numTags, &tagNamePtrs) != TCL_OK) { @@ -3645,14 +3677,15 @@ TextSearchCmd( int i, argsLeft, code; SearchSpec searchSpec; - static const char *switchStrings[] = { + static const char *const switchStrings[] = { + "-hidden", "--", "-all", "-backwards", "-count", "-elide", "-exact", "-forwards", - "-hidden", "-nocase", "-nolinestop", "-overlap", "-regexp", - "-strictlimits", NULL + "-nocase", "-nolinestop", "-overlap", "-regexp", "-strictlimits", NULL }; enum SearchSwitches { + SEARCH_HIDDEN, SEARCH_END, SEARCH_ALL, SEARCH_BACK, SEARCH_COUNT, SEARCH_ELIDE, - SEARCH_EXACT, SEARCH_FWD, SEARCH_HIDDEN, SEARCH_NOCASE, + SEARCH_EXACT, SEARCH_FWD, SEARCH_NOCASE, SEARCH_NOLINESTOP, SEARCH_OVERLAP, SEARCH_REGEXP, SEARCH_STRICTLIMITS }; @@ -3674,7 +3707,7 @@ TextSearchCmd( searchSpec.strictLimits = 0; searchSpec.numLines = TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr); - searchSpec.clientData = (ClientData)textPtr; + searchSpec.clientData = textPtr; searchSpec.addLineProc = &TextSearchAddNextLine; searchSpec.foundMatchProc = &TextSearchFoundMatch; searchSpec.lineIndexProc = &TextSearchGetLineIndex; @@ -3685,21 +3718,20 @@ TextSearchCmd( for (i=2 ; i<objc ; i++) { int index; + if (Tcl_GetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], switchStrings, "switch", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(NULL, objv[i], switchStrings, + sizeof(char *), "switch", 0, &index) != TCL_OK) { /* - * Hide the -hidden option. + * Hide the -hidden option, generating the error description with + * the side effects of T_GIFO. */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad switch \"", Tcl_GetString(objv[i]), - "\": must be --, -all, -backward, -count, -elide, ", - "-exact, -forward, -nocase, -nolinestop, -overlap, ", - "-regexp, or -strictlimits", NULL); + (void) Tcl_GetIndexFromObjStruct(interp, objv[i], switchStrings+1, + sizeof(char *), "switch", 0, &index); return TCL_ERROR; } @@ -3715,8 +3747,9 @@ TextSearchCmd( break; case SEARCH_COUNT: if (i >= objc-1) { - Tcl_SetResult(interp, "no value given for \"-count\" option", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no value given for \"-count\" option", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "VALUE", NULL); return TCL_ERROR; } i++; @@ -3767,14 +3800,18 @@ TextSearchCmd( } if (searchSpec.noLineStop && searchSpec.exact) { - Tcl_SetResult(interp, "the \"-nolinestop\" option requires the " - "\"-regexp\" option to be present", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-nolinestop\" option requires the \"-regexp\" option" + " to be present", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL); return TCL_ERROR; } if (searchSpec.overlap && !searchSpec.all) { - Tcl_SetResult(interp, "the \"-overlap\" option requires the " - "\"-all\" option to be present", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the \"-overlap\" option requires the \"-all\" option" + " to be present", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "SEARCH_USAGE", NULL); return TCL_ERROR; } @@ -3859,7 +3896,7 @@ TextSearchGetLineIndex( { const TkTextIndex *indexPtr; int line; - TkText *textPtr = (TkText *) searchSpecPtr->clientData; + TkText *textPtr = searchSpecPtr->clientData; indexPtr = TkTextGetIndexFromObj(interp, textPtr, objPtr); if (indexPtr == NULL) { @@ -3924,7 +3961,7 @@ TextSearchIndexInLine( TkTextSegment *segPtr; TkTextIndex curIndex; int index, leftToScan; - TkText *textPtr = (TkText *) searchSpecPtr->clientData; + TkText *textPtr = searchSpecPtr->clientData; index = 0; curIndex.tree = textPtr->sharedTextPtr->tree; @@ -3994,7 +4031,7 @@ TextSearchAddNextLine( TkTextLine *linePtr, *thisLinePtr; TkTextIndex curIndex; TkTextSegment *segPtr; - TkText *textPtr = (TkText *) searchSpecPtr->clientData; + TkText *textPtr = searchSpecPtr->clientData; int nothingYet = 1; /* @@ -4066,12 +4103,13 @@ TextSearchAddNextLine( if (lenPtr != NULL) { if (searchSpecPtr->exact) { - Tcl_GetStringFromObj(theLine, lenPtr); + (void)Tcl_GetString(theLine); + *lenPtr = theLine->length; } else { *lenPtr = Tcl_GetCharLength(theLine); } } - return (ClientData)linePtr; + return linePtr; } /* @@ -4115,7 +4153,7 @@ TextSearchFoundMatch( TkTextIndex curIndex, foundIndex; TkTextSegment *segPtr; TkTextLine *linePtr; - TkText *textPtr = (TkText *) searchSpecPtr->clientData; + TkText *textPtr = searchSpecPtr->clientData; if (lineNum == searchSpecPtr->stopLine) { /* @@ -4166,7 +4204,7 @@ TextSearchFoundMatch( * reached the end of the match or we have reached the end of the line. */ - linePtr = (TkTextLine *)clientData; + linePtr = clientData; if (linePtr == NULL) { linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr, lineNum); @@ -4351,7 +4389,7 @@ TkTextGetTabs( /* * Map these strings to TkTextTabAlign values. */ - static const char *tabOptionStrings[] = { + static const char *const tabOptionStrings[] = { "left", "right", "center", "numeric", NULL }; @@ -4366,6 +4404,7 @@ TkTextGetTabs( count = 0; for (i = 0; i < objc; i++) { char c = Tcl_GetString(objv[i])[0]; + if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) { count++; } @@ -4375,8 +4414,8 @@ TkTextGetTabs( * Parse the elements of the list one at a time to fill in the array. */ - tabArrayPtr = (TkTextTabArray *) ckalloc((unsigned) - (sizeof(TkTextTabArray) + (count-1)*sizeof(TkTextTab))); + tabArrayPtr = ckalloc(sizeof(TkTextTabArray) + + (count - 1) * sizeof(TkTextTab)); tabArrayPtr->numTabs = 0; prevStop = 0.0; lastStop = 0.0; @@ -4394,14 +4433,16 @@ TkTextGetTabs( } if (tabPtr->location <= 0) { - Tcl_AppendResult(interp, "tab stop \"", Tcl_GetString(objv[i]), - "\" is not at a positive distance", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tab stop \"%s\" is not at a positive distance", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL); goto error; } prevStop = lastStop; - if (Tk_GetDoublePixelsFromObj (interp, textPtr->tkwin, objv[i], - &lastStop) != TCL_OK) { + if (Tk_GetDoublePixelsFromObj(interp, textPtr->tkwin, objv[i], + &lastStop) != TCL_OK) { goto error; } @@ -4425,11 +4466,11 @@ TkTextGetTabs( } lastStop = tabPtr->location; #else - Tcl_AppendResult(interp, - "tabs must be monotonically increasing, but \"", - Tcl_GetString(objv[i]), - "\" is smaller than or equal to the previous tab", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tabs must be monotonically increasing, but \"%s\" is " + "smaller than or equal to the previous tab", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "VALUE", "TAB_STOP", NULL); goto error; #endif /* _TK_ALLOW_DECREASING_TABS */ } @@ -4456,11 +4497,11 @@ TkTextGetTabs( } i += 1; - if (Tcl_GetIndexFromObj(interp, objv[i], tabOptionStrings, - "tab alignment", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], tabOptionStrings, + sizeof(char *), "tab alignment", 0, &index) != TCL_OK) { goto error; } - tabPtr->alignment = ((TkTextTabAlign)index); + tabPtr->alignment = (TkTextTabAlign) index; } /* @@ -4475,7 +4516,7 @@ TkTextGetTabs( return tabArrayPtr; error: - ckfree((char *) tabArrayPtr); + ckfree(tabArrayPtr); return NULL; } @@ -4521,7 +4562,7 @@ TextDumpCmd( #define TK_DUMP_IMG 0x10 #define TK_DUMP_ALL (TK_DUMP_TEXT|TK_DUMP_MARK|TK_DUMP_TAG| \ TK_DUMP_WIN|TK_DUMP_IMG) - static const char *optStrings[] = { + static const char *const optStrings[] = { "-all", "-command", "-image", "-mark", "-tag", "-text", "-window", NULL }; @@ -4534,8 +4575,8 @@ TextDumpCmd( if (Tcl_GetString(objv[arg])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[arg], optStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[arg], optStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum opts) index) { @@ -4560,10 +4601,7 @@ TextDumpCmd( case DUMP_CMD: arg++; if (arg >= objc) { - Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), - " dump ?-all -image -text -mark -tag -window? ", - "?-command script? index ?index2?", NULL); - return TCL_ERROR; + goto wrongArgs; } command = objv[arg]; break; @@ -4572,9 +4610,11 @@ TextDumpCmd( } } if (arg >= objc || arg+2 < objc) { - Tcl_AppendResult(interp, "Usage: ", Tcl_GetString(objv[0]), - " dump ?-all -image -text -mark -tag -window? ", - "?-command script? index ?index2?", NULL); + wrongArgs: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Usage: %s dump ?-all -image -text -mark -tag -window? " + "?-command script? index ?index2?", Tcl_GetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } if (what == 0) { @@ -4589,13 +4629,14 @@ TextDumpCmd( TkTextIndexForwChars(NULL, &index1, 1, &index2, COUNT_INDICES); } else { int length; - char *str; + const char *str; if (TkTextGetObjIndex(interp, textPtr, objv[arg], &index2) != TCL_OK) { return TCL_ERROR; } - str = Tcl_GetStringFromObj(objv[arg], &length); - if (strncmp(str, "end", (unsigned)length) == 0) { + str = Tcl_GetString(objv[arg]); + length = objv[arg]->length; + if (strncmp(str, "end", (unsigned) length) == 0) { atEnd = 1; } } @@ -4628,8 +4669,8 @@ TextDumpCmd( if (lineno == lineend) { break; } - textChanged = DumpLine(interp, textPtr, what, linePtr, 0, 32000000, - lineno, command); + textChanged = DumpLine(interp, textPtr, what, linePtr, 0, + 32000000, lineno, command); if (textChanged) { if (textPtr->flags & DESTROYED) { return TCL_OK; @@ -4738,10 +4779,9 @@ DumpLine( */ int length = last - first; - char *range = ckalloc((length + 1) * sizeof(char)); + char *range = ckalloc(length + 1); - memcpy(range, segPtr->body.chars + first, - length * sizeof(char)); + memcpy(range, segPtr->body.chars + first, length); range[length] = '\0'; TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, @@ -4756,9 +4796,11 @@ DumpLine( segPtr->body.chars + first, command, &index, what); } } else if ((offset >= startByte)) { - if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) { - char *name; - TkTextMark *markPtr = (TkTextMark *) &segPtr->body; + if ((what & TK_DUMP_MARK) + && (segPtr->typePtr == &tkTextLeftMarkType + || segPtr->typePtr == &tkTextRightMarkType)) { + const char *name; + TkTextMark *markPtr = &segPtr->body.mark; if (segPtr == textPtr->insertMarkPtr) { name = "insert"; @@ -4792,18 +4834,18 @@ DumpLine( segPtr->body.toggle.tagPtr->name, command, &index, what); } else if ((what & TK_DUMP_IMG) && - (segPtr->typePtr->name[0] == 'i')) { - TkTextEmbImage *eiPtr = (TkTextEmbImage *)&segPtr->body; - char *name = (eiPtr->name == NULL) ? "" : eiPtr->name; + (segPtr->typePtr == &tkTextEmbImageType)) { + TkTextEmbImage *eiPtr = &segPtr->body.ei; + const char *name = (eiPtr->name == NULL) ? "" : eiPtr->name; TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineno, offset, &index); lineChanged = DumpSegment(textPtr, interp, "image", name, command, &index, what); } else if ((what & TK_DUMP_WIN) && - (segPtr->typePtr->name[0] == 'w')) { - TkTextEmbWindow *ewPtr = (TkTextEmbWindow *)&segPtr->body; - char *pathname; + (segPtr->typePtr == &tkTextEmbWindowType)) { + TkTextEmbWindow *ewPtr = &segPtr->body.ew; + const char *pathname; if (ewPtr->tkwin == (Tk_Window) NULL) { pathname = ""; @@ -4816,6 +4858,7 @@ DumpLine( command, &index, what); } } + offset += currentSize; if (lineChanged) { TkTextSegment *newSegPtr; @@ -4833,9 +4876,7 @@ DumpLine( linePtr = TkBTreeFindLine(textPtr->sharedTextPtr->tree, textPtr, lineno); newSegPtr = linePtr->segPtr; - if (segPtr == newSegPtr) { - segPtr = segPtr->nextPtr; - } else { + if (segPtr != newSegPtr) { while ((newOffset < endByte) && (newOffset < offset) && (newSegPtr != NULL)) { newOffset += currentSize; @@ -4857,11 +4898,9 @@ DumpLine( } } segPtr = newSegPtr; - if (segPtr != NULL) { - segPtr = segPtr->nextPtr; - } } - } else { + } + if (segPtr != NULL) { segPtr = segPtr->nextPtr; } } @@ -4900,31 +4939,36 @@ DumpSegment( int what) /* Look for TK_DUMP_INDEX bit. */ { char buffer[TK_POS_CHARS]; + Tcl_Obj *values[3], *tuple; TkTextPrintIndex(textPtr, index, buffer); + values[0] = Tcl_NewStringObj(key, -1); + values[1] = Tcl_NewStringObj(value, -1); + values[2] = Tcl_NewStringObj(buffer, -1); + tuple = Tcl_NewListObj(3, values); if (command == NULL) { - Tcl_AppendElement(interp, key); - Tcl_AppendElement(interp, value); - Tcl_AppendElement(interp, buffer); + Tcl_ListObjAppendList(NULL, Tcl_GetObjResult(interp), tuple); + Tcl_DecrRefCount(tuple); return 0; } else { - const char *argv[4]; - char *list; int oldStateEpoch = TkBTreeEpoch(textPtr->sharedTextPtr->tree); - - argv[0] = key; - argv[1] = value; - argv[2] = buffer; - argv[3] = NULL; - list = Tcl_Merge(3, argv); - Tcl_VarEval(interp, Tcl_GetString(command), " ", list, NULL); - ckfree(list); - if ((textPtr->flags & DESTROYED) || - TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch) { - return 1; - } else { - return 0; - } + Tcl_DString buf; + int code; + + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, Tcl_GetString(command), -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, Tcl_GetString(tuple), -1); + code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); + if (code != TCL_OK) { + Tcl_AddErrorInfo(interp, + "\n (segment dumping command executed by text)"); + Tcl_BackgroundException(interp, code); + } + Tcl_DecrRefCount(tuple); + return ((textPtr->flags & DESTROYED) || + TkBTreeEpoch(textPtr->sharedTextPtr->tree) != oldStateEpoch); } } @@ -5047,9 +5091,8 @@ TextEditCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int index; - - static const char *editOptionStrings[] = { + int index, setModified, oldModified; + static const char *const editOptionStrings[] = { "modified", "redo", "reset", "separator", "undo", NULL }; enum editOptions { @@ -5057,12 +5100,12 @@ TextEditCmd( }; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], editOptionStrings, - "edit option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], editOptionStrings, + sizeof(char *), "edit option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -5071,39 +5114,36 @@ TextEditCmd( if (objc == 3) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj(textPtr->sharedTextPtr->isDirty)); + return TCL_OK; } else if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "?boolean?"); return TCL_ERROR; - } else { - int setModified, oldModified; - - if (Tcl_GetBooleanFromObj(interp, objv[3], - &setModified) != TCL_OK) { - return TCL_ERROR; - } + } else if (Tcl_GetBooleanFromObj(interp, objv[3], + &setModified) != TCL_OK) { + return TCL_ERROR; + } - /* - * Set or reset the dirty info, and trigger a Modified event. - */ + /* + * Set or reset the dirty info, and trigger a Modified event. + */ - setModified = setModified ? 1 : 0; + setModified = setModified ? 1 : 0; - oldModified = textPtr->sharedTextPtr->isDirty; - textPtr->sharedTextPtr->isDirty = setModified; - if (setModified) { - textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED; - } else { - textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL; - } + oldModified = textPtr->sharedTextPtr->isDirty; + textPtr->sharedTextPtr->isDirty = setModified; + if (setModified) { + textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_FIXED; + } else { + textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL; + } - /* - * Only issue the <<Modified>> event if the flag actually changed. - * However, degree of modified-ness doesn't matter. [Bug 1799782] - */ + /* + * Only issue the <<Modified>> event if the flag actually changed. + * However, degree of modified-ness doesn't matter. [Bug 1799782] + */ - if ((!oldModified) != (!setModified)) { - GenerateModifiedEvent(textPtr); - } + if ((!oldModified) != (!setModified)) { + GenerateModifiedEvent(textPtr); } break; case EDIT_REDO: @@ -5112,7 +5152,8 @@ TextEditCmd( return TCL_ERROR; } if (TextEditRedo(textPtr)) { - Tcl_AppendResult(interp, "nothing to redo", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to redo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_REDO", NULL); return TCL_ERROR; } break; @@ -5136,7 +5177,8 @@ TextEditCmd( return TCL_ERROR; } if (TextEditUndo(textPtr)) { - Tcl_AppendResult(interp, "nothing to undo", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("nothing to undo", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_UNDO", NULL); return TCL_ERROR; } break; @@ -5196,11 +5238,10 @@ TextGetText( if (TkTextIndexCmp(indexPtr1, indexPtr2) < 0) { while (1) { - int offset, last; - TkTextSegment *segPtr; + int offset; + TkTextSegment *segPtr = TkTextIndexToSeg(&tmpIndex, &offset); + int last = segPtr->size, last2; - segPtr = TkTextIndexToSeg(&tmpIndex, &offset); - last = segPtr->size; if (tmpIndex.linePtr == indexPtr2->linePtr) { /* * The last line that was requested must be handled carefully, @@ -5210,21 +5251,17 @@ TextGetText( if (indexPtr2->byteIndex == tmpIndex.byteIndex) { break; - } else { - int last2 = indexPtr2->byteIndex - tmpIndex.byteIndex - + offset; - - if (last2 < last) { - last = last2; - } } - } - if (segPtr->typePtr == &tkTextCharType) { - if (!visibleOnly || !TkTextIsElided(textPtr,&tmpIndex,NULL)) { - Tcl_AppendToObj(resultPtr, segPtr->body.chars + offset, - last - offset); + last2 = indexPtr2->byteIndex - tmpIndex.byteIndex + offset; + if (last2 < last) { + last = last2; } } + if (segPtr->typePtr == &tkTextCharType && + !(visibleOnly && TkTextIsElided(textPtr,&tmpIndex,NULL))){ + Tcl_AppendToObj(resultPtr, segPtr->body.chars + offset, + last - offset); + } TkTextIndexForwBytes(textPtr, &tmpIndex, last-offset, &tmpIndex); } } @@ -5236,7 +5273,7 @@ TextGetText( * * GenerateModifiedEvent -- * - * Send an event that the text was modified. This is equivalent to + * Send an event that the text was modified. This is equivalent to: * event generate $textWidget <<Modified>> * * Results: @@ -5252,7 +5289,10 @@ static void GenerateModifiedEvent( TkText *textPtr) /* Information about text widget. */ { - union {XEvent general; XVirtualEvent virtual;} event; + union { + XEvent general; + XVirtualEvent virtual; + } event; Tk_MakeWindowExist(textPtr->tkwin); @@ -5362,7 +5402,7 @@ SearchPerform( * for regexp search, utf-8 bytes for exact search). */ - if ((*searchSpecPtr->lineIndexProc)(interp, fromPtr, searchSpecPtr, + if (searchSpecPtr->lineIndexProc(interp, fromPtr, searchSpecPtr, &searchSpecPtr->startLine, &searchSpecPtr->startOffset) != TCL_OK) { return TCL_ERROR; @@ -5374,7 +5414,7 @@ SearchPerform( if (toPtr != NULL) { const TkTextIndex *indexToPtr, *indexFromPtr; - TkText *textPtr = (TkText *) searchSpecPtr->clientData; + TkText *textPtr = searchSpecPtr->clientData; indexToPtr = TkTextGetIndexFromObj(interp, textPtr, toPtr); if (indexToPtr == NULL) { @@ -5388,17 +5428,12 @@ SearchPerform( * wrap when given a negative search range). */ - if (searchSpecPtr->backwards) { - if (TkTextIndexCmp(indexFromPtr, indexToPtr) == -1) { - return TCL_OK; - } - } else { - if (TkTextIndexCmp(indexFromPtr, indexToPtr) == 1) { - return TCL_OK; - } + if (TkTextIndexCmp(indexFromPtr, indexToPtr) == + (searchSpecPtr->backwards ? -1 : 1)) { + return TCL_OK; } - if ((*searchSpecPtr->lineIndexProc)(interp, toPtr, searchSpecPtr, + if (searchSpecPtr->lineIndexProc(interp, toPtr, searchSpecPtr, &searchSpecPtr->stopLine, &searchSpecPtr->stopOffset) != TCL_OK) { return TCL_ERROR; @@ -5533,7 +5568,8 @@ SearchCore( * it has dual purpose. */ - pattern = Tcl_GetStringFromObj(patObj, &matchLength); + pattern = Tcl_GetString(patObj); + matchLength = patObj->length; nl = strchr(pattern, '\n'); /* @@ -5584,8 +5620,8 @@ SearchCore( * this line, which is what 'lastOffset' represents. */ - lineInfo = (*searchSpecPtr->addLineProc)(lineNum, searchSpecPtr, - theLine, &lastOffset, &linesSearched); + lineInfo = searchSpecPtr->addLineProc(lineNum, searchSpecPtr, theLine, + &lastOffset, &linesSearched); if (lineInfo == NULL) { /* @@ -5664,6 +5700,7 @@ SearchCore( int maxExtraLines = 0; const char *startOfLine = Tcl_GetString(theLine); + CLANG_ASSERT(pattern); do { Tcl_UniChar ch; const char *p; @@ -5701,7 +5738,7 @@ SearchCore( } while (p >= startOfLine + firstOffset) { if (p[0] == c && !strncmp(p, pattern, - (unsigned)matchLength)) { + (unsigned) matchLength)) { goto backwardsMatch; } p--; @@ -5730,7 +5767,7 @@ SearchCore( */ p = startOfLine + lastOffset - firstNewLine - 1; - if (strncmp(p, pattern, (unsigned)(firstNewLine + 1))) { + if (strncmp(p, pattern, (unsigned) firstNewLine + 1)) { /* * No match. */ @@ -5769,7 +5806,7 @@ SearchCore( */ if (extraLines > maxExtraLines) { - if ((*searchSpecPtr->addLineProc)(lineNum + if (searchSpecPtr->addLineProc(lineNum + extraLines, searchSpecPtr, theLine, &lastTotal, &extraLines) == NULL) { p = NULL; @@ -5849,9 +5886,8 @@ SearchCore( matchOffset = p - startOfLine; if (searchSpecPtr->all && - !(*searchSpecPtr->foundMatchProc)(lineNum, - searchSpecPtr, lineInfo, theLine, matchOffset, - matchLength)) { + !searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr, + lineInfo, theLine, matchOffset, matchLength)) { /* * We reached the end of the search. */ @@ -5992,7 +6028,7 @@ SearchCore( */ if (extraLines > maxExtraLines) { - if ((*searchSpecPtr->addLineProc)(lineNum + if (searchSpecPtr->addLineProc(lineNum + extraLines, searchSpecPtr, theLine, &lastTotal, &extraLines) == NULL) { /* @@ -6171,9 +6207,9 @@ SearchCore( if (lastBackwardsLineMatch != -1) { recordBackwardsMatch: - (*searchSpecPtr->foundMatchProc)( - lastBackwardsLineMatch, searchSpecPtr, NULL, - NULL, lastBackwardsMatchOffset, matchLength); + searchSpecPtr->foundMatchProc(lastBackwardsLineMatch, + searchSpecPtr, NULL, NULL, + lastBackwardsMatchOffset, matchLength); lastBackwardsLineMatch = -1; if (!searchSpecPtr->all) { goto searchDone; @@ -6216,13 +6252,13 @@ SearchCore( * matches on the heap. */ - int *newArray = (int *) + int *newArray = ckalloc(4 * matchNum * sizeof(int)); memcpy(newArray, storeMatch, matchNum*sizeof(int)); memcpy(newArray + 2*matchNum, storeLength, matchNum * sizeof(int)); if (storeMatch != smArray) { - ckfree((char *) storeMatch); + ckfree(storeMatch); } matchNum *= 2; storeMatch = newArray; @@ -6238,7 +6274,7 @@ SearchCore( */ if (searchSpecPtr->all && - !(*searchSpecPtr->foundMatchProc)(lineNum, + !searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr, lineInfo, theLine, matchOffset, matchLength)) { /* @@ -6329,7 +6365,7 @@ SearchCore( continue; } } - (*searchSpecPtr->foundMatchProc)(lineNum, searchSpecPtr, + searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr, lineInfo, theLine, matchOffset, matchLength); if (!searchSpecPtr->all) { goto searchDone; @@ -6344,7 +6380,7 @@ SearchCore( * non-all case. */ - (*searchSpecPtr->foundMatchProc)(lineNum, searchSpecPtr, + searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr, lineInfo, theLine, matchOffset, matchLength); } else { lastBackwardsLineMatch = lineNum; @@ -6363,7 +6399,7 @@ SearchCore( if ((lastBackwardsLineMatch == -1) && (matchOffset >= 0) && !searchSpecPtr->all) { - (*searchSpecPtr->foundMatchProc)(lineNum, searchSpecPtr, lineInfo, + searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr, lineInfo, theLine, matchOffset, matchLength); goto searchDone; } @@ -6390,7 +6426,7 @@ SearchCore( if (lastBackwardsLineMatch != -1 && ((lineNum < 0) || (lineNum + 2 < lastBackwardsLineMatch))) { - (*searchSpecPtr->foundMatchProc)(lastBackwardsLineMatch, + searchSpecPtr->foundMatchProc(lastBackwardsLineMatch, searchSpecPtr, NULL, NULL, lastBackwardsMatchOffset, matchLength); lastBackwardsLineMatch = -1; @@ -6436,7 +6472,7 @@ SearchCore( searchDone: if (lastBackwardsLineMatch != -1) { - (*searchSpecPtr->foundMatchProc)(lastBackwardsLineMatch, searchSpecPtr, + searchSpecPtr->foundMatchProc(lastBackwardsLineMatch, searchSpecPtr, NULL, NULL, lastBackwardsMatchOffset, matchLength); } @@ -6452,7 +6488,7 @@ SearchCore( */ if (storeMatch != smArray) { - ckfree((char *) storeMatch); + ckfree(storeMatch); } return code; @@ -6487,9 +6523,8 @@ GetLineStartEnd( if (linePtr == NULL) { return Tcl_NewObj(); - } else { - return Tcl_NewIntObj(1+TkBTreeLinesTo(NULL, linePtr)); } + return Tcl_NewIntObj(1 + TkBTreeLinesTo(NULL, linePtr)); } /* @@ -6602,16 +6637,14 @@ static int ObjectIsEmpty( Tcl_Obj *objPtr) /* Object to test. May be NULL. */ { - int length; - if (objPtr == NULL) { return 1; } if (objPtr->bytes != NULL) { return (objPtr->length == 0); } - Tcl_GetStringFromObj(objPtr, &length); - return (length == 0); + (void)Tcl_GetString(objPtr); + return (objPtr->length == 0); } /* @@ -6636,8 +6669,8 @@ int TkpTesttextCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { TkText *textPtr; size_t len; @@ -6646,45 +6679,41 @@ TkpTesttextCmd( char buf[64]; Tcl_CmdInfo info; - if (argc < 3) { + if (objc < 3) { return TCL_ERROR; } - if (Tcl_GetCommandInfo(interp, argv[1], &info) == 0) { + if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[1]), &info) == 0) { return TCL_ERROR; } - if (info.isNativeObjectProc) { - textPtr = (TkText *) info.objClientData; - } else { - textPtr = (TkText *) info.clientData; - } - len = strlen(argv[2]); - if (strncmp(argv[2], "byteindex", len) == 0) { - if (argc != 5) { + textPtr = info.objClientData; + len = strlen(Tcl_GetString(objv[2])); + if (strncmp(Tcl_GetString(objv[2]), "byteindex", len) == 0) { + if (objc != 5) { return TCL_ERROR; } - lineIndex = atoi(argv[3]) - 1; - byteIndex = atoi(argv[4]); + lineIndex = atoi(Tcl_GetString(objv[3])) - 1; + byteIndex = atoi(Tcl_GetString(objv[4])); TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, lineIndex, byteIndex, &index); - } else if (strncmp(argv[2], "forwbytes", len) == 0) { - if (argc != 5) { + } else if (strncmp(Tcl_GetString(objv[2]), "forwbytes", len) == 0) { + if (objc != 5) { return TCL_ERROR; } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { + if (TkTextGetIndex(interp, textPtr, Tcl_GetString(objv[3]), &index) != TCL_OK) { return TCL_ERROR; } - byteOffset = atoi(argv[4]); + byteOffset = atoi(Tcl_GetString(objv[4])); TkTextIndexForwBytes(textPtr, &index, byteOffset, &index); - } else if (strncmp(argv[2], "backbytes", len) == 0) { - if (argc != 5) { + } else if (strncmp(Tcl_GetString(objv[2]), "backbytes", len) == 0) { + if (objc != 5) { return TCL_ERROR; } - if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) { + if (TkTextGetIndex(interp, textPtr, Tcl_GetString(objv[3]), &index) != TCL_OK) { return TCL_ERROR; } - byteOffset = atoi(argv[4]); + byteOffset = atoi(Tcl_GetString(objv[4])); TkTextIndexBackBytes(textPtr, &index, byteOffset, &index); } else { return TCL_ERROR; @@ -6692,9 +6721,7 @@ TkpTesttextCmd( TkTextSetMark(textPtr, "insert", &index); TkTextPrintIndex(textPtr, &index, buf); - sprintf(buf + strlen(buf), " %d", index.byteIndex); - Tcl_AppendResult(interp, buf, NULL); - + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s %d", buf, index.byteIndex)); return TCL_OK; } diff --git a/generic/tkText.h b/generic/tkText.h index 6f5f153..78a99a9 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -21,17 +21,6 @@ #include "tkUndo.h" #endif -#ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif - -/* - * Opaque types for structures whose guts are only needed by a single file. - */ - -typedef struct TkTextBTree_ *TkTextBTree; - /* * The data structure below defines a single logical line of text (from * newline to newline, not necessarily what appears on one display line of the @@ -179,7 +168,7 @@ typedef struct TkTextSegment { int size; /* Size of this segment (# of bytes of index * space it occupies). */ union { - char chars[4]; /* Characters that make up character info. + char chars[2]; /* Characters that make up character info. * Actual length varies to hold as many * characters as needed.*/ TkTextToggle toggle; /* Information about tag toggle. */ @@ -493,7 +482,7 @@ typedef struct TkTextTabArray { } TkTextTabArray; /* - * Enumeration definining the edit modes of the widget. + * Enumeration defining the edit modes of the widget. */ typedef enum { @@ -595,6 +584,17 @@ typedef struct TkSharedText { } TkSharedText; /* + * The following enum is used to define a type for the -insertunfocussed + * option of the Text widget. + */ + +typedef enum { + TK_TEXT_INSERT_NOFOCUS_HOLLOW, + TK_TEXT_INSERT_NOFOCUS_NONE, + TK_TEXT_INSERT_NOFOCUS_SOLID +} TkTextInsertUnfocussed; + +/* * A data structure of the following type is kept for each text widget that * currently exists for this process: */ @@ -726,7 +726,10 @@ typedef struct TkText { Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion * cursor. */ int insertWidth; /* Total width of insert cursor. */ - int insertBorderWidth; /* Width of 3-D border around insert cursor. */ + int insertBorderWidth; /* Width of 3-D border around insert cursor */ + TkTextInsertUnfocussed insertUnfocussed; + /* How to display the insert cursor when the + * text widget does not have the focus. */ int insertOnTime; /* Number of milliseconds cursor should spend * in "on" state for each blink. */ int insertOffTime; /* Number of milliseconds cursor should spend @@ -955,6 +958,8 @@ MODULE_SCOPE const Tk_SegType tkTextLeftMarkType; MODULE_SCOPE const Tk_SegType tkTextRightMarkType; MODULE_SCOPE const Tk_SegType tkTextToggleOnType; MODULE_SCOPE const Tk_SegType tkTextToggleOffType; +MODULE_SCOPE const Tk_SegType tkTextEmbWindowType; +MODULE_SCOPE const Tk_SegType tkTextEmbImageType; /* * Convenience macros for use by B-tree clients which want to access pixel @@ -1006,8 +1011,6 @@ MODULE_SCOPE void TkBTreeLinkSegment(TkTextSegment *segPtr, MODULE_SCOPE TkTextLine *TkBTreeNextLine(const TkText *textPtr, TkTextLine *linePtr); MODULE_SCOPE int TkBTreeNextTag(TkTextSearch *searchPtr); -MODULE_SCOPE int TkBTreeNumLines(TkTextBTree tree, - const TkText *textPtr); MODULE_SCOPE int TkBTreeNumPixels(TkTextBTree tree, const TkText *textPtr); MODULE_SCOPE TkTextLine *TkBTreePreviousLine(TkText *textPtr, @@ -1027,9 +1030,6 @@ MODULE_SCOPE void TkBTreeUnlinkSegment(TkTextSegment *segPtr, MODULE_SCOPE void TkTextBindProc(ClientData clientData, XEvent *eventPtr); MODULE_SCOPE void TkTextSelectionEvent(TkText *textPtr); -MODULE_SCOPE void TkTextChanged(TkSharedText *sharedTextPtr, - TkText *textPtr, const TkTextIndex *index1Ptr, - const TkTextIndex *index2Ptr); MODULE_SCOPE int TkTextIndexBbox(TkText *textPtr, const TkTextIndex *indexPtr, int *xPtr, int *yPtr, int *widthPtr, int *heightPtr, int *charWidthPtr); @@ -1050,8 +1050,6 @@ MODULE_SCOPE TkTextTag *TkTextCreateTag(TkText *textPtr, MODULE_SCOPE void TkTextFreeDInfo(TkText *textPtr); MODULE_SCOPE void TkTextDeleteTag(TkText *textPtr, TkTextTag *tagPtr); MODULE_SCOPE void TkTextFreeTag(TkText *textPtr, TkTextTag *tagPtr); -MODULE_SCOPE int TkTextGetIndex(Tcl_Interp *interp, TkText *textPtr, - const char *string, TkTextIndex *indexPtr); MODULE_SCOPE int TkTextGetObjIndex(Tcl_Interp *interp, TkText *textPtr, Tcl_Obj *idxPtr, TkTextIndex *indexPtr); MODULE_SCOPE int TkTextSharedGetObjIndex(Tcl_Interp *interp, @@ -1063,9 +1061,6 @@ MODULE_SCOPE TkTextTabArray *TkTextGetTabs(Tcl_Interp *interp, TkText *textPtr, Tcl_Obj *stringPtr); MODULE_SCOPE void TkTextFindDisplayLineEnd(TkText *textPtr, TkTextIndex *indexPtr, int end, int *xOffset); -MODULE_SCOPE int TkTextIndexBackBytes(const TkText *textPtr, - const TkTextIndex *srcPtr, int count, - TkTextIndex *dstPtr); MODULE_SCOPE void TkTextIndexBackChars(const TkText *textPtr, const TkTextIndex *srcPtr, int count, TkTextIndex *dstPtr, TkTextCountType type); @@ -1078,9 +1073,6 @@ MODULE_SCOPE int TkTextIndexCount(const TkText *textPtr, const TkTextIndex *index1Ptr, const TkTextIndex *index2Ptr, TkTextCountType type); -MODULE_SCOPE int TkTextIndexForwBytes(const TkText *textPtr, - const TkTextIndex *srcPtr, int count, - TkTextIndex *dstPtr); MODULE_SCOPE void TkTextIndexForwChars(const TkText *textPtr, const TkTextIndex *srcPtr, int count, TkTextIndex *dstPtr, TkTextCountType type); @@ -1090,10 +1082,6 @@ MODULE_SCOPE int TkTextIndexYPixels(TkText *textPtr, const TkTextIndex *indexPtr); MODULE_SCOPE TkTextSegment *TkTextIndexToSeg(const TkTextIndex *indexPtr, int *offsetPtr); -MODULE_SCOPE void TkTextInsertDisplayProc(TkText *textPtr, - TkTextDispChunk *chunkPtr, int x, int y, - int height, int baseline, Display *display, - Drawable dst, int screenY); MODULE_SCOPE void TkTextLostSelection(ClientData clientData); MODULE_SCOPE TkTextIndex *TkTextMakeCharIndex(TkTextBTree tree, TkText *textPtr, int lineIndex, int charIndex, @@ -1104,9 +1092,6 @@ MODULE_SCOPE void TkTextFreeElideInfo(TkTextElideInfo *infoPtr); MODULE_SCOPE int TkTextIsElided(const TkText *textPtr, const TkTextIndex *indexPtr, TkTextElideInfo *infoPtr); -MODULE_SCOPE TkTextIndex *TkTextMakeByteIndex(TkTextBTree tree, - const TkText *textPtr, int lineIndex, - int byteIndex, TkTextIndex *indexPtr); MODULE_SCOPE int TkTextMakePixelIndex(TkText *textPtr, int pixelIndex, TkTextIndex *indexPtr); MODULE_SCOPE void TkTextInvalidateLineMetrics( @@ -1127,8 +1112,6 @@ MODULE_SCOPE void TkTextEventuallyRepick(TkText *textPtr); MODULE_SCOPE void TkTextPickCurrent(TkText *textPtr, XEvent *eventPtr); MODULE_SCOPE void TkTextPixelIndex(TkText *textPtr, int x, int y, TkTextIndex *indexPtr, int *nearest); -MODULE_SCOPE int TkTextPrintIndex(const TkText *textPtr, - const TkTextIndex *indexPtr, char *string); MODULE_SCOPE Tcl_Obj * TkTextNewIndexObj(TkText *textPtr, const TkTextIndex *indexPtr); MODULE_SCOPE void TkTextRedrawRegion(TkText *textPtr, int x, int y, @@ -1144,8 +1127,6 @@ MODULE_SCOPE int TkTextSeeCmd(TkText *textPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TkTextSegToOffset(const TkTextSegment *segPtr, const TkTextLine *linePtr); -MODULE_SCOPE TkTextSegment *TkTextSetMark(TkText *textPtr, - const char *name, TkTextIndex *indexPtr); MODULE_SCOPE void TkTextSetYView(TkText *textPtr, TkTextIndex *indexPtr, int pickPlace); MODULE_SCOPE int TkTextTagCmd(TkText *textPtr, Tcl_Interp *interp, @@ -1158,16 +1139,11 @@ MODULE_SCOPE int TkTextWindowCmd(TkText *textPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TkTextWindowIndex(TkText *textPtr, const char *name, TkTextIndex *indexPtr); -MODULE_SCOPE int TkTextXviewCmd(TkText *textPtr, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TkTextYviewCmd(TkText *textPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TkTextWinFreeClient(Tcl_HashEntry *hPtr, TkTextEmbWindowClient *client); -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TKTEXT */ /* diff --git a/generic/tkTextBTree.c b/generic/tkTextBTree.c index 58fc645..0fdc280 100644 --- a/generic/tkTextBTree.c +++ b/generic/tkTextBTree.c @@ -273,9 +273,9 @@ TkBTreeCreate( * of the tree. */ - rootPtr = (Node *) ckalloc(sizeof(Node)); - linePtr = (TkTextLine *) ckalloc(sizeof(TkTextLine)); - linePtr2 = (TkTextLine *) ckalloc(sizeof(TkTextLine)); + rootPtr = ckalloc(sizeof(Node)); + linePtr = ckalloc(sizeof(TkTextLine)); + linePtr2 = ckalloc(sizeof(TkTextLine)); rootPtr->parentPtr = NULL; rootPtr->nextPtr = NULL; @@ -296,7 +296,7 @@ TkBTreeCreate( linePtr->parentPtr = rootPtr; linePtr->nextPtr = linePtr2; - segPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(1)); + segPtr = ckalloc(CSEG_SIZE(1)); linePtr->segPtr = segPtr; segPtr->typePtr = &tkTextCharType; segPtr->nextPtr = NULL; @@ -306,7 +306,7 @@ TkBTreeCreate( linePtr2->parentPtr = rootPtr; linePtr2->nextPtr = NULL; - segPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(1)); + segPtr = ckalloc(CSEG_SIZE(1)); linePtr2->segPtr = segPtr; segPtr->typePtr = &tkTextCharType; segPtr->nextPtr = NULL; @@ -314,7 +314,7 @@ TkBTreeCreate( segPtr->body.chars[0] = '\n'; segPtr->body.chars[1] = 0; - treePtr = (BTree *) ckalloc(sizeof(BTree)); + treePtr = ckalloc(sizeof(BTree)); treePtr->sharedTextPtr = sharedTextPtr; treePtr->rootPtr = rootPtr; treePtr->clients = 0; @@ -478,10 +478,10 @@ TkBTreeDestroy( DestroyNode(treePtr->rootPtr); if (treePtr->startEnd != NULL) { - ckfree((char *) treePtr->startEnd); - ckfree((char *) treePtr->startEndRef); + ckfree(treePtr->startEnd); + ckfree(treePtr->startEndRef); } - ckfree((char *) treePtr); + ckfree(treePtr); } /* @@ -543,7 +543,7 @@ TkBTreeRemoveClient( */ DestroyNode(treePtr->rootPtr); - ckfree((char *) treePtr); + ckfree(treePtr); return; } else if (pixelReference == -1) { /* @@ -632,11 +632,9 @@ AdjustStartEndRefs( i++; } treePtr->startEndCount = count; - treePtr->startEnd = (TkTextLine **) - ckrealloc((char *) treePtr->startEnd, + treePtr->startEnd = ckrealloc(treePtr->startEnd, sizeof(TkTextLine *) * count); - treePtr->startEndRef = (TkText **) - ckrealloc((char *) treePtr->startEndRef, + treePtr->startEndRef = ckrealloc(treePtr->startEndRef, sizeof(TkText *) * count); } if ((action & TEXT_ADD_REFS) @@ -652,11 +650,9 @@ AdjustStartEndRefs( count = treePtr->startEndCount; - treePtr->startEnd = (TkTextLine **) - ckrealloc((char *) treePtr->startEnd, + treePtr->startEnd = ckrealloc(treePtr->startEnd, sizeof(TkTextLine *) * count); - treePtr->startEndRef = (TkText **) - ckrealloc((char *) treePtr->startEndRef, + treePtr->startEndRef = ckrealloc(treePtr->startEndRef, sizeof(TkText *) * count); if (textPtr->start != NULL) { @@ -739,7 +735,7 @@ AdjustPixelClient( *counting = 0; } if (newPixelReferences != treePtr->pixelReferences) { - linePtr->pixels = (int *) ckrealloc((char *) linePtr->pixels, + linePtr->pixels = ckrealloc(linePtr->pixels, sizeof(int) * 2 * newPixelReferences); } @@ -756,7 +752,7 @@ AdjustPixelClient( } } if (newPixelReferences != treePtr->pixelReferences) { - nodePtr->numPixels = (int *) ckrealloc((char *) nodePtr->numPixels, + nodePtr->numPixels = ckrealloc(nodePtr->numPixels, sizeof(int) * newPixelReferences); } nodePtr->numPixels[useReference] = pixelCount; @@ -805,7 +801,7 @@ RemovePixelClient( if (treePtr->pixelReferences == 1) { nodePtr->numPixels = NULL; } else { - nodePtr->numPixels = (int *) ckrealloc((char *) nodePtr->numPixels, + nodePtr->numPixels = ckrealloc(nodePtr->numPixels, sizeof(int) * (treePtr->pixelReferences - 1)); } if (nodePtr->level != 0) { @@ -826,7 +822,7 @@ RemovePixelClient( if (treePtr->pixelReferences == 1) { linePtr->pixels = NULL; } else { - linePtr->pixels = (int *) ckrealloc((char *) linePtr->pixels, + linePtr->pixels = ckrealloc(linePtr->pixels, sizeof(int) * 2 * (treePtr->pixelReferences-1)); } linePtr = linePtr->nextPtr; @@ -865,10 +861,10 @@ DestroyNode( while (linePtr->segPtr != NULL) { segPtr = linePtr->segPtr; linePtr->segPtr = segPtr->nextPtr; - (*segPtr->typePtr->deleteProc)(segPtr, linePtr, 1); + segPtr->typePtr->deleteProc(segPtr, linePtr, 1); } - ckfree((char *) linePtr->pixels); - ckfree((char *) linePtr); + ckfree(linePtr->pixels); + ckfree(linePtr); } } else { register Node *childPtr; @@ -880,8 +876,8 @@ DestroyNode( } } DeleteSummaries(nodePtr->summaryPtr); - ckfree((char *) nodePtr->numPixels); - ckfree((char *) nodePtr); + ckfree(nodePtr->numPixels); + ckfree(nodePtr); } /* @@ -910,7 +906,7 @@ DeleteSummaries( while (summaryPtr != NULL) { nextPtr = summaryPtr->nextPtr; - ckfree((char *) summaryPtr); + ckfree(summaryPtr); summaryPtr = nextPtr; } } @@ -1047,8 +1043,7 @@ TkBTreeInsertChars( changeToLineCount = 0; if (treePtr->pixelReferences > PIXEL_CLIENTS) { - changeToPixelCount = (int *) - ckalloc(sizeof(int) * treePtr->pixelReferences); + changeToPixelCount = ckalloc(sizeof(int) * treePtr->pixelReferences); } else { changeToPixelCount = pixels; } @@ -1064,7 +1059,7 @@ TkBTreeInsertChars( } } chunkSize = eol-string; - segPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(chunkSize)); + segPtr = ckalloc(CSEG_SIZE(chunkSize)); segPtr->typePtr = &tkTextCharType; if (curPtr == NULL) { segPtr->nextPtr = linePtr->segPtr; @@ -1086,8 +1081,8 @@ TkBTreeInsertChars( * the remainder of the old line to it. */ - newLinePtr = (TkTextLine *) ckalloc(sizeof(TkTextLine)); - newLinePtr->pixels = (int *) + newLinePtr = ckalloc(sizeof(TkTextLine)); + newLinePtr->pixels = ckalloc(sizeof(int) * 2 * treePtr->pixelReferences); newLinePtr->parentPtr = linePtr->parentPtr; @@ -1147,7 +1142,7 @@ TkBTreeInsertChars( } } if (treePtr->pixelReferences > PIXEL_CLIENTS) { - ckfree((char *) changeToPixelCount); + ckfree(changeToPixelCount); } nodePtr = linePtr->parentPtr; @@ -1205,7 +1200,7 @@ SplitSeg( if (count == 0) { return prevPtr; } - segPtr = (*segPtr->typePtr->splitProc)(segPtr, count); + segPtr = segPtr->typePtr->splitProc(segPtr, count); if (prevPtr == NULL) { indexPtr->linePtr->segPtr = segPtr; } else { @@ -1231,8 +1226,9 @@ SplitSeg( /* * Reached end of the text. */ + } else { + segPtr = linePtr->segPtr; } - segPtr = linePtr->segPtr; } } Tcl_Panic("SplitSeg reached end of line!"); @@ -1280,7 +1276,7 @@ CleanupLine( segPtr != NULL; prevPtrPtr = &(*prevPtrPtr)->nextPtr, segPtr = *prevPtrPtr) { if (segPtr->typePtr->cleanupProc != NULL) { - *prevPtrPtr = (*segPtr->typePtr->cleanupProc)(segPtr, linePtr); + *prevPtrPtr = segPtr->typePtr->cleanupProc(segPtr, linePtr); if (segPtr != *prevPtrPtr) { anyChanges = 1; } @@ -1387,6 +1383,7 @@ TkBTreeDeleteIndexRange( } } changeToLineCount++; + CLANG_ASSERT(curNodePtr); curNodePtr->numChildren--; /* @@ -1417,8 +1414,8 @@ TkBTreeDeleteIndexRange( checkCount++; } } - ckfree((char *) curLinePtr->pixels); - ckfree((char *) curLinePtr); + ckfree(curLinePtr->pixels); + ckfree(curLinePtr); } curLinePtr = nextLinePtr; segPtr = curLinePtr->segPtr; @@ -1442,7 +1439,7 @@ TkBTreeDeleteIndexRange( prevNodePtr->nextPtr = curNodePtr->nextPtr; } parentPtr->numChildren--; - ckfree((char *) curNodePtr); + ckfree(curNodePtr); curNodePtr = parentPtr; } curNodePtr = curLinePtr->parentPtr; @@ -1450,7 +1447,7 @@ TkBTreeDeleteIndexRange( } nextPtr = segPtr->nextPtr; - if ((*segPtr->typePtr->deleteProc)(segPtr, curLinePtr, 0) != 0) { + if (segPtr->typePtr->deleteProc(segPtr, curLinePtr, 0) != 0) { /* * This segment refuses to die. Move it to prevPtr and advance * prevPtr if the segment has left gravity. @@ -1481,7 +1478,7 @@ TkBTreeDeleteIndexRange( for (segPtr = lastPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { if (segPtr->typePtr->lineChangeProc != NULL) { - (*segPtr->typePtr->lineChangeProc)(segPtr, index2Ptr->linePtr); + segPtr->typePtr->lineChangeProc(segPtr, index2Ptr->linePtr); } } curNodePtr = index2Ptr->linePtr->parentPtr; @@ -1537,8 +1534,8 @@ TkBTreeDeleteIndexRange( checkCount++; } } - ckfree((char *) index2Ptr->linePtr->pixels); - ckfree((char *) index2Ptr->linePtr); + ckfree(index2Ptr->linePtr->pixels); + ckfree(index2Ptr->linePtr); Rebalance((BTree *) index2Ptr->tree, curNodePtr); } @@ -1991,7 +1988,7 @@ TkBTreeLinesTo( } } if (textPtr != NULL) { - /* + /* * The index to return must be relative to textPtr, not to the entire * tree. Take care to never return a negative index when linePtr * denotes a line before -startline, or an index larger than the @@ -2157,7 +2154,7 @@ TkBTreeTag( oldState = TkBTreeCharTagged(index1Ptr, tagPtr); if ((add != 0) ^ oldState) { - segPtr = (TkTextSegment *) ckalloc(TSEG_SIZE); + segPtr = ckalloc(TSEG_SIZE); segPtr->typePtr = (add) ? &tkTextToggleOnType : &tkTextToggleOffType; prevPtr = SplitSeg(index1Ptr); if (prevPtr == NULL) { @@ -2202,7 +2199,7 @@ TkBTreeTag( } else { changed = 0; } - ckfree((char *) segPtr); + ckfree(segPtr); /* * The code below is a bit tricky. After deleting a toggle we @@ -2228,7 +2225,7 @@ TkBTreeTag( } } if ((add != 0) ^ oldState) { - segPtr = (TkTextSegment *) ckalloc(TSEG_SIZE); + segPtr = ckalloc(TSEG_SIZE); segPtr->typePtr = (add) ? &tkTextToggleOffType : &tkTextToggleOnType; prevPtr = SplitSeg(index2Ptr); if (prevPtr == NULL) { @@ -2353,7 +2350,7 @@ ChangeNodeToggleCount( } else { prevPtr->nextPtr = summaryPtr->nextPtr; } - ckfree((char *) summaryPtr); + ckfree(summaryPtr); } else { /* * This tag isn't currently in the summary information list. @@ -2372,7 +2369,7 @@ ChangeNodeToggleCount( Node *rootNodePtr = tagPtr->tagRootPtr; - summaryPtr = (Summary *) ckalloc(sizeof(Summary)); + summaryPtr = ckalloc(sizeof(Summary)); summaryPtr->tagPtr = tagPtr; summaryPtr->toggleCount = tagPtr->toggleCount - delta; summaryPtr->nextPtr = rootNodePtr->summaryPtr; @@ -2381,7 +2378,7 @@ ChangeNodeToggleCount( rootLevel = rootNodePtr->level; tagPtr->tagRootPtr = rootNodePtr; } - summaryPtr = (Summary *) ckalloc(sizeof(Summary)); + summaryPtr = ckalloc(sizeof(Summary)); summaryPtr->tagPtr = tagPtr; summaryPtr->toggleCount = delta; summaryPtr->nextPtr = nodePtr->summaryPtr; @@ -2438,7 +2435,7 @@ ChangeNodeToggleCount( } else { prevPtr->nextPtr = summaryPtr->nextPtr; } - ckfree((char *) summaryPtr); + ckfree(summaryPtr); tagPtr->tagRootPtr = node2Ptr; break; } @@ -2487,7 +2484,7 @@ FindTagStart( * level 0 node. */ - while (nodePtr->level > 0) { + while (nodePtr && nodePtr->level > 0) { for (nodePtr = nodePtr->children.nodePtr ; nodePtr != NULL; nodePtr = nodePtr->nextPtr) { for (summaryPtr = nodePtr->summaryPtr ; summaryPtr != NULL; @@ -2501,6 +2498,10 @@ FindTagStart( continue; } + if (nodePtr == NULL) { + return NULL; + } + /* * Work through the lines attached to the level-0 node. */ @@ -2568,7 +2569,7 @@ FindTagEnd( * level 0 node. */ - while (nodePtr->level > 0) { + while (nodePtr && nodePtr->level > 0) { for (lastNodePtr = NULL, nodePtr = nodePtr->children.nodePtr ; nodePtr != NULL; nodePtr = nodePtr->nextPtr) { for (summaryPtr = nodePtr->summaryPtr ; summaryPtr != NULL; @@ -2582,6 +2583,10 @@ FindTagEnd( nodePtr = lastNodePtr; } + if (nodePtr == NULL) { + return NULL; + } + /* * Work through the lines attached to the level-0 node. */ @@ -2951,7 +2956,7 @@ TkBTreeNextTag( } searchPtr->linesLeft -= nodePtr->numLines; if (nodePtr->nextPtr == NULL) { - Tcl_Panic("TkBTreeNextTag found incorrect tag summary info."); + Tcl_Panic("TkBTreeNextTag found incorrect tag summary info"); } } nextChild: @@ -3169,7 +3174,7 @@ TkBTreePrevTag( continue; } if (prevNodePtr == NULL) { - Tcl_Panic("TkBTreePrevTag found incorrect tag summary info."); + Tcl_Panic("TkBTreePrevTag found incorrect tag summary info"); } searchPtr->linesLeft -= linesSkipped; nodePtr = prevNodePtr; @@ -3349,10 +3354,8 @@ TkBTreeGetTags( tagInfo.numTags = 0; tagInfo.arraySize = NUM_TAG_INFOS; - tagInfo.tagPtrs = (TkTextTag **) - ckalloc((unsigned) NUM_TAG_INFOS * sizeof(TkTextTag *)); - tagInfo.counts = (int *) - ckalloc((unsigned) NUM_TAG_INFOS * sizeof(int)); + tagInfo.tagPtrs = ckalloc(NUM_TAG_INFOS * sizeof(TkTextTag *)); + tagInfo.counts = ckalloc(NUM_TAG_INFOS * sizeof(int)); /* * Record tag toggles within the line of indexPtr but preceding indexPtr. @@ -3437,9 +3440,9 @@ TkBTreeGetTags( } } *numTagsPtr = dst; - ckfree((char *) tagInfo.counts); + ckfree(tagInfo.counts); if (dst == 0) { - ckfree((char *) tagInfo.tagPtrs); + ckfree(tagInfo.tagPtrs); return NULL; } return tagInfo.tagPtrs; @@ -3496,8 +3499,7 @@ TkTextIsElided( int elide; if (elideInfo == NULL) { - infoPtr = (TkTextElideInfo *) - ckalloc((unsigned) sizeof(TkTextElideInfo)); + infoPtr = ckalloc(sizeof(TkTextElideInfo)); } else { infoPtr = elideInfo; } @@ -3512,10 +3514,8 @@ TkTextIsElided( */ if (LOTSA_TAGS < infoPtr->numTags) { - infoPtr->tagCnts = (int *) - ckalloc((unsigned) sizeof(int) * infoPtr->numTags); - infoPtr->tagPtrs = (TkTextTag **) - ckalloc((unsigned) sizeof(TkTextTag *) * infoPtr->numTags); + infoPtr->tagCnts = ckalloc(sizeof(int) * infoPtr->numTags); + infoPtr->tagPtrs = ckalloc(sizeof(TkTextTag *) * infoPtr->numTags); } for (i=0; i<infoPtr->numTags; i++) { @@ -3630,11 +3630,11 @@ TkTextIsElided( if (elideInfo == NULL) { if (LOTSA_TAGS < infoPtr->numTags) { - ckfree((char *) infoPtr->tagCnts); - ckfree((char *) infoPtr->tagPtrs); + ckfree(infoPtr->tagCnts); + ckfree(infoPtr->tagPtrs); } - ckfree((char *) infoPtr); + ckfree(infoPtr); } return elide; @@ -3663,8 +3663,8 @@ TkTextFreeElideInfo( * structure. */ { if (LOTSA_TAGS < elideInfo->numTags) { - ckfree((char *) elideInfo->tagCnts); - ckfree((char *) elideInfo->tagPtrs); + ckfree(elideInfo->tagCnts); + ckfree(elideInfo->tagPtrs); } } @@ -3715,16 +3715,15 @@ IncCount( int *newCounts, newSize; newSize = 2 * tagInfoPtr->arraySize; - newTags = (TkTextTag **) - ckalloc((unsigned) newSize * sizeof(TkTextTag *)); + newTags = ckalloc(newSize * sizeof(TkTextTag *)); memcpy(newTags, tagInfoPtr->tagPtrs, tagInfoPtr->arraySize * sizeof(TkTextTag *)); - ckfree((char *) tagInfoPtr->tagPtrs); + ckfree(tagInfoPtr->tagPtrs); tagInfoPtr->tagPtrs = newTags; - newCounts = (int *) ckalloc((unsigned) newSize * sizeof(int)); + newCounts = ckalloc(newSize * sizeof(int)); memcpy(newCounts, tagInfoPtr->counts, tagInfoPtr->arraySize * sizeof(int)); - ckfree((char *) tagInfoPtr->counts); + ckfree(tagInfoPtr->counts); tagInfoPtr->counts = newCounts; tagInfoPtr->arraySize = newSize; } @@ -3772,7 +3771,7 @@ TkBTreeCheck( for (entryPtr=Tcl_FirstHashEntry(&treePtr->sharedTextPtr->tagTable,&search); entryPtr != NULL ; entryPtr = Tcl_NextHashEntry(&search)) { - tagPtr = (TkTextTag *) Tcl_GetHashValue(entryPtr); + tagPtr = Tcl_GetHashValue(entryPtr); nodePtr = tagPtr->tagRootPtr; if (nodePtr == NULL) { if (tagPtr->toggleCount != 0) { @@ -3924,7 +3923,7 @@ CheckNodeConsistency( numChildren = 0; numLines = 0; if (references > PIXEL_CLIENTS) { - numPixels = (int *) ckalloc(sizeof(int) * references); + numPixels = ckalloc(sizeof(int) * references); } else { numPixels = pixels; } @@ -3944,7 +3943,7 @@ CheckNodeConsistency( for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) { if (segPtr->typePtr->checkProc != NULL) { - (*segPtr->typePtr->checkProc)(segPtr, linePtr); + segPtr->typePtr->checkProc(segPtr, linePtr); } if ((segPtr->size == 0) && (!segPtr->typePtr->leftGravity) && (segPtr->nextPtr != NULL) @@ -4013,7 +4012,7 @@ CheckNodeConsistency( } } if (references > PIXEL_CLIENTS) { - ckfree((char *) numPixels); + ckfree(numPixels); } for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL; @@ -4112,7 +4111,7 @@ Rebalance( */ if (nodePtr->parentPtr == NULL) { - newPtr = (Node *) ckalloc(sizeof(Node)); + newPtr = ckalloc(sizeof(Node)); newPtr->parentPtr = NULL; newPtr->nextPtr = NULL; newPtr->summaryPtr = NULL; @@ -4120,7 +4119,7 @@ Rebalance( newPtr->children.nodePtr = nodePtr; newPtr->numChildren = 1; newPtr->numLines = nodePtr->numLines; - newPtr->numPixels = (int *) + newPtr->numPixels = ckalloc(sizeof(int) * treePtr->pixelReferences); for (i=0; i<treePtr->pixelReferences; i++) { newPtr->numPixels[i] = nodePtr->numPixels[i]; @@ -4128,8 +4127,8 @@ Rebalance( RecomputeNodeCounts(treePtr, newPtr); treePtr->rootPtr = newPtr; } - newPtr = (Node *) ckalloc(sizeof(Node)); - newPtr->numPixels = (int *) + newPtr = ckalloc(sizeof(Node)); + newPtr->numPixels = ckalloc(sizeof(int) * treePtr->pixelReferences); for (i=0; i<treePtr->pixelReferences; i++) { newPtr->numPixels[i] = 0; @@ -4186,7 +4185,7 @@ Rebalance( treePtr->rootPtr = nodePtr->children.nodePtr; treePtr->rootPtr->parentPtr = NULL; DeleteSummaries(nodePtr->summaryPtr); - ckfree((char *) nodePtr); + ckfree(nodePtr); } return; } @@ -4275,7 +4274,7 @@ Rebalance( nodePtr->nextPtr = otherPtr->nextPtr; nodePtr->parentPtr->numChildren--; DeleteSummaries(otherPtr->summaryPtr); - ckfree((char *) otherPtr); + ckfree(otherPtr); continue; } @@ -4285,9 +4284,11 @@ Rebalance( */ if (nodePtr->level == 0) { + CLANG_ASSERT(halfwayLinePtr); otherPtr->children.linePtr = halfwayLinePtr->nextPtr; halfwayLinePtr->nextPtr = NULL; } else { + CLANG_ASSERT(halfwayNodePtr); otherPtr->children.nodePtr = halfwayNodePtr->nextPtr; halfwayNodePtr->nextPtr = NULL; } @@ -4371,7 +4372,7 @@ RecomputeNodeCounts( for (summaryPtr = nodePtr->summaryPtr; ; summaryPtr = summaryPtr->nextPtr) { if (summaryPtr == NULL) { - summaryPtr = (Summary *) ckalloc(sizeof(Summary)); + summaryPtr = ckalloc(sizeof(Summary)); summaryPtr->tagPtr = tagPtr; summaryPtr->toggleCount = 1; summaryPtr->nextPtr = nodePtr->summaryPtr; @@ -4399,7 +4400,7 @@ RecomputeNodeCounts( for (summaryPtr = nodePtr->summaryPtr; ; summaryPtr = summaryPtr->nextPtr) { if (summaryPtr == NULL) { - summaryPtr = (Summary *) ckalloc(sizeof(Summary)); + summaryPtr = ckalloc(sizeof(Summary)); summaryPtr->tagPtr = summaryPtr2->tagPtr; summaryPtr->toggleCount = summaryPtr2->toggleCount; summaryPtr->nextPtr = nodePtr->summaryPtr; @@ -4448,11 +4449,11 @@ RecomputeNodeCounts( } if (summaryPtr2 != NULL) { summaryPtr2->nextPtr = summaryPtr->nextPtr; - ckfree((char *) summaryPtr); + ckfree(summaryPtr); summaryPtr = summaryPtr2->nextPtr; } else { nodePtr->summaryPtr = summaryPtr->nextPtr; - ckfree((char *) summaryPtr); + ckfree(summaryPtr); summaryPtr = nodePtr->summaryPtr; } } @@ -4552,9 +4553,8 @@ CharSplitProc( { TkTextSegment *newPtr1, *newPtr2; - newPtr1 = (TkTextSegment *) ckalloc(CSEG_SIZE(index)); - newPtr2 = (TkTextSegment *) ckalloc( - CSEG_SIZE(segPtr->size - index)); + newPtr1 = ckalloc(CSEG_SIZE(index)); + newPtr2 = ckalloc(CSEG_SIZE(segPtr->size - index)); newPtr1->typePtr = &tkTextCharType; newPtr1->nextPtr = newPtr2; newPtr1->size = index; @@ -4565,7 +4565,7 @@ CharSplitProc( newPtr2->size = segPtr->size - index; memcpy(newPtr2->body.chars, segPtr->body.chars + index, newPtr2->size); newPtr2->body.chars[newPtr2->size] = 0; - ckfree((char *) segPtr); + ckfree(segPtr); return newPtr1; } @@ -4600,16 +4600,15 @@ CharCleanupProc( if ((segPtr2 == NULL) || (segPtr2->typePtr != &tkTextCharType)) { return segPtr; } - newPtr = (TkTextSegment *) ckalloc(CSEG_SIZE( - segPtr->size + segPtr2->size)); + newPtr = ckalloc(CSEG_SIZE(segPtr->size + segPtr2->size)); newPtr->typePtr = &tkTextCharType; newPtr->nextPtr = segPtr2->nextPtr; newPtr->size = segPtr->size + segPtr2->size; memcpy(newPtr->body.chars, segPtr->body.chars, segPtr->size); memcpy(newPtr->body.chars + segPtr->size, segPtr2->body.chars, segPtr2->size); newPtr->body.chars[newPtr->size] = 0; - ckfree((char *) segPtr); - ckfree((char *) segPtr2); + ckfree(segPtr); + ckfree(segPtr2); return newPtr; } @@ -4638,7 +4637,7 @@ CharDeleteProc( * deleted, so everything must get cleaned * up. */ { - ckfree((char *) segPtr); + ckfree(segPtr); return 0; } @@ -4714,7 +4713,7 @@ ToggleDeleteProc( * up. */ { if (treeGone) { - ckfree((char *) segPtr); + ckfree(segPtr); return 0; } @@ -4788,9 +4787,9 @@ ToggleCleanupProc( segPtr->body.toggle.tagPtr, -counts); } prevPtr->nextPtr = segPtr2->nextPtr; - ckfree((char *) segPtr2); + ckfree(segPtr2); segPtr2 = segPtr->nextPtr; - ckfree((char *) segPtr); + ckfree(segPtr); return segPtr2; } } diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 133a7d7..a57c24b 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -16,7 +16,7 @@ #include "tkInt.h" #include "tkText.h" -#ifdef __WIN32__ +#ifdef _WIN32 #include "tkWinInt.h" #elif defined(__CYGWIN__) #include "tkUnixInt.h" @@ -416,8 +416,8 @@ typedef struct TextDInfo { typedef struct CharInfo { int numBytes; /* Number of bytes to display. */ - char chars[4]; /* UTF characters to display. Actual size will - * be numBytes, not 4. THIS MUST BE THE LAST + char chars[1]; /* UTF characters to display. Actual size will + * be numBytes, not 1. THIS MUST BE THE LAST * FIELD IN THE STRUCTURE. */ } CharInfo; @@ -447,6 +447,7 @@ typedef struct BaseCharInfo { * LayoutDLine(). */ } BaseCharInfo; +/* TODO: Thread safety */ static TkTextDispChunk *baseCharChunkPtr = NULL; #endif /* TK_LAYOUT_WITH_BASE_CHUNKS */ @@ -544,23 +545,23 @@ static void DisplayLineBackground(TkText *textPtr, DLine *dlPtr, DLine *prevPtr, Pixmap pixmap); static void DisplayText(ClientData clientData); static DLine * FindDLine(TkText *textPtr, DLine *dlPtr, - CONST TkTextIndex *indexPtr); + const TkTextIndex *indexPtr); static void FreeDLines(TkText *textPtr, DLine *firstPtr, DLine *lastPtr, int action); static void FreeStyle(TkText *textPtr, TextStyle *stylePtr); -static TextStyle * GetStyle(TkText *textPtr, CONST TkTextIndex *indexPtr); +static TextStyle * GetStyle(TkText *textPtr, const TkTextIndex *indexPtr); static void GetXView(Tcl_Interp *interp, TkText *textPtr, int report); static void GetYView(Tcl_Interp *interp, TkText *textPtr, int report); static int GetYPixelCount(TkText *textPtr, DLine *dlPtr); static DLine * LayoutDLine(TkText *textPtr, - CONST TkTextIndex *indexPtr); -static int MeasureChars(Tk_Font tkfont, CONST char *source, + const TkTextIndex *indexPtr); +static int MeasureChars(Tk_Font tkfont, const char *source, int maxBytes, int rangeStart, int rangeLength, int startX, int maxX, int flags, int *nextXPtr); static void MeasureUp(TkText *textPtr, - CONST TkTextIndex *srcPtr, int distance, + const TkTextIndex *srcPtr, int distance, TkTextIndex *dstPtr, int *overlap); static int NextTabStop(Tk_Font tkfont, int x, int tabOrigin); static void UpdateDisplayInfo(TkText *textPtr); @@ -570,8 +571,8 @@ static int SizeOfTab(TkText *textPtr, int tabStyle, TkTextTabArray *tabArrayPtr, int *indexPtr, int x, int maxX); static void TextChanged(TkText *textPtr, - CONST TkTextIndex *index1Ptr, - CONST TkTextIndex *index2Ptr); + const TkTextIndex *index1Ptr, + const TkTextIndex *index2Ptr); static void TextInvalidateRegion(TkText *textPtr, TkRegion region); static void TextRedrawTag(TkText *textPtr, TkTextIndex *index1Ptr, TkTextIndex *index2Ptr, @@ -579,7 +580,7 @@ static void TextRedrawTag(TkText *textPtr, static void TextInvalidateLineMetrics(TkText *textPtr, TkTextLine *linePtr, int lineCount, int action); static int CalculateDisplayLineHeight(TkText *textPtr, - CONST TkTextIndex *indexPtr, int *byteCountPtr, + const TkTextIndex *indexPtr, int *byteCountPtr, int *mergedLinePtr); static void DlineIndexOfX(TkText *textPtr, DLine *dlPtr, int x, TkTextIndex *indexPtr); @@ -587,7 +588,7 @@ static int DlineXOfIndex(TkText *textPtr, DLine *dlPtr, int byteIndex); static int TextGetScrollInfoObj(Tcl_Interp *interp, TkText *textPtr, int objc, - Tcl_Obj *CONST objv[], double *dblPtr, + Tcl_Obj *const objv[], double *dblPtr, int *intPtr); static void AsyncUpdateLineMetrics(ClientData clientData); static void AsyncUpdateYScrollbar(ClientData clientData); @@ -629,7 +630,7 @@ TkTextCreateDInfo( register TextDInfo *dInfoPtr; XGCValues gcValues; - dInfoPtr = (TextDInfo *) ckalloc(sizeof(TextDInfo)); + dInfoPtr = ckalloc(sizeof(TextDInfo)); Tcl_InitHashTable(&dInfoPtr->styleTable, sizeof(StyleValues)/sizeof(int)); dInfoPtr->dLinePtr = NULL; dInfoPtr->copyGC = None; @@ -701,7 +702,7 @@ TkTextFreeDInfo( } Tk_FreeGC(textPtr->display, dInfoPtr->scrollGC); if (dInfoPtr->flags & REDRAW_PENDING) { - Tcl_CancelIdleCall(DisplayText, (ClientData) textPtr); + Tcl_CancelIdleCall(DisplayText, textPtr); } if (dInfoPtr->lineUpdateTimer != NULL) { Tcl_DeleteTimerHandler(dInfoPtr->lineUpdateTimer); @@ -713,7 +714,7 @@ TkTextFreeDInfo( textPtr->refCount--; dInfoPtr->scrollbarTimer = NULL; } - ckfree((char *) dInfoPtr); + ckfree(dInfoPtr); } /* @@ -737,7 +738,7 @@ TkTextFreeDInfo( static TextStyle * GetStyle( TkText *textPtr, /* Overall information about text widget. */ - CONST TkTextIndex *indexPtr)/* The character in the text for which display + const TkTextIndex *indexPtr)/* The character in the text for which display * information is wanted. */ { TkTextTag **tagPtrs; @@ -917,7 +918,7 @@ GetStyle( } } if (tagPtrs != NULL) { - ckfree((char *) tagPtrs); + ckfree(tagPtrs); } /* @@ -927,7 +928,7 @@ GetStyle( hPtr = Tcl_CreateHashEntry(&textPtr->dInfoPtr->styleTable, (char *) &styleValues, &isNew); if (!isNew) { - stylePtr = (TextStyle *) Tcl_GetHashValue(hPtr); + stylePtr = Tcl_GetHashValue(hPtr); stylePtr->refCount++; return stylePtr; } @@ -936,7 +937,7 @@ GetStyle( * No existing style matched. Make a new one. */ - stylePtr = (TextStyle *) ckalloc(sizeof(TextStyle)); + stylePtr = ckalloc(sizeof(TextStyle)); stylePtr->refCount = 1; if (styleValues.border != NULL) { gcValues.foreground = Tk_3DBorderColor(styleValues.border)->pixel; @@ -1001,7 +1002,7 @@ FreeStyle( Tk_FreeGC(textPtr->display, stylePtr->fgGC); } Tcl_DeleteHashEntry(stylePtr->hPtr); - ckfree((char *) stylePtr); + ckfree(stylePtr); } } @@ -1042,7 +1043,7 @@ FreeStyle( static DLine * LayoutDLine( TkText *textPtr, /* Overall information about text widget. */ - CONST TkTextIndex *indexPtr)/* Beginning of display line. May not + const TkTextIndex *indexPtr)/* Beginning of display line. May not * necessarily point to a character * segment. */ { @@ -1100,7 +1101,7 @@ LayoutDLine( * Create and initialize a new DLine structure. */ - dlPtr = (DLine *) ckalloc(sizeof(DLine)); + dlPtr = ckalloc(sizeof(DLine)); dlPtr->index = *indexPtr; dlPtr->byteCount = 0; dlPtr->y = 0; @@ -1260,14 +1261,14 @@ LayoutDLine( */ TkTextLine *linePtr = TkBTreeNextLine(NULL, curIndex.linePtr); - if (linePtr != NULL) { - dlPtr->logicalLinesMerged++; - curIndex.byteIndex = 0; - curIndex.linePtr = linePtr; - segPtr = curIndex.linePtr->segPtr; - } else { + if (linePtr == NULL) { break; } + + dlPtr->logicalLinesMerged++; + curIndex.byteIndex = 0; + curIndex.linePtr = linePtr; + segPtr = curIndex.linePtr->segPtr; } } @@ -1331,7 +1332,7 @@ LayoutDLine( * into a single display line. * if (segPtr == NULL && chunkPtr != NULL) { - ckfree((char *) chunkPtr); + ckfree(chunkPtr); chunkPtr = NULL; } */ @@ -1345,7 +1346,7 @@ LayoutDLine( continue; } if (chunkPtr == NULL) { - chunkPtr = (TkTextDispChunk *) ckalloc(sizeof(TkTextDispChunk)); + chunkPtr = ckalloc(sizeof(TkTextDispChunk)); chunkPtr->nextPtr = NULL; chunkPtr->clientData = NULL; } @@ -1454,7 +1455,7 @@ LayoutDLine( code = 1; } else { - code = (*segPtr->typePtr->layoutProc)(textPtr, &curIndex, segPtr, + code = segPtr->typePtr->layoutProc(textPtr, &curIndex, segPtr, byteOffset, maxX-tabSize, maxBytes, noCharsYet, wrapMode, chunkPtr); } @@ -1477,7 +1478,7 @@ LayoutDLine( */ if (chunkPtr != NULL) { - ckfree((char *) chunkPtr); + ckfree(chunkPtr); } break; } @@ -1606,18 +1607,18 @@ LayoutDLine( FreeStyle(textPtr, chunkPtr->stylePtr); breakChunkPtr->nextPtr = chunkPtr->nextPtr; if (chunkPtr->undisplayProc != NULL) { - (*chunkPtr->undisplayProc)(textPtr, chunkPtr); + chunkPtr->undisplayProc(textPtr, chunkPtr); } - ckfree((char *) chunkPtr); + ckfree(chunkPtr); } if (breakByteOffset != breakChunkPtr->numBytes) { if (breakChunkPtr->undisplayProc != NULL) { - (*breakChunkPtr->undisplayProc)(textPtr, breakChunkPtr); + breakChunkPtr->undisplayProc(textPtr, breakChunkPtr); } segPtr = TkTextIndexToSeg(&breakIndex, &byteOffset); - (*segPtr->typePtr->layoutProc)(textPtr, &breakIndex, - segPtr, byteOffset, maxX, breakByteOffset, 0, - wrapMode, breakChunkPtr); + segPtr->typePtr->layoutProc(textPtr, &breakIndex, segPtr, + byteOffset, maxX, breakByteOffset, 0, wrapMode, + breakChunkPtr); #if TK_LAYOUT_WITH_BASE_CHUNKS FinalizeBaseChunk(NULL); #endif /* TK_LAYOUT_WITH_BASE_CHUNKS */ @@ -2302,13 +2303,13 @@ FreeDLines( for (chunkPtr = firstPtr->chunkPtr; chunkPtr != NULL; chunkPtr = nextChunkPtr) { if (chunkPtr->undisplayProc != NULL) { - (*chunkPtr->undisplayProc)(textPtr, chunkPtr); + chunkPtr->undisplayProc(textPtr, chunkPtr); } FreeStyle(textPtr, chunkPtr->stylePtr); nextChunkPtr = chunkPtr->nextPtr; - ckfree((char *) chunkPtr); + ckfree(chunkPtr); } - ckfree((char *) firstPtr); + ckfree(firstPtr); firstPtr = nextDLinePtr; } if (action != DLINE_FREE_TEMP) { @@ -2400,7 +2401,7 @@ DisplayDLine( if (chunkPtr->displayProc == TkTextInsertDisplayProc) { int x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curXPixelOffset; - (*chunkPtr->displayProc)(textPtr, chunkPtr, x, + chunkPtr->displayProc(textPtr, chunkPtr, x, y + dlPtr->spaceAbove, dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, dlPtr->baseline - dlPtr->spaceAbove, display, pixmap, @@ -2448,7 +2449,7 @@ DisplayDLine( x = -chunkPtr->width; } - (*chunkPtr->displayProc)(textPtr, chunkPtr, x, + chunkPtr->displayProc(textPtr, chunkPtr, x, y + dlPtr->spaceAbove, dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, dlPtr->baseline - dlPtr->spaceAbove, display, pixmap, dlPtr->y + dlPtr->spaceAbove); @@ -2897,7 +2898,7 @@ static void AsyncUpdateLineMetrics( ClientData clientData) /* Information about widget. */ { - register TkText *textPtr = (TkText *) clientData; + register TkText *textPtr = clientData; TextDInfo *dInfoPtr = textPtr->dInfoPtr; int lineNum; @@ -2910,7 +2911,7 @@ AsyncUpdateLineMetrics( */ if (--textPtr->refCount == 0) { - ckfree((char *) textPtr); + ckfree(textPtr); } return; } @@ -2921,6 +2922,11 @@ AsyncUpdateLineMetrics( return; } + /* + * Reify where we end or all hell breaks loose with the calculations when + * we try to update. [Bug 2677890] + */ + lineNum = dInfoPtr->currentMetricUpdateLine; if (dInfoPtr->lastMetricUpdateLine == -1) { dInfoPtr->lastMetricUpdateLine = @@ -2957,7 +2963,7 @@ AsyncUpdateLineMetrics( textPtr->refCount--; if (textPtr->refCount == 0) { - ckfree((char *) textPtr); + ckfree(textPtr); } return; } @@ -2969,7 +2975,7 @@ AsyncUpdateLineMetrics( */ dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1, - AsyncUpdateLineMetrics, (ClientData) textPtr); + AsyncUpdateLineMetrics, textPtr); } /* @@ -3070,86 +3076,82 @@ TkTextUpdateLineMetrics( */ if (TkBTreeLinePixelEpoch(textPtr, linePtr) - != textPtr->dInfoPtr->lineMetricUpdateEpoch) { - if (doThisMuch == -1) { - count += 8 * TkTextUpdateOneLine(textPtr, linePtr, 0, - NULL, 0); - } else { - TkTextIndex index; - TkTextIndex *indexPtr; - int pixelHeight; + == textPtr->dInfoPtr->lineMetricUpdateEpoch) { + /* + * This line is already up to date. That means there's nothing + * to do here. + */ + } else if (doThisMuch == -1) { + count += 8 * TkTextUpdateOneLine(textPtr, linePtr, 0,NULL,0); + } else { + TkTextIndex index; + TkTextIndex *indexPtr; + int pixelHeight; + /* + * If the metric epoch is the same as the widget's epoch, then + * we know that indexPtrs are still valid, and if the cached + * metricIndex (if any) is for the same line as we wish to + * examine, then we are looking at a long line wrapped many + * times, which we will examine in pieces. + */ + + if (textPtr->dInfoPtr->metricEpoch == + textPtr->sharedTextPtr->stateEpoch && + textPtr->dInfoPtr->metricIndex.linePtr==linePtr) { + indexPtr = &textPtr->dInfoPtr->metricIndex; + pixelHeight = textPtr->dInfoPtr->metricPixelHeight; + } else { /* - * If the metric epoch is the same as the widget's epoch, - * then we know that indexPtrs are still valid, and if the - * cached metricIndex (if any) is for the same line as we - * wish to examine, then we are looking at a long line - * wrapped many times, which we will examine in pieces. + * We must reset the partial line height calculation data + * here, so we don't use it when it is out of date. */ - if (textPtr->dInfoPtr->metricEpoch == - textPtr->sharedTextPtr->stateEpoch && - textPtr->dInfoPtr->metricIndex.linePtr==linePtr) { - indexPtr = &textPtr->dInfoPtr->metricIndex; - pixelHeight = textPtr->dInfoPtr->metricPixelHeight; - } else { - /* - * We must reset the partial line height calculation - * data here, so we don't use it when it is out of - * date. - */ + textPtr->dInfoPtr->metricEpoch = -1; + index.tree = textPtr->sharedTextPtr->tree; + index.linePtr = linePtr; + index.byteIndex = 0; + index.textPtr = NULL; + indexPtr = &index; + pixelHeight = 0; + } - textPtr->dInfoPtr->metricEpoch = -1; - index.tree = textPtr->sharedTextPtr->tree; - index.linePtr = linePtr; - index.byteIndex = 0; - index.textPtr = NULL; - indexPtr = &index; - pixelHeight = 0; - } + /* + * Update the line and update the counter, counting 8 for each + * display line we actually re-layout. + */ + + count += 8 * TkTextUpdateOneLine(textPtr, linePtr, + pixelHeight, indexPtr, 1); + if (indexPtr->linePtr == linePtr) { /* - * Update the line and update the counter, counting 8 for - * each display line we actually re-layout. + * We didn't complete the logical line, because it + * produced very many display lines, which must be because + * it must be a long line wrapped many times. So we must + * cache as far as we got for next time around. */ - count += 8 * TkTextUpdateOneLine(textPtr, linePtr, - pixelHeight, indexPtr, 1); - - if (indexPtr->linePtr == linePtr) { - /* - * We didn't complete the logical line, because it - * produced very many display lines - it must be a - * long line wrapped many times. So we must cache as - * far as we got for next time around. - */ - - if (pixelHeight == 0) { - /* - * These have already been stored, unless we just - * started the new line. - */ - - textPtr->dInfoPtr->metricIndex = index; - textPtr->dInfoPtr->metricEpoch = - textPtr->sharedTextPtr->stateEpoch; - } - textPtr->dInfoPtr->metricPixelHeight = - TkBTreeLinePixelCount(textPtr, linePtr); - break; - } else { + if (pixelHeight == 0) { /* - * We're done with this long line. + * These have already been stored, unless we just + * started the new line. */ - textPtr->dInfoPtr->metricEpoch = -1; + textPtr->dInfoPtr->metricIndex = index; + textPtr->dInfoPtr->metricEpoch = + textPtr->sharedTextPtr->stateEpoch; } + textPtr->dInfoPtr->metricPixelHeight = + TkBTreeLinePixelCount(textPtr, linePtr); + break; } - } else { + /* - * This line is already up to date. That means there's nothing - * to do here. + * We're done with this long line. */ + + textPtr->dInfoPtr->metricEpoch = -1; } } else { /* @@ -3350,7 +3352,7 @@ TextInvalidateLineMetrics( if (dInfoPtr->lineUpdateTimer == NULL) { textPtr->refCount++; dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1, - AsyncUpdateLineMetrics, (ClientData) textPtr); + AsyncUpdateLineMetrics, textPtr); } } @@ -3400,6 +3402,8 @@ TkTextFindDisplayLineEnd( * of the original index within its display * line. */ { + TkTextIndex index; + if (!end && IsStartOfNotMergedLine(textPtr, indexPtr)) { /* * Nothing to do. @@ -3409,96 +3413,94 @@ TkTextFindDisplayLineEnd( *xOffset = 0; } return; - } else { - TkTextIndex index = *indexPtr; - - index.byteIndex = 0; - index.textPtr = NULL; - - while (1) { - TkTextIndex endOfLastLine; + } - if (TkTextIndexBackBytes(textPtr, &index, 1, &endOfLastLine)) { - /* - * Reached beginning of text. - */ + index = *indexPtr; + index.byteIndex = 0; + index.textPtr = NULL; - break; - } + while (1) { + TkTextIndex endOfLastLine; - if (!TkTextIsElided(textPtr, &endOfLastLine, NULL)) { - /* - * The eol is not elided, so 'index' points to the start of a - * display line (as well as logical line). - */ + if (TkTextIndexBackBytes(textPtr, &index, 1, &endOfLastLine)) { + /* + * Reached beginning of text. + */ - break; - } + break; + } + if (!TkTextIsElided(textPtr, &endOfLastLine, NULL)) { /* - * indexPtr's logical line is actually merged with the previous - * logical line whose eol is elided. Continue searching back to - * get a real line start. + * The eol is not elided, so 'index' points to the start of a + * display line (as well as logical line). */ - index = endOfLastLine; - index.byteIndex = 0; + break; } - while (1) { - DLine *dlPtr; - int byteCount; - TkTextIndex nextLineStart; + /* + * indexPtr's logical line is actually merged with the previous + * logical line whose eol is elided. Continue searching back to get a + * real line start. + */ - dlPtr = LayoutDLine(textPtr, &index); - byteCount = dlPtr->byteCount; + index = endOfLastLine; + index.byteIndex = 0; + } + + while (1) { + DLine *dlPtr; + int byteCount; + TkTextIndex nextLineStart; - TkTextIndexForwBytes(textPtr, &index, byteCount, &nextLineStart); + dlPtr = LayoutDLine(textPtr, &index); + byteCount = dlPtr->byteCount; + TkTextIndexForwBytes(textPtr, &index, byteCount, &nextLineStart); + + /* + * 'byteCount' goes up to the beginning of the next display line, so + * equality here says we need one more line. We try to perform a quick + * comparison which is valid for the case where the logical line is + * the same, but otherwise fall back on a full TkTextIndexCmp. + */ + + if (((index.linePtr == indexPtr->linePtr) + && (index.byteIndex + byteCount > indexPtr->byteIndex)) + || (dlPtr->logicalLinesMerged > 0 + && TkTextIndexCmp(&nextLineStart, indexPtr) > 0)) { /* - * 'byteCount' goes up to the beginning of the next display line, - * so equality here says we need one more line. We try to perform - * a quick comparison which is valid for the case where the - * logical line is the same, but otherwise fall back on a full - * TkTextIndexCmp. + * It's on this display line. */ - if (((index.linePtr == indexPtr->linePtr) - && (index.byteIndex + byteCount > indexPtr->byteIndex)) - || (dlPtr->logicalLinesMerged > 0 - && TkTextIndexCmp(&nextLineStart, indexPtr) > 0)) { + if (xOffset != NULL) { /* - * It's on this display line. + * This call takes a byte index relative to the start of the + * current _display_ line, not logical line. We are about to + * overwrite indexPtr->byteIndex, so we must do this now. */ - if (xOffset != NULL) { - /* - * This call takes a byte index relative to the start of - * the current _display_ line, not logical line. We are - * about to overwrite indexPtr->byteIndex, so we must do - * this now. - */ - - *xOffset = DlineXOfIndex(textPtr, dlPtr, - TkTextIndexCountBytes(textPtr, &dlPtr->index, - indexPtr)); - } - if (end) { - /* - * The index we want is one less than the number of bytes - * in the display line. - */ + *xOffset = DlineXOfIndex(textPtr, dlPtr, + TkTextIndexCountBytes(textPtr, &dlPtr->index, + indexPtr)); + } + if (end) { + /* + * The index we want is one less than the number of bytes in + * the display line. + */ - TkTextIndexBackBytes(textPtr, &nextLineStart, 1, indexPtr); - } else { - *indexPtr = index; - } - FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP); - return; + TkTextIndexBackBytes(textPtr, &nextLineStart, 1, indexPtr); + } else { + *indexPtr = index; } FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP); - index = nextLineStart; + return; } + + FreeDLines(textPtr, dlPtr, NULL, DLINE_FREE_TEMP); + index = nextLineStart; } } @@ -3540,7 +3542,7 @@ TkTextFindDisplayLineEnd( static int CalculateDisplayLineHeight( TkText *textPtr, /* Widget record for text widget. */ - CONST TkTextIndex *indexPtr,/* The index at the beginning of the display + const TkTextIndex *indexPtr,/* The index at the beginning of the display * line of interest. */ int *byteCountPtr, /* NULL or used to return the number of byte * indices on the given display line. */ @@ -3632,7 +3634,7 @@ CalculateDisplayLineHeight( int TkTextIndexYPixels( TkText *textPtr, /* Widget record for text widget. */ - CONST TkTextIndex *indexPtr)/* The index of which we want the pixel + const TkTextIndex *indexPtr)/* The index of which we want the pixel * distance from top of logical line to top of * index. */ { @@ -3925,7 +3927,7 @@ TkTextUpdateOneLine( if (textPtr->dInfoPtr->scrollbarTimer == NULL) { textPtr->refCount++; textPtr->dInfoPtr->scrollbarTimer = Tcl_CreateTimerHandler(200, - AsyncUpdateYScrollbar, (ClientData) textPtr); + AsyncUpdateYScrollbar, textPtr); } return displayLines; } @@ -3951,7 +3953,7 @@ static void DisplayText( ClientData clientData) /* Information about widget. */ { - register TkText *textPtr = (TkText *) clientData; + register TkText *textPtr = clientData; TextDInfo *dInfoPtr = textPtr->dInfoPtr; register DLine *dlPtr; DLine *prevPtr; @@ -3969,8 +3971,8 @@ DisplayText( TkWindow *winPtr = (TkWindow *)(textPtr->tkwin); MacDrawable *macWin = winPtr->privatePtr; if (macWin && (macWin->flags & TK_DO_NOT_DRAW)){ - dInfoPtr->flags &= ~REDRAW_PENDING; - return; + dInfoPtr->flags &= ~REDRAW_PENDING; + return; } #endif @@ -3983,7 +3985,7 @@ DisplayText( } interp = textPtr->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); if (tkTextDebug) { Tcl_SetVar2(interp, "tk_textRelayout", NULL, "", TCL_GLOBAL_ONLY); @@ -4013,7 +4015,7 @@ DisplayText( dInfoPtr->flags &= ~REPICK_NEEDED; TkTextPickCurrent(textPtr, &textPtr->pickEvent); if (--textPtr->refCount == 0) { - ckfree((char *) textPtr); + ckfree(textPtr); goto end; } if ((textPtr->tkwin == NULL) || (textPtr->flags & DESTROYED)) { @@ -4093,7 +4095,7 @@ DisplayText( */ if ((y + height) > dInfoPtr->maxY) { - height = dInfoPtr->maxY -y; + height = dInfoPtr->maxY - y; } oldY = dlPtr->oldY; if (y < dInfoPtr->y) { @@ -4406,7 +4408,7 @@ DisplayText( } end: - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } /* @@ -4435,7 +4437,7 @@ TkTextEventuallyRepick( dInfoPtr->flags |= REPICK_NEEDED; if (!(dInfoPtr->flags & REDRAW_PENDING)) { dInfoPtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } } @@ -4479,7 +4481,7 @@ TkTextRedrawRegion( if (!(dInfoPtr->flags & REDRAW_PENDING)) { dInfoPtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } TkDestroyRegion(damageRgn); } @@ -4573,8 +4575,8 @@ void TkTextChanged( TkSharedText *sharedTextPtr,/* Shared widget section, or NULL. */ TkText *textPtr, /* Widget record for text widget, or NULL. */ - CONST TkTextIndex*index1Ptr,/* Index of first character to redisplay. */ - CONST TkTextIndex*index2Ptr)/* Index of character just after last one to + const TkTextIndex*index1Ptr,/* Index of first character to redisplay. */ + const TkTextIndex*index2Ptr)/* Index of character just after last one to * redisplay. */ { if (sharedTextPtr == NULL) { @@ -4591,8 +4593,8 @@ TkTextChanged( static void TextChanged( TkText *textPtr, /* Widget record for text widget, or NULL. */ - CONST TkTextIndex*index1Ptr,/* Index of first character to redisplay. */ - CONST TkTextIndex*index2Ptr)/* Index of character just after last one to + const TkTextIndex*index1Ptr,/* Index of first character to redisplay. */ + const TkTextIndex*index2Ptr)/* Index of character just after last one to * redisplay. */ { TextDInfo *dInfoPtr = textPtr->dInfoPtr; @@ -4618,7 +4620,7 @@ TextChanged( */ if (!(dInfoPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; @@ -4862,7 +4864,7 @@ TextRedrawTag( */ if (!(dInfoPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; @@ -4966,7 +4968,7 @@ TkTextRelayoutWindow( */ if (!(dInfoPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } dInfoPtr->flags |= REDRAW_PENDING|REDRAW_BORDERS|DINFO_OUT_OF_DATE |REPICK_NEEDED; @@ -5061,7 +5063,7 @@ TkTextRelayoutWindow( if (dInfoPtr->lineUpdateTimer == NULL) { textPtr->refCount++; dInfoPtr->lineUpdateTimer = Tcl_CreateTimerHandler(1, - AsyncUpdateLineMetrics, (ClientData) textPtr); + AsyncUpdateLineMetrics, textPtr); } } } @@ -5257,7 +5259,7 @@ TkTextSetYView( scheduleUpdate: if (!(dInfoPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; } @@ -5347,7 +5349,7 @@ TkTextMeasureDown( static void MeasureUp( TkText *textPtr, /* Text widget in which to measure. */ - CONST TkTextIndex *srcPtr, /* Index of character from which to start + const TkTextIndex *srcPtr, /* Index of character from which to start * measuring. */ int distance, /* Vertical distance in pixels measured from * the pixel just below the lowest one in @@ -5466,7 +5468,7 @@ TkTextSeeCmd( TkText *textPtr, /* Information about text widget. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. Someone else has already + Tcl_Obj *const objv[]) /* Argument objects. Someone else has already * parsed this command enough to know that * objv[1] is "see". */ { @@ -5546,7 +5548,7 @@ TkTextSeeCmd( */ if (chunkPtr != NULL) { - (*chunkPtr->bboxProc)(textPtr, chunkPtr, byteCount, + chunkPtr->bboxProc(textPtr, chunkPtr, byteCount, dlPtr->y + dlPtr->spaceAbove, dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width, @@ -5555,27 +5557,26 @@ TkTextSeeCmd( oneThird = lineWidth/3; if (delta < 0) { if (delta < -oneThird) { - dInfoPtr->newXPixelOffset = (x - lineWidth/2); + dInfoPtr->newXPixelOffset = x - lineWidth/2; } else { - dInfoPtr->newXPixelOffset -= ((-delta) ); + dInfoPtr->newXPixelOffset += delta; } } else { - delta -= (lineWidth - width); - if (delta > 0) { - if (delta > oneThird) { - dInfoPtr->newXPixelOffset = (x - lineWidth/2); - } else { - dInfoPtr->newXPixelOffset += (delta ); - } - } else { + delta -= lineWidth - width; + if (delta <= 0) { return TCL_OK; } + if (delta > oneThird) { + dInfoPtr->newXPixelOffset = x - lineWidth/2; + } else { + dInfoPtr->newXPixelOffset += delta; + } } } dInfoPtr->flags |= DINFO_OUT_OF_DATE; if (!(dInfoPtr->flags & REDRAW_PENDING)) { dInfoPtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } return TCL_OK; } @@ -5603,7 +5604,7 @@ TkTextXviewCmd( TkText *textPtr, /* Information about text widget. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. Someone else has already + Tcl_Obj *const objv[]) /* Argument objects. Someone else has already * parsed this command enough to know that * objv[1] is "xview". */ { @@ -5656,7 +5657,7 @@ TkTextXviewCmd( dInfoPtr->flags |= DINFO_OUT_OF_DATE; if (!(dInfoPtr->flags & REDRAW_PENDING)) { dInfoPtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } return TCL_OK; } @@ -5741,7 +5742,7 @@ YScrollByPixels( return; } if (!(dInfoPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; } @@ -5876,7 +5877,7 @@ YScrollByLines( scheduleUpdate: if (!(dInfoPtr->flags & REDRAW_PENDING)) { - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED; } @@ -5904,7 +5905,7 @@ TkTextYviewCmd( TkText *textPtr, /* Information about text widget. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. Someone else has already + Tcl_Obj *const objv[]) /* Argument objects. Someone else has already * parsed this command enough to know that * objv[1] is "yview". */ { @@ -5930,7 +5931,7 @@ TkTextYviewCmd( pickPlace = 0; if (Tcl_GetString(objv[2])[0] == '-') { - register CONST char *switchStr = + register const char *switchStr = Tcl_GetStringFromObj(objv[2], &switchLength); if ((switchLength >= 2) && (strncmp(switchStr, "-pickplace", @@ -6085,7 +6086,7 @@ TkTextScanCmd( register TkText *textPtr, /* Information about text widget. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. Someone else has already + Tcl_Obj *const objv[]) /* Argument objects. Someone else has already * parsed this command enough to know that * objv[1] is "scan". */ { @@ -6156,7 +6157,7 @@ TkTextScanCmd( dInfoPtr->flags |= DINFO_OUT_OF_DATE; if (!(dInfoPtr->flags & REDRAW_PENDING)) { dInfoPtr->flags |= REDRAW_PENDING; - Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr); + Tcl_DoWhenIdle(DisplayText, textPtr); } } else if (c=='m' && strncmp(Tcl_GetString(objv[2]), "mark", length)==0) { dInfoPtr->scanMarkXPixel = dInfoPtr->newXPixelOffset; @@ -6164,8 +6165,11 @@ TkTextScanCmd( dInfoPtr->scanTotalYScroll = 0; dInfoPtr->scanMarkY = y; } else { - Tcl_AppendResult(interp, "bad scan option \"", Tcl_GetString(objv[2]), - "\": must be mark or dragto", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad scan option \"%s\": must be mark or dragto", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "scan option", + Tcl_GetString(objv[2]), NULL); return TCL_ERROR; } return TCL_OK; @@ -6238,16 +6242,22 @@ GetXView( if (textPtr->xScrollCmd != NULL) { char buf1[TCL_DOUBLE_SPACE+1]; char buf2[TCL_DOUBLE_SPACE+1]; + Tcl_DString buf; buf1[0] = ' '; buf2[0] = ' '; Tcl_PrintDouble(NULL, first, buf1+1); Tcl_PrintDouble(NULL, last, buf2+1); - code = Tcl_VarEval(interp, textPtr->xScrollCmd, buf1, buf2, NULL); + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, textPtr->xScrollCmd, -1); + Tcl_DStringAppend(&buf, buf1, -1); + Tcl_DStringAppend(&buf, buf2, -1); + code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (horizontal scrolling command executed by text)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); } } } @@ -6366,9 +6376,8 @@ GetYPixelCount( notFirst = 1; } break; - } else { - dlPtr = dlPtr->nextPtr; } + dlPtr = dlPtr->nextPtr; } while (dlPtr->index.linePtr == linePtr); return count; @@ -6518,16 +6527,22 @@ GetYView( if (textPtr->yScrollCmd != NULL) { char buf1[TCL_DOUBLE_SPACE+1]; char buf2[TCL_DOUBLE_SPACE+1]; + Tcl_DString buf; buf1[0] = ' '; buf2[0] = ' '; Tcl_PrintDouble(NULL, first, buf1+1); Tcl_PrintDouble(NULL, last, buf2+1); - code = Tcl_VarEval(interp, textPtr->yScrollCmd, buf1, buf2, NULL); + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, textPtr->yScrollCmd, -1); + Tcl_DStringAppend(&buf, buf1, -1); + Tcl_DStringAppend(&buf, buf2, -1); + code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (vertical scrolling command executed by text)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); } } } @@ -6554,7 +6569,7 @@ static void AsyncUpdateYScrollbar( ClientData clientData) /* Information about widget. */ { - register TkText *textPtr = (TkText *) clientData; + register TkText *textPtr = clientData; textPtr->dInfoPtr->scrollbarTimer = NULL; @@ -6563,7 +6578,7 @@ AsyncUpdateYScrollbar( } if (--textPtr->refCount == 0) { - ckfree((char *) textPtr); + ckfree(textPtr); } } @@ -6591,7 +6606,7 @@ FindDLine( TkText *textPtr, /* Widget record for text widget. */ register DLine *dlPtr, /* Pointer to first in list of DLines to * search. */ - CONST TkTextIndex *indexPtr)/* Index of desired character. */ + const TkTextIndex *indexPtr)/* Index of desired character. */ { DLine *dlPtrPrev; @@ -6766,25 +6781,26 @@ TkTextPixelIndex( } *indexPtr = textPtr->topIndex; return; - } else { - for (dlPtr = validDlPtr = dInfoPtr->dLinePtr; - y >= (dlPtr->y + dlPtr->height); - dlPtr = dlPtr->nextPtr) { - if (dlPtr->chunkPtr != NULL) { - validDlPtr = dlPtr; - } - if (dlPtr->nextPtr == NULL) { - /* - * Y-coordinate is off the bottom of the displayed text. Use - * the last character on the last line. - */ + } + for (dlPtr = validDlPtr = dInfoPtr->dLinePtr; + y >= (dlPtr->y + dlPtr->height); + dlPtr = dlPtr->nextPtr) { + if (dlPtr->chunkPtr != NULL) { + validDlPtr = dlPtr; + } + if (dlPtr->nextPtr == NULL) { + /* + * Y-coordinate is off the bottom of the displayed text. Use the + * last character on the last line. + */ - x = dInfoPtr->maxX - 1; - nearby = 1; - break; - } + x = dInfoPtr->maxX - 1; + nearby = 1; + break; } - if (dlPtr->chunkPtr == NULL) dlPtr = validDlPtr; + } + if (dlPtr->chunkPtr == NULL) { + dlPtr = validDlPtr; } if (nearest != NULL) { @@ -6882,7 +6898,7 @@ DlineIndexOfX( */ if (chunkPtr->numBytes > 1) { - indexPtr->byteIndex += (*chunkPtr->measureProc)(chunkPtr, x); + indexPtr->byteIndex += chunkPtr->measureProc(chunkPtr, x); } } @@ -6957,7 +6973,7 @@ DlineXOfIndex( int x = 0; if (byteIndex == 0 || chunkPtr == NULL) { - return 0; + return x; } /* @@ -6970,15 +6986,14 @@ DlineXOfIndex( if (byteIndex < chunkPtr->numBytes) { int y, width, height; - (*chunkPtr->bboxProc)(textPtr, chunkPtr, byteIndex, + chunkPtr->bboxProc(textPtr, chunkPtr, byteIndex, dlPtr->y + dlPtr->spaceAbove, dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width, &height); break; - } else { - byteIndex -= chunkPtr->numBytes; } + byteIndex -= chunkPtr->numBytes; if (chunkPtr->nextPtr == NULL || byteIndex == 0) { x = chunkPtr->x + chunkPtr->width; break; @@ -7012,7 +7027,7 @@ DlineXOfIndex( int TkTextIndexBbox( TkText *textPtr, /* Widget record for text widget. */ - CONST TkTextIndex *indexPtr,/* Index whose bounding box is desired. */ + const TkTextIndex *indexPtr,/* Index whose bounding box is desired. */ int *xPtr, int *yPtr, /* Filled with index's upper-left * coordinate. */ int *widthPtr, int *heightPtr, @@ -7041,7 +7056,7 @@ TkTextIndexBbox( dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, indexPtr); - /* + /* * Two cases shall be trapped here because the logic later really * needs dlPtr to be the display line containing indexPtr: * 1. if no display line contains the desired index (NULL dlPtr) @@ -7079,7 +7094,7 @@ TkTextIndexBbox( * coordinate on the screen. Translate it to reflect horizontal scrolling. */ - (*chunkPtr->bboxProc)(textPtr, chunkPtr, byteCount, + chunkPtr->bboxProc(textPtr, chunkPtr, byteCount, dlPtr->y + dlPtr->spaceAbove, dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow, dlPtr->baseline - dlPtr->spaceAbove, xPtr, yPtr, widthPtr, @@ -7158,7 +7173,7 @@ TkTextIndexBbox( int TkTextDLineInfo( TkText *textPtr, /* Widget record for text widget. */ - CONST TkTextIndex *indexPtr,/* Index of character whose bounding box is + const TkTextIndex *indexPtr,/* Index of character whose bounding box is * desired. */ int *xPtr, int *yPtr, /* Filled with line's upper-left * coordinate. */ @@ -7185,7 +7200,7 @@ TkTextDLineInfo( dlPtr = FindDLine(textPtr, dInfoPtr->dLinePtr, indexPtr); - /* + /* * Two cases shall be trapped here because the logic later really * needs dlPtr to be the display line containing indexPtr: * 1. if no display line contains the desired index (NULL dlPtr) @@ -7325,22 +7340,22 @@ TkTextCharLayoutProc( #if TK_LAYOUT_WITH_BASE_CHUNKS if (baseCharChunkPtr == NULL) { baseCharChunkPtr = chunkPtr; - bciPtr = (BaseCharInfo *) ckalloc(sizeof(BaseCharInfo)); + bciPtr = ckalloc(sizeof(BaseCharInfo)); baseString = &bciPtr->baseChars; Tcl_DStringInit(baseString); bciPtr->width = 0; ciPtr = &bciPtr->ci; } else { - bciPtr = (BaseCharInfo *) baseCharChunkPtr->clientData; - ciPtr = (CharInfo *) ckalloc(sizeof(CharInfo)); + bciPtr = baseCharChunkPtr->clientData; + ciPtr = ckalloc(sizeof(CharInfo)); baseString = &bciPtr->baseChars; } lineOffset = Tcl_DStringLength(baseString); line = Tcl_DStringAppend(baseString,p,maxBytes); - chunkPtr->clientData = (ClientData) ciPtr; + chunkPtr->clientData = ciPtr; ciPtr->baseChunkPtr = baseCharChunkPtr; ciPtr->baseOffset = lineOffset; ciPtr->chars = NULL; @@ -7396,7 +7411,7 @@ TkTextCharLayoutProc( } else { Tcl_DStringSetLength(baseString,lineOffset); } - ckfree((char *) ciPtr); + ckfree(ciPtr); #endif /* TK_LAYOUT_WITH_BASE_CHUNKS */ return 0; } @@ -7422,9 +7437,8 @@ TkTextCharLayoutProc( chunkPtr->breakIndex = -1; #if !TK_LAYOUT_WITH_BASE_CHUNKS - ciPtr = (CharInfo *) - ckalloc((unsigned) bytesThatFit + Tk_Offset(CharInfo, chars) + 1); - chunkPtr->clientData = (ClientData) ciPtr; + ciPtr = ckalloc((Tk_Offset(CharInfo, chars) + 1) + bytesThatFit); + chunkPtr->clientData = ciPtr; memcpy(ciPtr->chars, p, (unsigned) bytesThatFit); #endif /* TK_LAYOUT_WITH_BASE_CHUNKS */ @@ -7462,11 +7476,21 @@ TkTextCharLayoutProc( } else { for (count = bytesThatFit, p += bytesThatFit - 1; count > 0; count--, p--) { - if (UCHAR(*p) < 0x80 && isspace(UCHAR(*p))) { + /* + * Don't use isspace(); effects are unpredictable and can lead to + * odd word-wrapping problems on some platforms. Also don't use + * Tcl_UniCharIsSpace here either, as it identifies non-breaking + * spaces as places to break. What we actually want is only the + * ASCII space characters, so use them explicitly... + */ + + switch (*p) { + case '\t': case '\n': case '\v': case '\f': case '\r': case ' ': chunkPtr->breakIndex = count; - break; + goto checkForNextChunk; } } + checkForNextChunk: if ((bytesThatFit + byteOffset) == segPtr->size) { for (nextPtr = segPtr->nextPtr; nextPtr != NULL; nextPtr = nextPtr->nextPtr) { @@ -7526,7 +7550,7 @@ CharChunkMeasureChars( * here. */ { Tk_Font tkfont = chunkPtr->stylePtr->sValuePtr->tkfont; - CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData; + CharInfo *ciPtr = chunkPtr->clientData; #if !TK_LAYOUT_WITH_BASE_CHUNKS if (chars == NULL) { @@ -7539,7 +7563,7 @@ CharChunkMeasureChars( return MeasureChars(tkfont, chars, charsLen, start, end-start, startX, maxX, flags, nextXPtr); -#else +#else /* TK_LAYOUT_WITH_BASE_CHUNKS */ { int xDisplacement; int fit, bstart = start, bend = end; @@ -7579,7 +7603,7 @@ CharChunkMeasureChars( return fit - bstart; } } -#endif +#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */ } /* @@ -7615,7 +7639,7 @@ CharDisplayProc( int screenY) /* Y-coordinate in text window that * corresponds to y. */ { - CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData; + CharInfo *ciPtr = chunkPtr->clientData; const char *string; TextStyle *stylePtr; StyleValues *sValuePtr; @@ -7633,7 +7657,7 @@ CharDisplayProc( } #if TK_DRAW_IN_CONTEXT - bciPtr = (BaseCharInfo *) ciPtr->baseChunkPtr->clientData; + bciPtr = ciPtr->baseChunkPtr->clientData; numBytes = Tcl_DStringLength(&bciPtr->baseChars); string = Tcl_DStringValue(&bciPtr->baseChars); @@ -7766,7 +7790,7 @@ CharUndisplayProc( TkText *textPtr, /* Overall information about text widget. */ TkTextDispChunk *chunkPtr) /* Chunk that is about to be freed. */ { - CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData; + CharInfo *ciPtr = chunkPtr->clientData; if (ciPtr) { #if TK_LAYOUT_WITH_BASE_CHUNKS @@ -7793,7 +7817,7 @@ CharUndisplayProc( ciPtr->numBytes = 0; #endif /* TK_LAYOUT_WITH_BASE_CHUNKS */ - ckfree((char *) ciPtr); + ckfree(ciPtr); chunkPtr->clientData = NULL; } } @@ -7869,7 +7893,7 @@ CharBboxProc( int *heightPtr) /* Gets filled in with height of character, in * pixels. */ { - CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData; + CharInfo *ciPtr = chunkPtr->clientData; int maxX; maxX = chunkPtr->width + chunkPtr->x; @@ -8032,7 +8056,7 @@ AdjustForTab( if (chunkPtr2->displayProc != CharDisplayProc) { continue; } - ciPtr = (CharInfo *) chunkPtr2->clientData; + ciPtr = chunkPtr2->clientData; for (p = ciPtr->chars, i = 0; i < ciPtr->numBytes; p++, i++) { if (isdigit(UCHAR(*p))) { gotDigit = 1; @@ -8053,23 +8077,23 @@ AdjustForTab( if (decimalChunkPtr != NULL) { int curX; - ciPtr = (CharInfo *) decimalChunkPtr->clientData; + ciPtr = decimalChunkPtr->clientData; CharChunkMeasureChars(decimalChunkPtr, NULL, 0, 0, decimal, decimalChunkPtr->x, -1, 0, &curX); desired = tabX - (curX - x); goto update; - } else { - /* - * There wasn't a decimal point. Right justify the text. - */ + } - width = 0; - for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL; - chunkPtr2 = chunkPtr2->nextPtr) { - width += chunkPtr2->width; - } - desired = tabX - width; + /* + * There wasn't a decimal point. Right justify the text. + */ + + width = 0; + for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL; + chunkPtr2 = chunkPtr2->nextPtr) { + width += chunkPtr2->width; } + desired = tabX - width; /* * Shift all of the chunks to the right so that the left edge is at the @@ -8307,7 +8331,7 @@ NextTabStop( static int MeasureChars( Tk_Font tkfont, /* Font in which to draw characters. */ - CONST char *source, /* Characters to be displayed. Need not be + const char *source, /* Characters to be displayed. Need not be * NULL-terminated. */ int maxBytes, /* Maximum # of bytes to consider from * source. */ @@ -8322,7 +8346,7 @@ MeasureChars( * here. */ { int curX, width, ch; - CONST char *special, *end, *start; + const char *special, *end, *start; ch = 0; /* lint. */ curX = startX; @@ -8369,11 +8393,10 @@ MeasureChars( break; } if (special < end) { - if (ch == '\t') { - start++; - } else { + if (ch != '\t') { break; } + start++; } } @@ -8414,19 +8437,19 @@ TextGetScrollInfoObj( Tcl_Interp *interp, /* Used for error reporting. */ TkText *textPtr, /* Information about the text widget. */ int objc, /* # arguments for command. */ - Tcl_Obj *CONST objv[], /* Arguments for command. */ + Tcl_Obj *const objv[], /* Arguments for command. */ double *dblPtr, /* Filled in with argument "moveto" option, if * any. */ int *intPtr) /* Filled in with number of pages or lines or * pixels to scroll, if any. */ { - static CONST char *subcommands[] = { + static const char *const subcommands[] = { "moveto", "scroll", NULL }; enum viewSubcmds { VIEW_MOVETO, VIEW_SCROLL }; - static CONST char *units[] = { + static const char *const units[] = { "units", "pages", "pixels", NULL }; enum viewUnits { @@ -8434,8 +8457,8 @@ TextGetScrollInfoObj( }; int index; - if (Tcl_GetIndexFromObj(interp, objv[2], subcommands, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], subcommands, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TKTEXT_SCROLL_ERROR; } @@ -8454,8 +8477,8 @@ TextGetScrollInfoObj( Tcl_WrongNumArgs(interp, 3, objv, "number units|pages|pixels"); return TKTEXT_SCROLL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[4], units, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[4], units, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TKTEXT_SCROLL_ERROR; } switch ((enum viewUnits) index) { @@ -8533,7 +8556,7 @@ FinalizeBaseChunk( if (chunkPtr->displayProc != CharDisplayProc) { continue; } - ciPtr = (CharInfo *)chunkPtr->clientData; + ciPtr = chunkPtr->clientData; if (ciPtr->baseChunkPtr != baseCharChunkPtr) { break; } @@ -8550,7 +8573,7 @@ FinalizeBaseChunk( } if (addChunkPtr != NULL) { - ciPtr = (CharInfo *)addChunkPtr->clientData; + ciPtr = addChunkPtr->clientData; ciPtr->chars = baseChars + ciPtr->baseOffset; #if TK_DRAW_IN_CONTEXT @@ -8601,7 +8624,7 @@ FreeBaseChunk( if (chunkPtr->undisplayProc != CharUndisplayProc) { continue; } - ciPtr = (CharInfo *) chunkPtr->clientData; + ciPtr = chunkPtr->clientData; if (ciPtr->baseChunkPtr != baseChunkPtr) { break; } @@ -8610,7 +8633,9 @@ FreeBaseChunk( ciPtr->chars = NULL; } - Tcl_DStringFree(&((BaseCharInfo *) baseChunkPtr->clientData)->baseChars); + if (baseChunkPtr) { + Tcl_DStringFree(&((BaseCharInfo *) baseChunkPtr->clientData)->baseChars); + } } /* @@ -8719,14 +8744,14 @@ RemoveFromBaseChunk( * Reinstitute this base chunk for re-layout. */ - ciPtr = (CharInfo *) chunkPtr->clientData; + ciPtr = chunkPtr->clientData; baseCharChunkPtr = ciPtr->baseChunkPtr; /* * Remove the chunk data from the base chunk data. */ - bciPtr = (BaseCharInfo *) baseCharChunkPtr->clientData; + bciPtr = baseCharChunkPtr->clientData; if ((ciPtr->baseOffset + ciPtr->numBytes) != Tcl_DStringLength(&bciPtr->baseChars)) { diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c index bc2b7c4..41dd448 100644 --- a/generic/tkTextImage.c +++ b/generic/tkTextImage.c @@ -54,7 +54,7 @@ static void EmbImageProc(ClientData clientData, int x, int y, * The following structure declares the "embedded image" segment type. */ -static const Tk_SegType tkTextEmbImageType = { +const Tk_SegType tkTextEmbImageType = { "image", /* name */ 0, /* leftGravity */ NULL, /* splitProc */ @@ -69,7 +69,7 @@ static const Tk_SegType tkTextEmbImageType = { * Definitions for alignment values: */ -static const char *alignStrings[] = { +static const char *const alignStrings[] = { "baseline", "bottom", "center", "top", NULL }; @@ -84,7 +84,7 @@ typedef enum { static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_STRING_TABLE, "-align", NULL, NULL, "center", -1, Tk_Offset(TkTextEmbImage, align), - 0, (ClientData) alignStrings, 0}, + 0, alignStrings, 0}, {TK_OPTION_PIXELS, "-padx", NULL, NULL, "0", -1, Tk_Offset(TkTextEmbImage, padX), 0, 0, 0}, {TK_OPTION_PIXELS, "-pady", NULL, NULL, @@ -95,9 +95,8 @@ static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_STRING, "-name", NULL, NULL, NULL, -1, Tk_Offset(TkTextEmbImage, imageName), TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_END} + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} }; - /* *-------------------------------------------------------------- @@ -128,7 +127,7 @@ TkTextImageCmd( int idx; register TkTextSegment *eiPtr; TkTextIndex index; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "cget", "configure", "create", "names", NULL }; enum opts { @@ -136,11 +135,11 @@ TkTextImageCmd( }; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings, "option", 0, - &idx) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], optionStrings, + sizeof(char *), "option", 0, &idx) != TCL_OK) { return TCL_ERROR; } switch ((enum opts) idx) { @@ -156,8 +155,10 @@ TkTextImageCmd( } eiPtr = TkTextIndexToSeg(&index, NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { - Tcl_AppendResult(interp, "no embedded image at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded image at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL); return TCL_ERROR; } objPtr = Tk_GetOptionValue(interp, (char *) &eiPtr->body.ei, @@ -171,7 +172,7 @@ TkTextImageCmd( } case CMD_CONF: if (objc < 4) { - Tcl_WrongNumArgs(interp, 3, objv, "index ?option value ...?"); + Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?"); return TCL_ERROR; } if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { @@ -179,14 +180,17 @@ TkTextImageCmd( } eiPtr = TkTextIndexToSeg(&index, NULL); if (eiPtr->typePtr != &tkTextEmbImageType) { - Tcl_AppendResult(interp, "no embedded image at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded image at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_IMAGE", NULL); return TCL_ERROR; } if (objc <= 5) { Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable, (objc == 5) ? objv[4] : NULL, textPtr->tkwin); + if (objPtr == NULL) { return TCL_ERROR; } else { @@ -215,7 +219,7 @@ TkTextImageCmd( */ if (objc < 4) { - Tcl_WrongNumArgs(interp, 3, objv, "index ?option value ...?"); + Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?"); return TCL_ERROR; } if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { @@ -238,7 +242,7 @@ TkTextImageCmd( * Create the new image segment and initialize it. */ - eiPtr = (TkTextSegment *) ckalloc(EI_SEG_SIZE); + eiPtr = ckalloc(EI_SEG_SIZE); eiPtr->typePtr = &tkTextEmbImageType; eiPtr->size = 1; eiPtr->body.ei.sharedTextPtr = textPtr->sharedTextPtr; @@ -273,16 +277,20 @@ TkTextImageCmd( case CMD_NAMES: { Tcl_HashSearch search; Tcl_HashEntry *hPtr; + Tcl_Obj *resultObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->imageTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), + -1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } default: @@ -324,11 +332,12 @@ EmbImageConfigure( Tcl_HashEntry *hPtr; Tcl_HashSearch search; char *name; + int dummy; int count = 0; /* The counter for picking a unique name */ int conflict = 0; /* True if we have a name conflict */ - size_t len; /* length of image name */ + size_t len; /* length of image name */ - if (Tk_SetOptions(textPtr->interp, (char*)&eiPtr->body.ei, + if (Tk_SetOptions(textPtr->interp, (char *) &eiPtr->body.ei, eiPtr->body.ei.optionTable, objc, objv, textPtr->tkwin, NULL, NULL) != TCL_OK) { return TCL_ERROR; @@ -343,7 +352,7 @@ EmbImageConfigure( if (eiPtr->body.ei.imageString != NULL) { image = Tk_GetImage(textPtr->interp, textPtr->tkwin, - eiPtr->body.ei.imageString, EmbImageProc, (ClientData) eiPtr); + eiPtr->body.ei.imageString, EmbImageProc, eiPtr); if (image == NULL) { return TCL_ERROR; } @@ -370,9 +379,11 @@ EmbImageConfigure( name = eiPtr->body.ei.imageString; } if (name == NULL) { - Tcl_AppendResult(textPtr->interp, "Either a \"-name\" ", - "or a \"-image\" argument must be provided ", - "to the \"image create\" subcommand.", NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj( + "Either a \"-name\" or a \"-image\" argument must be" + " provided to the \"image create\" subcommand", -1)); + Tcl_SetErrorCode(textPtr->interp, "TK", "TEXT", "IMAGE_CREATE_USAGE", + NULL); return TCL_ERROR; } len = strlen(name); @@ -404,15 +415,11 @@ EmbImageConfigure( Tcl_DStringAppend(&newName, buf, -1); } name = Tcl_DStringValue(&newName); - { - int dummy; - - hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->imageTable, name, - &dummy); - } + hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->imageTable, name, + &dummy); Tcl_SetHashValue(hPtr, eiPtr); - Tcl_AppendResult(textPtr->interp, name, NULL); - eiPtr->body.ei.name = ckalloc((unsigned) Tcl_DStringLength(&newName)+1); + Tcl_SetObjResult(textPtr->interp, Tcl_NewStringObj(name, -1)); + eiPtr->body.ei.name = ckalloc(Tcl_DStringLength(&newName) + 1); strcpy(eiPtr->body.ei.name, name); Tcl_DStringFree(&newName); @@ -473,7 +480,7 @@ EmbImageDeleteProc( if (eiPtr->body.ei.name) { ckfree(eiPtr->body.ei.name); } - ckfree((char *) eiPtr); + ckfree(eiPtr); return 0; } @@ -586,7 +593,7 @@ EmbImageLayoutProc( chunkPtr->width = width; chunkPtr->breakIndex = -1; chunkPtr->breakIndex = 1; - chunkPtr->clientData = (ClientData) eiPtr; + chunkPtr->clientData = eiPtr; eiPtr->body.ei.chunkCount += 1; return 1; } @@ -658,7 +665,7 @@ EmbImageDisplayProc( int screenY) /* Y-coordinate in text window that * corresponds to y. */ { - TkTextSegment *eiPtr = (TkTextSegment *) chunkPtr->clientData; + TkTextSegment *eiPtr = chunkPtr->clientData; int lineX, imageX, imageY, width, height; Tk_Image image; @@ -722,7 +729,7 @@ EmbImageBboxProc( int *heightPtr) /* Gets filled in with height of image, in * pixels. */ { - TkTextSegment *eiPtr = (TkTextSegment *) chunkPtr->clientData; + TkTextSegment *eiPtr = chunkPtr->clientData; Tk_Image image; image = eiPtr->body.ei.image; @@ -787,7 +794,7 @@ TkTextImageIndex( if (hPtr == NULL) { return 0; } - eiPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + eiPtr = Tcl_GetHashValue(hPtr); indexPtr->tree = textPtr->sharedTextPtr->tree; indexPtr->linePtr = eiPtr->body.ei.linePtr; indexPtr->byteIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr); @@ -821,7 +828,7 @@ EmbImageProc( int imgWidth, int imgHeight)/* New dimensions of image. */ { - TkTextSegment *eiPtr = (TkTextSegment *) clientData; + TkTextSegment *eiPtr = clientData; TkTextIndex index; index.tree = eiPtr->body.ei.sharedTextPtr->tree; diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index b886975..8820191 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -33,12 +33,12 @@ * Forward declarations for functions defined later in this file: */ -static CONST char * ForwBack(TkText *textPtr, CONST char *string, +static const char * ForwBack(TkText *textPtr, const char *string, TkTextIndex *indexPtr); -static CONST char * StartEnd(TkText *textPtr, CONST char *string, +static const char * StartEnd(TkText *textPtr, const char *string, TkTextIndex *indexPtr); static int GetIndex(Tcl_Interp *interp, TkSharedText *sharedPtr, - TkText *textPtr, CONST char *string, + TkText *textPtr, const char *string, TkTextIndex *indexPtr, int *canCachePtr); static int IndexCountBytesOrdered(CONST TkText *textPtr, CONST TkTextIndex *indexPtr1, @@ -51,8 +51,6 @@ static int IndexCountBytesOrdered(CONST TkText *textPtr, static void DupTextIndexInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeTextIndexInternalRep(Tcl_Obj *listPtr); -static int SetTextIndexFromAny(Tcl_Interp *interp, - Tcl_Obj *objPtr); static void UpdateStringOfTextIndex(Tcl_Obj *objPtr); /* @@ -64,39 +62,41 @@ static void UpdateStringOfTextIndex(Tcl_Obj *objPtr); #define GET_INDEXEPOCH(objPtr) \ (PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2)) #define SET_TEXTINDEX(objPtr, indexPtr) \ - ((objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (indexPtr)) + ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (indexPtr)) #define SET_INDEXEPOCH(objPtr, epoch) \ ((objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(epoch)) - + /* * Define the 'textindex' object type, which Tk uses to represent indices in * text widgets internally. */ -Tcl_ObjType tkTextIndexType = { +const Tcl_ObjType tkTextIndexType = { "textindex", /* name */ FreeTextIndexInternalRep, /* freeIntRepProc */ DupTextIndexInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetTextIndexFromAny /* setFromAnyProc */ + NULL /* setFromAnyProc */ }; - + static void FreeTextIndexInternalRep( Tcl_Obj *indexObjPtr) /* TextIndex object with internal rep to * free. */ { TkTextIndex *indexPtr = GET_TEXTINDEX(indexObjPtr); + if (indexPtr->textPtr != NULL) { if (--indexPtr->textPtr->refCount == 0) { /* * The text widget has been deleted and we need to free it now. */ - ckfree((char *) (indexPtr->textPtr)); + ckfree(indexPtr->textPtr); } } - ckfree((char *) indexPtr); + ckfree(indexPtr); + indexObjPtr->typePtr = NULL; } static void @@ -107,7 +107,7 @@ DupTextIndexInternalRep( int epoch; TkTextIndex *dupIndexPtr, *indexPtr; - dupIndexPtr = (TkTextIndex *) ckalloc(sizeof(TkTextIndex)); + dupIndexPtr = ckalloc(sizeof(TkTextIndex)); indexPtr = GET_TEXTINDEX(srcPtr); epoch = GET_INDEXEPOCH(srcPtr); @@ -122,7 +122,7 @@ DupTextIndexInternalRep( SET_INDEXEPOCH(copyPtr, epoch); copyPtr->typePtr = &tkTextIndexType; } - + /* * This will not be called except by TkTextNewIndexObj below. This is because * if a TkTextIndex is no longer valid, it is not possible to regenerate the @@ -135,26 +135,14 @@ UpdateStringOfTextIndex( { char buffer[TK_POS_CHARS]; register int len; - - CONST TkTextIndex *indexPtr = GET_TEXTINDEX(objPtr); + const TkTextIndex *indexPtr = GET_TEXTINDEX(objPtr); len = TkTextPrintIndex(indexPtr->textPtr, indexPtr, buffer); - objPtr->bytes = ckalloc((unsigned) len + 1); + objPtr->bytes = ckalloc(len + 1); strcpy(objPtr->bytes, buffer); objPtr->length = len; } - -static int -SetTextIndexFromAny( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ -{ - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "can't convert value to textindex except via TkTextGetIndexFromObj API", - -1); - return TCL_ERROR; -} /* *--------------------------------------------------------------------------- @@ -186,9 +174,9 @@ MakeObjIndex( TkText *textPtr, /* Information about text widget. */ Tcl_Obj *objPtr, /* Object containing description of * position. */ - CONST TkTextIndex *origPtr) /* Pointer to index. */ + const TkTextIndex *origPtr) /* Pointer to index. */ { - TkTextIndex *indexPtr = (TkTextIndex *) ckalloc(sizeof(TkTextIndex)); + TkTextIndex *indexPtr = ckalloc(sizeof(TkTextIndex)); indexPtr->tree = origPtr->tree; indexPtr->linePtr = origPtr->linePtr; @@ -205,8 +193,8 @@ MakeObjIndex( } return indexPtr; } - -CONST TkTextIndex * + +const TkTextIndex * TkTextGetIndexFromObj( Tcl_Interp *interp, /* Use this for error reporting. */ TkText *textPtr, /* Information about text widget. */ @@ -245,8 +233,8 @@ TkTextGetIndexFromObj( if (objPtr->bytes == NULL) { objPtr->typePtr->updateStringProc(objPtr); } - if ((objPtr->typePtr->freeIntRepProc) != NULL) { - (*objPtr->typePtr->freeIntRepProc)(objPtr); + if (objPtr->typePtr->freeIntRepProc != NULL) { + objPtr->typePtr->freeIntRepProc(objPtr); } } @@ -274,7 +262,7 @@ TkTextGetIndexFromObj( Tcl_Obj * TkTextNewIndexObj( TkText *textPtr, /* Text widget for this index */ - CONST TkTextIndex *indexPtr)/* Pointer to index. */ + const TkTextIndex *indexPtr)/* Pointer to index. */ { Tcl_Obj *retVal; @@ -388,9 +376,9 @@ TkTextMakePixelIndex( TkTextIndex * TkTextMakeByteIndex( - TkTextBTree tree, /* Tree that lineIndex and byteIndex refer + TkTextBTree tree, /* Tree that lineIndex and byteIndex refer * to. */ - CONST TkText *textPtr, + const TkText *textPtr, int lineIndex, /* Index of desired line (0 means first line * of text). */ int byteIndex, /* Byte index of desired character. */ @@ -398,7 +386,7 @@ TkTextMakeByteIndex( { TkTextSegment *segPtr; int index; - CONST char *p, *start; + const char *p, *start; Tcl_UniChar ch; indexPtr->tree = tree; @@ -442,7 +430,7 @@ TkTextMakeByteIndex( if ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) { /* * Prevent UTF-8 character from being split up by ensuring - * that byteIndex falls on a character boundary. If index + * that byteIndex falls on a character boundary. If the index * falls in the middle of a UTF-8 character, it will be * adjusted to the end of that UTF-8 character. */ @@ -576,7 +564,7 @@ TkTextMakeCharIndex( TkTextSegment * TkTextIndexToSeg( - CONST TkTextIndex *indexPtr,/* Text index. */ + const TkTextIndex *indexPtr,/* Text index. */ int *offsetPtr) /* Where to store offset within segment, or * NULL if offset isn't wanted. */ { @@ -614,10 +602,10 @@ TkTextIndexToSeg( int TkTextSegToOffset( - CONST TkTextSegment *segPtr,/* Segment whose offset is desired. */ - CONST TkTextLine *linePtr) /* Line containing segPtr. */ + const TkTextSegment *segPtr,/* Segment whose offset is desired. */ + const TkTextLine *linePtr) /* Line containing segPtr. */ { - CONST TkTextSegment *segPtr2; + const TkTextSegment *segPtr2; int offset = 0; for (segPtr2 = linePtr->segPtr; segPtr2 != segPtr; @@ -708,7 +696,7 @@ int TkTextGetIndex( Tcl_Interp *interp, /* Use this for error reporting. */ TkText *textPtr, /* Information about text widget. */ - CONST char *string, /* Textual description of position. */ + const char *string, /* Textual description of position. */ TkTextIndex *indexPtr) /* Index structure to fill in. */ { return GetIndex(interp, NULL, textPtr, string, indexPtr, NULL); @@ -742,7 +730,7 @@ GetIndex( Tcl_Interp *interp, /* Use this for error reporting. */ TkSharedText *sharedPtr, TkText *textPtr, /* Information about text widget. */ - CONST char *string, /* Textual description of position. */ + const char *string, /* Textual description of position. */ TkTextIndex *indexPtr, /* Index structure to fill in. */ int *canCachePtr) /* Pointer to integer to store whether we can * cache the index (or NULL). */ @@ -751,7 +739,7 @@ GetIndex( TkTextIndex first, last; int wantLast, result; char c; - CONST char *cp; + const char *cp; Tcl_DString copy; int canCache = 0; @@ -803,7 +791,7 @@ GetIndex( TkTextSearch search; TkTextTag *tagPtr; Tcl_HashEntry *hPtr = NULL; - CONST char *tagName; + const char *tagName; if ((p[1] == 'f') && (strncmp(p+1, "first", 5) == 0)) { wantLast = 0; @@ -828,7 +816,7 @@ GetIndex( hPtr = Tcl_FindHashEntry(&sharedPtr->tagTable, tagName); *p = '.'; if (hPtr != NULL) { - tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr); + tagPtr = Tcl_GetHashValue(hPtr); } } @@ -843,13 +831,14 @@ GetIndex( if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) { if (tagPtr == textPtr->selTagPtr) { tagName = "sel"; - } else { + } else if (hPtr != NULL) { tagName = Tcl_GetHashKey(&sharedPtr->tagTable, hPtr); } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "text doesn't contain any characters tagged with \"", - tagName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "text doesn't contain any characters tagged with \"%s\"", + tagName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_INDEX", tagName, + NULL); Tcl_DStringFree(©); return TCL_ERROR; } @@ -1012,8 +1001,8 @@ GetIndex( error: Tcl_DStringFree(©); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad text index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad text index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "BAD_INDEX", NULL); return TCL_ERROR; } @@ -1037,8 +1026,8 @@ GetIndex( int TkTextPrintIndex( - CONST TkText *textPtr, - CONST TkTextIndex *indexPtr,/* Pointer to index. */ + const TkText *textPtr, + const TkTextIndex *indexPtr,/* Pointer to index. */ char *string) /* Place to store the position. Must have at * least TK_POS_CHARS characters. */ { @@ -1101,8 +1090,8 @@ TkTextPrintIndex( int TkTextIndexCmp( - CONST TkTextIndex*index1Ptr,/* First index. */ - CONST TkTextIndex*index2Ptr)/* Second index. */ + const TkTextIndex*index1Ptr,/* First index. */ + const TkTextIndex*index2Ptr)/* Second index. */ { int line1, line2; @@ -1154,15 +1143,15 @@ TkTextIndexCmp( *--------------------------------------------------------------------------- */ -static CONST char * +static const char * ForwBack( TkText *textPtr, /* Information about text widget. */ - CONST char *string, /* String to parse for additional info about + const char *string, /* String to parse for additional info about * modifier (count and units). Points to "+" * or "-" that starts modifier. */ TkTextIndex *indexPtr) /* Index to update as specified in string. */ { - register CONST char *p, *units; + register const char *p, *units; char *end; int count, lineIndex, modifier; size_t length; @@ -1402,8 +1391,8 @@ ForwBack( int TkTextIndexForwBytes( - CONST TkText *textPtr, - CONST TkTextIndex *srcPtr, /* Source index. */ + const TkText *textPtr, + const TkTextIndex *srcPtr, /* Source index. */ int byteCount, /* How many bytes forward to move. May be * negative. */ TkTextIndex *dstPtr) /* Destination index: gets modified. */ @@ -1474,8 +1463,8 @@ TkTextIndexForwBytes( void TkTextIndexForwChars( - CONST TkText *textPtr, /* Overall information about text widget. */ - CONST TkTextIndex *srcPtr, /* Source index. */ + const TkText *textPtr, /* Overall information about text widget. */ + const TkTextIndex *srcPtr, /* Source index. */ int charCount, /* How many characters forward to move. May * be negative. */ TkTextIndex *dstPtr, /* Destination index: gets modified. */ @@ -1495,8 +1484,7 @@ TkTextIndexForwChars( return; } if (checkElided) { - infoPtr = (TkTextElideInfo *) - ckalloc((unsigned) sizeof(TkTextElideInfo)); + infoPtr = ckalloc(sizeof(TkTextElideInfo)); elide = TkTextIsElided(textPtr, srcPtr, infoPtr); } @@ -1624,7 +1612,7 @@ TkTextIndexForwChars( forwardCharDone: if (infoPtr != NULL) { TkTextFreeElideInfo(infoPtr); - ckfree((char *) infoPtr); + ckfree(infoPtr); } } @@ -1738,11 +1726,11 @@ IndexCountBytesOrdered( int TkTextIndexCount( - CONST TkText *textPtr, /* Overall information about text widget. */ - CONST TkTextIndex *indexPtr1, + const TkText *textPtr, /* Overall information about text widget. */ + const TkTextIndex *indexPtr1, /* Index describing location of character from * which to count. */ - CONST TkTextIndex *indexPtr2, + const TkTextIndex *indexPtr2, /* Index describing location of last character * at which to stop the count. */ TkTextCountType type) /* The kind of indices to count. */ @@ -1764,8 +1752,7 @@ TkTextIndexCount( seg2Ptr = TkTextIndexToSeg(indexPtr2, &maxBytes); if (checkElided) { - infoPtr = (TkTextElideInfo *) - ckalloc((unsigned) sizeof(TkTextElideInfo)); + infoPtr = ckalloc(sizeof(TkTextElideInfo)); elide = TkTextIsElided(textPtr, indexPtr1, infoPtr); } @@ -1905,11 +1892,11 @@ TkTextIndexCount( countDone: if (infoPtr != NULL) { TkTextFreeElideInfo(infoPtr); - ckfree((char *) infoPtr); + ckfree(infoPtr); } return count; } - + /* *--------------------------------------------------------------------------- * @@ -1934,8 +1921,8 @@ TkTextIndexCount( int TkTextIndexBackBytes( - CONST TkText *textPtr, - CONST TkTextIndex *srcPtr, /* Source index. */ + const TkText *textPtr, + const TkTextIndex *srcPtr, /* Source index. */ int byteCount, /* How many bytes backward to move. May be * negative. */ TkTextIndex *dstPtr) /* Destination index: gets modified. */ @@ -2004,8 +1991,8 @@ TkTextIndexBackBytes( void TkTextIndexBackChars( - CONST TkText *textPtr, /* Overall information about text widget. */ - CONST TkTextIndex *srcPtr, /* Source index. */ + const TkText *textPtr, /* Overall information about text widget. */ + const TkTextIndex *srcPtr, /* Source index. */ int charCount, /* How many characters backward to move. May * be negative. */ TkTextIndex *dstPtr, /* Destination index: gets modified. */ @@ -2014,7 +2001,7 @@ TkTextIndexBackChars( TkTextSegment *segPtr, *oldPtr; TkTextElideInfo *infoPtr = NULL; int lineIndex, segSize; - CONST char *p, *start, *end; + const char *p, *start, *end; int elide = 0; int checkElided = (type & COUNT_DISPLAY); @@ -2023,7 +2010,7 @@ TkTextIndexBackChars( return; } if (checkElided) { - infoPtr = (TkTextElideInfo *) ckalloc(sizeof(TkTextElideInfo)); + infoPtr = ckalloc(sizeof(TkTextElideInfo)); elide = TkTextIsElided(textPtr, srcPtr, infoPtr); } @@ -2189,7 +2176,7 @@ TkTextIndexBackChars( backwardCharDone: if (infoPtr != NULL) { TkTextFreeElideInfo(infoPtr); - ckfree((char *) infoPtr); + ckfree(infoPtr); } } @@ -2213,15 +2200,15 @@ TkTextIndexBackChars( *---------------------------------------------------------------------- */ -static CONST char * +static const char * StartEnd( TkText *textPtr, /* Information about text widget. */ - CONST char *string, /* String to parse for additional info about + const char *string, /* String to parse for additional info about * modifier (count and units). Points to first * character of modifier word. */ TkTextIndex *indexPtr) /* Index to modify based on string. */ { - CONST char *p; + const char *p; size_t length; register TkTextSegment *segPtr; int modifier; diff --git a/generic/tkTextMark.c b/generic/tkTextMark.c index 71a7949..6a41c77 100644 --- a/generic/tkTextMark.c +++ b/generic/tkTextMark.c @@ -13,6 +13,7 @@ #include "tkInt.h" #include "tkText.h" +#include "tk3d.h" /* * Macro that determines the size of a mark segment: @@ -25,6 +26,7 @@ * Forward references for functions defined in this file: */ +static Tcl_Obj * GetMarkName(TkText *textPtr, TkTextSegment *segPtr); static void InsertUndisplayProc(TkText *textPtr, TkTextDispChunk *chunkPtr); static int MarkDeleteProc(TkTextSegment *segPtr, @@ -38,9 +40,9 @@ static int MarkLayoutProc(TkText *textPtr, TkTextIndex *indexPtr, int maxChars, int noCharsYet, TkWrapMode wrapMode, TkTextDispChunk *chunkPtr); static int MarkFindNext(Tcl_Interp *interp, - TkText *textPtr, const char *markName); + TkText *textPtr, Tcl_Obj *markName); static int MarkFindPrev(Tcl_Interp *interp, - TkText *textPtr, const char *markName); + TkText *textPtr, Tcl_Obj *markName); /* @@ -104,7 +106,7 @@ TkTextMarkCmd( TkTextIndex index; const Tk_SegType *newTypePtr; int optionIndex; - static const char *markOptionStrings[] = { + static const char *const markOptionStrings[] = { "gravity", "names", "next", "previous", "set", "unset", NULL }; enum markOptions { @@ -113,11 +115,11 @@ TkTextMarkCmd( }; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], markOptionStrings, "mark option", - 0, &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], markOptionStrings, + sizeof(char *), "mark option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } @@ -125,13 +127,13 @@ TkTextMarkCmd( case MARK_GRAVITY: { char c; int length; - char *str; + const char *str; if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 3, objv, "markName ?gravity?"); return TCL_ERROR; } - str = Tcl_GetStringFromObj(objv[3],&length); + str = Tcl_GetStringFromObj(objv[3], &length); if (length == 6 && !strcmp(str, "insert")) { markPtr = textPtr->insertMarkPtr; } else if (length == 7 && !strcmp(str, "current")) { @@ -139,30 +141,36 @@ TkTextMarkCmd( } else { hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, str); if (hPtr == NULL) { - Tcl_AppendResult(interp, "there is no mark named \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "there is no mark named \"%s\"", str)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_MARK", str, + NULL); return TCL_ERROR; } - markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + markPtr = Tcl_GetHashValue(hPtr); } if (objc == 4) { + const char *typeStr; + if (markPtr->typePtr == &tkTextRightMarkType) { - Tcl_SetResult(interp, "right", TCL_STATIC); + typeStr = "right"; } else { - Tcl_SetResult(interp, "left", TCL_STATIC); + typeStr = "left"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeStr, -1)); return TCL_OK; } str = Tcl_GetStringFromObj(objv[4],&length); c = str[0]; - if ((c == 'l') && (strncmp(str, "left", (unsigned)length) == 0)) { + if ((c == 'l') && (strncmp(str, "left", (unsigned) length) == 0)) { newTypePtr = &tkTextLeftMarkType; } else if ((c == 'r') && - (strncmp(str, "right", (unsigned)length) == 0)) { + (strncmp(str, "right", (unsigned) length) == 0)) { newTypePtr = &tkTextRightMarkType; } else { - Tcl_AppendResult(interp, "bad mark gravity \"", str, - "\": must be left or right", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad mark gravity \"%s\": must be left or right", str)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "MARK_GRAVITY", NULL); return TCL_ERROR; } TkTextMarkSegToIndex(textPtr, markPtr, &index); @@ -171,31 +179,39 @@ TkTextMarkCmd( TkBTreeLinkSegment(markPtr, &index); break; } - case MARK_NAMES: + case MARK_NAMES: { + Tcl_Obj *resultObj; + if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } - Tcl_AppendElement(interp, "insert"); - Tcl_AppendElement(interp, "current"); + resultObj = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + "insert", -1)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + "current", -1)); for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->markTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), + -1)); } + Tcl_SetObjResult(interp, resultObj); break; + } case MARK_NEXT: if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "index"); return TCL_ERROR; } - return MarkFindNext(interp, textPtr, Tcl_GetString(objv[3])); + return MarkFindNext(interp, textPtr, objv[3]); case MARK_PREVIOUS: if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "index"); return TCL_ERROR; } - return MarkFindPrev(interp, textPtr, Tcl_GetString(objv[3])); + return MarkFindPrev(interp, textPtr, objv[3]); case MARK_SET: if (objc != 5) { Tcl_WrongNumArgs(interp, 3, objv, "markName index"); @@ -213,7 +229,7 @@ TkTextMarkCmd( hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, Tcl_GetString(objv[i])); if (hPtr != NULL) { - markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + markPtr = Tcl_GetHashValue(hPtr); /* * Special case not needed with peer widgets. @@ -225,7 +241,7 @@ TkTextMarkCmd( } TkBTreeUnlinkSegment(markPtr, markPtr->body.mark.linePtr); Tcl_DeleteHashEntry(hPtr); - ckfree((char *) markPtr); + ckfree(markPtr); } } break; @@ -274,7 +290,7 @@ TkTextSetMark( widgetSpecific = 0; hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->markTable, name, &isNew); - markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + markPtr = Tcl_GetHashValue(hPtr); } if (!isNew) { /* @@ -288,7 +304,7 @@ TkTextSetMark( int nblines; TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index); - TkTextIndexForwChars(NULL,&index, 1, &index2, COUNT_INDICES); + TkTextIndexForwChars(NULL, &index, 1, &index2, COUNT_INDICES); /* * While we wish to redisplay, no heights have changed, so no need @@ -314,7 +330,7 @@ TkTextSetMark( } TkBTreeUnlinkSegment(markPtr, markPtr->body.mark.linePtr); } else { - markPtr = (TkTextSegment *) ckalloc(MSEG_SIZE); + markPtr = ckalloc(MSEG_SIZE); markPtr->typePtr = &tkTextRightMarkType; markPtr->size = 0; markPtr->body.mark.textPtr = textPtr; @@ -338,7 +354,7 @@ TkTextSetMark( if (markPtr == textPtr->insertMarkPtr) { TkTextIndex index2; - TkTextIndexForwChars(NULL,indexPtr, 1, &index2, COUNT_INDICES); + TkTextIndexForwChars(NULL, indexPtr, 1, &index2, COUNT_INDICES); /* * While we wish to redisplay, no heights have changed, so no need to @@ -430,12 +446,13 @@ TkTextMarkNameToIndex( } else if (!strcmp(name, "current")) { segPtr = textPtr->currentMarkPtr; } else { - Tcl_HashEntry *hPtr; - hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, name); + Tcl_HashEntry *hPtr = + Tcl_FindHashEntry(&textPtr->sharedTextPtr->markTable, name); + if (hPtr == NULL) { return TCL_ERROR; } - segPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + segPtr = Tcl_GetHashValue(hPtr); } TkTextMarkSegToIndex(textPtr, segPtr, indexPtr); @@ -578,7 +595,7 @@ MarkLayoutProc( */ chunkPtr->breakIndex = -1; - chunkPtr->clientData = (ClientData) textPtr; + chunkPtr->clientData = textPtr; return 1; } @@ -619,13 +636,13 @@ TkTextInsertDisplayProc( * We have no need for the clientData. */ - /* TkText *textPtr = (TkText *) chunkPtr->clientData; */ + /* TkText *textPtr = chunkPtr->clientData; */ TkTextIndex index; int halfWidth = textPtr->insertWidth/2; int rightSideWidth; int ix = 0, iy = 0, iw = 0, ih = 0, charWidth = 0; - if(textPtr->insertCursorType) { + if (textPtr->insertCursorType) { TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index); TkTextIndexBbox(textPtr, &index, &ix, &iy, &iw, &ih, &charWidth); rightSideWidth = charWidth + halfWidth; @@ -653,14 +670,37 @@ TkTextInsertDisplayProc( * the cursor. */ - if (textPtr->flags & INSERT_ON) { + if (textPtr->flags & GOT_FOCUS) { + if (textPtr->flags & INSERT_ON) { + Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->insertBorder, + x - halfWidth, y, charWidth + textPtr->insertWidth, + height, textPtr->insertBorderWidth, TK_RELIEF_RAISED); + } else if (textPtr->selBorder == textPtr->insertBorder) { + Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->border, + x - halfWidth, y, charWidth + textPtr->insertWidth, + height, 0, TK_RELIEF_FLAT); + } + } else if (textPtr->insertUnfocussed == TK_TEXT_INSERT_NOFOCUS_HOLLOW) { + if (textPtr->insertBorderWidth < 1) { + /* + * Hack to work around the fact that a "solid" border always + * paints in black. + */ + + TkBorder *borderPtr = (TkBorder *) textPtr->insertBorder; + + XDrawRectangle(Tk_Display(textPtr->tkwin), dst, borderPtr->bgGC, + x - halfWidth, y, charWidth + textPtr->insertWidth - 1, + height - 1); + } else { + Tk_Draw3DRectangle(textPtr->tkwin, dst, textPtr->insertBorder, + x - halfWidth, y, charWidth + textPtr->insertWidth, + height, textPtr->insertBorderWidth, TK_RELIEF_RAISED); + } + } else if (textPtr->insertUnfocussed == TK_TEXT_INSERT_NOFOCUS_SOLID) { Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->insertBorder, x - halfWidth, y, charWidth + textPtr->insertWidth, height, textPtr->insertBorderWidth, TK_RELIEF_RAISED); - } else if (textPtr->selBorder == textPtr->insertBorder) { - Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->border, - x - halfWidth, y, charWidth + textPtr->insertWidth, height, - 0, TK_RELIEF_FLAT); } } @@ -765,12 +805,13 @@ static int MarkFindNext( Tcl_Interp *interp, /* For error reporting */ TkText *textPtr, /* The widget */ - const char *string) /* The starting index or mark name */ + Tcl_Obj *obj) /* The starting index or mark name */ { TkTextIndex index; Tcl_HashEntry *hPtr; register TkTextSegment *segPtr; int offset; + const char *string = Tcl_GetString(obj); if (!strcmp(string, "insert")) { segPtr = textPtr->insertMarkPtr; @@ -789,7 +830,7 @@ MarkFindNext( * position. */ - segPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + segPtr = Tcl_GetHashValue(hPtr); TkTextMarkSegToIndex(textPtr, segPtr, &index); segPtr = segPtr->nextPtr; } else { @@ -798,7 +839,7 @@ MarkFindNext( * right at the index. */ - if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, obj, &index) != TCL_OK) { return TCL_ERROR; } for (offset = 0, segPtr = index.linePtr->segPtr; @@ -818,28 +859,12 @@ MarkFindNext( for ( ; segPtr != NULL ; segPtr = segPtr->nextPtr) { if (segPtr->typePtr == &tkTextRightMarkType || segPtr->typePtr == &tkTextLeftMarkType) { - if (segPtr == textPtr->currentMarkPtr) { - Tcl_SetResult(interp, "current", TCL_STATIC); - } else if (segPtr == textPtr->insertMarkPtr) { - Tcl_SetResult(interp, "insert", TCL_STATIC); - } else if (segPtr->body.mark.hPtr == NULL) { - /* - * Ignore widget-specific marks for the other widgets. - * This is either an insert or a current mark - * (markPtr->body.mark.hPtr actually receives NULL - * for these marks in TkTextSetMark). - * The insert and current marks for textPtr having - * already been tested above, the current segment is - * an insert or current mark from a peer of textPtr, - * which we don't want to return. - */ - continue; - } else { - Tcl_SetResult(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, - segPtr->body.mark.hPtr), TCL_STATIC); + Tcl_Obj *markName = GetMarkName(textPtr, segPtr); + + if (markName != NULL) { + Tcl_SetObjResult(interp, markName); + return TCL_OK; } - return TCL_OK; } } index.linePtr = TkBTreeNextLine(textPtr, index.linePtr); @@ -871,12 +896,13 @@ static int MarkFindPrev( Tcl_Interp *interp, /* For error reporting */ TkText *textPtr, /* The widget */ - const char *string) /* The starting index or mark name */ + Tcl_Obj *obj) /* The starting index or mark name */ { TkTextIndex index; Tcl_HashEntry *hPtr; register TkTextSegment *segPtr, *seg2Ptr, *prevPtr; int offset; + const char *string = Tcl_GetString(obj); if (!strcmp(string, "insert")) { segPtr = textPtr->insertMarkPtr; @@ -893,7 +919,7 @@ MarkFindPrev( * position. */ - segPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + segPtr = Tcl_GetHashValue(hPtr); TkTextMarkSegToIndex(textPtr, segPtr, &index); } else { /* @@ -901,7 +927,7 @@ MarkFindPrev( * right at the index. */ - if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) { + if (TkTextGetObjIndex(interp, textPtr, obj, &index) != TCL_OK) { return TCL_ERROR; } for (offset = 0, segPtr = index.linePtr->segPtr; @@ -937,28 +963,11 @@ MarkFindPrev( } } if (prevPtr != NULL) { - if (prevPtr == textPtr->currentMarkPtr) { - Tcl_SetResult(interp, "current", TCL_STATIC); - return TCL_OK; - } else if (prevPtr == textPtr->insertMarkPtr) { - Tcl_SetResult(interp, "insert", TCL_STATIC); - return TCL_OK; - } else if (prevPtr->body.mark.hPtr == NULL) { - /* - * Ignore widget-specific marks for the other widgets. - * This is either an insert or a current mark - * (markPtr->body.mark.hPtr actually receives NULL - * for these marks in TkTextSetMark). - * The insert and current marks for textPtr having - * already been tested above, the current segment is - * an insert or current mark from a peer of textPtr, - * which we don't want to return. - */ - } else { - Tcl_SetResult(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, - prevPtr->body.mark.hPtr), TCL_STATIC); - return TCL_OK; + Tcl_Obj *markName = GetMarkName(textPtr, prevPtr); + + if (markName != NULL) { + Tcl_SetObjResult(interp, markName); + return TCL_OK; } } index.linePtr = TkBTreePreviousLine(textPtr, index.linePtr); @@ -970,6 +979,46 @@ MarkFindPrev( } /* + * ------------------------------------------------------------------------ + * + * GetMarkName -- + * Returns the name of the mark that is the given text segment, or NULL + * if it is unnamed (i.e., a widget-specific mark that isn't "current" or + * "insert"). + * + * ------------------------------------------------------------------------ + */ + +static Tcl_Obj * +GetMarkName( + TkText *textPtr, + TkTextSegment *segPtr) +{ + const char *markName; + + if (segPtr == textPtr->currentMarkPtr) { + markName = "current"; + } else if (segPtr == textPtr->insertMarkPtr) { + markName = "insert"; + } else if (segPtr->body.mark.hPtr == NULL) { + /* + * Ignore widget-specific marks for the other widgets. This is either + * an insert or a current mark (markPtr->body.mark.hPtr actually + * receives NULL for these marks in TkTextSetMark). The insert and + * current marks for textPtr having already been tested above, the + * current segment is an insert or current mark from a peer of + * textPtr, which we don't want to return. + */ + + return NULL; + } else { + markName = Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, + segPtr->body.mark.hPtr); + } + return Tcl_NewStringObj(markName, -1); +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tkTextTag.c b/generic/tkTextTag.c index dad03bf..af3f235 100644 --- a/generic/tkTextTag.c +++ b/generic/tkTextTag.c @@ -23,7 +23,7 @@ * a whole is not. */ -static const char *wrapStrings[] = { +static const char *const wrapStrings[] = { "char", "none", "word", "", NULL }; @@ -34,7 +34,7 @@ static const char *wrapStrings[] = { * widget as a whole is not. */ -static const char *tabStyleStrings[] = { +static const char *const tabStyleStrings[] = { "tabular", "wordprocessor", "", NULL }; @@ -80,14 +80,14 @@ static const Tk_OptionSpec tagOptionSpecs[] = { NULL, Tk_Offset(TkTextTag, tabStringPtr), -1, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-tabstyle", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, tabStyle), - TK_OPTION_NULL_OK, (ClientData) tabStyleStrings, 0}, + TK_OPTION_NULL_OK, tabStyleStrings, 0}, {TK_OPTION_STRING, "-underline", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, underlineString), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-wrap", NULL, NULL, NULL, -1, Tk_Offset(TkTextTag, wrapMode), - TK_OPTION_NULL_OK, (ClientData) wrapStrings, 0}, - {TK_OPTION_END} + TK_OPTION_NULL_OK, wrapStrings, 0}, + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} }; /* @@ -99,8 +99,8 @@ static void ChangeTagPriority(TkText *textPtr, TkTextTag *tagPtr, static TkTextTag * FindTag(Tcl_Interp *interp, TkText *textPtr, Tcl_Obj *tagName); static void SortTags(int numTags, TkTextTag **tagArrayPtr); -static int TagSortProc(CONST VOID *first, CONST VOID *second); -static void TagBindEvent(TkText *textPtr, XEvent *eventPtr, +static int TagSortProc(const void *first, const void *second); +static void TagBindEvent(TkText *textPtr, XEvent *eventPtr, int numTags, TkTextTag **tagArrayPtr); /* @@ -126,11 +126,11 @@ TkTextTagCmd( register TkText *textPtr, /* Information about text widget. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. Someone else has already + Tcl_Obj *const objv[]) /* Argument objects. Someone else has already * parsed this command enough to know that * objv[1] is "tag". */ { - static CONST char *tagOptionStrings[] = { + static const char *const tagOptionStrings[] = { "add", "bind", "cget", "configure", "delete", "lower", "names", "nextrange", "prevrange", "raise", "ranges", "remove", NULL }; @@ -144,12 +144,12 @@ TkTextTagCmd( TkTextIndex index1, index2; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], tagOptionStrings, - "tag option", 0, &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], tagOptionStrings, + sizeof(char *), "tag option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } @@ -221,7 +221,7 @@ TkTextTagCmd( if (tagPtr == textPtr->selTagPtr) { /* - * Send an event that the selection changed. This is + * Send an event that the selection changed. This is * equivalent to: * event generate $textWidget <<Selection>> */ @@ -231,7 +231,7 @@ TkTextTagCmd( if (addTag && textPtr->exportSelection && !(textPtr->flags & GOT_SELECTION)) { Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, - TkTextLostSelection, (ClientData) textPtr); + TkTextLostSelection, textPtr); textPtr->flags |= GOT_SELECTION; } textPtr->abortSelections = 1; @@ -259,7 +259,7 @@ TkTextTagCmd( if (objc == 6) { int append = 0; unsigned long mask; - char *fifth = Tcl_GetString(objv[5]); + const char *fifth = Tcl_GetString(objv[5]); if (fifth[0] == 0) { return Tk_DeleteBinding(interp, @@ -284,20 +284,20 @@ TkTextTagCmd( |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) { Tk_DeleteBinding(interp, textPtr->sharedTextPtr->bindingTable, (ClientData) tagPtr->name, Tcl_GetString(objv[4])); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "requested illegal events; ", - "only key, button, motion, enter, leave, and virtual ", - "events may be used", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "requested illegal events; only key, button, motion," + " enter, leave, and virtual events may be used", -1)); + Tcl_SetErrorCode(interp, "TK", "TEXT", "TAG_BIND_EVENT",NULL); return TCL_ERROR; } } else if (objc == 5) { - CONST char *command; + const char *command; command = Tk_GetBinding(interp, textPtr->sharedTextPtr->bindingTable, (ClientData) tagPtr->name, Tcl_GetString(objv[4])); if (command == NULL) { - CONST char *string = Tcl_GetStringResult(interp); + const char *string = Tcl_GetString(Tcl_GetObjResult(interp)); /* * Ignore missing binding errors. This is a special hack that @@ -310,7 +310,7 @@ TkTextTagCmd( } Tcl_ResetResult(interp); } else { - Tcl_SetResult(interp, (char *) command, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); } } else { Tk_GetAllBindings(interp, textPtr->sharedTextPtr->bindingTable, @@ -342,7 +342,7 @@ TkTextTagCmd( if (objc < 4) { Tcl_WrongNumArgs(interp, 3, objv, - "tagName ?option? ?value? ?option value ...?"); + "tagName ?-option? ?value? ?-option value ...?"); return TCL_ERROR; } tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), &newTag); @@ -359,7 +359,7 @@ TkTextTagCmd( } else { int result = TCL_OK; - if (Tk_SetOptions(interp, (char*)tagPtr, tagPtr->optionTable, + if (Tk_SetOptions(interp, (char *) tagPtr, tagPtr->optionTable, objc-4, objv+4, textPtr->tkwin, NULL, NULL) != TCL_OK) { return TCL_ERROR; } @@ -444,7 +444,7 @@ TkTextTagCmd( } } if (tagPtr->tabArrayPtr != NULL) { - ckfree((char *) tagPtr->tabArrayPtr); + ckfree(tagPtr->tabArrayPtr); tagPtr->tabArrayPtr = NULL; } if (tagPtr->tabStringPtr != NULL) { @@ -465,11 +465,14 @@ TkTextTagCmd( &tagPtr->elide) != TCL_OK) { return TCL_ERROR; } - /* Indices are potentially obsolete after changing -elide, - * especially those computed with "display" or "any" - * submodifier, therefore increase the epoch. - */ - textPtr->sharedTextPtr->stateEpoch++; + + /* + * Indices are potentially obsolete after changing -elide, + * especially those computed with "display" or "any" + * submodifier, therefore increase the epoch. + */ + + textPtr->sharedTextPtr->stateEpoch++; } /* @@ -552,7 +555,7 @@ TkTextTagCmd( continue; } - tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr); + tagPtr = Tcl_GetHashValue(hPtr); if (tagPtr == textPtr->selTagPtr) { continue; } @@ -613,12 +616,12 @@ TkTextTagCmd( Tcl_HashSearch search; Tcl_HashEntry *hPtr; - arrayPtr = (TkTextTag **) ckalloc((unsigned) - (textPtr->sharedTextPtr->numTags * sizeof(TkTextTag *))); + arrayPtr = ckalloc(textPtr->sharedTextPtr->numTags + * sizeof(TkTextTag *)); for (i=0, hPtr = Tcl_FirstHashEntry( &textPtr->sharedTextPtr->tagTable, &search); hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) { - arrayPtr[i] = (TkTextTag *) Tcl_GetHashValue(hPtr); + arrayPtr[i] = Tcl_GetHashValue(hPtr); } /* @@ -647,13 +650,14 @@ TkTextTagCmd( Tcl_NewStringObj(tagPtr->name,-1)); } Tcl_SetObjResult(interp, listObj); - ckfree((char *) arrayPtr); + ckfree(arrayPtr); break; } case TAG_NEXTRANGE: { TkTextIndex last; TkTextSearch tSearch; char position[TK_POS_CHARS]; + Tcl_Obj *resultObj; if ((objc != 5) && (objc != 6)) { Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?"); @@ -722,11 +726,15 @@ TkTextTagCmd( if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) { return TCL_OK; } + resultObj = Tcl_NewObj(); TkTextPrintIndex(textPtr, &tSearch.curIndex, position); - Tcl_AppendElement(interp, position); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position, -1)); TkBTreeNextTag(&tSearch); TkTextPrintIndex(textPtr, &tSearch.curIndex, position); - Tcl_AppendElement(interp, position); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position, -1)); + Tcl_SetObjResult(interp, resultObj); break; } case TAG_PREVRANGE: { @@ -734,6 +742,7 @@ TkTextTagCmd( TkTextSearch tSearch; char position1[TK_POS_CHARS]; char position2[TK_POS_CHARS]; + Tcl_Obj *resultObj; if ((objc != 5) && (objc != 6)) { Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?"); @@ -781,8 +790,7 @@ TkTextTagCmd( TkTextPrintIndex(textPtr, &index2, position1); TkTextPrintIndex(textPtr, &index1, position2); - Tcl_AppendElement(interp, position1); - Tcl_AppendElement(interp, position2); + goto gotPrevIndexPair; } return TCL_OK; } @@ -832,8 +840,14 @@ TkTextTagCmd( } } } - Tcl_AppendElement(interp, position1); - Tcl_AppendElement(interp, position2); + + gotPrevIndexPair: + resultObj = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position1, -1)); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(position2, -1)); + Tcl_SetObjResult(interp, resultObj); break; } case TAG_RAISE: { @@ -892,12 +906,12 @@ TkTextTagCmd( 0, &last); TkBTreeStartSearch(&first, &last, tagPtr, &tSearch); if (TkBTreeCharTagged(&first, tagPtr)) { - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &first)); count++; } while (TkBTreeNextTag(&tSearch)) { - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &tSearch.curIndex)); count++; } @@ -908,7 +922,7 @@ TkTextTagCmd( * closed. In this case we add the end of the range. */ - Tcl_ListObjAppendElement(interp, listObj, + Tcl_ListObjAppendElement(NULL, listObj, TkTextNewIndexObj(textPtr, &last)); } Tcl_SetObjResult(interp, listObj); @@ -939,25 +953,25 @@ TkTextTagCmd( TkTextTag * TkTextCreateTag( TkText *textPtr, /* Widget in which tag is being used. */ - CONST char *tagName, /* Name of desired tag. */ + const char *tagName, /* Name of desired tag. */ int *newTag) /* If non-NULL, then return 1 if new, or 0 if * already exists. */ { register TkTextTag *tagPtr; Tcl_HashEntry *hPtr = NULL; int isNew; - CONST char *name; + const char *name; if (!strcmp(tagName, "sel")) { - if (textPtr->selTagPtr != NULL) { + if (textPtr->selTagPtr != NULL) { if (newTag != NULL) { - *newTag = 0; + *newTag = 0; } - return textPtr->selTagPtr; - } + return textPtr->selTagPtr; + } if (newTag != NULL) { *newTag = 1; - } + } name = "sel"; } else { hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->tagTable, @@ -966,7 +980,7 @@ TkTextCreateTag( *newTag = isNew; } if (!isNew) { - return (TkTextTag *) Tcl_GetHashValue(hPtr); + return Tcl_GetHashValue(hPtr); } name = Tcl_GetHashKey(&textPtr->sharedTextPtr->tagTable, hPtr); } @@ -976,7 +990,7 @@ TkTextCreateTag( * to it to the hash table entry. */ - tagPtr = (TkTextTag *) ckalloc(sizeof(TkTextTag)); + tagPtr = ckalloc(sizeof(TkTextTag)); tagPtr->name = name; tagPtr->textPtr = NULL; tagPtr->toggleCount = 0; @@ -1024,6 +1038,7 @@ TkTextCreateTag( tagPtr->textPtr = textPtr; textPtr->refCount++; } else { + CLANG_ASSERT(hPtr); Tcl_SetHashValue(hPtr, tagPtr); } tagPtr->optionTable = @@ -1055,24 +1070,27 @@ FindTag( * NULL, then don't record an error * message. */ TkText *textPtr, /* Widget in which tag is being used. */ - Tcl_Obj *tagName) /* Name of desired tag. */ + Tcl_Obj *tagName) /* Name of desired tag. */ { Tcl_HashEntry *hPtr; int len; - CONST char *str; + const char *str; str = Tcl_GetStringFromObj(tagName, &len); - if (len == 3 && !strcmp(str,"sel")) { - return textPtr->selTagPtr; + if (len == 3 && !strcmp(str, "sel")) { + return textPtr->selTagPtr; } hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->tagTable, Tcl_GetString(tagName)); if (hPtr != NULL) { - return (TkTextTag *) Tcl_GetHashValue(hPtr); + return Tcl_GetHashValue(hPtr); } if (interp != NULL) { - Tcl_AppendResult(interp, "tag \"", Tcl_GetString(tagName), - "\" isn't defined in text widget", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tag \"%s\" isn't defined in text widget", + Tcl_GetString(tagName))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TEXT_TAG", + Tcl_GetString(tagName), NULL); } return NULL; } @@ -1179,7 +1197,7 @@ TkTextFreeTag( */ if (tagPtr->tabArrayPtr != NULL) { - ckfree((char *) tagPtr->tabArrayPtr); + ckfree(tagPtr->tabArrayPtr); } /* @@ -1208,7 +1226,7 @@ TkTextFreeTag( } textPtr->refCount--; if (textPtr->refCount == 0) { - ckfree((char *) textPtr); + ckfree(textPtr); } tagPtr->textPtr = NULL; } @@ -1217,7 +1235,7 @@ TkTextFreeTag( * Finally free the tag's memory. */ - ckfree((char *) tagPtr); + ckfree(tagPtr); } /* @@ -1290,8 +1308,8 @@ SortTags( static int TagSortProc( - CONST void *first, - CONST void *second) /* Elements to be compared. */ + const void *first, + const void *second) /* Elements to be compared. */ { TkTextTag *tagPtr1, *tagPtr2; @@ -1360,7 +1378,7 @@ ChangeTagPriority( } for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->tagTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - tagPtr2 = (TkTextTag *) Tcl_GetHashValue(hPtr); + tagPtr2 = Tcl_GetHashValue(hPtr); if ((tagPtr2->priority >= low) && (tagPtr2->priority <= high)) { tagPtr2->priority += delta; } @@ -1391,8 +1409,8 @@ TkTextBindProc( ClientData clientData, /* Pointer to canvas structure. */ XEvent *eventPtr) /* Pointer to X event that just happened. */ { - TkText *textPtr = (TkText *) clientData; - int repick = 0; + TkText *textPtr = clientData; + int repick = 0; # define AnyButtonMask \ (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask) @@ -1436,7 +1454,7 @@ TkTextBindProc( } } else if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) { - if (eventPtr->xcrossing.state & AnyButtonMask) { + if (eventPtr->xcrossing.state & AnyButtonMask) { textPtr->flags |= BUTTON_DOWN; } else { textPtr->flags &= ~BUTTON_DOWN; @@ -1444,7 +1462,7 @@ TkTextBindProc( TkTextPickCurrent(textPtr, eventPtr); goto done; } else if (eventPtr->type == MotionNotify) { - if (eventPtr->xmotion.state & AnyButtonMask) { + if (eventPtr->xmotion.state & AnyButtonMask) { textPtr->flags |= BUTTON_DOWN; } else { textPtr->flags &= ~BUTTON_DOWN; @@ -1471,7 +1489,7 @@ TkTextBindProc( done: if (--textPtr->refCount == 0) { - ckfree((char *) textPtr); + ckfree(textPtr); } } @@ -1568,7 +1586,7 @@ TkTextPickCurrent( = eventPtr->xmotion.same_screen; textPtr->pickEvent.xcrossing.focus = False; textPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state; - } else { + } else { textPtr->pickEvent = *eventPtr; } } @@ -1603,7 +1621,7 @@ TkTextPickCurrent( SortTags(textPtr->numCurTags, textPtr->curTagArrayPtr); if (numNewTags > 0) { size = numNewTags * sizeof(TkTextTag *); - copyArrayPtr = (TkTextTag **) ckalloc((unsigned) size); + copyArrayPtr = ckalloc(size); memcpy(copyArrayPtr, newArrayPtr, (size_t) size); for (i = 0; i < textPtr->numCurTags; i++) { for (j = 0; j < numNewTags; j++) { @@ -1645,7 +1663,7 @@ TkTextPickCurrent( event.xcrossing.detail = NotifyAncestor; TagBindEvent(textPtr, &event, numOldTags, oldArrayPtr); } - ckfree((char *) oldArrayPtr); + ckfree(oldArrayPtr); } /* @@ -1667,7 +1685,7 @@ TkTextPickCurrent( event.xcrossing.detail = NotifyAncestor; TagBindEvent(textPtr, &event, numNewTags, copyArrayPtr); } - ckfree((char *) copyArrayPtr); + ckfree(copyArrayPtr); } } @@ -1697,9 +1715,9 @@ TagBindEvent( int numTags, /* Number of relevant tags. */ TkTextTag **tagArrayPtr) /* Array of relevant tags. */ { - #define NUM_BIND_TAGS 10 - CONST char *nameArray[NUM_BIND_TAGS]; - CONST char **nameArrPtr; +# define NUM_BIND_TAGS 10 + const char *nameArray[NUM_BIND_TAGS]; + const char **nameArrPtr; int i; /* @@ -1707,7 +1725,7 @@ TagBindEvent( */ if (numTags > NUM_BIND_TAGS) { - nameArrPtr = (CONST char **) ckalloc(numTags * sizeof(CONST char *)); + nameArrPtr = ckalloc(numTags * sizeof(const char *)); } else { nameArrPtr = nameArray; } @@ -1720,6 +1738,7 @@ TagBindEvent( for (i = 0; i < numTags; i++) { TkTextTag *tagPtr = tagArrayPtr[i]; + if (tagPtr != NULL) { nameArrPtr[i] = tagPtr->name; } else { @@ -1736,7 +1755,7 @@ TagBindEvent( textPtr->tkwin, numTags, (ClientData *) nameArrPtr); if (numTags > NUM_BIND_TAGS) { - ckfree((char *) nameArrPtr); + ckfree(nameArrPtr); } } diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c index 5b511d2..c9fc20f 100644 --- a/generic/tkTextWind.c +++ b/generic/tkTextWind.c @@ -63,14 +63,14 @@ static void EmbWinStructureProc(ClientData clientData, XEvent *eventPtr); static void EmbWinUndisplayProc(TkText *textPtr, TkTextDispChunk *chunkPtr); -static TkTextEmbWindowClient* EmbWinGetClient(const TkText *textPtr, +static TkTextEmbWindowClient *EmbWinGetClient(const TkText *textPtr, TkTextSegment *ewPtr); /* * The following structure declares the "embedded window" segment type. */ -static const Tk_SegType tkTextEmbWindowType = { +const Tk_SegType tkTextEmbWindowType = { "window", /* name */ 0, /* leftGravity */ NULL, /* splitProc */ @@ -85,7 +85,7 @@ static const Tk_SegType tkTextEmbWindowType = { * Definitions for alignment values: */ -static const char *alignStrings[] = { +static const char *const alignStrings[] = { "baseline", "bottom", "center", "top", NULL }; @@ -100,7 +100,7 @@ typedef enum { static const Tk_OptionSpec optionSpecs[] = { {TK_OPTION_STRING_TABLE, "-align", NULL, NULL, "center", -1, Tk_Offset(TkTextEmbWindow, align), - 0, (ClientData) alignStrings, 0}, + 0, alignStrings, 0}, {TK_OPTION_STRING, "-create", NULL, NULL, NULL, -1, Tk_Offset(TkTextEmbWindow, create), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_PIXELS, "-padx", NULL, NULL, @@ -111,7 +111,7 @@ static const Tk_OptionSpec optionSpecs[] = { "0", -1, Tk_Offset(TkTextEmbWindow, stretch), 0, 0, 0}, {TK_OPTION_WINDOW, "-window", NULL, NULL, NULL, -1, Tk_Offset(TkTextEmbWindow, tkwin), TK_OPTION_NULL_OK, 0, 0}, - {TK_OPTION_END} + {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} }; /* @@ -141,7 +141,7 @@ TkTextWindowCmd( * objv[1] is "window". */ { int optionIndex; - static const char *windOptionStrings[] = { + static const char *const windOptionStrings[] = { "cget", "configure", "create", "names", NULL }; enum windOptions { @@ -150,11 +150,11 @@ TkTextWindowCmd( register TkTextSegment *ewPtr; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], windOptionStrings, - "window option", 0, &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], windOptionStrings, + sizeof(char *), "window option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum windOptions) optionIndex) { @@ -173,8 +173,10 @@ TkTextWindowCmd( } ewPtr = TkTextIndexToSeg(&index, NULL); if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded window at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL); return TCL_ERROR; } @@ -202,7 +204,7 @@ TkTextWindowCmd( TkTextSegment *ewPtr; if (objc < 4) { - Tcl_WrongNumArgs(interp, 3, objv, "index ?option value ...?"); + Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?"); return TCL_ERROR; } if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { @@ -210,13 +212,15 @@ TkTextWindowCmd( } ewPtr = TkTextIndexToSeg(&index, NULL); if (ewPtr->typePtr != &tkTextEmbWindowType) { - Tcl_AppendResult(interp, "no embedded window at index \"", - Tcl_GetString(objv[3]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no embedded window at index \"%s\"", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "TEXT", "NO_WINDOW", NULL); return TCL_ERROR; } if (objc <= 5) { TkTextEmbWindowClient *client; - Tcl_Obj* objPtr; + Tcl_Obj *objPtr; /* * Copy over client specific value before querying. @@ -263,7 +267,7 @@ TkTextWindowCmd( */ if (objc < 4) { - Tcl_WrongNumArgs(interp, 3, objv, "index ?option value ...?"); + Tcl_WrongNumArgs(interp, 3, objv, "index ?-option value ...?"); return TCL_ERROR; } if (TkTextGetObjIndex(interp, textPtr, objv[3], &index) != TCL_OK) { @@ -286,7 +290,7 @@ TkTextWindowCmd( * Create the new window segment and initialize it. */ - ewPtr = (TkTextSegment *) ckalloc(EW_SEG_SIZE); + ewPtr = ckalloc(EW_SEG_SIZE); ewPtr->typePtr = &tkTextEmbWindowType; ewPtr->size = 1; ewPtr->body.ew.sharedTextPtr = textPtr->sharedTextPtr; @@ -298,8 +302,7 @@ TkTextWindowCmd( ewPtr->body.ew.stretch = 0; ewPtr->body.ew.optionTable = Tk_CreateOptionTable(interp, optionSpecs); - client = (TkTextEmbWindowClient *) - ckalloc(sizeof(TkTextEmbWindowClient)); + client = ckalloc(sizeof(TkTextEmbWindowClient)); client->next = NULL; client->textPtr = textPtr; client->tkwin = NULL; @@ -332,16 +335,20 @@ TkTextWindowCmd( case WIND_NAMES: { Tcl_HashSearch search; Tcl_HashEntry *hPtr; + Tcl_Obj *resultObj; if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } + resultObj = Tcl_NewObj(); for (hPtr = Tcl_FirstHashEntry(&textPtr->sharedTextPtr->windowTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendElement(interp, - Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_GetHashKey(&textPtr->sharedTextPtr->markTable, hPtr), + -1)); } + Tcl_SetObjResult(interp, resultObj); break; } } @@ -408,8 +415,8 @@ EmbWinConfigure( &textPtr->sharedTextPtr->windowTable, Tk_PathName(oldWindow))); Tk_DeleteEventHandler(oldWindow, StructureNotifyMask, - EmbWinStructureProc, (ClientData) client); - Tk_ManageGeometry(oldWindow, NULL, (ClientData) NULL); + EmbWinStructureProc, client); + Tk_ManageGeometry(oldWindow, NULL, NULL); if (textPtr->tkwin != Tk_Parent(oldWindow)) { Tk_UnmaintainGeometry(oldWindow, textPtr->tkwin); } else { @@ -437,9 +444,12 @@ EmbWinConfigure( } if (Tk_TopWinHierarchy(ancestor)) { badMaster: - Tcl_AppendResult(textPtr->interp, "can't embed ", - Tk_PathName(ewPtr->body.ew.tkwin), " in ", - Tk_PathName(textPtr->tkwin), NULL); + Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf( + "can't embed %s in %s", + Tk_PathName(ewPtr->body.ew.tkwin), + Tk_PathName(textPtr->tkwin))); + Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", + "HIERARCHY", NULL); ewPtr->body.ew.tkwin = NULL; if (client != NULL) { client->tkwin = NULL; @@ -457,8 +467,7 @@ EmbWinConfigure( * Have to make the new client. */ - client = (TkTextEmbWindowClient *) - ckalloc(sizeof(TkTextEmbWindowClient)); + client = ckalloc(sizeof(TkTextEmbWindowClient)); client->next = ewPtr->body.ew.clients; client->textPtr = textPtr; client->tkwin = NULL; @@ -474,10 +483,9 @@ EmbWinConfigure( * event handler to find out when it is deleted. */ - Tk_ManageGeometry(ewPtr->body.ew.tkwin, &textGeomType, - (ClientData) client); + Tk_ManageGeometry(ewPtr->body.ew.tkwin, &textGeomType, client); Tk_CreateEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask, - EmbWinStructureProc, (ClientData) client); + EmbWinStructureProc, client); /* * Special trick! Must enter into the hash table *after* calling @@ -518,7 +526,7 @@ EmbWinStructureProc( ClientData clientData, /* Pointer to record describing window item. */ XEvent *eventPtr) /* Describes what just happened. */ { - TkTextEmbWindowClient *client = (TkTextEmbWindowClient*)clientData; + TkTextEmbWindowClient *client = clientData; TkTextSegment *ewPtr = client->parent; TkTextIndex index; Tcl_HashEntry *hPtr; @@ -571,7 +579,7 @@ EmbWinRequestProc( ClientData clientData, /* Pointer to record for window item. */ Tk_Window tkwin) /* Window that changed its desired size. */ { - TkTextEmbWindowClient *client = (TkTextEmbWindowClient*)clientData; + TkTextEmbWindowClient *client = clientData; TkTextSegment *ewPtr = client->parent; TkTextIndex index; @@ -608,15 +616,15 @@ EmbWinLostSlaveProc( Tk_Window tkwin) /* Window that was claimed away by another * geometry manager. */ { - TkTextEmbWindowClient *client = (TkTextEmbWindowClient*)clientData; + TkTextEmbWindowClient *client = clientData; TkTextSegment *ewPtr = client->parent; TkTextIndex index; Tcl_HashEntry *hPtr; TkTextEmbWindowClient *loop; Tk_DeleteEventHandler(client->tkwin, StructureNotifyMask, - EmbWinStructureProc, (ClientData) client); - Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) client); + EmbWinStructureProc, client); + Tcl_CancelIdleCall(EmbWinDelayedUnmap, client); if (client->textPtr->tkwin != Tk_Parent(tkwin)) { Tk_UnmaintainGeometry(tkwin, client->textPtr->tkwin); } else { @@ -641,7 +649,7 @@ EmbWinLostSlaveProc( } loop->next = client->next; } - ckfree((char *) client); + ckfree(client); index.tree = ewPtr->body.ew.sharedTextPtr->tree; index.linePtr = ewPtr->body.ew.linePtr; @@ -698,16 +706,16 @@ TkTextWinFreeClient( if (client->tkwin != NULL) { Tk_DeleteEventHandler(client->tkwin, StructureNotifyMask, - EmbWinStructureProc, (ClientData) client); + EmbWinStructureProc, client); Tk_DestroyWindow(client->tkwin); } - Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) client); + Tcl_CancelIdleCall(EmbWinDelayedUnmap, client); /* * Free up this client. */ - ckfree((char *) client); + ckfree(client); } /* @@ -761,7 +769,7 @@ EmbWinDeleteProc( * Free up all memory allocated. */ - ckfree((char *) ewPtr); + ckfree(ewPtr); return 0; } @@ -849,7 +857,8 @@ EmbWinLayoutProc( Tk_Window ancestor; Tcl_HashEntry *hPtr; const char *before, *string; - Tcl_DString name, buf, *dsPtr = NULL; + Tcl_DString buf, *dsPtr = NULL; + Tcl_Obj *nameObj; before = ewPtr->body.ew.create; @@ -908,36 +917,40 @@ EmbWinLayoutProc( code = Tcl_EvalEx(textPtr->interp, ewPtr->body.ew.create, -1, TCL_EVAL_GLOBAL); } if (code != TCL_OK) { - createError: - Tcl_BackgroundError(textPtr->interp); + Tcl_BackgroundException(textPtr->interp, code); goto gotWindow; } - Tcl_DStringInit(&name); - Tcl_DStringAppend(&name, Tcl_GetStringResult(textPtr->interp), -1); + nameObj = Tcl_GetObjResult(textPtr->interp); + Tcl_IncrRefCount(nameObj); Tcl_ResetResult(textPtr->interp); ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp, - Tcl_DStringValue(&name), textPtr->tkwin); - Tcl_DStringFree(&name); + Tcl_GetString(nameObj), textPtr->tkwin); + Tcl_DecrRefCount(nameObj); if (ewPtr->body.ew.tkwin == NULL) { - goto createError; + Tcl_BackgroundException(textPtr->interp, TCL_ERROR); + goto gotWindow; } + for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) { if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) { break; } if (Tk_TopWinHierarchy(ancestor)) { - badMaster: - Tcl_AppendResult(textPtr->interp, "can't embed ", - Tk_PathName(ewPtr->body.ew.tkwin), " relative to ", - Tk_PathName(textPtr->tkwin), NULL); - Tcl_BackgroundError(textPtr->interp); - ewPtr->body.ew.tkwin = NULL; - goto gotWindow; + goto badMaster; } } if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin) || (textPtr->tkwin == ewPtr->body.ew.tkwin)) { - goto badMaster; + badMaster: + Tcl_SetObjResult(textPtr->interp, Tcl_ObjPrintf( + "can't embed %s relative to %s", + Tk_PathName(ewPtr->body.ew.tkwin), + Tk_PathName(textPtr->tkwin))); + Tcl_SetErrorCode(textPtr->interp, "TK", "GEOMETRY", "HIERARCHY", + NULL); + Tcl_BackgroundException(textPtr->interp, TCL_ERROR); + ewPtr->body.ew.tkwin = NULL; + goto gotWindow; } if (client == NULL) { @@ -946,8 +959,7 @@ EmbWinLayoutProc( * now need to add to our client list. */ - client = (TkTextEmbWindowClient *) - ckalloc(sizeof(TkTextEmbWindowClient)); + client = ckalloc(sizeof(TkTextEmbWindowClient)); client->next = ewPtr->body.ew.clients; client->textPtr = textPtr; client->tkwin = NULL; @@ -958,10 +970,9 @@ EmbWinLayoutProc( } client->tkwin = ewPtr->body.ew.tkwin; - Tk_ManageGeometry(client->tkwin, &textGeomType, - (ClientData) client); + Tk_ManageGeometry(client->tkwin, &textGeomType, client); Tk_CreateEventHandler(client->tkwin, StructureNotifyMask, - EmbWinStructureProc, (ClientData) client); + EmbWinStructureProc, client); /* * Special trick! Must enter into the hash table *after* calling @@ -1013,7 +1024,7 @@ EmbWinLayoutProc( chunkPtr->width = width; chunkPtr->breakIndex = -1; chunkPtr->breakIndex = 1; - chunkPtr->clientData = (ClientData) ewPtr; + chunkPtr->clientData = ewPtr; if (client != NULL) { client->chunkCount += 1; } @@ -1089,7 +1100,7 @@ TkTextEmbWinDisplayProc( { int lineX, windowX, windowY, width, height; Tk_Window tkwin; - TkTextSegment *ewPtr = (TkTextSegment*) chunkPtr->clientData; + TkTextSegment *ewPtr = chunkPtr->clientData; TkTextEmbWindowClient *client = EmbWinGetClient(textPtr, ewPtr); if (client == NULL) { @@ -1169,7 +1180,7 @@ EmbWinUndisplayProc( TkText *textPtr, /* Overall information about text widget. */ TkTextDispChunk *chunkPtr) /* Chunk that is about to be freed. */ { - TkTextSegment *ewPtr = (TkTextSegment*) chunkPtr->clientData; + TkTextSegment *ewPtr = chunkPtr->clientData; TkTextEmbWindowClient *client = EmbWinGetClient(textPtr, ewPtr); if (client == NULL) { @@ -1187,7 +1198,7 @@ EmbWinUndisplayProc( */ client->displayed = 0; - Tcl_DoWhenIdle(EmbWinDelayedUnmap, (ClientData) client); + Tcl_DoWhenIdle(EmbWinDelayedUnmap, client); } } @@ -1232,7 +1243,7 @@ EmbWinBboxProc( * pixels. */ { Tk_Window tkwin; - TkTextSegment *ewPtr = (TkTextSegment *) chunkPtr->clientData; + TkTextSegment *ewPtr = chunkPtr->clientData; TkTextEmbWindowClient *client = EmbWinGetClient(textPtr, ewPtr); if (client == NULL) { @@ -1294,7 +1305,7 @@ static void EmbWinDelayedUnmap( ClientData clientData) /* Token for the window to be unmapped. */ { - TkTextEmbWindowClient *client = (TkTextEmbWindowClient*) clientData; + TkTextEmbWindowClient *client = clientData; if (!client->displayed && (client->tkwin != NULL)) { if (client->textPtr->tkwin != Tk_Parent(client->tkwin)) { @@ -1342,7 +1353,7 @@ TkTextWindowIndex( return 0; } - ewPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr); + ewPtr = Tcl_GetHashValue(hPtr); indexPtr->tree = textPtr->sharedTextPtr->tree; indexPtr->linePtr = ewPtr->body.ew.linePtr; indexPtr->byteIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr); @@ -1373,7 +1384,7 @@ TkTextWindowIndex( *-------------------------------------------------------------- */ -static TkTextEmbWindowClient* +static TkTextEmbWindowClient * EmbWinGetClient( const TkText *textPtr, /* Information about text widget. */ TkTextSegment *ewPtr) /* Segment containing embedded window. */ diff --git a/generic/tkTrig.c b/generic/tkTrig.c index d7439b3..a2bf456 100644 --- a/generic/tkTrig.c +++ b/generic/tkTrig.c @@ -12,7 +12,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <stdio.h> #include "tkInt.h" #include "tkCanvas.h" @@ -20,9 +19,6 @@ #define MIN(a,b) (((a) < (b)) ? (a) : (b)) #undef MAX #define MAX(a,b) (((a) > (b)) ? (a) : (b)) -#ifndef PI -# define PI 3.14159265358979323846 -#endif /* PI */ /* *-------------------------------------------------------------- @@ -755,7 +751,7 @@ TkOvalToPoint( int TkOvalToArea( - register double *ovalPtr, /* Points to coordinates definining the + register double *ovalPtr, /* Points to coordinates defining the * bounding rectangle for the oval: x1, y1, * x2, y2. X1 must be less than x2 and y1 less * than y2. */ @@ -1379,7 +1375,7 @@ TkMakeBezierPostscript( int closed, i; int numCoords = numPoints*2; double control[8]; - char buffer[200]; + Tcl_Obj *psObj; /* * If the curve is a closed one then generate a special spline that spans @@ -1398,7 +1394,9 @@ TkMakeBezierPostscript( control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3]; control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2]; control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3]; - sprintf(buffer, "%.15g %.15g moveto\n%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + psObj = Tcl_ObjPrintf( + "%.15g %.15g moveto\n" + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", control[0], Tk_CanvasPsY(canvas, control[1]), control[2], Tk_CanvasPsY(canvas, control[3]), control[4], Tk_CanvasPsY(canvas, control[5]), @@ -1407,10 +1405,9 @@ TkMakeBezierPostscript( closed = 0; control[6] = pointPtr[0]; control[7] = pointPtr[1]; - sprintf(buffer, "%.15g %.15g moveto\n", + psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n", control[6], Tk_CanvasPsY(canvas, control[7])); } - Tcl_AppendResult(interp, buffer, NULL); /* * Cycle through all the remaining points in the curve, generating a curve @@ -1436,12 +1433,15 @@ TkMakeBezierPostscript( control[4] = 0.333*control[6] + 0.667*pointPtr[0]; control[5] = 0.333*control[7] + 0.667*pointPtr[1]; - sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", control[2], Tk_CanvasPsY(canvas, control[3]), control[4], Tk_CanvasPsY(canvas, control[5]), control[6], Tk_CanvasPsY(canvas, control[7])); - Tcl_AppendResult(interp, buffer, NULL); } + + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); } /* @@ -1476,15 +1476,14 @@ TkMakeRawCurvePostscript( { int i; double *segPtr; - char buffer[200]; + Tcl_Obj *psObj; /* * Put the first point into the path. */ - sprintf(buffer, "%.15g %.15g moveto\n", + psObj = Tcl_ObjPrintf("%.15g %.15g moveto\n", pointPtr[0], Tk_CanvasPsY(canvas, pointPtr[1])); - Tcl_AppendResult(interp, buffer, NULL); /* * Loop through all the remaining points in the curve, generating a @@ -1499,19 +1498,19 @@ TkMakeRawCurvePostscript( * neighbouring knots, so this segment is just a straight line. */ - sprintf(buffer, "%.15g %.15g lineto\n", + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", segPtr[6], Tk_CanvasPsY(canvas, segPtr[7])); } else { /* * This is a generic Bezier curve segment. */ - sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", segPtr[2], Tk_CanvasPsY(canvas, segPtr[3]), segPtr[4], Tk_CanvasPsY(canvas, segPtr[5]), segPtr[6], Tk_CanvasPsY(canvas, segPtr[7])); } - Tcl_AppendResult(interp, buffer, NULL); } /* @@ -1536,20 +1535,23 @@ TkMakeRawCurvePostscript( * Straight line. */ - sprintf(buffer, "%.15g %.15g lineto\n", + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", control[6], Tk_CanvasPsY(canvas, control[7])); } else { /* * Bezier curve segment. */ - sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", + Tcl_AppendPrintfToObj(psObj, + "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n", control[2], Tk_CanvasPsY(canvas, control[3]), control[4], Tk_CanvasPsY(canvas, control[5]), control[6], Tk_CanvasPsY(canvas, control[7])); } - Tcl_AppendResult(interp, buffer, NULL); } + + Tcl_AppendObjToObj(Tcl_GetObjResult(interp), psObj); + Tcl_DecrRefCount(psObj); } /* diff --git a/generic/tkUndo.c b/generic/tkUndo.c index bf2ed7c..8359e0a 100644 --- a/generic/tkUndo.c +++ b/generic/tkUndo.c @@ -94,7 +94,7 @@ TkUndoInsertSeparator( TkUndoAtom *separator; if (*stack!=NULL && (*stack)->type!=TK_UNDO_SEPARATOR) { - separator = (TkUndoAtom *) ckalloc(sizeof(TkUndoAtom)); + separator = ckalloc(sizeof(TkUndoAtom)); separator->type = TK_UNDO_SEPARATOR; TkUndoPushStack(stack,separator); return 1; @@ -135,7 +135,7 @@ TkUndoClearStack( if (sub->action != NULL) { Tcl_DecrRefCount(sub->action); } - ckfree((char *)sub); + ckfree(sub); sub = next; } @@ -146,11 +146,11 @@ TkUndoClearStack( if (sub->action != NULL) { Tcl_DecrRefCount(sub->action); } - ckfree((char *)sub); + ckfree(sub); sub = next; } } - ckfree((char *)elem); + ckfree(elem); } *stack = NULL; } @@ -181,7 +181,7 @@ TkUndoPushAction( { TkUndoAtom *atom; - atom = (TkUndoAtom *) ckalloc(sizeof(TkUndoAtom)); + atom = ckalloc(sizeof(TkUndoAtom)); atom->type = TK_UNDO_ACTION; atom->apply = apply; atom->revert = revert; @@ -237,7 +237,7 @@ TkUndoMakeCmdSubAtom( Tcl_Panic("NULL command and actionScript in TkUndoMakeCmdSubAtom"); } - atom = (TkUndoSubAtom *) ckalloc(sizeof(TkUndoSubAtom)); + atom = ckalloc(sizeof(TkUndoSubAtom)); atom->command = command; atom->funcPtr = NULL; atom->clientData = NULL; @@ -299,7 +299,7 @@ TkUndoMakeSubAtom( Tcl_Panic("NULL funcPtr in TkUndoMakeSubAtom"); } - atom = (TkUndoSubAtom *) ckalloc(sizeof(TkUndoSubAtom)); + atom = ckalloc(sizeof(TkUndoSubAtom)); atom->command = NULL; atom->funcPtr = funcPtr; atom->clientData = clientData; @@ -341,7 +341,7 @@ TkUndoInitStack( { TkUndoRedoStack *stack; /* An Undo/Redo stack */ - stack = (TkUndoRedoStack *) ckalloc(sizeof(TkUndoRedoStack)); + stack = ckalloc(sizeof(TkUndoRedoStack)); stack->undoStack = NULL; stack->redoStack = NULL; stack->interp = interp; @@ -392,6 +392,7 @@ TkUndoSetDepth( prevelem = elem; elem = elem->next; } + CLANG_ASSERT(prevelem); prevelem->next = NULL; while (elem != NULL) { prevelem = elem; @@ -403,7 +404,7 @@ TkUndoSetDepth( if (sub->action != NULL) { Tcl_DecrRefCount(sub->action); } - ckfree((char *)sub); + ckfree(sub); sub = next; } sub = elem->revert; @@ -413,12 +414,12 @@ TkUndoSetDepth( if (sub->action != NULL) { Tcl_DecrRefCount(sub->action); } - ckfree((char *)sub); + ckfree(sub); sub = next; } } elem = elem->next; - ckfree((char *) prevelem); + ckfree(prevelem); } stack->depth = stack->maxdepth; } @@ -471,7 +472,7 @@ TkUndoFreeStack( TkUndoRedoStack *stack) /* An Undo/Redo stack */ { TkUndoClearStacks(stack); - ckfree((char *) stack); + ckfree(stack); } /* @@ -540,7 +541,7 @@ TkUndoRevert( } if (elem->type == TK_UNDO_SEPARATOR) { - ckfree((char *) elem); + ckfree(elem); elem = TkUndoPopStack(&stack->undoStack); } @@ -602,7 +603,7 @@ TkUndoApply( } if (elem->type == TK_UNDO_SEPARATOR) { - ckfree((char *) elem); + ckfree(elem); elem = TkUndoPopStack(&stack->redoStack); } @@ -654,7 +655,7 @@ EvaluateActionList( while (action != NULL) { if (action->funcPtr != NULL) { - result = (*action->funcPtr)(interp, action->clientData, + result = action->funcPtr(interp, action->clientData, action->action); } else if (action->command != NULL) { Tcl_Obj *cmdNameObj, *evalObj; diff --git a/generic/tkUndo.h b/generic/tkUndo.h index b0e2db0..e63aac4 100644 --- a/generic/tkUndo.h +++ b/generic/tkUndo.h @@ -16,13 +16,8 @@ #include "tkInt.h" #endif -#ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif - /* - * Enum definining the types used in an undo stack. + * Enum defining the types used in an undo stack. */ typedef enum { @@ -115,7 +110,4 @@ MODULE_SCOPE void TkUndoPushAction(TkUndoRedoStack *stack, MODULE_SCOPE int TkUndoRevert(TkUndoRedoStack *stack); MODULE_SCOPE int TkUndoApply(TkUndoRedoStack *stack); -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TKUNDO */ diff --git a/generic/tkUtil.c b/generic/tkUtil.c index bfa5d5c..7ff9ecb 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -18,7 +18,7 @@ * object, used for quickly finding a mapping in a TkStateMap. */ -Tcl_ObjType tkStateKeyObjType = { +const Tcl_ObjType tkStateKeyObjType = { "statekey", /* name */ NULL, /* freeIntRepProc */ NULL, /* dupIntRepProc */ @@ -56,10 +56,11 @@ TkStateParseProc( int c; int flags = PTR2INT(clientData); size_t length; + Tcl_Obj *msgObj; register Tk_State *statePtr = (Tk_State *) (widgRec + offset); - if(value == NULL || *value == 0) { + if (value == NULL || *value == 0) { *statePtr = TK_STATE_NULL; return TCL_OK; } @@ -84,18 +85,20 @@ TkStateParseProc( return TCL_OK; } - Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state", - " value \"", value, "\": must be normal", NULL); - if (flags&1) { - Tcl_AppendResult(interp, ", active", NULL); + msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be normal", + ((flags & 4) ? "-default" : "state"), value); + if (flags & 1) { + Tcl_AppendToObj(msgObj, ", active", -1); } - if (flags&2) { - Tcl_AppendResult(interp, ", hidden", NULL); + if (flags & 2) { + Tcl_AppendToObj(msgObj, ", hidden", -1); } - if (flags&3) { - Tcl_AppendResult(interp, ",", NULL); + if (flags & 3) { + Tcl_AppendToObj(msgObj, ",", -1); } - Tcl_AppendResult(interp, " or disabled", NULL); + Tcl_AppendToObj(msgObj, " or disabled", -1); + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "VALUE", "STATE", NULL); *statePtr = TK_STATE_NORMAL; return TCL_ERROR; } @@ -121,7 +124,7 @@ TkStateParseProc( *-------------------------------------------------------------- */ -char * +const char * TkStatePrintProc( ClientData clientData, /* Ignored. */ Tk_Window tkwin, /* Window containing canvas widget. */ @@ -179,7 +182,7 @@ TkOrientParseProc( register int *orientPtr = (int *) (widgRec + offset); - if(value == NULL || *value == 0) { + if (value == NULL || *value == 0) { *orientPtr = 0; return TCL_OK; } @@ -195,8 +198,10 @@ TkOrientParseProc( *orientPtr = 1; return TCL_OK; } - Tcl_AppendResult(interp, "bad orientation \"", value, - "\": must be vertical or horizontal", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad orientation \"%s\": must be vertical or horizontal", + value)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ORIENTATION", NULL); *orientPtr = 0; return TCL_ERROR; } @@ -222,7 +227,7 @@ TkOrientParseProc( *-------------------------------------------------------------- */ -char * +const char * TkOrientPrintProc( ClientData clientData, /* Ignored. */ Tk_Window tkwin, /* Window containing canvas widget. */ @@ -265,6 +270,7 @@ TkOffsetParseProc( Tk_TSOffset tsoffset; const char *q, *p; int result; + Tcl_Obj *msgObj; if ((value == NULL) || (*value == 0)) { tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; @@ -273,7 +279,7 @@ TkOffsetParseProc( tsoffset.flags = 0; p = value; - switch(value[0]) { + switch (value[0]) { case '#': if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) { tsoffset.flags = TK_OFFSET_RELATIVE; @@ -336,7 +342,13 @@ TkOffsetParseProc( tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; goto goodTSOffset; } - if ((q = strchr(p,',')) == NULL) { + + /* + * Check for an extra offset. + */ + + q = strchr(p, ','); + if (q == NULL) { if (PTR2INT(clientData) & TK_OFFSET_INDEX) { if (Tcl_GetInt(interp, (char *) p, &tsoffset.flags) != TCL_OK) { Tcl_ResetResult(interp); @@ -347,6 +359,7 @@ TkOffsetParseProc( } goto badTSOffset; } + *((char *) q) = 0; result = Tk_GetPixels(interp, tkwin, (char *) p, &tsoffset.xoffset); *((char *) q) = ','; @@ -357,27 +370,28 @@ TkOffsetParseProc( return TCL_ERROR; } - goodTSOffset: /* * Below is a hack to allow the stipple/tile offset to be stored in the * internal tile structure. Most of the times, offsetPtr is a pointer to * an already existing tile structure. However if this structure is not - * already created, we must do it with Tk_GetTile()!!!!; + * already created, we must do it with Tk_GetTile()!!!! */ + goodTSOffset: memcpy(offsetPtr, &tsoffset, sizeof(Tk_TSOffset)); return TCL_OK; badTSOffset: - Tcl_AppendResult(interp, "bad offset \"", value, - "\": expected \"x,y\"", NULL); + msgObj = Tcl_ObjPrintf("bad offset \"%s\": expected \"x,y\"", value); if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) { - Tcl_AppendResult(interp, ", \"#x,y\"", NULL); + Tcl_AppendToObj(msgObj, ", \"#x,y\"", -1); } if (PTR2INT(clientData) & TK_OFFSET_INDEX) { - Tcl_AppendResult(interp, ", <index>", NULL); + Tcl_AppendToObj(msgObj, ", <index>", -1); } - Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", NULL); + Tcl_AppendToObj(msgObj, ", n, ne, e, se, s, sw, w, nw, or center", -1); + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "VALUE", "OFFSET", NULL); return TCL_ERROR; } @@ -394,7 +408,7 @@ TkOffsetParseProc( *---------------------------------------------------------------------- */ -char * +const char * TkOffsetPrintProc( ClientData clientData, /* not used */ Tk_Window tkwin, /* not used */ @@ -409,7 +423,7 @@ TkOffsetPrintProc( if (offsetPtr->flags >= INT_MAX) { return "end"; } - p = (char *) ckalloc(32); + p = ckalloc(32); sprintf(p, "%d", offsetPtr->flags & ~TK_OFFSET_INDEX); *freeProcPtr = TCL_DYNAMIC; return p; @@ -439,7 +453,7 @@ TkOffsetPrintProc( return "se"; } } - q = p = (char *) ckalloc(32); + q = p = ckalloc(32); if (offsetPtr->flags & TK_OFFSET_RELATIVE) { *q++ = '#'; } @@ -461,7 +475,7 @@ TkOffsetPrintProc( int TkPixelParseProc( ClientData clientData, /* If non-NULL, negative values are allowed as - * well */ + * well. */ Tcl_Interp *interp, /* Interpreter to send results back to */ Tk_Window tkwin, /* Window on same display as tile */ const char *value, /* Name of image */ @@ -474,7 +488,9 @@ TkPixelParseProc( result = TkGetDoublePixels(interp, tkwin, value, doublePtr); if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) { - Tcl_AppendResult(interp, "bad screen distance \"", value, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen distance \"%s\"", value)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "PIXELS", NULL); return TCL_ERROR; } return result; @@ -493,7 +509,7 @@ TkPixelParseProc( *---------------------------------------------------------------------- */ -char * +const char * TkPixelPrintProc( ClientData clientData, /* not used */ Tk_Window tkwin, /* not used */ @@ -502,7 +518,7 @@ TkPixelPrintProc( Tcl_FreeProc **freeProcPtr) /* not used */ { double *doublePtr = (double *) (widgRec + offset); - char *p = (char *) ckalloc(24); + char *p = ckalloc(24); Tcl_PrintDouble(NULL, *doublePtr, p); *freeProcPtr = TCL_DYNAMIC; @@ -637,8 +653,10 @@ Tk_GetScrollInfo( if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) { if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " moveto fraction\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s %s\"", + argv[0], argv[1], "moveto fraction")); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) { @@ -648,8 +666,10 @@ Tk_GetScrollInfo( } else if ((c == 's') && (strncmp(argv[2], "scroll", length) == 0)) { if (argc != 5) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " scroll number units|pages\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s %s\"", + argv[0], argv[1], "scroll number units|pages")); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) { @@ -663,12 +683,15 @@ Tk_GetScrollInfo( return TK_SCROLL_UNITS; } - Tcl_AppendResult(interp, "bad argument \"", argv[4], - "\": must be units or pages", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be units or pages", argv[4])); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } - Tcl_AppendResult(interp, "unknown option \"", argv[2], - "\": must be moveto or scroll", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be moveto or scroll", argv[2])); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", argv[2], + NULL); return TK_SCROLL_ERROR; } @@ -706,12 +729,11 @@ Tk_GetScrollInfoObj( int *intPtr) /* Filled in with number of pages or lines to * scroll, if any. */ { - int length; - const char *arg; - - arg = Tcl_GetStringFromObj(objv[2], &length); + const char *arg = Tcl_GetString(objv[2]); + size_t length = objv[2]->length; -#define ArgPfxEq(str) ((arg[0]==str[0])&&!strncmp(arg,str,(unsigned)length)) +#define ArgPfxEq(str) \ + ((arg[0] == str[0]) && !strncmp(arg, str, (unsigned)length)) if (ArgPfxEq("moveto")) { if (objc != 4) { @@ -731,19 +753,22 @@ Tk_GetScrollInfoObj( return TK_SCROLL_ERROR; } - arg = Tcl_GetStringFromObj(objv[4], &length); + arg = Tcl_GetString(objv[4]); + length = objv[4]->length; if (ArgPfxEq("pages")) { return TK_SCROLL_PAGES; } else if (ArgPfxEq("units")) { return TK_SCROLL_UNITS; } - Tcl_AppendResult(interp, "bad argument \"", arg, - "\": must be units or pages", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument \"%s\": must be units or pages", arg)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "SCROLL_UNITS", NULL); return TK_SCROLL_ERROR; } - Tcl_AppendResult(interp, "unknown option \"", arg, - "\": must be moveto or scroll", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be moveto or scroll", arg)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", arg, NULL); return TK_SCROLL_ERROR; } @@ -848,14 +873,14 @@ TkComputeAnchor( *--------------------------------------------------------------------------- */ -char * +const char * TkFindStateString( const TkStateMap *mapPtr, /* The state table. */ int numKey) /* The key to try to find in the table. */ { for (; mapPtr->strKey!=NULL ; mapPtr++) { if (numKey == mapPtr->numKey) { - return (char *) mapPtr->strKey; + return mapPtr->strKey; } } return NULL; @@ -907,14 +932,17 @@ TkFindStateNum( */ if (interp != NULL) { + Tcl_Obj *msgObj; + mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", option, " value \"", strKey, - "\": must be ", mPtr->strKey, NULL); + msgObj = Tcl_ObjPrintf("bad %s value \"%s\": must be %s", + option, strKey, mPtr->strKey); for (mPtr++; mPtr->strKey != NULL; mPtr++) { - Tcl_AppendResult(interp, - ((mPtr[1].strKey != NULL) ? ", " : ", or "), - mPtr->strKey, NULL); + Tcl_AppendPrintfToObj(msgObj, ",%s %s", + ((mPtr[1].strKey != NULL) ? "" : "or "), mPtr->strKey); } + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", option, strKey, NULL); } return mPtr->numKey; } @@ -943,12 +971,12 @@ TkFindStateNumObj( * Not there. Look in the state map. */ - key = Tcl_GetStringFromObj(keyPtr, NULL); + key = Tcl_GetString(keyPtr); for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) { if (strcmp(key, mPtr->strKey) == 0) { typePtr = keyPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { - (*typePtr->freeIntRepProc)(keyPtr); + typePtr->freeIntRepProc(keyPtr); } keyPtr->internalRep.twoPtrValue.ptr1 = (void *) mapPtr; keyPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(mPtr->numKey); @@ -963,19 +991,203 @@ TkFindStateNumObj( */ if (interp != NULL) { + Tcl_Obj *msgObj; + mPtr = mapPtr; - Tcl_AppendResult(interp, "bad ", Tcl_GetString(optionPtr), - " value \"", key, "\": must be ", mPtr->strKey, NULL); + msgObj = Tcl_ObjPrintf( + "bad %s value \"%s\": must be %s", + Tcl_GetString(optionPtr), key, mPtr->strKey); for (mPtr++; mPtr->strKey != NULL; mPtr++) { - Tcl_AppendResult(interp, - ((mPtr[1].strKey != NULL) ? ", " : ", or "), - mPtr->strKey, NULL); + Tcl_AppendPrintfToObj(msgObj, ",%s %s", + ((mPtr[1].strKey != NULL) ? "" : " or"), mPtr->strKey); } + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", Tcl_GetString(optionPtr), + key, NULL); } return mPtr->numKey; } /* + * ---------------------------------------------------------------------- + * + * 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_BackgroundException(interp, r); + } + + /* + * Restore the state of the interpreter. + */ + + (void) Tcl_RestoreInterpState(interp, state); + Tcl_Release(interp); + + return r; +} + +/* + *---------------------------------------------------------------------- + * + * TkMakeEnsemble -- + * + * Create an ensemble from a table of implementation commands. This may + * be called recursively to create sub-ensembles. + * + * Results: + * Handle for the ensemble, or NULL if creation of it fails. + * + *---------------------------------------------------------------------- + */ + +Tcl_Command +TkMakeEnsemble( + Tcl_Interp *interp, + const char *namespace, + const char *name, + ClientData clientData, + const TkEnsemble map[]) +{ + Tcl_Namespace *namespacePtr = NULL; + Tcl_Command ensemble = NULL; + Tcl_Obj *dictObj = NULL, *nameObj; + Tcl_DString ds; + int i; + + if (map == NULL) { + return NULL; + } + + Tcl_DStringInit(&ds); + + namespacePtr = Tcl_FindNamespace(interp, namespace, NULL, 0); + if (namespacePtr == NULL) { + namespacePtr = Tcl_CreateNamespace(interp, namespace, NULL, NULL); + if (namespacePtr == NULL) { + Tcl_Panic("failed to create namespace \"%s\"", namespace); + } + } + + nameObj = Tcl_NewStringObj(name, -1); + ensemble = Tcl_FindEnsemble(interp, nameObj, 0); + Tcl_DecrRefCount(nameObj); + if (ensemble == NULL) { + ensemble = Tcl_CreateEnsemble(interp, name, namespacePtr, + TCL_ENSEMBLE_PREFIX); + if (ensemble == NULL) { + Tcl_Panic("failed to create ensemble \"%s\"", name); + } + } + + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, namespace, -1); + if (!(strlen(namespace) == 2 && namespace[1] == ':')) { + Tcl_DStringAppend(&ds, "::", -1); + } + Tcl_DStringAppend(&ds, name, -1); + + dictObj = Tcl_NewObj(); + for (i = 0; map[i].name != NULL ; ++i) { + Tcl_Obj *nameObj, *fqdnObj; + + nameObj = Tcl_NewStringObj(map[i].name, -1); + fqdnObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_AppendStringsToObj(fqdnObj, "::", map[i].name, NULL); + Tcl_DictObjPut(NULL, dictObj, nameObj, fqdnObj); + if (map[i].proc) { + Tcl_CreateObjCommand(interp, Tcl_GetString(fqdnObj), + map[i].proc, clientData, NULL); + } else if (map[i].subensemble) { + TkMakeEnsemble(interp, Tcl_DStringValue(&ds), + map[i].name, clientData, map[i].subensemble); + } + } + + if (ensemble) { + Tcl_SetEnsembleMappingDict(interp, ensemble, dictObj); + } + + Tcl_DStringFree(&ds); + return ensemble; +} + +/* + *---------------------------------------------------------------------- + * + * TkSendVirtualEvent -- + * + * Send a virtual event notification to the specified target window. + * Equivalent to "event generate $target <<$eventName>>" + * + * Note that we use Tk_QueueWindowEvent, not Tk_HandleEvent, so this + * routine does not reenter the interpreter. + * + *---------------------------------------------------------------------- + */ + +void +TkSendVirtualEvent( + Tk_Window target, + const char *eventName) +{ + union {XEvent general; XVirtualEvent virtual;} event; + + memset(&event, 0, sizeof(event)); + event.general.xany.type = VirtualEvent; + event.general.xany.serial = NextRequest(Tk_Display(target)); + event.general.xany.send_event = False; + event.general.xany.window = Tk_WindowId(target); + event.general.xany.display = Tk_Display(target); + event.virtual.name = Tk_GetUid(eventName); + + Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL); +} +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tkVisual.c b/generic/tkVisual.c index ec8be11..8b0c155 100644 --- a/generic/tkVisual.c +++ b/generic/tkVisual.c @@ -20,12 +20,12 @@ */ typedef struct VisualDictionary { - char *name; /* Textual name of class. */ + const char *name; /* Textual name of class. */ int minLength; /* Minimum # characters that must be specified * for an unambiguous match. */ int class; /* X symbol for class. */ } VisualDictionary; -static VisualDictionary visualNames[] = { +static const VisualDictionary visualNames[] = { {"best", 1, 0}, {"directcolor", 2, DirectColor}, {"grayscale", 1, GrayScale}, @@ -86,7 +86,7 @@ Visual * Tk_GetVisual( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tk_Window tkwin, /* Window in which visual will be used. */ - CONST char *string, /* String describing visual. See manual entry + const char *string, /* String describing visual. See manual entry * for details. */ int *depthPtr, /* The depth of the returned visual is stored * here. */ @@ -101,8 +101,8 @@ Tk_GetVisual( Visual *visual; ptrdiff_t length; int c, numVisuals, prio, bestPrio, i; - CONST char *p; - VisualDictionary *dictPtr; + const char *p; + const VisualDictionary *dictPtr; TkColormap *cmapPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; @@ -173,9 +173,9 @@ Tk_GetVisual( */ if (Tcl_GetInt(interp, string, &visualId) == TCL_ERROR) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad X identifier for visual: \"", - string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad X identifier for visual: \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "VISUALID", NULL); return NULL; } template.visualid = visualId; @@ -202,12 +202,16 @@ Tk_GetVisual( } } if (template.class == -1) { - Tcl_AppendResult(interp, "unknown or ambiguous visual name \"", - string, "\": class must be ", NULL); + Tcl_Obj *msgObj = Tcl_ObjPrintf( + "unknown or ambiguous visual name \"%s\": class must be ", + string); + for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) { - Tcl_AppendResult(interp, dictPtr->name, ", ", NULL); + Tcl_AppendPrintfToObj(msgObj, "%s, ", dictPtr->name); } - Tcl_AppendResult(interp, "or default", NULL); + Tcl_AppendToObj(msgObj, "or default", -1); + Tcl_SetObjResult(interp, msgObj); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "VISUAL", string, NULL); return NULL; } while (isspace(UCHAR(*p))) { @@ -215,10 +219,8 @@ Tk_GetVisual( } if (*p == 0) { template.depth = 10000; - } else { - if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) { - return NULL; - } + } else if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) { + return NULL; } if (c == 'b') { mask = 0; @@ -237,8 +239,9 @@ Tk_GetVisual( visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template, &numVisuals); if (visInfoList == NULL) { - Tcl_SetResult(interp, "couldn't find an appropriate visual", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find an appropriate visual", -1)); + Tcl_SetErrorCode(interp, "TK", "VISUAL", "INAPPROPRIATE", NULL); return NULL; } @@ -301,6 +304,7 @@ Tk_GetVisual( bestPtr = &visInfoList[i]; bestPrio = prio; } + CLANG_ASSERT(bestPtr); *depthPtr = bestPtr->depth; visual = bestPtr->visual; XFree((char *) visInfoList); @@ -324,7 +328,7 @@ Tk_GetVisual( goto done; } } - cmapPtr = (TkColormap *) ckalloc(sizeof(TkColormap)); + cmapPtr = ckalloc(sizeof(TkColormap)); cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin), RootWindowOfScreen(Tk_Screen(tkwin)), visual, AllocNone); @@ -366,7 +370,7 @@ Colormap Tk_GetColormap( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tk_Window tkwin, /* Window where colormap will be used. */ - CONST char *string) /* String that identifies colormap: either + const char *string) /* String that identifies colormap: either * "new" or the name of another window. */ { Colormap colormap; @@ -379,7 +383,7 @@ Tk_GetColormap( */ if (strcmp(string, "new") == 0) { - cmapPtr = (TkColormap *) ckalloc(sizeof(TkColormap)); + cmapPtr = ckalloc(sizeof(TkColormap)); cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin), RootWindowOfScreen(Tk_Screen(tkwin)), Tk_Visual(tkwin), AllocNone); @@ -402,13 +406,15 @@ Tk_GetColormap( return None; } if (Tk_Screen(other) != Tk_Screen(tkwin)) { - Tcl_AppendResult(interp, "can't use colormap for ", string, - ": not on same screen", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use colormap for %s: not on same screen", string)); + Tcl_SetErrorCode(interp, "TK", "COLORMAP", "SCREEN", NULL); return None; } if (Tk_Visual(other) != Tk_Visual(tkwin)) { - Tcl_AppendResult(interp, "can't use colormap for ", string, - ": incompatible visuals", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use colormap for %s: incompatible visuals", string)); + Tcl_SetErrorCode(interp, "TK", "COLORMAP", "INCOMPATIBLE", NULL); return None; } colormap = Tk_Colormap(other); @@ -478,7 +484,7 @@ Tk_FreeColormap( } else { prevPtr->nextPtr = cmapPtr->nextPtr; } - ckfree((char *) cmapPtr); + ckfree(cmapPtr); } return; } diff --git a/generic/tkWindow.c b/generic/tkWindow.c index f2e98e8..b5cbbab 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -14,7 +14,7 @@ #include "tkInt.h" -#ifdef __WIN32__ +#ifdef _WIN32 #include "tkWinInt.h" #elif !defined(MAC_OSX_TK) #include "tkUnixInt.h" @@ -97,12 +97,14 @@ static const XSetWindowAttributes defAtts= { #define ISSAFE 1 #define PASSMAINWINDOW 2 -#define NOOBJPROC 4 -#define WINMACONLY 8 +#define WINMACONLY 4 +#define USEINITPROC 8 +typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData); typedef struct { - const char *name; /* Name of command. */ - Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based function. */ + const char *name; /* Name of command. */ + Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based + * function, or initProc. */ int flags; } TkCmd; @@ -125,10 +127,10 @@ static const TkCmd commands[] = { {"lower", Tk_LowerObjCmd, PASSMAINWINDOW|ISSAFE}, {"option", Tk_OptionObjCmd, PASSMAINWINDOW|ISSAFE}, {"pack", Tk_PackObjCmd, PASSMAINWINDOW|ISSAFE}, - {"place", Tk_PlaceObjCmd, ISSAFE}, + {"place", Tk_PlaceObjCmd, PASSMAINWINDOW|ISSAFE}, {"raise", Tk_RaiseObjCmd, PASSMAINWINDOW|ISSAFE}, {"selection", Tk_SelectionObjCmd, PASSMAINWINDOW}, - {"tk", Tk_TkObjCmd, PASSMAINWINDOW|ISSAFE}, + {"tk", (Tcl_ObjCmdProc *) TkInitTkCmd, USEINITPROC|PASSMAINWINDOW|ISSAFE}, {"tkwait", Tk_TkwaitObjCmd, PASSMAINWINDOW|ISSAFE}, {"update", Tk_UpdateObjCmd, PASSMAINWINDOW|ISSAFE}, {"winfo", Tk_WinfoObjCmd, PASSMAINWINDOW|ISSAFE}, @@ -146,12 +148,13 @@ static const TkCmd commands[] = { {"label", Tk_LabelObjCmd, ISSAFE}, {"labelframe", Tk_LabelframeObjCmd, ISSAFE}, {"listbox", Tk_ListboxObjCmd, ISSAFE}, + {"menu", Tk_MenuObjCmd, PASSMAINWINDOW}, {"menubutton", Tk_MenubuttonObjCmd, ISSAFE}, {"message", Tk_MessageObjCmd, ISSAFE}, {"panedwindow", Tk_PanedWindowObjCmd, ISSAFE}, {"radiobutton", Tk_RadiobuttonObjCmd, ISSAFE}, {"scale", Tk_ScaleObjCmd, ISSAFE}, - {"scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, NOOBJPROC|PASSMAINWINDOW|ISSAFE}, + {"scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE}, {"spinbox", Tk_SpinboxObjCmd, ISSAFE}, {"text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, {"toplevel", Tk_ToplevelObjCmd, 0}, @@ -173,7 +176,7 @@ static const TkCmd commands[] = { {"::tk::panedwindow",Tk_PanedWindowObjCmd, ISSAFE}, {"::tk::radiobutton",Tk_RadiobuttonObjCmd, ISSAFE}, {"::tk::scale", Tk_ScaleObjCmd, ISSAFE}, - {"::tk::scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, NOOBJPROC|PASSMAINWINDOW|ISSAFE}, + {"::tk::scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE}, {"::tk::spinbox", Tk_SpinboxObjCmd, ISSAFE}, {"::tk::text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, {"::tk::toplevel", Tk_ToplevelObjCmd, 0}, @@ -183,7 +186,7 @@ static const TkCmd commands[] = { * these commands differently (via the script library). */ -#if defined(__WIN32__) || defined(MAC_OSX_TK) +#if defined(_WIN32) || defined(MAC_OSX_TK) {"tk_chooseColor", Tk_ChooseColorObjCmd, PASSMAINWINDOW}, {"tk_chooseDirectory", Tk_ChooseDirectoryObjCmd,WINMACONLY|PASSMAINWINDOW}, {"tk_getOpenFile", Tk_GetOpenFileObjCmd, WINMACONLY|PASSMAINWINDOW}, @@ -195,7 +198,7 @@ static const TkCmd commands[] = { * Misc. */ -#if defined(MAC_OSX_TK) +#ifdef MAC_OSX_TK {"::tk::unsupported::MacWindowStyle", TkUnsupported1ObjCmd, PASSMAINWINDOW|ISSAFE}, #endif @@ -216,7 +219,7 @@ static char *use = NULL; static char *visual = NULL; static int rest = 0; -static Tk_ArgvInfo argTable[] = { +static const Tk_ArgvInfo argTable[] = { {"-colormap", TK_ARGV_STRING, NULL, (char *) &colormap, "Colormap for main window"}, {"-display", TK_ARGV_STRING, NULL, (char *) &display, @@ -241,14 +244,14 @@ static Tk_ArgvInfo argTable[] = { */ static Tk_Window CreateTopLevelWindow(Tcl_Interp *interp, - Tk_Window parent, CONST char *name, - CONST char *screenName, unsigned int flags); + Tk_Window parent, const char *name, + const char *screenName, unsigned int flags); static void DeleteWindowsExitProc(ClientData clientData); -static TkDisplay * GetScreen(Tcl_Interp *interp, CONST char *screenName, +static TkDisplay * GetScreen(Tcl_Interp *interp, const char *screenName, int *screenPtr); static int Initialize(Tcl_Interp *interp); static int NameWindow(Tcl_Interp *interp, TkWindow *winPtr, - TkWindow *parentPtr, CONST char *name); + TkWindow *parentPtr, const char *name); static void UnlinkWindow(TkWindow *winPtr); /* @@ -288,11 +291,12 @@ TkCloseDisplay( if (dispPtr->errorPtr != NULL) { TkErrorHandler *errorPtr; + for (errorPtr = dispPtr->errorPtr; errorPtr != NULL; errorPtr = dispPtr->errorPtr) { dispPtr->errorPtr = errorPtr->nextPtr; - ckfree((char *) errorPtr); + ckfree(errorPtr); } } @@ -307,7 +311,7 @@ TkCloseDisplay( Tcl_DeleteHashTable(&dispPtr->winTable); - ckfree((char *) dispPtr); + ckfree(dispPtr); /* * There is more to clean up, we leave it at this for the time being. @@ -341,9 +345,9 @@ CreateTopLevelWindow( Tk_Window parent, /* Token for logical parent of new window * (used for naming, options, etc.). May be * NULL. */ - CONST char *name, /* Name for new window; if parent is non-NULL, + const char *name, /* Name for new window; if parent is non-NULL, * must be unique among parent's children. */ - CONST char *screenName, /* Name of screen on which to create window. + const char *screenName, /* Name of screen on which to create window. * NULL means use DISPLAY environment variable * to determine. Empty string means use * parent's screen, or DISPLAY if no @@ -353,7 +357,7 @@ CreateTopLevelWindow( register TkWindow *winPtr; register TkDisplay *dispPtr; int screenId; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { @@ -371,6 +375,7 @@ CreateTopLevelWindow( */ Tk_CreatePhotoImageFormat(&tkImgFmtGIF); + Tk_CreatePhotoImageFormat(&tkImgFmtPNG); Tk_CreatePhotoImageFormat(&tkImgFmtPPM); } @@ -380,7 +385,7 @@ CreateTopLevelWindow( } else { dispPtr = GetScreen(interp, screenName, &screenId); if (dispPtr == NULL) { - return (Tk_Window) NULL; + return NULL; } } @@ -413,7 +418,7 @@ CreateTopLevelWindow( if (parent != NULL) { if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) { Tk_DestroyWindow((Tk_Window) winPtr); - return (Tk_Window) NULL; + return NULL; } } TkWmNewWindow(winPtr); @@ -445,15 +450,15 @@ CreateTopLevelWindow( static TkDisplay * GetScreen( Tcl_Interp *interp, /* Place to leave error message. */ - CONST char *screenName, /* Name for screen. NULL or empty means use + const char *screenName, /* Name for screen. NULL or empty means use * DISPLAY envariable. */ int *screenPtr) /* Where to store screen number. */ { register TkDisplay *dispPtr; - CONST char *p; + const char *p; int screenId; size_t length; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -464,9 +469,9 @@ GetScreen( screenName = TkGetDefaultScreenName(interp, screenName); if (screenName == NULL) { - Tcl_SetResult(interp, - "no display name and no $DISPLAY environment variable", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no display name and no $DISPLAY environment variable", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_DISPLAY", NULL); return NULL; } length = strlen(screenName); @@ -494,9 +499,9 @@ GetScreen( dispPtr = TkpOpenDisplay(screenName); if (dispPtr == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't connect to display \"", - screenName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't connect to display \"%s\"", screenName)); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECT", NULL); return NULL; } dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */ @@ -505,7 +510,7 @@ GetScreen( dispPtr->lastEventTime = CurrentTime; dispPtr->bindInfoStale = 1; dispPtr->cursorFont = None; - dispPtr->warpWindow = None; + dispPtr->warpWindow = NULL; dispPtr->multipleAtom = None; /* @@ -517,11 +522,9 @@ GetScreen( Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS); - dispPtr->name = (char *) ckalloc((unsigned) (length+1)); + dispPtr->name = ckalloc(length + 1); strncpy(dispPtr->name, screenName, length); dispPtr->name[length] = '\0'; - - TkInitXId(dispPtr); break; } if ((strncmp(dispPtr->name, screenName, length) == 0) @@ -530,10 +533,9 @@ GetScreen( } } if (screenId >= ScreenCount(dispPtr->display)) { - char buf[32 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad screen number \"%d\"", screenId); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen number \"%d\"", screenId)); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "SCREEN_NUMBER", NULL); return NULL; } *screenPtr = screenId; @@ -563,7 +565,7 @@ TkGetDisplay( Display *display) /* X's display pointer */ { TkDisplay *dispPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (dispPtr = tsdPtr->displayList; dispPtr != NULL; @@ -596,7 +598,7 @@ TkGetDisplay( TkDisplay * TkGetDisplayList(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); return tsdPtr->displayList; @@ -623,7 +625,7 @@ TkGetDisplayList(void) TkMainInfo * TkGetMainInfoList(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); return tsdPtr->mainWindowList; @@ -653,9 +655,8 @@ TkAllocWindow( * inherit visual information. NULL means use * screen defaults instead of inheriting. */ { - register TkWindow *winPtr; + register TkWindow *winPtr = ckalloc(sizeof(TkWindow)); - winPtr = (TkWindow *) ckalloc(sizeof(TkWindow)); winPtr->display = dispPtr->display; winPtr->dispPtr = dispPtr; winPtr->screenNum = screenNum; @@ -708,6 +709,7 @@ TkAllocWindow( winPtr->internalBorderBottom = 0; winPtr->minReqWidth = 0; winPtr->minReqHeight = 0; + winPtr->geometryMaster = NULL; return winPtr; } @@ -735,7 +737,7 @@ NameWindow( register TkWindow *winPtr, /* Window that is to be named and inserted. */ TkWindow *parentPtr, /* Pointer to logical parent for winPtr (used * for naming, options, etc.). */ - CONST char *name) /* Name for winPtr; must be unique among + const char *name) /* Name for winPtr; must be unique among * parentPtr's children. */ { #define FIXED_SIZE 200 @@ -773,24 +775,25 @@ NameWindow( } /* - * For non-anonymous windows, set up the window name. - */ - - winPtr->nameUid = Tk_GetUid(name); - - /* * Don't permit names that start with an upper-case letter: this will just * cause confusion with class names in the option database. */ if (isupper(UCHAR(name[0]))) { - Tcl_AppendResult(interp, - "window name starts with an upper-case letter: \"", - name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name starts with an upper-case letter: \"%s\"", + name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "NOTCLASS", NULL); return TCL_ERROR; } /* + * For non-anonymous windows, set up the window name. + */ + + winPtr->nameUid = Tk_GetUid(name); + + /* * To permit names of arbitrary length, must be prepared to malloc a * buffer to hold the new path name. To run fast in the common case where * names are short, use a fixed-size buffer on the stack. @@ -798,10 +801,10 @@ NameWindow( length1 = strlen(parentPtr->pathName); length2 = strlen(name); - if ((length1+length2+2) <= FIXED_SIZE) { + if ((length1 + length2 + 2) <= FIXED_SIZE) { pathName = staticSpace; } else { - pathName = (char *) ckalloc((unsigned) (length1+length2+2)); + pathName = ckalloc(length1 + length2 + 2); } if (length1 == 1) { pathName[0] = '.'; @@ -817,8 +820,9 @@ NameWindow( ckfree(pathName); } if (!isNew) { - Tcl_AppendResult(interp, "window name \"", name, - "\" already exists in parent", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name \"%s\" already exists in parent", name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "EXISTS", NULL); return TCL_ERROR; } Tcl_SetHashValue(hPtr, winPtr); @@ -852,10 +856,10 @@ NameWindow( Tk_Window TkCreateMainWindow( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ - CONST char *screenName, /* Name of screen on which to create window. + const char *screenName, /* Name of screen on which to create window. * Empty or NULL string means use DISPLAY * environment variable. */ - char *baseName) /* Base name for application; usually of the + const char *baseName) /* Base name for application; usually of the * form "prog instance". */ { Tk_Window tkwin; @@ -865,7 +869,7 @@ TkCreateMainWindow( register TkWindow *winPtr; register const TkCmd *cmdPtr; ClientData clientData; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -893,7 +897,7 @@ TkCreateMainWindow( */ winPtr = (TkWindow *) tkwin; - mainPtr = (TkMainInfo *) ckalloc(sizeof(TkMainInfo)); + mainPtr = ckalloc(sizeof(TkMainInfo)); mainPtr->winPtr = winPtr; mainPtr->refCount = 1; mainPtr->interp = interp; @@ -927,6 +931,7 @@ TkCreateMainWindow( hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy); Tcl_SetHashValue(hPtr, winPtr); winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr); + Tcl_InitHashTable(&mainPtr->busyTable, TCL_ONE_WORD_KEYS); /* * We have just created another Tk application; increment the refcount on @@ -950,39 +955,39 @@ TkCreateMainWindow( if (cmdPtr->objProc == NULL) { Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs"); } -#if defined(__WIN32__) && !defined(STATIC_BUILD) + +#if defined(_WIN32) && !defined(STATIC_BUILD) if ((cmdPtr->flags & WINMACONLY) && tclStubsPtr->reserved9) { - /* We are running on Cygwin, so don't use the win32 dialogs */ + /* + * We are running on Cygwin, so don't use the win32 dialogs. + */ + continue; } -#endif +#endif /* _WIN32 && !STATIC_BUILD */ + if (cmdPtr->flags & PASSMAINWINDOW) { - clientData = (ClientData) tkwin; + clientData = tkwin; } else { - clientData = (ClientData) NULL; + clientData = NULL; } - if (cmdPtr->flags & NOOBJPROC) { - Tcl_CreateCommand(interp, cmdPtr->name, - (Tcl_CmdProc *) cmdPtr->objProc, clientData, NULL); + if (cmdPtr->flags & USEINITPROC) { + ((TkInitProc *) cmdPtr->objProc)(interp, clientData); } else { Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc, clientData, NULL); } - if (isSafe) { - if (!(cmdPtr->flags & ISSAFE)) { - Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name); - } + if (isSafe && !(cmdPtr->flags & ISSAFE)) { + Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name); } } - TkCreateMenuCmd(interp); - /* * Set variables for the intepreter. */ - Tcl_SetVar(interp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tk_patchLevel", NULL, TK_PATCH_LEVEL, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tk_version", NULL, TK_VERSION, TCL_GLOBAL_ONLY); tsdPtr->numMainWindows++; return tkwin; @@ -1016,36 +1021,38 @@ Tk_CreateWindow( * the interp's result is assumed to be * initialized by the caller. */ Tk_Window parent, /* Token for parent of new window. */ - CONST char *name, /* Name for new window. Must be unique among + const char *name, /* Name for new window. Must be unique among * parent's children. */ - CONST char *screenName) /* If NULL, new window will be internal on + const char *screenName) /* If NULL, new window will be internal on * same screen as its parent. If non-NULL, * gives name of screen on which to create new * window; window will be a top-level * window. */ { TkWindow *parentPtr = (TkWindow *) parent; - TkWindow *winPtr; - - if ((parentPtr != NULL) && (parentPtr->flags & TK_ALREADY_DEAD)) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); - return NULL; - } else if ((parentPtr != NULL) && - (parentPtr->flags & TK_CONTAINER)) { - Tcl_AppendResult(interp, - "can't create window: its parent has -container = yes", NULL); - return NULL; - } - if (screenName == NULL) { - winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum, - parentPtr); - if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) { - Tk_DestroyWindow((Tk_Window) winPtr); + if (parentPtr) { + if (parentPtr->flags & TK_ALREADY_DEAD) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; + } else if (parentPtr->flags & TK_CONTAINER) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: its parent has -container = yes", + -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); + return NULL; + } else if (screenName == NULL) { + TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, + parentPtr->screenNum, parentPtr); + + if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) { + Tk_DestroyWindow((Tk_Window) winPtr); + return NULL; + } + return (Tk_Window) winPtr; } - return (Tk_Window) winPtr; } return CreateTopLevelWindow(interp, parent, name, screenName, /* flags */ 0); @@ -1080,39 +1087,41 @@ Tk_CreateAnonymousWindow( * the interp's result is assumed to be * initialized by the caller. */ Tk_Window parent, /* Token for parent of new window. */ - CONST char *screenName) /* If NULL, new window will be internal on + const char *screenName) /* If NULL, new window will be internal on * same screen as its parent. If non-NULL, * gives name of screen on which to create new * window; window will be a top-level * window. */ { TkWindow *parentPtr = (TkWindow *) parent; - TkWindow *winPtr; - if ((parentPtr != NULL) && (parentPtr->flags & TK_ALREADY_DEAD)) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); - return NULL; - } else if ((parentPtr != NULL) && - (parentPtr->flags & TK_CONTAINER)) { - Tcl_AppendResult(interp, - "can't create window: its parent has -container = yes", NULL); - return NULL; - } - if (screenName == NULL) { - winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum, - parentPtr); - /* - * Add the anonymous window flag now, so that NameWindow will behave - * correctly. - */ - - winPtr->flags |= TK_ANONYMOUS_WINDOW; - if (NameWindow(interp, winPtr, parentPtr, NULL) != TCL_OK) { - Tk_DestroyWindow((Tk_Window) winPtr); + if (parentPtr) { + if (parentPtr->flags & TK_ALREADY_DEAD) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; + } else if (parentPtr->flags & TK_CONTAINER) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: its parent has -container = yes", + -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); + return NULL; + } else if (screenName == NULL) { + TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, + parentPtr->screenNum, parentPtr); + /* + * Add the anonymous window flag now, so that NameWindow will + * behave correctly. + */ + + winPtr->flags |= TK_ANONYMOUS_WINDOW; + if (NameWindow(interp, winPtr, parentPtr, NULL) != TCL_OK) { + Tk_DestroyWindow((Tk_Window) winPtr); + return NULL; + } + return (Tk_Window) winPtr; } - return (Tk_Window) winPtr; } return CreateTopLevelWindow(interp, parent, NULL, screenName, TK_ANONYMOUS_WINDOW); @@ -1147,11 +1156,11 @@ Tk_CreateWindowFromPath( * initialized by the caller. */ Tk_Window tkwin, /* Token for any window in application that is * to contain new window. */ - CONST char *pathName, /* Path name for new window within the + const char *pathName, /* Path name for new window within the * application of tkwin. The parent of this * window must already exist, but the window * itself must not exist. */ - CONST char *screenName) /* If NULL, new window will be on same screen + const char *screenName) /* If NULL, new window will be on same screen * as its parent. If non-NULL, gives name of * screen on which to create new window; * window will be a top-level window. */ @@ -1172,13 +1181,14 @@ Tk_CreateWindowFromPath( p = strrchr(pathName, '.'); if (p == NULL) { - Tcl_AppendResult(interp, "bad window path name \"", pathName, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL); return NULL; } numChars = (int) (p-pathName); if (numChars > FIXED_SPACE) { - p = (char *) ckalloc((unsigned) (numChars+1)); + p = ckalloc(numChars + 1); } else { p = fixedSpace; } @@ -1202,13 +1212,14 @@ Tk_CreateWindowFromPath( return NULL; } if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) { - Tcl_AppendResult(interp, - "can't create window: parent has been destroyed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); return NULL; - } - if (((TkWindow *) parent)->flags & TK_CONTAINER) { - Tcl_AppendResult(interp, - "can't create window: its parent has -container = yes", NULL); + } else if (((TkWindow *) parent)->flags & TK_CONTAINER) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: its parent has -container = yes", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); return NULL; } @@ -1262,7 +1273,7 @@ Tk_DestroyWindow( TkDisplay *dispPtr = winPtr->dispPtr; XEvent event; TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->flags & TK_ALREADY_DEAD) { @@ -1285,7 +1296,7 @@ Tk_DestroyWindow( (tsdPtr->halfdeadWindowList->winPtr == winPtr)) { halfdeadPtr = tsdPtr->halfdeadWindowList; } else { - halfdeadPtr = (TkHalfdeadWindow *) ckalloc(sizeof(TkHalfdeadWindow)); + halfdeadPtr = ckalloc(sizeof(TkHalfdeadWindow)); halfdeadPtr->flags = 0; halfdeadPtr->winPtr = winPtr; halfdeadPtr->nextPtr = tsdPtr->halfdeadWindowList; @@ -1347,12 +1358,11 @@ Tk_DestroyWindow( if (!(halfdeadPtr->flags & HD_DESTROY_COUNT)) { halfdeadPtr->flags |= HD_DESTROY_COUNT; - dispPtr->destroyCount++; } while (winPtr->childList != NULL) { - TkWindow *childPtr; - childPtr = winPtr->childList; + TkWindow *childPtr = winPtr->childList; + childPtr->flags |= TK_DONT_DESTROY_WINDOW; Tk_DestroyWindow((Tk_Window) childPtr); if (winPtr->childList == childPtr) { @@ -1379,8 +1389,8 @@ Tk_DestroyWindow( * deleted, in which case TkpGetOtherWindow will return NULL. */ - TkWindow *childPtr; - childPtr = TkpGetOtherWindow(winPtr); + TkWindow *childPtr = TkpGetOtherWindow(winPtr); + if (childPtr != NULL) { childPtr->flags |= TK_DONT_DESTROY_WINDOW; Tk_DestroyWindow((Tk_Window) childPtr); @@ -1430,7 +1440,7 @@ Tk_DestroyWindow( } else { prev_halfdeadPtr->nextPtr = halfdeadPtr->nextPtr; } - ckfree((char *) halfdeadPtr); + ckfree(halfdeadPtr); break; } prev_halfdeadPtr = halfdeadPtr; @@ -1450,7 +1460,7 @@ Tk_DestroyWindow( TkWmRemoveFromColormapWindows(winPtr); } if (winPtr->window != None) { -#if defined(MAC_OSX_TK) || defined(__WIN32__) +#if defined(MAC_OSX_TK) || defined(_WIN32) XDestroyWindow(winPtr->display, winPtr->window); #else if ((winPtr->flags & TK_TOP_HIERARCHY) @@ -1462,19 +1472,15 @@ Tk_DestroyWindow( * to do an explicit destroy of this X window. */ - dispPtr->lastDestroyRequest = NextRequest(winPtr->display); XDestroyWindow(winPtr->display, winPtr->window); } #endif - TkFreeWindowId(dispPtr, winPtr->window); Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->winTable, (char *) winPtr->window)); winPtr->window = None; } - dispPtr->destroyCount--; UnlinkWindow(winPtr); TkEventDeadWindow(winPtr); - TkBindDeadWindow(winPtr); #ifdef TK_USE_INPUT_METHODS if (winPtr->inputContext != NULL) { XDestroyIC(winPtr->inputContext); @@ -1487,10 +1493,14 @@ Tk_DestroyWindow( TkOptionDeadWindow(winPtr); TkSelDeadWindow(winPtr); TkGrabDeadWindow(winPtr); + if (winPtr->geometryMaster != NULL) { + ckfree(winPtr->geometryMaster); + winPtr->geometryMaster = NULL; + } if (winPtr->mainPtr != NULL) { if (winPtr->pathName != NULL) { Tk_DeleteAllBindings(winPtr->mainPtr->bindingTable, - (ClientData) winPtr->pathName); + winPtr->pathName); Tcl_DeleteHashEntry(Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, winPtr->pathName)); @@ -1525,18 +1535,19 @@ Tk_DestroyWindow( */ if ((winPtr->mainPtr->interp != NULL) && - (!Tcl_InterpDeleted(winPtr->mainPtr->interp))) { + !Tcl_InterpDeleted(winPtr->mainPtr->interp)) { for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { - Tcl_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name, - TkDeadAppCmd, NULL, NULL); + Tcl_CreateObjCommand(winPtr->mainPtr->interp, cmdPtr->name, + TkDeadAppObjCmd, NULL, NULL); } - Tcl_CreateCommand(winPtr->mainPtr->interp, "send", - TkDeadAppCmd, NULL, NULL); + Tcl_CreateObjCommand(winPtr->mainPtr->interp, "send", + TkDeadAppObjCmd, NULL, NULL); Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif"); - Tcl_UnlinkVar(winPtr->mainPtr->interp, + Tcl_UnlinkVar(winPtr->mainPtr->interp, "::tk::AlwaysShowSelection"); } + Tcl_DeleteHashTable(&winPtr->mainPtr->busyTable); Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable); TkBindFree(winPtr->mainPtr); TkDeleteAllImages(winPtr->mainPtr); @@ -1554,14 +1565,14 @@ Tk_DestroyWindow( if (winPtr->flags & TK_EMBEDDED) { XSync(winPtr->display, False); } - ckfree((char *) winPtr->mainPtr); + ckfree(winPtr->mainPtr); /* * If no other applications are using the display, close the * display now and relinquish its data structures. */ -#if !defined(WIN32) && defined(NOT_YET) +#if !defined(_WIN32) && defined(NOT_YET) if (dispPtr->refCount <= 0) { /* * I have disabled this code because on Windows there are @@ -1609,10 +1620,10 @@ Tk_DestroyWindow( TkCloseDisplay(dispPtr); } -#endif +#endif /* !_WIN32 && NOT_YET */ } } - Tcl_EventuallyFree((ClientData) winPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(winPtr, TCL_DYNAMIC); } /* @@ -1719,7 +1730,7 @@ Tk_MakeWindowExist( createProc = Tk_GetClassProc(winPtr->classProcsPtr, createProc); if (createProc != NULL && parent != None) { - winPtr->window = (*createProc)(tkwin, parent, winPtr->instanceData); + winPtr->window = createProc(tkwin, parent, winPtr->instanceData); } else { winPtr->window = TkpMakeWindow(winPtr, parent); } @@ -1747,6 +1758,7 @@ Tk_MakeWindowExist( if ((winPtr2->window != None) && !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) { XWindowChanges changes; + changes.sibling = winPtr2->window; changes.stack_mode = Below; XConfigureWindow(winPtr->display, winPtr->window, @@ -1860,7 +1872,7 @@ Tk_ConfigureWindow( winPtr->changes.border_width = valuePtr->border_width; } if (valueMask & (CWSibling|CWStackMode)) { - Tcl_Panic("Can't set sibling or stack mode from Tk_ConfigureWindow."); + Tcl_Panic("Can't set sibling or stack mode from Tk_ConfigureWindow"); } if (winPtr->window != None) { @@ -2247,7 +2259,7 @@ TkDoConfigureNotify( void Tk_SetClass( Tk_Window tkwin, /* Token for window to assign class. */ - CONST char *className) /* New class for tkwin. */ + const char *className) /* New class for tkwin. */ { register TkWindow *winPtr = (TkWindow *) tkwin; @@ -2279,7 +2291,7 @@ Tk_SetClass( void Tk_SetClassProcs( Tk_Window tkwin, /* Token for window to modify. */ - Tk_ClassProcs *procs, /* Class procs structure. */ + const Tk_ClassProcs *procs, /* Class procs structure. */ ClientData instanceData) /* Data to be passed to class functions. */ { register TkWindow *winPtr = (TkWindow *) tkwin; @@ -2311,7 +2323,7 @@ Tk_SetClassProcs( Tk_Window Tk_NameToWindow( Tcl_Interp *interp, /* Where to report errors. */ - CONST char *pathName, /* Path name of window. */ + const char *pathName, /* Path name of window. */ Tk_Window tkwin) /* Token for window: name is assumed to belong * to the same main window as tkwin. */ { @@ -2324,7 +2336,8 @@ Tk_NameToWindow( */ if (interp != NULL) { - Tcl_AppendResult(interp, "NULL main window", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window",-1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); } return NULL; } @@ -2333,12 +2346,14 @@ Tk_NameToWindow( pathName); if (hPtr == NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "bad window path name \"", - pathName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", pathName, + NULL); } return NULL; } - return (Tk_Window) Tcl_GetHashValue(hPtr); + return Tcl_GetHashValue(hPtr); } /* @@ -2381,7 +2396,7 @@ Tk_IdToWindow( if (hPtr == NULL) { return NULL; } - return (Tk_Window) Tcl_GetHashValue(hPtr); + return Tcl_GetHashValue(hPtr); } /* @@ -2401,7 +2416,7 @@ Tk_IdToWindow( *---------------------------------------------------------------------- */ -CONST char * +const char * Tk_DisplayName( Tk_Window tkwin) /* Window whose display name is desired. */ { @@ -2428,8 +2443,8 @@ Tcl_Interp * Tk_Interp( Tk_Window tkwin) { - if (tkwin != NULL && ((TkWindow *)tkwin)->mainPtr != NULL) { - return ((TkWindow *)tkwin)->mainPtr->interp; + if (tkwin != NULL && ((TkWindow *) tkwin)->mainPtr != NULL) { + return ((TkWindow *) tkwin)->mainPtr->interp; } return NULL; } @@ -2587,9 +2602,8 @@ Tk_RestackWindow( if (winPtr->window != None) { XWindowChanges changes; - unsigned int mask; + unsigned int mask = CWStackMode; - mask = CWStackMode; changes.stack_mode = Above; for (otherPtr = winPtr->nextPtr; otherPtr != NULL; otherPtr = otherPtr->nextPtr) { @@ -2640,8 +2654,7 @@ Tk_MainWindow( return NULL; } #endif - tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL; mainPtr = mainPtr->nextPtr) { @@ -2649,7 +2662,9 @@ Tk_MainWindow( return (Tk_Window) mainPtr->winPtr; } } - Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this isn't a Tk application", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); return NULL; } @@ -2709,8 +2724,7 @@ Tk_GetNumMainWindows(void) } #endif - tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); return tsdPtr->numMainWindows; } @@ -2768,7 +2782,7 @@ DeleteWindowsExitProc( { TkDisplay *dispPtr, *nextPtr; Tcl_Interp *interp; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; + ThreadSpecificData *tsdPtr = clientData; if (tsdPtr == NULL) { return; @@ -2784,11 +2798,11 @@ DeleteWindowsExitProc( while (tsdPtr->halfdeadWindowList != NULL) { interp = tsdPtr->halfdeadWindowList->winPtr->mainPtr->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); tsdPtr->halfdeadWindowList->flags |= HD_CLEANUP; tsdPtr->halfdeadWindowList->winPtr->flags &= ~TK_ALREADY_DEAD; Tk_DestroyWindow((Tk_Window) tsdPtr->halfdeadWindowList->winPtr); - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } /* @@ -2797,9 +2811,9 @@ DeleteWindowsExitProc( while (tsdPtr->mainWindowList != NULL) { interp = tsdPtr->mainWindowList->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr); - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } /* @@ -2831,51 +2845,54 @@ DeleteWindowsExitProc( tsdPtr->initialized = 0; } -#if defined(__WIN32__) +#if defined(_WIN32) static HMODULE tkcygwindll = NULL; /* * Run Tk_MainEx from libtk8.?.dll * - * This function is only ever called from wish8.4.exe, the cygwin - * port of Tcl. This means that the system encoding is utf-8, - * so we don't have to do any encoding conversions. + * This function is only ever called from wish8.4.exe, the cygwin port of Tcl. + * This means that the system encoding is utf-8, so we don't have to do any + * encoding conversions. */ + int -TkCygwinMainEx(argc, argv, appInitProc, interp) - int argc; /* Number of arguments. */ - char **argv; /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc; /* Application-specific initialization - * procedure to call after most - * initialization but before starting - * to execute commands. */ - Tcl_Interp *interp; +TkCygwinMainEx( + int argc, /* Number of arguments. */ + char **argv, /* Array of argument strings. */ + Tcl_AppInitProc *appInitProc, + /* Application-specific initialization + * procedure to call after most initialization + * but before starting to execute commands. */ + Tcl_Interp *interp) { - char name[MAX_PATH]; + TCHAR name[MAX_PATH]; int len; - void (*sym)(int, char **, Tcl_AppInitProc *, Tcl_Interp *); + void (*tkmainex)(int, char **, Tcl_AppInitProc *, Tcl_Interp *); /* construct "<path>/libtk8.?.dll", from "<path>/tk8?.dll" */ - len = GetModuleFileName(Tk_GetHINSTANCE(), name, MAX_PATH); - name[len-2] = '.'; - name[len-1] = name[len-5]; - strcpy(name+len, ".dll"); - memcpy(name+len-8, "libtk8", 6); - - tkcygwindll = LoadLibrary(name); - if (!tkcygwindll) { - /* dll is not present */ - return 0; - } - sym = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_MainEx"); - if (!sym) { - return 0; - } - sym(argc, argv, appInitProc, interp); + len = GetModuleFileNameW(Tk_GetHINSTANCE(), name, MAX_PATH); + name[len-2] = TEXT('.'); + name[len-1] = name[len-5]; + _tcscpy(name+len, TEXT(".dll")); + memcpy(name+len-8, TEXT("libtk8"), 6 * sizeof(TCHAR)); + + tkcygwindll = LoadLibrary(name); + if (!tkcygwindll) { + /* dll is not present */ + return 0; + } + tkmainex = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) + GetProcAddress(tkcygwindll, "Tk_MainEx"); + if (!tkmainex) { + return 0; + } + tkmainex(argc, argv, appInitProc, interp); return 1; } -#endif +#endif /* _WIN32 */ + /* *---------------------------------------------------------------------- * @@ -2903,16 +2920,16 @@ int Tk_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { -#if defined(__WIN32__) +#if defined(_WIN32) if (tkcygwindll) { - int (*sym)(Tcl_Interp *); + int (*tkinit)(Tcl_Interp *); - sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_Init"); - if (sym) { - return sym(interp); + tkinit = (int(*)(Tcl_Interp *)) GetProcAddress(tkcygwindll,"Tk_Init"); + if (tkinit) { + return tkinit(interp); } } -#endif +#endif /* _WIN32 */ return Initialize(interp); } @@ -2976,27 +2993,29 @@ Tk_SafeInit( * checked at several places to differentiate the two initialisations. */ -#if defined(__WIN32__) +#if defined(_WIN32) if (tkcygwindll) { - int (*sym)(Tcl_Interp *); + int (*tksafeinit)(Tcl_Interp *); - sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_SafeInit"); - if (sym) { - return sym(interp); + tksafeinit = (int (*)(Tcl_Interp *)) + GetProcAddress(tkcygwindll, "Tk_SafeInit"); + if (tksafeinit) { + return tksafeinit(interp); } } -#endif +#endif /* _WIN32 */ return Initialize(interp); } -extern TkStubs tkStubs; +MODULE_SCOPE const TkStubs tkStubs; /* *---------------------------------------------------------------------- * * Initialize -- * - * ???TODO??? + * The core of the initialization code for Tk, called from Tk_Init and + * Tk_SafeInit. * * Results: * A standard Tcl result. Also leaves an error message in the interp's @@ -3014,9 +3033,9 @@ Initialize( { char *p; int argc, code; - CONST char **argv; - char *args[20]; - CONST char *argString = NULL; + const char **argv; + const char *args[20]; + const char *argString = NULL; Tcl_DString class; ThreadSpecificData *tsdPtr; @@ -3024,7 +3043,7 @@ Initialize( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { return TCL_ERROR; } @@ -3034,8 +3053,7 @@ Initialize( TkRegisterObjTypes(); - tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Start by initializing all the static variables to default acceptable @@ -3055,7 +3073,7 @@ Initialize( argv = NULL; /* - * We start by resetting the result because it might not be clean + * We start by resetting the result because it might not be clean. */ Tcl_ResetResult(interp); @@ -3080,7 +3098,9 @@ Initialize( while (1) { master = Tcl_GetMaster(master); if (master == NULL) { - Tcl_AppendResult(interp, "NULL master", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no controlling master interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "NO_MASTER", NULL); code = TCL_ERROR; goto done; } @@ -3096,7 +3116,9 @@ Initialize( code = Tcl_GetInterpPath(master, interp); if (code != TCL_OK) { - Tcl_AppendResult(interp, "error in Tcl_GetInterpPath", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error in Tcl_GetInterpPath", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } @@ -3106,14 +3128,14 @@ Initialize( Tcl_DStringInit(&ds); Tcl_DStringAppendElement(&ds, "::safe::TkInit"); - Tcl_DStringAppendElement(&ds, Tcl_GetStringResult(master)); + Tcl_DStringAppendElement(&ds, Tcl_GetString(Tcl_GetObjResult(master))); /* * Step 2 : Eval in the master. The argument is the *reversed* interp * path of the slave. */ - code = Tcl_Eval(master, Tcl_DStringValue(&ds)); + code = Tcl_EvalEx(master, Tcl_DStringValue(&ds), -1, 0); if (code != TCL_OK) { /* * We might want to transfer the error message or not. We don't. @@ -3121,8 +3143,9 @@ Initialize( */ Tcl_DStringFree(&ds); - Tcl_AppendResult(interp, - "not allowed to start Tk by master's safe::TkInit", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not allowed to start Tk by master's safe::TkInit", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL); goto done; } Tcl_DStringFree(&ds); @@ -3133,7 +3156,7 @@ Initialize( * changing the code below. */ - argString = Tcl_GetStringResult(master); + argString = Tcl_GetString(Tcl_GetObjResult(master)); } else { /* * If there is an "argv" variable, get its value, extract out relevant @@ -3231,7 +3254,7 @@ Initialize( visual = NULL; } args[argc] = NULL; - code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name); + code = TkCreateFrame(NULL, interp, argc, args, 1, name); Tcl_DStringFree(&class); if (code != TCL_OK) { @@ -3248,8 +3271,14 @@ Initialize( */ if (geometry != NULL) { - Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY); - code = Tcl_VarEval(interp, "wm geometry . ", geometry, NULL); + Tcl_DString buf; + + Tcl_SetVar2(interp, "geometry", NULL, geometry, TCL_GLOBAL_ONLY); + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, "wm geometry . ", -1); + Tcl_DStringAppend(&buf, geometry, -1); + code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); if (code != TCL_OK) { goto done; } @@ -3275,12 +3304,6 @@ Initialize( Tcl_SetMainLoop(Tk_MainLoop); -#ifndef _WIN32 - /* On Windows, this has no added value. */ -# undef Tk_InitStubs - Tk_InitStubs(interp, TK_VERSION, 1); -#endif - /* * Initialized the themed widget set */ @@ -3298,7 +3321,7 @@ Initialize( Tcl_MutexUnlock(&windowMutex); if (argv != NULL) { - ckfree((char *) argv); + ckfree(argv); } code = TkpInit(interp); if (code == TCL_OK) { @@ -3313,7 +3336,7 @@ Initialize( * an alternate [tkInit] command before calling Tk_Init(). */ - code = Tcl_Eval(interp, + code = Tcl_EvalEx(interp, "if {[namespace which -command tkInit] eq \"\"} {\n\ proc tkInit {} {\n\ global tk_library tk_version tk_patchLevel\n\ @@ -3321,7 +3344,7 @@ Initialize( tcl_findLibrary tk $tk_version $tk_patchLevel tk.tcl TK_LIBRARY tk_library\n\ }\n\ }\n\ -tkInit"); +tkInit", -1, 0); } if (code == TCL_OK) { /* @@ -3330,14 +3353,14 @@ tkInit"); * specific cleanups take place to avoid panics in finalization. */ - TkCreateThreadExitHandler(DeleteWindowsExitProc, (ClientData) tsdPtr); + TkCreateThreadExitHandler(DeleteWindowsExitProc, tsdPtr); } return code; done: Tcl_MutexUnlock(&windowMutex); if (argv != NULL) { - ckfree((char *) argv); + ckfree(argv); } return code; } @@ -3361,16 +3384,16 @@ tkInit"); *---------------------------------------------------------------------- */ -CONST char * +const char * Tk_PkgInitStubsCheck( Tcl_Interp *interp, - CONST char * version, + const char * version, int exact) { - CONST char *actualVersion = Tcl_PkgRequire(interp, "Tk", version, 0); + const char *actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0, NULL); if (exact && actualVersion) { - CONST char *p = version; + const char *p = version; int count = 0; while (*p) { @@ -3379,15 +3402,16 @@ Tk_PkgInitStubsCheck( if (count == 1) { if (0 != strncmp(version, actualVersion, strlen(version))) { /* Construct error message */ - Tcl_PkgPresent(interp, "Tk", version, 1); + Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL); return NULL; } } else { - return Tcl_PkgPresent(interp, "Tk", version, 1); + return Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL); } } return actualVersion; } + /* * Local Variables: * mode: c diff --git a/generic/ttk/ttk.decls b/generic/ttk/ttk.decls index 8b2b50b..e668a2a 100644 --- a/generic/ttk/ttk.decls +++ b/generic/ttk/ttk.decls @@ -3,148 +3,148 @@ interface ttk epoch 0 scspec TTKAPI -declare 0 current { - Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name); +declare 0 { + Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name) } -declare 1 current { - Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp); +declare 1 { + Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp) } -declare 2 current { - Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp); +declare 2 { + Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp) } -declare 3 current { +declare 3 { Ttk_Theme Ttk_CreateTheme( - Tcl_Interp *interp, const char *name, Ttk_Theme parent); + Tcl_Interp *interp, const char *name, Ttk_Theme parent) } -declare 4 current { +declare 4 { void Ttk_RegisterCleanup( - Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc); + Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc) } -declare 5 current { +declare 5 { int Ttk_RegisterElementSpec( Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, - void *clientData); + void *clientData) } -declare 6 current { +declare 6 { Ttk_ElementClass *Ttk_RegisterElement( Tcl_Interp *interp, Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, - void *clientData); + void *clientData) } -declare 7 current { +declare 7 { int Ttk_RegisterElementFactory( Tcl_Interp *interp, const char *name, Ttk_ElementFactory factoryProc, - void *clientData); + void *clientData) } -declare 8 current { +declare 8 { void Ttk_RegisterLayout( - Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec); + Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec) } # # State maps. # -declare 10 current { +declare 10 { int Ttk_GetStateSpecFromObj( - Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn); + Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn) } -declare 11 current { +declare 11 { Tcl_Obj *Ttk_NewStateSpecObj( - unsigned int onbits, unsigned int offbits); + unsigned int onbits, unsigned int offbits) } -declare 12 current { +declare 12 { Ttk_StateMap Ttk_GetStateMapFromObj( - Tcl_Interp *interp, Tcl_Obj *objPtr); + Tcl_Interp *interp, Tcl_Obj *objPtr) } -declare 13 current { +declare 13 { Tcl_Obj *Ttk_StateMapLookup( - Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state); + Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state) } -declare 14 current { +declare 14 { int Ttk_StateTableLookup( - Ttk_StateTable map[], Ttk_State state); + Ttk_StateTable map[], Ttk_State state) } # # Low-level geometry utilities. # -declare 20 current { +declare 20 { int Ttk_GetPaddingFromObj( Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, - Ttk_Padding *pad_rtn); + Ttk_Padding *pad_rtn) } -declare 21 current { +declare 21 { int Ttk_GetBorderFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, - Ttk_Padding *pad_rtn); + Ttk_Padding *pad_rtn) } -declare 22 current { +declare 22 { int Ttk_GetStickyFromObj( - Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn); + Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn) } -declare 23 current { +declare 23 { Ttk_Padding Ttk_MakePadding( - short l, short t, short r, short b); + short l, short t, short r, short b) } -declare 24 current { +declare 24 { Ttk_Padding Ttk_UniformPadding( - short borderWidth); + short borderWidth) } -declare 25 current { - Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2); +declare 25 { + Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2) } -declare 26 current { +declare 26 { Ttk_Padding Ttk_RelievePadding( - Ttk_Padding padding, int relief, int n); + Ttk_Padding padding, int relief, int n) } -declare 27 current { - Ttk_Box Ttk_MakeBox(int x, int y, int width, int height); +declare 27 { + Ttk_Box Ttk_MakeBox(int x, int y, int width, int height) } -declare 28 current { - int Ttk_BoxContains(Ttk_Box box, int x, int y); +declare 28 { + int Ttk_BoxContains(Ttk_Box box, int x, int y) } -declare 29 current { - Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side); +declare 29 { + Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side) } -declare 30 current { - Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky); +declare 30 { + Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky) } -declare 31 current { - Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor); +declare 31 { + Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor) } -declare 32 current { - Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p); +declare 32 { + Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p) } -declare 33 current { - Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p); +declare 33 { + Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p) } -declare 34 current { +declare 34 { Ttk_Box Ttk_PlaceBox( - Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky); + Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky) } -declare 35 current { - Tcl_Obj *Ttk_NewBoxObj(Ttk_Box box); +declare 35 { + Tcl_Obj *Ttk_NewBoxObj(Ttk_Box box) } # # Utilities. # -declare 40 current { - int Ttk_GetOrientFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient); +declare 40 { + int Ttk_GetOrientFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient) } diff --git a/generic/ttk/ttkBlink.c b/generic/ttk/ttkBlink.c index 7e46fac..706a871 100644 --- a/generic/ttk/ttkBlink.c +++ b/generic/ttk/ttkBlink.c @@ -49,10 +49,10 @@ static void CursorManagerDeleteProc(ClientData clientData, Tcl_Interp *interp) static CursorManager *GetCursorManager(Tcl_Interp *interp) { static const char *cm_key = "ttk::CursorManager"; - CursorManager *cm = (CursorManager *) Tcl_GetAssocData(interp, cm_key,0); + CursorManager *cm = Tcl_GetAssocData(interp, cm_key,0); if (!cm) { - cm = (CursorManager*)ckalloc(sizeof(*cm)); + cm = ckalloc(sizeof(*cm)); cm->timer = 0; cm->owner = 0; cm->onTime = DEF_CURSOR_ON_TIME; diff --git a/generic/ttk/ttkCache.c b/generic/ttk/ttkCache.c index e3aeaba..0ae2372 100644 --- a/generic/ttk/ttkCache.c +++ b/generic/ttk/ttkCache.c @@ -49,7 +49,7 @@ struct Ttk_ResourceCache_ { */ Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *interp) { - Ttk_ResourceCache cache = (Ttk_ResourceCache)ckalloc(sizeof(*cache)); + Ttk_ResourceCache cache = ckalloc(sizeof(*cache)); cache->tkwin = NULL; /* initialized later */ cache->interp = interp; @@ -160,7 +160,7 @@ void Ttk_FreeResourceCache(Ttk_ResourceCache cache) } Tcl_DeleteHashTable(&cache->namedColors); - ckfree((ClientData)cache); + ckfree(cache); } /* @@ -270,7 +270,7 @@ static Tcl_Obj *Ttk_Use( } else { Tcl_DecrRefCount(cacheObj); Tcl_SetHashValue(entryPtr, NULL); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, TCL_ERROR); return NULL; } } @@ -341,7 +341,7 @@ Tk_Image Ttk_UseImage(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr) Tcl_SetHashValue(entryPtr, image); if (!image) { - Tcl_BackgroundError(cache->interp); + Tcl_BackgroundException(cache->interp, TCL_ERROR); } return image; diff --git a/generic/ttk/ttkClamTheme.c b/generic/ttk/ttkClamTheme.c index 572f630..15ebcb7 100644 --- a/generic/ttk/ttkClamTheme.c +++ b/generic/ttk/ttkClamTheme.c @@ -12,7 +12,7 @@ * off-by-one error in the end point. This is especially apparent with this * theme. Defining this macro as true handles this case. */ -#if defined(WIN32) && !defined(WIN32_XDRAWLINE_HACK) +#if defined(_WIN32) && !defined(WIN32_XDRAWLINE_HACK) # define WIN32_XDRAWLINE_HACK 1 #else # define WIN32_XDRAWLINE_HACK 0 diff --git a/generic/ttk/ttkDecls.h b/generic/ttk/ttkDecls.h index 8473d36..6701724 100644 --- a/generic/ttk/ttkDecls.h +++ b/generic/ttk/ttkDecls.h @@ -13,7 +13,7 @@ extern const char *TtkInitializeStubs( interp, TTK_VERSION, TTK_STUBS_EPOCH, TTK_STUBS_REVISION) #else -#define Ttk_InitStubs(interp) Tcl_PkgRequire(interp, "Ttk", TTK_VERSION, 0) +#define Ttk_InitStubs(interp) Tcl_PkgRequireEx(interp, "Ttk", TTK_VERSION, 0, NULL) #endif @@ -32,36 +32,36 @@ extern "C" { */ /* 0 */ -TTKAPI Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, CONST char *name); +TTKAPI Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name); /* 1 */ TTKAPI Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp); /* 2 */ TTKAPI Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp); /* 3 */ -TTKAPI Ttk_Theme Ttk_CreateTheme(Tcl_Interp *interp, CONST char *name, +TTKAPI Ttk_Theme Ttk_CreateTheme(Tcl_Interp *interp, const char *name, Ttk_Theme parent); /* 4 */ TTKAPI void Ttk_RegisterCleanup(Tcl_Interp *interp, - VOID *deleteData, + void *deleteData, Ttk_CleanupProc *cleanupProc); /* 5 */ TTKAPI int Ttk_RegisterElementSpec(Ttk_Theme theme, - CONST char *elementName, + const char *elementName, Ttk_ElementSpec *elementSpec, - VOID *clientData); + void *clientData); /* 6 */ TTKAPI Ttk_ElementClass * Ttk_RegisterElement(Tcl_Interp *interp, - Ttk_Theme theme, CONST char *elementName, + Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, - VOID *clientData); + void *clientData); /* 7 */ TTKAPI int Ttk_RegisterElementFactory(Tcl_Interp *interp, - CONST char *name, + const char *name, Ttk_ElementFactory factoryProc, - VOID *clientData); + void *clientData); /* 8 */ TTKAPI void Ttk_RegisterLayout(Ttk_Theme theme, - CONST char *className, + const char *className, Ttk_LayoutSpec layoutSpec); /* Slot 9 is reserved */ /* 10 */ @@ -137,17 +137,17 @@ typedef struct TtkStubs { int magic; int epoch; int revision; - const struct TtkStubHooks *hooks; + void *hooks; - Ttk_Theme (*ttk_GetTheme) (Tcl_Interp *interp, CONST char *name); /* 0 */ + Ttk_Theme (*ttk_GetTheme) (Tcl_Interp *interp, const char *name); /* 0 */ Ttk_Theme (*ttk_GetDefaultTheme) (Tcl_Interp *interp); /* 1 */ Ttk_Theme (*ttk_GetCurrentTheme) (Tcl_Interp *interp); /* 2 */ - Ttk_Theme (*ttk_CreateTheme) (Tcl_Interp *interp, CONST char *name, Ttk_Theme parent); /* 3 */ - void (*ttk_RegisterCleanup) (Tcl_Interp *interp, VOID *deleteData, Ttk_CleanupProc *cleanupProc); /* 4 */ - int (*ttk_RegisterElementSpec) (Ttk_Theme theme, CONST char *elementName, Ttk_ElementSpec *elementSpec, VOID *clientData); /* 5 */ - Ttk_ElementClass * (*ttk_RegisterElement) (Tcl_Interp *interp, Ttk_Theme theme, CONST char *elementName, Ttk_ElementSpec *elementSpec, VOID *clientData); /* 6 */ - int (*ttk_RegisterElementFactory) (Tcl_Interp *interp, CONST char *name, Ttk_ElementFactory factoryProc, VOID *clientData); /* 7 */ - void (*ttk_RegisterLayout) (Ttk_Theme theme, CONST char *className, Ttk_LayoutSpec layoutSpec); /* 8 */ + Ttk_Theme (*ttk_CreateTheme) (Tcl_Interp *interp, const char *name, Ttk_Theme parent); /* 3 */ + void (*ttk_RegisterCleanup) (Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc); /* 4 */ + int (*ttk_RegisterElementSpec) (Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, void *clientData); /* 5 */ + Ttk_ElementClass * (*ttk_RegisterElement) (Tcl_Interp *interp, Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, void *clientData); /* 6 */ + int (*ttk_RegisterElementFactory) (Tcl_Interp *interp, const char *name, Ttk_ElementFactory factoryProc, void *clientData); /* 7 */ + void (*ttk_RegisterLayout) (Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec); /* 8 */ void (*reserved9)(void); int (*ttk_GetStateSpecFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn); /* 10 */ Tcl_Obj * (*ttk_NewStateSpecObj) (unsigned int onbits, unsigned int offbits); /* 11 */ diff --git a/generic/ttk/ttkDefaultTheme.c b/generic/ttk/ttkDefaultTheme.c index d2deee8..81f8126 100644 --- a/generic/ttk/ttkDefaultTheme.c +++ b/generic/ttk/ttkDefaultTheme.c @@ -12,7 +12,7 @@ #include <X11/Xutil.h> #include "ttkTheme.h" -#if defined(WIN32) +#if defined(_WIN32) static const int WIN32_XDRAWLINE_HACK = 1; #else static const int WIN32_XDRAWLINE_HACK = 0; @@ -722,8 +722,8 @@ static void MenubuttonArrowElementDraw( int width = 0, height = 0; Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &size); - Tcl_GetIndexFromObj(NULL, arrow->directionObj, directionStrings, - ""/*message*/, 0/*flags*/, &postDirection); + Tcl_GetIndexFromObjStruct(NULL, arrow->directionObj, directionStrings, + sizeof(char *), ""/*message*/, 0/*flags*/, &postDirection); /* ... this might not be such a great idea ... */ switch (postDirection) { diff --git a/generic/ttk/ttkElements.c b/generic/ttk/ttkElements.c index 22af1d6..5c95dba 100644 --- a/generic/ttk/ttkElements.c +++ b/generic/ttk/ttkElements.c @@ -1145,7 +1145,7 @@ static void TabElementDraw( Tk_3DBorderGC(tkwin, border, TK_3D_FLAT_GC), pts, 6, Convex, CoordModeOrigin); -#ifndef WIN32 +#ifndef _WIN32 /* * Account for whether XDrawLines draws endpoints by platform */ @@ -1275,7 +1275,7 @@ void TtkElements_Init(Tcl_Interp *interp) /* * Register "default" as a user-loadable theme (for now): */ - Tcl_PkgProvide(interp, "ttk::theme::default", TTK_VERSION); + Tcl_PkgProvideEx(interp, "ttk::theme::default", TTK_VERSION, NULL); } /*EOF*/ diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index ae43ae6..f395649 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -652,7 +652,7 @@ static void EntryRevalidateBG(Entry *entryPtr, VREASON reason) { Tcl_Interp *interp = entryPtr->core.interp; if (EntryRevalidate(interp, entryPtr, reason) == TCL_ERROR) { - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, TCL_ERROR); } } @@ -758,8 +758,8 @@ static int EntrySetValue(Entry *entryPtr, const char *value) Tcl_GetString(entryPtr->entry.textVariableObj); if (textVarName && *textVarName) { entryPtr->core.flags |= SYNCING_VARIABLE; - value = Tcl_SetVar(entryPtr->core.interp, textVarName, - value, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + value = Tcl_SetVar2(entryPtr->core.interp, textVarName, + NULL, value, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); entryPtr->core.flags &= ~SYNCING_VARIABLE; if (!value || WidgetDestroyed(&entryPtr->core)) { return TCL_ERROR; @@ -786,7 +786,7 @@ static void EntryTextVariableTrace(void *recordPtr, const char *value) } if (entryPtr->core.flags & SYNCING_VARIABLE) { - /* Trace was fired due to Tcl_SetVar call in EntrySetValue. + /* Trace was fired due to Tcl_SetVar2 call in EntrySetValue. * Don't do anything. */ return; @@ -1179,13 +1179,13 @@ static void EntryDisplay(void *clientData, Drawable d) textarea = Ttk_ClientRegion(entryPtr->core.layout, "textarea"); showCursor = - (entryPtr->core.flags & CURSOR_ON) != 0 + (entryPtr->core.flags & CURSOR_ON) && EntryEditable(entryPtr) && entryPtr->entry.insertPos >= leftIndex && entryPtr->entry.insertPos <= rightIndex ; showSelection = - (entryPtr->core.state & TTK_STATE_DISABLED) == 0 + !(entryPtr->core.state & TTK_STATE_DISABLED) && selFirst > -1 && selLast > leftIndex && selFirst <= rightIndex @@ -1314,8 +1314,8 @@ EntryIndex( int *indexPtr) /* Return value */ { # define EntryWidth(e) (Tk_Width(entryPtr->core.tkwin)) /* Not Right */ - int length; - const char *string = Tcl_GetStringFromObj(indexObj, &length); + const char *string = Tcl_GetString(indexObj); + size_t length = indexObj->length; if (strncmp(string, "end", length) == 0) { *indexPtr = entryPtr->entry.numChars; @@ -1327,9 +1327,10 @@ EntryIndex( *indexPtr = entryPtr->entry.xscroll.last; } else if (strncmp(string, "sel.", 4) == 0) { if (entryPtr->entry.selectFirst < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "selection isn't in widget ", - Tk_PathName(entryPtr->core.tkwin), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "selection isn't in widget %s", + Tk_PathName(entryPtr->core.tkwin))); + Tcl_SetErrorCode(interp, "TTK", "ENTRY", "NO_SELECTION", NULL); return TCL_ERROR; } if (strncmp(string, "sel.first", length) == 0) { @@ -1381,8 +1382,9 @@ EntryIndex( return TCL_OK; badIndex: - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad entry index \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad entry index \"%s\"", string)); + Tcl_SetErrorCode(interp, "TTK", "ENTRY", "INDEX", NULL); return TCL_ERROR; } @@ -1457,7 +1459,7 @@ EntryGetCommand( Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - Tcl_SetResult(interp, entryPtr->entry.string, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->entry.string, -1)); return TCL_OK; } @@ -1795,9 +1797,9 @@ static int ComboboxCurrentCommand( return TCL_ERROR; } if (currentIndex < 0 || currentIndex >= nValues) { - Tcl_AppendResult(interp, - "Index ", Tcl_GetString(objv[2]), " out of range", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Index %s out of range", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TTK", "COMBOBOX", "IDX_RANGE", NULL); return TCL_ERROR; } diff --git a/generic/ttk/ttkFrame.c b/generic/ttk/ttkFrame.c index 7860024..3e50a7f 100644 --- a/generic/ttk/ttkFrame.c +++ b/generic/ttk/ttkFrame.c @@ -206,10 +206,9 @@ int TtkGetLabelAnchorFromObj( error: if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Bad label anchor specification ", Tcl_GetString(objPtr), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Bad label anchor specification %s", Tcl_GetString(objPtr))); + Tcl_SetErrorCode(interp, "TTK", "LABEL", "ANCHOR", NULL); } return TCL_ERROR; } diff --git a/generic/ttk/ttkGenStubs.tcl b/generic/ttk/ttkGenStubs.tcl index 3c8eb19..56ba2fa 100644 --- a/generic/ttk/ttkGenStubs.tcl +++ b/generic/ttk/ttkGenStubs.tcl @@ -5,26 +5,20 @@ # # # Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> +# # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SOURCE: tcl/tools/genStubs.tcl, revision 1.20 +# SOURCE: tcl/tools/genStubs.tcl, revision 1.44 # # CHANGES: -# + Remove xxx_TCL_DECLARED #ifdeffery -# + Use application-defined storage class specifier instead of "EXTERN" -# + Add "epoch" and "revision" fields to stubs table record -# + Remove dead code related to USE_*_STUB_PROCS (emitStubs, makeStub) # + Second argument to "declare" is used as a status guard # instead of a platform guard. -# + Use void (*reserved$i)(void) = 0 instead of void *reserved$i = NULL -# for unused stub entries, in case pointer-to-function and -# pointer-to-object are different sizes. # + Allow trailing semicolon in function declarations -# + stubs table is const-qualified # -package require Tcl 8 +package require Tcl 8.4 namespace eval genStubs { # libraryName -- @@ -50,9 +44,9 @@ namespace eval genStubs { # scspec -- # # Storage class specifier for external function declarations. - # Normally "extern", may be set to something like XYZAPI + # Normally "EXTERN", may be set to something like XYZAPI # - variable scspec "extern" + variable scspec "EXTERN" # epoch, revision -- # @@ -60,7 +54,7 @@ namespace eval genStubs { # (@@@TODO: should be an array mapping interface names -> numbers) # - variable epoch 0 + variable epoch {} variable revision 0 # hooks -- @@ -181,6 +175,9 @@ proc genStubs::hooks {names} { # decl The C function declaration, or {} for an undefined # entry. # +# Results: +# None. + proc genStubs::declare {args} { variable stubs variable curName @@ -203,7 +200,6 @@ proc genStubs::declare {args} { if {[info exists stubs($curName,decl,$index)]} { puts stderr "Duplicate entry: $index" } - regsub -all const $decl CONST decl regsub -all "\[ \t\n\]+" [string trim $decl] " " decl set decl [parseDecl $decl] @@ -290,22 +286,48 @@ proc genStubs::rewriteFile {file text} { # Results: # Returns the original text inside an appropriate #ifdef. -proc genStubs::addPlatformGuard {plat text} { +proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { + set text "" switch $plat { win { - return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n" + append text "#ifdef _WIN32 /* WIN */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* WIN */\n${eltxt}" + } + append text "#endif /* WIN */\n" } unix { - return "#if !defined(__WIN32__) /* UNIX */\n${text}#endif /* UNIX */\n" + append text "#if !defined(_WIN32) && !defined(MAC_OSX_TCL)\ + /* UNIX */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* UNIX */\n${eltxt}" + } + append text "#endif /* UNIX */\n" } macosx { - return "#ifdef MAC_OSX_TCL\n${text}#endif /* MAC_OSX_TCL */\n" + append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* MACOSX */\n${eltxt}" + } + append text "#endif /* MACOSX */\n" } aqua { - return "#ifdef MAC_OSX_TK\n${text}#endif /* MAC_OSX_TK */\n" + append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* AQUA */\n${eltxt}" + } + append text "#endif /* AQUA */\n" } x11 { - return "#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n" + append text "#if !(defined(_WIN32) || defined(MAC_OSX_TK))\ + /* X11 */\n${iftxt}" + if {$eltxt ne ""} { + append text "#else /* X11 */\n${eltxt}" + } + append text "#endif /* X11 */\n" + } + default { + append text "${iftxt}${eltxt}" } } return $text @@ -313,7 +335,9 @@ proc genStubs::addPlatformGuard {plat text} { # genStubs::emitSlots -- # -# Generate the stub table slots for the given interface. +# Generate the stub table slots for the given interface. If there +# are no generic slots, then one table is generated for each +# platform, otherwise one table is generated for all platforms. # # Arguments: # name The name of the interface being emitted. @@ -324,6 +348,7 @@ proc genStubs::addPlatformGuard {plat text} { proc genStubs::emitSlots {name textVar} { upvar $textVar text + forAllStubs $name makeSlot noGuard text {" void (*reserved$i)(void);\n"} return } @@ -352,7 +377,7 @@ proc genStubs::parseDecl {decl} { return } set rtype [string trim $rtype] - if {$args == ""} { + if {$args eq ""} { return [list $rtype $fname {}] } foreach arg [split $args ,] { @@ -400,14 +425,14 @@ proc genStubs::parseDecl {decl} { proc genStubs::parseArg {arg} { if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} { - if {$arg == "void"} { + if {$arg eq "void"} { return $arg } else { return } } set result [list [string trim $type] $name] - if {$array != ""} { + if {$array ne ""} { lappend result $array } return $result @@ -430,9 +455,6 @@ proc genStubs::makeDecl {name decl index} { lassign $decl rtype fname args append text "/* $index */\n" - if {$rtype != "void"} { - regsub -all void $rtype VOID rtype - } set line "$scspec $rtype" set count [expr {2 - ([string length $line] / 8)}] append line [string range "\t\t\t" 0 $count] @@ -441,7 +463,7 @@ proc genStubs::makeDecl {name decl index} { append line " " set pad 0 } - if {$args == ""} { + if {$args eq ""} { append line $fname append text $line append text ";\n" @@ -449,10 +471,9 @@ proc genStubs::makeDecl {name decl index} { } append line $fname - regsub -all void $args VOID args set arg1 [lindex $args 0] switch -exact $arg1 { - VOID { + void { append line "(void)" } TCL_VARARGS { @@ -520,7 +541,7 @@ proc genStubs::makeMacro {name decl index} { append lfname [string range $fname 1 end] set text "#define $fname \\\n\t(" - if {$args == ""} { + if {$args eq ""} { append text "*" } append text "${name}StubsPtr->$lfname)" @@ -547,19 +568,18 @@ proc genStubs::makeSlot {name decl index} { append lfname [string range $fname 1 end] set text " " - if {$rtype != "void"} { - regsub -all void $rtype VOID rtype - } - if {$args == ""} { + if {$args eq ""} { append text $rtype " *" $lfname "; /* $index */\n" return $text } - append text $rtype " (*" $lfname ") " - - regsub -all void $args VOID args + if {[string range $rtype end-8 end] eq "__stdcall"} { + append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " + } else { + append text $rtype " (*" $lfname ") " + } set arg1 [lindex $args 0] switch -exact $arg1 { - VOID { + void { append text "(void)" } TCL_VARARGS { @@ -605,7 +625,7 @@ proc genStubs::makeSlot {name decl index} { # Returns the formatted declaration string. proc genStubs::makeInit {name decl index} { - if {[lindex $decl 2] == ""} { + if {[lindex $decl 2] eq ""} { append text " &" [lindex $decl 1] ", /* " $index " */\n" } else { append text " " [lindex $decl 1] ", /* " $index " */\n" @@ -635,7 +655,7 @@ proc genStubs::makeInit {name decl index} { # None. proc genStubs::forAllStubs {name slotProc guardProc textVar - {skipString {"/* Slot $i is reserved */\n"}}} { + {skipString {"/* Slot $i is reserved */\n"}}} { variable stubs upvar $textVar text @@ -742,17 +762,19 @@ proc genStubs::emitHeader {name} { set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] - set CAPName [string toupper $name] - append text "\n" - append text "#define ${CAPName}_STUBS_EPOCH $epoch\n" - append text "#define ${CAPName}_STUBS_REVISION $revision\n" + if {$epoch ne ""} { + set CAPName [string toupper $name] + append text "\n" + append text "#define ${CAPName}_STUBS_EPOCH $epoch\n" + append text "#define ${CAPName}_STUBS_REVISION $revision\n" + } append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" emitDeclarations $name text if {[info exists hooks($name)]} { - append text "\ntypedef struct ${capName}StubHooks {\n" + append text "\ntypedef struct {\n" foreach hook $hooks($name) { set capHook [string toupper [string index $hook 0]] append capHook [string range $hook 1 end] @@ -762,9 +784,15 @@ proc genStubs::emitHeader {name} { } append text "\ntypedef struct ${capName}Stubs {\n" append text " int magic;\n" - append text " int epoch;\n" - append text " int revision;\n" - append text " const struct ${capName}StubHooks *hooks;\n\n" + if {$epoch ne ""} { + append text " int epoch;\n" + append text " int revision;\n" + } + if {[info exists hooks($name)]} { + append text " const ${capName}StubHooks *hooks;\n\n" + } else { + append text " void *hooks;\n\n" + } emitSlots $name text @@ -794,13 +822,11 @@ proc genStubs::emitInit {name textVar} { variable hooks variable interfaces variable epoch - variable revision upvar $textVar text - set root 1 + set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] - set CAPName [string toupper $name] if {[info exists hooks($name)]} { append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n" @@ -813,21 +839,23 @@ proc genStubs::emitInit {name textVar} { } foreach intf [array names interfaces] { if {[info exists hooks($intf)]} { - if {0<=[lsearch -exact $hooks($intf) $name]} { + if {[lsearch -exact $hooks($intf) $name] >= 0} { set root 0 - break; + break } } } - if {$root} { - append text "\nconst ${capName}Stubs ${name}Stubs = \{\n" - } else { - append text "\nstatic const ${capName}Stubs ${name}Stubs = \{\n" + append text "\n" + if {!$root} { + append text "static " + } + append text "const ${capName}Stubs ${name}Stubs = \{\n TCL_STUB_MAGIC,\n" + if {$epoch ne ""} { + set CAPName [string toupper $name] + append text " ${CAPName}_STUBS_EPOCH,\n" + append text " ${CAPName}_STUBS_REVISION,\n" } - append text " TCL_STUB_MAGIC,\n" - append text " ${CAPName}_STUBS_EPOCH,\n" - append text " ${CAPName}_STUBS_REVISION,\n" if {[info exists hooks($name)]} { append text " &${name}StubHooks,\n" } else { diff --git a/generic/ttk/ttkImage.c b/generic/ttk/ttkImage.c index 2b12864..a5a3a52 100644 --- a/generic/ttk/ttkImage.c +++ b/generic/ttk/ttkImage.c @@ -36,7 +36,7 @@ static void NullImageChanged(ClientData clientData, /* TtkGetImageSpec -- * Constructs a Ttk_ImageSpec * from a Tcl_Obj *. - * Result must be released using TtkFreeImageSpec. + * Result must be released using TtkFreeImageSpec. * * TODO: Need a variant of this that takes a user-specified ImageChanged proc */ @@ -47,7 +47,7 @@ TtkGetImageSpec(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr) int i = 0, n = 0, objc; Tcl_Obj **objv; - imageSpec = (Ttk_ImageSpec *)ckalloc(sizeof(*imageSpec)); + imageSpec = ckalloc(sizeof(*imageSpec)); imageSpec->baseImage = 0; imageSpec->mapCount = 0; imageSpec->states = 0; @@ -59,16 +59,17 @@ TtkGetImageSpec(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr) if ((objc % 2) != 1) { if (interp) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "image specification must contain an odd number of elements", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TTK", "IMAGE", "SPEC", NULL); } goto error; } n = (objc - 1) / 2; - imageSpec->states = (Ttk_StateSpec*)ckalloc(n * sizeof(Ttk_StateSpec)); - imageSpec->images = (Tk_Image*)ckalloc(n * sizeof(Tk_Image *)); + imageSpec->states = ckalloc(n * sizeof(Ttk_StateSpec)); + imageSpec->images = ckalloc(n * sizeof(Tk_Image *)); /* Get base image: */ @@ -117,10 +118,10 @@ void TtkFreeImageSpec(Ttk_ImageSpec *imageSpec) } if (imageSpec->baseImage) { Tk_FreeImage(imageSpec->baseImage); } - if (imageSpec->states) { ckfree((ClientData)imageSpec->states); } - if (imageSpec->images) { ckfree((ClientData)imageSpec->images); } + if (imageSpec->states) { ckfree(imageSpec->states); } + if (imageSpec->images) { ckfree(imageSpec->images); } - ckfree((ClientData)imageSpec); + ckfree(imageSpec); } /* TtkSelectImage -- @@ -324,7 +325,9 @@ Ttk_CreateImageElement( int i; if (objc <= 0) { - Tcl_AppendResult(interp, "Must supply a base image", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Must supply a base image", -1)); + Tcl_SetErrorCode(interp, "TTK", "IMAGE", "BASE", NULL); return TCL_ERROR; } @@ -333,7 +336,7 @@ Ttk_CreateImageElement( return TCL_ERROR; } - imageData = (ImageData*)ckalloc(sizeof(*imageData)); + imageData = ckalloc(sizeof(*imageData)); imageData->imageSpec = imageSpec; imageData->minWidth = imageData->minHeight = -1; imageData->sticky = TTK_FILL_BOTH; @@ -347,9 +350,9 @@ Ttk_CreateImageElement( int option; if (i == objc - 1) { - Tcl_AppendResult(interp, - "Value for ", Tcl_GetString(objv[i]), " missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Value for %s missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TTK", "IMAGE", "VALUE", NULL); goto error; } @@ -361,13 +364,17 @@ Ttk_CreateImageElement( } #endif - if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, - "option", 0, &option) != TCL_OK) { goto error; } + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, + sizeof(char *), "option", 0, &option) != TCL_OK) { + goto error; + } switch (option) { case O_BORDER: if (Ttk_GetBorderFromObj(interp, objv[i+1], &imageData->border) - != TCL_OK) { goto error; } + != TCL_OK) { + goto error; + } if (!padding_specified) { imageData->padding = imageData->border; } diff --git a/generic/ttk/ttkInit.c b/generic/ttk/ttkInit.c index 78676c6..dc6e994 100644 --- a/generic/ttk/ttkInit.c +++ b/generic/ttk/ttkInit.c @@ -21,8 +21,8 @@ int Ttk_GetButtonDefaultStateFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, int *statePtr) { *statePtr = TTK_BUTTON_DEFAULT_DISABLED; - return Tcl_GetIndexFromObj(interp, objPtr, - ttkDefaultStrings, "default state", 0, statePtr); + return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkDefaultStrings, + sizeof(char *), "default state", 0, statePtr); } /* @@ -38,8 +38,8 @@ int Ttk_GetCompoundFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, int *statePtr) { *statePtr = TTK_COMPOUND_NONE; - return Tcl_GetIndexFromObj(interp, objPtr, - ttkCompoundStrings, "compound layout", 0, statePtr); + return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkCompoundStrings, + sizeof(char *), "compound layout", 0, statePtr); } /* @@ -54,8 +54,8 @@ int Ttk_GetOrientFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr) { *resultPtr = TTK_ORIENT_HORIZONTAL; - return Tcl_GetIndexFromObj(interp, objPtr, - ttkOrientStrings, "orientation", 0, resultPtr); + return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkOrientStrings, + sizeof(char *), "orientation", 0, resultPtr); } /* @@ -65,18 +65,18 @@ int Ttk_GetOrientFromObj( static const char *ttkStateStrings[] = { "normal", "readonly", "disabled", "active", NULL }; -enum { +enum { TTK_COMPAT_STATE_NORMAL, TTK_COMPAT_STATE_READONLY, TTK_COMPAT_STATE_DISABLED, TTK_COMPAT_STATE_ACTIVE }; -/* TtkCheckStateOption -- +/* TtkCheckStateOption -- * Handle -state compatibility option. * - * NOTE: setting -state disabled / -state enabled affects the - * widget state, but the internal widget state does *not* affect + * NOTE: setting -state disabled / -state enabled affects the + * widget state, but the internal widget state does *not* affect * the value of the -state option. * This option is present for compatibility only. */ @@ -86,7 +86,8 @@ void TtkCheckStateOption(WidgetCore *corePtr, Tcl_Obj *objPtr) unsigned all = TTK_STATE_DISABLED|TTK_STATE_READONLY|TTK_STATE_ACTIVE; # define SETFLAGS(f) TtkWidgetChangeState(corePtr, f, all^f) - (void)Tcl_GetIndexFromObj(NULL,objPtr,ttkStateStrings,"",0,&stateOption); + (void)Tcl_GetIndexFromObjStruct(NULL, objPtr, ttkStateStrings, + sizeof(char *), "", 0, &stateOption); switch (stateOption) { case TTK_COMPAT_STATE_NORMAL: default: @@ -174,7 +175,7 @@ int TtkGetOptionValue( * type name dbName dbClass default objOffset intOffset flags clientData mask */ -/* public */ +/* public */ Tk_OptionSpec ttkCoreOptionSpecs[] = { {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", NULL, diff --git a/generic/ttk/ttkLayout.c b/generic/ttk/ttkLayout.c index 58c99eb..ba24589 100644 --- a/generic/ttk/ttkLayout.c +++ b/generic/ttk/ttkLayout.c @@ -326,8 +326,9 @@ int Ttk_GetPaddingFromObj( if (padc > 4) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Wrong #elements in padding spec", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Wrong #elements in padding spec", -1)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "PADDING", NULL); } goto error; } @@ -363,8 +364,9 @@ int Ttk_GetBorderFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Padding *pad) if (padc > 4) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Wrong #elements in border spec", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Wrong #elements in padding spec", -1)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "BORDER", NULL); } goto error; } @@ -476,11 +478,10 @@ int Ttk_GetStickyFromObj( case 's': case 'S': sticky |= TTK_STICK_S; break; default: if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Bad -sticky specification ", - Tcl_GetString(objPtr), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Bad -sticky specification %s", + Tcl_GetString(objPtr))); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "STICKY", NULL); } return TCL_ERROR; } @@ -524,7 +525,7 @@ struct Ttk_LayoutNode_ static Ttk_LayoutNode *Ttk_NewLayoutNode( unsigned flags, Ttk_ElementClass *elementClass) { - Ttk_LayoutNode *node = (Ttk_LayoutNode*)ckalloc(sizeof(*node)); + Ttk_LayoutNode *node = ckalloc(sizeof(*node)); node->flags = flags; node->eclass = elementClass; @@ -540,7 +541,7 @@ static void Ttk_FreeLayoutNode(Ttk_LayoutNode *node) while (node) { Ttk_LayoutNode *next = node->next; Ttk_FreeLayoutNode(node->child); - ckfree((ClientData)node); + ckfree(node); node = next; } } @@ -557,7 +558,7 @@ struct Ttk_TemplateNode_ { static Ttk_TemplateNode *Ttk_NewTemplateNode(const char *name, unsigned flags) { - Ttk_TemplateNode *op = (Ttk_TemplateNode*)ckalloc(sizeof(*op)); + Ttk_TemplateNode *op = ckalloc(sizeof(*op)); op->name = ckalloc(strlen(name) + 1); strcpy(op->name, name); op->flags = flags; op->next = op->child = 0; @@ -570,7 +571,7 @@ void Ttk_FreeLayoutTemplate(Ttk_LayoutTemplate op) Ttk_LayoutTemplate next = op->next; Ttk_FreeLayoutTemplate(op->child); ckfree(op->name); - ckfree((ClientData)op); + ckfree(op); op = next; } } @@ -635,25 +636,25 @@ Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(Tcl_Interp *interp, Tcl_Obj *objPtr) if (optName[0] != '-') break; - if (Tcl_GetIndexFromObj( - interp, objv[i], optStrings, "option", 0, &option) + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings, + sizeof(char *), "option", 0, &option) != TCL_OK) { goto error; } if (++i >= objc) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Missing value for option ",Tcl_GetString(objv[i-1]), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Missing value for option %s", + Tcl_GetString(objv[i-1]))); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "LAYOUT", NULL); goto error; } switch (option) { case OP_SIDE: /* <<NOTE-PACKSIDE>> */ - if (Tcl_GetIndexFromObj(interp, objv[i], packSideStrings, - "side", 0, &value) != TCL_OK) + if (Tcl_GetIndexFromObjStruct(interp, objv[i], packSideStrings, + sizeof(char *), "side", 0, &value) != TCL_OK) { goto error; } @@ -790,7 +791,7 @@ Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node) int side = 0; unsigned sideFlags = flags & _TTK_MASK_PACK; - while ((sideFlags & TTK_PACK_LEFT) == 0) { + while (!(sideFlags & TTK_PACK_LEFT)) { ++side; sideFlags >>= 1; } @@ -799,9 +800,11 @@ Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node) } } - /* In Ttk_ParseLayoutTemplate, default -sticky is "nsew", - * so always include this even if no sticky bits are set. + /* + * In Ttk_ParseLayoutTemplate, default -sticky is "nsew", so always + * include this even if no sticky bits are set. */ + APPENDSTR("-sticky"); APPENDOBJ(Ttk_NewStickyObj(flags & _TTK_MASK_STICK)); @@ -839,7 +842,7 @@ static Ttk_Layout TTKNewLayout( void *recordPtr,Tk_OptionTable optionTable, Tk_Window tkwin, Ttk_LayoutNode *root) { - Ttk_Layout layout = (Ttk_Layout)ckalloc(sizeof(*layout)); + Ttk_Layout layout = ckalloc(sizeof(*layout)); layout->style = style; layout->recordPtr = recordPtr; layout->optionTable = optionTable; @@ -851,7 +854,7 @@ static Ttk_Layout TTKNewLayout( void Ttk_FreeLayout(Ttk_Layout layout) { Ttk_FreeLayoutNode(layout->root); - ckfree((ClientData)layout); + ckfree(layout); } /* @@ -875,8 +878,9 @@ Ttk_Layout Ttk_CreateLayout( Ttk_LayoutNode *bgnode; if (!layoutTemplate) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Layout %s not found", styleName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL); return 0; } @@ -915,8 +919,9 @@ Ttk_CreateSublayout( layoutTemplate = Ttk_FindLayoutTemplate(themePtr, styleName); if (!layoutTemplate) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Layout %s not found", styleName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", styleName, NULL); return 0; } diff --git a/generic/ttk/ttkManager.c b/generic/ttk/ttkManager.c index 2fcb190..24a0fb1 100644 --- a/generic/ttk/ttkManager.c +++ b/generic/ttk/ttkManager.c @@ -188,7 +188,7 @@ static void SlaveEventHandler(ClientData clientData, XEvent *eventPtr) static Ttk_Slave *NewSlave( Ttk_Manager *mgr, Tk_Window slaveWindow, void *slaveData) { - Ttk_Slave *slave = (Ttk_Slave*)ckalloc(sizeof(*slave)); + Ttk_Slave *slave = ckalloc(sizeof(*slave)); slave->slaveWindow = slaveWindow; slave->manager = mgr; @@ -200,7 +200,7 @@ static Ttk_Slave *NewSlave( static void DeleteSlave(Ttk_Slave *slave) { - ckfree((ClientData)slave); + ckfree(slave); } /*------------------------------------------------------------------------ @@ -210,7 +210,7 @@ static void DeleteSlave(Ttk_Slave *slave) Ttk_Manager *Ttk_CreateManager( Ttk_ManagerSpec *managerSpec, void *managerData, Tk_Window masterWindow) { - Ttk_Manager *mgr = (Ttk_Manager*)ckalloc(sizeof(*mgr)); + Ttk_Manager *mgr = ckalloc(sizeof(*mgr)); mgr->managerSpec = managerSpec; mgr->managerData = managerData; @@ -234,12 +234,12 @@ void Ttk_DeleteManager(Ttk_Manager *mgr) Ttk_ForgetSlave(mgr, mgr->nSlaves - 1); } if (mgr->slaves) { - ckfree((ClientData)mgr->slaves); + ckfree(mgr->slaves); } Tcl_CancelIdleCall(ManagerIdleProc, mgr); - ckfree((ClientData)mgr); + ckfree(mgr); } /*------------------------------------------------------------------------ @@ -252,8 +252,7 @@ void Ttk_DeleteManager(Ttk_Manager *mgr) static void InsertSlave(Ttk_Manager *mgr, Ttk_Slave *slave, int index) { int endIndex = mgr->nSlaves++; - mgr->slaves = (Ttk_Slave**)ckrealloc( - (ClientData)mgr->slaves, mgr->nSlaves * sizeof(Ttk_Slave *)); + mgr->slaves = ckrealloc(mgr->slaves, mgr->nSlaves * sizeof(Ttk_Slave *)); while (endIndex > index) { mgr->slaves[endIndex] = mgr->slaves[endIndex - 1]; @@ -456,10 +455,9 @@ int Ttk_GetSlaveIndexFromObj( */ if (Tcl_GetIntFromObj(NULL, objPtr, &slaveIndex) == TCL_OK) { if (slaveIndex < 0 || slaveIndex >= mgr->nSlaves) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Slave index ", Tcl_GetString(objPtr), " out of bounds", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Slave index %d out of bounds", slaveIndex)); + Tcl_SetErrorCode(interp, "TTK", "SLAVE", "INDEX", NULL); return TCL_ERROR; } *indexPtr = slaveIndex; @@ -468,23 +466,23 @@ int Ttk_GetSlaveIndexFromObj( /* Try interpreting as a slave window name; */ - if ( (*string == '.') - && (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow))) - { + if ((*string == '.') && + (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow))) { slaveIndex = Ttk_SlaveIndex(mgr, tkwin); if (slaveIndex < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - string, " is not managed by ", Tk_PathName(mgr->masterWindow), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is not managed by %s", string, + Tk_PathName(mgr->masterWindow))); + Tcl_SetErrorCode(interp, "TTK", "SLAVE", "MANAGER", NULL); return TCL_ERROR; } *indexPtr = slaveIndex; return TCL_OK; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Invalid slave specification ", string, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid slave specification %s", string)); + Tcl_SetErrorCode(interp, "TTK", "SLAVE", "SPEC", NULL); return TCL_ERROR; } @@ -543,10 +541,9 @@ int Ttk_Maintainable(Tcl_Interp *interp, Tk_Window slave, Tk_Window master) return 1; badWindow: - Tcl_AppendResult(interp, - "can't add ", Tk_PathName(slave), - " as slave of ", Tk_PathName(master), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't add %s as slave of %s", + Tk_PathName(slave), Tk_PathName(master))); + Tcl_SetErrorCode(interp, "TTK", "GEOMETRY", "MAINTAINABLE", NULL); return 0; } diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c index 551f4a6..16a8bfe 100644 --- a/generic/ttk/ttkNotebook.c +++ b/generic/ttk/ttkNotebook.c @@ -727,9 +727,9 @@ static int AddTab( } #if 0 /* can't happen */ if (Ttk_SlaveIndex(nb->notebook.mgr, slaveWindow) >= 0) { - Tcl_AppendResult(interp, - Tk_PathName(slaveWindow), " already added", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s already added", + Tk_PathName(slaveWindow))); + Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "PRESENT", NULL); return TCL_ERROR; } #endif @@ -859,10 +859,9 @@ static int GetTabIndex( int status = FindTabIndex(interp, nb, objPtr, index_rtn); if (status == TCL_OK && *index_rtn < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "tab '", Tcl_GetString(objPtr), "' not found", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tab '%s' not found", Tcl_GetString(objPtr))); + Tcl_SetErrorCode(interp, "TTK", "NOTEBOOK", "TAB", NULL); status = TCL_ERROR; } return status; @@ -1059,9 +1058,8 @@ static int NotebookIdentifyCommand( if ( Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK || Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK - || (objc == 5 && - Tcl_GetIndexFromObj(interp, objv[2], whatTable, "option", 0, &what) - != TCL_OK) + || (objc == 5 && Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable, + sizeof(char *), "option", 0, &what) != TCL_OK) ) { return TCL_ERROR; } @@ -1082,7 +1080,8 @@ static int NotebookIdentifyCommand( case IDENTIFY_ELEMENT: if (element) { const char *elementName = Ttk_ElementName(element); - Tcl_SetObjResult(interp,Tcl_NewStringObj(elementName,-1)); + + Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1)); } break; case IDENTIFY_TAB: @@ -1173,10 +1172,10 @@ static int NotebookTabsCommand( result = Tcl_NewListObj(0, NULL); for (i = 0; i < Ttk_NumberSlaves(mgr); ++i) { const char *pathName = Tk_PathName(Ttk_SlaveWindow(mgr,i)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(pathName,-1)); + + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(pathName,-1)); } Tcl_SetObjResult(interp, result); - return TCL_OK; } diff --git a/generic/ttk/ttkPanedwindow.c b/generic/ttk/ttkPanedwindow.c index b301372..adc2aef 100644 --- a/generic/ttk/ttkPanedwindow.c +++ b/generic/ttk/ttkPanedwindow.c @@ -157,7 +157,9 @@ static int ConfigurePane( /* Sanity-check: */ if (pane->weight < 0) { - Tcl_AppendResult(interp, "-weight must be nonnegative", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-weight must be nonnegative", -1)); + Tcl_SetErrorCode(interp, "TTK", "PANE", "WEIGHT", NULL); goto error; } @@ -419,9 +421,9 @@ static int AddPane( return TCL_ERROR; } if (Ttk_SlaveIndex(pw->paned.mgr, slaveWindow) >= 0) { - Tcl_AppendResult(interp, - Tk_PathName(slaveWindow), " already added", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s already added", Tk_PathName(slaveWindow))); + Tcl_SetErrorCode(interp, "TTK", "PANE", "PRESENT", NULL); return TCL_ERROR; } @@ -729,9 +731,8 @@ static int PanedIdentifyCommand( if ( Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK || Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK - || (objc == 5 && - Tcl_GetIndexFromObj(interp, objv[2], whatTable, "option", 0, &what) - != TCL_OK) + || (objc == 5 && Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable, + sizeof(char *), "option", 0, &what) != TCL_OK) ) { return TCL_ERROR; } @@ -844,9 +845,9 @@ static int PanedSashposCommand( return TCL_ERROR; } if (sashIndex < 0 || sashIndex >= Ttk_NumberSlaves(pw->paned.mgr) - 1) { - Tcl_AppendResult(interp, - "sash index ", Tcl_GetString(objv[2]), " out of range", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "sash index %d out of range", sashIndex)); + Tcl_SetErrorCode(interp, "TTK", "PANE", "SASH_INDEX", NULL); return TCL_ERROR; } diff --git a/generic/ttk/ttkScroll.c b/generic/ttk/ttkScroll.c index fc305e9..2bd3ddb 100644 --- a/generic/ttk/ttkScroll.c +++ b/generic/ttk/ttkScroll.c @@ -7,7 +7,7 @@ * * Scrollable interface: * - * + 'first' is controlled by [xy]view widget command + * + 'first' is controlled by [xy]view widget command * and other scrolling commands like 'see'; * + 'total' depends on widget contents; * + 'last' depends on first, total, and widget size. @@ -16,15 +16,15 @@ * * 1. User adjusts scrollbar, scrollbar widget calls its -command * 2. Scrollbar -command invokes the scrollee [xy]view widget method - * 3. TtkScrollviewCommand calls TtkScrollTo(), which updates + * 3. TtkScrollviewCommand calls TtkScrollTo(), which updates * 'first' and schedules a redisplay. - * 4. Once the scrollee knows 'total' and 'last' (typically in - * the LayoutProc), call TtkScrolled(h,first,last,total) to + * 4. Once the scrollee knows 'total' and 'last' (typically in + * the LayoutProc), call TtkScrolled(h,first,last,total) to * synchronize the scrollbar. * 5. The scrollee -[xy]scrollcommand is called (in an idle callback) * 6. Which calls the scrollbar 'set' method and redisplays the scrollbar. * - * If the scrollee has internal scrolling (e.g., a 'see' method), + * If the scrollee has internal scrolling (e.g., a 'see' method), * it should TtkScrollTo() directly (step 2). * * If the widget value changes, it should call TtkScrolled() (step 4). @@ -55,7 +55,7 @@ struct ScrollHandleRec */ ScrollHandle TtkCreateScrollHandle(WidgetCore *corePtr, Scrollable *scrollPtr) { - ScrollHandle h = (ScrollHandle)ckalloc(sizeof(*h)); + ScrollHandle h = ckalloc(sizeof(*h)); h->flags = 0; h->corePtr = corePtr; @@ -130,7 +130,7 @@ static void UpdateScrollbarBG(ClientData clientData) Tcl_Preserve((ClientData) interp); code = UpdateScrollbar(interp, h); if (code == TCL_ERROR && !Tcl_InterpDeleted(interp)) { - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); } Tcl_Release((ClientData) interp); } @@ -141,7 +141,7 @@ static void UpdateScrollbarBG(ClientData clientData) void TtkScrolled(ScrollHandle h, int first, int last, int total) { Scrollable *s = h->scrollPtr; - + /* Sanity-check inputs: */ if (total <= 0) { @@ -253,6 +253,6 @@ void TtkFreeScrollHandle(ScrollHandle h) if (h->flags & SCROLL_UPDATE_PENDING) { Tcl_CancelIdleCall(UpdateScrollbarBG, (ClientData)h); } - ckfree((ClientData)h); + ckfree(h); } diff --git a/generic/ttk/ttkState.c b/generic/ttk/ttkState.c index a71ae21..c34b900 100644 --- a/generic/ttk/ttkState.c +++ b/generic/ttk/ttkState.c @@ -98,8 +98,9 @@ static int StateSpecSetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) if (stateNames[j] == 0) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Invalid state name ", stateName,NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid state name %s", stateName)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATE", NULL); } return TCL_ERROR; } @@ -216,8 +217,8 @@ Tcl_Obj *Ttk_StateMapLookup( return specs[j+1]; } if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "No match in state map", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("No match in state map", -1)); + Tcl_SetErrorCode(interp, "TTK", "STATE", "UNMATCHED", NULL); } return NULL; } @@ -240,10 +241,11 @@ Ttk_StateMap Ttk_GetStateMapFromObj( return NULL; if (nSpecs % 2 != 0) { - if (interp) - Tcl_SetResult(interp, - "State map must have an even number of elements", - TCL_STATIC); + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "State map must have an even number of elements", -1)); + Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATEMAP", NULL); + } return 0; } diff --git a/generic/ttk/ttkTagSet.c b/generic/ttk/ttkTagSet.c index 9f2a87b..f2108b9 100644 --- a/generic/ttk/ttkTagSet.c +++ b/generic/ttk/ttkTagSet.c @@ -34,7 +34,7 @@ struct TtkTagTable { */ static Ttk_Tag NewTag(Ttk_TagTable tagTable, const char *tagName) { - Ttk_Tag tag = (Ttk_Tag)ckalloc(sizeof(*tag)); + Ttk_Tag tag = ckalloc(sizeof(*tag)); tag->tagRecord = ckalloc(tagTable->recordSize); memset(tag->tagRecord, 0, tagTable->recordSize); /* Don't need Tk_InitOptions() here, all defaults should be NULL. */ @@ -47,7 +47,7 @@ static void DeleteTag(Ttk_TagTable tagTable, Ttk_Tag tag) { Tk_FreeConfigOptions(tag->tagRecord,tagTable->optionTable,tagTable->tkwin); ckfree(tag->tagRecord); - ckfree((void*)tag); + ckfree(tag); } /*------------------------------------------------------------------------ @@ -58,7 +58,7 @@ Ttk_TagTable Ttk_CreateTagTable( Tcl_Interp *interp, Tk_Window tkwin, Tk_OptionSpec optionSpecs[], int recordSize) { - Ttk_TagTable tagTable = (Ttk_TagTable)ckalloc(sizeof(*tagTable)); + Ttk_TagTable tagTable = ckalloc(sizeof(*tagTable)); tagTable->tkwin = tkwin; tagTable->optionSpecs = optionSpecs; tagTable->optionTable = Tk_CreateOptionTable(interp, optionSpecs); @@ -80,7 +80,7 @@ void Ttk_DeleteTagTable(Ttk_TagTable tagTable) } Tcl_DeleteHashTable(&tagTable->tags); - ckfree((void*)tagTable); + ckfree(tagTable); } Ttk_Tag Ttk_GetTag(Ttk_TagTable tagTable, const char *tagName) @@ -116,7 +116,7 @@ Ttk_Tag Ttk_GetTagFromObj(Ttk_TagTable tagTable, Tcl_Obj *objPtr) Ttk_TagSet Ttk_GetTagSetFromObj( Tcl_Interp *interp, Ttk_TagTable tagTable, Tcl_Obj *objPtr) { - Ttk_TagSet tagset = (Ttk_TagSet)(ckalloc(sizeof *tagset)); + Ttk_TagSet tagset = ckalloc(sizeof(*tagset)); Tcl_Obj **objv; int i, objc; @@ -127,11 +127,11 @@ Ttk_TagSet Ttk_GetTagSetFromObj( } if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { - ckfree((ClientData)tagset); + ckfree(tagset); return NULL; } - tagset->tags = (Ttk_Tag*)ckalloc((objc+1) * sizeof(Ttk_Tag)); + tagset->tags = ckalloc((objc+1) * sizeof(Ttk_Tag)); for (i=0; i<objc; ++i) { tagset->tags[i] = Ttk_GetTagFromObj(tagTable, objv[i]); } @@ -158,8 +158,8 @@ Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet tagset) void Ttk_FreeTagSet(Ttk_TagSet tagset) { - ckfree((ClientData)tagset->tags); - ckfree((ClientData)tagset); + ckfree(tagset->tags); + ckfree(tagset); } /* Ttk_TagSetContains -- test if tag set contains a tag. @@ -188,7 +188,7 @@ int Ttk_TagSetAdd(Ttk_TagSet tagset, Ttk_Tag tag) return 0; } } - tagset->tags = (void*)ckrealloc((void*)tagset->tags, + tagset->tags = ckrealloc(tagset->tags, (tagset->nTags+1)*sizeof(tagset->tags[0])); tagset->tags[tagset->nTags++] = tag; return 1; diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c index a2c51c0..2f95962 100644 --- a/generic/ttk/ttkTheme.c +++ b/generic/ttk/ttkTheme.c @@ -40,7 +40,7 @@ typedef struct Ttk_Style_ static Style *NewStyle() { - Style *stylePtr = (Style*)ckalloc(sizeof(Style)); + Style *stylePtr = ckalloc(sizeof(Style)); stylePtr->styleName = NULL; stylePtr->parentStyle = NULL; @@ -75,7 +75,7 @@ static void FreeStyle(Style *stylePtr) Ttk_FreeLayoutTemplate(stylePtr->layoutTemplate); - ckfree((ClientData)stylePtr); + ckfree(stylePtr); } /* @@ -179,7 +179,7 @@ static const Tk_OptionSpec *TTKGetOptionSpec( static OptionMap BuildOptionMap(Ttk_ElementClass *elementClass, Tk_OptionTable optionTable) { - OptionMap optionMap = (OptionMap)ckalloc( + OptionMap optionMap = ckalloc( sizeof(const Tk_OptionSpec) * elementClass->nResources + 1); int i; @@ -221,8 +221,7 @@ GetOptionMap(Ttk_ElementClass *elementClass, Tk_OptionTable optionTable) static Ttk_ElementClass * NewElementClass(const char *name, Ttk_ElementSpec *specPtr,void *clientData) { - Ttk_ElementClass *elementClass = - (Ttk_ElementClass*)ckalloc(sizeof(Ttk_ElementClass)); + Ttk_ElementClass *elementClass = ckalloc(sizeof(Ttk_ElementClass)); int i; elementClass->name = name; @@ -238,7 +237,7 @@ NewElementClass(const char *name, Ttk_ElementSpec *specPtr,void *clientData) /* Initialize default values: */ - elementClass->defaultValues = (Tcl_Obj**) + elementClass->defaultValues = ckalloc(elementClass->nResources * sizeof(Tcl_Obj *) + 1); for (i=0; i < elementClass->nResources; ++i) { const char *defaultValue = specPtr->options[i].defaultValue; @@ -275,7 +274,7 @@ static void FreeElementClass(Ttk_ElementClass *elementClass) Tcl_DecrRefCount(elementClass->defaultValues[i]); } } - ckfree((ClientData)elementClass->defaultValues); + ckfree(elementClass->defaultValues); /* * Free option map cache: @@ -288,7 +287,7 @@ static void FreeElementClass(Ttk_ElementClass *elementClass) Tcl_DeleteHashTable(&elementClass->optMapCache); ckfree(elementClass->elementRecord); - ckfree((ClientData)elementClass); + ckfree(elementClass); } /*------------------------------------------------------------------------ @@ -311,7 +310,7 @@ typedef struct Ttk_Theme_ static Theme *NewTheme(Ttk_ResourceCache cache, Ttk_Theme parent) { - Theme *themePtr = (Theme*)ckalloc(sizeof(Theme)); + Theme *themePtr = ckalloc(sizeof(Theme)); Tcl_HashEntry *entryPtr; int unused; @@ -365,7 +364,7 @@ static void FreeTheme(Theme *themePtr) /* * Free theme record: */ - ckfree((ClientData)themePtr); + ckfree(themePtr); return; } @@ -454,11 +453,11 @@ static void Ttk_StylePkgFree(ClientData clientData, Tcl_Interp *interp) while (cleanup) { Cleanup *next = cleanup->next; cleanup->cleanupProc(cleanup->clientData); - ckfree((ClientData)cleanup); + ckfree(cleanup); cleanup = next; } - ckfree((ClientData)pkgPtr); + ckfree(pkgPtr); } /* @@ -484,7 +483,7 @@ void Ttk_RegisterCleanup( Tcl_Interp *interp, ClientData clientData, Ttk_CleanupProc *cleanupProc) { StylePackageData *pkgPtr = GetStylePackageData(interp); - Cleanup *cleanup = (Cleanup*)ckalloc(sizeof(*cleanup)); + Cleanup *cleanup = ckalloc(sizeof(*cleanup)); cleanup->clientData = clientData; cleanup->cleanupProc = cleanupProc; @@ -509,8 +508,9 @@ static void ThemeChangedProc(ClientData clientData) static char ThemeChangedScript[] = "ttk::ThemeChanged"; StylePackageData *pkgPtr = clientData; - if (Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL) != TCL_OK) { - Tcl_BackgroundError(pkgPtr->interp); + int code = Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { + Tcl_BackgroundException(pkgPtr->interp, code); } pkgPtr->themeChangePending = 0; } @@ -549,8 +549,9 @@ Ttk_CreateTheme( entryPtr = Tcl_CreateHashEntry(&pkgPtr->themeTable, name, &newEntry); if (!newEntry) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Theme ", name, " already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Theme %s already exists", name)); + Tcl_SetErrorCode(interp, "TTK", "THEME", "EXISTS", NULL); return NULL; } @@ -592,8 +593,9 @@ static Ttk_Theme LookupTheme( entryPtr = Tcl_FindHashEntry(&pkgPtr->themeTable, name); if (!entryPtr) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "theme \"", name, "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "theme \"%s\" doesn't exist", name)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "THEME", name, NULL); return NULL; } @@ -800,7 +802,7 @@ int Ttk_RegisterElementFactory( Ttk_ElementFactory factory, void *clientData) { StylePackageData *pkgPtr = GetStylePackageData(interp); - FactoryRec *recPtr = (FactoryRec*)ckalloc(sizeof(*recPtr)); + FactoryRec *recPtr = ckalloc(sizeof(*recPtr)); Tcl_HashEntry *entryPtr; int newEntry; @@ -876,9 +878,10 @@ Ttk_ElementClass *Ttk_RegisterElement( if (specPtr->version != TK_STYLE_VERSION_2) { /* Version mismatch */ if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Internal error: Ttk_RegisterElement (", - name, "): invalid version", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Internal error: Ttk_RegisterElement (%s): invalid version", + name)); + Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "VERSION", NULL); } return 0; @@ -888,7 +891,9 @@ Ttk_ElementClass *Ttk_RegisterElement( if (!newEntry) { if (interp) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Duplicate element ", name, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Duplicate element %s", name)); + Tcl_SetErrorCode(interp, "TTK", "REGISTER_ELEMENT", "DUPE", NULL); } return 0; } @@ -1356,8 +1361,9 @@ static int StyleThemeCurrentCmd( } if (name == NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("error: failed to get theme name", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error: failed to get theme name", -1)); + Tcl_SetErrorCode(interp, "TTK", "THEME", "NAMELESS", NULL); return TCL_ERROR; } @@ -1388,8 +1394,8 @@ static int StyleThemeCreateCmd( for (i=4; i < objc; i +=2) { int option; - if (Tcl_GetIndexFromObj( - interp, objv[i], optStrings, "option", 0, &option) != TCL_OK) + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings, + sizeof(char *), "option", 0, &option) != TCL_OK) { return TCL_ERROR; } @@ -1492,7 +1498,10 @@ static int StyleElementCreateCmd( entryPtr = Tcl_FindHashEntry(&pkgPtr->factoryTable, factoryName); if (!entryPtr) { - Tcl_AppendResult(interp, "No such element type ", factoryName, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "No such element type %s", factoryName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT_TYPE", factoryName, + NULL); return TCL_ERROR; } @@ -1551,7 +1560,9 @@ static int StyleElementOptionsCmd( return TCL_OK; } - Tcl_AppendResult(interp, "element ", elementName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "element %s not found", elementName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT", elementName, NULL); return TCL_ERROR; } @@ -1575,7 +1586,10 @@ static int StyleLayoutCmd( if (objc == 3) { layoutTemplate = Ttk_FindLayoutTemplate(theme, layoutName); if (!layoutTemplate) { - Tcl_AppendResult(interp, "Layout ", layoutName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Layout %s not found", layoutName)); + Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "LAYOUT", layoutName, + NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Ttk_UnparseLayoutTemplate(layoutTemplate)); @@ -1660,7 +1674,7 @@ StyleObjCmd( return Ttk_InvokeEnsemble(StyleEnsemble, 1, clientData,interp,objc,objv); } -MODULE_SCOPE +MODULE_SCOPE int Ttk_InvokeEnsemble( /* Run an ensemble command */ const Ttk_Ensemble *ensemble, int cmdIndex, void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -1695,8 +1709,7 @@ void Ttk_StylePkgInit(Tcl_Interp *interp) { Tcl_Namespace *nsPtr; - StylePackageData *pkgPtr = (StylePackageData *) - ckalloc(sizeof(StylePackageData)); + StylePackageData *pkgPtr = ckalloc(sizeof(StylePackageData)); pkgPtr->interp = interp; Tcl_InitHashTable(&pkgPtr->themeTable, TCL_STRING_KEYS); diff --git a/generic/ttk/ttkTrace.c b/generic/ttk/ttkTrace.c index 8bc8519..ba66db4 100644 --- a/generic/ttk/ttkTrace.c +++ b/generic/ttk/ttkTrace.c @@ -54,7 +54,7 @@ VarTraceProc( ckfree((ClientData)tracePtr); return NULL; } - Tcl_TraceVar(interp, name, + Tcl_TraceVar2(interp, name, NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VarTraceProc, clientData); tracePtr->callback(tracePtr->clientData, NULL); @@ -85,7 +85,7 @@ Ttk_TraceHandle *Ttk_TraceVariable( Ttk_TraceProc callback, void *clientData) { - Ttk_TraceHandle *h = (Ttk_TraceHandle*)ckalloc(sizeof(*h)); + Ttk_TraceHandle *h = ckalloc(sizeof(*h)); int status; h->interp = interp; @@ -94,13 +94,13 @@ Ttk_TraceHandle *Ttk_TraceVariable( h->clientData = clientData; h->callback = callback; - status = Tcl_TraceVar(interp, Tcl_GetString(varnameObj), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + status = Tcl_TraceVar2(interp, Tcl_GetString(varnameObj), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VarTraceProc, (ClientData)h); if (status != TCL_OK) { Tcl_DecrRefCount(h->varnameObj); - ckfree((ClientData)h); + ckfree(h); return NULL; } @@ -150,11 +150,11 @@ void Ttk_UntraceVariable(Ttk_TraceHandle *h) h->interp = NULL; return; } - Tcl_UntraceVar(h->interp, Tcl_GetString(h->varnameObj), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + Tcl_UntraceVar2(h->interp, Tcl_GetString(h->varnameObj), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VarTraceProc, (ClientData)h); Tcl_DecrRefCount(h->varnameObj); - ckfree((ClientData)h); + ckfree(h); } } diff --git a/generic/ttk/ttkTrack.c b/generic/ttk/ttkTrack.c index 9cf8267..396b073 100644 --- a/generic/ttk/ttkTrack.c +++ b/generic/ttk/ttkTrack.c @@ -173,7 +173,7 @@ ElementStateEventProc(ClientData clientData, XEvent *ev) void TtkTrackElementState(WidgetCore *corePtr) { - ElementStateTracker *es = (ElementStateTracker*)ckalloc(sizeof(*es)); + ElementStateTracker *es = ckalloc(sizeof(*es)); es->corePtr = corePtr; es->tracking = 0; es->activeElement = es->pressedElement = 0; diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c index f0a3003..d957ad2 100644 --- a/generic/ttk/ttkTreeview.c +++ b/generic/ttk/ttkTreeview.c @@ -86,7 +86,7 @@ static Tk_OptionSpec ItemOptionSpecs[] = { */ static TreeItem *NewItem(void) { - TreeItem *item = (TreeItem*)ckalloc(sizeof(*item)); + TreeItem *item = ckalloc(sizeof(*item)); item->entryPtr = 0; item->parent = item->children = item->next = item->prev = NULL; @@ -118,7 +118,7 @@ static void FreeItem(TreeItem *item) if (item->tagset) { Ttk_FreeTagSet(item->tagset); } if (item->imagespec) { TtkFreeImageSpec(item->imagespec); } - ckfree((ClientData)item); + ckfree(item); } static void FreeItemCB(void *clientData) { FreeItem(clientData); } @@ -340,8 +340,8 @@ static int GetEnumSetFromObj( for (i = 0; i < objc; ++i) { int index; - if (TCL_OK != Tcl_GetIndexFromObj( - interp, objv[i], table, "value", TCL_EXACT, &index)) + if (TCL_OK != Tcl_GetIndexFromObjStruct(interp, objv[i], table, + sizeof(char *), "value", TCL_EXACT, &index)) { return TCL_ERROR; } @@ -534,21 +534,18 @@ static TreeColumn *GetColumn( */ if (Tcl_GetIntFromObj(NULL, columnIDObj, &columnIndex) == TCL_OK) { if (columnIndex < 0 || columnIndex >= tv->tree.nColumns) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Column index ", - Tcl_GetString(columnIDObj), - " out of bounds", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Column index %s out of bounds", + Tcl_GetString(columnIDObj))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLBOUND", NULL); return NULL; } return tv->tree.columns + columnIndex; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Invalid column index ", Tcl_GetString(columnIDObj), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid column index %s", Tcl_GetString(columnIDObj))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL); return NULL; } @@ -566,10 +563,9 @@ static TreeColumn *FindColumn( return tv->tree.displayColumns[colno]; } /* else */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Column ", Tcl_GetString(columnIDObj), " out of range", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Column %s out of range", Tcl_GetString(columnIDObj))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN", NULL); return NULL; } @@ -587,8 +583,9 @@ static TreeItem *FindItem( Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tv->tree.items, itemName); if (!entryPtr) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Item ", itemName, " not found", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Item %s not found", itemName)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM", NULL); return 0; } return Tcl_GetHashValue(entryPtr); @@ -612,11 +609,11 @@ static TreeItem **GetItemListFromObj( return NULL; } - items = (TreeItem**)ckalloc((nElements + 1)*sizeof(TreeItem*)); + items = ckalloc((nElements + 1)*sizeof(TreeItem*)); for (i = 0; i < nElements; ++i) { items[i] = FindItem(interp, tv, elements[i]); if (!items[i]) { - ckfree((ClientData)items); + ckfree(items); return NULL; } } @@ -658,7 +655,7 @@ static void TreeviewFreeColumns(Treeview *tv) if (tv->tree.columns) { for (i = 0; i < tv->tree.nColumns; ++i) FreeColumn(tv->tree.columns + i); - ckfree((ClientData)tv->tree.columns); + ckfree(tv->tree.columns); tv->tree.columns = 0; } } @@ -687,8 +684,7 @@ static int TreeviewInitColumns(Tcl_Interp *interp, Treeview *tv) * Initialize columns array and columnNames hash table: */ tv->tree.nColumns = ncols; - tv->tree.columns = - (TreeColumn*)ckalloc(tv->tree.nColumns * sizeof(TreeColumn)); + tv->tree.columns = ckalloc(tv->tree.nColumns * sizeof(TreeColumn)); for (i = 0; i < ncols; ++i) { int isNew; @@ -733,16 +729,16 @@ static int TreeviewInitDisplayColumns(Tcl_Interp *interp, Treeview *tv) if (!strcmp(Tcl_GetString(tv->tree.displayColumnsObj), "#all")) { ndcols = tv->tree.nColumns; - displayColumns = (TreeColumn**)ckalloc((ndcols+1)*sizeof(TreeColumn*)); + displayColumns = ckalloc((ndcols+1) * sizeof(TreeColumn*)); for (index = 0; index < ndcols; ++index) { displayColumns[index+1] = tv->tree.columns + index; } } else { - displayColumns = (TreeColumn**)ckalloc((ndcols+1)*sizeof(TreeColumn*)); + displayColumns = ckalloc((ndcols+1) * sizeof(TreeColumn*)); for (index = 0; index < ndcols; ++index) { displayColumns[index+1] = GetColumn(interp, tv, dcolumns[index]); if (!displayColumns[index+1]) { - ckfree((ClientData)displayColumns); + ckfree(displayColumns); return TCL_ERROR; } } @@ -750,7 +746,7 @@ static int TreeviewInitDisplayColumns(Tcl_Interp *interp, Treeview *tv) displayColumns[0] = &tv->tree.column0; if (tv->tree.displayColumns) - ckfree((ClientData)tv->tree.displayColumns); + ckfree(tv->tree.displayColumns); tv->tree.displayColumns = displayColumns; tv->tree.nDisplayColumns = ndcols + 1; @@ -1223,8 +1219,9 @@ static int ConfigureColumn( } if (mask & READONLY_OPTION) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Attempt to change read-only option", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Attempt to change read-only option", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "READONLY", NULL); goto error; } @@ -1913,11 +1910,10 @@ static int AncestryCheck( TreeItem *p = parent; while (p) { if (p == item) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "Cannot insert ", ItemName(tv, item), - " as a descendant of ", ItemName(tv, parent), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Cannot insert %s as descendant of %s", + ItemName(tv, item), ItemName(tv, parent))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ANCESTRY", NULL); return 0; } p = p->parent; @@ -1986,7 +1982,7 @@ static int TreeviewChildrenCommand( */ for (i=0; newChildren[i]; ++i) { if (!AncestryCheck(interp, tv, newChildren[i], item)) { - ckfree((ClientData)newChildren); + ckfree(newChildren); return TCL_ERROR; } } @@ -2022,7 +2018,7 @@ static int TreeviewChildrenCommand( child = newChildren[i]; } - ckfree((ClientData)newChildren); + ckfree(newChildren); TtkRedisplayWidget(&tv->core); } @@ -2291,8 +2287,8 @@ static int TreeviewIdentifyCommand( return TCL_ERROR; } - if ( Tcl_GetIndexFromObj(interp, objv[2], - submethodStrings, "command", TCL_EXACT, &submethod) != TCL_OK + if (Tcl_GetIndexFromObjStruct(interp, objv[2], submethodStrings, + sizeof(char *), "command", TCL_EXACT, &submethod) != TCL_OK || Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK || Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK ) { @@ -2319,9 +2315,7 @@ static int TreeviewIdentifyCommand( case I_COLUMN : if (colno >= 0) { - char dcolbuf[16]; - sprintf(dcolbuf, "#%d", colno); - Tcl_SetObjResult(interp, Tcl_NewStringObj(dcolbuf, -1)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%d", colno)); } break; @@ -2489,9 +2483,9 @@ static int TreeviewSetCommand( for (columnNumber=0; columnNumber<tv->tree.nColumns; ++columnNumber) { Tcl_ListObjIndex(interp, item->valuesObj, columnNumber, &value); if (value) { - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, tv->tree.columns[columnNumber].idObj); - Tcl_ListObjAppendElement(interp, result, value); + Tcl_ListObjAppendElement(NULL, result, value); } } Tcl_SetObjResult(interp, result); @@ -2505,7 +2499,9 @@ static int TreeviewSetCommand( if (column == &tv->tree.column0) { /* @@@ Maybe set -text here instead? */ - Tcl_AppendResult(interp, "Display column #0 cannot be set", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Display column #0 cannot be set", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_0", NULL); return TCL_ERROR; } @@ -2588,9 +2584,12 @@ static int TreeviewInsertCommand( objc -= 4; objv += 4; if (objc >= 2 && !strcmp("-id", Tcl_GetString(objv[0]))) { const char *itemName = Tcl_GetString(objv[1]); + entryPtr = Tcl_CreateHashEntry(&tv->tree.items, itemName, &isNew); if (!isNew) { - Tcl_AppendResult(interp, "Item ",itemName," already exists",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Item %s already exists", itemName)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ITEM_EXISTS", NULL); return TCL_ERROR; } objc -= 2; objv += 2; @@ -2647,8 +2646,10 @@ static int TreeviewDetachCommand( /* Sanity-check */ for (i = 0; items[i]; ++i) { if (items[i] == tv->tree.root) { - Tcl_AppendResult(interp, "Cannot detach root item", NULL); - ckfree((ClientData)items); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Cannot detach root item", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL); + ckfree(items); return TCL_ERROR; } } @@ -2658,7 +2659,7 @@ static int TreeviewDetachCommand( } TtkRedisplayWidget(&tv->core); - ckfree((ClientData)items); + ckfree(items); return TCL_OK; } @@ -2694,8 +2695,10 @@ static int TreeviewDeleteCommand( */ for (i=0; items[i]; ++i) { if (items[i] == tv->tree.root) { - ckfree((ClientData)items); - Tcl_AppendResult(interp, "Cannot delete root item", NULL); + ckfree(items); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Cannot delete root item", -1)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "ROOT", NULL); return TCL_ERROR; } } @@ -2719,7 +2722,7 @@ static int TreeviewDeleteCommand( delq = next; } - ckfree((ClientData)items); + ckfree(items); TtkRedisplayWidget(&tv->core); return TCL_OK; } @@ -2886,10 +2889,9 @@ static int TreeviewDragCommand( left = right; } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "column ", Tcl_GetString(objv[2]), " is not displayed", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "column %s is not displayed", Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TTK", "TREE", "COLUMN_INVISIBLE", NULL); return TCL_ERROR; } @@ -2953,9 +2955,8 @@ static int TreeviewSelectionCommand( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], selopStrings, - "selection operation", 0, &selop) != TCL_OK) - { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], selopStrings, + sizeof(char *), "selection operation", 0, &selop) != TCL_OK) { return TCL_ERROR; } @@ -2988,7 +2989,7 @@ static int TreeviewSelectionCommand( break; } - ckfree((ClientData)items); + ckfree(items); TtkSendVirtualEvent(tv->core.tkwin, "TreeviewSelect"); TtkRedisplayWidget(&tv->core); @@ -3041,10 +3042,10 @@ static int TreeviewTagBindCommand( */ if (mask & (~TreeviewBindEventMask)) { Tk_DeleteBinding(interp, bindingTable, tag, sequence); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unsupported event ", sequence, - "\nonly key, button, motion, and virtual events supported", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unsupported event %s\nonly key, button, motion, and" + " virtual events supported", sequence)); + Tcl_SetErrorCode(interp, "TTK", "TREE", "BIND_EVENTS", NULL); return TCL_ERROR; } } diff --git a/generic/ttk/ttkWidget.c b/generic/ttk/ttkWidget.c index d5e0484..c50efc5 100644 --- a/generic/ttk/ttkWidget.c +++ b/generic/ttk/ttkWidget.c @@ -198,7 +198,7 @@ WidgetInstanceObjCmdDeleted(ClientData clientData) * Final cleanup for widget; called via Tcl_EventuallyFree(). */ static void -FreeWidget(char *memPtr) +FreeWidget(void *memPtr) { ckfree(memPtr); } @@ -231,7 +231,7 @@ DestroyWidget(WidgetCore *corePtr) /* NB: this can reenter the interpreter via a command traces */ Tcl_DeleteCommandFromToken(corePtr->interp, cmd); } - Tcl_EventuallyFree(corePtr, FreeWidget); + Tcl_EventuallyFree(corePtr, (Tcl_FreeProc *) FreeWidget); } /* @@ -440,7 +440,8 @@ int TtkWidgetConstructorObjCmd( error: if (WidgetDestroyed(corePtr)) { - Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widget has been destroyed", -1)); } else { Tk_DestroyWindow(tkwin); } @@ -634,8 +635,8 @@ int TtkWidgetConfigureCommand( return status; if (mask & READONLY_OPTION) { - Tcl_SetResult(interp, - "Attempt to change read-only option", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to change read-only option", -1)); Tk_RestoreSavedOptions(&savedOptions); return TCL_ERROR; } @@ -649,7 +650,8 @@ int TtkWidgetConfigureCommand( status = corePtr->widgetSpec->postConfigureProc(interp,recordPtr,mask); if (WidgetDestroyed(corePtr)) { - Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widget has been destroyed", -1)); status = TCL_ERROR; } if (status != TCL_OK) { @@ -764,8 +766,8 @@ int TtkWidgetIdentifyCommand( } if (objc == 5) { /* $w identify element $x $y */ - if (Tcl_GetIndexFromObj(interp,objv[2],whatTable,"option",0,&what) - != TCL_OK) + if (Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable, + sizeof(char *), "option", 0, &what) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/ttk/ttkWidget.h b/generic/ttk/ttkWidget.h index 9e9ab69..e4dd712 100644 --- a/generic/ttk/ttkWidget.h +++ b/generic/ttk/ttkWidget.h @@ -260,7 +260,7 @@ MODULE_SCOPE int TtkGetLabelAnchorFromObj( * Platform-specific initialization. */ -#if defined(__WIN32__) +#ifdef _WIN32 #define Ttk_PlatformInit Ttk_WinPlatformInit MODULE_SCOPE int Ttk_PlatformInit(Tcl_Interp *); #elif defined(MAC_OSX_TK) diff --git a/library/bgerror.tcl b/library/bgerror.tcl index f46ab4c..b15387e 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -9,6 +9,7 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # Copyright (c) 2007 by ActiveState Software Inc. # Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> +# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> namespace eval ::tk::dialog::error { namespace import -force ::tk::msgcat::* @@ -26,13 +27,13 @@ namespace eval ::tk::dialog::error { } } -proc ::tk::dialog::error::Return {} { +proc ::tk::dialog::error::Return {which code} { variable button - .bgerrorDialog.ok configure -state active -relief sunken + .bgerrorDialog.$which state {active selected focus} update idletasks after 100 - set button 0 + set button $code } proc ::tk::dialog::error::Details {} { @@ -53,19 +54,19 @@ proc ::tk::dialog::error::SaveToLog {text} { } else { set allFiles * } - set types [list \ - [list [mc "Log Files"] .log] \ - [list [mc "Text Files"] .txt] \ + set types [list \ + [list [mc "Log Files"] .log] \ + [list [mc "Text Files"] .txt] \ [list [mc "All Files"] $allFiles] \ ] set filename [tk_getSaveFile -title [mc "Select Log File"] \ -filetypes $types -defaultextension .log -parent .bgerrorDialog] - if {![string length $filename]} { - return + if {$filename ne {}} { + set f [open $filename w] + puts -nonewline $f $text + close $f } - set f [open $filename w] - puts -nonewline $f $text - close $f + return } proc ::tk::dialog::error::Destroy {w} { @@ -75,16 +76,29 @@ proc ::tk::dialog::error::Destroy {w} { } } +proc ::tk::dialog::error::DeleteByProtocol {} { + variable button + set button 1 +} + +proc ::tk::dialog::error::ReturnInDetails w { + bind $w <Return> {}; # Remove this binding + $w invoke + return -code break +} + # ::tk::dialog::error::bgerror -- -# This is the default version of bgerror. -# It tries to execute tkerror, if that fails it posts a dialog box containing -# the error message and gives the user a chance to ask to see a stack -# trace. +# +# This is the default version of bgerror. +# It tries to execute tkerror, if that fails it posts a dialog box +# containing the error message and gives the user a chance to ask +# to see a stack trace. +# # Arguments: -# err - The error message. - +# err - The error message. +# proc ::tk::dialog::error::bgerror err { - global errorInfo tcl_platform + global errorInfo variable button set info $errorInfo @@ -130,12 +144,13 @@ proc ::tk::dialog::error::bgerror err { # and bottom parts. set dlg .bgerrorDialog + set bg [ttk::style lookup . -background] destroy $dlg - toplevel $dlg -class ErrorDialog + toplevel $dlg -class ErrorDialog -background $bg wm withdraw $dlg wm title $dlg $title wm iconname $dlg ErrorDialog - wm protocol $dlg WM_DELETE_WINDOW { } + wm protocol $dlg WM_DELETE_WINDOW [namespace code DeleteByProtocol] if {$windowingsystem eq "aqua"} { ::tk::unsupported::MacWindowStyle style $dlg moveableAlert {} @@ -143,23 +158,19 @@ proc ::tk::dialog::error::bgerror err { wm attributes $dlg -type dialog } - frame $dlg.bot - frame $dlg.top - if {$windowingsystem eq "x11"} { - $dlg.bot configure -relief raised -bd 1 - $dlg.top configure -relief raised -bd 1 - } + ttk::frame $dlg.bot + ttk::frame $dlg.top pack $dlg.bot -side bottom -fill both pack $dlg.top -side top -fill both -expand 1 - set W [frame $dlg.top.info] + set W [ttk::frame $dlg.top.info] text $W.text -setgrid true -height 10 -wrap char \ -yscrollcommand [list $W.scroll set] if {$windowingsystem ne "aqua"} { $W.text configure -width 40 } - scrollbar $W.scroll -command [list $W.text yview] + ttk::scrollbar $W.scroll -command [list $W.text yview] pack $W.scroll -side right -fill y pack $W.text -side left -expand yes -fill both $W.text insert 0.0 "$err\n$info" @@ -174,18 +185,11 @@ proc ::tk::dialog::error::bgerror err { # ...minus the width of the icon, padding and a fudge factor for # the window manager decorations and aesthetics. set wrapwidth [expr {$wrapwidth-60-[winfo pixels $dlg 9m]}] - label $dlg.msg -justify left -text $text -wraplength $wrapwidth - if {$windowingsystem eq "aqua"} { - # On the Macintosh, use the stop bitmap - label $dlg.bitmap -bitmap stop - } else { - # On other platforms, make the error icon - canvas $dlg.bitmap -width 32 -height 32 -highlightthickness 0 - $dlg.bitmap create oval 0 0 31 31 -fill red -outline black - $dlg.bitmap create line 9 9 23 23 -fill white -width 4 - $dlg.bitmap create line 9 23 23 9 -fill white -width 4 - } + ttk::label $dlg.msg -justify left -text $text -wraplength $wrapwidth + ttk::label $dlg.bitmap -image ::tk::icons::error + grid $dlg.bitmap $dlg.msg -in $dlg.top -row 0 -padx 3m -pady 3m + grid configure $dlg.bitmap -sticky ne grid configure $dlg.msg -sticky nsw -padx {0 3m} grid rowconfigure $dlg.top 1 -weight 1 grid columnconfigure $dlg.top 1 -weight 1 @@ -194,7 +198,7 @@ proc ::tk::dialog::error::bgerror err { set i 0 foreach {name caption} $buttons { - button $dlg.$name -text $caption -default normal \ + ttk::button $dlg.$name -text $caption -default normal \ -command [namespace code [list set button $i]] grid $dlg.$name -in $dlg.bot -column $i -row 0 -sticky ew -padx 10 grid columnconfigure $dlg.bot $i -weight 1 @@ -210,8 +214,10 @@ proc ::tk::dialog::error::bgerror err { # The "OK" button is the default for this dialog. $dlg.ok configure -default active - bind $dlg <Return> [namespace code Return] - bind $dlg <Destroy> [namespace code [list Destroy %W]] + bind $dlg <Return> [namespace code {Return ok 0}] + bind $dlg <Escape> [namespace code {Return dismiss 1}] + bind $dlg <Destroy> [namespace code {Destroy %W}] + bind $dlg.function <Return> [namespace code {ReturnInDetails %W}] $dlg.function configure -command [namespace code Details] # 6. Withdraw the window, then update all the geometry information @@ -220,7 +226,11 @@ proc ::tk::dialog::error::bgerror err { ::tk::PlaceWindow $dlg - # 7. Ensure that we are topmost. + # 7. Set a grab and claim the focus too. + + ::tk::SetFocusGrab $dlg $dlg.ok + + # 8. Ensure that we are topmost. raise $dlg if {[tk windowingsystem] eq "win32"} { @@ -228,13 +238,9 @@ proc ::tk::dialog::error::bgerror err { # order to ensure that it's seen if {[lindex [wm stackorder .] end] ne "$dlg"} { wm attributes $dlg -topmost 1 - } + } } - # 8. Set a grab and claim the focus too. - - ::tk::SetFocusGrab $dlg $dlg.ok - # 9. Wait for the user to respond, then restore the focus and # return the index of the selected button. Restore the focus # before deleting the window, since otherwise the window manager diff --git a/library/button.tcl b/library/button.tcl index 75378cc..b2bafb2 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -17,6 +17,7 @@ #------------------------------------------------------------------------- if {[tk windowingsystem] eq "aqua"} { + bind Radiobutton <Enter> { tk::ButtonEnter %W } @@ -143,7 +144,7 @@ bind Radiobutton <Leave> { if {"win32" eq [tk windowingsystem]} { ######################### -# Windows implementation +# Windows implementation ######################### # ::tk::ButtonEnter -- @@ -755,3 +756,10 @@ proc ::tk::CheckLeave {w} { set Priv(window) "" } + +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/library/choosedir.tcl b/library/choosedir.tcl index 00dca9d..68dd9b0 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -122,7 +122,7 @@ proc ::tk::dialog::file::chooseDir:: {args} { # Return value to user # - + return $Priv(selectFilePath) } @@ -164,7 +164,7 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { if {$data(-title) eq ""} { set data(-title) "[mc "Choose Directory"]" } - + # Stub out the -multiple value for the dialog; it doesn't make sense for # choose directory dialogs, but we have to have something there because we # share so much code with the file dialogs. @@ -186,7 +186,8 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } } @@ -209,9 +210,9 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { # 4b. If the value is different from the current directory, change to # that directory. - set selection [tk::IconList_CurSelection $data(icons)] + set selection [$data(icons) selection get] if {[llength $selection] != 0} { - set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]] + set iconText [$data(icons) get [lindex $selection 0]] set iconText [file join $data(selectPath) $iconText] Done $w $iconText } else { @@ -259,10 +260,9 @@ proc ::tk::dialog::file::chooseDir::IsOK? {w text} { proc ::tk::dialog::file::chooseDir::DblClick {w} { upvar ::tk::dialog::file::[winfo name $w] data - set selection [tk::IconList_CurSelection $data(icons)] + set selection [$data(icons) selection get] if {[llength $selection] != 0} { - set filenameFragment \ - [tk::IconList_Get $data(icons) [lindex $selection 0]] + set filenameFragment [$data(icons) get [lindex $selection 0]] set file $data(selectPath) if {[file isdirectory $file]} { ::tk::dialog::file::ListInvoke $w [list $filenameFragment] diff --git a/library/clrpick.tcl b/library/clrpick.tcl index 092915c..600be16 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -12,7 +12,7 @@ # # (1): Find out how many free colors are left in the colormap and # don't allocate too many colors. -# (2): Implement HSV color selection. +# (2): Implement HSV color selection. # # Make sure namespaces exist @@ -54,11 +54,11 @@ proc ::tk::dialog::color:: {args} { set data(BARS_WIDTH) 160 # PLGN_WIDTH is the number of pixels wide of the triangular selection - # polygon. This also results in the definition of the padding on the + # polygon. This also results in the definition of the padding on the # left and right sides which is half of PLGN_WIDTH. Make this number even. set data(PLGN_HEIGHT) 10 - # PLGN_HEIGHT is the height of the selection polygon and the height of the + # PLGN_HEIGHT is the height of the selection polygon and the height of the # selection rectangle at the bottom of the color bar. No restrictions. set data(PLGN_WIDTH) 10 @@ -190,11 +190,13 @@ proc ::tk::dialog::color::Config {dataName argList} { set data(-title) " " } if {[catch {winfo rgb . $data(-initialcolor)} err]} { - error $err + return -code error -errorcode [list TK LOOKUP COLOR $data(-initialcolor)] \ + $err } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } } @@ -326,7 +328,7 @@ proc ::tk::dialog::color::BuildDialog {w} { # Sets the current selection of the dialog box # proc ::tk::dialog::color::SetRGBValue {w color} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar ::tk::dialog::color::[winfo name $w] data set data(red,intensity) [lindex $color 0] set data(green,intensity) [lindex $color 1] @@ -366,7 +368,7 @@ proc ::tk::dialog::color::RgbToX {w color} { } # ::tk::dialog::color::DrawColorScale -- -# +# # Draw color scale is called whenever the size of one of the color # scale canvases is changed. # @@ -505,7 +507,7 @@ proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { upvar ::tk::dialog::color::[winfo name $w] data switch $colorChanged { - red { + red { DrawColorScale $w green DrawColorScale $w blue } @@ -535,7 +537,7 @@ proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { # Handles a mousedown button event over the selector polygon. # Adds the bindings for moving the mouse while the button is # pressed. Sets the binding for the button-release event. -# +# # Params: sel is the selector canvas window, color is the color of the strip. # proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { @@ -547,7 +549,7 @@ proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { } # ::tk::dialog::color::MoveSelector -- -# +# # Moves the polygon selector so that its middle point has the same # x value as the specified x. If x is outside the bounds [0,255], # the selector is set to the closest endpoint. @@ -581,7 +583,7 @@ proc ::tk::dialog::color::MoveSelector {w sel color x delta} { # x is the x-coord of the mouse. # proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar ::tk::dialog::color::[winfo name $w] data set x [MoveSelector $w $sel $color $x $delta] @@ -600,7 +602,7 @@ proc ::tk::dialog::color::ResizeColorBars {w} { upvar ::tk::dialog::color::[winfo name $w] data if { - ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || + ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0) } then { set data(BARS_WIDTH) $data(NUM_COLORBARS) @@ -658,7 +660,7 @@ proc ::tk::dialog::color::HandleRGBEntry {w} { SetRGBValue $w "$data(red,intensity) \ $data(green,intensity) $data(blue,intensity)" -} +} # mouse cursor enters a color bar # diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 39d27d3..18df8a6 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -40,7 +40,8 @@ proc tclParseConfigSpec {w specs flags argList} { # foreach spec $specs { if {[llength $spec] < 4} { - error "\"spec\" should contain 5 or 4 elements" + return -code error -errorcode {TK VALUE CONFIG_SPEC} \ + "\"spec\" should contain 5 or 4 elements" } set cmdsw [lindex $spec 0] set cmd($cmdsw) "" @@ -53,9 +54,11 @@ proc tclParseConfigSpec {w specs flags argList} { if {[llength $argList] & 1} { set cmdsw [lindex $argList end] if {![info exists cmd($cmdsw)]} { - error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" + return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \ + "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" } - error "value for \"$cmdsw\" missing" + return -code error -errorcode {TK VALUE_MISSING} \ + "value for \"$cmdsw\" missing" } # 2: set the default values @@ -68,7 +71,8 @@ proc tclParseConfigSpec {w specs flags argList} { # foreach {cmdsw value} $argList { if {![info exists cmd($cmdsw)]} { - error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" + return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \ + "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" } set data($cmdsw) $value } @@ -120,7 +124,8 @@ proc tclListValidFlags {v} { proc ::tk::FocusGroup_Create {t} { variable ::tk::Priv if {[winfo toplevel $t] ne $t} { - error "$t is not a toplevel window" + return -code error -errorcode [list TK LOOKUP TOPLEVEL $t] \ + "$t is not a toplevel window" } if {![info exists Priv(fg,$t)]} { set Priv(fg,$t) 1 @@ -140,7 +145,8 @@ proc ::tk::FocusGroup_BindIn {t w cmd} { variable FocusIn variable ::tk::Priv if {![info exists Priv(fg,$t)]} { - error "focus group \"$t\" doesn't exist" + return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \ + "focus group \"$t\" doesn't exist" } set FocusIn($t,$w) $cmd } @@ -156,7 +162,8 @@ proc ::tk::FocusGroup_BindOut {t w cmd} { variable FocusOut variable ::tk::Priv if {![info exists Priv(fg,$t)]} { - error "focus group \"$t\" doesn't exist" + return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \ + "focus group \"$t\" doesn't exist" } set FocusOut($t,$w) $cmd } @@ -173,7 +180,7 @@ proc ::tk::FocusGroup_Destroy {t w} { if {$t eq $w} { unset Priv(fg,$t) - unset Priv(focus,$t) + unset Priv(focus,$t) foreach name [array names FocusIn $t,*] { unset FocusIn($name) @@ -255,7 +262,8 @@ proc ::tk::FocusGroup_Out {t w detail} { proc ::tk::FDGetFileTypes {string} { foreach t $string { if {[llength $t] < 2 || [llength $t] > 3} { - error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" + return -code error -errorcode {TK VALUE FILE_TYPE} \ + "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" } lappend fileTypes([lindex $t 0]) {*}[lindex $t 1] } @@ -269,15 +277,16 @@ proc ::tk::FDGetFileTypes {string} { continue } - # Validate each macType. This is to agree with the + # Validate each macType. This is to agree with the # behaviour of TkGetFileFilters(). This list may be # empty. foreach macType [lindex $t 2] { if {[string length $macType] != 4} { - error "bad Macintosh file type \"$macType\"" + return -code error -errorcode {TK VALUE MAC_TYPE} \ + "bad Macintosh file type \"$macType\"" } } - + set name "$label \(" set sep "" set doAppend 1 diff --git a/library/console.tcl b/library/console.tcl index e44324f..ba68ccc 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -6,7 +6,7 @@ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. -# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> +# Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -20,11 +20,10 @@ namespace eval ::tk::console { variable magicKeys 1 ; # enable brace matching and proc/var recognition variable maxLines 600 ; # maximum # of lines buffered in console variable showMatches 1 ; # show multiple expand matches - + variable useFontchooser [llength [info command ::tk::fontchooser]] variable inPlugin [info exists embed_args] variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used - if {$inPlugin} { set defaultPrompt {subst {[history nextid] % }} } else { @@ -42,8 +41,6 @@ interp alias {} EvalAttached {} consoleinterp eval # None. proc ::tk::ConsoleInit {} { - global tcl_platform - if {![consoleinterp eval {set tcl_interactive}]} { wm withdraw . } @@ -79,7 +76,7 @@ proc ::tk::ConsoleInit {} { AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\ -command {event generate .console <<Paste>>} - if {$tcl_platform(platform) ne "windows"} { + if {[tk windowingsystem] ne "win32"} { AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \ -command {event generate .console <<Clear>>} } else { @@ -93,10 +90,35 @@ proc ::tk::ConsoleInit {} { } AmpMenuArgs .menubar.edit add separator + if {$::tk::console::useFontchooser} { + if {[tk windowingsystem] eq "aqua"} { + .menubar.edit add command -label tk_choose_font_marker + set index [.menubar.edit index tk_choose_font_marker] + .menubar.edit entryconfigure $index \ + -label [mc "Show Fonts"]\ + -accelerator "$mod-T"\ + -command [list ::tk::console::FontchooserToggle] + bind Console <<TkFontchooserVisibility>> \ + [list ::tk::console::FontchooserVisibility $index] + ::tk::console::FontchooserVisibility $index + } else { + AmpMenuArgs .menubar.edit add command -label [mc "&Font..."] \ + -command [list ::tk::console::FontchooserToggle] + } + bind Console <FocusIn> [list ::tk::console::FontchooserFocus %W 1] + bind Console <FocusOut> [list ::tk::console::FontchooserFocus %W 0] + } AmpMenuArgs .menubar.edit add command -label [mc "&Increase Font Size"] \ -accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>} AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \ -accel "$mod+-" -command {event generate .console <<Console_FontSizeDecr>>} + AmpMenuArgs .menubar.edit add command -label [mc "Fit To Screen Width"] \ + -command {event generate .console <<Console_FitScreenWidth>>} + + if {[tk windowingsystem] eq "aqua"} { + .menubar add cascade -label [mc Window] -menu [menu .menubar.window] + .menubar add cascade -label [mc Help] -menu [menu .menubar.help] + } . configure -menu .menubar @@ -171,7 +193,7 @@ proc ::tk::ConsoleInit {} { $w mark set promptEnd insert $w mark gravity promptEnd left - if {$tcl_platform(platform) eq "windows"} { + if {[tk windowingsystem] ne "aqua"} { # Subtle work-around to erase the '% ' that tclMain.c prints out after idle [subst -nocommand { if {[$con get 1.0 output] eq "% "} { $con delete 1.0 output } @@ -289,7 +311,7 @@ proc ::tk::ConsoleHistory {cmd} { # ::tk::ConsolePrompt -- # This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2 -# exists in the main interpreter it will be called to generate the +# exists in the main interpreter it will be called to generate the # prompt. Otherwise, a hard coded default prompt is printed. # # Arguments: @@ -356,6 +378,26 @@ proc ::tk::console::Paste {w} { } } +# Fit TkConsoleFont to window width +proc ::tk::console::FitScreenWidth {w} { + set width [winfo screenwidth $w] + set cwidth [$w cget -width] + set s -50 + set fit 0 + array set fi [font configure TkConsoleFont] + while {$s < 0} { + set fi(-size) $s + set f [font create {*}[array get fi]] + set c [font measure $f "eM"] + font delete $f + if {$c * $cwidth < 1.667 * $width} { + font configure TkConsoleFont -size $s + break + } + incr s 2 + } +} + # ::tk::ConsoleBind -- # This procedure first ensures that the default bindings for the Text # class have been defined. Then certain bindings are overridden for @@ -390,8 +432,6 @@ proc ::tk::ConsoleBind {w} { bind Console <Control-KeyPress> {# nothing} foreach {ev key} { - <<Console_Prev>> <Key-Up> - <<Console_Next>> <Key-Down> <<Console_NextImmediate>> <Control-Key-n> <<Console_PrevImmediate>> <Control-Key-p> <<Console_PrevSearch>> <Control-Key-r> @@ -426,6 +466,9 @@ proc ::tk::ConsoleBind {w} { event add $ev $key bind Console $key {} } + if {$::tk::console::useFontchooser} { + bind Console <Command-Key-t> [list ::tk::console::FontchooserToggle] + } } bind Console <<Console_Expand>> { if {[%W compare insert > promptEnd]} { @@ -474,18 +517,16 @@ proc ::tk::ConsoleBind {w} { } bind Console <Control-h> [bind Console <BackSpace>] - bind Console <Home> { + bind Console <<LineStart>> { if {[%W compare insert < promptEnd]} { tk::TextSetCursor %W {insert linestart} } else { tk::TextSetCursor %W promptEnd } } - bind Console <Control-a> [bind Console <Home>] - bind Console <End> { + bind Console <<LineEnd>> { tk::TextSetCursor %W {insert lineend} } - bind Console <Control-e> [bind Console <End>] bind Console <Control-d> { if {[%W compare insert < promptEnd]} { break @@ -535,10 +576,10 @@ proc ::tk::ConsoleBind {w} { %W delete insert {insert wordend} } } - bind Console <<Console_Prev>> { + bind Console <<PrevLine>> { tk::ConsoleHistory prev } - bind Console <<Console_Next>> { + bind Console <<NextLine>> { tk::ConsoleHistory next } bind Console <Insert> { @@ -562,11 +603,25 @@ proc ::tk::ConsoleBind {w} { bind Console <<Console_FontSizeIncr>> { set size [font configure TkConsoleFont -size] - font configure TkConsoleFont -size [incr size] + if {$size < 0} {set sign -1} else {set sign 1} + set size [expr {(abs($size) + 1) * $sign}] + font configure TkConsoleFont -size $size + if {$::tk::console::useFontchooser} { + tk fontchooser configure -font TkConsoleFont + } } bind Console <<Console_FontSizeDecr>> { set size [font configure TkConsoleFont -size] - font configure TkConsoleFont -size [incr size -1] + if {abs($size) < 2} { return } + if {$size < 0} {set sign -1} else {set sign 1} + set size [expr {(abs($size) - 1) * $sign}] + font configure TkConsoleFont -size $size + if {$::tk::console::useFontchooser} { + tk fontchooser configure -font TkConsoleFont + } + } + bind Console <<Console_FitScreenWidth>> { + ::tk::console::FitScreenWidth %W } ## @@ -671,6 +726,35 @@ Tcl $::tcl_patchLevel Tk $::tk_patchLevel" } +# ::tk::console::Fontchooser* -- +# Let the user select the console font (TIP 324). + +proc ::tk::console::FontchooserToggle {} { + if {[tk fontchooser configure -visible]} { + tk fontchooser hide + } else { + tk fontchooser show + } +} +proc ::tk::console::FontchooserVisibility {index} { + if {[tk fontchooser configure -visible]} { + .menubar.edit entryconfigure $index -label [msgcat::mc "Hide Fonts"] + } else { + .menubar.edit entryconfigure $index -label [msgcat::mc "Show Fonts"] + } +} +proc ::tk::console::FontchooserFocus {w isFocusIn} { + if {$isFocusIn} { + tk fontchooser configure -parent $w -font TkConsoleFont \ + -command [namespace code [list FontchooserApply]] + } else { + tk fontchooser configure -parent $w -font {} -command {} + } +} +proc ::tk::console::FontchooserApply {font args} { + catch {font configure TkConsoleFont {*}[font actual $font]} +} + # ::tk::console::TagProc -- # # Tags a procedure in the console if it's recognized @@ -720,7 +804,7 @@ proc ::tk::console::TagProc w { # c2 - second char of pair # # Calls: ::tk::console::Blink - + proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { if {!$::tk::console::magicKeys} { return @@ -775,7 +859,7 @@ proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { # w - console text widget # # Calls: ::tk::console::Blink - + proc ::tk::console::MatchQuote {w {lim 1.0}} { if {!$::tk::console::magicKeys} { return @@ -910,11 +994,11 @@ proc ::tk::console::Expand {w {type ""}} { # # Returns: list containing longest unique match followed by all the # possible further matches - + proc ::tk::console::ExpandPathname str { set pwd [EvalAttached pwd] - if {[catch {EvalAttached [list cd [file dirname $str]]} err]} { - return -code error $err + if {[catch {EvalAttached [list cd [file dirname $str]]} err opt]} { + return -options $opt $err } set dir [file tail $str] ## Check to see if it was known to be a directory and keep the trailing @@ -926,8 +1010,7 @@ proc ::tk::console::ExpandPathname str { set match {} } else { if {[llength $m] > 1} { - global tcl_platform - if {[string match windows $tcl_platform(platform)]} { + if { $::tcl_platform(platform) eq "windows" } { ## Windows is screwy because it's case insensitive set tmp [ExpandBestMatch [string tolower $m] \ [string tolower $dir]] diff --git a/library/demos/aniwave.tcl b/library/demos/aniwave.tcl index 6122132..a7539fb 100644 --- a/library/demos/aniwave.tcl +++ b/library/demos/aniwave.tcl @@ -17,7 +17,7 @@ wm title $w "Animated Wave Demonstration" wm iconname $w "aniwave" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line." +label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line." pack $w.msg -side top ## See Code / Dismiss buttons diff --git a/library/demos/bind.tcl b/library/demos/bind.tcl index d9bc22f..03f6d3b 100644 --- a/library/demos/bind.tcl +++ b/library/demos/bind.tcl @@ -22,7 +22,7 @@ pack $btns -side bottom -fill x text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ -width 60 -height 24 -font $font -wrap word -scrollbar $w.scroll -command "$w.text yview" +ttk::scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/combo.tcl b/library/demos/combo.tcl index 5dad9f0..8631904 100644 --- a/library/demos/combo.tcl +++ b/library/demos/combo.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .combo catch {destroy $w} diff --git a/library/demos/ctext.tcl b/library/demos/ctext.tcl index e894bc2..4b8c644 100644 --- a/library/demos/ctext.tcl +++ b/library/demos/ctext.tcl @@ -17,7 +17,7 @@ wm iconname $w "Text" positionWindow $w set c $w.c -label $w.msg -font $font -wraplength 5i -justify left -text "This window displays a string of text to demonstrate the text facilities of canvas widgets. You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification. The text also supports the following simple bindings for editing: +label $w.msg -font $font -wraplength 5i -justify left -text "This window displays a string of text to demonstrate the text facilities of canvas widgets. You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification, and on a pie slice to change its angle. The text also supports the following simple bindings for editing: 1. You can point, click, and type. 2. You can also select with button 1. 3. You can copy the selection to the mouse position with button 2. @@ -50,36 +50,63 @@ $c bind text <Return> "textInsert $c \\n" $c bind text <Control-h> "textBs $c" $c bind text <BackSpace> "textBs $c" $c bind text <Delete> "textDel $c" -$c bind text <2> "textPaste $c @%x,%y" +$c bind text <2> "textPaste $c @%x,%y" # Next, create some items that allow the text's anchor position # to be edited. -proc mkTextConfig {w x y option value color} { +proc mkTextConfigBox {w x y option value color} { set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \ -outline black -fill $color -width 1] $w bind $item <1> "$w itemconf text $option $value" $w addtag config withtag $item } +proc mkTextConfigPie {w x y a option value color} { + set item [$w create arc $x $y [expr {$x+90}] [expr {$y+90}] \ + -start [expr {$a-15}] -extent 30 -outline black -fill $color \ + -width 1] + $w bind $item <1> "$w itemconf text $option $value" + $w addtag config withtag $item +} set x 50 set y 50 set color LightSkyBlue1 -mkTextConfig $c $x $y -anchor se $color -mkTextConfig $c [expr {$x+30}] [expr {$y }] -anchor s $color -mkTextConfig $c [expr {$x+60}] [expr {$y }] -anchor sw $color -mkTextConfig $c [expr {$x }] [expr {$y+30}] -anchor e $color -mkTextConfig $c [expr {$x+30}] [expr {$y+30}] -anchor center $color -mkTextConfig $c [expr {$x+60}] [expr {$y+30}] -anchor w $color -mkTextConfig $c [expr {$x }] [expr {$y+60}] -anchor ne $color -mkTextConfig $c [expr {$x+30}] [expr {$y+60}] -anchor n $color -mkTextConfig $c [expr {$x+60}] [expr {$y+60}] -anchor nw $color +mkTextConfigBox $c $x $y -anchor se $color +mkTextConfigBox $c [expr {$x+30}] [expr {$y }] -anchor s $color +mkTextConfigBox $c [expr {$x+60}] [expr {$y }] -anchor sw $color +mkTextConfigBox $c [expr {$x }] [expr {$y+30}] -anchor e $color +mkTextConfigBox $c [expr {$x+30}] [expr {$y+30}] -anchor center $color +mkTextConfigBox $c [expr {$x+60}] [expr {$y+30}] -anchor w $color +mkTextConfigBox $c [expr {$x }] [expr {$y+60}] -anchor ne $color +mkTextConfigBox $c [expr {$x+30}] [expr {$y+60}] -anchor n $color +mkTextConfigBox $c [expr {$x+60}] [expr {$y+60}] -anchor nw $color set item [$c create rect \ [expr {$x+40}] [expr {$y+40}] [expr {$x+50}] [expr {$y+50}] \ -outline black -fill red] $c bind $item <1> "$c itemconf text -anchor center" $c create text [expr {$x+45}] [expr {$y-5}] \ - -text {Text Position} -anchor s -font {Times 24} -fill brown + -text {Text Position} -anchor s -font {Times 20} -fill brown + +# Now create some items that allow the text's angle to be changed. + +set x 205 +set y 50 +set color Yellow +mkTextConfigPie $c $x $y 0 -angle 90 $color +mkTextConfigPie $c $x $y 30 -angle 120 $color +mkTextConfigPie $c $x $y 60 -angle 150 $color +mkTextConfigPie $c $x $y 90 -angle 180 $color +mkTextConfigPie $c $x $y 120 -angle 210 $color +mkTextConfigPie $c $x $y 150 -angle 240 $color +mkTextConfigPie $c $x $y 180 -angle 270 $color +mkTextConfigPie $c $x $y 210 -angle 300 $color +mkTextConfigPie $c $x $y 240 -angle 330 $color +mkTextConfigPie $c $x $y 270 -angle 0 $color +mkTextConfigPie $c $x $y 300 -angle 30 $color +mkTextConfigPie $c $x $y 330 -angle 60 $color +$c create text [expr {$x+45}] [expr {$y-5}] \ + -text {Text Angle} -anchor s -font {Times 20} -fill brown # Lastly, create some items that allow the text's justification to be # changed. @@ -87,11 +114,11 @@ $c create text [expr {$x+45}] [expr {$y-5}] \ set x 350 set y 50 set color SeaGreen2 -mkTextConfig $c $x $y -justify left $color -mkTextConfig $c [expr {$x+30}] $y -justify center $color -mkTextConfig $c [expr {$x+60}] $y -justify right $color +mkTextConfigBox $c $x $y -justify left $color +mkTextConfigBox $c [expr {$x+30}] $y -justify center $color +mkTextConfigBox $c [expr {$x+60}] $y -justify right $color $c create text [expr {$x+45}] [expr {$y-5}] \ - -text {Justification} -anchor s -font {Times 24} -fill brown + -text {Justification} -anchor s -font {Times 20} -fill brown $c bind config <Enter> "textEnter $c" $c bind config <Leave> "$c itemconf current -fill \$textConfigFill" diff --git a/library/demos/en.msg b/library/demos/en.msg index d4783fe..e364c81 100644 --- a/library/demos/en.msg +++ b/library/demos/en.msg @@ -18,7 +18,7 @@ ::msgcat::mcset en "Demo code: %s" ::msgcat::mcset en "About Widget Demo" ::msgcat::mcset en "Tk widget demonstration application" -::msgcat::mcset en "Copyright (c) %s" "Copyright \u00a9 %s" +::msgcat::mcset en "Copyright \u00a9 %s" ::msgcat::mcset en " @@title Tk Widget Demonstrations diff --git a/library/demos/entry2.tcl b/library/demos/entry2.tcl index d0ca35a..9e3f4ef 100644 --- a/library/demos/entry2.tcl +++ b/library/demos/entry2.tcl @@ -27,15 +27,15 @@ frame $w.frame -borderwidth 10 pack $w.frame -side top -fill x -expand 1 entry $w.frame.e1 -xscrollcommand "$w.frame.s1 set" -scrollbar $w.frame.s1 -relief sunken -orient horiz -command \ +ttk::scrollbar $w.frame.s1 -orient horiz -command \ "$w.frame.e1 xview" frame $w.frame.spacer1 -width 20 -height 10 entry $w.frame.e2 -xscrollcommand "$w.frame.s2 set" -scrollbar $w.frame.s2 -relief sunken -orient horiz -command \ +ttk::scrollbar $w.frame.s2 -orient horiz -command \ "$w.frame.e2 xview" frame $w.frame.spacer2 -width 20 -height 10 entry $w.frame.e3 -xscrollcommand "$w.frame.s3 set" -scrollbar $w.frame.s3 -relief sunken -orient horiz -command \ +ttk::scrollbar $w.frame.s3 -orient horiz -command \ "$w.frame.e3 xview" pack $w.frame.e1 $w.frame.s1 $w.frame.spacer1 $w.frame.e2 $w.frame.s2 \ $w.frame.spacer2 $w.frame.e3 $w.frame.s3 -side top -fill x diff --git a/library/demos/entry3.tcl b/library/demos/entry3.tcl index 3d76c2e..d4435c6 100644 --- a/library/demos/entry3.tcl +++ b/library/demos/entry3.tcl @@ -169,8 +169,8 @@ bind $w.l3.e <FocusIn> { after idle {%W selection clear} } } -bind $w.l3.e <Left> {phoneSkipLeft %W} -bind $w.l3.e <Right> {phoneSkipRight %W} +bind $w.l3.e <<PrevChar>> {phoneSkipLeft %W} +bind $w.l3.e <<NextChar>> {phoneSkipRight %W} pack $w.l3.e -fill x -expand 1 -padx 1m -pady 1m labelframe $w.l4 -text "Password Entry" diff --git a/library/demos/filebox.tcl b/library/demos/filebox.tcl index 032e3d8..e06ebba 100644 --- a/library/demos/filebox.tcl +++ b/library/demos/filebox.tcl @@ -15,7 +15,10 @@ wm title $w "File Selection Dialogs" wm iconname $w "filebox" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog." +ttk::frame $w._bg +place $w._bg -x 0 -y 0 -relwidth 1 -relheight 1 + +ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog." pack $w.msg -side top ## See Code / Dismiss buttons @@ -23,10 +26,10 @@ set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x foreach i {open save} { - set f [frame $w.$i] - label $f.lab -text "Select a file to $i: " -anchor e - entry $f.ent -width 20 - button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i" + set f [ttk::frame $w.$i] + ttk::label $f.lab -text "Select a file to $i: " -anchor e + ttk::entry $f.ent -width 20 + ttk::button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i" pack $f.lab -side left pack $f.ent -side left -expand yes -fill x pack $f.but -side left @@ -34,7 +37,7 @@ foreach i {open save} { } if {[tk windowingsystem] eq "x11"} { - checkbutton $w.strict -text "Use Motif Style Dialog" \ + ttk::checkbutton $w.strict -text "Use Motif Style Dialog" \ -variable tk_strictMotif -onvalue 1 -offvalue 0 pack $w.strict -anchor c diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl index 827600b..c36979b 100644 --- a/library/demos/floor.tcl +++ b/library/demos/floor.tcl @@ -1307,8 +1307,8 @@ pack $btns -side bottom -fill x set f [frame $w.frame] pack $f -side top -fill both -expand yes -set h [scrollbar $f.hscroll -orient horizontal] -set v [scrollbar $f.vscroll -orient vertical] +set h [ttk::scrollbar $f.hscroll -orient horizontal] +set v [ttk::scrollbar $f.vscroll -orient vertical] set f1 [frame $f.f1 -borderwidth 2 -relief sunken] set c [canvas $f1.c -width 900 -height 500 -highlightthickness 0 \ -xscrollcommand [list $h set] \ diff --git a/library/demos/fontchoose.tcl b/library/demos/fontchoose.tcl new file mode 100644 index 0000000..8b34377 --- /dev/null +++ b/library/demos/fontchoose.tcl @@ -0,0 +1,69 @@ +# fontchoose.tcl -- +# +# Show off the stock font selector dialog + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk + +set w .fontchoose +catch {destroy $w} +toplevel $w +wm title $w "Font Selection Dialog" +wm iconname $w "fontchooser" +positionWindow $w + +catch {font create FontchooseDemoFont {*}[font actual TkDefaultFont]} + +# The font chooser needs to be configured and then shown. +proc SelectFont {parent} { + tk fontchooser configure -font FontchooseDemoFont \ + -command ApplyFont -parent $parent + tk fontchooser show +} + +proc ApplyFont {font} { + font configure FontchooseDemoFont {*}[font actual $font] +} + +# When the visibility of the fontchooser changes, the following event is fired +# to the parent widget. +# +bind $w <<TkFontchooserVisibility>> { + if {[tk fontchooser configure -visible]} { + %W.f.font state disabled + } else { + %W.f.font state !disabled + } +} + + +set f [ttk::frame $w.f -relief sunken -padding 2] + +text $f.msg -font FontchooseDemoFont -width 40 -height 6 -borderwidth 0 \ + -yscrollcommand [list $f.vs set] +ttk::scrollbar $f.vs -command [list $f.msg yview] + +$f.msg insert end "Press the buttons below to choose a new font for the\ + text shown in this window.\n" {} + +ttk::button $f.font -text "Set font ..." -command [list SelectFont $w] + +grid $f.msg $f.vs -sticky news +grid $f.font - -sticky e +grid columnconfigure $f 0 -weight 1 +grid rowconfigure $f 0 -weight 1 +bind $w <Visibility> { + bind %W <Visibility> {} + grid propagate %W.f 0 +} + +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] + +grid $f -sticky news +grid $btns -sticky ew +grid columnconfigure $w 0 -weight 1 +grid rowconfigure $w 0 -weight 1 diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl index 7b3d748..2d7ba03 100644 --- a/library/demos/image2.tcl +++ b/library/demos/image2.tcl @@ -36,7 +36,7 @@ proc loadDir w { proc selectAndLoadDir w { global dirName set dir [tk_chooseDirectory -initialdir $dirName -parent $w -mustexist 1] - if {[string length $dir] != 0} { + if {$dir ne ""} { set dirName $dir loadDir $w } @@ -92,7 +92,7 @@ pack $w.dir.b -side left -fill y -padx {0 2m} -pady 2m labelframe $w.f -text "File:" -padx 2m -pady 2m listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" -scrollbar $w.f.scroll -command "$w.f.list yview" +ttk::scrollbar $w.f.scroll -command "$w.f.list yview" pack $w.f.list $w.f.scroll -side left -fill y -expand 1 $w.f.list insert 0 earth.gif earthris.gif teapot.ppm bind $w.f.list <Double-1> "loadImage $w %x %y" diff --git a/library/demos/images/face.xbm b/library/demos/images/face.xbm deleted file mode 100644 index 03d829f..0000000 --- a/library/demos/images/face.xbm +++ /dev/null @@ -1,173 +0,0 @@ -#define face_width 108 -#define face_height 144 -#define face_x_hot 48 -#define face_y_hot 80 -static char face_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x09, - 0x20, 0x80, 0x24, 0x05, 0x00, 0x80, 0x08, 0x00, 0x00, 0x00, 0x00, 0x88, - 0x24, 0x20, 0x80, 0x24, 0x00, 0x00, 0x00, 0x10, 0x80, 0x04, 0x00, 0x01, - 0x00, 0x01, 0x40, 0x0a, 0x09, 0x00, 0x92, 0x04, 0x80, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x10, 0x40, 0x12, 0x00, 0x00, 0x10, 0x40, 0x00, 0x00, 0x84, - 0x24, 0x40, 0x22, 0xa8, 0x02, 0x14, 0x84, 0x92, 0x40, 0x42, 0x12, 0x04, - 0x10, 0x00, 0x00, 0x00, 0x00, 0x52, 0x00, 0x52, 0x11, 0x00, 0x12, 0x00, - 0x40, 0x02, 0x00, 0x20, 0x00, 0x08, 0x00, 0xaa, 0x02, 0x54, 0x85, 0x24, - 0x00, 0x10, 0x12, 0x00, 0x00, 0x81, 0x44, 0x00, 0x90, 0x5a, 0x00, 0xea, - 0x1b, 0x00, 0x80, 0x40, 0x40, 0x02, 0x00, 0x08, 0x00, 0x20, 0xa2, 0x05, - 0x8a, 0xb4, 0x6e, 0x45, 0x12, 0x04, 0x08, 0x00, 0x00, 0x00, 0x10, 0x02, - 0xa8, 0x92, 0x00, 0xda, 0x5f, 0x10, 0x00, 0x10, 0xa1, 0x04, 0x20, 0x41, - 0x02, 0x00, 0x5a, 0x25, 0xa0, 0xff, 0xfb, 0x05, 0x41, 0x02, 0x04, 0x00, - 0x00, 0x08, 0x40, 0x80, 0xec, 0x9b, 0xec, 0xfe, 0x7f, 0x01, 0x04, 0x20, - 0x90, 0x02, 0x04, 0x00, 0x08, 0x20, 0xfb, 0x2e, 0xf5, 0xff, 0xff, 0x57, - 0x00, 0x04, 0x02, 0x00, 0x00, 0x20, 0x01, 0xc1, 0x6e, 0xab, 0xfa, 0xff, - 0xff, 0x05, 0x90, 0x20, 0x48, 0x02, 0x00, 0x04, 0x20, 0xa8, 0xdf, 0xb5, - 0xfe, 0xff, 0xff, 0x0b, 0x01, 0x00, 0x01, 0x00, 0x80, 0x80, 0x04, 0xe0, - 0xbb, 0xef, 0xff, 0xff, 0x7f, 0x01, 0x00, 0x04, 0x48, 0x02, 0x00, 0x20, - 0x80, 0xf4, 0x6f, 0xfb, 0xff, 0xff, 0xff, 0x20, 0x90, 0x40, 0x02, 0x00, - 0x00, 0x04, 0x08, 0xb8, 0xf6, 0xff, 0xff, 0xdf, 0xbe, 0x12, 0x45, 0x10, - 0x90, 0x04, 0x90, 0x00, 0x22, 0xfa, 0xff, 0xff, 0xff, 0xbb, 0xd7, 0xe9, - 0x3a, 0x02, 0x02, 0x00, 0x04, 0x90, 0x80, 0xfe, 0xdf, 0xf6, 0xb7, 0xef, - 0xbe, 0x56, 0x57, 0x40, 0x48, 0x09, 0x00, 0x04, 0x00, 0xfa, 0xf5, 0xdf, - 0xed, 0x5a, 0xd5, 0xea, 0xbd, 0x09, 0x00, 0x00, 0x40, 0x00, 0x92, 0xfe, - 0xbf, 0x7d, 0xb7, 0x6a, 0x55, 0xbf, 0xf7, 0x02, 0x11, 0x01, 0x00, 0x91, - 0x00, 0xff, 0xff, 0xaf, 0x55, 0x55, 0x5b, 0xeb, 0xef, 0x22, 0x04, 0x04, - 0x04, 0x00, 0xa4, 0xff, 0xf7, 0xad, 0xaa, 0xaa, 0xaa, 0xbe, 0xfe, 0x03, - 0x20, 0x00, 0x10, 0x44, 0x80, 0xff, 0x7f, 0x55, 0x12, 0x91, 0x2a, 0xeb, - 0xbf, 0x0b, 0x82, 0x02, 0x00, 0x00, 0xd1, 0x7f, 0xdf, 0xa2, 0xa4, 0x54, - 0x55, 0xfd, 0xfd, 0x47, 0x08, 0x08, 0x00, 0x21, 0xe4, 0xff, 0x37, 0x11, - 0x09, 0xa5, 0xaa, 0xb6, 0xff, 0x0d, 0x80, 0x00, 0x00, 0x04, 0xd0, 0xff, - 0x4f, 0x44, 0x20, 0x48, 0x55, 0xfb, 0xff, 0x27, 0x11, 0x02, 0x40, 0x40, - 0xe2, 0xfb, 0x15, 0x11, 0x4a, 0x55, 0x4a, 0x7d, 0xf7, 0x0f, 0x00, 0x00, - 0x04, 0x08, 0xf8, 0xdf, 0x52, 0x44, 0x01, 0x52, 0xb5, 0xfa, 0xff, 0x0f, - 0x49, 0x02, 0x00, 0x02, 0xe9, 0xf6, 0x0a, 0x11, 0xa4, 0x88, 0x4a, 0x6d, - 0xff, 0x5f, 0x00, 0x00, 0x10, 0x20, 0xf0, 0x2f, 0x21, 0x44, 0x10, 0x52, - 0xb5, 0xfa, 0xff, 0x0f, 0x44, 0x04, 0x80, 0x08, 0xf8, 0xab, 0x8a, 0x00, - 0x81, 0xa4, 0xd4, 0xd6, 0xfe, 0x2f, 0x00, 0x00, 0x04, 0x40, 0xb5, 0x2d, - 0x21, 0x08, 0x04, 0x90, 0xaa, 0xfa, 0xff, 0x1f, 0x11, 0x01, 0x00, 0x04, - 0xf0, 0x57, 0x0a, 0x22, 0x40, 0x4a, 0xda, 0x5e, 0xfb, 0x1f, 0x40, 0x00, - 0x40, 0x20, 0xba, 0x95, 0x90, 0x00, 0x01, 0xa0, 0xaa, 0xea, 0xff, 0x5f, - 0x02, 0x02, 0x00, 0x01, 0xe8, 0x57, 0x05, 0x00, 0x00, 0x12, 0xd5, 0xfe, - 0xfd, 0x1f, 0x48, 0x00, 0x04, 0x48, 0x7a, 0x95, 0x08, 0x02, 0x10, 0x40, - 0xaa, 0x55, 0xf7, 0x1f, 0x00, 0x09, 0x20, 0x00, 0xf8, 0x57, 0x22, 0x10, - 0x00, 0x28, 0xa9, 0xfa, 0xff, 0x5f, 0x02, 0x00, 0x00, 0x49, 0xdd, 0x29, - 0x01, 0x00, 0x80, 0x80, 0xaa, 0xd7, 0xff, 0x0f, 0x10, 0x00, 0x08, 0x00, - 0xf8, 0x96, 0x08, 0x00, 0x00, 0x20, 0x54, 0xfa, 0xee, 0x3f, 0x81, 0x04, - 0x40, 0x24, 0xfe, 0x55, 0x82, 0x00, 0x00, 0x82, 0xd2, 0xad, 0xff, 0x0f, - 0x08, 0x00, 0x04, 0x80, 0x6c, 0x97, 0x00, 0x00, 0x02, 0x20, 0xa9, 0xf6, - 0xdf, 0x5f, 0x00, 0x02, 0x20, 0x09, 0xfa, 0x49, 0x12, 0x00, 0x20, 0x84, - 0x54, 0xdb, 0xfe, 0x1f, 0x91, 0x00, 0x00, 0x00, 0xf8, 0x2b, 0x00, 0x20, - 0x00, 0x40, 0xa4, 0xf6, 0xbb, 0x1f, 0x04, 0x00, 0x44, 0x92, 0x7e, 0x95, - 0x02, 0x00, 0x00, 0x89, 0xaa, 0xdd, 0xff, 0x1f, 0x20, 0x09, 0x10, 0x00, - 0xf4, 0x57, 0x20, 0x01, 0x08, 0x20, 0xa9, 0x76, 0xff, 0x5f, 0x02, 0x00, - 0x00, 0x21, 0xfc, 0x4a, 0x05, 0x00, 0x01, 0x80, 0x54, 0xdb, 0xff, 0x1e, - 0x08, 0x02, 0x04, 0x08, 0xf9, 0x2b, 0x00, 0x00, 0x40, 0x28, 0xd2, 0xf6, - 0xff, 0xbf, 0x80, 0x00, 0x90, 0x00, 0xbc, 0x92, 0x08, 0x10, 0x00, 0x82, - 0x54, 0xdb, 0xff, 0x1f, 0x20, 0x00, 0x00, 0x44, 0xf9, 0x55, 0x02, 0x01, - 0x00, 0x20, 0xaa, 0xbd, 0xfd, 0x3f, 0x08, 0x04, 0x04, 0x10, 0xf4, 0x2a, - 0x01, 0x00, 0x22, 0x80, 0xd4, 0xf6, 0xff, 0x5f, 0x82, 0x00, 0x40, 0x02, - 0xf8, 0x55, 0x20, 0x00, 0x00, 0x50, 0x6a, 0xdf, 0xfe, 0x3f, 0x00, 0x00, - 0x00, 0x48, 0xe9, 0x4a, 0x05, 0x08, 0x00, 0xa5, 0xd5, 0xf5, 0xff, 0x3f, - 0x10, 0x01, 0x10, 0x01, 0xb0, 0xab, 0x92, 0x02, 0x40, 0xf8, 0xbf, 0xde, - 0xfe, 0x5f, 0x02, 0x04, 0x04, 0x48, 0xfa, 0xd4, 0x6f, 0x20, 0x84, 0xef, - 0xff, 0xfb, 0xff, 0x1f, 0x20, 0x00, 0x00, 0x00, 0xe0, 0xed, 0xbf, 0x0b, - 0xa1, 0x7e, 0xff, 0xbf, 0xfd, 0x5f, 0x04, 0x01, 0x20, 0x49, 0xd2, 0xfb, - 0xfe, 0x55, 0xd4, 0xff, 0xff, 0xf6, 0xff, 0x07, 0x00, 0x04, 0x00, 0x00, - 0xc0, 0xaa, 0xfb, 0x2b, 0xa2, 0xfe, 0xff, 0xdf, 0xee, 0x1f, 0x91, 0x00, - 0x82, 0xa4, 0xa4, 0xf5, 0xff, 0x57, 0xd5, 0xff, 0xbf, 0xfd, 0xff, 0x4d, - 0x00, 0x00, 0x20, 0x00, 0x88, 0x5b, 0xff, 0x2f, 0x69, 0xff, 0xff, 0xdb, - 0xfe, 0x1f, 0x24, 0x02, 0x00, 0x49, 0xa2, 0xd6, 0xff, 0x5f, 0xea, 0xff, - 0x7f, 0x7f, 0x7f, 0x0d, 0x00, 0x00, 0x10, 0x00, 0x40, 0xab, 0xf7, 0xbb, - 0xf0, 0xdf, 0xff, 0xd5, 0xff, 0xbf, 0x82, 0x04, 0x42, 0x24, 0x91, 0xd5, - 0xaa, 0xae, 0xd4, 0xaa, 0x52, 0x7b, 0xff, 0x15, 0x08, 0x00, 0x00, 0x01, - 0x04, 0x55, 0xd5, 0x55, 0x70, 0x5b, 0x75, 0xdd, 0xdf, 0x1f, 0x40, 0x00, - 0x08, 0x48, 0xa0, 0x4a, 0xa9, 0x56, 0xea, 0x56, 0xad, 0x6a, 0x7d, 0x9b, - 0x04, 0x01, 0x00, 0x02, 0x42, 0x2a, 0xd5, 0xaa, 0xa8, 0xaa, 0xaa, 0xfa, - 0xdf, 0x2f, 0x10, 0x04, 0x22, 0x48, 0x08, 0x45, 0x2a, 0x15, 0x68, 0x55, - 0x55, 0xd7, 0x76, 0x1b, 0x00, 0x00, 0x00, 0x01, 0x40, 0x2a, 0x80, 0xa0, - 0xb2, 0x09, 0x48, 0xb9, 0xdf, 0x17, 0x22, 0x01, 0x00, 0x24, 0x45, 0x8a, - 0x24, 0x4a, 0x54, 0x51, 0x91, 0xf6, 0x6e, 0x4b, 0x00, 0x04, 0x90, 0x00, - 0x80, 0x52, 0x00, 0x20, 0x69, 0x05, 0xa4, 0xaa, 0xff, 0x1e, 0x48, 0x00, - 0x02, 0x92, 0x08, 0x05, 0x81, 0x94, 0xd4, 0x92, 0x40, 0xfd, 0xb6, 0x8b, - 0x00, 0x01, 0x40, 0x00, 0x82, 0x54, 0x00, 0x48, 0x68, 0x05, 0x90, 0xa4, - 0xef, 0x06, 0x24, 0x00, 0x08, 0x12, 0x10, 0x05, 0x00, 0x10, 0xb5, 0x01, - 0x42, 0xfb, 0xbf, 0x43, 0x00, 0x09, 0x00, 0x40, 0x81, 0xa8, 0x08, 0x4a, - 0xaa, 0x96, 0x90, 0xac, 0x6d, 0x15, 0x22, 0x00, 0x20, 0x09, 0x04, 0x15, - 0x80, 0x28, 0xdc, 0x01, 0x24, 0xfb, 0xbf, 0x01, 0x80, 0x04, 0x09, 0x00, - 0x40, 0x48, 0x02, 0x45, 0xb2, 0x2e, 0x41, 0x6d, 0xef, 0x05, 0x11, 0x00, - 0x40, 0x52, 0x02, 0x15, 0x29, 0x2a, 0xac, 0x42, 0x54, 0xfb, 0x3b, 0x51, - 0x84, 0x00, 0x08, 0x00, 0x20, 0x54, 0x80, 0x05, 0xb5, 0x3d, 0xa2, 0xb6, - 0xdf, 0x00, 0x20, 0x04, 0x20, 0x49, 0x89, 0xa8, 0x6a, 0x29, 0xac, 0xd6, - 0x54, 0xff, 0x3f, 0x84, 0x00, 0x01, 0x04, 0x10, 0x00, 0x94, 0xa8, 0x56, - 0xda, 0x5f, 0xab, 0xd5, 0x1e, 0x10, 0x48, 0x00, 0x90, 0x82, 0x48, 0xa8, - 0xb2, 0xac, 0xfd, 0x55, 0xd5, 0xfe, 0x9f, 0x80, 0x00, 0x0a, 0x02, 0x08, - 0x02, 0x55, 0x5a, 0x75, 0xff, 0xaf, 0xb6, 0xf7, 0x2d, 0x12, 0x92, 0x00, - 0x10, 0x20, 0x10, 0xa8, 0x54, 0xd5, 0xbf, 0x5d, 0xad, 0xdd, 0x0f, 0x00, - 0x00, 0x04, 0x40, 0x09, 0x84, 0xa8, 0xaa, 0x5a, 0xed, 0xeb, 0x6a, 0xff, - 0x9f, 0xa4, 0x24, 0x01, 0x02, 0xa0, 0x20, 0x50, 0x55, 0xd5, 0xbe, 0xae, - 0xad, 0xfd, 0x16, 0x00, 0x10, 0x04, 0x20, 0x0a, 0x08, 0xb4, 0xaa, 0x95, - 0xaa, 0x7b, 0xb7, 0xdb, 0x5f, 0x92, 0x04, 0x01, 0x84, 0x20, 0x21, 0x51, - 0xd5, 0x2a, 0xa9, 0xee, 0xd5, 0xfe, 0x0d, 0x00, 0x20, 0x04, 0x10, 0x00, - 0x08, 0x50, 0xe9, 0xd7, 0xd4, 0xfb, 0xb5, 0xff, 0x9f, 0x24, 0x09, 0x01, - 0x42, 0x4a, 0xa2, 0x64, 0xd5, 0x55, 0x7b, 0x7f, 0xda, 0x7d, 0x4f, 0x00, - 0x20, 0x04, 0x00, 0x80, 0x00, 0xa0, 0x2a, 0x13, 0x84, 0x6a, 0x55, 0xff, - 0x1d, 0x48, 0x8a, 0x00, 0x94, 0x24, 0x8a, 0xc8, 0xaa, 0x42, 0x20, 0x5d, - 0xf5, 0xff, 0x5f, 0x01, 0x00, 0x02, 0x01, 0x00, 0x20, 0xa2, 0x4a, 0x1a, - 0x82, 0x56, 0xda, 0xbd, 0x3f, 0x92, 0x92, 0x00, 0x90, 0x92, 0x00, 0x40, - 0x95, 0x6a, 0xf4, 0x55, 0x6d, 0xff, 0xd6, 0x00, 0x00, 0x0a, 0x04, 0x20, - 0x14, 0x49, 0x4b, 0xaa, 0xaa, 0x56, 0xf5, 0xff, 0xbf, 0xab, 0xa4, 0x00, - 0x20, 0x89, 0x40, 0x80, 0xaa, 0xaa, 0xaa, 0xaa, 0xde, 0xbf, 0xeb, 0x03, - 0x00, 0x02, 0x04, 0x02, 0x0a, 0x10, 0x2b, 0x2a, 0x55, 0x5b, 0xf5, 0xff, - 0xd7, 0x2f, 0x92, 0x00, 0x10, 0x28, 0x21, 0x01, 0x56, 0x95, 0xa0, 0x56, - 0xdf, 0xef, 0xea, 0x87, 0x40, 0x0a, 0x42, 0x41, 0x00, 0x90, 0xaa, 0x52, - 0xb6, 0xad, 0xfa, 0xff, 0xd5, 0x2f, 0x14, 0x00, 0x00, 0x04, 0x95, 0x04, - 0xaa, 0xac, 0x55, 0x6b, 0xff, 0xb7, 0xea, 0x9f, 0x40, 0x02, 0x28, 0x51, - 0x00, 0x40, 0x58, 0xd5, 0xda, 0xd6, 0x6e, 0x7f, 0xf9, 0x3f, 0x12, 0x04, - 0x02, 0x04, 0x49, 0x25, 0x55, 0xaa, 0x77, 0xab, 0xff, 0x2b, 0xfd, 0x3f, - 0x48, 0x01, 0x20, 0x41, 0x00, 0x00, 0x58, 0xa9, 0xda, 0xea, 0xfd, 0xaf, - 0xfa, 0xff, 0x02, 0x04, 0x08, 0x14, 0x29, 0x49, 0x52, 0x55, 0x55, 0x55, - 0xff, 0x8d, 0xfe, 0x3f, 0xa8, 0x00, 0x02, 0x41, 0x00, 0x02, 0xa0, 0xa2, - 0xaa, 0xea, 0xff, 0x53, 0xfd, 0xff, 0x02, 0x04, 0x50, 0x04, 0x25, 0xa8, - 0x54, 0x49, 0x52, 0xb5, 0xbf, 0x8a, 0xfe, 0xff, 0xa9, 0x08, 0x04, 0x50, - 0x80, 0x02, 0xa1, 0x2a, 0x95, 0xea, 0xff, 0xa1, 0xff, 0xff, 0x03, 0x02, - 0x90, 0x02, 0x09, 0x08, 0x44, 0x49, 0x52, 0xbd, 0x7f, 0xca, 0xff, 0xff, - 0x2b, 0x09, 0x04, 0x48, 0x40, 0x82, 0x90, 0x56, 0xa9, 0xf6, 0xbf, 0xd0, - 0xff, 0xff, 0x47, 0x00, 0x50, 0x02, 0x15, 0x11, 0x40, 0x95, 0xaa, 0xfd, - 0x2f, 0xe9, 0xff, 0xff, 0x8f, 0x0a, 0x84, 0x50, 0x40, 0x84, 0x14, 0xaa, - 0x6a, 0xff, 0x5f, 0xf2, 0xff, 0xff, 0x7f, 0x00, 0x10, 0x02, 0x09, 0x10, - 0x40, 0x7d, 0xf7, 0xff, 0x0b, 0xfc, 0xff, 0xff, 0xaf, 0x02, 0x84, 0x50, - 0x42, 0x85, 0x12, 0xd0, 0xdd, 0xff, 0xa7, 0xf2, 0xff, 0xff, 0xff, 0x04, - 0x00, 0x0a, 0x08, 0x10, 0x48, 0xf8, 0xff, 0xff, 0x0a, 0xfe, 0xff, 0xff, - 0x7f, 0x03, 0xa4, 0x80, 0xa2, 0x8a, 0x02, 0x68, 0xff, 0xff, 0x52, 0xfd, - 0xff, 0xff, 0xff, 0x07, 0x00, 0x2a, 0x08, 0x20, 0x28, 0xdc, 0xff, 0x5f, - 0x05, 0xff, 0xff, 0xff, 0xff, 0x0d, 0x92, 0x40, 0x22, 0x09, 0x02, 0xea, - 0xfb, 0xaf, 0x48, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x12, 0x81, 0xa0, - 0x48, 0x9c, 0x6e, 0x93, 0xa2, 0xff, 0xff, 0xff, 0xff, 0x07, 0xa8, 0x40, - 0x28, 0x0a, 0x02, 0x74, 0xb5, 0x45, 0x81, 0xff, 0xff, 0xff, 0xff, 0x0f, - 0x02, 0x0a, 0x81, 0x20, 0x08, 0xae, 0xaa, 0x90, 0xe8, 0xff, 0xff, 0xff, - 0xff, 0x0f, 0x90, 0x40, 0x28, 0x88, 0x12, 0x58, 0x15, 0x50, 0xd0, 0xff, - 0xff, 0xff, 0xff, 0x0f, 0x44, 0x0a, 0x41, 0x21, 0x08, 0xae, 0x04, 0x14, - 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x40, 0x14, 0x88, 0x04, 0xba, - 0x02, 0x28, 0xe8, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x42, 0x15, 0x41, 0x21, - 0x05, 0xad, 0x00, 0x05, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x40, - 0x24, 0x8a, 0x0e, 0x36, 0x00, 0x0a, 0xf4, 0xff, 0xff, 0xff, 0xff, 0x0f, - 0x42, 0x25, 0x90, 0xd0, 0x8b, 0xc2, 0x41, 0x05, 0xfc, 0xff, 0xff, 0xff, - 0xff, 0x0f, 0x10, 0x08, 0x05, 0xe8, 0x8e, 0x58, 0x80, 0x02, 0xfa, 0xff, - 0xff, 0xff, 0xff, 0x0f, 0x4a, 0x20, 0xa8, 0xba, 0x0b, 0x2b, 0x51, 0x01, - 0xfe, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x8a, 0x02, 0xe8, 0xaf, 0x84, - 0x90, 0x04, 0xfd, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x52, 0x21, 0x54, 0xbf, - 0x1f, 0x15, 0xa5, 0x02, 0xfe, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x08, - 0x01, 0xfa, 0xb6, 0xa4, 0x52, 0x40, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, - 0x4a, 0xa2, 0x54, 0xef, 0x5f, 0x4b, 0xa4, 0x80, 0xff, 0xff, 0xff, 0xff, - 0xff, 0x0f, 0x80, 0x10, 0x82, 0xfe, 0xbf, 0x92, 0x52, 0x42, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x0f, 0x12, 0x42, 0xa8, 0xbf, 0x1f, 0x24, 0x80, 0xa0, - 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x84, 0x28, 0x8a, 0xf7, 0x37, 0x80, - 0x52, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x82, 0xe0, 0xff, - 0x1f, 0x00, 0x20, 0xe1, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x84, 0x28, - 0xca, 0xff, 0x1f, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, - 0x10, 0x42, 0xf0, 0xfd, 0x1b, 0x00, 0x50, 0xf0, 0xff, 0xff, 0xff, 0xff, - 0xff, 0x0f, 0xa4, 0x10, 0xc5, 0xff, 0x1f, 0x00, 0x00, 0xe0, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x0f, 0x00, 0x22, 0xf8, 0xff, 0x0e, 0x00, 0x00, 0xf0, - 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0xaa, 0x88, 0xe2, 0xff, 0x0f, 0x10, - 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x25, 0xfa, 0xff, - 0x0f, 0x01, 0x11, 0xfd, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0xff, 0xfb, - 0xfb, 0xff, 0x7f, 0x5d, 0xd5, 0xfa, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f}; diff --git a/library/demos/images/ouster.png b/library/demos/images/ouster.png Binary files differnew file mode 100644 index 0000000..259b8f9 --- /dev/null +++ b/library/demos/images/ouster.png diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 85bf5f3..000e4cb 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -31,8 +31,8 @@ canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \ -relief sunken -borderwidth 2 \ -xscrollcommand "$w.frame.hscroll set" \ -yscrollcommand "$w.frame.vscroll set" -scrollbar $w.frame.vscroll -command "$c yview" -scrollbar $w.frame.hscroll -orient horiz -command "$c xview" +ttk::scrollbar $w.frame.vscroll -command "$c yview" +ttk::scrollbar $w.frame.hscroll -orient horiz -command "$c xview" grid $c -in $w.frame \ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news @@ -126,8 +126,8 @@ $c create text 25.5c 11c -anchor w -font $font1 -fill $blue \ -text "Several lines,\n each centered\nindividually,\nand all anchored\nat the left edge." \ -justify center -tags item $c create rectangle 24.9c 13.9c 25.1c 14.1c -$c create text 25c 14c -font $font2 -anchor c -fill $red -stipple gray50 \ - -text "Stippled characters" -tags item +$c create text 25c 14c -font $font2 -anchor c -fill $red -angle 15 \ + -text "Angled characters" -tags item $c create text 5c 16.2c -text Arcs -anchor n $c create arc 0.5c 17c 7c 20c -fill $green -outline black \ @@ -140,9 +140,13 @@ $c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \ $c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \ -fill $blue -outline {} -start 45 -extent 270 -tags item -$c create text 15c 16.2c -text Bitmaps -anchor n -$c create bitmap 13c 20c -tags item \ - -bitmap @[file join $tk_demoDirectory images face.xbm] +image create photo items.ousterhout \ + -file [file join $tk_demoDirectory images ouster.png] +image create photo items.ousterhout.active -format "png -alpha 0.5" \ + -file [file join $tk_demoDirectory images ouster.png] +$c create text 15c 16.2c -text "Bitmaps and Images" -anchor n +$c create image 13c 20c -tags item -image items.ousterhout \ + -activeimage items.ousterhout.active $c create bitmap 17c 18.5c -tags item \ -bitmap @[file join $tk_demoDirectory images noletter.xbm] $c create bitmap 17c 21.5c -tags item \ @@ -169,7 +173,7 @@ bind $c <2> "$c scan mark %x %y" bind $c <B2-Motion> "$c scan dragto %x %y" bind $c <3> "itemMark $c %x %y" bind $c <B3-Motion> "itemStroke $c %x %y" -bind $c <Control-f> "itemsUnderArea $c" +bind $c <<NextChar>> "itemsUnderArea $c" bind $c <1> "itemStartDrag $c %x %y" bind $c <B1-Motion> "itemDrag $c %x %y" @@ -183,15 +187,18 @@ proc itemEnter {c} { return } set type [$c type current] - if {$type == "window"} { + if {$type == "window" || $type == "image"} { set restoreCmd {} return - } - if {$type == "bitmap"} { + } elseif {$type == "bitmap"} { set bg [lindex [$c itemconf current -background] 4] set restoreCmd [list $c itemconfig current -background $bg] $c itemconfig current -background SteelBlue2 return + } elseif {$type == "image"} { + set restoreCmd [list $c itemconfig current -state normal] + $c itemconfig current -state active + return } set fill [lindex [$c itemconfig current -fill] 4] if {(($type == "rectangle") || ($type == "oval") || ($type == "arc")) @@ -279,6 +286,6 @@ proc itemDrag {c x y} { # is invoked. proc butPress {w color} { - set i [$w create text 25c 18.1c -text "Ouch!!" -fill $color -anchor n] + set i [$w create text 25c 18.1c -text "Oooohhh!!" -fill $color -anchor n] after 500 "$w delete $i" } diff --git a/library/demos/ixset b/library/demos/ixset index 06b644d..ee6e072 100644 --- a/library/demos/ixset +++ b/library/demos/ixset @@ -186,12 +186,12 @@ proc createwindows {} { # frame .buttons - button .buttons.ok -default active -command ok -text "Ok" + button .buttons.ok -default active -command ok -text "Ok" button .buttons.apply -default normal -command apply -text "Apply" \ -state disabled button .buttons.cancel -default normal -command cancel -text "Cancel" \ -state disabled - button .buttons.quit -default normal -command quit -text "Quit" + button .buttons.quit -default normal -command quit -text "Quit" pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \ -side left -expand yes -pady 5 diff --git a/library/demos/knightstour.tcl b/library/demos/knightstour.tcl index b52e38f..6113db2 100644 --- a/library/demos/knightstour.tcl +++ b/library/demos/knightstour.tcl @@ -61,6 +61,8 @@ proc Next {square} { set minimum $count set nextSquare $testSquare } elseif {$count == $minimum} { + # to remove the enhancement to Warnsdorff's rule + # remove the next line: set nextSquare [Edgemost $nextSquare $testSquare] } } @@ -92,7 +94,7 @@ proc MovePiece {dlg last square} { $dlg.f.txt see end $dlg.f.c itemconfigure [expr {1+$last}] -state normal -outline black $dlg.f.c itemconfigure [expr {1+$square}] -state normal -outline red - $dlg.f.c coords knight [lrange [$dlg.f.c coords [expr {1+$square}]] 0 1] + $dlg.f.c moveto knight {*}[lrange [$dlg.f.c coords [expr {1+$square}]] 0 1] lappend visited $square set next [Next $square] if {$next ne -1} { @@ -125,8 +127,8 @@ proc Tour {dlg {square {}}} { $dlg.f.c itemconfigure $n -state disabled -outline black } if {$square eq {}} { - set square [expr {[$dlg.f.c find closest \ - {*}[$dlg.f.c coords knight] 0 65]-1}] + set coords [lrange [$dlg.f.c coords knight] 0 1] + set square [expr {[$dlg.f.c find closest {*}$coords 0 65]-1}] } variable initial $square after idle [list MovePiece $dlg $initial $initial] @@ -161,7 +163,7 @@ proc DragMotion {w x y} { } proc DragEnd {w x y} { set square [$w find closest $x $y 0 65] - $w coords selected [lrange [$w coords $square] 0 1] + $w moveto selected {*}[lrange [$w coords $square] 0 1] $w dtag selected variable dragging ; unset dragging } @@ -201,14 +203,25 @@ proc CreateGUI {} { -width 2 -state disabled } } - catch {eval font create KnightFont -size -24} - $c create text 0 0 -font KnightFont -text "\u265e" \ - -anchor nw -tags knight -fill black -activefill "#600000" - $c coords knight [lrange [$c coords [expr {1 + int(rand() * 64)}]] 0 1] + if {[tk windowingsystem] ne "x11"} { + catch {eval font create KnightFont -size -24} + $c create text 0 0 -font KnightFont -text "\u265e" \ + -anchor nw -tags knight -fill black -activefill "#600000" + } else { + # On X11 we cannot reliably tell if the \u265e glyph is available + # so just use a polygon + set pts { + 2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16 + 2 17 4 14 5 15 3 17 5 17 9 14 10 15 5 21 + } + $c create polygon $pts -tag knight -offset 8 \ + -fill black -activefill "#600000" + } + $c moveto knight {*}[lrange [$c coords [expr {1 + int(rand() * 64)}]] 0 1] $c bind knight <ButtonPress-1> [namespace code [list DragStart %W %x %y]] $c bind knight <Motion> [namespace code [list DragMotion %W %x %y]] $c bind knight <ButtonRelease-1> [namespace code [list DragEnd %W %x %y]] - + grid $c $f.txt $f.vs -sticky news grid rowconfigure $f 0 -weight 1 grid columnconfigure $f 1 -weight 1 @@ -231,7 +244,7 @@ proc CreateGUI {} { if {[info exists ::widgetDemo]} { grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew } - + grid rowconfigure $dlg 0 -weight 1 grid columnconfigure $dlg 0 -weight 1 diff --git a/library/demos/label.tcl b/library/demos/label.tcl index a5cab10..13463f7 100644 --- a/library/demos/label.tcl +++ b/library/demos/label.tcl @@ -16,7 +16,7 @@ wm title $w "Label Demonstration" wm iconname $w "label" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left -text "Five labels are displayed below: three textual ones on the left, and a bitmap label and a text label on the right. Labels are pretty boring because you can't do anything with them." +label $w.msg -font $font -wraplength 4i -justify left -text "Five labels are displayed below: three textual ones on the left, and an image label and a text label on the right. Labels are pretty boring because you can't do anything with them." pack $w.msg -side top ## See Code / Dismiss buttons @@ -33,7 +33,8 @@ label $w.left.l3 -text "Third label, sunken" -relief sunken pack $w.left.l1 $w.left.l2 $w.left.l3 -side top -expand yes -pady 2 -anchor w # Main widget program sets variable tk_demoDirectory -label $w.right.bitmap -borderwidth 2 -relief sunken \ - -bitmap @[file join $tk_demoDirectory images face.xbm] -label $w.right.caption -text "Tcl/Tk Proprietor" -pack $w.right.bitmap $w.right.caption -side top +image create photo label.ousterhout \ + -file [file join $tk_demoDirectory images ouster.png] +label $w.right.picture -borderwidth 2 -relief sunken -image label.ousterhout +label $w.right.caption -text "Tcl/Tk Creator" +pack $w.right.picture $w.right.caption -side top diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl index 21dcf29..7a4dd4c 100644 --- a/library/demos/mclist.tcl +++ b/library/demos/mclist.tcl @@ -8,7 +8,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .mclist catch {destroy $w} @@ -27,19 +26,22 @@ pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x ttk::frame $w.container ttk::treeview $w.tree -columns {country capital currency} -show headings \ -yscroll "$w.vsb set" -xscroll "$w.hsb set" -if {[tk windowingsystem] ne "aqua"} { - ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" - ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" -} else { - scrollbar $w.vsb -orient vertical -command "$w.tree yview" - scrollbar $w.hsb -orient horizontal -command "$w.tree xview" -} +ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" +ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" pack $w.container -fill both -expand 1 grid $w.tree $w.vsb -in $w.container -sticky nsew grid $w.hsb -in $w.container -sticky nsew grid column $w.container 0 -weight 1 grid row $w.container 0 -weight 1 +image create photo upArrow -data { + R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAImhI+ + py+1LIsJHiBAh+BgmiEAJQITgW6DgUQIAECH4JN8IPqYuNxUAOw==} +image create photo downArrow -data { + R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAInhI+ + py+1I4ocQ/IgDEYIPgYJICUCE4F+YIBolEoKPEJKZmVJK6ZACADs=} +image create photo noArrow -height 14 -width 14 + ## The data we're going to insert set data { Argentina {Buenos Aires} ARS @@ -60,11 +62,15 @@ set data { } ## Code to insert the data nicely -set font [ttk::style lookup [$w.tree cget -style] -font] +set font [ttk::style lookup Heading -font] foreach col {country capital currency} name {Country Capital Currency} { - $w.tree heading $col -command [list SortBy $w.tree $col 0] -text $name - $w.tree column $col -width [font measure $font $name] + $w.tree heading $col -text $name -image noArrow -anchor w \ + -command [list SortBy $w.tree $col 0] + $w.tree column $col -width [expr { + [font measure $font $name] + [image width noArrow] + 5 + }] } +set font [ttk::style lookup Treeview -font] foreach {country capital currency} $data { $w.tree insert {} end -values [list $country $capital $currency] foreach col {country capital currency} { @@ -82,7 +88,7 @@ proc SortBy {tree col direction} { set s [$tree heading $c state] if {("selected" in $s || "alternate" in $s) && $col ne $c} { # Sorted column has changed - $tree heading $c state {!selected !alternate !user1} + $tree heading $c -image noArrow state {!selected !alternate !user1} set direction [expr {"alternate" in $s}] } } @@ -104,8 +110,10 @@ proc SortBy {tree col direction} { # Switch the heading so that it will sort in the opposite direction $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] \ state [expr {$direction?"!selected alternate":"selected !alternate"}] - if {[tk windowingsystem] eq "aqua"} { + if {[ttk::style theme use] eq "aqua"} { # Aqua theme displays native sort arrows when user1 state is set $tree heading $col state "user1" + } else { + $tree heading $col -image [expr {$direction?"upArrow":"downArrow"}] } } diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl index e19df57..e32b54f 100644 --- a/library/demos/menu.tcl +++ b/library/demos/menu.tcl @@ -16,7 +16,7 @@ wm title $w "Menu Demonstration" wm iconname $w "menu" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left +label $w.msg -font $font -wraplength 4i -justify left if {[tk windowingsystem] eq "aqua"} { catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1} $w.msg configure -text "This window has a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by selecting the first item in the menu." diff --git a/library/demos/menubu.tcl b/library/demos/menubu.tcl index 86326b5..96e3b15 100644 --- a/library/demos/menubu.tcl +++ b/library/demos/menubu.tcl @@ -21,7 +21,7 @@ pack $w.body -expand 1 -fill both if {[tk windowingsystem] eq "aqua"} {catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1}} menubutton $w.body.below -text "Below" -underline 0 -direction below -menu $w.body.below.m -relief raised -menu $w.body.below.m -tearoff 0 +menu $w.body.below.m -tearoff 0 $w.body.below.m add command -label "Below menu: first item" -command "puts \"You have selected the first item from the Below menu.\"" $w.body.below.m add command -label "Below menu: second item" -command "puts \"You have selected the second item from the Below menu.\"" grid $w.body.below -row 0 -column 1 -sticky n diff --git a/library/demos/msgbox.tcl b/library/demos/msgbox.tcl index a8f7d17..2c2cc2d 100644 --- a/library/demos/msgbox.tcl +++ b/library/demos/msgbox.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .msgbox catch {destroy $w} @@ -24,7 +23,7 @@ pack [addSeeDismiss $w.buttons $w {} { }] -side bottom -fill x #pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1 -frame $w.left +frame $w.left frame $w.right pack $w.left $w.right -side left -expand yes -fill y -pady .5c -padx .5c @@ -57,7 +56,7 @@ proc showMessageBox {w} { set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \ -title Message -parent $w\ -message "This is a \"$msgboxType\" type messagebox with the \"$msgboxIcon\" icon"] - + tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\ -parent $w } diff --git a/library/demos/nl.msg b/library/demos/nl.msg index b17ceaa..61832d8 100644 --- a/library/demos/nl.msg +++ b/library/demos/nl.msg @@ -18,7 +18,7 @@ ::msgcat::mcset nl "Demo code: %s" "Code van Demo %s" ::msgcat::mcset nl "About Widget Demo" "Over deze demonstratie" ::msgcat::mcset nl "Tk widget demonstration" "Demonstratie van Tk widgets" -::msgcat::mcset nl "Copyright (c) %s" "Copyright (c) %s" +::msgcat::mcset nl "Copyright \u00a9 %s" ::msgcat::mcset nl "Tk Widget Demonstrations" "Demostratie van Tk widgets" ::msgcat::mcset nl "This application provides a front end for several short scripts" \ diff --git a/library/demos/paned2.tcl b/library/demos/paned2.tcl index f481d14..c549249 100644 --- a/library/demos/paned2.tcl +++ b/library/demos/paned2.tcl @@ -54,7 +54,7 @@ listbox $f.list -listvariable paneList -yscrollcommand "$f.scr set" # Invert the first item to highlight it $f.list itemconfigure 0 \ -background [$f.list cget -fg] -foreground [$f.list cget -bg] -scrollbar $f.scr -orient vertical -command "$f.list yview" +ttk::scrollbar $f.scr -orient vertical -command "$f.list yview" pack $f.scr -side right -fill y pack $f.list -fill both -expand 1 @@ -62,8 +62,8 @@ pack $f.list -fill both -expand 1 set f [frame $w.pane.bottom] text $f.text -xscrollcommand "$f.xscr set" -yscrollcommand "$f.yscr set" \ -width 30 -height 8 -wrap none -scrollbar $f.xscr -orient horizontal -command "$f.text xview" -scrollbar $f.yscr -orient vertical -command "$f.text yview" +ttk::scrollbar $f.xscr -orient horizontal -command "$f.text xview" +ttk::scrollbar $f.yscr -orient vertical -command "$f.text yview" grid $f.text $f.yscr -sticky nsew grid $f.xscr -sticky nsew grid columnconfigure $f 0 -weight 1 diff --git a/library/demos/pendulum.tcl b/library/demos/pendulum.tcl index 2e3d459..d344d8d 100644 --- a/library/demos/pendulum.tcl +++ b/library/demos/pendulum.tcl @@ -49,9 +49,9 @@ for {set i 90} {$i>=0} {incr i -10} { # Coordinates of these items don't matter; they will be set properly below $w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i } -# FIXME: UNICODE labels -$w.k create text 0 0 -anchor ne -text "q" -font {Symbol 8} -tags label_theta -$w.k create text 0 0 -anchor ne -text "dq" -font {Symbol 8} -tags label_dtheta + +$w.k create text 0 0 -anchor ne -text "\u03b8" -tags label_theta +$w.k create text 0 0 -anchor ne -text "\u03b4\u03b8" -tags label_dtheta pack $w.k -in $w.p.l2 -fill both -expand true # Initialize some variables diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl index fb8ab4c..4f7f955 100644 --- a/library/demos/puzzle.tcl +++ b/library/demos/puzzle.tcl @@ -54,7 +54,7 @@ pack $btns -side bottom -fill x scrollbar $w.s # The button metrics are a bit bigger in Aqua, and since we are -# using place which doesn't autosize, then we need to have a +# using place which doesn't autosize, then we need to have a # slightly larger frame here... if {[tk windowingsystem] eq "aqua"} { diff --git a/library/demos/sayings.tcl b/library/demos/sayings.tcl index 4d26ffe..aa3479c 100644 --- a/library/demos/sayings.tcl +++ b/library/demos/sayings.tcl @@ -28,8 +28,8 @@ frame $w.frame -borderwidth 10 pack $w.frame -side top -expand yes -fill both -padx 1c -scrollbar $w.frame.yscroll -command "$w.frame.list yview" -scrollbar $w.frame.xscroll -orient horizontal \ +ttk::scrollbar $w.frame.yscroll -command "$w.frame.list yview" +ttk::scrollbar $w.frame.xscroll -orient horizontal \ -command "$w.frame.list xview" listbox $w.frame.list -width 20 -height 10 -setgrid 1 \ -yscroll "$w.frame.yscroll set" -xscroll "$w.frame.xscroll set" diff --git a/library/demos/search.tcl b/library/demos/search.tcl index 9f44e16..a1a3d7f 100644 --- a/library/demos/search.tcl +++ b/library/demos/search.tcl @@ -109,7 +109,7 @@ pack $w.string.button -side left -pady 5 -padx 10 bind $w.string.entry <Return> "textSearch $w.text \$searchString search" text $w.text -yscrollcommand "$w.scroll set" -setgrid true -scrollbar $w.scroll -command "$w.text yview" +ttk::scrollbar $w.scroll -command "$w.text yview" pack $w.file $w.string -side top -fill x pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/square b/library/demos/square index 08c362b..1d7eb20 100644 --- a/library/demos/square +++ b/library/demos/square @@ -7,7 +7,7 @@ exec wish "$0" ${1+"$@"} # widget. It's only usable in the "tktest" application or if Tk has # been compiled with tkSquare.c. This demo arranges the following # bindings for the widget: -# +# # Button-1 press/drag: moves square to mouse # "a": toggle size animation on/off diff --git a/library/demos/states.tcl b/library/demos/states.tcl index e76540d..92b1f1e 100644 --- a/library/demos/states.tcl +++ b/library/demos/states.tcl @@ -26,7 +26,7 @@ pack $btns -side bottom -fill x frame $w.frame -borderwidth .5c pack $w.frame -side top -expand yes -fill y -scrollbar $w.frame.scroll -command "$w.frame.list yview" +ttk::scrollbar $w.frame.scroll -command "$w.frame.list yview" listbox $w.frame.list -yscroll "$w.frame.scroll set" -setgrid 1 -height 12 pack $w.frame.scroll -side right -fill y pack $w.frame.list -side left -expand 1 -fill both diff --git a/library/demos/style.tcl b/library/demos/style.tcl index 614ea1f..a529a03 100644 --- a/library/demos/style.tcl +++ b/library/demos/style.tcl @@ -26,7 +26,7 @@ set family Courier text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ -width 70 -height 32 -wrap word -font "$family 12" -scrollbar $w.scroll -command "$w.text yview" +ttk::scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/text.tcl b/library/demos/text.tcl index 1b5f3b9..d1801d1 100644 --- a/library/demos/text.tcl +++ b/library/demos/text.tcl @@ -17,14 +17,39 @@ wm iconname $w "text" positionWindow $w ## See Code / Dismiss buttons -set btns [addSeeDismiss $w.buttons $w] +set btns [addSeeDismiss $w.buttons $w {} \ + {ttk::button $w.buttons.fontchooser -command fontchooserToggle}] pack $btns -side bottom -fill x text $w.text -yscrollcommand [list $w.scroll set] -setgrid 1 \ -height 30 -undo 1 -autosep 1 -scrollbar $w.scroll -command [list $w.text yview] +ttk::scrollbar $w.scroll -command [list $w.text yview] pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both + +# TIP 324 Demo: [tk fontchooser] +proc fontchooserToggle {} { + tk fontchooser [expr {[tk fontchooser configure -visible] ? + "hide" : "show"}] +} +proc fontchooserVisibility {w} { + $w configure -text [expr {[tk fontchooser configure -visible] ? + "Hide Font Dialog" : "Show Font Dialog"}] +} +proc fontchooserFocus {w} { + tk fontchooser configure -font [$w cget -font] \ + -command [list fontchooserFontSel $w] +} +proc fontchooserFontSel {w font args} { + $w configure -font [font actual $font] +} +tk fontchooser configure -parent $w +bind $w.text <FocusIn> [list fontchooserFocus $w.text] +fontchooserVisibility $w.buttons.fontchooser +bind $w <<TkFontchooserVisibility>> [list \ + fontchooserVisibility $w.buttons.fontchooser] +focus $w.text + $w.text insert 0.0 \ {This window is a text widget. It displays one or more lines of text and allows you to edit the text. Here is a summary of the things you diff --git a/library/demos/textpeer.tcl b/library/demos/textpeer.tcl index e94284e..83e8e14 100644 --- a/library/demos/textpeer.tcl +++ b/library/demos/textpeer.tcl @@ -36,7 +36,7 @@ proc makeClone {w parent} { global count set t [$parent peer create $w.text[incr count] -yscroll "$w.sb$count set"\ -height 10 -wrap word] - set sb [scrollbar $w.sb$count -command "$t yview" -orient vertical] + set sb [ttk::scrollbar $w.sb$count -command "$t yview" -orient vertical] set b1 [button $w.clone$count -command "makeClone $w $t" \ -text "Make Peer"] set b2 [button $w.kill$count -command "killClone $w $count" \ diff --git a/library/demos/tree.tcl b/library/demos/tree.tcl index 14d5db8..71c32c1 100644 --- a/library/demos/tree.tcl +++ b/library/demos/tree.tcl @@ -8,7 +8,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .tree catch {destroy $w} @@ -72,13 +71,8 @@ proc populateTree {tree node} { ## Create the tree and set it up ttk::treeview $w.tree -columns {fullpath type size} -displaycolumns {size} \ -yscroll "$w.vsb set" -xscroll "$w.hsb set" -if {[tk windowingsystem] ne "aqua"} { - ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" - ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" -} else { - scrollbar $w.vsb -orient vertical -command "$w.tree yview" - scrollbar $w.hsb -orient horizontal -command "$w.tree xview" -} +ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" +ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" $w.tree heading \#0 -text "Directory Structure" $w.tree heading size -text "File Size" $w.tree column size -stretch 0 -width 70 diff --git a/library/demos/ttkbut.tcl b/library/demos/ttkbut.tcl index 66ff1d7..904cd31 100644 --- a/library/demos/ttkbut.tcl +++ b/library/demos/ttkbut.tcl @@ -9,7 +9,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttkbut catch {destroy $w} diff --git a/library/demos/ttkmenu.tcl b/library/demos/ttkmenu.tcl index c01c9af..0084dd6 100644 --- a/library/demos/ttkmenu.tcl +++ b/library/demos/ttkmenu.tcl @@ -8,7 +8,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttkmenu catch {destroy $w} diff --git a/library/demos/ttknote.tcl b/library/demos/ttknote.tcl index 5683892..50a9258 100644 --- a/library/demos/ttknote.tcl +++ b/library/demos/ttknote.tcl @@ -8,7 +8,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttknote catch {destroy $w} @@ -53,10 +52,6 @@ ttk::frame $w.note.editor $w.note add $w.note.editor -text "Text Editor" -underline 0 text $w.note.editor.t -width 40 -height 10 -wrap char \ -yscroll "$w.note.editor.s set" -if {[tk windowingsystem] ne "aqua"} { - ttk::scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview" -} else { - scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview" -} +ttk::scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview" pack $w.note.editor.s -side right -fill y -padx {0 2} -pady 2 pack $w.note.editor.t -fill both -expand 1 -pady 2 -padx {2 0} diff --git a/library/demos/ttkpane.tcl b/library/demos/ttkpane.tcl index a4d5738..7575d76 100644 --- a/library/demos/ttkpane.tcl +++ b/library/demos/ttkpane.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttkpane catch {destroy $w} @@ -51,7 +50,7 @@ proc every {delay script} { uplevel #0 $script after $delay [list every $delay $script] } -set zones { +set testzones { :Europe/Berlin :America/Argentina/Buenos_Aires :Africa/Johannesburg @@ -65,7 +64,13 @@ set zones { } # Force a pre-load of all the timezones needed; otherwise can end up # poor-looking synch problems! -foreach zone $zones {clock format 0 -timezone $zone} +set zones {} +foreach zone $testzones { + if {![catch {clock format 0 -timezone $zone}]} { + lappend zones $zone + } +} +if {[llength $zones] < 2} { lappend zones -0200 :GMT :UTC +0200 } foreach zone $zones { set city [string map {_ " "} [regexp -inline {[^/]+$} $zone]] if {$i} { diff --git a/library/demos/ttkprogress.tcl b/library/demos/ttkprogress.tcl index 87765d7..8a72cf9 100644 --- a/library/demos/ttkprogress.tcl +++ b/library/demos/ttkprogress.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttkprogress catch {destroy $w} diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index e1d0b5b..bafb57e 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -25,7 +25,7 @@ set t $w.f.text text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ -height 35 -wrap word -highlightthickness 0 -borderwidth 0 pack $t -expand yes -fill both -scrollbar $w.scroll -command "$t yview" +ttk::scrollbar $w.scroll -command "$t yview" pack $w.scroll -side right -fill y panedwindow $w.pane pack $w.pane -expand yes -fill both @@ -162,11 +162,11 @@ $t window create end -window $t.smallP $t insert end "\n\nFinally, images fit comfortably in text widgets too:" $t image create end -image \ - [image create bitmap -file [file join $tk_demoDirectory images face.xbm]] + [image create photo -file [file join $tk_demoDirectory images ouster.png]] proc textWindBigB w { - $w configure -borderwidth 15 + $w configure -borderwidth 15 } proc textWindBigH w { @@ -193,7 +193,7 @@ proc textWindSmallP w { proc textWindOn w { catch {destroy $w.scroll2} set t $w.f.text - scrollbar $w.scroll2 -orient horizontal -command "$t xview" + ttk::scrollbar $w.scroll2 -orient horizontal -command "$t xview" pack $w.scroll2 -after $w.buttons -side bottom -fill x $t configure -xscrollcommand "$w.scroll2 set" -wrap none } @@ -230,7 +230,7 @@ proc createPlot {t} { $c create line 100 250 400 250 -width 2 $c create line 100 250 100 50 -width 2 $c create text 225 20 -text "A Simple Plot" -font $font -fill brown - + for {set i 0} {$i <= 10} {incr i} { set x [expr {100 + ($i*30)}] $c create line $x 250 $x 245 -width 2 @@ -241,7 +241,7 @@ proc createPlot {t} { $c create line 100 $y 105 $y -width 2 $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font } - + foreach point { {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} } { @@ -303,7 +303,7 @@ proc textMakePeer {parent} { set t [$parent peer create $w.f.text -yscrollcommand "$w.scroll set" \ -borderwidth 0 -highlightthickness 0] pack $t -expand yes -fill both - scrollbar $w.scroll -command "$t yview" + ttk::scrollbar $w.scroll -command "$t yview" pack $w.scroll -side right -fill y pack $w.f -expand yes -fill both } diff --git a/library/demos/unicodeout.tcl b/library/demos/unicodeout.tcl index 11cc933..faa9f90 100644 --- a/library/demos/unicodeout.tcl +++ b/library/demos/unicodeout.tcl @@ -9,26 +9,6 @@ if {![info exists widgetDemo]} { package require Tk -# On Windows, we need to determine whether the font system will render -# right-to-left text. - -if {[tk windowingsystem] eq {win32}} { - set rkey [join { - HKEY_LOCAL_MACHINE - SOFTWARE - Microsoft - {Windows NT} - CurrentVersion - LanguagePack - } \\] - set w32langs {} - if {![catch {package require registry}]} { - if {[catch {registry values $rkey} w32langs]} { - set w32langs {} - } - } -} - set w .unicodeout catch {destroy $w} toplevel $w @@ -50,11 +30,9 @@ pack $w.msg -side top set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x -pack [label $w.wait -text "Please wait while loading fonts..." \ - -font {Helvetica 12 italic}] -pack [frame $w.f] -expand 1 -fill both -padx 2m -pady 1m +## The frame that will contain the sample texts. +pack [frame $w.f] -side bottom -expand 1 -fill both -padx 2m -pady 1m grid columnconfigure $w.f 1 -weight 1 - set i 0 proc addSample {w language args} { global font i @@ -66,42 +44,87 @@ proc addSample {w language args} { grid configure $w.f.l$j -padx 1m } -# Processing when some characters are missing might take a while, so make -# sure we're displaying something in the meantime... +## A helper procedure that determines what form to use to express languages +## that have complex rendering rules... +proc usePresentationFormsFor {language} { + switch [tk windowingsystem] { + aqua { + # OSX wants natural character order; the renderer knows how to + # compose things for display for all languages. + return false + } + x11 { + # The X11 font renderers that Tk supports all know nothing about + # composing characters, so we need to use presentation forms. + return true + } + win32 { + # On Windows, we need to determine whether the font system will + # render right-to-left text. This varies by language! + try { + package require registry + set rkey [join { + HKEY_LOCAL_MACHINE + SOFTWARE + Microsoft + {Windows NT} + CurrentVersion + LanguagePack + } \\] + return [expr { + [string toupper $language] ni [registry values $rkey] + }] + } trap error {} { + # Cannot work it out, so use presentation forms. + return true + } + } + default { + # Default to using presentation forms. + return true + } + } +} +## Processing when some characters are not currently cached by the display +## engine might take a while, so make sure we're displaying something in the +## meantime... +pack [label $w.wait -text "Please wait while loading fonts..." \ + -font {Helvetica 12 italic}] set oldCursor [$w cget -cursor] $w conf -cursor watch update -if {[tk windowingsystem] eq {x11} - || (([tk windowingsystem] eq {win32}) && ({ARABIC} ni $w32langs))} { +## Add the samples... +if {[usePresentationFormsFor Arabic]} { # Using presentation forms (pre-layouted) addSample $w Arabic \ - "\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \ - "\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D" + "\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \ + "\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D" } else { # Using standard text characters addSample $w Arabic \ - "\u0627\u0644\u0643\u0644\u0645\u0629 " \ - "\u0627\u0644\u0639\u0631\u0628\u064A\u0629" + "\u0627\u0644\u0643\u0644\u0645\u0629 " \ + "\u0627\u0644\u0639\u0631\u0628\u064A\u0629" } -addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57" +addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57" addSample $w "Simpl. Chinese" "\u6C49\u8BED" +addSample $w French "Langue fran\u00E7aise" addSample $w Greek \ "\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \ "\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1" -if {[tk windowingsystem] eq {x11} - || (([tk windowingsystem] eq {win32}) && ({HEBREW} ni $w32langs))} { +if {[usePresentationFormsFor Hebrew]} { # Visual order (pre-layouted) addSample $w Hebrew \ - "\u05EA\u05D9\u05E8\u05D1\u05E2 " \ - "\u05D1\u05EA\u05DB" + "\u05EA\u05D9\u05E8\u05D1\u05E2 \u05D1\u05EA\u05DB" } else { # Standard logical order addSample $w Hebrew \ - "\u05DB\u05EA\u05D1 " \ - "\u05E2\u05D1\u05E8\u05D9\u05EA" + "\u05DB\u05EA\u05D1 \u05E2\u05D1\u05E8\u05D9\u05EA" } +addSample $w Hindi \ + "\u0939\u093f\u0928\u094d\u0926\u0940 \u092d\u093e\u0937\u093e" +addSample $w Icelandic "\u00CDslenska" addSample $w Japanese \ "\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \ "\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA" @@ -109,6 +132,6 @@ addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00" addSample $w Russian \ "\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A" -# We're done processing, so change things back to normal running... +## We're done processing, so change things back to normal running... destroy $w.wait $w conf -cursor $oldCursor diff --git a/library/demos/widget b/library/demos/widget index d58f086..7604341 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -13,7 +13,6 @@ exec wish "$0" ${1+"$@"} package require Tcl 8.5 package require Tk 8.5 package require msgcat -package require Ttk eval destroy [winfo child .] set tk_demoDirectory [file join [pwd] [file dirname [info script]]] @@ -146,7 +145,7 @@ catch { } ttk::frame .textFrame -scrollbar .s -orient vertical -command {.t yview} -takefocus 1 +ttk::scrollbar .s -orient vertical -command {.t yview} -takefocus 1 pack .s -in .textFrame -side right -fill y text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \ -font mainFont -setgrid 1 -highlightthickness 0 \ @@ -318,16 +317,13 @@ addFormattedText { @@demo image1 Two labels displaying images @@demo image2 A simple user interface for viewing images @@demo labelframe Labelled frames - @@new @@demo ttkbut The simple Themed Tk widgets @@subtitle Listboxes and Trees @@demo states The 50 states @@demo colors Colors: change the color scheme for the application @@demo sayings A collection of famous and infamous sayings - @@new @@demo mclist A multi-column list of countries - @@new @@demo tree A directory browser tree @@subtitle Entries, Spin-boxes and Combo-boxes @@ -335,7 +331,6 @@ addFormattedText { @@demo entry2 Entries with scrollbars @@demo entry3 Validated entries and password fields @@demo spin Spin-boxes - @@new @@demo combo Combo-boxes @@demo form Simple Rolodex-like form @@ -345,7 +340,6 @@ addFormattedText { @@demo bind Hypertext (tag bindings) @@demo twind A text widget with embedded windows and other features @@demo search A search tool built with a text widget - @@new @@demo textpeer Peering text widgets @@subtitle Canvases @@ -356,7 +350,6 @@ addFormattedText { @@demo ruler A ruler with adjustable tab stops @@demo floor A building floor plan @@demo cscroll A simple scrollable canvas - @@new @@demo knightstour A Knight's tour of the chess board @@subtitle Scales and Progress Bars @@ -364,38 +357,30 @@ addFormattedText { @@demo vscale Vertical scale @@new @@demo ttkscale Themed scale linked to a label with traces - @@new @@demo ttkprogress Progress bar @@subtitle Paned Windows and Notebooks @@demo paned1 Horizontal paned window @@demo paned2 Vertical paned window - @@new @@demo ttkpane Themed nested panes - @@new @@demo ttknote Notebook widget @@subtitle Menus and Toolbars @@demo menu Menus and cascades (sub-menus) @@demo menubu Menu-buttons - @@new @@demo ttkmenu Themed menu buttons - @@new @@demo toolbar Themed toolbar @@subtitle Common Dialogs @@demo msgbox Message boxes @@demo filebox File selection dialog @@demo clrpick Color picker + @@demo fontchoose Font selection dialog @@subtitle Animation - @@new @@demo anilabel Animated labels - @@new @@demo aniwave Animated wave - @@new @@demo pendulum Pendulum simulation - @@new @@demo goldberg A celebration of Rube Goldberg @@subtitle Miscellaneous @@ -580,8 +565,10 @@ proc showCode w { -xscrollcommand [list $t.xscroll set] \ -yscrollcommand [list $t.yscroll set] \ -setgrid 1 -highlightthickness 0 -pady 2 -padx 3] - scrollbar $t.xscroll -command [list $t.text xview] -orient horizontal - scrollbar $t.yscroll -command [list $t.text yview] -orient vertical + ttk::scrollbar $t.xscroll -command [list $t.text xview] \ + -orient horizontal + ttk::scrollbar $t.yscroll -command [list $t.text yview] \ + -orient vertical grid $t.text $t.yscroll -sticky news #grid $t.xscroll @@ -724,10 +711,10 @@ proc PrintTextWin32 {filename} { proc tkAboutDialog {} { tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \ -message [mc "Tk widget demonstration application"] -detail \ -"[mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}] -[mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}] -[mc {Copyright (c) %s} {2001-2007 Donal K. Fellows}] -[mc {Copyright (c) %s} {2002-2007 Daniel A. Steffen}]" +"[mc "Copyright \u00a9 %s" {1996-1997 Sun Microsystems, Inc.}] +[mc "Copyright \u00a9 %s" {1997-2000 Ajuba Solutions, Inc.}] +[mc "Copyright \u00a9 %s" {2001-2009 Donal K. Fellows}] +[mc "Copyright \u00a9 %s" {2002-2007 Daniel A. Steffen}]" } # Local Variables: diff --git a/library/dialog.tcl b/library/dialog.tcl index 26ec7e0..c751621 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -28,14 +28,14 @@ # bottom of the dialog box. proc ::tk_dialog {w title text bitmap default args} { - global tcl_platform variable ::tk::Priv # Check that $default was properly given if {[string is integer -strict $default]} { if {$default >= [llength $args]} { - return -code error "default button index greater than number of\ - buttons specified for tk_dialog" + return -code error -errorcode {TK DIALOG BAD_DEFAULT} \ + "default button index greater than number of buttons\ + specified for tk_dialog" } } elseif {"" eq $default} { set default -1 @@ -136,7 +136,7 @@ proc ::tk_dialog {w title text bitmap default args} { bind $w <Return> [list $w.button$default invoke] } bind $w <<PrevWindow>> [list bind $w <Return> {[tk_focusPrev %W] invoke}] - bind $w <Tab> [list bind $w <Return> {[tk_focusNext %W] invoke}] + bind $w <<NextWindow>> [list bind $w <Return> {[tk_focusNext %W] invoke}] # 5. Create a <Destroy> binding for the window that sets the # button variable to -1; this is needed in case something happens @@ -148,7 +148,7 @@ proc ::tk_dialog {w title text bitmap default args} { # so we know how big it wants to be, then center the window in the # display (Motif style) and de-iconify it. - ::tk::PlaceWindow $w + ::tk::PlaceWindow $w tkwait visibility $w # 7. Set a grab and claim the focus too. diff --git a/library/entry.tcl b/library/entry.tcl index c3e573d..6243d26 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -46,7 +46,6 @@ bind Entry <<Copy>> { } } bind Entry <<Paste>> { - global tcl_platform catch { if {[tk windowingsystem] ne "x11"} { catch { @@ -69,8 +68,8 @@ bind Entry <<PasteSelection>> { } bind Entry <<TraverseIn>> { - %W selection range 0 end - %W icursor end + %W selection range 0 end + %W icursor end } # Standard Motif bindings: @@ -119,45 +118,45 @@ bind Entry <Control-1> { %W icursor @%x } -bind Entry <Left> { +bind Entry <<PrevChar>> { tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } -bind Entry <Right> { +bind Entry <<NextChar>> { tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } -bind Entry <Shift-Left> { +bind Entry <<SelectPrevChar>> { tk::EntryKeySelect %W [expr {[%W index insert] - 1}] tk::EntrySeeInsert %W } -bind Entry <Shift-Right> { +bind Entry <<SelectNextChar>> { tk::EntryKeySelect %W [expr {[%W index insert] + 1}] tk::EntrySeeInsert %W } -bind Entry <Control-Left> { +bind Entry <<PrevWord>> { tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert] } -bind Entry <Control-Right> { +bind Entry <<NextWord>> { tk::EntrySetCursor %W [tk::EntryNextWord %W insert] } -bind Entry <Shift-Control-Left> { +bind Entry <<SelectPrevWord>> { tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert] tk::EntrySeeInsert %W } -bind Entry <Shift-Control-Right> { +bind Entry <<SelectNextWord>> { tk::EntryKeySelect %W [tk::EntryNextWord %W insert] tk::EntrySeeInsert %W } -bind Entry <Home> { +bind Entry <<LineStart>> { tk::EntrySetCursor %W 0 } -bind Entry <Shift-Home> { +bind Entry <<SelectLineStart>> { tk::EntryKeySelect %W 0 tk::EntrySeeInsert %W } -bind Entry <End> { +bind Entry <<LineEnd>> { tk::EntrySetCursor %W end } -bind Entry <Shift-End> { +bind Entry <<SelectLineEnd>> { tk::EntryKeySelect %W end tk::EntrySeeInsert %W } @@ -185,10 +184,10 @@ bind Entry <Control-Shift-space> { bind Entry <Shift-Select> { %W selection adjust insert } -bind Entry <Control-slash> { +bind Entry <<SelectAll>> { %W selection range 0 end } -bind Entry <Control-backslash> { +bind Entry <<SelectNone>> { %W selection clear } bind Entry <KeyPress> { @@ -208,9 +207,14 @@ bind Entry <Escape> {# nothing} bind Entry <Return> {# nothing} bind Entry <KP_Enter> {# nothing} bind Entry <Tab> {# nothing} +bind Entry <Prior> {# nothing} +bind Entry <Next> {# nothing} if {[tk windowingsystem] eq "aqua"} { bind Entry <Command-KeyPress> {# nothing} } +# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] +bind Entry <<NextLine>> {# nothing} +bind Entry <<PrevLine>> {# nothing} # On Windows, paste is done using Shift-Insert. Shift-Insert already # generates the <<Paste>> event, so we don't need to do anything here. @@ -222,31 +226,11 @@ if {[tk windowingsystem] ne "win32"} { # Additional emacs-like bindings: -bind Entry <Control-a> { - if {!$tk_strictMotif} { - tk::EntrySetCursor %W 0 - } -} -bind Entry <Control-b> { - if {!$tk_strictMotif} { - tk::EntrySetCursor %W [expr {[%W index insert] - 1}] - } -} bind Entry <Control-d> { if {!$tk_strictMotif} { %W delete insert } } -bind Entry <Control-e> { - if {!$tk_strictMotif} { - tk::EntrySetCursor %W end - } -} -bind Entry <Control-f> { - if {!$tk_strictMotif} { - tk::EntrySetCursor %W [expr {[%W index insert] + 1}] - } -} bind Entry <Control-h> { if {!$tk_strictMotif} { tk::EntryBackspace %W diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl new file mode 100644 index 0000000..8f91ade --- /dev/null +++ b/library/fontchooser.tcl @@ -0,0 +1,449 @@ +# fontchooser.tcl - +# +# A themeable Tk font selection dialog. See TIP #324. +# +# Copyright (C) 2008 Keith Vetter +# Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +namespace eval ::tk::fontchooser { + variable S + + set S(W) .__tk__fontchooser + set S(fonts) [lsort -dictionary [font families]] + set S(styles) [list \ + [::msgcat::mc "Regular"] \ + [::msgcat::mc "Italic"] \ + [::msgcat::mc "Bold"] \ + [::msgcat::mc "Bold Italic"] \ + ] + + set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} + set S(strike) 0 + set S(under) 0 + set S(first) 1 + set S(sampletext) [::msgcat::mc "AaBbYyZz01"] + set S(-parent) . + set S(-title) [::msgcat::mc "Font"] + set S(-command) "" + set S(-font) TkDefaultFont +} + +proc ::tk::fontchooser::Setup {} { + variable S + + # Canonical versions of font families, styles, etc. for easier searching + set S(fonts,lcase) {} + foreach font $S(fonts) { lappend S(fonts,lcase) [string tolower $font]} + set S(styles,lcase) {} + foreach style $S(styles) { lappend S(styles,lcase) [string tolower $style]} + set S(sizes,lcase) $S(sizes) + + ::ttk::style layout FontchooserFrame { + Entry.field -sticky news -border true -children { + FontchooserFrame.padding -sticky news + } + } + bind [winfo class .] <<ThemeChanged>> \ + [list +ttk::style layout FontchooserFrame \ + [ttk::style layout FontchooserFrame]] + + namespace ensemble create -map { + show ::tk::fontchooser::Show + hide ::tk::fontchooser::Hide + configure ::tk::fontchooser::Configure + } +} +::tk::fontchooser::Setup + +proc ::tk::fontchooser::Show {} { + variable S + if {![winfo exists $S(W)]} { + Create + wm transient $S(W) [winfo toplevel $S(-parent)] + tk::PlaceWindow $S(W) widget $S(-parent) + } + wm deiconify $S(W) +} + +proc ::tk::fontchooser::Hide {} { + variable S + wm withdraw $S(W) +} + +proc ::tk::fontchooser::Configure {args} { + variable S + + set specs { + {-parent "" "" . } + {-title "" "" ""} + {-font "" "" ""} + {-command "" "" ""} + } + + if {[llength $args] == 0} { + set result {} + foreach spec $specs { + foreach {name xx yy default} $spec break + lappend result $name \ + [expr {[info exists S($name)] ? $S($name) : $default}] + } + lappend result -visible \ + [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + return $result + } + if {[llength $args] == 1} { + set option [lindex $args 0] + if {[string equal $option "-visible"]} { + return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + } elseif {[info exists S($option)]} { + return $S($option) + } + return -code error -errorcode [list TK LOOKUP OPTION $option] \ + "bad option \"$option\": must be\ + -command, -font, -parent, -title or -visible" + } + + set cache [dict create -parent $S(-parent) -title $S(-title) \ + -font $S(-font) -command $S(-command)] + set r [tclParseConfigSpec [namespace which -variable S] $specs "" $args] + if {![winfo exists $S(-parent)]} { + set code [list TK LOOKUP WINDOW $S(-parent)] + set err "bad window path name \"$S(-parent)\"" + array set S $cache + return -code error -errorcode $code $err + } + if {[string trim $S(-title)] eq ""} { + set S(-title) [::msgcat::mc "Font"] + } + if {[winfo exists $S(W)] && [lsearch $args -font] != -1} { + Init $S(-font) + event generate $S(-parent) <<TkFontchooserFontChanged>> + } + return $r +} + +proc ::tk::fontchooser::Create {} { + variable S + set windowName __tk__fontchooser + if {$S(-parent) eq "."} { + set S(W) .$windowName + } else { + set S(W) $S(-parent).$windowName + } + + # Now build the dialog + if {![winfo exists $S(W)]} { + toplevel $S(W) -class TkFontDialog + if {[package provide tcltest] ne {}} {set ::tk_dialog $S(W)} + wm withdraw $S(W) + wm title $S(W) $S(-title) + wm transient $S(W) [winfo toplevel $S(-parent)] + + set outer [::ttk::frame $S(W).outer -padding {10 10}] + ::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"] + ::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"] + ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] + ttk::entry $S(W).efont -width 18 \ + -textvariable [namespace which -variable S](font) + ttk::entry $S(W).estyle -width 10 \ + -textvariable [namespace which -variable S](style) + ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \ + -width 3 -validate key -validatecommand {string is double %P} + + ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](fonts) + ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](styles) + ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](sizes) + + set WE $S(W).effects + ::ttk::labelframe $WE -text [::msgcat::mc "Effects"] + ::tk::AmpWidget ::ttk::checkbutton $WE.strike \ + -variable [namespace which -variable S](strike) \ + -text [::msgcat::mc "Stri&keout"] \ + -command [namespace code [list Click strike]] + ::tk::AmpWidget ::ttk::checkbutton $WE.under \ + -variable [namespace which -variable S](under) \ + -text [::msgcat::mc "&Underline"] \ + -command [namespace code [list Click under]] + + set bbox [::ttk::frame $S(W).bbox] + ::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\ + -command [namespace code [list Done 1]] + ::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \ + -command [namespace code [list Done 0]] + ::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \ + -command [namespace code [list Apply]] + wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]] + + # Calculate minimum sizes + ttk::scrollbar $S(W).tmpvs + set scroll_width [winfo reqwidth $S(W).tmpvs] + destroy $S(W).tmpvs + set minsize(gap) 10 + set minsize(bbox) [winfo reqwidth $S(W).ok] + set minsize(fonts) \ + [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}] + set minsize(styles) \ + [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}] + set minsize(sizes) \ + [expr {[font measure TkDefaultFont "-99"] + $scroll_width}] + set min [expr {$minsize(gap) * 4}] + foreach {what width} [array get minsize] { incr min $width } + wm minsize $S(W) $min 260 + + bind $S(W) <Return> [namespace code [list Done 1]] + bind $S(W) <Escape> [namespace code [list Done 0]] + bind $S(W) <Map> [namespace code [list Visibility %W 1]] + bind $S(W) <Unmap> [namespace code [list Visibility %W 0]] + bind $S(W) <Destroy> [namespace code [list Visibility %W 0]] + bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]] + bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]] + bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]] + bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A] + bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont] + bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle] + bind $S(W).size <<AltUnderlined>> [list ::focus $S(W).esize] + bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]] + bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke] + bind $WE.under <<AltUnderlined>> [list $WE.under invoke] + + set WS $S(W).sample + ::ttk::labelframe $WS -text [::msgcat::mc "Sample"] + ::ttk::label $WS.sample -relief sunken -anchor center \ + -textvariable [namespace which -variable S](sampletext) + set S(sample) $WS.sample + grid $WS.sample -sticky news -padx 6 -pady 4 + grid rowconfigure $WS 0 -weight 1 + grid columnconfigure $WS 0 -weight 1 + grid propagate $WS 0 + + grid $S(W).ok -in $bbox -sticky new -pady {0 2} + grid $S(W).cancel -in $bbox -sticky new -pady 2 + if {$S(-command) ne ""} { + grid $S(W).apply -in $bbox -sticky new -pady 2 + } + grid columnconfigure $bbox 0 -weight 1 + + grid $WE.strike -sticky w -padx 10 + grid $WE.under -sticky w -padx 10 -pady {0 30} + grid columnconfigure $WE 1 -weight 1 + + grid $S(W).font x $S(W).style x $S(W).size x -in $outer -sticky w + grid $S(W).efont x $S(W).estyle x $S(W).esize x $bbox -in $outer -sticky ew + grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news + grid $WE x $WS - - x ^ -in $outer -sticky news -pady {15 30} + grid configure $bbox -sticky n + grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) + grid columnconfigure $outer {0 2 4} -weight 1 + grid columnconfigure $outer 0 -minsize $minsize(fonts) + grid columnconfigure $outer 2 -minsize $minsize(styles) + grid columnconfigure $outer 4 -minsize $minsize(sizes) + grid columnconfigure $outer 6 -minsize $minsize(bbox) + + grid $outer -sticky news + grid rowconfigure $S(W) 0 -weight 1 + grid columnconfigure $S(W) 0 -weight 1 + + Init $S(-font) + + trace add variable [namespace which -variable S](size) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](style) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](font) \ + write [namespace code [list Tracer]] + } else { + Init $S(-font) + } + + return +} + +# ::tk::fontchooser::Done -- +# +# Handles teardown of the dialog, calling -command if needed +# +# Arguments: +# ok true if user pressed OK +# +proc ::tk::::fontchooser::Done {ok} { + variable S + + if {! $ok} { + set S(result) "" + } + trace vdelete S(size) w [namespace code [list Tracer]] + trace vdelete S(style) w [namespace code [list Tracer]] + trace vdelete S(font) w [namespace code [list Tracer]] + destroy $S(W) + if {$ok && $S(-command) ne ""} { + uplevel #0 $S(-command) [list $S(result)] + } +} + +# ::tk::fontchooser::Apply -- +# +# Call the -command procedure appending the current font +# Errors are reported via the background error mechanism +# +proc ::tk::fontchooser::Apply {} { + variable S + if {$S(-command) ne ""} { + if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} { + ::bgerror $err + } + } + event generate $S(-parent) <<TkFontchooserFontChanged>> +} + +# ::tk::fontchooser::Init -- +# +# Initializes dialog to a default font +# +# Arguments: +# defaultFont font to use as the default +# +proc ::tk::fontchooser::Init {{defaultFont ""}} { + variable S + + if {$S(first) || $defaultFont ne ""} { + if {$defaultFont eq ""} { + set defaultFont [[entry .___e] cget -font] + destroy .___e + } + array set F [font actual $defaultFont] + set S(font) $F(-family) + set S(size) $F(-size) + set S(strike) $F(-overstrike) + set S(under) $F(-underline) + set S(style) "Regular" + if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} { + set S(style) "Bold Italic" + } elseif {$F(-weight) eq "bold"} { + set S(style) "Bold" + } elseif {$F(-slant) eq "italic"} { + set S(style) "Italic" + } + + set S(first) 0 + } + + Tracer a b c + Update +} + +# ::tk::fontchooser::Click -- +# +# Handles all button clicks, updating the appropriate widgets +# +# Arguments: +# who which widget got pressed +# +proc ::tk::fontchooser::Click {who} { + variable S + + if {$who eq "font"} { + set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]] + } elseif {$who eq "style"} { + set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]] + } elseif {$who eq "size"} { + set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]] + } + Update +} + +# ::tk::fontchooser::Tracer -- +# +# Handles traces on key variables, updating the appropriate widgets +# +# Arguments: +# standard trace arguments (not used) +# +proc ::tk::fontchooser::Tracer {var1 var2 op} { + variable S + + set bad 0 + set nstate normal + # Make selection in each listbox + foreach var {font style size} { + set value [string tolower $S($var)] + $S(W).l${var}s selection clear 0 end + set n [lsearch -exact $S(${var}s,lcase) $value] + $S(W).l${var}s selection set $n + if {$n != -1} { + set S($var) [lindex $S(${var}s) $n] + $S(W).e$var icursor end + $S(W).e$var selection clear + } else { ;# No match, try prefix + # Size is weird: valid numbers are legal but don't display + # unless in the font size list + set n [lsearch -glob $S(${var}s,lcase) "$value*"] + set bad 1 + if {$var ne "size" || ! [string is double -strict $value]} { + set nstate disabled + } + } + $S(W).l${var}s see $n + } + if {!$bad} { Update } + $S(W).ok configure -state $nstate +} + +# ::tk::fontchooser::Update -- +# +# Shows a sample of the currently selected font +# +proc ::tk::fontchooser::Update {} { + variable S + + set S(result) [list $S(font) $S(size)] + if {$S(style) eq "Bold"} { lappend S(result) bold } + if {$S(style) eq "Italic"} { lappend S(result) italic } + if {$S(style) eq "Bold Italic"} { lappend S(result) bold italic} + if {$S(strike)} { lappend S(result) overstrike} + if {$S(under)} { lappend S(result) underline} + + $S(sample) configure -font $S(result) +} + +# ::tk::fontchooser::Visibility -- +# +# Notify the parent when the dialog visibility changes +# +proc ::tk::fontchooser::Visibility {w visible} { + variable S + if {$w eq $S(W)} { + event generate $S(-parent) <<TkFontchooserVisibility>> + } +} + +# ::tk::fontchooser::ttk_listbox -- +# +# Create a properly themed scrolled listbox. +# This is exactly right on XP but may need adjusting on other platforms. +# +proc ::tk::fontchooser::ttk_slistbox {w args} { + set f [ttk::frame $w -style FontchooserFrame -padding 2] + if {[catch { + listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args + ttk::scrollbar $f.vs -command [list $f.list yview] + $f.list configure -yscrollcommand [list $f.vs set] + grid $f.list $f.vs -sticky news + grid rowconfigure $f 0 -weight 1 + grid columnconfigure $f 0 -weight 1 + interp hide {} $w + interp alias {} $w {} $f.list + } err opt]} { + destroy $f + return -options $opt $err + } + return $w +} diff --git a/library/iconlist.tcl b/library/iconlist.tcl new file mode 100644 index 0000000..62b0b2d --- /dev/null +++ b/library/iconlist.tcl @@ -0,0 +1,696 @@ +# iconlist.tcl +# +# Implements the icon-list megawidget used in the "Tk" standard file +# selection dialog boxes. +# +# Copyright (c) 1994-1998 Sun Microsystems, Inc. +# Copyright (c) 2009 Donal K. Fellows +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# API Summary: +# tk::IconList <path> ?<option> <value>? ... +# <path> add <imageName> <itemList> +# <path> cget <option> +# <path> configure ?<option>? ?<value>? ... +# <path> deleteall +# <path> destroy +# <path> get <itemIndex> +# <path> index <index> +# <path> invoke +# <path> see <index> +# <path> selection anchor ?<int>? +# <path> selection clear <first> ?<last>? +# <path> selection get +# <path> selection includes <item> +# <path> selection set <first> ?<last>? + +package require Tk 8.6 + +::tk::Megawidget create ::tk::IconList ::tk::FocusableWidget { + variable w canvas sbar accel accelCB fill font index \ + itemList itemsPerColumn list maxIH maxIW maxTH maxTW noScroll \ + numItems oldX oldY options rect selected selection textList + constructor args { + next {*}$args + set accelCB {} + } + destructor { + my Reset + next + } + + method GetSpecs {} { + concat [next] { + {-command "" "" ""} + {-font "" "" "TkIconFont"} + {-multiple "" "" "0"} + } + } + + # ---------------------------------------------------------------------- + + method index i { + if {![info exist list]} { + set list {} + } + switch -regexp -- $i { + "^-?[0-9]+$" { + if {$i < 0} { + set i 0 + } + if {$i >= [llength $list]} { + set i [expr {[llength $list] - 1}] + } + return $i + } + "^anchor$" { + return $index(anchor) + } + "^end$" { + return [llength $list] + } + "@-?[0-9]+,-?[0-9]+" { + scan $i "@%d,%d" x y + set item [$canvas find closest \ + [$canvas canvasx $x] [$canvas canvasy $y]] + return [lindex [$canvas itemcget $item -tags] 1] + } + } + } + + method selection {op args} { + switch -exact -- $op { + anchor { + if {[llength $args] == 1} { + set index(anchor) [$w index [lindex $args 0]] + } else { + return $index(anchor) + } + } + clear { + switch [llength $args] { + 2 { + lassign $args first last + } + 1 { + set first [set last [lindex $args 0]] + } + default { + return -code error -errorcode {TCL WRONGARGS} \ + "wrong # args: should be\ + \"[lrange [info level 0] 0 1] first ?last?\"" + } + } + + set first [$w index $first] + set last [$w index $last] + if {$first > $last} { + set tmp $first + set first $last + set last $tmp + } + set ind 0 + foreach item $selection { + if {$item >= $first} { + set first $ind + break + } + incr ind + } + set ind [expr {[llength $selection] - 1}] + for {} {$ind >= 0} {incr ind -1} { + set item [lindex $selection $ind] + if {$item <= $last} { + set last $ind + break + } + } + + if {$first > $last} { + return + } + set selection [lreplace $selection $first $last] + event generate $w <<ListboxSelect>> + my DrawSelection + } + get { + return $selection + } + includes { + return [expr {[lindex $args 0] in $selection}] + } + set { + switch [llength $args] { + 2 { + lassign $args first last + } + 1 { + set first [set last [lindex $args 0]] + } + default { + return -code error -errorcode {TCL WRONGARGS} \ + "wrong # args: should be\ + \"[lrange [info level 0] 0 1] first ?last?\"" + } + } + + set first [$w index $first] + set last [$w index $last] + if {$first > $last} { + set tmp $first + set first $last + set last $tmp + } + + for {set i $first} {$i <= $last} {incr i} { + lappend selection $i + } + set selection [lsort -integer -unique $selection] + event generate $w <<ListboxSelect>> + my DrawSelection + } + } + } + + method get item { + set rTag [lindex $list $item 2] + lassign $itemList($rTag) iTag tTag text serial + return $text + } + + # Deletes all the items inside the canvas subwidget and reset the + # iconList's state. + # + method deleteall {} { + $canvas delete all + unset -nocomplain selected rect list itemList + set maxIW 1 + set maxIH 1 + set maxTW 1 + set maxTH 1 + set numItems 0 + set noScroll 1 + set selection {} + set index(anchor) "" + $sbar set 0.0 1.0 + $canvas xview moveto 0 + } + + # Adds an icon into the IconList with the designated image and text + # + method add {image items} { + foreach text $items { + set iID item$numItems + set iTag [$canvas create image 0 0 -image $image -anchor nw \ + -tags [list icon $numItems $iID]] + set tTag [$canvas create text 0 0 -text $text -anchor nw \ + -font $options(-font) -fill $fill \ + -tags [list text $numItems $iID]] + set rTag [$canvas create rect 0 0 0 0 -fill "" -outline "" \ + -tags [list rect $numItems $iID]] + + lassign [$canvas bbox $iTag] x1 y1 x2 y2 + set iW [expr {$x2 - $x1}] + set iH [expr {$y2 - $y1}] + if {$maxIW < $iW} { + set maxIW $iW + } + if {$maxIH < $iH} { + set maxIH $iH + } + + lassign [$canvas bbox $tTag] x1 y1 x2 y2 + set tW [expr {$x2 - $x1}] + set tH [expr {$y2 - $y1}] + if {$maxTW < $tW} { + set maxTW $tW + } + if {$maxTH < $tH} { + set maxTH $tH + } + + lappend list [list $iTag $tTag $rTag $iW $iH $tW $tH $numItems] + set itemList($rTag) [list $iTag $tTag $text $numItems] + set textList($numItems) [string tolower $text] + incr numItems + } + my WhenIdle Arrange + return + } + + # Gets called when the user invokes the IconList (usually by + # double-clicking or pressing the Return key). + # + method invoke {} { + if {$options(-command) ne "" && [llength $selection]} { + uplevel #0 $options(-command) + } + } + + # If the item is not (completely) visible, scroll the canvas so that it + # becomes visible. + # + method see rTag { + if {$noScroll} { + return + } + set sRegion [$canvas cget -scrollregion] + if {$sRegion eq ""} { + return + } + + if {$rTag < 0 || $rTag >= [llength $list]} { + return + } + + set bbox [$canvas bbox item$rTag] + set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}] + + set x1 [lindex $bbox 0] + set x2 [lindex $bbox 2] + incr x1 [expr {$pad * -2}] + incr x2 [expr {$pad * -1}] + + set cW [expr {[winfo width $canvas] - $pad*2}] + + set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}] + set dispX [expr {int([lindex [$canvas xview] 0]*$scrollW)}] + set oldDispX $dispX + + # check if out of the right edge + # + if {($x2 - $dispX) >= $cW} { + set dispX [expr {$x2 - $cW}] + } + # check if out of the left edge + # + if {($x1 - $dispX) < 0} { + set dispX $x1 + } + + if {$oldDispX ne $dispX} { + set fraction [expr {double($dispX) / double($scrollW)}] + $canvas xview moveto $fraction + } + } + + # ---------------------------------------------------------------------- + + # Places the icons in a column-major arrangement. + # + method Arrange {} { + if {![info exists list]} { + if {[info exists canvas] && [winfo exists $canvas]} { + set noScroll 1 + $sbar configure -command "" + } + return + } + + set W [winfo width $canvas] + set H [winfo height $canvas] + set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}] + if {$pad < 2} { + set pad 2 + } + + incr W [expr {$pad*-2}] + incr H [expr {$pad*-2}] + + set dx [expr {$maxIW + $maxTW + 8}] + if {$maxTH > $maxIH} { + set dy $maxTH + } else { + set dy $maxIH + } + incr dy 2 + set shift [expr {$maxIW + 4}] + + set x [expr {$pad * 2}] + set y [expr {$pad * 1}] ; # Why * 1 ? + set usedColumn 0 + foreach sublist $list { + set usedColumn 1 + lassign $sublist iTag tTag rTag iW iH tW tH + + set i_dy [expr {($dy - $iH)/2}] + set t_dy [expr {($dy - $tH)/2}] + + $canvas coords $iTag $x [expr {$y + $i_dy}] + $canvas coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}] + $canvas coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}] + + incr y $dy + if {($y + $dy) > $H} { + set y [expr {$pad * 1}] ; # *1 ? + incr x $dx + set usedColumn 0 + } + } + + if {$usedColumn} { + set sW [expr {$x + $dx}] + } else { + set sW $x + } + + if {$sW < $W} { + $canvas configure -scrollregion [list $pad $pad $sW $H] + $sbar configure -command "" + $canvas xview moveto 0 + set noScroll 1 + } else { + $canvas configure -scrollregion [list $pad $pad $sW $H] + $sbar configure -command [list $canvas xview] + set noScroll 0 + } + + set itemsPerColumn [expr {($H-$pad) / $dy}] + if {$itemsPerColumn < 1} { + set itemsPerColumn 1 + } + + my DrawSelection + } + + method DrawSelection {} { + $canvas delete selection + $canvas itemconfigure selectionText -fill black + $canvas dtag selectionText + set cbg [ttk::style lookup TEntry -selectbackground focus] + set cfg [ttk::style lookup TEntry -selectforeground focus] + foreach item $selection { + set rTag [lindex $list $item 2] + foreach {iTag tTag text serial} $itemList($rTag) { + break + } + + set bbox [$canvas bbox $tTag] + $canvas create rect $bbox -fill $cbg -outline $cbg \ + -tags selection + $canvas itemconfigure $tTag -fill $cfg -tags selectionText + } + $canvas lower selection + return + } + + # Creates an IconList widget by assembling a canvas widget and a + # scrollbar widget. Sets all the bindings necessary for the IconList's + # operations. + # + method Create {} { + variable hull + set sbar [ttk::scrollbar $hull.sbar -orient horizontal -takefocus 0] + catch {$sbar configure -highlightthickness 0} + set canvas [canvas $hull.canvas -highlightthick 0 -takefocus 1 \ + -width 400 -height 120 -background white] + pack $sbar -side bottom -fill x -padx 2 -pady {0 2} + pack $canvas -expand yes -fill both -padx 2 -pady {2 0} + + $sbar configure -command [list $canvas xview] + $canvas configure -xscrollcommand [list $sbar set] + + # Initializes the max icon/text width and height and other variables + # + set maxIW 1 + set maxIH 1 + set maxTW 1 + set maxTH 1 + set numItems 0 + set noScroll 1 + set selection {} + set index(anchor) "" + set fg [option get $canvas foreground Foreground] + if {$fg eq ""} { + set fill black + } else { + set fill $fg + } + + # Creates the event bindings. + # + bind $canvas <Configure> [namespace code {my WhenIdle Arrange}] + + bind $canvas <1> [namespace code {my Btn1 %x %y}] + bind $canvas <B1-Motion> [namespace code {my Motion1 %x %y}] + bind $canvas <B1-Leave> [namespace code {my Leave1 %x %y}] + bind $canvas <Control-1> [namespace code {my CtrlBtn1 %x %y}] + bind $canvas <Shift-1> [namespace code {my ShiftBtn1 %x %y}] + bind $canvas <B1-Enter> [list tk::CancelRepeat] + bind $canvas <ButtonRelease-1> [list tk::CancelRepeat] + bind $canvas <Double-ButtonRelease-1> \ + [namespace code {my Double1 %x %y}] + + bind $canvas <Control-B1-Motion> {;} + bind $canvas <Shift-B1-Motion> [namespace code {my ShiftMotion1 %x %y}] + + bind $canvas <<PrevLine>> [namespace code {my UpDown -1}] + bind $canvas <<NextLine>> [namespace code {my UpDown 1}] + bind $canvas <<PrevChar>> [namespace code {my LeftRight -1}] + bind $canvas <<NextChar>> [namespace code {my LeftRight 1}] + bind $canvas <Return> [namespace code {my ReturnKey}] + bind $canvas <KeyPress> [namespace code {my KeyPress %A}] + bind $canvas <Control-KeyPress> ";" + bind $canvas <Alt-KeyPress> ";" + + bind $canvas <FocusIn> [namespace code {my FocusIn}] + bind $canvas <FocusOut> [namespace code {my FocusOut}] + + return $w + } + + # This procedure is invoked when the mouse leaves an entry window with + # button 1 down. It scrolls the window up, down, left, or right, + # depending on where the mouse left the window, and reschedules itself + # as an "after" command so that the window continues to scroll until the + # mouse moves back into the window or the mouse button is released. + # + method AutoScan {} { + if {![winfo exists $w]} return + set x $oldX + set y $oldY + if {$noScroll} { + return + } + if {$x >= [winfo width $canvas]} { + $canvas xview scroll 1 units + } elseif {$x < 0} { + $canvas xview scroll -1 units + } elseif {$y >= [winfo height $canvas]} { + # do nothing + } elseif {$y < 0} { + # do nothing + } else { + return + } + my Motion1 $x $y + set ::tk::Priv(afterId) [after 50 [namespace code {my AutoScan}]] + } + + # ---------------------------------------------------------------------- + + # Event handlers + method Btn1 {x y} { + focus $canvas + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + $w selection clear 0 end + $w selection set $i + $w selection anchor $i + } + method CtrlBtn1 {x y} { + if {$options(-multiple)} { + focus $canvas + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + if {[$w selection includes $i]} { + $w selection clear $i + } else { + $w selection set $i + $w selection anchor $i + } + } + } + method ShiftBtn1 {x y} { + if {$options(-multiple)} { + focus $canvas + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + if {[$w index anchor] eq ""} { + $w selection anchor $i + } + $w selection clear 0 end + $w selection set anchor $i + } + } + + # Gets called on button-1 motions + # + method Motion1 {x y} { + set oldX $x + set oldY $y + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + $w selection clear 0 end + $w selection set $i + } + method ShiftMotion1 {x y} { + set oldX $x + set oldY $y + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + $w selection clear 0 end + $w selection set anchor $i + } + method Double1 {x y} { + if {[llength $selection]} { + $w invoke + } + } + method ReturnKey {} { + $w invoke + } + method Leave1 {x y} { + set oldX $x + set oldY $y + my AutoScan + } + method FocusIn {} { + $w state focus + if {![info exists list]} { + return + } + if {[llength $selection]} { + my DrawSelection + } + } + method FocusOut {} { + $w state !focus + $w selection clear 0 end + } + + # Moves the active element up or down by one element + # + # Arguments: + # amount - +1 to move down one item, -1 to move back one item. + # + method UpDown amount { + if {![info exists list]} { + return + } + set curr [$w selection get] + if {[llength $curr] == 0} { + set i 0 + } else { + set i [$w index anchor] + if {$i eq ""} { + return + } + incr i $amount + } + $w selection clear 0 end + $w selection set $i + $w selection anchor $i + $w see $i + } + + # Moves the active element left or right by one column + # + # Arguments: + # amount - +1 to move right one column, -1 to move left one + # column + # + method LeftRight amount { + if {![info exists list]} { + return + } + set curr [$w selection get] + if {[llength $curr] == 0} { + set i 0 + } else { + set i [$w index anchor] + if {$i eq ""} { + return + } + incr i [expr {$amount * $itemsPerColumn}] + } + $w selection clear 0 end + $w selection set $i + $w selection anchor $i + $w see $i + } + + # Gets called when user enters an arbitrary key in the listbox. + # + method KeyPress key { + append accel $key + my Goto $accel + after cancel $accelCB + set accelCB [after 500 [namespace code {my Reset}]] + } + + method Goto text { + if {![info exists list]} { + return + } + if {$text eq "" || $numItems == 0} { + return + } + + if {[llength [$w selection get]]} { + set start [$w index anchor] + } else { + set start 0 + } + set theIndex -1 + set less 0 + set len [string length $text] + set len0 [expr {$len - 1}] + set i $start + + # Search forward until we find a filename whose prefix is a + # case-insensitive match with $text + while {1} { + if {[string equal -nocase -length $len0 $textList($i) $text]} { + set theIndex $i + break + } + incr i + if {$i == $numItems} { + set i 0 + } + if {$i == $start} { + break + } + } + + if {$theIndex > -1} { + $w selection clear 0 end + $w selection set $theIndex + $w selection anchor $theIndex + $w see $theIndex + } + } + method Reset {} { + unset -nocomplain accel + } +} + +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/library/icons.tcl b/library/icons.tcl new file mode 100644 index 0000000..e53a1bd --- /dev/null +++ b/library/icons.tcl @@ -0,0 +1,153 @@ +# icons.tcl -- +# +# A set of stock icons for use in Tk dialogs. The icons used here +# were provided by the Tango Desktop project which provides a +# unified set of high quality icons licensed under the +# Creative Commons Attribution Share-Alike license +# (http://creativecommons.org/licenses/by-sa/3.0/) +# +# See http://tango.freedesktop.org/Tango_Desktop_Project +# +# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> + +namespace eval ::tk::icons {} + +image create photo ::tk::icons::warning -data { + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABSZJREFU + WIXll1toVEcYgL+Zc87u2Yu7MYmrWRuTJuvdiMuqiJd4yYKXgMQKVkSjFR80kFIVJfWCWlvpg4h9 + 8sXGWGof8iKNICYSo6JgkCBEJRG8ImYThNrNxmaTeM7pQ5IlJkabi0/9YZhhZv7///4z/8zPgf+7 + KCNRLgdlJijXwRyuDTlcxV9hbzv8nQmxMjg+XDtiOEplkG9PSfkztGmTgmFQd+FCVzwa3fYN/PHZ + AcpBaReicW5xcbb64IEQqko8Lc26d/58cxS+/BY6hmJvyEfQBoUpwWCmW1FErKaGWHU13uRk4QkE + UtxQNFR7QwIoB4eiKD9PWbVKbb10CZmaCqmpxCormRYO26QQx85B0mcD+AeK0xYvHqu1tNDx+DH6 + gQM4jh0j3tCA3tGBLyfHLuD7zwJwAcYqun44sHy51nr5MsqsWWj5+djCYdS5c4ldvUr24sU2qarf + lUL6qAN0wqH0vDy7+fAhXZEI+v79CNmt7igpofPVK5SmJvyhkJBwYlQBSiHd7vUWZ86bp8WqqtCW + LkVbuBAhBEIItGAQ2+rVxG7cICMY1KTDsekc5IwagIQTmStXis47dzBiMfR9+xCi+wb39s79+zFi + MczGRjLmzTMlnBoVgLMwyzF+/Cb/lClq2/Xr2AoKUKdPxzAMWltbiUajmKaJkpGBY8sW3tbW4g8E + VNXrXVEKK0YMoMKp7Px8K15Tg2VZOHbvBiASiRAMBgkGg0QiEYQQOIuLsRSFrnv3yJo/HxVOW594 + 7D4KUAa57qysvNSUFOVtbS32rVuRfj9CCFwuV2Kfy+VCCIFMScFVVET7/fukJidLm883rQy+HhaA + BUII8cvUNWt4W1WFcLvRd+5MnHl/AOjOB+eOHchx44jX1ZEdCqkSTpaDbcgA5+GrpNmzc9ymKdvr + 67Hv2oVMSko4cjgcKIqCoijoup64EdLpxLV3Lx1PnuCVUrgmTfK9hV1DAjgKqlSUk1PCYdl25QrS + 70cvLEw4SWS+04nT6XxvXgiBc8MGtKlTaa+rIysnR1Ok/OF38PxngAzY4VuwYKL99WvR8fQpjj17 + kLqeiL6393g8eDyeAWBSVfEcOkRXczOOaBRvVpZuDPJEDwD4DVyKrv+UlZurxSorUWfMQC8oGOBc + CDHgC/Rdc4TD2BctIl5fT+bkyTahaXvOw8RPApiwd2Ju7hjZ2EhXSwvOkhKQcoADgIqKCioqKgYc + QW9LOnIEIxZDbWpiXCCABT9+FKAUxtm83pKMUEiLVVejLVqEtmTJB50LIdi2bRuFPbnRd7232efM + wbVuHR2PHjHR77dJXS8sg5mDAihweFJenmrevYvR1oazpGTQ6IQQaJqG7ClI/dd655IOHsSyLMSL + F6QFAib9nugEQClk2Xy+orTsbK3t1i3sa9ei5eQMGr0QgvLyci5evDiocyEEtsxMPNu30/nsGRO8 + XlVzu8NlkNvrV+0T/fHMZcusrtu3MeNx9PXrobUVq8cYQrw3TrRub1h9+v573Bs3Ej1zBvP5c/zp + 6dbLhoaTwPy+ANKCfF92thq7dg2A6JYt/fNlxGK8eUNSerryHEJHQT8K8V4A5ztojty8OeaLzZul + 1DSwLCzDANPEMozusWFgmWZ33288YK3/nGlixuM0v3xpWfDX0Z4i1VupXEWwIgRnJfhGPfQ+YsLr + +7DzNFwCuvqWyiRg7DSYoIBu9smPkYqEd4AwIN4ITUAL0A4Da7UC6ICdEfy2fUBMoAvo7GnWKNoe + mfwLcAuinuFNL7QAAAAASUVORK5CYII= +} + +image create photo ::tk::icons::error -data { + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABiRJREFU + WIXFl11sHFcVgL97Z/bX693sbtd2ipOqCU7sQKukFYUigQgv/a+hoZGoqipvfQKpAsEDD0hIvCHE + j/pQ3sIDUdOiIqUyqXioEFSUhqit7cRJFJpEruxs1mt77Z3d2Z259/KwM5vZXTtOERJXOrozZ+6e + 852fuXcW/s9D3O3Cs1Bow1Nx234BKQ9qpYpK6yFLSseScsVoveApdUrAzNOw9j8DOAMTtmX9RsM3 + SqOjevcXDqUzu8dI5AvEc8O0axu4q6s4yzdZvnCxUSmXLWHMXzxjXpmGq/81wGmIZ6T8NXDi8w8d + id//+GPS8j1YWQXHgVYbfA/sGCRiMDQExTzKtvn3zDv6k9m5FsacXNT6+y+D95kAZqCEEO/cMzIy + 9eBLLybjyodrN6DpDqw1/dfpFNw3TtuSfPz7P7irlZUL2pjHn4GVuwJ4G/JCiLl9U1OjB58/ZnP5 + Mqxv3NGpMWZAz64cHNzHlTf/5N9YuHzTMeaLx6HW78+K3pwGKynEu/snJycOHPuWzdw81BuDUQZO + dfQ+MmvAuC1MdY3i178izUo15VZXj07DyTf6OGX0Jivlz0vFwgMTz3/bNnMXO0ZCo8b0iIk4C0WF + zsP1TRc1e4l9x56N5YuFwxkpf9afgW4J/gi7M1IuHH3lezm5uAQbmwOpjc79ujArA2uMgWwGMz7K + P377u/WW1pPTUB7IQFrKXx44NJWRbQ9d2+hGqbeRMEoTZEQFJdERfVgmvVFH+D57Jw9k4lL+YqAE + pyGnjZm+95knLHVjcVvHA6WIPgtLE+hVH4i6vsS9T3zTVsY8NwPZHoAUPFUs5JVQCt1q9zqORKm3 + iLKrF6IjkfSHOiUlqu0hhCSXHdYePNYDEBPiu6MT+zOquo6JGNGhESkxUnYNmkCnLQtjWRgpMRG9 + CtZ3JdD7axsU9+3N2EK8EALYQcNMpvfuQTcaXUMIAa+/Hi0Xgs9weASjefx4p5mFQDdbpD63G/HR + hakeAA2l+EgJU652iIMMyO2sRoYxBq1191oIgZQSITqooT0A7fnEirswUAp/LwG0MZlYIY9WqpPa + IHU7Da01Sqluo4UQSil830dr3emVsBeMIZbLoI0Z7gGQQtTbjoOOxW/XewcApVQ38jsBNs6fx6tW + O70Si+GWKwghNsM1NoCAW81KJTeUjKNbrR2N7uS4B7TRwJ+fR6TTxO4fxzUeAio9AMCl+tVrE0NH + DmM2nU4DAu6JE53UGoNfLuNdv45xnO4OF/ZKz+4X2T179I6D5To0NupouNgD4Btzqjx/8WjpS0cy + PU1Tr6MqFfylpc4bss1W26/rBwyfybECtcvXNrUxp3oAXJjZ2Kxb7cVP8P61gDGgWy2M624Z5d1E + 3wNkDDKdwMQkjtuygbMhgAQ4DjUhxFvL/5z15X1jeLUaynW7p1u484WiuL3V9m/NoV6F50Ogjx3Y + Q/mDBV8a3piGzR4AAFfrHy4vlesmm0bks7edRQ6aAafcPoZVH2AUXOYzkI5TvbVa9+FHREYX4Bgs + I8RrV9/9oJF4eBKTjO8YvdoCJgqujcGkEqQemmDxb7OOFOLV6FHcAwBQ1/onTtOd/fTvH3rJRx/A + pBIDqd0q+p5sRaInnWDoywdZem+u7bbaH9W1/il9Y2Brfwt22TBfKOVHxr92JOacv4S/UuttuC06 + PKoHsEs5hg7vZ/m9eW+zWltuwoNbfRNuebacgXsEnE2lkof2Hn04ZRouzQvXUU5z29cwFGs4TWpy + HJGK8+lfP256bnuuDU8+B9WtfG17uL0GsTF4VQrxYn60kBh55JDEbdG6uYq/7qDdFtpTELOQyQRW + Lk1sLI+MW9w6d8Wv3Vrz2nDyJPzgDDS287MVgAAywBCQ+Q5MTsOPs/BIMpVQ2bFCKlnMYg+nsYeS + eE6TVq1Be3WD9ZtrTc9tWetw7k341dtwBagDTmTeESAdAAxH5z0w9iQ8ehi+moWxBGRsiPvguVBf + h8qH8P6f4dxSp9PrdN73cN6k859R3U0J0nS+28JMpIM5FUgCiNP5X2ECox7gAk06KQ8ldLzZ7/xO + ANHnscBhCkgGjuOB3gb8CEAbaAWO3UA34DQ6/gPnmhBFs5mqXAAAAABJRU5ErkJggg== +} + +image create photo ::tk::icons::information -data { + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABmJLR0QA/wD/AP+gvaeTAAAACXBI + WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gUdFDM4pWaDogAABwNJREFUWMPFlltsVNcVhv+199ln + bh7PjAdfMGNDcA04EKMkJlIsBVJVbRqlEVUrqyW0QAtFTVWpjVpFfamUF6K+tCTKQyXn0jaiShOr + bRqRoHJpEEoIEBucENuk2OViPB5f5j5zrvuc3YcMFQ8FPBFVj7S0paN91v+tf1/OAv7PD9UzeeCp + p0KRCrYyHtymoPrgySYAANdyBBr2Peu1agP+NrR/v3nHAb6/52d7wfivWlet11NdvZG21laEwzo0 + RvA9F4uLi7h08bxxaWLUVp78xSsv/XrwjgAMDDyjRxPWUGOy5Uu9/VsjEA3I5KvIVQ240gHIh9CA + 5YkwelIJRATw94NvGpnpK0fL+eDA0NAzzq3ya7cDjCbsoWWr1j+y4f4vB/41Z8JTeaxqE7hndSNi + EeELzn3LkapQdfzJTE5JV/GBb28LHz327lcnzp4ZAvB1AOpmAvyWtv/g6R9GW1c+uf6Bx0Kfzpjo + TmnYtDaKtkTAj4aEFBqTnJPUOfciIeG3N4XVQtmyzl/JuY8/fH9wOjO/smvVmuy5s+8P1w2wa9dP + 46SLN3sf2ha7uiixaU0Qna06NA6PMXIZQRJBMiIXRBKABygv3hBQV+bK1dmcoR7d3Bc5c/pk/8YN + fYOjo6es/6bDbgbAdLa9uXNj2PYF2pOEloQGAiRIuUTkME42J7IZweYES+NkckZWWNfseEPAKJtO + oWxLu69/c5jpbPtNdW7qPwvsbO1cF8pVLKxs0+HD94gpl0AOQTlEsDkjizFmMk4WESyNM4NzMgOC + VYI6q17OlIp9992ngek769+EvtfVEI3jWqaKgAgAIAlFLuOwGZHDiTnElGQgF4DvM1LKV7Bdz2NE + xaCuhQpVm1Y0p5qhvNV1AyjlRTWhwVM2TMdzgkJzieAQyGGMbMZgfwZBEiBPA3xX+VSouAvBAFeM + yDddD7rgpHw/WjcAMa0EZScZk5heqFrxiO4BzCGCzYgsBrI4I5sYcxlBKl/5WdOdd6S0gxoLEZEi + Iq4AnzGq1r0HiPhYuZRFU1R3FgqWkS1aZQA2gWzOyGQcJudkaAwVR3qz8yXzvCXlzJoViaagrlWC + jJnLm8Jarli2GNMm6wbwPPO31y6Ollc2N3pcI+fyYjW/8a5EKqQTz5WtdLHsTi1W7Im5vDlcMdxx + wVk2Ys9/pTI3+WhAaIauM+MLbYnlH46MVKVyX6v7Hhg9e2ps3doN32ld0Rlrb1nmmK4stCdCSCUj + Le1NwW6uXJ08m/t2OarBXh0ie0syHu0plKtTFGw8n4o33q1z1XngD7+X3C/uHBkZces7hoAi1946 + fPSvtpDlYFdLPDI8mR03HC87frXwFpgqLYuFuzrbkg8m49EeDsqDa+cizXcNpppia5ui+sYXnn+O + 29LbOTg4aHzun9GOPT/pDemhf3xzx25DicjkiqaAIs4zhumMRUJaPhzgJZ0LQ5C7gXjQL1kS0YD+ + o337nhWlYvHJV178zZ9vlZ/dDuDVl57/2HWt755894hINoYSmZx11TYKCUZKCs4cnQuDmGtfvDiR + dD3n04aA6J4YHzeLhfLg7cSXBAAA5NPpufS1WFjwkFSelZ6ZLWfn0kliTDJdue8dO9qenp2d1DVR + 4cTarlyZJgV5dim5lwTw8sv7c1L6H89cm6FlDcHVhlOJffThsa9d+ud72y5+cnTn2PjJJ1avjOoE + SnBiPadOfRDTGT5YSm5tqR2R7Zp7//L6gRPf27NjVaolqS9MCzh28W6mgDXdKxCNRb/oOlV18O3D + 1xzXGXpx8LnZO94Tbt/x+MFYouexh7dsQU/PWjRGI+BcAyMgm1vAO28fxvj4xOX5jL7u0KEX7Dvq + AAC0Nucf2rLZhq8Y3njjT8gulOBKDw0NAQjNQT435eQWL3iHDk3YS81ZF0B6psI/GbuAXbu+gQf7 + H4ArPeQWC5jLZKCUhQvjWb2QD3bVk5PVM9nz5LML8waOH38fekBHIhFDqqMFXd0pnDhxGmMTU3Bd + 9/X/GQDntO/eezswMPBjaFwAABxH4sKFq+jt7cX6ni6EQuJbdeWsZ3J3d/PTmqaEYUyhXDZBTEOh + WIIQwOi5jzA1eRnZXPFSPO7/bmbGlLfqhus5BVotRH9/x7rGxtBeIQJPACrMOYNSPpRiUIpnlTIO + nzmT+eX8fLH8WZMKF4Csje7ncUAHEKhFcHq6ZE5OZoc7O3tlc3N33+7dP9c2bXoE09NlO52uHDhy + ZOTVatUWte+otsTXg2pQSwagG6r/jwsAQul0erqjo+OesbGx1tHRUT+fz48dP378j57neQD8mtB1 + B1TtnV9zo64loJqoXhtFDUQHEGhvb2/2fZ9nMpliTcAFYNdC1sIBYN1sCeq5Ca9bqtWcu9Fe3FDl + 9Uqvu3HLjfhvTUo85WzjhogAAAAASUVORK5CYII= +} + +image create photo ::tk::icons::question -data { + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAACG5JREFU + WIXFl3twVdUVxn97n3Nubm7euZcghEdeBBICEQUFIgVECqIo1uJMp3WodqyjMzpjZ7TTh20cK31N + /2jL2FYdKXaqRcbnDKGpoBFaAY1BHgHMgyRKQkJy87yv3Nyzd/84594k1RlppzPumTXn3Dl3r/Wd + b31rrbPhS17iSv+4bl2t2ZFhrRGI7QKxRkMAyHEfjwgYEOgjNnpfcXjiSENDbeL/AqBoW22uGE/7 + MYL7yubN4MYVpVkrquaKqwJZ+LPTARgcjdIbHKOx+aI+9EH7WGvnZdA8q9PGf9b5eu3w/wygaPPO + h6Uhntxcsyj9/q+vtMrnBa6Is7ZPgzzzyvGJ/YfPRpWWj3fWff93/xWAonW1Xu3z/nVx6cxNTz74 + 1YzK4gIQjuN/nfyEEx9fIjgaYXAkhhAQyE3Hn5PBsvJZrF46l5I5+QB83NnP40+/FT7d1ltPOPrN + zoba2BcCWLy91hMOp72/bX1VxU/u3+BJ91i0fhrkuTcaaTzbjTQkhpQIIZBSIBApL1prtNYsryhk + xy1XUzonn1g8wVPPvh1/5dDpcz5f7LrmfbXxqfGM6eG1yCw+9uq2G6tW7nxoU5plGrzecJYnnnub + SwMhTNPAmmKmYWCaBoYpMQyJaRhIQ3IpGOKt4+1k+dKoLJ7BjStKjb6hcN7JloFrhlsO7oUnPh9A + 8Rbvo6uuLrr3N4/ckm4Ykt/vPcqe/R9hGAamaWJZbnDL+W2axqRJA8NlxzAkAI3newhF4lxbMZs1 + y4rNM+19c0PZ++NDLQff+0wKCu/Y6c/UVsubv/12/ryZubxUf5Ln3vgQ0zKnvK1kadkMlpQUUFEU + oCDPR25WOuPxBH2DYZpa+qg/3kEoGsdWCttWJGzF3ZuXcuf6Ci5eHmXrw7sHR4mXd7/2w+A0Bvyl + N+265/bl19+8eqE8c6GPn+85jGkYWC4Ay3Luf/3AV1g038+MXB8+rwfDkKR5TPKyvCyan8+qqtmc + au8nFrcdnQCn2vuoLptJSWEeE7bynDjdXTDUcvBNAAmweF1tpmXKu+65bYWh0Ty97zhSyGkUO0BM + hBAI4RAXTyjiCYWUEukKMz/Ly/b1C7EsE49lYlkmhjTYvf8jNHD3lmsM0zTuWryuNhPABIj4vFvW + Xl0s87PTOdXWS8snQTwec4ro3DSYBglbcfx8P+8199I7FMEQgg3L53N7TWkKXOV8Px7LJCFtXKx0 + dA9zrnOAyqIAa68tkQePtm4BXpaO9vWOm65b4EPAkY+6HDEZTt4NN/dJML946QSv/fMCA6PjpHks + LI/F2a5BtNYpMUtJirGpLL7f3A3AxpXlPiHFjhQDaJZVlc0EoPWT4DQ1m8ZkKizTJDRuY1mmC04i + pWDNksJUD9Bac7E/jGUZrmuN1qCU5sKlIQAqSwrQWi+bBCDwF+RnAk5fl27wqeYAkZM9wLWaxVex + qnJmKritFO+e7sMyDdBOc1JKYxiSkdA4CMGM3Aw02j+VAfLcwTIWibuiEpNApJMSw208ydJcu3QW + axZPCW7bHGjspmcwimkYTmAlMWzHTyTmDMiczLRU/ctkNxgajboPvUghppuUGFJMY6O6OJ/ViwIo + pVBKYds2dR9e4uPuMbc7Tm9MUgqyM70AjITHUy1IAghNsH8oDEAgz4cQOIqWjkkpEC4rSYfXL/Sn + giulONYyRFd/1GXKAZxkUrgvkp/tAAgORxAQnAQg5InmC5cBWDgv4NS5EAhAINzyIlVmUgiy040U + 9Uop2voiKYakEAiRvDp7EYKS2XkAnOvsR0h5IqUBrfWeQ8fb1t2xvtJXs3QuB462TfZokbxMGZxC + 8If6DtI8Fh6PhcdjojSpBuXin7Kc3csXzQLgrWOtEWWrPSkAvkis7kjTBTU8FqOypIAF8/x09Y6Q + FGjyTdHJstLsWDsnNZIBXj7Wj1LKYSS5B412nRTNymHBnHxGQ+O8836r8kVidakUNDfUhhIJtfcv + dU22AO69dRlCCNeZU8fJe6U0ylZYBlgGmNKx+ESCiYRNwlYoWzn/UxqtHOB3ra8AAX/7x0nbttXe + 5oba0GQVAPGE9dju1z4Y7u4fY9F8P9/YWOUEV06O7eTVnXBTBaiUIj4xwcSETSJhk7BtbNtOPdta + U0ZpYS59wRB/2ndsOBa3HkvGTU3D0fb6aE7ZBt3RM1yzuabcqiwKEI5N0N495ChaSKcihJPRa0pz + sbUmYTugPmgbJmErB4DLxETC5oYlhWxdXUrCVvxgV32krav/qa4Djx76D4kllxalt/7q9e2bqjf9 + 9Lsb0oQQHGrsYO+hc0gp3emW/Bhxm5NbZlqD0g79CTcFt60u4YYlhWhg5/MN4y/WNdW3vfnoNhD6 + Mww46wlmV9/w6snzA1sHRqKBVUvnGQvm+qkuKyA4GqVvKOJAdrcn8zz14yNh2ywozOVbGyuoKg4w + PmHzyxcOx1+sazqTlhbZ3H92vT29Pj5nzVn1SLqVH3ipunzOxqceutlX6n7lXrw8yqn2flq7hxgL + TzAWiyOFICfTS44vjbLCXKqK/cwOOHOl49IwP9r192hT84V3e4+9cF90sC0IRL8QAOADsgvXfu9B + b3bgkTs3LPN+52srzPlX5V7RUerTy6M8/0Zj4uUDH45Hg13PdB/9425gzLUhQH0RgDQgC8hKLyid + 7a/c9oCV4d9WVTpLbF5TmX5tRaGYkecjJ8MLAkZD4wyMRGg636PrDjfHzrT26NhYT33w1Kt/Hh/u + 6XUDh4BBIHwlDIBTohlANpBhWb6s7PKNK30FCzZa6dnVYORoIX2OExVF26Px8NCZSN/5d0bb3mlK + JGIhHLpDwLAL4jPnxSs9nBqABXhddrw4XdRygSrABuKuxYBx9/6KDqlf2vo3PYe56vmkuwMAAAAA + SUVORK5CYII= +} diff --git a/library/listbox.tcl b/library/listbox.tcl index 2d9af20..17c03c0 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -69,28 +69,28 @@ bind Listbox <B1-Enter> { tk::CancelRepeat } -bind Listbox <Up> { +bind Listbox <<PrevLine>> { tk::ListboxUpDown %W -1 } -bind Listbox <Shift-Up> { +bind Listbox <<SelectPrevLine>> { tk::ListboxExtendUpDown %W -1 } -bind Listbox <Down> { +bind Listbox <<NextLine>> { tk::ListboxUpDown %W 1 } -bind Listbox <Shift-Down> { +bind Listbox <<SelectNextLine>> { tk::ListboxExtendUpDown %W 1 } -bind Listbox <Left> { +bind Listbox <<PrevChar>> { %W xview scroll -1 units } -bind Listbox <Control-Left> { +bind Listbox <<PrevWord>> { %W xview scroll -1 pages } -bind Listbox <Right> { +bind Listbox <<NextChar>> { %W xview scroll 1 units } -bind Listbox <Control-Right> { +bind Listbox <<NextWord>> { %W xview scroll 1 pages } bind Listbox <Prior> { @@ -107,10 +107,10 @@ bind Listbox <Control-Prior> { bind Listbox <Control-Next> { %W xview scroll 1 pages } -bind Listbox <Home> { +bind Listbox <<LineStart>> { %W xview moveto 0 } -bind Listbox <End> { +bind Listbox <<LineEnd>> { %W xview moveto 1 } bind Listbox <Control-Home> { @@ -118,9 +118,9 @@ bind Listbox <Control-Home> { %W see 0 %W selection clear 0 end %W selection set 0 - event generate %W <<ListboxSelect>> + tk::FireListboxSelectEvent %W } -bind Listbox <Shift-Control-Home> { +bind Listbox <Control-Shift-Home> { tk::ListboxDataExtend %W 0 } bind Listbox <Control-End> { @@ -128,9 +128,9 @@ bind Listbox <Control-End> { %W see end %W selection clear 0 end %W selection set end - event generate %W <<ListboxSelect>> + tk::FireListboxSelectEvent %W } -bind Listbox <Shift-Control-End> { +bind Listbox <Control-Shift-End> { tk::ListboxDataExtend %W [%W index end] } bind Listbox <<Copy>> { @@ -157,13 +157,13 @@ bind Listbox <Shift-Select> { bind Listbox <Escape> { tk::ListboxCancel %W } -bind Listbox <Control-slash> { +bind Listbox <<SelectAll>> { tk::ListboxSelectAll %W } -bind Listbox <Control-backslash> { +bind Listbox <<SelectNone>> { if {[%W cget -selectmode] ne "browse"} { %W selection clear 0 end - event generate %W <<ListboxSelect>> + tk::FireListboxSelectEvent %W } } @@ -197,6 +197,9 @@ if {[tk windowingsystem] eq "aqua"} { bind Listbox <MouseWheel> { %W yview scroll [expr {- (%D / 120) * 4}] units } + bind Listbox <Shift-MouseWheel> { + %W xview scroll [expr {- (%D / 120) * 4}] units + } } if {"x11" eq [tk windowingsystem]} { @@ -209,11 +212,21 @@ if {"x11" eq [tk windowingsystem]} { %W yview scroll -5 units } } + bind Listbox <Shift-4> { + if {!$tk_strictMotif} { + %W xview scroll -5 units + } + } bind Listbox <5> { if {!$tk_strictMotif} { %W yview scroll 5 units } } + bind Listbox <Shift-5> { + if {!$tk_strictMotif} { + %W xview scroll 5 units + } + } } # ::tk::ListboxBeginSelect -- @@ -243,7 +256,7 @@ proc ::tk::ListboxBeginSelect {w el {focus 1}} { set Priv(listboxSelection) {} set Priv(listboxPrev) $el } - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w # check existence as ListboxSelect may destroy us if {$focus && [winfo exists $w] && [$w cget -state] eq "normal"} { focus $w @@ -271,7 +284,7 @@ proc ::tk::ListboxMotion {w el} { $w selection clear 0 end $w selection set $el set Priv(listboxPrev) $el - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } extended { set i $Priv(listboxPrev) @@ -302,7 +315,7 @@ proc ::tk::ListboxMotion {w el} { incr i -1 } set Priv(listboxPrev) $el - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } } } @@ -353,7 +366,7 @@ proc ::tk::ListboxBeginToggle {w el} { } else { $w selection set $el } - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } } @@ -405,7 +418,7 @@ proc ::tk::ListboxUpDown {w amount} { browse { $w selection clear 0 end $w selection set active - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } extended { $w selection clear 0 end @@ -413,7 +426,7 @@ proc ::tk::ListboxUpDown {w amount} { $w selection anchor active set Priv(listboxPrev) [$w index active] set Priv(listboxSelection) {} - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } } } @@ -501,7 +514,7 @@ proc ::tk::ListboxCancel w { } incr first } - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w } # ::tk::ListboxSelectAll @@ -521,5 +534,19 @@ proc ::tk::ListboxSelectAll w { } else { $w selection set 0 end } - event generate $w <<ListboxSelect>> + tk::FireListboxSelectEvent $w +} + +# ::tk::FireListboxSelectEvent +# +# Fire the <<ListboxSelect>> event if the listbox is not in disabled +# state. +# +# Arguments: +# w - The listbox widget. + +proc ::tk::FireListboxSelectEvent w { + if {[$w cget -state] eq "normal"} { + event generate $w <<ListboxSelect>> + } } diff --git a/library/megawidget.tcl b/library/megawidget.tcl new file mode 100644 index 0000000..9b9be92 --- /dev/null +++ b/library/megawidget.tcl @@ -0,0 +1,146 @@ +# megawidget.tcl +# +# Basic megawidget support classes. Experimental for any use other than +# the ::tk::IconList megawdget, which is itself only designed for use in +# the Unix file dialogs. +# +# Copyright (c) 2009-2010 Donal K. Fellows +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +package require Tk 8.6 + +::oo::class create ::tk::Megawidget { + superclass ::oo::class + method unknown {w args} { + if {[string match .* $w]} { + [self] create $w {*}$args + return $w + } + next $w {*}$args + } + unexport new unknown + self method create {name superclasses body} { + next $name [list \ + superclass ::tk::MegawidgetClass {*}$superclasses]\;$body + } +} + +::oo::class create ::tk::MegawidgetClass { + variable w hull OptionSpecification options IdleCallbacks + constructor args { + # Extract the "widget name" from the object name + set w [namespace tail [self]] + + # Configure things + set OptionSpecification [my GetSpecs] + my configure {*}$args + + # Move the object out of the way of the hull widget + rename [self] _tmp + + # Make the hull widget(s) + my CreateHull + bind $hull <Destroy> [list [namespace which my] destroy] + + # Rename things into their final places + rename ::$w theFrame + rename [self] ::$w + + # Make the contents + my Create + } + destructor { + foreach {name cb} [array get IdleCallbacks] { + after cancel $cb + unset IdleCallbacks($name) + } + if {[winfo exists $w]} { + bind $hull <Destroy> {} + destroy $w + } + } + + method configure args { + tclParseConfigSpec [my varname options] $OptionSpecification "" $args + } + method cget option { + return $options($option) + } + + method GetSpecs {} { + return { + {-takefocus takeFocus TakeFocus {}} + } + } + + method CreateHull {} { + return -code error -errorcode {TCL OO ABSTRACT_METHOD} \ + "method must be overridden" + } + method Create {} { + return -code error -errorcode {TCL OO ABSTRACT_METHOD} \ + "method must be overridden" + } + + method WhenIdle {method args} { + if {![info exists IdleCallbacks($method)]} { + set IdleCallbacks($method) [after idle [list \ + [namespace which my] DoWhenIdle $method $args]] + } + } + method DoWhenIdle {method arguments} { + unset IdleCallbacks($method) + tailcall my $method {*}$arguments + } +} + +::tk::Megawidget create ::tk::SimpleWidget {} { + variable w hull options + method GetSpecs {} { + return { + {-cursor cursor Cursor {}} + {-takefocus takeFocus TakeFocus {}} + } + } + method CreateHull {} { + set hull [::ttk::frame $w -cursor $options(-cursor)] + trace add variable options(-cursor) write \ + [namespace code {my UpdateCursorOption}] + } + method UpdateCursorOption args { + $hull configure -cursor $options(-cursor) + } + method state args { + tailcall $hull state {*}$args + } + method instate args { + tailcall $hull instate {*}$args + } +} + +::tk::Megawidget create ::tk::FocusableWidget ::tk::SimpleWidget { + variable w hull options + method GetSpecs {} { + return { + {-cursor cursor Cursor {}} + {-takefocus takeFocus TakeFocus ::ttk::takefocus} + } + } + method CreateHull {} { + ttk::frame $w + set hull [ttk::entry $w.cHull -takefocus 0 -cursor $options(-cursor)] + pack $hull -expand yes -fill both -ipadx 2 -ipady 2 + trace add variable options(-cursor) write \ + [namespace code {my UpdateCursorOption}] + } +} + +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/library/menu.tcl b/library/menu.tcl index 4875477..a7aaa3f 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -156,16 +156,16 @@ bind Menu <Return> { bind Menu <Escape> { tk::MenuEscape %W } -bind Menu <Left> { +bind Menu <<PrevChar>> { tk::MenuLeftArrow %W } -bind Menu <Right> { +bind Menu <<NextChar>> { tk::MenuRightArrow %W } -bind Menu <Up> { +bind Menu <<PrevLine>> { tk::MenuUpArrow %W } -bind Menu <Down> { +bind Menu <<NextLine>> { tk::MenuDownArrow %W } bind Menu <KeyPress> { @@ -248,7 +248,6 @@ proc ::tk::MbLeave w { proc ::tk::MbPost {w {x {}} {y {}}} { global errorInfo variable ::tk::Priv - global tcl_platform if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} { return @@ -260,7 +259,8 @@ proc ::tk::MbPost {w {x {}} {y {}}} { set tearoff [expr {[tk windowingsystem] eq "x11" \ || [$menu cget -type] eq "tearoff"}] if {[string first $w $menu] != 0} { - error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)" + return -code error -errorcode {TK MENUBUTTON POST_NONCHILD} \ + "can't post $menu: it isn't a descendant of $w" } set cur $Priv(postedMb) if {$cur ne ""} { @@ -330,7 +330,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { $menu activate $entry GenerateMenuSelect $menu } - } + } right { set x [expr {[winfo rootx $w] + [winfo width $w]}] set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] @@ -366,14 +366,12 @@ proc ::tk::MbPost {w {x {}} {y {}}} { } } } - } msg]} { + } msg opt]} { # Error posting menu (e.g. bogus -postcommand). Unpost it and # reflect the error. - set savedInfo $errorInfo MenuUnpost {} - error $msg $savedInfo - + return -options $opt $msg } set Priv(tearoff) $tearoff @@ -403,7 +401,6 @@ proc ::tk::MbPost {w {x {}} {y {}}} { # is a posted menubutton. proc ::tk::MenuUnpost menu { - global tcl_platform variable ::tk::Priv set mb $Priv(postedMb) @@ -532,7 +529,6 @@ proc ::tk::MbMotion {w upDown rootx rooty} { proc ::tk::MbButtonUp w { variable ::tk::Priv - global tcl_platform set menu [$w cget -menu] set tearoff [expr {[tk windowingsystem] eq "x11" || \ @@ -607,7 +603,6 @@ proc ::tk::MenuMotion {menu x y state} { proc ::tk::MenuButtonDown menu { variable ::tk::Priv - global tcl_platform if {![winfo viewable $menu]} { return @@ -1219,8 +1214,6 @@ proc ::tk::MenuFindName {menu s} { # upper-left corner goes at (x,y). proc ::tk::PostOverPoint {menu x y {entry {}}} { - global tcl_platform - if {$entry ne ""} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ @@ -1235,8 +1228,8 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} { if {[tk windowingsystem] eq "win32"} { # osVersion is not available in safe interps set ver 5 - if {[info exists tcl_platform(osVersion)]} { - scan $tcl_platform(osVersion) %d ver + if {[info exists ::tcl_platform(osVersion)]} { + scan $::tcl_platform(osVersion) %d ver } # We need to fix some problems with menu posting on Windows, @@ -1341,7 +1334,6 @@ proc ::tk::GenerateMenuSelect {menu} { proc ::tk_popup {menu x y {entry {}}} { variable ::tk::Priv - global tcl_platform if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} { tk::MenuUnpost {} } diff --git a/library/mkpsenc.tcl b/library/mkpsenc.tcl index 9efb6de..b3fd13d 100644 --- a/library/mkpsenc.tcl +++ b/library/mkpsenc.tcl @@ -1,1365 +1,1487 @@ # mkpsenc.tcl -- # -# Creates Postscript encoding vector for given encoding -# +# This file generates the postscript prolog used by Tk. -proc ::tk::CreatePostscriptEncoding {encoding} { - # now check for known. Even if it is known, it can be other - # than we need. GhostScript seems to be happy with such approach - set result "/CurrentEncoding \[\n" - for {set i 0} {$i<256} {incr i 8} { - for {set j 0} {$j<8} {incr j} { - set enc [encoding convertfrom $encoding [format %c [expr {$i+$j}]]] - if {[catch {format %04X [scan $enc %c]} hexcode]} {set hexcode {}} - if [info exists ::tk::psglyphs($hexcode)] { - append result "/$::tk::psglyphs($hexcode)" - } else { - append result "/space" +namespace eval ::tk { + # Creates Postscript encoding vector for ISO-8859-1 (could theoretically + # handle any 8-bit encoding, but Tk never generates characters outside + # ASCII). + # + proc CreatePostscriptEncoding {} { + variable psglyphs + # Now check for known. Even if it is known, it can be other than we + # need. GhostScript seems to be happy with such approach + set result "\[\n" + for {set i 0} {$i<256} {incr i 8} { + for {set j 0} {$j<8} {incr j} { + set enc [encoding convertfrom "iso8859-1" \ + [format %c [expr {$i+$j}]]] + catch { + set hexcode {} + set hexcode [format %04X [scan $enc %c]] + } + if {[info exists psglyphs($hexcode)]} { + append result "/$psglyphs($hexcode)" + } else { + append result "/space" + } } + append result "\n" } - append result "\n" + append result "\]" + return $result } - append result "\] def\n" - return $result -} - -# List of adobe glyph names. Converted from glyphlist.txt, downloaded -# from Adobe - -namespace eval ::tk { -array set psglyphs { - 0020 space - 0021 exclam - 0022 quotedbl - 0023 numbersign - 0024 dollar - 0025 percent - 0026 ampersand - 0027 quotesingle - 0028 parenleft - 0029 parenright - 002A asterisk - 002B plus - 002C comma - 002D hyphen - 002E period - 002F slash - 0030 zero - 0031 one - 0032 two - 0033 three - 0034 four - 0035 five - 0036 six - 0037 seven - 0038 eight - 0039 nine - 003A colon - 003B semicolon - 003C less - 003D equal - 003E greater - 003F question - 0040 at - 0041 A - 0042 B - 0043 C - 0044 D - 0045 E - 0046 F - 0047 G - 0048 H - 0049 I - 004A J - 004B K - 004C L - 004D M - 004E N - 004F O - 0050 P - 0051 Q - 0052 R - 0053 S - 0054 T - 0055 U - 0056 V - 0057 W - 0058 X - 0059 Y - 005A Z - 005B bracketleft - 005C backslash - 005D bracketright - 005E asciicircum - 005F underscore - 0060 grave - 0061 a - 0062 b - 0063 c - 0064 d - 0065 e - 0066 f - 0067 g - 0068 h - 0069 i - 006A j - 006B k - 006C l - 006D m - 006E n - 006F o - 0070 p - 0071 q - 0072 r - 0073 s - 0074 t - 0075 u - 0076 v - 0077 w - 0078 x - 0079 y - 007A z - 007B braceleft - 007C bar - 007D braceright - 007E asciitilde - 00A0 space - 00A1 exclamdown - 00A2 cent - 00A3 sterling - 00A4 currency - 00A5 yen - 00A6 brokenbar - 00A7 section - 00A8 dieresis - 00A9 copyright - 00AA ordfeminine - 00AB guillemotleft - 00AC logicalnot - 00AD hyphen - 00AE registered - 00AF macron - 00B0 degree - 00B1 plusminus - 00B2 twosuperior - 00B3 threesuperior - 00B4 acute - 00B5 mu - 00B6 paragraph - 00B7 periodcentered - 00B8 cedilla - 00B9 onesuperior - 00BA ordmasculine - 00BB guillemotright - 00BC onequarter - 00BD onehalf - 00BE threequarters - 00BF questiondown - 00C0 Agrave - 00C1 Aacute - 00C2 Acircumflex - 00C3 Atilde - 00C4 Adieresis - 00C5 Aring - 00C6 AE - 00C7 Ccedilla - 00C8 Egrave - 00C9 Eacute - 00CA Ecircumflex - 00CB Edieresis - 00CC Igrave - 00CD Iacute - 00CE Icircumflex - 00CF Idieresis - 00D0 Eth - 00D1 Ntilde - 00D2 Ograve - 00D3 Oacute - 00D4 Ocircumflex - 00D5 Otilde - 00D6 Odieresis - 00D7 multiply - 00D8 Oslash - 00D9 Ugrave - 00DA Uacute - 00DB Ucircumflex - 00DC Udieresis - 00DD Yacute - 00DE Thorn - 00DF germandbls - 00E0 agrave - 00E1 aacute - 00E2 acircumflex - 00E3 atilde - 00E4 adieresis - 00E5 aring - 00E6 ae - 00E7 ccedilla - 00E8 egrave - 00E9 eacute - 00EA ecircumflex - 00EB edieresis - 00EC igrave - 00ED iacute - 00EE icircumflex - 00EF idieresis - 00F0 eth - 00F1 ntilde - 00F2 ograve - 00F3 oacute - 00F4 ocircumflex - 00F5 otilde - 00F6 odieresis - 00F7 divide - 00F8 oslash - 00F9 ugrave - 00FA uacute - 00FB ucircumflex - 00FC udieresis - 00FD yacute - 00FE thorn - 00FF ydieresis - 0100 Amacron - 0101 amacron - 0102 Abreve - 0103 abreve - 0104 Aogonek - 0105 aogonek - 0106 Cacute - 0107 cacute - 0108 Ccircumflex - 0109 ccircumflex - 010A Cdotaccent - 010B cdotaccent - 010C Ccaron - 010D ccaron - 010E Dcaron - 010F dcaron - 0110 Dcroat - 0111 dcroat - 0112 Emacron - 0113 emacron - 0114 Ebreve - 0115 ebreve - 0116 Edotaccent - 0117 edotaccent - 0118 Eogonek - 0119 eogonek - 011A Ecaron - 011B ecaron - 011C Gcircumflex - 011D gcircumflex - 011E Gbreve - 011F gbreve - 0120 Gdotaccent - 0121 gdotaccent - 0122 Gcommaaccent - 0123 gcommaaccent - 0124 Hcircumflex - 0125 hcircumflex - 0126 Hbar - 0127 hbar - 0128 Itilde - 0129 itilde - 012A Imacron - 012B imacron - 012C Ibreve - 012D ibreve - 012E Iogonek - 012F iogonek - 0130 Idotaccent - 0131 dotlessi - 0132 IJ - 0133 ij - 0134 Jcircumflex - 0135 jcircumflex - 0136 Kcommaaccent - 0137 kcommaaccent - 0138 kgreenlandic - 0139 Lacute - 013A lacute - 013B Lcommaaccent - 013C lcommaaccent - 013D Lcaron - 013E lcaron - 013F Ldot - 0140 ldot - 0141 Lslash - 0142 lslash - 0143 Nacute - 0144 nacute - 0145 Ncommaaccent - 0146 ncommaaccent - 0147 Ncaron - 0148 ncaron - 0149 napostrophe - 014A Eng - 014B eng - 014C Omacron - 014D omacron - 014E Obreve - 014F obreve - 0150 Ohungarumlaut - 0151 ohungarumlaut - 0152 OE - 0153 oe - 0154 Racute - 0155 racute - 0156 Rcommaaccent - 0157 rcommaaccent - 0158 Rcaron - 0159 rcaron - 015A Sacute - 015B sacute - 015C Scircumflex - 015D scircumflex - 015E Scedilla - 015F scedilla - 0160 Scaron - 0161 scaron - 0162 Tcommaaccent - 0163 tcommaaccent - 0164 Tcaron - 0165 tcaron - 0166 Tbar - 0167 tbar - 0168 Utilde - 0169 utilde - 016A Umacron - 016B umacron - 016C Ubreve - 016D ubreve - 016E Uring - 016F uring - 0170 Uhungarumlaut - 0171 uhungarumlaut - 0172 Uogonek - 0173 uogonek - 0174 Wcircumflex - 0175 wcircumflex - 0176 Ycircumflex - 0177 ycircumflex - 0178 Ydieresis - 0179 Zacute - 017A zacute - 017B Zdotaccent - 017C zdotaccent - 017D Zcaron - 017E zcaron - 017F longs - 0192 florin - 01A0 Ohorn - 01A1 ohorn - 01AF Uhorn - 01B0 uhorn - 01E6 Gcaron - 01E7 gcaron - 01FA Aringacute - 01FB aringacute - 01FC AEacute - 01FD aeacute - 01FE Oslashacute - 01FF oslashacute - 0218 Scommaaccent - 0219 scommaaccent - 021A Tcommaaccent - 021B tcommaaccent - 02BC afii57929 - 02BD afii64937 - 02C6 circumflex - 02C7 caron - 02C9 macron - 02D8 breve - 02D9 dotaccent - 02DA ring - 02DB ogonek - 02DC tilde - 02DD hungarumlaut - 0300 gravecomb - 0301 acutecomb - 0303 tildecomb - 0309 hookabovecomb - 0323 dotbelowcomb - 0384 tonos - 0385 dieresistonos - 0386 Alphatonos - 0387 anoteleia - 0388 Epsilontonos - 0389 Etatonos - 038A Iotatonos - 038C Omicrontonos - 038E Upsilontonos - 038F Omegatonos - 0390 iotadieresistonos - 0391 Alpha - 0392 Beta - 0393 Gamma - 0394 Delta - 0395 Epsilon - 0396 Zeta - 0397 Eta - 0398 Theta - 0399 Iota - 039A Kappa - 039B Lambda - 039C Mu - 039D Nu - 039E Xi - 039F Omicron - 03A0 Pi - 03A1 Rho - 03A3 Sigma - 03A4 Tau - 03A5 Upsilon - 03A6 Phi - 03A7 Chi - 03A8 Psi - 03A9 Omega - 03AA Iotadieresis - 03AB Upsilondieresis - 03AC alphatonos - 03AD epsilontonos - 03AE etatonos - 03AF iotatonos - 03B0 upsilondieresistonos - 03B1 alpha - 03B2 beta - 03B3 gamma - 03B4 delta - 03B5 epsilon - 03B6 zeta - 03B7 eta - 03B8 theta - 03B9 iota - 03BA kappa - 03BB lambda - 03BC mu - 03BD nu - 03BE xi - 03BF omicron - 03C0 pi - 03C1 rho - 03C2 sigma1 - 03C3 sigma - 03C4 tau - 03C5 upsilon - 03C6 phi - 03C7 chi - 03C8 psi - 03C9 omega - 03CA iotadieresis - 03CB upsilondieresis - 03CC omicrontonos - 03CD upsilontonos - 03CE omegatonos - 03D1 theta1 - 03D2 Upsilon1 - 03D5 phi1 - 03D6 omega1 - 0401 afii10023 - 0402 afii10051 - 0403 afii10052 - 0404 afii10053 - 0405 afii10054 - 0406 afii10055 - 0407 afii10056 - 0408 afii10057 - 0409 afii10058 - 040A afii10059 - 040B afii10060 - 040C afii10061 - 040E afii10062 - 040F afii10145 - 0410 afii10017 - 0411 afii10018 - 0412 afii10019 - 0413 afii10020 - 0414 afii10021 - 0415 afii10022 - 0416 afii10024 - 0417 afii10025 - 0418 afii10026 - 0419 afii10027 - 041A afii10028 - 041B afii10029 - 041C afii10030 - 041D afii10031 - 041E afii10032 - 041F afii10033 - 0420 afii10034 - 0421 afii10035 - 0422 afii10036 - 0423 afii10037 - 0424 afii10038 - 0425 afii10039 - 0426 afii10040 - 0427 afii10041 - 0428 afii10042 - 0429 afii10043 - 042A afii10044 - 042B afii10045 - 042C afii10046 - 042D afii10047 - 042E afii10048 - 042F afii10049 - 0430 afii10065 - 0431 afii10066 - 0432 afii10067 - 0433 afii10068 - 0434 afii10069 - 0435 afii10070 - 0436 afii10072 - 0437 afii10073 - 0438 afii10074 - 0439 afii10075 - 043A afii10076 - 043B afii10077 - 043C afii10078 - 043D afii10079 - 043E afii10080 - 043F afii10081 - 0440 afii10082 - 0441 afii10083 - 0442 afii10084 - 0443 afii10085 - 0444 afii10086 - 0445 afii10087 - 0446 afii10088 - 0447 afii10089 - 0448 afii10090 - 0449 afii10091 - 044A afii10092 - 044B afii10093 - 044C afii10094 - 044D afii10095 - 044E afii10096 - 044F afii10097 - 0451 afii10071 - 0452 afii10099 - 0453 afii10100 - 0454 afii10101 - 0455 afii10102 - 0456 afii10103 - 0457 afii10104 - 0458 afii10105 - 0459 afii10106 - 045A afii10107 - 045B afii10108 - 045C afii10109 - 045E afii10110 - 045F afii10193 - 0462 afii10146 - 0463 afii10194 - 0472 afii10147 - 0473 afii10195 - 0474 afii10148 - 0475 afii10196 - 0490 afii10050 - 0491 afii10098 - 04D9 afii10846 - 05B0 afii57799 - 05B1 afii57801 - 05B2 afii57800 - 05B3 afii57802 - 05B4 afii57793 - 05B5 afii57794 - 05B6 afii57795 - 05B7 afii57798 - 05B8 afii57797 - 05B9 afii57806 - 05BB afii57796 - 05BC afii57807 - 05BD afii57839 - 05BE afii57645 - 05BF afii57841 - 05C0 afii57842 - 05C1 afii57804 - 05C2 afii57803 - 05C3 afii57658 - 05D0 afii57664 - 05D1 afii57665 - 05D2 afii57666 - 05D3 afii57667 - 05D4 afii57668 - 05D5 afii57669 - 05D6 afii57670 - 05D7 afii57671 - 05D8 afii57672 - 05D9 afii57673 - 05DA afii57674 - 05DB afii57675 - 05DC afii57676 - 05DD afii57677 - 05DE afii57678 - 05DF afii57679 - 05E0 afii57680 - 05E1 afii57681 - 05E2 afii57682 - 05E3 afii57683 - 05E4 afii57684 - 05E5 afii57685 - 05E6 afii57686 - 05E7 afii57687 - 05E8 afii57688 - 05E9 afii57689 - 05EA afii57690 - 05F0 afii57716 - 05F1 afii57717 - 05F2 afii57718 - 060C afii57388 - 061B afii57403 - 061F afii57407 - 0621 afii57409 - 0622 afii57410 - 0623 afii57411 - 0624 afii57412 - 0625 afii57413 - 0626 afii57414 - 0627 afii57415 - 0628 afii57416 - 0629 afii57417 - 062A afii57418 - 062B afii57419 - 062C afii57420 - 062D afii57421 - 062E afii57422 - 062F afii57423 - 0630 afii57424 - 0631 afii57425 - 0632 afii57426 - 0633 afii57427 - 0634 afii57428 - 0635 afii57429 - 0636 afii57430 - 0637 afii57431 - 0638 afii57432 - 0639 afii57433 - 063A afii57434 - 0640 afii57440 - 0641 afii57441 - 0642 afii57442 - 0643 afii57443 - 0644 afii57444 - 0645 afii57445 - 0646 afii57446 - 0647 afii57470 - 0648 afii57448 - 0649 afii57449 - 064A afii57450 - 064B afii57451 - 064C afii57452 - 064D afii57453 - 064E afii57454 - 064F afii57455 - 0650 afii57456 - 0651 afii57457 - 0652 afii57458 - 0660 afii57392 - 0661 afii57393 - 0662 afii57394 - 0663 afii57395 - 0664 afii57396 - 0665 afii57397 - 0666 afii57398 - 0667 afii57399 - 0668 afii57400 - 0669 afii57401 - 066A afii57381 - 066D afii63167 - 0679 afii57511 - 067E afii57506 - 0686 afii57507 - 0688 afii57512 - 0691 afii57513 - 0698 afii57508 - 06A4 afii57505 - 06AF afii57509 - 06BA afii57514 - 06D2 afii57519 - 06D5 afii57534 - 1E80 Wgrave - 1E81 wgrave - 1E82 Wacute - 1E83 wacute - 1E84 Wdieresis - 1E85 wdieresis - 1EF2 Ygrave - 1EF3 ygrave - 200C afii61664 - 200D afii301 - 200E afii299 - 200F afii300 - 2012 figuredash - 2013 endash - 2014 emdash - 2015 afii00208 - 2017 underscoredbl - 2018 quoteleft - 2019 quoteright - 201A quotesinglbase - 201B quotereversed - 201C quotedblleft - 201D quotedblright - 201E quotedblbase - 2020 dagger - 2021 daggerdbl - 2022 bullet - 2024 onedotenleader - 2025 twodotenleader - 2026 ellipsis - 202C afii61573 - 202D afii61574 - 202E afii61575 - 2030 perthousand - 2032 minute - 2033 second - 2039 guilsinglleft - 203A guilsinglright - 203C exclamdbl - 2044 fraction - 2070 zerosuperior - 2074 foursuperior - 2075 fivesuperior - 2076 sixsuperior - 2077 sevensuperior - 2078 eightsuperior - 2079 ninesuperior - 207D parenleftsuperior - 207E parenrightsuperior - 207F nsuperior - 2080 zeroinferior - 2081 oneinferior - 2082 twoinferior - 2083 threeinferior - 2084 fourinferior - 2085 fiveinferior - 2086 sixinferior - 2087 seveninferior - 2088 eightinferior - 2089 nineinferior - 208D parenleftinferior - 208E parenrightinferior - 20A1 colonmonetary - 20A3 franc - 20A4 lira - 20A7 peseta - 20AA afii57636 - 20AB dong - 20AC Euro - 2105 afii61248 - 2111 Ifraktur - 2113 afii61289 - 2116 afii61352 - 2118 weierstrass - 211C Rfraktur - 211E prescription - 2122 trademark - 2126 Omega - 212E estimated - 2135 aleph - 2153 onethird - 2154 twothirds - 215B oneeighth - 215C threeeighths - 215D fiveeighths - 215E seveneighths - 2190 arrowleft - 2191 arrowup - 2192 arrowright - 2193 arrowdown - 2194 arrowboth - 2195 arrowupdn - 21A8 arrowupdnbse - 21B5 carriagereturn - 21D0 arrowdblleft - 21D1 arrowdblup - 21D2 arrowdblright - 21D3 arrowdbldown - 21D4 arrowdblboth - 2200 universal - 2202 partialdiff - 2203 existential - 2205 emptyset - 2206 Delta - 2207 gradient - 2208 element - 2209 notelement - 220B suchthat - 220F product - 2211 summation - 2212 minus - 2215 fraction - 2217 asteriskmath - 2219 periodcentered - 221A radical - 221D proportional - 221E infinity - 221F orthogonal - 2220 angle - 2227 logicaland - 2228 logicalor - 2229 intersection - 222A union - 222B integral - 2234 therefore - 223C similar - 2245 congruent - 2248 approxequal - 2260 notequal - 2261 equivalence - 2264 lessequal - 2265 greaterequal - 2282 propersubset - 2283 propersuperset - 2284 notsubset - 2286 reflexsubset - 2287 reflexsuperset - 2295 circleplus - 2297 circlemultiply - 22A5 perpendicular - 22C5 dotmath - 2302 house - 2310 revlogicalnot - 2320 integraltp - 2321 integralbt - 2329 angleleft - 232A angleright - 2500 SF100000 - 2502 SF110000 - 250C SF010000 - 2510 SF030000 - 2514 SF020000 - 2518 SF040000 - 251C SF080000 - 2524 SF090000 - 252C SF060000 - 2534 SF070000 - 253C SF050000 - 2550 SF430000 - 2551 SF240000 - 2552 SF510000 - 2553 SF520000 - 2554 SF390000 - 2555 SF220000 - 2556 SF210000 - 2557 SF250000 - 2558 SF500000 - 2559 SF490000 - 255A SF380000 - 255B SF280000 - 255C SF270000 - 255D SF260000 - 255E SF360000 - 255F SF370000 - 2560 SF420000 - 2561 SF190000 - 2562 SF200000 - 2563 SF230000 - 2564 SF470000 - 2565 SF480000 - 2566 SF410000 - 2567 SF450000 - 2568 SF460000 - 2569 SF400000 - 256A SF540000 - 256B SF530000 - 256C SF440000 - 2580 upblock - 2584 dnblock - 2588 block - 258C lfblock - 2590 rtblock - 2591 ltshade - 2592 shade - 2593 dkshade - 25A0 filledbox - 25A1 H22073 - 25AA H18543 - 25AB H18551 - 25AC filledrect - 25B2 triagup - 25BA triagrt - 25BC triagdn - 25C4 triaglf - 25CA lozenge - 25CB circle - 25CF H18533 - 25D8 invbullet - 25D9 invcircle - 25E6 openbullet - 263A smileface - 263B invsmileface - 263C sun - 2640 female - 2642 male - 2660 spade - 2663 club - 2665 heart - 2666 diamond - 266A musicalnote - 266B musicalnotedbl - F6BE dotlessj - F6BF LL - F6C0 ll - F6C1 Scedilla - F6C2 scedilla - F6C3 commaaccent - F6C4 afii10063 - F6C5 afii10064 - F6C6 afii10192 - F6C7 afii10831 - F6C8 afii10832 - F6C9 Acute - F6CA Caron - F6CB Dieresis - F6CC DieresisAcute - F6CD DieresisGrave - F6CE Grave - F6CF Hungarumlaut - F6D0 Macron - F6D1 cyrBreve - F6D2 cyrFlex - F6D3 dblGrave - F6D4 cyrbreve - F6D5 cyrflex - F6D6 dblgrave - F6D7 dieresisacute - F6D8 dieresisgrave - F6D9 copyrightserif - F6DA registerserif - F6DB trademarkserif - F6DC onefitted - F6DD rupiah - F6DE threequartersemdash - F6DF centinferior - F6E0 centsuperior - F6E1 commainferior - F6E2 commasuperior - F6E3 dollarinferior - F6E4 dollarsuperior - F6E5 hypheninferior - F6E6 hyphensuperior - F6E7 periodinferior - F6E8 periodsuperior - F6E9 asuperior - F6EA bsuperior - F6EB dsuperior - F6EC esuperior - F6ED isuperior - F6EE lsuperior - F6EF msuperior - F6F0 osuperior - F6F1 rsuperior - F6F2 ssuperior - F6F3 tsuperior - F6F4 Brevesmall - F6F5 Caronsmall - F6F6 Circumflexsmall - F6F7 Dotaccentsmall - F6F8 Hungarumlautsmall - F6F9 Lslashsmall - F6FA OEsmall - F6FB Ogoneksmall - F6FC Ringsmall - F6FD Scaronsmall - F6FE Tildesmall - F6FF Zcaronsmall - F721 exclamsmall - F724 dollaroldstyle - F726 ampersandsmall - F730 zerooldstyle - F731 oneoldstyle - F732 twooldstyle - F733 threeoldstyle - F734 fouroldstyle - F735 fiveoldstyle - F736 sixoldstyle - F737 sevenoldstyle - F738 eightoldstyle - F739 nineoldstyle - F73F questionsmall - F760 Gravesmall - F761 Asmall - F762 Bsmall - F763 Csmall - F764 Dsmall - F765 Esmall - F766 Fsmall - F767 Gsmall - F768 Hsmall - F769 Ismall - F76A Jsmall - F76B Ksmall - F76C Lsmall - F76D Msmall - F76E Nsmall - F76F Osmall - F770 Psmall - F771 Qsmall - F772 Rsmall - F773 Ssmall - F774 Tsmall - F775 Usmall - F776 Vsmall - F777 Wsmall - F778 Xsmall - F779 Ysmall - F77A Zsmall - F7A1 exclamdownsmall - F7A2 centoldstyle - F7A8 Dieresissmall - F7AF Macronsmall - F7B4 Acutesmall - F7B8 Cedillasmall - F7BF questiondownsmall - F7E0 Agravesmall - F7E1 Aacutesmall - F7E2 Acircumflexsmall - F7E3 Atildesmall - F7E4 Adieresissmall - F7E5 Aringsmall - F7E6 AEsmall - F7E7 Ccedillasmall - F7E8 Egravesmall - F7E9 Eacutesmall - F7EA Ecircumflexsmall - F7EB Edieresissmall - F7EC Igravesmall - F7ED Iacutesmall - F7EE Icircumflexsmall - F7EF Idieresissmall - F7F0 Ethsmall - F7F1 Ntildesmall - F7F2 Ogravesmall - F7F3 Oacutesmall - F7F4 Ocircumflexsmall - F7F5 Otildesmall - F7F6 Odieresissmall - F7F8 Oslashsmall - F7F9 Ugravesmall - F7FA Uacutesmall - F7FB Ucircumflexsmall - F7FC Udieresissmall - F7FD Yacutesmall - F7FE Thornsmall - F7FF Ydieresissmall - F8E5 radicalex - F8E6 arrowvertex - F8E7 arrowhorizex - F8E8 registersans - F8E9 copyrightsans - F8EA trademarksans - F8EB parenlefttp - F8EC parenleftex - F8ED parenleftbt - F8EE bracketlefttp - F8EF bracketleftex - F8F0 bracketleftbt - F8F1 bracelefttp - F8F2 braceleftmid - F8F3 braceleftbt - F8F4 braceex - F8F5 integralex - F8F6 parenrighttp - F8F7 parenrightex - F8F8 parenrightbt - F8F9 bracketrighttp - F8FA bracketrightex - F8FB bracketrightbt - F8FC bracerighttp - F8FD bracerightmid - F8FE bracerightbt - FB00 ff - FB01 fi - FB02 fl - FB03 ffi - FB04 ffl - FB1F afii57705 - FB2A afii57694 - FB2B afii57695 - FB35 afii57723 - FB4B afii57700 -} - -# precalculate entire prolog when this file is loaded -# (to speed things up) -set ps_preamable "%%BeginProlog\n" -append ps_preamable [CreatePostscriptEncoding [encoding system]] -append ps_preamable { -50 dict begin -% This is a standard prolog for Postscript generated by Tk's canvas -% widget. -% The definitions below just define all of the variables used in -% any of the procedures here. This is needed for obscure reasons -% explained on p. 716 of the Postscript manual (Section H.2.7, -% "Initializing Variables," in the section on Encapsulated Postscript). + # List of adobe glyph names. Converted from glyphlist.txt, downloaded from + # Adobe. -/baseline 0 def -/stipimage 0 def -/height 0 def -/justify 0 def -/lineLength 0 def -/spacing 0 def -/stipple 0 def -/strings 0 def -/xoffset 0 def -/yoffset 0 def -/tmpstip null def + variable psglyphs + array set psglyphs { + 0020 space + 0021 exclam + 0022 quotedbl + 0023 numbersign + 0024 dollar + 0025 percent + 0026 ampersand + 0027 quotesingle + 0028 parenleft + 0029 parenright + 002A asterisk + 002B plus + 002C comma + 002D hyphen + 002E period + 002F slash + 0030 zero + 0031 one + 0032 two + 0033 three + 0034 four + 0035 five + 0036 six + 0037 seven + 0038 eight + 0039 nine + 003A colon + 003B semicolon + 003C less + 003D equal + 003E greater + 003F question + 0040 at + 0041 A + 0042 B + 0043 C + 0044 D + 0045 E + 0046 F + 0047 G + 0048 H + 0049 I + 004A J + 004B K + 004C L + 004D M + 004E N + 004F O + 0050 P + 0051 Q + 0052 R + 0053 S + 0054 T + 0055 U + 0056 V + 0057 W + 0058 X + 0059 Y + 005A Z + 005B bracketleft + 005C backslash + 005D bracketright + 005E asciicircum + 005F underscore + 0060 grave + 0061 a + 0062 b + 0063 c + 0064 d + 0065 e + 0066 f + 0067 g + 0068 h + 0069 i + 006A j + 006B k + 006C l + 006D m + 006E n + 006F o + 0070 p + 0071 q + 0072 r + 0073 s + 0074 t + 0075 u + 0076 v + 0077 w + 0078 x + 0079 y + 007A z + 007B braceleft + 007C bar + 007D braceright + 007E asciitilde + 00A0 space + 00A1 exclamdown + 00A2 cent + 00A3 sterling + 00A4 currency + 00A5 yen + 00A6 brokenbar + 00A7 section + 00A8 dieresis + 00A9 copyright + 00AA ordfeminine + 00AB guillemotleft + 00AC logicalnot + 00AD hyphen + 00AE registered + 00AF macron + 00B0 degree + 00B1 plusminus + 00B2 twosuperior + 00B3 threesuperior + 00B4 acute + 00B5 mu + 00B6 paragraph + 00B7 periodcentered + 00B8 cedilla + 00B9 onesuperior + 00BA ordmasculine + 00BB guillemotright + 00BC onequarter + 00BD onehalf + 00BE threequarters + 00BF questiondown + 00C0 Agrave + 00C1 Aacute + 00C2 Acircumflex + 00C3 Atilde + 00C4 Adieresis + 00C5 Aring + 00C6 AE + 00C7 Ccedilla + 00C8 Egrave + 00C9 Eacute + 00CA Ecircumflex + 00CB Edieresis + 00CC Igrave + 00CD Iacute + 00CE Icircumflex + 00CF Idieresis + 00D0 Eth + 00D1 Ntilde + 00D2 Ograve + 00D3 Oacute + 00D4 Ocircumflex + 00D5 Otilde + 00D6 Odieresis + 00D7 multiply + 00D8 Oslash + 00D9 Ugrave + 00DA Uacute + 00DB Ucircumflex + 00DC Udieresis + 00DD Yacute + 00DE Thorn + 00DF germandbls + 00E0 agrave + 00E1 aacute + 00E2 acircumflex + 00E3 atilde + 00E4 adieresis + 00E5 aring + 00E6 ae + 00E7 ccedilla + 00E8 egrave + 00E9 eacute + 00EA ecircumflex + 00EB edieresis + 00EC igrave + 00ED iacute + 00EE icircumflex + 00EF idieresis + 00F0 eth + 00F1 ntilde + 00F2 ograve + 00F3 oacute + 00F4 ocircumflex + 00F5 otilde + 00F6 odieresis + 00F7 divide + 00F8 oslash + 00F9 ugrave + 00FA uacute + 00FB ucircumflex + 00FC udieresis + 00FD yacute + 00FE thorn + 00FF ydieresis + 0100 Amacron + 0101 amacron + 0102 Abreve + 0103 abreve + 0104 Aogonek + 0105 aogonek + 0106 Cacute + 0107 cacute + 0108 Ccircumflex + 0109 ccircumflex + 010A Cdotaccent + 010B cdotaccent + 010C Ccaron + 010D ccaron + 010E Dcaron + 010F dcaron + 0110 Dcroat + 0111 dcroat + 0112 Emacron + 0113 emacron + 0114 Ebreve + 0115 ebreve + 0116 Edotaccent + 0117 edotaccent + 0118 Eogonek + 0119 eogonek + 011A Ecaron + 011B ecaron + 011C Gcircumflex + 011D gcircumflex + 011E Gbreve + 011F gbreve + 0120 Gdotaccent + 0121 gdotaccent + 0122 Gcommaaccent + 0123 gcommaaccent + 0124 Hcircumflex + 0125 hcircumflex + 0126 Hbar + 0127 hbar + 0128 Itilde + 0129 itilde + 012A Imacron + 012B imacron + 012C Ibreve + 012D ibreve + 012E Iogonek + 012F iogonek + 0130 Idotaccent + 0131 dotlessi + 0132 IJ + 0133 ij + 0134 Jcircumflex + 0135 jcircumflex + 0136 Kcommaaccent + 0137 kcommaaccent + 0138 kgreenlandic + 0139 Lacute + 013A lacute + 013B Lcommaaccent + 013C lcommaaccent + 013D Lcaron + 013E lcaron + 013F Ldot + 0140 ldot + 0141 Lslash + 0142 lslash + 0143 Nacute + 0144 nacute + 0145 Ncommaaccent + 0146 ncommaaccent + 0147 Ncaron + 0148 ncaron + 0149 napostrophe + 014A Eng + 014B eng + 014C Omacron + 014D omacron + 014E Obreve + 014F obreve + 0150 Ohungarumlaut + 0151 ohungarumlaut + 0152 OE + 0153 oe + 0154 Racute + 0155 racute + 0156 Rcommaaccent + 0157 rcommaaccent + 0158 Rcaron + 0159 rcaron + 015A Sacute + 015B sacute + 015C Scircumflex + 015D scircumflex + 015E Scedilla + 015F scedilla + 0160 Scaron + 0161 scaron + 0162 Tcommaaccent + 0163 tcommaaccent + 0164 Tcaron + 0165 tcaron + 0166 Tbar + 0167 tbar + 0168 Utilde + 0169 utilde + 016A Umacron + 016B umacron + 016C Ubreve + 016D ubreve + 016E Uring + 016F uring + 0170 Uhungarumlaut + 0171 uhungarumlaut + 0172 Uogonek + 0173 uogonek + 0174 Wcircumflex + 0175 wcircumflex + 0176 Ycircumflex + 0177 ycircumflex + 0178 Ydieresis + 0179 Zacute + 017A zacute + 017B Zdotaccent + 017C zdotaccent + 017D Zcaron + 017E zcaron + 017F longs + 0192 florin + 01A0 Ohorn + 01A1 ohorn + 01AF Uhorn + 01B0 uhorn + 01E6 Gcaron + 01E7 gcaron + 01FA Aringacute + 01FB aringacute + 01FC AEacute + 01FD aeacute + 01FE Oslashacute + 01FF oslashacute + 0218 Scommaaccent + 0219 scommaaccent + 021A Tcommaaccent + 021B tcommaaccent + 02BC afii57929 + 02BD afii64937 + 02C6 circumflex + 02C7 caron + 02C9 macron + 02D8 breve + 02D9 dotaccent + 02DA ring + 02DB ogonek + 02DC tilde + 02DD hungarumlaut + 0300 gravecomb + 0301 acutecomb + 0303 tildecomb + 0309 hookabovecomb + 0323 dotbelowcomb + 0384 tonos + 0385 dieresistonos + 0386 Alphatonos + 0387 anoteleia + 0388 Epsilontonos + 0389 Etatonos + 038A Iotatonos + 038C Omicrontonos + 038E Upsilontonos + 038F Omegatonos + 0390 iotadieresistonos + 0391 Alpha + 0392 Beta + 0393 Gamma + 0394 Delta + 0395 Epsilon + 0396 Zeta + 0397 Eta + 0398 Theta + 0399 Iota + 039A Kappa + 039B Lambda + 039C Mu + 039D Nu + 039E Xi + 039F Omicron + 03A0 Pi + 03A1 Rho + 03A3 Sigma + 03A4 Tau + 03A5 Upsilon + 03A6 Phi + 03A7 Chi + 03A8 Psi + 03A9 Omega + 03AA Iotadieresis + 03AB Upsilondieresis + 03AC alphatonos + 03AD epsilontonos + 03AE etatonos + 03AF iotatonos + 03B0 upsilondieresistonos + 03B1 alpha + 03B2 beta + 03B3 gamma + 03B4 delta + 03B5 epsilon + 03B6 zeta + 03B7 eta + 03B8 theta + 03B9 iota + 03BA kappa + 03BB lambda + 03BC mu + 03BD nu + 03BE xi + 03BF omicron + 03C0 pi + 03C1 rho + 03C2 sigma1 + 03C3 sigma + 03C4 tau + 03C5 upsilon + 03C6 phi + 03C7 chi + 03C8 psi + 03C9 omega + 03CA iotadieresis + 03CB upsilondieresis + 03CC omicrontonos + 03CD upsilontonos + 03CE omegatonos + 03D1 theta1 + 03D2 Upsilon1 + 03D5 phi1 + 03D6 omega1 + 0401 afii10023 + 0402 afii10051 + 0403 afii10052 + 0404 afii10053 + 0405 afii10054 + 0406 afii10055 + 0407 afii10056 + 0408 afii10057 + 0409 afii10058 + 040A afii10059 + 040B afii10060 + 040C afii10061 + 040E afii10062 + 040F afii10145 + 0410 afii10017 + 0411 afii10018 + 0412 afii10019 + 0413 afii10020 + 0414 afii10021 + 0415 afii10022 + 0416 afii10024 + 0417 afii10025 + 0418 afii10026 + 0419 afii10027 + 041A afii10028 + 041B afii10029 + 041C afii10030 + 041D afii10031 + 041E afii10032 + 041F afii10033 + 0420 afii10034 + 0421 afii10035 + 0422 afii10036 + 0423 afii10037 + 0424 afii10038 + 0425 afii10039 + 0426 afii10040 + 0427 afii10041 + 0428 afii10042 + 0429 afii10043 + 042A afii10044 + 042B afii10045 + 042C afii10046 + 042D afii10047 + 042E afii10048 + 042F afii10049 + 0430 afii10065 + 0431 afii10066 + 0432 afii10067 + 0433 afii10068 + 0434 afii10069 + 0435 afii10070 + 0436 afii10072 + 0437 afii10073 + 0438 afii10074 + 0439 afii10075 + 043A afii10076 + 043B afii10077 + 043C afii10078 + 043D afii10079 + 043E afii10080 + 043F afii10081 + 0440 afii10082 + 0441 afii10083 + 0442 afii10084 + 0443 afii10085 + 0444 afii10086 + 0445 afii10087 + 0446 afii10088 + 0447 afii10089 + 0448 afii10090 + 0449 afii10091 + 044A afii10092 + 044B afii10093 + 044C afii10094 + 044D afii10095 + 044E afii10096 + 044F afii10097 + 0451 afii10071 + 0452 afii10099 + 0453 afii10100 + 0454 afii10101 + 0455 afii10102 + 0456 afii10103 + 0457 afii10104 + 0458 afii10105 + 0459 afii10106 + 045A afii10107 + 045B afii10108 + 045C afii10109 + 045E afii10110 + 045F afii10193 + 0462 afii10146 + 0463 afii10194 + 0472 afii10147 + 0473 afii10195 + 0474 afii10148 + 0475 afii10196 + 0490 afii10050 + 0491 afii10098 + 04D9 afii10846 + 05B0 afii57799 + 05B1 afii57801 + 05B2 afii57800 + 05B3 afii57802 + 05B4 afii57793 + 05B5 afii57794 + 05B6 afii57795 + 05B7 afii57798 + 05B8 afii57797 + 05B9 afii57806 + 05BB afii57796 + 05BC afii57807 + 05BD afii57839 + 05BE afii57645 + 05BF afii57841 + 05C0 afii57842 + 05C1 afii57804 + 05C2 afii57803 + 05C3 afii57658 + 05D0 afii57664 + 05D1 afii57665 + 05D2 afii57666 + 05D3 afii57667 + 05D4 afii57668 + 05D5 afii57669 + 05D6 afii57670 + 05D7 afii57671 + 05D8 afii57672 + 05D9 afii57673 + 05DA afii57674 + 05DB afii57675 + 05DC afii57676 + 05DD afii57677 + 05DE afii57678 + 05DF afii57679 + 05E0 afii57680 + 05E1 afii57681 + 05E2 afii57682 + 05E3 afii57683 + 05E4 afii57684 + 05E5 afii57685 + 05E6 afii57686 + 05E7 afii57687 + 05E8 afii57688 + 05E9 afii57689 + 05EA afii57690 + 05F0 afii57716 + 05F1 afii57717 + 05F2 afii57718 + 060C afii57388 + 061B afii57403 + 061F afii57407 + 0621 afii57409 + 0622 afii57410 + 0623 afii57411 + 0624 afii57412 + 0625 afii57413 + 0626 afii57414 + 0627 afii57415 + 0628 afii57416 + 0629 afii57417 + 062A afii57418 + 062B afii57419 + 062C afii57420 + 062D afii57421 + 062E afii57422 + 062F afii57423 + 0630 afii57424 + 0631 afii57425 + 0632 afii57426 + 0633 afii57427 + 0634 afii57428 + 0635 afii57429 + 0636 afii57430 + 0637 afii57431 + 0638 afii57432 + 0639 afii57433 + 063A afii57434 + 0640 afii57440 + 0641 afii57441 + 0642 afii57442 + 0643 afii57443 + 0644 afii57444 + 0645 afii57445 + 0646 afii57446 + 0647 afii57470 + 0648 afii57448 + 0649 afii57449 + 064A afii57450 + 064B afii57451 + 064C afii57452 + 064D afii57453 + 064E afii57454 + 064F afii57455 + 0650 afii57456 + 0651 afii57457 + 0652 afii57458 + 0660 afii57392 + 0661 afii57393 + 0662 afii57394 + 0663 afii57395 + 0664 afii57396 + 0665 afii57397 + 0666 afii57398 + 0667 afii57399 + 0668 afii57400 + 0669 afii57401 + 066A afii57381 + 066D afii63167 + 0679 afii57511 + 067E afii57506 + 0686 afii57507 + 0688 afii57512 + 0691 afii57513 + 0698 afii57508 + 06A4 afii57505 + 06AF afii57509 + 06BA afii57514 + 06D2 afii57519 + 06D5 afii57534 + 1E80 Wgrave + 1E81 wgrave + 1E82 Wacute + 1E83 wacute + 1E84 Wdieresis + 1E85 wdieresis + 1EF2 Ygrave + 1EF3 ygrave + 200C afii61664 + 200D afii301 + 200E afii299 + 200F afii300 + 2012 figuredash + 2013 endash + 2014 emdash + 2015 afii00208 + 2017 underscoredbl + 2018 quoteleft + 2019 quoteright + 201A quotesinglbase + 201B quotereversed + 201C quotedblleft + 201D quotedblright + 201E quotedblbase + 2020 dagger + 2021 daggerdbl + 2022 bullet + 2024 onedotenleader + 2025 twodotenleader + 2026 ellipsis + 202C afii61573 + 202D afii61574 + 202E afii61575 + 2030 perthousand + 2032 minute + 2033 second + 2039 guilsinglleft + 203A guilsinglright + 203C exclamdbl + 2044 fraction + 2070 zerosuperior + 2074 foursuperior + 2075 fivesuperior + 2076 sixsuperior + 2077 sevensuperior + 2078 eightsuperior + 2079 ninesuperior + 207D parenleftsuperior + 207E parenrightsuperior + 207F nsuperior + 2080 zeroinferior + 2081 oneinferior + 2082 twoinferior + 2083 threeinferior + 2084 fourinferior + 2085 fiveinferior + 2086 sixinferior + 2087 seveninferior + 2088 eightinferior + 2089 nineinferior + 208D parenleftinferior + 208E parenrightinferior + 20A1 colonmonetary + 20A3 franc + 20A4 lira + 20A7 peseta + 20AA afii57636 + 20AB dong + 20AC Euro + 2105 afii61248 + 2111 Ifraktur + 2113 afii61289 + 2116 afii61352 + 2118 weierstrass + 211C Rfraktur + 211E prescription + 2122 trademark + 2126 Omega + 212E estimated + 2135 aleph + 2153 onethird + 2154 twothirds + 215B oneeighth + 215C threeeighths + 215D fiveeighths + 215E seveneighths + 2190 arrowleft + 2191 arrowup + 2192 arrowright + 2193 arrowdown + 2194 arrowboth + 2195 arrowupdn + 21A8 arrowupdnbse + 21B5 carriagereturn + 21D0 arrowdblleft + 21D1 arrowdblup + 21D2 arrowdblright + 21D3 arrowdbldown + 21D4 arrowdblboth + 2200 universal + 2202 partialdiff + 2203 existential + 2205 emptyset + 2206 Delta + 2207 gradient + 2208 element + 2209 notelement + 220B suchthat + 220F product + 2211 summation + 2212 minus + 2215 fraction + 2217 asteriskmath + 2219 periodcentered + 221A radical + 221D proportional + 221E infinity + 221F orthogonal + 2220 angle + 2227 logicaland + 2228 logicalor + 2229 intersection + 222A union + 222B integral + 2234 therefore + 223C similar + 2245 congruent + 2248 approxequal + 2260 notequal + 2261 equivalence + 2264 lessequal + 2265 greaterequal + 2282 propersubset + 2283 propersuperset + 2284 notsubset + 2286 reflexsubset + 2287 reflexsuperset + 2295 circleplus + 2297 circlemultiply + 22A5 perpendicular + 22C5 dotmath + 2302 house + 2310 revlogicalnot + 2320 integraltp + 2321 integralbt + 2329 angleleft + 232A angleright + 2500 SF100000 + 2502 SF110000 + 250C SF010000 + 2510 SF030000 + 2514 SF020000 + 2518 SF040000 + 251C SF080000 + 2524 SF090000 + 252C SF060000 + 2534 SF070000 + 253C SF050000 + 2550 SF430000 + 2551 SF240000 + 2552 SF510000 + 2553 SF520000 + 2554 SF390000 + 2555 SF220000 + 2556 SF210000 + 2557 SF250000 + 2558 SF500000 + 2559 SF490000 + 255A SF380000 + 255B SF280000 + 255C SF270000 + 255D SF260000 + 255E SF360000 + 255F SF370000 + 2560 SF420000 + 2561 SF190000 + 2562 SF200000 + 2563 SF230000 + 2564 SF470000 + 2565 SF480000 + 2566 SF410000 + 2567 SF450000 + 2568 SF460000 + 2569 SF400000 + 256A SF540000 + 256B SF530000 + 256C SF440000 + 2580 upblock + 2584 dnblock + 2588 block + 258C lfblock + 2590 rtblock + 2591 ltshade + 2592 shade + 2593 dkshade + 25A0 filledbox + 25A1 H22073 + 25AA H18543 + 25AB H18551 + 25AC filledrect + 25B2 triagup + 25BA triagrt + 25BC triagdn + 25C4 triaglf + 25CA lozenge + 25CB circle + 25CF H18533 + 25D8 invbullet + 25D9 invcircle + 25E6 openbullet + 263A smileface + 263B invsmileface + 263C sun + 2640 female + 2642 male + 2660 spade + 2663 club + 2665 heart + 2666 diamond + 266A musicalnote + 266B musicalnotedbl + F6BE dotlessj + F6BF LL + F6C0 ll + F6C1 Scedilla + F6C2 scedilla + F6C3 commaaccent + F6C4 afii10063 + F6C5 afii10064 + F6C6 afii10192 + F6C7 afii10831 + F6C8 afii10832 + F6C9 Acute + F6CA Caron + F6CB Dieresis + F6CC DieresisAcute + F6CD DieresisGrave + F6CE Grave + F6CF Hungarumlaut + F6D0 Macron + F6D1 cyrBreve + F6D2 cyrFlex + F6D3 dblGrave + F6D4 cyrbreve + F6D5 cyrflex + F6D6 dblgrave + F6D7 dieresisacute + F6D8 dieresisgrave + F6D9 copyrightserif + F6DA registerserif + F6DB trademarkserif + F6DC onefitted + F6DD rupiah + F6DE threequartersemdash + F6DF centinferior + F6E0 centsuperior + F6E1 commainferior + F6E2 commasuperior + F6E3 dollarinferior + F6E4 dollarsuperior + F6E5 hypheninferior + F6E6 hyphensuperior + F6E7 periodinferior + F6E8 periodsuperior + F6E9 asuperior + F6EA bsuperior + F6EB dsuperior + F6EC esuperior + F6ED isuperior + F6EE lsuperior + F6EF msuperior + F6F0 osuperior + F6F1 rsuperior + F6F2 ssuperior + F6F3 tsuperior + F6F4 Brevesmall + F6F5 Caronsmall + F6F6 Circumflexsmall + F6F7 Dotaccentsmall + F6F8 Hungarumlautsmall + F6F9 Lslashsmall + F6FA OEsmall + F6FB Ogoneksmall + F6FC Ringsmall + F6FD Scaronsmall + F6FE Tildesmall + F6FF Zcaronsmall + F721 exclamsmall + F724 dollaroldstyle + F726 ampersandsmall + F730 zerooldstyle + F731 oneoldstyle + F732 twooldstyle + F733 threeoldstyle + F734 fouroldstyle + F735 fiveoldstyle + F736 sixoldstyle + F737 sevenoldstyle + F738 eightoldstyle + F739 nineoldstyle + F73F questionsmall + F760 Gravesmall + F761 Asmall + F762 Bsmall + F763 Csmall + F764 Dsmall + F765 Esmall + F766 Fsmall + F767 Gsmall + F768 Hsmall + F769 Ismall + F76A Jsmall + F76B Ksmall + F76C Lsmall + F76D Msmall + F76E Nsmall + F76F Osmall + F770 Psmall + F771 Qsmall + F772 Rsmall + F773 Ssmall + F774 Tsmall + F775 Usmall + F776 Vsmall + F777 Wsmall + F778 Xsmall + F779 Ysmall + F77A Zsmall + F7A1 exclamdownsmall + F7A2 centoldstyle + F7A8 Dieresissmall + F7AF Macronsmall + F7B4 Acutesmall + F7B8 Cedillasmall + F7BF questiondownsmall + F7E0 Agravesmall + F7E1 Aacutesmall + F7E2 Acircumflexsmall + F7E3 Atildesmall + F7E4 Adieresissmall + F7E5 Aringsmall + F7E6 AEsmall + F7E7 Ccedillasmall + F7E8 Egravesmall + F7E9 Eacutesmall + F7EA Ecircumflexsmall + F7EB Edieresissmall + F7EC Igravesmall + F7ED Iacutesmall + F7EE Icircumflexsmall + F7EF Idieresissmall + F7F0 Ethsmall + F7F1 Ntildesmall + F7F2 Ogravesmall + F7F3 Oacutesmall + F7F4 Ocircumflexsmall + F7F5 Otildesmall + F7F6 Odieresissmall + F7F8 Oslashsmall + F7F9 Ugravesmall + F7FA Uacutesmall + F7FB Ucircumflexsmall + F7FC Udieresissmall + F7FD Yacutesmall + F7FE Thornsmall + F7FF Ydieresissmall + F8E5 radicalex + F8E6 arrowvertex + F8E7 arrowhorizex + F8E8 registersans + F8E9 copyrightsans + F8EA trademarksans + F8EB parenlefttp + F8EC parenleftex + F8ED parenleftbt + F8EE bracketlefttp + F8EF bracketleftex + F8F0 bracketleftbt + F8F1 bracelefttp + F8F2 braceleftmid + F8F3 braceleftbt + F8F4 braceex + F8F5 integralex + F8F6 parenrighttp + F8F7 parenrightex + F8F8 parenrightbt + F8F9 bracketrighttp + F8FA bracketrightex + F8FB bracketrightbt + F8FC bracerighttp + F8FD bracerightmid + F8FE bracerightbt + FB00 ff + FB01 fi + FB02 fl + FB03 ffi + FB04 ffl + FB1F afii57705 + FB2A afii57694 + FB2B afii57695 + FB35 afii57723 + FB4B afii57700 + } + variable ps_preamble {} -/cstringshow { - { - dup type /stringtype eq - { show } { glyphshow } - ifelse + namespace eval ps { + namespace ensemble create + namespace export {[a-z]*} + proc literal {string} { + upvar 0 ::tk::ps_preamble preamble + foreach line [split $string \n] { + set line [string trim $line] + if {$line eq ""} continue + append preamble $line \n + } + return + } + proc variable {name value} { + upvar 0 ::tk::ps_preamble preamble + append preamble "/$name $value def\n" + return + } + proc function {name body} { + upvar 0 ::tk::ps_preamble preamble + append preamble "/$name \{" + foreach line [split $body \n] { + set line [string trim $line] + # Strip blank lines and comments from the bodies of functions + if {$line eq "" } continue + if {[string match {[%#]*} $line]} continue + append preamble $line " " + } + append preamble "\} bind def\n" + return + } } - forall -} bind def + ps literal { + %%BeginProlog + % This is a standard prolog for Postscript generated by Tk's canvas + % widget. + } + ps variable CurrentEncoding [CreatePostscriptEncoding] + ps literal {50 dict begin} + # The definitions below just define all of the variables used in any of + # the procedures here. This is needed for obscure reasons explained on + # p. 716 of the Postscript manual (Section H.2.7, "Initializing + # Variables," in the section on Encapsulated Postscript). + ps variable baseline 0 + ps variable stipimage 0 + ps variable height 0 + ps variable justify 0 + ps variable lineLength 0 + ps variable spacing 0 + ps variable stipple 0 + ps variable strings 0 + ps variable xoffset 0 + ps variable yoffset 0 + ps variable tmpstip null + ps variable baselineSampler "( TXygqPZ)" + # Put an extra-tall character in; done this way to avoid encoding trouble + ps literal {baselineSampler 0 196 put} -/cstringwidth { - 0 exch 0 exch - { - dup type /stringtype eq - { stringwidth } { - currentfont /Encoding get exch 1 exch put (\001) stringwidth - } - ifelse - exch 3 1 roll add 3 1 roll add exch + ps function cstringshow { + { + dup type /stringtype eq + { show } { glyphshow } + ifelse + } forall } - forall -} bind def -% font ISOEncode font -% This procedure changes the encoding of a font from the default -% Postscript encoding to current system encoding. It's typically invoked just -% before invoking "setfont". The body of this procedure comes from -% Section 5.6.1 of the Postscript book. + ps function cstringwidth { + 0 exch 0 exch + { + dup type /stringtype eq + { stringwidth } { + currentfont /Encoding get exch 1 exch put (\001) + stringwidth + } + ifelse + exch 3 1 roll add 3 1 roll add exch + } forall + } -/ISOEncode { - dup length dict begin + # font ISOEncode font + # + # This procedure changes the encoding of a font from the default + # Postscript encoding to current system encoding. It's typically invoked + # just before invoking "setfont". The body of this procedure comes from + # Section 5.6.1 of the Postscript book. + ps function ISOEncode { + dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall /Encoding CurrentEncoding def currentdict - end - - % I'm not sure why it's necessary to use "definefont" on this new - % font, but it seems to be important; just use the name "Temporary" - % for the font. - - /Temporary exch definefont -} bind def - -% StrokeClip -% -% This procedure converts the current path into a clip area under -% the assumption of stroking. It's a bit tricky because some Postscript -% interpreters get errors during strokepath for dashed lines. If -% this happens then turn off dashes and try again. - -/StrokeClip { - {strokepath} stopped { - (This Postscript printer gets limitcheck overflows when) = - (stippling dashed lines; lines will be printed solid instead.) = - [] 0 setdash strokepath} if - clip -} bind def - -% desiredSize EvenPixels closestSize -% -% The procedure below is used for stippling. Given the optimal size -% of a dot in a stipple pattern in the current user coordinate system, -% compute the closest size that is an exact multiple of the device's -% pixel size. This allows stipple patterns to be displayed without -% aliasing effects. - -/EvenPixels { - % Compute exact number of device pixels per stipple dot. - dup 0 matrix currentmatrix dtransform - dup mul exch dup mul add sqrt - - % Round to an integer, make sure the number is at least 1, and compute - % user coord distance corresponding to this. - dup round dup 1 lt {pop 1} if - exch div mul -} bind def - -% width height string StippleFill -- -% -% Given a path already set up and a clipping region generated from -% it, this procedure will fill the clipping region with a stipple -% pattern. "String" contains a proper image description of the -% stipple pattern and "width" and "height" give its dimensions. Each -% stipple dot is assumed to be about one unit across in the current -% user coordinate system. This procedure trashes the graphics state. - -/StippleFill { - % The following code is needed to work around a NeWSprint bug. - - /tmpstip 1 index def - - % Change the scaling so that one user unit in user coordinates - % corresponds to the size of one stipple dot. - 1 EvenPixels dup scale - - % Compute the bounding box occupied by the path (which is now - % the clipping region), and round the lower coordinates down - % to the nearest starting point for the stipple pattern. Be - % careful about negative numbers, since the rounding works - % differently on them. - - pathbbox - 4 2 roll - 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll - 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll + end + % I'm not sure why it's necessary to use "definefont" on this new + % font, but it seems to be important; just use the name "Temporary" + % for the font. + /Temporary exch definefont + } - % Stack now: width height string y1 y2 x1 x2 - % Below is a doubly-nested for loop to iterate across this area - % in units of the stipple pattern size, going up columns then - % across rows, blasting out a stipple-pattern-sized rectangle at - % each position + # StrokeClip + # + # This procedure converts the current path into a clip area under the + # assumption of stroking. It's a bit tricky because some Postscript + # interpreters get errors during strokepath for dashed lines. If this + # happens then turn off dashes and try again. + ps function StrokeClip { + {strokepath} stopped { + (This Postscript printer gets limitcheck overflows when) = + (stippling dashed lines; lines will be printed solid instead.) = + [] 0 setdash strokepath} if + clip + } - 6 index exch { - 2 index 5 index 3 index { - % Stack now: width height string y1 y2 x y + # desiredSize EvenPixels closestSize + # + # The procedure below is used for stippling. Given the optimal size of a + # dot in a stipple pattern in the current user coordinate system, compute + # the closest size that is an exact multiple of the device's pixel + # size. This allows stipple patterns to be displayed without aliasing + # effects. + ps function EvenPixels { + % Compute exact number of device pixels per stipple dot. + dup 0 matrix currentmatrix dtransform + dup mul exch dup mul add sqrt + % Round to an integer, make sure the number is at least 1, and + % compute user coord distance corresponding to this. + dup round dup 1 lt {pop 1} if + exch div mul + } - gsave - 1 index exch translate - 5 index 5 index true matrix tmpstip imagemask - grestore + # width height string StippleFill -- + # + # Given a path already set up and a clipping region generated from it, + # this procedure will fill the clipping region with a stipple pattern. + # "String" contains a proper image description of the stipple pattern and + # "width" and "height" give its dimensions. Each stipple dot is assumed to + # be about one unit across in the current user coordinate system. This + # procedure trashes the graphics state. + ps function StippleFill { + % The following code is needed to work around a NeWSprint bug. + /tmpstip 1 index def + % Change the scaling so that one user unit in user coordinates + % corresponds to the size of one stipple dot. + 1 EvenPixels dup scale + % Compute the bounding box occupied by the path (which is now the + % clipping region), and round the lower coordinates down to the + % nearest starting point for the stipple pattern. Be careful about + % negative numbers, since the rounding works differently on them. + pathbbox + 4 2 roll + 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll + 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll + % Stack now: width height string y1 y2 x1 x2 + % Below is a doubly-nested for loop to iterate across this area + % in units of the stipple pattern size, going up columns then + % across rows, blasting out a stipple-pattern-sized rectangle at + % each position + 6 index exch { + 2 index 5 index 3 index { + % Stack now: width height string y1 y2 x y + gsave + 1 index exch translate + 5 index 5 index true matrix tmpstip imagemask + grestore + } for + pop } for - pop - } for - pop pop pop pop pop -} bind def - -% -- AdjustColor -- -% Given a color value already set for output by the caller, adjusts -% that value to a grayscale or mono value if requested by the CL -% variable. + pop pop pop pop pop + } -/AdjustColor { - CL 2 lt { - currentgray - CL 0 eq { - .5 lt {0} {1} ifelse + # -- AdjustColor -- + # + # Given a color value already set for output by the caller, adjusts that + # value to a grayscale or mono value if requested by the CL variable. + ps function AdjustColor { + CL 2 lt { + currentgray + CL 0 eq { + .5 lt {0} {1} ifelse + } if + setgray } if - setgray - } if -} bind def - -% x y strings spacing xoffset yoffset justify stipple DrawText -- -% This procedure does all of the real work of drawing text. The -% color and font must already have been set by the caller, and the -% following arguments must be on the stack: -% -% x, y - Coordinates at which to draw text. -% strings - An array of strings, one for each line of the text item, -% in order from top to bottom. -% spacing - Spacing between lines. -% xoffset - Horizontal offset for text bbox relative to x and y: 0 for -% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se. -% yoffset - Vertical offset for text bbox relative to x and y: 0 for -% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se. -% justify - 0 for left justification, 0.5 for center, 1 for right justify. -% stipple - Boolean value indicating whether or not text is to be -% drawn in stippled fashion. If text is stippled, -% procedure StippleText must have been defined to call -% StippleFill in the right way. -% -% Also, when this procedure is invoked, the color and font must already -% have been set for the text. - -/DrawText { - /stipple exch def - /justify exch def - /yoffset exch def - /xoffset exch def - /spacing exch def - /strings exch def - - % First scan through all of the text to find the widest line. + } - /lineLength 0 def - strings { - cstringwidth pop - dup lineLength gt {/lineLength exch def} {pop} ifelse + # x y strings spacing xoffset yoffset justify stipple DrawText -- + # + # This procedure does all of the real work of drawing text. The color and + # font must already have been set by the caller, and the following + # arguments must be on the stack: + # + # x, y - Coordinates at which to draw text. + # strings - An array of strings, one for each line of the text item, in + # order from top to bottom. + # spacing - Spacing between lines. + # xoffset - Horizontal offset for text bbox relative to x and y: 0 for + # nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se. + # yoffset - Vertical offset for text bbox relative to x and y: 0 for + # nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se. + # justify - 0 for left justification, 0.5 for center, 1 for right justify. + # stipple - Boolean value indicating whether or not text is to be drawn in + # stippled fashion. If text is stippled, function StippleText + # must have been defined to call StippleFill in the right way. + # + # Also, when this procedure is invoked, the color and font must already + # have been set for the text. + ps function DrawText { + /stipple exch def + /justify exch def + /yoffset exch def + /xoffset exch def + /spacing exch def + /strings exch def + % First scan through all of the text to find the widest line. + /lineLength 0 def + strings { + cstringwidth pop + dup lineLength gt {/lineLength exch def} {pop} ifelse + newpath + } forall + % Compute the baseline offset and the actual font height. + 0 0 moveto baselineSampler false charpath + pathbbox dup /baseline exch def + exch pop exch sub /height exch def pop newpath - } forall - - % Compute the baseline offset and the actual font height. - - 0 0 moveto (TXygqPZ) false charpath - pathbbox dup /baseline exch def - exch pop exch sub /height exch def pop - newpath - - % Translate coordinates first so that the origin is at the upper-left - % corner of the text's bounding box. Remember that x and y for - % positioning are still on the stack. - - translate - lineLength xoffset mul - strings length 1 sub spacing mul height add yoffset mul translate - - % Now use the baseline and justification information to translate so - % that the origin is at the baseline and positioning point for the - % first line of text. - - justify lineLength mul baseline neg translate - - % Iterate over each of the lines to output it. For each line, - % compute its width again so it can be properly justified, then - % display it. + % Translate and rotate coordinates first so that the origin is at + % the upper-left corner of the text's bounding box. Remember that + % angle for rotating, and x and y for positioning are still on the + % stack. + translate + rotate + lineLength xoffset mul + strings length 1 sub spacing mul height add yoffset mul translate + % Now use the baseline and justification information to translate + % so that the origin is at the baseline and positioning point for + % the first line of text. + justify lineLength mul baseline neg translate + % Iterate over each of the lines to output it. For each line, + % compute its width again so it can be properly justified, then + % display it. + strings { + dup cstringwidth pop + justify neg mul 0 moveto + stipple { + % The text is stippled, so turn it into a path and print + % by calling StippledText, which in turn calls + % StippleFill. Unfortunately, many Postscript interpreters + % will get overflow errors if we try to do the whole + % string at once, so do it a character at a time. + gsave + /char (X) def + { + dup type /stringtype eq { + % This segment is a string. + { + char 0 3 -1 roll put + currentpoint + gsave + char true charpath clip StippleText + grestore + char stringwidth translate + moveto + } forall + } { + % This segment is glyph name + % Temporary override + currentfont /Encoding get exch 1 exch put + currentpoint + gsave (\001) true charpath clip StippleText + grestore + (\001) stringwidth translate + moveto + } ifelse + } forall + grestore + } {cstringshow} ifelse + 0 spacing neg translate + } forall + } - strings { - dup cstringwidth pop - justify neg mul 0 moveto - stipple { - - - % The text is stippled, so turn it into a path and print - % by calling StippledText, which in turn calls StippleFill. - % Unfortunately, many Postscript interpreters will get - % overflow errors if we try to do the whole string at - % once, so do it a character at a time. + # Define the "TkPhoto" function variants, which are modified versions + # of the original "transparentimage" function posted by ian@five-d.com + # (Ian Kemmish) to comp.lang.postscript. For a monochrome colorLevel + # this is a slightly different version that uses the imagemask command + # instead of image. - gsave - /char (X) def + ps function TkPhotoColor { + gsave + 32 dict begin + /tinteger exch def + /transparent 1 string def + transparent 0 tinteger put + /olddict exch def + olddict /DataSource get dup type /filetype ne { + olddict /DataSource 3 -1 roll + 0 () /SubFileDecode filter put + } { + pop + } ifelse + /newdict olddict maxlength dict def + olddict newdict copy pop + /w newdict /Width get def + /crpp newdict /Decode get length 2 idiv def + /str w string def + /pix w crpp mul string def + /substrlen 2 w log 2 log div floor exp cvi def + /substrs [ { + substrlen string + 0 1 substrlen 1 sub { + 1 index exch tinteger put + } for + /substrlen substrlen 2 idiv def + substrlen 0 eq {exit} if + } loop ] def + /h newdict /Height get def + 1 w div 1 h div matrix scale + olddict /ImageMatrix get exch matrix concatmatrix + matrix invertmatrix concat + newdict /Height 1 put + newdict /DataSource pix put + /mat [w 0 0 h 0 0] def + newdict /ImageMatrix mat put + 0 1 h 1 sub { + mat 5 3 -1 roll neg put + olddict /DataSource get str readstring pop pop + /tail str def + /x 0 def + olddict /DataSource get pix readstring pop pop { - dup type /stringtype eq { - % This segment is a string. - { - char 0 3 -1 roll put - currentpoint - gsave - char true charpath clip StippleText - grestore - char stringwidth translate - moveto - } forall - } { - % This segment is glyph name - % Temporary override - currentfont /Encoding get exch 1 exch put - currentpoint - gsave (\001) true charpath clip StippleText - grestore - (\001) stringwidth translate - moveto - } ifelse - } forall - grestore - } {cstringshow} ifelse - 0 spacing neg translate - } forall -} bind def - -%%EndProlog -} + tail transparent search dup /done exch not def + {exch pop exch pop} if + /w1 exch length def + w1 0 ne { + newdict /DataSource + pix x crpp mul w1 crpp mul getinterval put + newdict /Width w1 put + mat 4 x neg put + /x x w1 add def + newdict image + /tail tail w1 tail length w1 sub getinterval def + } if + done {exit} if + tail substrs { + anchorsearch {pop} if + } forall + /tail exch def + tail length 0 eq {exit} if + /x w tail length sub def + } loop + } for + end + grestore + } + ps function TkPhotoMono { + gsave + 32 dict begin + /dummyInteger exch def + /olddict exch def + olddict /DataSource get dup type /filetype ne { + olddict /DataSource 3 -1 roll + 0 () /SubFileDecode filter put + } { + pop + } ifelse + /newdict olddict maxlength dict def + olddict newdict copy pop + /w newdict /Width get def + /pix w 7 add 8 idiv string def + /h newdict /Height get def + 1 w div 1 h div matrix scale + olddict /ImageMatrix get exch matrix concatmatrix + matrix invertmatrix concat + newdict /Height 1 put + newdict /DataSource pix put + /mat [w 0 0 h 0 0] def + newdict /ImageMatrix mat put + 0 1 h 1 sub { + mat 5 3 -1 roll neg put + 0.000 0.000 0.000 setrgbcolor + olddict /DataSource get pix readstring pop pop + newdict /DataSource pix put + newdict imagemask + 1.000 1.000 1.000 setrgbcolor + olddict /DataSource get pix readstring pop pop + newdict /DataSource pix put + newdict imagemask + } for + end + grestore + } + ps literal %%EndProlog } proc tk::ensure_psenc_is_loaded {} { diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 572510a..6d329c2 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -111,7 +111,7 @@ static unsigned char w3_bits[] = { 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" - + # ::tk::MessageBox -- # # Pops up a messagebox with an application-supplied message with @@ -129,7 +129,7 @@ static unsigned char w3_bits[] = { # See the user documentation for details on what tk_messageBox does. # proc ::tk::MessageBox {args} { - global tcl_platform tk_strictMotif + global tk_strictMotif variable ::tk::Priv set w ::tk::PrivMsgBox @@ -137,7 +137,7 @@ proc ::tk::MessageBox {args} { # # The default value of the title is space (" ") not the empty string - # because for some window managers, a + # because for some window managers, a # wm title .foo "" # causes the window title to be "foo" instead of the empty string. # @@ -153,8 +153,9 @@ proc ::tk::MessageBox {args} { tclParseConfigSpec $w $specs "" $args - if {[lsearch -exact {info warning error question} $data(-icon)] == -1} { - error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" + if {$data(-icon) ni {info warning error question}} { + return -code error -errorcode [list TK LOOKUP ICON $data(-icon)] \ + "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" } set windowingsystem [tk windowingsystem] if {$windowingsystem eq "aqua"} { @@ -169,11 +170,12 @@ proc ::tk::MessageBox {args} { } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } switch -- $data(-type) { - abortretryignore { + abortretryignore { set names [list abort retry ignore] set labels [list &Abort &Retry &Ignore] set cancel abort @@ -204,9 +206,10 @@ proc ::tk::MessageBox {args} { set cancel cancel } default { - error "bad -type value \"$data(-type)\": must be\ - abortretryignore, ok, okcancel, retrycancel,\ - yesno, or yesnocancel" + return -code error -errorcode [list TK LOOKUP DLG_TYPE $data(-type)] \ + "bad -type value \"$data(-type)\": must be\ + abortretryignore, ok, okcancel, retrycancel,\ + yesno, or yesnocancel" } } @@ -215,7 +218,7 @@ proc ::tk::MessageBox {args} { lappend buttons [list $name -text [mc $lab]] } - # If no default button was specified, the default default is the + # If no default button was specified, the default default is the # first button (Bug: 2218). if {$data(-default) eq ""} { @@ -230,7 +233,8 @@ proc ::tk::MessageBox {args} { } } if {!$valid} { - error "invalid default button \"$data(-default)\"" + return -code error -errorcode {TK MSGBOX DEFAULT} \ + "invalid default button \"$data(-default)\"" } # 2. Set the dialog to be a child window of $parent @@ -271,15 +275,11 @@ proc ::tk::MessageBox {args} { wm attributes $w -type dialog } - ttk::frame $w.bot;# -background $bg + ttk::frame $w.bot grid anchor $w.bot center pack $w.bot -side bottom -fill both - ttk::frame $w.top;# -background $bg + ttk::frame $w.top pack $w.top -side top -fill both -expand 1 - if {$windowingsystem ne "aqua"} { - #$w.bot configure -relief raised -bd 1 - #$w.top configure -relief raised -bd 1 - } # 4. Fill the top part with bitmap, message and detail (use the # option database for -wraplength and -font so that they can be @@ -291,53 +291,32 @@ proc ::tk::MessageBox {args} { option add *Dialog.dtl.font TkDefaultFont widgetDefault ttk::label $w.msg -anchor nw -justify left -text $data(-message) - #-background $bg if {$data(-detail) ne ""} { ttk::label $w.dtl -anchor nw -justify left -text $data(-detail) - #-background $bg } if {$data(-icon) ne ""} { - if {$windowingsystem eq "aqua" - || ([winfo depth $w] < 4) || $tk_strictMotif} { + if {([winfo depth $w] < 4) || $tk_strictMotif} { # ttk::label has no -bitmap option - label $w.bitmap -bitmap $data(-icon);# -background $bg + label $w.bitmap -bitmap $data(-icon) -background $bg } else { - canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \ - -background $bg switch $data(-icon) { - error { - $w.bitmap create oval 0 0 31 31 -fill red -outline black - $w.bitmap create line 9 9 23 23 -fill white -width 4 - $w.bitmap create line 9 23 23 9 -fill white -width 4 - } - info { - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::b1 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::b2 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::i - } - question { - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::b1 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::b2 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::q - } - default { - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::w1 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::w2 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::w3 - } + error { + ttk::label $w.bitmap -image ::tk::icons::error + } + info { + ttk::label $w.bitmap -image ::tk::icons::information + } + question { + ttk::label $w.bitmap -image ::tk::icons::question + } + default { + ttk::label $w.bitmap -image ::tk::icons::warning + } } } } grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m + grid configure $w.bitmap -sticky nw grid columnconfigure $w.top 1 -weight 1 if {$data(-detail) ne ""} { grid ^ $w.dtl -in $w.top -sticky news -padx 2m -pady {0 2m} @@ -360,7 +339,6 @@ proc ::tk::MessageBox {args} { eval [list tk::AmpWidget ttk::button $w.$name] $opts \ [list -command [list set tk::Priv(button) $name]] - # -padx 3m if {$name eq $data(-default)} { $w.$name configure -default active diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg index cd86ca9..d6be730 100644 --- a/library/msgs/cs.msg +++ b/library/msgs/cs.msg @@ -1,72 +1,65 @@ namespace eval ::tk { ::msgcat::mcset cs "&Abort" "&P\u0159eru\u0161it" ::msgcat::mcset cs "&About..." "&O programu..." - ::msgcat::mcset cs "&Blue" "&Modr\341" - ::msgcat::mcset cs "&Cancel" "&Zru\u0161it" - ::msgcat::mcset cs "&Clear Console" "&Smazat konzolu" - ::msgcat::mcset cs "&Copy" "&Kop\355rovat" - ::msgcat::mcset cs "&Delete" "&Smazat" - ::msgcat::mcset cs "&Directory:" "&Adres\341\u0159:" - ::msgcat::mcset cs "&Edit" "&\332pravy" - ::msgcat::mcset cs "&File" "&Soubor" - ::msgcat::mcset cs "&Filter" "&Filtr" - ::msgcat::mcset cs "&Green" "Ze&len\341" - ::msgcat::mcset cs "&Help" "&N\341pov\u011bda" - ::msgcat::mcset cs "&Hide Console" "&Schovat Konzolu" - ::msgcat::mcset cs "&Ignore" "&Ignorovat" - ::msgcat::mcset cs "&No" "&Ne" - ::msgcat::mcset cs "&OK" - ::msgcat::mcset cs "&Open" "&Otev\u0159\355t" - ::msgcat::mcset cs "&Quit" "&Ukon\u010dit" - ::msgcat::mcset cs "&Red" "\u010ce&rven\341" - ::msgcat::mcset cs "&Retry" "Z&novu" - ::msgcat::mcset cs "&Save" "&Ulo\u017eit" - ::msgcat::mcset cs "&Selection:" "&V\375b\u011br:" - ::msgcat::mcset cs "&Source..." "&Zdroj..." - ::msgcat::mcset cs "&Yes" "&Ano" - ::msgcat::mcset cs "About..." "O programu..." ::msgcat::mcset cs "All Files" "V\u0161echny soubory" ::msgcat::mcset cs "Application Error" "Chyba programu" + ::msgcat::mcset cs "Bold Italic" + ::msgcat::mcset cs "&Blue" "&Modr\341" + ::msgcat::mcset cs "Cancel" "Zru\u0161it" + ::msgcat::mcset cs "&Cancel" "&Zru\u0161it" ::msgcat::mcset cs "Cannot change to the directory \"%1\$s\".\nPermission denied." "Nemohu zm\u011bnit atku\341ln\355 adres\341\u0159 na \"%1\$s\".\nP\u0159\355stup odm\355tnut." ::msgcat::mcset cs "Choose Directory" "V\375b\u011br adres\341\u0159e" ::msgcat::mcset cs "Cl&ear" "Sma&zat" - ::msgcat::mcset cs "Clear" "Smazat" + ::msgcat::mcset cs "&Clear Console" "&Smazat konzolu" ::msgcat::mcset cs "Color" "Barva" ::msgcat::mcset cs "Console" "Konzole" - ::msgcat::mcset cs "Copy" "Kop\355rovat" + ::msgcat::mcset cs "&Copy" "&Kop\355rovat" ::msgcat::mcset cs "Cu&t" "V&y\u0159\355znout" - ::msgcat::mcset cs "Cut" "Vy\u0159\355znout" - ::msgcat::mcset cs "Delete" "Smazat" + ::msgcat::mcset cs "&Delete" "&Smazat" ::msgcat::mcset cs "Details >>" "Detaily >>" ::msgcat::mcset cs "Directory \"%1\$s\" does not exist." "Adres\341\u0159 \"%1\$s\" neexistuje." - ::msgcat::mcset cs "E&xit" "&Konec" + ::msgcat::mcset cs "&Directory:" "&Adres\341\u0159:" + ::msgcat::mcset cs "&Edit" "&\332pravy" ::msgcat::mcset cs "Error: %1\$s" "Chyba: %1\$s" - ::msgcat::mcset cs "Exit" "Konec" - ::msgcat::mcset cs "Fi&les:" "Sou&bory:" - ::msgcat::mcset cs "Fil&ter:" "Fil&tr:" - ::msgcat::mcset cs "File \"%1\$s\" already exists.\n\n" "Soubor \"%1\$s\" ji\u017e existuje.\n\n" + ::msgcat::mcset cs "E&xit" "&Konec" + ::msgcat::mcset cs "&File" "&Soubor" ::msgcat::mcset cs "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Soubor \"%1\$s\" ji\u017e existuje.\nChcete jej p\u0159epsat?" + ::msgcat::mcset cs "File \"%1\$s\" already exists.\n\n" "Soubor \"%1\$s\" ji\u017e existuje.\n\n" ::msgcat::mcset cs "File \"%1\$s\" does not exist." "Soubor \"%1\$s\" neexistuje." ::msgcat::mcset cs "File &name:" "&Jm\351no souboru:" ::msgcat::mcset cs "File &names:" "&Jm\351na soubor\u016f:" ::msgcat::mcset cs "Files of &type:" "&Typy soubor\u016f:" + ::msgcat::mcset cs "Fi&les:" "Sou&bory:" + ::msgcat::mcset cs "&Filter" "&Filtr" + ::msgcat::mcset cs "Fil&ter:" "Fil&tr:" + ::msgcat::mcset cs "Font st&yle:" + ::msgcat::mcset cs "&Green" "Ze&len\341" + ::msgcat::mcset cs "&Help" "&N\341pov\u011bda" ::msgcat::mcset cs "Hi" "Ahoj" - ::msgcat::mcset cs "Hide Console" "Skr\375t konsolu" + ::msgcat::mcset cs "&Hide Console" "&Schovat Konzolu" + ::msgcat::mcset cs "&Ignore" "&Ignorovat" ::msgcat::mcset cs "Invalid file name \"%1\$s\"." "\u0160patn\351 jm\351no souboru \"%1\$s\"." ::msgcat::mcset cs "Log Files" "Log soubory" + ::msgcat::mcset cs "&No" "&Ne" + ::msgcat::mcset cs "&OK" + ::msgcat::mcset cs "OK" ::msgcat::mcset cs "Ok" ::msgcat::mcset cs "Open" "Otev\u0159\355t" + ::msgcat::mcset cs "&Open" "&Otev\u0159\355t" ::msgcat::mcset cs "Open Multiple Files" "Otev\u0159\355t v\355ce soubor\u016f" ::msgcat::mcset cs "P&aste" "&Vlo\u017eit" - ::msgcat::mcset cs "Paste" "Vlo\u017eit" - ::msgcat::mcset cs "Quit" "Skon\u010dit" + ::msgcat::mcset cs "&Quit" "&Ukon\u010dit" + ::msgcat::mcset cs "&Red" "\u010ce&rven\341" ::msgcat::mcset cs "Replace existing file?" "Nahradit st\341vaj\355c\355 soubor?" + ::msgcat::mcset cs "&Retry" "Z&novu" + ::msgcat::mcset cs "&Save" "&Ulo\u017eit" ::msgcat::mcset cs "Save As" "Ulo\u017eit jako" ::msgcat::mcset cs "Save To Log" "Ulo\u017eit do logu" ::msgcat::mcset cs "Select Log File" "Vybrat log soubor" ::msgcat::mcset cs "Select a file to source" "Vybrat soubor k nahr\341n\355" + ::msgcat::mcset cs "&Selection:" "&V\375b\u011br:" ::msgcat::mcset cs "Skip Messages" "P\u0159esko\u010dit zpr\341vy" - ::msgcat::mcset cs "Source..." "Nahr\341t..." + ::msgcat::mcset cs "&Source..." "&Zdroj..." ::msgcat::mcset cs "Tcl Scripts" "Tcl skripty" ::msgcat::mcset cs "Tcl for Windows" "Tcl pro Windows" ::msgcat::mcset cs "Text Files" "Textov\351 soubory" diff --git a/library/msgs/da.msg b/library/msgs/da.msg index c749608..c302c79 100644 --- a/library/msgs/da.msg +++ b/library/msgs/da.msg @@ -4,10 +4,11 @@ namespace eval ::tk { ::msgcat::mcset da "All Files" "Alle filer" ::msgcat::mcset da "Application Error" "Programfejl" ::msgcat::mcset da "&Blue" "&Bl\u00E5" + ::msgcat::mcset da "Cancel" "Annuller" ::msgcat::mcset da "&Cancel" "&Annuller" ::msgcat::mcset da "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan ikke skifte til katalog \"%1\$s\".\nIngen rettigheder." ::msgcat::mcset da "Choose Directory" "V\u00E6lg katalog" - ::msgcat::mcset da "&Clear" "&Ryd" + ::msgcat::mcset da "Cl&ear" "&Ryd" ::msgcat::mcset da "&Clear Console" "&Ryd konsolen" ::msgcat::mcset da "Color" "Farve" ::msgcat::mcset da "Console" "Konsol" @@ -38,8 +39,8 @@ namespace eval ::tk { ::msgcat::mcset da "Invalid file name \"%1\$s\"." "Ugyldig fil navn \"%1\$s\"." ::msgcat::mcset da "Log Files" "Logfiler" ::msgcat::mcset da "&No" "&Nej" - ::msgcat::mcset da "OK" "O.K." ::msgcat::mcset da "&OK" "&O.K." + ::msgcat::mcset da "OK" "O.K." ::msgcat::mcset da "Ok" ::msgcat::mcset da "Open" "\u00C5bn" ::msgcat::mcset da "&Open" "&\u00C5bn" diff --git a/library/msgs/de.msg b/library/msgs/de.msg index 7750313..e420f8a 100644 --- a/library/msgs/de.msg +++ b/library/msgs/de.msg @@ -3,7 +3,11 @@ namespace eval ::tk { ::msgcat::mcset de "&About..." "&\u00dcber..." ::msgcat::mcset de "All Files" "Alle Dateien" ::msgcat::mcset de "Application Error" "Applikationsfehler" + ::msgcat::mcset de "&Apply" "&Anwenden" + ::msgcat::mcset de "Bold" "Fett" + ::msgcat::mcset de "Bold Italic" "Fett kursiv" ::msgcat::mcset de "&Blue" "&Blau" + ::msgcat::mcset de "Cancel" "Abbruch" ::msgcat::mcset de "&Cancel" "&Abbruch" ::msgcat::mcset de "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kann nicht in das Verzeichnis \"%1\$s\" wechseln.\nKeine Rechte vorhanden." ::msgcat::mcset de "Choose Directory" "W\u00e4hle Verzeichnis" @@ -18,6 +22,7 @@ namespace eval ::tk { ::msgcat::mcset de "Directory \"%1\$s\" does not exist." "Das Verzeichnis \"%1\$s\" existiert nicht." ::msgcat::mcset de "&Directory:" "&Verzeichnis:" ::msgcat::mcset de "&Edit" "&Bearbeiten" + ::msgcat::mcset de "Effects" "Effekte" ::msgcat::mcset de "Error: %1\$s" "Fehler: %1\$s" ::msgcat::mcset de "E&xit" "&Ende" ::msgcat::mcset de "&File" "&Datei" @@ -30,15 +35,20 @@ namespace eval ::tk { ::msgcat::mcset de "Fi&les:" "Dat&eien:" ::msgcat::mcset de "&Filter" ::msgcat::mcset de "Fil&ter:" + ::msgcat::mcset de "Font" "Schriftart" + ::msgcat::mcset de "&Font:" "Schriftart:" + ::msgcat::mcset de "Font st&yle:" "Schriftschnitt:" ::msgcat::mcset de "&Green" "&Gr\u00fcn" ::msgcat::mcset de "&Help" "&Hilfe" ::msgcat::mcset de "Hi" "Hallo" ::msgcat::mcset de "&Hide Console" "&Konsole unsichtbar machen" ::msgcat::mcset de "&Ignore" "&Ignorieren" ::msgcat::mcset de "Invalid file name \"%1\$s\"." "Ung\u00fcltiger Dateiname \"%1\$s\"." + ::msgcat::mcset de "Italic" "Kursiv" ::msgcat::mcset de "Log Files" "Protokolldatei" ::msgcat::mcset de "&No" "&Nein" ::msgcat::mcset de "&OK" + ::msgcat::mcset de "OK" ::msgcat::mcset de "Ok" ::msgcat::mcset de "Open" "\u00d6ffnen" ::msgcat::mcset de "&Open" "\u00d6&ffnen" @@ -46,21 +56,26 @@ namespace eval ::tk { ::msgcat::mcset de "P&aste" "E&inf\u00fcgen" ::msgcat::mcset de "&Quit" "&Beenden" ::msgcat::mcset de "&Red" "&Rot" + ::msgcat::mcset de "Regular" "Standard" ::msgcat::mcset de "Replace existing file?" "Existierende Datei ersetzen?" ::msgcat::mcset de "&Retry" "&Wiederholen" + ::msgcat::mcset de "Sample" "Beispiel" ::msgcat::mcset de "&Save" "&Speichern" ::msgcat::mcset de "Save As" "Speichern unter" ::msgcat::mcset de "Save To Log" "In Protokoll speichern" ::msgcat::mcset de "Select Log File" "Protokolldatei ausw\u00e4hlen" ::msgcat::mcset de "Select a file to source" "Auszuf\u00fchrende Datei ausw\u00e4hlen" ::msgcat::mcset de "&Selection:" "Auswah&l:" + ::msgcat::mcset de "&Size:" "Schriftgrad:" ::msgcat::mcset de "Show &Hidden Directories" "Zeige versteckte Dateien" ::msgcat::mcset de "Show &Hidden Files and Directories" "Zeige versteckte Dateien und Verzeichnisse" ::msgcat::mcset de "Skip Messages" "Weitere Nachrichten \u00fcberspringen" ::msgcat::mcset de "&Source..." "&Ausf\u00fchren..." + ::msgcat::mcset de "Stri&keout" "&Durchgestrichen" ::msgcat::mcset de "Tcl Scripts" "Tcl-Skripte" ::msgcat::mcset de "Tcl for Windows" "Tcl f\u00fcr Windows" ::msgcat::mcset de "Text Files" "Textdateien" + ::msgcat::mcset de "&Underline" "&Unterstrichen" ::msgcat::mcset de "&Yes" "&Ja" ::msgcat::mcset de "abort" "abbrechen" ::msgcat::mcset de "blue" "blau" diff --git a/library/msgs/el.msg b/library/msgs/el.msg index 1dcc451..2e3f236 100644 --- a/library/msgs/el.msg +++ b/library/msgs/el.msg @@ -47,12 +47,13 @@ namespace eval ::tk { ::msgcat::mcset el "Log Files" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u039a\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2" ::msgcat::mcset el "&No" "\u038c\u03c7\u03b9" ::msgcat::mcset el "&OK" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9" - ::msgcat::mcset el "&Ok" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9" + ::msgcat::mcset el "OK" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9" + ::msgcat::mcset el "Ok" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9" ::msgcat::mcset el "Open" "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1" ::msgcat::mcset el "&Open" "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1" ::msgcat::mcset el "Open Multiple Files" \ "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1 \u03c0\u03bf\u03bb\u03bb\u03b1\u03c0\u03bb\u03ce\u03bd \u03b1\u03c1\u03c7\u03b5\u03af\u03c9\u03bd" - ::msgcat::mcset el "Paste" "\u0395\u03c0\u03b9\u03ba\u03cc\u03bb\u03bb\u03b7\u03c3\u03b7" + ::msgcat::mcset el "P&aste" "\u0395\u03c0\u03b9\u03ba\u03cc\u03bb\u03bb\u03b7\u03c3\u03b7" ::msgcat::mcset el "Quit" "\u0388\u03be\u03bf\u03b4\u03bf\u03c2" ::msgcat::mcset el "&Red" "\u039a\u03cc\u03ba\u03ba\u03b9\u03bd\u03bf" ::msgcat::mcset el "Replace existing file?" \ @@ -66,7 +67,7 @@ namespace eval ::tk { "\u0395\u03c0\u03b9\u03bb\u03ad\u03be\u03c4\u03b5 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \u03b3\u03b9\u03b1 \u03b5\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7" ::msgcat::mcset el "&Selection:" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae:" ::msgcat::mcset el "Skip Messages" "\u0391\u03c0\u03bf\u03c6\u03c5\u03b3\u03ae\u03bc\u03b7\u03bd\u03c5\u03bc\u03ac\u03c4\u03c9\u03bd" - ::msgcat::mcset el "Source..." "\u0395\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7..." + ::msgcat::mcset el "&Source..." "\u0395\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7..." ::msgcat::mcset el "Tcl Scripts" "Tcl Scripts" ::msgcat::mcset el "Tcl for Windows" "Tcl \u03b3\u03b9\u03b1 Windows" ::msgcat::mcset el "Text Files" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u039a\u03b5\u03b9\u03bc\u03ad\u03bd\u03bf\u03c5" @@ -83,4 +84,3 @@ namespace eval ::tk { ::msgcat::mcset el "retry" "\u03c0\u03c1\u03bf\u03c3\u03c0\u03ac\u03b8\u03b7\u03c3\u03b5 \u03be\u03b1\u03bd\u03ac" ::msgcat::mcset el "yes" "\u03bd\u03b1\u03b9" } - diff --git a/library/msgs/en.msg b/library/msgs/en.msg index b4e51bf..5ad1094 100644 --- a/library/msgs/en.msg +++ b/library/msgs/en.msg @@ -3,7 +3,11 @@ namespace eval ::tk { ::msgcat::mcset en "&About..." ::msgcat::mcset en "All Files" ::msgcat::mcset en "Application Error" + ::msgcat::mcset en "&Apply" + ::msgcat::mcset en "Bold" + ::msgcat::mcset en "Bold Italic" ::msgcat::mcset en "&Blue" + ::msgcat::mcset en "Cancel" ::msgcat::mcset en "&Cancel" ::msgcat::mcset en "Cannot change to the directory \"%1\$s\".\nPermission denied." ::msgcat::mcset en "Choose Directory" @@ -18,6 +22,7 @@ namespace eval ::tk { ::msgcat::mcset en "Directory \"%1\$s\" does not exist." ::msgcat::mcset en "&Directory:" ::msgcat::mcset en "&Edit" + ::msgcat::mcset en "Effects" ::msgcat::mcset en "Error: %1\$s" ::msgcat::mcset en "E&xit" ::msgcat::mcset en "&File" @@ -30,15 +35,20 @@ namespace eval ::tk { ::msgcat::mcset en "Fi&les:" ::msgcat::mcset en "&Filter" ::msgcat::mcset en "Fil&ter:" + ::msgcat::mcset en "Font" + ::msgcat::mcset en "&Font:" + ::msgcat::mcset en "Font st&yle:" ::msgcat::mcset en "&Green" ::msgcat::mcset en "&Help" ::msgcat::mcset en "Hi" ::msgcat::mcset en "&Hide Console" ::msgcat::mcset en "&Ignore" ::msgcat::mcset en "Invalid file name \"%1\$s\"." + ::msgcat::mcset en "Italic" ::msgcat::mcset en "Log Files" ::msgcat::mcset en "&No" ::msgcat::mcset en "&OK" + ::msgcat::mcset en "OK" ::msgcat::mcset en "Ok" ::msgcat::mcset en "Open" ::msgcat::mcset en "&Open" @@ -46,21 +56,26 @@ namespace eval ::tk { ::msgcat::mcset en "P&aste" ::msgcat::mcset en "&Quit" ::msgcat::mcset en "&Red" + ::msgcat::mcset en "Regular" ::msgcat::mcset en "Replace existing file?" ::msgcat::mcset en "&Retry" + ::msgcat::mcset en "Sample" ::msgcat::mcset en "&Save" ::msgcat::mcset en "Save As" ::msgcat::mcset en "Save To Log" ::msgcat::mcset en "Select Log File" ::msgcat::mcset en "Select a file to source" ::msgcat::mcset en "&Selection:" + ::msgcat::mcset en "&Size:" ::msgcat::mcset en "Show &Hidden Directories" ::msgcat::mcset en "Show &Hidden Files and Directories" ::msgcat::mcset en "Skip Messages" ::msgcat::mcset en "&Source..." + ::msgcat::mcset en "Stri&keout" ::msgcat::mcset en "Tcl Scripts" ::msgcat::mcset en "Tcl for Windows" ::msgcat::mcset en "Text Files" + ::msgcat::mcset en "&Underline" ::msgcat::mcset en "&Yes" ::msgcat::mcset en "abort" ::msgcat::mcset en "blue" diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg index 85436c3..3645630 100644 --- a/library/msgs/eo.msg +++ b/library/msgs/eo.msg @@ -4,10 +4,11 @@ namespace eval ::tk { ::msgcat::mcset eo "All Files" "\u0108ioj dosieroj" ::msgcat::mcset eo "Application Error" "Aplikoerraro" ::msgcat::mcset eo "&Blue" "&Blua" + ::msgcat::mcset eo "Cancel" "Rezignu" ::msgcat::mcset eo "&Cancel" "&Rezignu" ::msgcat::mcset eo "Cannot change to the directory \"%1\$s\".\nPermission denied." "Neeble \u0109angi al dosierulon \"%1\$s\".\nVi ne rajtas tion." ::msgcat::mcset eo "Choose Directory" "Elektu Dosierujo" - ::msgcat::mcset eo "&Clear" "&Klaru" + ::msgcat::mcset eo "Cl&ear" "&Klaru" ::msgcat::mcset eo "&Clear Console" "&Klaru konzolon" ::msgcat::mcset eo "Color" "Farbo" ::msgcat::mcset eo "Console" "Konzolo" @@ -38,6 +39,7 @@ namespace eval ::tk { ::msgcat::mcset eo "Invalid file name \"%1\$s\"." "Malvalida dosieronomo \"%1\$s\"." ::msgcat::mcset eo "Log Files" "Protokolo" ::msgcat::mcset eo "&No" "&Ne" + ::msgcat::mcset eo "&OK" ::msgcat::mcset eo "OK" ::msgcat::mcset eo "Ok" ::msgcat::mcset eo "Open" "Malfermu" diff --git a/library/msgs/es.msg b/library/msgs/es.msg index ceb12d6..578c52c 100644 --- a/library/msgs/es.msg +++ b/library/msgs/es.msg @@ -1,15 +1,16 @@ namespace eval ::tk { ::msgcat::mcset es "&Abort" "&Abortar" ::msgcat::mcset es "&About..." "&Acerca de ..." - ::msgcat::mcset es "All Files" "Todos los archivos" + ::msgcat::mcset es "All Files" "Todos los archivos" ::msgcat::mcset es "Application Error" "Error de la aplicaci\u00f3n" ::msgcat::mcset es "&Blue" "&Azul" + ::msgcat::mcset es "Cancel" "Cancelar" ::msgcat::mcset es "&Cancel" "&Cancelar" ::msgcat::mcset es "Cannot change to the directory \"%1\$s\".\nPermission denied." "No es posible acceder al directorio \"%1\$s\".\nPermiso denegado." ::msgcat::mcset es "Choose Directory" "Elegir directorio" ::msgcat::mcset es "Cl&ear" "&Borrar" ::msgcat::mcset es "&Clear Console" "&Borrar consola" - ::msgcat::mcset es "Color" "Color" + ::msgcat::mcset es "Color" ::msgcat::mcset es "Console" "Consola" ::msgcat::mcset es "&Copy" "&Copiar" ::msgcat::mcset es "Cu&t" "Cor&tar" @@ -18,7 +19,7 @@ namespace eval ::tk { ::msgcat::mcset es "Directory \"%1\$s\" does not exist." "El directorio \"%1\$s\" no existe." ::msgcat::mcset es "&Directory:" "&Directorio:" ::msgcat::mcset es "&Edit" "&Editar" - ::msgcat::mcset es "Error: %1\$s" "Error: %1\$s" + ::msgcat::mcset es "Error: %1\$s" ::msgcat::mcset es "E&xit" "Salir" ::msgcat::mcset es "&File" "&Archivo" ::msgcat::mcset es "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "El archivo \"%1\$s\" ya existe.\n\u00bfDesea sobreescribirlo?" @@ -37,9 +38,10 @@ namespace eval ::tk { ::msgcat::mcset es "&Ignore" "&Ignorar" ::msgcat::mcset es "Invalid file name \"%1\$s\"." "Nombre de archivo inv\u00e1lido \"%1\$s\"." ::msgcat::mcset es "Log Files" "Ficheros de traza" - ::msgcat::mcset es "&No" "&No" - ::msgcat::mcset es "&OK" "&OK" - ::msgcat::mcset es "Ok" "Ok" + ::msgcat::mcset es "&No" + ::msgcat::mcset es "&OK" + ::msgcat::mcset es "OK" + ::msgcat::mcset es "Ok" ::msgcat::mcset es "Open" "Abrir" ::msgcat::mcset es "&Open" "&Abrir" ::msgcat::mcset es "Open Multiple Files" "Abrir m\u00faltiples archivos" @@ -59,7 +61,7 @@ namespace eval ::tk { ::msgcat::mcset es "Tcl Scripts" "Scripts Tcl" ::msgcat::mcset es "Tcl for Windows" "Tcl para Windows" ::msgcat::mcset es "Text Files" "Archivos de texto" - ::msgcat::mcset es "&Yes" "&S\u00ed" + ::msgcat::mcset es "&Yes" "&S\u00ed" ::msgcat::mcset es "abort" "abortar" ::msgcat::mcset es "blue" "azul" ::msgcat::mcset es "cancel" "cancelar" @@ -67,7 +69,7 @@ namespace eval ::tk { ::msgcat::mcset es "extensions" "extensiones" ::msgcat::mcset es "green" "verde" ::msgcat::mcset es "ignore" "ignorar" - ::msgcat::mcset es "ok" "ok" + ::msgcat::mcset es "ok" ::msgcat::mcset es "red" "rojo" ::msgcat::mcset es "retry" "reintentar" ::msgcat::mcset es "yes" "s\u00ed" diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg index b1eb7e3..7f42aca 100644 --- a/library/msgs/fr.msg +++ b/library/msgs/fr.msg @@ -4,20 +4,21 @@ namespace eval ::tk { ::msgcat::mcset fr "All Files" "Tous les fichiers" ::msgcat::mcset fr "Application Error" "Erreur d'application" ::msgcat::mcset fr "&Blue" "&Bleu" + ::msgcat::mcset fr "Cancel" "Annuler" ::msgcat::mcset fr "&Cancel" "&Annuler" ::msgcat::mcset fr "Cannot change to the directory \"%1\$s\".\nPermission denied." "Impossible d'acc\u00e9der au r\u00e9pertoire \"%1\$s\".\nPermission refus\u00e9e." ::msgcat::mcset fr "Choose Directory" "Choisir r\u00e9pertoire" - ::msgcat::mcset fr "Clear" "Effacer" + ::msgcat::mcset fr "Cl&ear" "Effacer" ::msgcat::mcset fr "Color" "Couleur" ::msgcat::mcset fr "Console" ::msgcat::mcset fr "Copy" "Copier" - ::msgcat::mcset fr "Cut" "Couper" + ::msgcat::mcset fr "Cu&t" "Couper" ::msgcat::mcset fr "Delete" "Effacer" ::msgcat::mcset fr "Details >>" "D\u00e9tails >>" ::msgcat::mcset fr "Directory \"%1\$s\" does not exist." "Le r\u00e9pertoire \"%1\$s\" n'existe pas." ::msgcat::mcset fr "&Directory:" "&R\u00e9pertoire:" ::msgcat::mcset fr "Error: %1\$s" "Erreur: %1\$s" - ::msgcat::mcset fr "Exit" "Quitter" + ::msgcat::mcset fr "E&xit" "Quitter" ::msgcat::mcset fr "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Le fichier \"%1\$s\" existe d\u00e9j\u00e0.\nVoulez-vous l'\u00e9craser?" ::msgcat::mcset fr "File \"%1\$s\" already exists.\n\n" "Le fichier \"%1\$s\" existe d\u00e9j\u00e0.\n\n" ::msgcat::mcset fr "File \"%1\$s\" does not exist." "Le fichier \"%1\$s\" n'existe pas." @@ -29,18 +30,19 @@ namespace eval ::tk { ::msgcat::mcset fr "Fil&ter:" "Fil&tre:" ::msgcat::mcset fr "&Green" "&Vert" ::msgcat::mcset fr "Hi" "Salut" - ::msgcat::mcset fr "Hide Console" "Cacher la Console" + ::msgcat::mcset fr "&Hide Console" "Cacher la Console" ::msgcat::mcset fr "&Ignore" "&Ignorer" ::msgcat::mcset fr "Invalid file name \"%1\$s\"." "Nom de fichier invalide \"%1\$s\"." ::msgcat::mcset fr "Log Files" "Fichiers de trace" ::msgcat::mcset fr "&No" "&Non" ::msgcat::mcset fr "&OK" + ::msgcat::mcset fr "OK" ::msgcat::mcset fr "Ok" ::msgcat::mcset fr "Open" "Ouvrir" ::msgcat::mcset fr "&Open" "&Ouvrir" ::msgcat::mcset fr "Open Multiple Files" "Ouvrir plusieurs fichiers" - ::msgcat::mcset fr "Paste" "Coller" - ::msgcat::mcset fr "Quit" "Quitter" + ::msgcat::mcset fr "P&aste" "Coller" + ::msgcat::mcset fr "&Quit" "&Quitter" ::msgcat::mcset fr "&Red" "&Rouge" ::msgcat::mcset fr "Replace existing file?" "Remplacer le fichier existant?" ::msgcat::mcset fr "&Retry" "&R\u00e9-essayer" @@ -51,7 +53,7 @@ namespace eval ::tk { ::msgcat::mcset fr "Select a file to source" "Choisir un fichier \u00e0 \u00e9valuer" ::msgcat::mcset fr "&Selection:" "&S\u00e9lection:" ::msgcat::mcset fr "Skip Messages" "Omettre les messages" - ::msgcat::mcset fr "Source..." "\u00c9valuer..." + ::msgcat::mcset fr "&Source..." "\u00c9valuer..." ::msgcat::mcset fr "Tcl Scripts" "Scripts Tcl" ::msgcat::mcset fr "Tcl for Windows" "Tcl pour Windows" ::msgcat::mcset fr "Text Files" "Fichiers texte" diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg index fc4700f..38ef0b8 100644 --- a/library/msgs/hu.msg +++ b/library/msgs/hu.msg @@ -1,14 +1,14 @@ namespace eval ::tk { ::msgcat::mcset hu "&Abort" "&Megszak\u00edt\u00e1s" - ::msgcat::mcset hu "About..." "N\u00e9vjegy..." + ::msgcat::mcset hu "&About..." "N\u00e9vjegy..." ::msgcat::mcset hu "All Files" "Minden f\u00e1jl" - ::msgcat::mcset hu "All Files (*) " "Minden f\u00e1jl (*) " ::msgcat::mcset hu "Application Error" "Alkalmaz\u00e1s hiba" ::msgcat::mcset hu "&Blue" "&K\u00e9k" + ::msgcat::mcset hu "Cancel" "M\u00e9gsem" ::msgcat::mcset hu "&Cancel" "M\u00e9g&sem" ::msgcat::mcset hu "Cannot change to the directory \"%1\$s\".\nPermission denied." "A k\u00f6nyvt\u00e1rv\u00e1lt\u00e1s nem siker\u00fclt: \"%1\$s\".\nHozz\u00e1f\u00e9r\u00e9s megtagadva." ::msgcat::mcset hu "Choose Directory" "K\u00f6nyvt\u00e1r kiv\u00e1laszt\u00e1sa" - ::msgcat::mcset hu "Clear" "T\u00f6rl\u00e9s" + ::msgcat::mcset hu "Cl&ear" "T\u00f6rl\u00e9s" ::msgcat::mcset hu "&Clear Console" "&T\u00f6rl\u00e9s Konzol" ::msgcat::mcset hu "Color" "Sz\u00edn" ::msgcat::mcset hu "Console" "Konzol" @@ -41,6 +41,7 @@ namespace eval ::tk { ::msgcat::mcset hu "&No" "&Nem" ::msgcat::mcset hu "&OK" ::msgcat::mcset hu "OK" + ::msgcat::mcset hu "Ok" ::msgcat::mcset hu "Open" "Megnyit\u00e1s" ::msgcat::mcset hu "&Open" "&Megnyit\u00e1s" ::msgcat::mcset hu "Open Multiple Files" "T\u00f6bb f\u00e1jl megnyit\u00e1sa" diff --git a/library/msgs/it.msg b/library/msgs/it.msg index 52394cd..2e1b4bd 100644 --- a/library/msgs/it.msg +++ b/library/msgs/it.msg @@ -1,23 +1,25 @@ namespace eval ::tk { ::msgcat::mcset it "&Abort" "&Interrompi" - ::msgcat::mcset it "About..." "Informazioni..." + ::msgcat::mcset it "&About..." "Informazioni..." ::msgcat::mcset it "All Files" "Tutti i file" ::msgcat::mcset it "Application Error" "Errore dell' applicazione" ::msgcat::mcset it "&Blue" "&Blu" + ::msgcat::mcset it "Cancel" "Annulla" ::msgcat::mcset it "&Cancel" "&Annulla" ::msgcat::mcset it "Cannot change to the directory \"%1\$s\".\nPermission denied." "Impossibile accedere alla directory \"%1\$s\".\nPermesso negato." ::msgcat::mcset it "Choose Directory" "Scegli una directory" - ::msgcat::mcset it "Clear" "Azzera" + ::msgcat::mcset it "Cl&ear" "Azzera" + ::msgcat::mcset it "&Clear Console" "Azzera Console" ::msgcat::mcset it "Color" "Colore" ::msgcat::mcset it "Console" - ::msgcat::mcset it "Copy" "Copia" - ::msgcat::mcset it "Cut" "Taglia" + ::msgcat::mcset it "&Copy" "Copia" + ::msgcat::mcset it "Cu&t" "Taglia" ::msgcat::mcset it "Delete" "Cancella" ::msgcat::mcset it "Details >>" "Dettagli >>" ::msgcat::mcset it "Directory \"%1\$s\" does not exist." "La directory \"%1\$s\" non esiste." ::msgcat::mcset it "&Directory:" ::msgcat::mcset it "Error: %1\$s" "Errore: %1\$s" - ::msgcat::mcset it "Exit" "Esci" + ::msgcat::mcset it "E&xit" "Esci" ::msgcat::mcset it "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Il file \"%1\$s\" esiste gi\u00e0.\nVuoi sovrascriverlo?" ::msgcat::mcset it "File \"%1\$s\" already exists.\n\n" "Il file \"%1\$s\" esiste gi\u00e0.\n\n" ::msgcat::mcset it "File \"%1\$s\" does not exist." "Il file \"%1\$s\" non esiste." @@ -29,18 +31,19 @@ namespace eval ::tk { ::msgcat::mcset it "Fil&ter:" "Fil&tro:" ::msgcat::mcset it "&Green" "&Verde" ::msgcat::mcset it "Hi" "Salve" - ::msgcat::mcset it "Hide Console" "Nascondi la console" + ::msgcat::mcset it "&Hide Console" "Nascondi la console" ::msgcat::mcset it "&Ignore" "&Ignora" ::msgcat::mcset it "Invalid file name \"%1\$s\"." "Nome di file non valido \"%1\$s\"." ::msgcat::mcset it "Log Files" "File di log" ::msgcat::mcset it "&No" ::msgcat::mcset it "&OK" + ::msgcat::mcset it "OK" ::msgcat::mcset it "Ok" - ::msgcat::mcset it "&Open" "A&pri" ::msgcat::mcset it "Open" "Apri" + ::msgcat::mcset it "&Open" "A&pri" ::msgcat::mcset it "Open Multiple Files" "Apri file multipli" - ::msgcat::mcset it "Paste" "Incolla" - ::msgcat::mcset it "Quit" "Esci" + ::msgcat::mcset it "P&aste" "Incolla" + ::msgcat::mcset it "&Quit" "Esci" ::msgcat::mcset it "&Red" "&Rosso" ::msgcat::mcset it "Replace existing file?" "Sostituisci il file esistente?" ::msgcat::mcset it "&Retry" "&Riprova" diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg index 90446c8..148a9e6 100644 --- a/library/msgs/nl.msg +++ b/library/msgs/nl.msg @@ -1,37 +1,33 @@ namespace eval ::tk { - ::msgcat::mcset nl "\"%1\$s\" must be an absolute pathname" "\"%1\$s\" moet een absolute pad-naam zijn" - ::msgcat::mcset nl "%1\$s is not a toplevel window" "%1\$s is geen toplevel window" - ::msgcat::mcset nl ", or" ", of" - ::msgcat::mcset nl "-default, -icon, -message, -parent, -title, or -type" "-default, -icon, -message, -parent, -title, of -type" - ::msgcat::mcset nl "-initialdir, -mustexist, -parent, or -title" "-initialdir, -mustexist, -parent, of -title" ::msgcat::mcset nl "&Abort" "&Afbreken" - ::msgcat::mcset nl "About..." "Over..." + ::msgcat::mcset nl "&About..." "Over..." ::msgcat::mcset nl "All Files" "Alle Bestanden" ::msgcat::mcset nl "Application Error" "Toepassingsfout" + ::msgcat::mcset nl "&Apply" "Toepassen" + ::msgcat::mcset nl "Bold" "Vet" + ::msgcat::mcset nl "Bold Italic" "Vet Cursief" ::msgcat::mcset nl "&Blue" "&Blauw" + ::msgcat::mcset nl "Cancel" "Annuleren" ::msgcat::mcset nl "&Cancel" "&Annuleren" ::msgcat::mcset nl "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan niet naar map \"%1\$s\" gaan.\nU heeft hiervoor geen toestemming." ::msgcat::mcset nl "Choose Directory" "Kies map" - ::msgcat::mcset nl "Clear" "Wissen" - ::msgcat::mcset nl "Clear entry, Press OK; Enter %1\$s, press OK" "Wis veld, Druk op OK; typ %1\$s in, druk op OK" + ::msgcat::mcset nl "Cl&ear" "Wissen" ::msgcat::mcset nl "&Clear Console" "&Wis Console" ::msgcat::mcset nl "Color" "Kleur" ::msgcat::mcset nl "Console" - ::msgcat::mcset nl "Copy" "Kopi\u00ebren" - ::msgcat::mcset nl "Cut" "Knippen" - ::msgcat::mcset nl "Delete" "Wissen" - ::msgcat::mcset nl "Details" + ::msgcat::mcset nl "&Copy" "Kopi\u00ebren" + ::msgcat::mcset nl "Cu&t" "Knippen" + ::msgcat::mcset nl "&Delete" "Wissen" ::msgcat::mcset nl "Details >>" ::msgcat::mcset nl "Directory \"%1\$s\" does not exist." "Map \"%1\$s\" bestaat niet." ::msgcat::mcset nl "&Directory:" "&Map:" - ::msgcat::mcset nl "Edit" "Bewerken" - ::msgcat::mcset nl "Enter \"%1\$s\", press OK" "Typ \"%1\$s\", druk op OK" - ::msgcat::mcset nl "Enter \"%1\$s\", press OK, enter \"%2\$s\", press OK" "Typ \"%1\$s\", druk op OK, typ \"%2\$s\", druk op OK" + ::msgcat::mcset nl "&Edit" "Bewerken" + ::msgcat::mcset nl "Effects" "Effecten" ::msgcat::mcset nl "Error: %1\$s" "Fout: %1\$s" - ::msgcat::mcset nl "Exit" "Be\u00ebindigen" - ::msgcat::mcset nl "File" "Bestand" - ::msgcat::mcset nl "File \"%1\$s\" already exists.\n\n" "Bestand \"%1\$s\" bestaat al.\n\n" + ::msgcat::mcset nl "E&xit" "Be\u00ebindigen" + ::msgcat::mcset nl "&File" "Bestand" ::msgcat::mcset nl "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Bestand \"%1\$s\" bestaat al.\nWilt u het overschrijven?" + ::msgcat::mcset nl "File \"%1\$s\" already exists.\n\n" "Bestand \"%1\$s\" bestaat al.\n\n" ::msgcat::mcset nl "File \"%1\$s\" does not exist." "Bestand \"%1\$s\" bestaat niet." ::msgcat::mcset nl "File &name:" "Bestands&naam:" ::msgcat::mcset nl "File &names:" "Bestands&namen:" @@ -39,71 +35,57 @@ namespace eval ::tk { ::msgcat::mcset nl "Fi&les:" "&Bestanden:" ::msgcat::mcset nl "&Filter" ::msgcat::mcset nl "Fil&ter:" + ::msgcat::mcset nl "Font" + ::msgcat::mcset nl "&Font:" + ::msgcat::mcset nl "Font st&yle:" "Font stijl:" ::msgcat::mcset nl "&Green" "&Groen" + ::msgcat::mcset nl "&Help" ::msgcat::mcset nl "Hi" "H\u00e9" - ::msgcat::mcset nl "Hide Console" "Verberg Console" + ::msgcat::mcset nl "&Hide Console" "Verberg Console" ::msgcat::mcset nl "&Ignore" "&Negeren" ::msgcat::mcset nl "Invalid file name \"%1\$s\"." "Ongeldige bestandsnaam \"%1\$s\"." + ::msgcat::mcset nl "Italic" "Cursief" ::msgcat::mcset nl "Log Files" "Log Bestanden" ::msgcat::mcset nl "&No" "&Nee" ::msgcat::mcset nl "&OK" + ::msgcat::mcset nl "OK" ::msgcat::mcset nl "Ok" - ::msgcat::mcset nl "&Open" "&Openen" ::msgcat::mcset nl "Open" "Openen" + ::msgcat::mcset nl "&Open" "&Openen" ::msgcat::mcset nl "Open Multiple Files" "Open meerdere bestanden" - ::msgcat::mcset nl "Paste" "Plakken" - ::msgcat::mcset nl "Please press %1\$s" "Druk op %1\$s, A.U.B." - ::msgcat::mcset nl "Please press ok" "Druk op ok, A.U.B." - ::msgcat::mcset nl "Press Cancel" "Druk op Annuleren" - ::msgcat::mcset nl "Press Ok" "Druk op Ok" - ::msgcat::mcset nl "Quit" "Stoppen" + ::msgcat::mcset nl "P&aste" "Pl&akken" + ::msgcat::mcset nl "&Quit" "Stoppen" ::msgcat::mcset nl "&Red" "&Rood" + ::msgcat::mcset nl "Regular" "Standaard" ::msgcat::mcset nl "Replace existing file?" "Vervang bestaand bestand?" ::msgcat::mcset nl "&Retry" "&Herhalen" + ::msgcat::mcset nl "Sample" ::msgcat::mcset nl "&Save" "Op&slaan" ::msgcat::mcset nl "Save As" "Opslaan als" ::msgcat::mcset nl "Save To Log" "Opslaan naar Log" ::msgcat::mcset nl "Select Log File" "Selecteer Log bestand" ::msgcat::mcset nl "Select a file to source" "Selecteer bronbestand" ::msgcat::mcset nl "&Selection:" "&Selectie:" + ::msgcat::mcset nl "&Size:" "Grootte" + ::msgcat::mcset nl "Show &Hidden Directories" "Laat verborgen mappen zien" + ::msgcat::mcset nl "Show &Hidden Files and Directories" "Laat verborgen bestanden mappen zien" ::msgcat::mcset nl "Skip Messages" "Berichten overslaan" - ::msgcat::mcset nl "Source..." "Bron..." + ::msgcat::mcset nl "&Source..." "Bron..." + ::msgcat::mcset nl "Stri&keout" ::msgcat::mcset nl "Tcl Scripts" ::msgcat::mcset nl "Tcl for Windows" "Tcl voor Windows" ::msgcat::mcset nl "Text Files" "Tekstbestanden" + ::msgcat::mcset nl "&Underline" "Onderstreept" ::msgcat::mcset nl "&Yes" "&Ja" ::msgcat::mcset nl "abort" "afbreken" - ::msgcat::mcset nl "abort, retry, ignore, ok, cancel, no, or yes" "afbreken, opnieuw, negeren, ok, annuleren, nee, of ja" - ::msgcat::mcset nl "abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel" "abortretryignore, ok, okcancel, retrycancel, yesno, of yesnocancel" - ::msgcat::mcset nl "bad %1\$s value \"%2\$s\": must be %3\$s" "verkeerde %1\$s waarde \"%2\$s\": moet zijn %3\$s" - ::msgcat::mcset nl "bad file type \"%1\$s\", should be" "verkeerd bestandstype \"%1\$s\", moet zijn" - ::msgcat::mcset nl "bad option \"%1\$s\": should be %2\$s" "verkeerde optie \"%1\$s\": moet zijn %2\$s" - ::msgcat::mcset nl "bad window path name \"%1\$s\"" "verkeerde window-padnaam \"%1\$s\"" ::msgcat::mcset nl "blue" "blauw" - ::msgcat::mcset nl "can't post %1\$s: it isn't a descendant of %2\$s (this is a new requirement in Tk versions 3.0 and later)" "kan %1\$s niet verzenden: het is geen afstammeling van %2\$s (dit is een nieuwe eis in Tk versies 3.0 en later)" ::msgcat::mcset nl "cancel" "annuleren" - ::msgcat::mcset nl "default button index greater than number of buttons specified for tk_dialog" "default knop index is groter dan het aantal knoppen beschikbaar voor tk_dialog" - ::msgcat::mcset nl "display name to use (current one otherwise)" "te gebruiken schermnaam (anders huidige scherm)" - ::msgcat::mcset nl "error, info, question, or warning" "error, info, question, of warning" ::msgcat::mcset nl "extension" ::msgcat::mcset nl "extensions" - ::msgcat::mcset nl "focus group \"%1\$s\" doesn't exist" "focusgroep \"%1\$s\" bestaat niet" ::msgcat::mcset nl "green" "groen" - ::msgcat::mcset nl "history event %1\$s" ::msgcat::mcset nl "ignore" "negeren" - ::msgcat::mcset nl "invalid default button \"%1\$s\"" "ongeldige default knop \"%1\$s\"" - ::msgcat::mcset nl "macType" - ::msgcat::mcset nl "macTypes" - ::msgcat::mcset nl "must specify a background color" "een achtergrondkleur is verplicht" - ::msgcat::mcset nl "name of the slave interpreter" "naam van de slaaf-interpreter" - ::msgcat::mcset nl "no winfo screen . nor env(DISPLAY)" "geen winfo scherm . noch env(DISPLAY)" ::msgcat::mcset nl "ok" ::msgcat::mcset nl "red" "rood" ::msgcat::mcset nl "retry" "opnieuw" - ::msgcat::mcset nl "should contain 5 or 4 elements" "moet 4 of 5 elementen bevatten" - ::msgcat::mcset nl "spec" - ::msgcat::mcset nl "tk_chooseDirectory command" "tk_chooseDirectory opdracht" - ::msgcat::mcset nl "tk_chooseDirectory command, cancel gives null" "tk_chooseDirectory opdracht, annuleren geeft lege waarde" - ::msgcat::mcset nl "tk_chooseDirectory command, initialdir" "tk_chooseDirectory opdracht, initi\u00eble map" ::msgcat::mcset nl "yes" "ja" } diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg index debebcb..c20f41e 100644 --- a/library/msgs/pl.msg +++ b/library/msgs/pl.msg @@ -3,7 +3,11 @@ namespace eval ::tk { ::msgcat::mcset pl "&About..." "O programie..." ::msgcat::mcset pl "All Files" "Wszystkie pliki" ::msgcat::mcset pl "Application Error" "B\u0142\u0105d w programie" + ::msgcat::mcset pl "&Apply" "Zastosuj" + ::msgcat::mcset pl "Bold" "Pogrubienie" + ::msgcat::mcset pl "Bold Italic" "Pogrubiona kursywa" ::msgcat::mcset pl "&Blue" "&Niebieski" + ::msgcat::mcset pl "Cancel" "Anuluj" ::msgcat::mcset pl "&Cancel" "&Anuluj" ::msgcat::mcset pl "Cannot change to the directory \"%1\$s\".\nPermission denied." "Nie mo\u017cna otworzy\u0107 katalogu \"%1\$s\".\nOdmowa dost\u0119pu." ::msgcat::mcset pl "Choose Directory" "Wybierz katalog" @@ -18,6 +22,7 @@ namespace eval ::tk { ::msgcat::mcset pl "Directory \"%1\$s\" does not exist." "Katalog \"%1\$s\" nie istnieje." ::msgcat::mcset pl "&Directory:" "&Katalog:" ::msgcat::mcset pl "&Edit" "&Edytuj" + ::msgcat::mcset pl "Effects" "Efekty" ::msgcat::mcset pl "Error: %1\$s" "B\u0142\u0105d: %1\$s" ::msgcat::mcset pl "E&xit" "&Wyjd\u017a" ::msgcat::mcset pl "&File" "&Plik" @@ -30,35 +35,47 @@ namespace eval ::tk { ::msgcat::mcset pl "Fi&les:" "Pli&ki:" ::msgcat::mcset pl "&Filter" "&Filtr" ::msgcat::mcset pl "Fil&ter:" "&Filtr:" + ::msgcat::mcset pl "Font" "Czcionka" + ::msgcat::mcset pl "&Font:" "Czcio&nka:" + ::msgcat::mcset pl "Font st&yle:" "&Styl czcionki:" ::msgcat::mcset pl "&Green" "&Zielony" ::msgcat::mcset pl "&Help" "&Pomoc" ::msgcat::mcset pl "Hi" "Witaj" ::msgcat::mcset pl "&Hide Console" "&Ukryj konsol\u0119" ::msgcat::mcset pl "&Ignore" "&Ignoruj" ::msgcat::mcset pl "Invalid file name \"%1\$s\"." "Niew\u0142a\u015bciwa nazwa pliku \"%1\$s\"." + ::msgcat::mcset pl "Italic" "Kursywa" ::msgcat::mcset pl "Log Files" "Pliki dziennika" ::msgcat::mcset pl "&No" "&Nie" - ::msgcat::mcset pl "OK" "OK" - ::msgcat::mcset pl "Ok" "Ok" + ::msgcat::mcset pl "&OK" + ::msgcat::mcset pl "OK" + ::msgcat::mcset pl "Ok" ::msgcat::mcset pl "Open" "Otw\u00f3rz" ::msgcat::mcset pl "&Open" "&Otw\u00f3rz" ::msgcat::mcset pl "Open Multiple Files" "Otw\u00f3rz wiele plik\u00f3w" ::msgcat::mcset pl "P&aste" "&Wklej" ::msgcat::mcset pl "&Quit" "&Zako\u0144cz" ::msgcat::mcset pl "&Red" "&Czerwony" + ::msgcat::mcset pl "Regular" "Regularne" ::msgcat::mcset pl "Replace existing file?" "Czy zast\u0105pi\u0107 istniej\u0105cy plik?" ::msgcat::mcset pl "&Retry" "&Pon\u00f3w" + ::msgcat::mcset pl "Sample" "Przyk\u0142ad" ::msgcat::mcset pl "&Save" "&Zapisz" ::msgcat::mcset pl "Save As" "Zapisz jako" ::msgcat::mcset pl "Save To Log" "Wpisz do dziennika" ::msgcat::mcset pl "Select Log File" "Wybierz plik dziennika" ::msgcat::mcset pl "Select a file to source" "Wybierz plik do wykonania" ::msgcat::mcset pl "&Selection:" "&Wyb\u00f3r:" + ::msgcat::mcset pl "&Size:" "&Rozmiar:" + ::msgcat::mcset pl "Show &Hidden Directories" "Poka\u017c &ukryte katalogi" + ::msgcat::mcset pl "Show &Hidden Files and Directories" "Poka\u017c &ukryte pliki i katalogi" ::msgcat::mcset pl "Skip Messages" "Pomi\u0144 pozosta\u0142e komunikaty" ::msgcat::mcset pl "&Source..." "&Kod \u017ar\u00f3d\u0142owy..." + ::msgcat::mcset pl "Stri&keout" "&Przekre\u015blenie" ::msgcat::mcset pl "Tcl Scripts" "Skrypty Tcl" ::msgcat::mcset pl "Tcl for Windows" "Tcl dla Windows" ::msgcat::mcset pl "Text Files" "Pliki tekstowe" + ::msgcat::mcset pl "&Underline" "Po&dkre\u015blenie" ::msgcat::mcset pl "&Yes" "&Tak" ::msgcat::mcset pl "abort" "przerwij" ::msgcat::mcset pl "blue" "niebieski" @@ -67,6 +84,7 @@ namespace eval ::tk { ::msgcat::mcset pl "extensions" "rozszerzenia" ::msgcat::mcset pl "green" "zielony" ::msgcat::mcset pl "ignore" "ignoruj" + ::msgcat::mcset pl "ok" ::msgcat::mcset pl "red" "czerwony" ::msgcat::mcset pl "retry" "pon\u00f3w" ::msgcat::mcset pl "yes" "tak" diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg index 259f82e..c29e293 100644 --- a/library/msgs/pt.msg +++ b/library/msgs/pt.msg @@ -1,70 +1,74 @@ namespace eval ::tk { - ::msgcat::mcset pt_br "&Abort" "&Abortar" - ::msgcat::mcset pt_br "About..." "Sobre ..." - ::msgcat::mcset pt_br "All Files" "Todos os arquivos" - ::msgcat::mcset pt_br "Application Error" "Erro de aplica\u00e7\u00e3o" - ::msgcat::mcset pt_br "&Blue" "&Azul" - ::msgcat::mcset pt_br "&Cancel" "&Cancelar" - ::msgcat::mcset pt_br "Cannot change to the directory \"%1\$s\".\nPermission denied." "N\u00e3o foi poss\u00edvel mudar para o diret\u00f3rio \"%1\$s\".\nPermiss\u00e3o negada." - ::msgcat::mcset pt_br "Choose Directory" "Escolha um diret\u00f3rio" - ::msgcat::mcset pt_br "Clear" "Apagar" - ::msgcat::mcset pt_br "Color" "Cor" - ::msgcat::mcset pt_br "Console" "Console" - ::msgcat::mcset pt_br "Copy" "Copiar" - ::msgcat::mcset pt_br "Cut" "Recortar" - ::msgcat::mcset pt_br "Delete" "Excluir" - ::msgcat::mcset pt_br "Details >>" "Detalhes >>" - ::msgcat::mcset pt_br "Directory \"%1\$s\" does not exist." "O diret\u00f3rio \"%1\$s\" n\u00e3o existe." - ::msgcat::mcset pt_br "&Directory:" "&Diret\u00f3rio:" - ::msgcat::mcset pt_br "Error: %1\$s" "Erro: %1\$s" - ::msgcat::mcset pt_br "Exit" "Sair" - ::msgcat::mcset pt_br "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "O arquivo \"%1\$s\" j\u00e1 existe.\nDeseja sobrescreve-lo?" - ::msgcat::mcset pt_br "File \"%1\$s\" already exists.\n\n" "O arquivo \"%1\$s\" j\u00e1 existe.\n\n" - ::msgcat::mcset pt_br "File \"%1\$s\" does not exist." "Arquivo \"%1\$s\" n\u00e3o existe." - ::msgcat::mcset pt_br "File &name:" "&Nome do arquivo:" - ::msgcat::mcset pt_br "File &names:" "&Nomes dos arquivos:" - ::msgcat::mcset pt_br "Files of &type:" "Arquivos do &tipo:" - ::msgcat::mcset pt_br "Fi&les:" "&Arquivos:" - ::msgcat::mcset pt_br "&Filter" "&Filtro" - ::msgcat::mcset pt_br "Fil&ter:" "Fil&tro:" - ::msgcat::mcset pt_br "&Green" "&Verde" - ::msgcat::mcset pt_br "Hi" "Oi" - ::msgcat::mcset pt_br "Hide Console" "Ocultar console" - ::msgcat::mcset pt_br "&Ignore" "&Ignorar" - ::msgcat::mcset pt_br "Invalid file name \"%1\$s\"." "O nome do arquivo \u00e9 inv\u00e1lido \"%1\$s\"." - ::msgcat::mcset pt_br "Log Files" "Arquivos de log" - ::msgcat::mcset pt_br "&No" "&N\u00e3o" - ::msgcat::mcset pt_br "&OK" "&OK" - ::msgcat::mcset pt_br "Ok" "Ok" - ::msgcat::mcset pt_br "Open" "Abrir" - ::msgcat::mcset pt_br "&Open" "&Abrir" - ::msgcat::mcset pt_br "Open Multiple Files" "Abrir m\u00faltiplos arquivos" - ::msgcat::mcset pt_br "Paste" "Colar" - ::msgcat::mcset pt_br "Quit" "Encerrar" - ::msgcat::mcset pt_br "&Red" "&Vermelho" - ::msgcat::mcset pt_br "Replace existing file?" "Substituir arquivo existente?" - ::msgcat::mcset pt_br "&Retry" "Tenta&r novamente" - ::msgcat::mcset pt_br "&Save" "&Salvar" - ::msgcat::mcset pt_br "Save As" "Salvar como" - ::msgcat::mcset pt_br "Save To Log" "Salvar arquivo de log" - ::msgcat::mcset pt_br "Select Log File" "Selecionar arquivo de log" - ::msgcat::mcset pt_br "Select a file to source" "Selecione um arquivo como fonte(source)" - ::msgcat::mcset pt_br "&Selection:" "&Sele\u00e7\u00e3o:" - ::msgcat::mcset pt_br "Skip Messages" "Omitir as mensagens" - ::msgcat::mcset pt_br "Source..." "Source..." - ::msgcat::mcset pt_br "Tcl Scripts" "Scripts Tcl" - ::msgcat::mcset pt_br "Tcl for Windows" "Tcl para Windows" - ::msgcat::mcset pt_br "Text Files" "Arquivos de texto" - ::msgcat::mcset pt_br "&Yes" "&Sim" - ::msgcat::mcset pt_br "abort" "abortar" - ::msgcat::mcset pt_br "blue" "azul" - ::msgcat::mcset pt_br "cancel" "cancelar" - ::msgcat::mcset pt_br "extension" "extens\u00e3o" - ::msgcat::mcset pt_br "extensions" "extens\u00f5es" - ::msgcat::mcset pt_br "green" "verde" - ::msgcat::mcset pt_br "ignore" "ignorar" - ::msgcat::mcset pt_br "ok" "ok" - ::msgcat::mcset pt_br "red" "vermelho" - ::msgcat::mcset pt_br "retry" "tentar novamente" - ::msgcat::mcset pt_br "yes" "sim" + ::msgcat::mcset pt "&Abort" "&Abortar" + ::msgcat::mcset pt "About..." "Sobre ..." + ::msgcat::mcset pt "All Files" "Todos os arquivos" + ::msgcat::mcset pt "Application Error" "Erro de aplica\u00e7\u00e3o" + ::msgcat::mcset pt "&Blue" "&Azul" + ::msgcat::mcset pt "Cancel" "Cancelar" + ::msgcat::mcset pt "&Cancel" "&Cancelar" + ::msgcat::mcset pt "Cannot change to the directory \"%1\$s\".\nPermission denied." "N\u00e3o foi poss\u00edvel mudar para o diret\u00f3rio \"%1\$s\".\nPermiss\u00e3o negada." + ::msgcat::mcset pt "Choose Directory" "Escolha um diret\u00f3rio" + ::msgcat::mcset pt "Cl&ear" "Apagar" + ::msgcat::mcset pt "&Clear Console" "Apagar Console" + ::msgcat::mcset pt "Color" "Cor" + ::msgcat::mcset pt "Console" + ::msgcat::mcset pt "&Copy" "Copiar" + ::msgcat::mcset pt "Cu&t" "Recortar" + ::msgcat::mcset pt "&Delete" "Excluir" + ::msgcat::mcset pt "Details >>" "Detalhes >>" + ::msgcat::mcset pt "Directory \"%1\$s\" does not exist." "O diret\u00f3rio \"%1\$s\" n\u00e3o existe." + ::msgcat::mcset pt "&Directory:" "&Diret\u00f3rio:" + ::msgcat::mcset pt "Error: %1\$s" "Erro: %1\$s" + ::msgcat::mcset pt "E&xit" "Sair" + ::msgcat::mcset pt "&File" "Arquivo" + ::msgcat::mcset pt "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "O arquivo \"%1\$s\" j\u00e1 existe.\nDeseja sobrescreve-lo?" + ::msgcat::mcset pt "File \"%1\$s\" already exists.\n\n" "O arquivo \"%1\$s\" j\u00e1 existe.\n\n" + ::msgcat::mcset pt "File \"%1\$s\" does not exist." "Arquivo \"%1\$s\" n\u00e3o existe." + ::msgcat::mcset pt "File &name:" "&Nome do arquivo:" + ::msgcat::mcset pt "File &names:" "&Nomes dos arquivos:" + ::msgcat::mcset pt "Files of &type:" "Arquivos do &tipo:" + ::msgcat::mcset pt "Fi&les:" "&Arquivos:" + ::msgcat::mcset pt "&Filter" "&Filtro" + ::msgcat::mcset pt "Fil&ter:" "Fil&tro:" + ::msgcat::mcset pt "&Green" "&Verde" + ::msgcat::mcset pt "Hi" "Oi" + ::msgcat::mcset pt "&Hide Console" "Ocultar console" + ::msgcat::mcset pt "&Ignore" "&Ignorar" + ::msgcat::mcset pt "Invalid file name \"%1\$s\"." "O nome do arquivo \u00e9 inv\u00e1lido \"%1\$s\"." + ::msgcat::mcset pt "Log Files" "Arquivos de log" + ::msgcat::mcset pt "&No" "&N\u00e3o" + ::msgcat::mcset pt "&OK" + ::msgcat::mcset pt "OK" + ::msgcat::mcset pt "Ok" + ::msgcat::mcset pt "Open" "Abrir" + ::msgcat::mcset pt "&Open" "&Abrir" + ::msgcat::mcset pt "Open Multiple Files" "Abrir m\u00faltiplos arquivos" + ::msgcat::mcset pt "P&aste" "Col&ar" + ::msgcat::mcset pt "Quit" "Encerrar" + ::msgcat::mcset pt "&Red" "&Vermelho" + ::msgcat::mcset pt "Replace existing file?" "Substituir arquivo existente?" + ::msgcat::mcset pt "&Retry" "Tenta&r novamente" + ::msgcat::mcset pt "&Save" "&Salvar" + ::msgcat::mcset pt "Save As" "Salvar como" + ::msgcat::mcset pt "Save To Log" "Salvar arquivo de log" + ::msgcat::mcset pt "Select Log File" "Selecionar arquivo de log" + ::msgcat::mcset pt "Select a file to source" "Selecione um arquivo como fonte" + ::msgcat::mcset pt "&Selection:" "&Sele\u00e7\u00e3o:" + ::msgcat::mcset pt "Skip Messages" "Omitir as mensagens" + ::msgcat::mcset pt "&Source..." "&Fonte..." + ::msgcat::mcset pt "Tcl Scripts" "Scripts Tcl" + ::msgcat::mcset pt "Tcl for Windows" "Tcl para Windows" + ::msgcat::mcset pt "Text Files" "Arquivos de texto" + ::msgcat::mcset pt "&Yes" "&Sim" + ::msgcat::mcset pt "abort" "abortar" + ::msgcat::mcset pt "blue" "azul" + ::msgcat::mcset pt "cancel" "cancelar" + ::msgcat::mcset pt "extension" "extens\u00e3o" + ::msgcat::mcset pt "extensions" "extens\u00f5es" + ::msgcat::mcset pt "green" "verde" + ::msgcat::mcset pt "ignore" "ignorar" + ::msgcat::mcset pt "ok" + ::msgcat::mcset pt "red" "vermelho" + ::msgcat::mcset pt "retry" "tentar novamente" + ::msgcat::mcset pt "yes" "sim" } diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg index 9f6aa80..2aac5bb 100644 --- a/library/msgs/ru.msg +++ b/library/msgs/ru.msg @@ -1,24 +1,25 @@ namespace eval ::tk { ::msgcat::mcset ru "&Abort" "&\u041e\u0442\u043c\u0435\u043d\u0438\u0442\u044c" - ::msgcat::mcset ru "About..." "\u041f\u0440\u043e..." + ::msgcat::mcset ru "&About..." "\u041f\u0440\u043e..." ::msgcat::mcset ru "All Files" "\u0412\u0441\u0435 \u0444\u0430\u0439\u043b\u044b" ::msgcat::mcset ru "Application Error" "\u041e\u0448\u0438\u0431\u043a\u0430 \u0432 \u043f\u0440\u043e\u0433\u0440\u0430\u043c\u043c\u0435" ::msgcat::mcset ru "&Blue" " &\u0413\u043e\u043b\u0443\u0431\u043e\u0439" + ::msgcat::mcset ru "Cancel" "\u041e\u0442&\u043c\u0435\u043d\u0430" ::msgcat::mcset ru "&Cancel" "\u041e\u0442&\u043c\u0435\u043d\u0430" ::msgcat::mcset ru "Cannot change to the directory \"%1\$s\".\nPermission denied." \ "\u041d\u0435 \u043c\u043e\u0433\u0443 \u043f\u0435\u0440\u0435\u0439\u0442\u0438 \u0432 \u043a\u0430\u0442\u0430\u043b\u043e\u0433 \"%1\$s\".\n\u041d\u0435\u0434\u043e\u0441\u0442\u0430\u0442\u043e\u0447\u043d\u043e \u043f\u0440\u0430\u0432 \u0434\u043e\u0441\u0442\u0443\u043f\u0430" ::msgcat::mcset ru "Choose Directory" "\u0412\u044b\u0431\u0435\u0440\u0438\u0442\u0435 \u043a\u0430\u0442\u0430\u043b\u043e\u0433" - ::msgcat::mcset ru "Clear" "\u041e\u0447\u0438\u0441\u0442\u0438\u0442\u044c" + ::msgcat::mcset ru "Cl&ear" "\u041e\u0447\u0438\u0441\u0442\u0438\u0442\u044c" ::msgcat::mcset ru "Color" "\u0426\u0432\u0435\u0442" ::msgcat::mcset ru "Console" "\u041a\u043e\u043d\u0441\u043e\u043b\u044c" - ::msgcat::mcset ru "Copy" "\u041a\u043e\u043f\u0438\u0440\u043e\u0432\u0430\u0442\u044c" - ::msgcat::mcset ru "Cut" "\u0412\u044b\u0440\u0435\u0437\u0430\u0442\u044c" - ::msgcat::mcset ru "Delete" "\u0423\u0434\u0430\u043b\u0438\u0442\u044c" + ::msgcat::mcset ru "&Copy" "\u041a\u043e\u043f\u0438\u0440\u043e\u0432\u0430\u0442\u044c" + ::msgcat::mcset ru "Cu&t" "\u0412\u044b\u0440\u0435\u0437\u0430\u0442\u044c" + ::msgcat::mcset ru "&Delete" "\u0423\u0434\u0430\u043b\u0438\u0442\u044c" ::msgcat::mcset ru "Details >>" "\u041f\u043e\u0434\u0440\u043e\u0431\u043d\u0435\u0435 >>" ::msgcat::mcset ru "Directory \"%1\$s\" does not exist." "\u041a\u0430\u0442\u0430\u043b\u043e\u0433\u0430 \"%1\$s\" \u043d\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442." ::msgcat::mcset ru "&Directory:" "&\u041a\u0430\u0442\u0430\u043b\u043e\u0433:" - ::msgcat::mcset ru "Error: %1\$s" "\u041e\u0448\u0438\u0431\u043a\u0430: %1\$s" - ::msgcat::mcset ru "Exit" "\u0412\u044b\u0445\u043e\u0434" + ::msgcat::mcset ru "Error: %1\$s" "\u041e\u0448\u0438\u0431\u043a\u0430: %1\$s" + ::msgcat::mcset ru "E&xit" "\u0412\u044b\u0445\u043e\u0434" ::msgcat::mcset ru "File \"%1\$s\" already exists.\nDo you want to overwrite it?" \ "\u0424\u0430\u0439\u043b \"%1\$s\" \u0443\u0436\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442.\n\u0417\u0430\u043c\u0435\u043d\u0438\u0442\u044c \u0435\u0433\u043e?" ::msgcat::mcset ru "File \"%1\$s\" already exists.\n\n" "\u0424\u0430\u0439\u043b \"%1\$s\" \u0443\u0436\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442.\n\n" @@ -31,18 +32,19 @@ namespace eval ::tk { ::msgcat::mcset ru "Fil&ter:" "\u0424\u0438\u043b\u044c&\u0442\u0440:" ::msgcat::mcset ru "&Green" " &\u0417\u0435\u043b\u0435\u043d\u044b\u0439" ::msgcat::mcset ru "Hi" "\u041f\u0440\u0438\u0432\u0435\u0442" - ::msgcat::mcset ru "Hide Console" "\u0421\u043f\u0440\u044f\u0442\u0430\u0442\u044c \u043a\u043e\u043d\u0441\u043e\u043b\u044c" + ::msgcat::mcset ru "&Hide Console" "\u0421\u043f\u0440\u044f\u0442\u0430\u0442\u044c \u043a\u043e\u043d\u0441\u043e\u043b\u044c" ::msgcat::mcset ru "&Ignore" "&\u0418\u0433\u043d\u043e\u0440\u0438\u0440\u043e\u0432\u0430\u0442\u044c" - ::msgcat::mcset ru "Invalid file name \"%1\$s\"." "\u041d\u0435\u0432\u0435\u0440\u043d\u043e\u0435 \u0438\u043c\u044f \u0444\u0430\u0439\u043b\u0430 \"%1\$s\"." + ::msgcat::mcset ru "Invalid file name \"%1\$s\"." "\u041d\u0435\u0432\u0435\u0440\u043d\u043e\u0435 \u0438\u043c\u044f \u0444\u0430\u0439\u043b\u0430 \"%1\$s\"." ::msgcat::mcset ru "Log Files" "\u0424\u0430\u0439\u043b\u044b \u0436\u0443\u0440\u043d\u0430\u043b\u0430" ::msgcat::mcset ru "&No" "&\u041d\u0435\u0442" ::msgcat::mcset ru "&OK" "&\u041e\u041a" + ::msgcat::mcset ru "OK" "\u041e\u041a" ::msgcat::mcset ru "Ok" "\u0414\u0430" ::msgcat::mcset ru "Open" "\u041e\u0442\u043a\u0440\u044b\u0442\u044c" ::msgcat::mcset ru "&Open" "&\u041e\u0442\u043a\u0440\u044b\u0442\u044c" ::msgcat::mcset ru "Open Multiple Files" "\u041e\u0442\u043a\u0440\u044b\u0442\u044c \u043d\u0435\u0441\u043a\u043e\u043b\u044c\u043a\u043e \u0444\u0430\u0439\u043b\u043e\u0432" - ::msgcat::mcset ru "Paste" "\u0412\u0441\u0442\u0430\u0432\u0438\u0442\u044c" - ::msgcat::mcset ru "Quit" "\u0412\u044b\u0445\u043e\u0434" + ::msgcat::mcset ru "P&aste" "\u0412\u0441\u0442\u0430\u0432\u0438\u0442\u044c" + ::msgcat::mcset ru "&Quit" "\u0412\u044b\u0445\u043e\u0434" ::msgcat::mcset ru "&Red" " &\u041a\u0440\u0430\u0441\u043d\u044b\u0439" ::msgcat::mcset ru "Replace existing file?" "\u0417\u0430\u043c\u0435\u043d\u0438\u0442\u044c \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u044e\u0449\u0438\u0439 \u0444\u0430\u0439\u043b?" ::msgcat::mcset ru "&Retry" "&\u041f\u043e\u0432\u0442\u043e\u0440\u0438\u0442\u044c" @@ -51,9 +53,9 @@ namespace eval ::tk { ::msgcat::mcset ru "Save To Log" "\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c \u0432 \u0436\u0443\u0440\u043d\u0430\u043b" ::msgcat::mcset ru "Select Log File" "\u0412\u044b\u0431\u0440\u0430\u0442\u044c \u0436\u0443\u0440\u043d\u0430\u043b" ::msgcat::mcset ru "Select a file to source" "\u0412\u044b\u0431\u0435\u0440\u0438\u0442\u0435 \u0444\u0430\u0439\u043b \u0434\u043b\u044f \u0438\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0430\u0446\u0438\u0438" - ::msgcat::mcset ru "&Selection:" "&Selection:" + ::msgcat::mcset ru "&Selection:" ::msgcat::mcset ru "Skip Messages" "\u041f\u0440\u043e\u043f\u0443\u0441\u0442\u0438\u0442\u044c \u0441\u043e\u043e\u0431\u0449\u0435\u043d\u0438\u044f" - ::msgcat::mcset ru "Source..." "\u0418\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0438\u0440\u043e\u0432\u0430\u0442\u044c \u0444\u0430\u0439\u043b..." + ::msgcat::mcset ru "&Source..." "\u0418\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0438\u0440\u043e\u0432\u0430\u0442\u044c \u0444\u0430\u0439\u043b..." ::msgcat::mcset ru "Tcl Scripts" "\u041f\u0440\u043e\u0433\u0440\u0430\u043c\u043c\u0430 \u043d\u0430 \u044f\u0437\u044b\u043a\u0435 TCL" ::msgcat::mcset ru "Tcl for Windows" "TCL \u0434\u043b\u044f Windows" ::msgcat::mcset ru "Text Files" "\u0422\u0435\u043a\u0441\u0442\u043e\u0432\u044b\u0435 \u0444\u0430\u0439\u043b\u044b" diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg index 14ce14d..62bfcbd 100644 --- a/library/msgs/sv.msg +++ b/library/msgs/sv.msg @@ -4,10 +4,11 @@ namespace eval ::tk { ::msgcat::mcset sv "All Files" "Samtliga filer" ::msgcat::mcset sv "Application Error" "Programfel" ::msgcat::mcset sv "&Blue" "&Bl\u00e5" + ::msgcat::mcset sv "Cancel" "Avbryt" ::msgcat::mcset sv "&Cancel" "&Avbryt" ::msgcat::mcset sv "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan ej n\u00e5 mappen \"%1\$s\".\nSaknar r\u00e4ttigheter." ::msgcat::mcset sv "Choose Directory" "V\u00e4lj mapp" - ::msgcat::mcset sv "&Clear" "&Radera" + ::msgcat::mcset sv "Cl&ear" "&Radera" ::msgcat::mcset sv "&Clear Console" "&Radera konsollen" ::msgcat::mcset sv "Color" "F\u00e4rg" ::msgcat::mcset sv "Console" "Konsoll" @@ -38,6 +39,7 @@ namespace eval ::tk { ::msgcat::mcset sv "Invalid file name \"%1\$s\"." "Ogiltigt filnamn \"%1\$s\"." ::msgcat::mcset sv "Log Files" "Loggfiler" ::msgcat::mcset sv "&No" "&Nej" + ::msgcat::mcset sv "&OK" ::msgcat::mcset sv "OK" ::msgcat::mcset sv "Ok" ::msgcat::mcset sv "Open" "\u00d6ppna" diff --git a/library/palette.tcl b/library/palette.tcl index 21be8dc..9cecf5b 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -36,7 +36,8 @@ proc ::tk_setPalette {args} { array set new $args } if {![info exists new(background)]} { - error "must specify a background color" + return -code error -errorcode {TK SET_PALETTE BACKGROUND} \ + "must specify a background color" } set bg [winfo rgb . $new(background)] if {![info exists new(foreground)]} { @@ -99,7 +100,7 @@ proc ::tk_setPalette {args} { set new(troughColor) $darkerBg } - # let's make one of each of the widgets so we know what the + # let's make one of each of the widgets so we know what the # defaults are currently for this platform. toplevel .___tk_set_palette wm withdraw .___tk_set_palette @@ -112,12 +113,12 @@ proc ::tk_setPalette {args} { } # Walk the widget hierarchy, recoloring all existing windows. - # The option database must be set according to what we do here, - # but it breaks things if we set things in the database while + # The option database must be set according to what we do here, + # but it breaks things if we set things in the database while # we are changing colors...so, ::tk::RecolorTree now returns the # option database changes that need to be made, and they # need to be evalled here to take effect. - # We have to walk the whole widget tree instead of just + # We have to walk the whole widget tree instead of just # relying on the widgets we've created above to do the work # because different extensions may provide other kinds # of widgets that we don't currently know about, so we'll @@ -143,7 +144,7 @@ proc ::tk_setPalette {args} { # ::tk::RecolorTree -- # This procedure changes the colors in a window and all of its # descendants, according to information provided by the colors -# argument. This looks at the defaults provided by the option +# argument. This looks at the defaults provided by the option # database, if it exists, and if not, then it looks at the default # value of the widget itself. # diff --git a/library/safetk.tcl b/library/safetk.tcl index c975fd6..9f8e25d 100644 --- a/library/safetk.tcl +++ b/library/safetk.tcl @@ -85,14 +85,12 @@ proc ::safe::loadTk {} {} if {![::tcl::OptProcArgGiven "-use"]} { # create a decorated toplevel - ::tcl::Lassign [tkTopLevel $slave $display] w use + lassign [tkTopLevel $slave $display] w use # set our delete hook (slave arg is added by interpDelete) # to clean up both window related code and tkInit(slave) set state(cleanupHook) [list tkDelete {} $w] - } else { - # set our delete hook (slave arg is added by interpDelete) # to clean up tkInit(slave) set state(cleanupHook) [list disallowTk] @@ -116,8 +114,8 @@ proc ::safe::loadTk {} {} } if {$nDisplay ne $display} { if {$displayGiven} { - error "conflicting -display $display and -use\ - $use -> $nDisplay" + return -code error -errorcode {TK DISPLAY SAFE} \ + "conflicting -display $display and -use $use -> $nDisplay" } else { set display $nDisplay } @@ -141,7 +139,7 @@ proc ::safe::TkInit {interpPath} { } else { Log $interpPath "TkInit called for interp with clearance:\ preventing Tk init" ERROR - error "not allowed" + return -code error -errorcode {TK SAFE PERMISSION} "not allowed" } } @@ -221,8 +219,8 @@ proc ::safe::tkTopLevel {slave display} { incr tkSafeId set w ".safe$tkSafeId" if {[catch {toplevel $w -screen $display -class SafeTk} msg]} { - return -code error "Unable to create toplevel for\ - safe slave \"$slave\" ($msg)" + return -code error -errorcode {TK TOPLEVEL SAFE} \ + "Unable to create toplevel for safe slave \"$slave\" ($msg)" } Log $slave "New toplevel $w" NOTICE diff --git a/library/scale.tcl b/library/scale.tcl index 771c7a4..fb9b81b 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -71,34 +71,34 @@ if {[tk windowingsystem] eq "win32"} { bind Scale <Control-1> { tk::ScaleControlPress %W %x %y } -bind Scale <Up> { +bind Scale <<PrevLine>> { tk::ScaleIncrement %W up little noRepeat } -bind Scale <Down> { +bind Scale <<NextLine>> { tk::ScaleIncrement %W down little noRepeat } -bind Scale <Left> { +bind Scale <<PrevChar>> { tk::ScaleIncrement %W up little noRepeat } -bind Scale <Right> { +bind Scale <<NextChar>> { tk::ScaleIncrement %W down little noRepeat } -bind Scale <Control-Up> { +bind Scale <<PrevPara>> { tk::ScaleIncrement %W up big noRepeat } -bind Scale <Control-Down> { +bind Scale <<NextPara>> { tk::ScaleIncrement %W down big noRepeat } -bind Scale <Control-Left> { +bind Scale <<PrevWord>> { tk::ScaleIncrement %W up big noRepeat } -bind Scale <Control-Right> { +bind Scale <<NextWord>> { tk::ScaleIncrement %W down big noRepeat } -bind Scale <Home> { +bind Scale <<LineStart>> { %W set [%W cget -from] } -bind Scale <End> { +bind Scale <<LineEnd>> { %W set [%W cget -to] } diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 7cec556..2a70b97 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -91,28 +91,28 @@ bind Scrollbar <Control-2> { tk::ScrollTopBottom %W %x %y } -bind Scrollbar <Up> { +bind Scrollbar <<PrevLine>> { tk::ScrollByUnits %W v -1 } -bind Scrollbar <Down> { +bind Scrollbar <<NextLine>> { tk::ScrollByUnits %W v 1 } -bind Scrollbar <Control-Up> { +bind Scrollbar <<PrevPara>> { tk::ScrollByPages %W v -1 } -bind Scrollbar <Control-Down> { +bind Scrollbar <<NextPara>> { tk::ScrollByPages %W v 1 } -bind Scrollbar <Left> { +bind Scrollbar <<PrevChar>> { tk::ScrollByUnits %W h -1 } -bind Scrollbar <Right> { +bind Scrollbar <<NextChar>> { tk::ScrollByUnits %W h 1 } -bind Scrollbar <Control-Left> { +bind Scrollbar <<PrevWord>> { tk::ScrollByPages %W h -1 } -bind Scrollbar <Control-Right> { +bind Scrollbar <<NextWord>> { tk::ScrollByPages %W h 1 } bind Scrollbar <Prior> { @@ -121,25 +121,41 @@ bind Scrollbar <Prior> { bind Scrollbar <Next> { tk::ScrollByPages %W hv 1 } -bind Scrollbar <Home> { +bind Scrollbar <<LineStart>> { tk::ScrollToPos %W 0 } -bind Scrollbar <End> { +bind Scrollbar <<LineEnd>> { tk::ScrollToPos %W 1 } } -if {[tk windowingsystem] eq "aqua"} { - bind Scrollbar <MouseWheel> { - tk::ScrollByUnits %W v [expr {- (%D)}] - } - bind Scrollbar <Option-MouseWheel> { - tk::ScrollByUnits %W v [expr {-10 * (%D)}] +switch [tk windowingsystem] { + "aqua" { + bind Scrollbar <MouseWheel> { + tk::ScrollByUnits %W v [expr {- (%D)}] + } + bind Scrollbar <Option-MouseWheel> { + tk::ScrollByUnits %W v [expr {-10 * (%D)}] + } + bind Scrollbar <Shift-MouseWheel> { + tk::ScrollByUnits %W h [expr {- (%D)}] + } + bind Scrollbar <Shift-Option-MouseWheel> { + tk::ScrollByUnits %W h [expr {-10 * (%D)}] + } } - bind Scrollbar <Shift-MouseWheel> { - tk::ScrollByUnits %W h [expr {- (%D)}] + "win32" { + bind Scrollbar <MouseWheel> { + tk::ScrollByUnits %W v [expr {- (%D / 120) * 4}] + } + bind Scrollbar <Shift-MouseWheel> { + tk::ScrollByUnits %W h [expr {- (%D / 120) * 4}] + } } - bind Scrollbar <Shift-Option-MouseWheel> { - tk::ScrollByUnits %W h [expr {-10 * (%D)}] + "x11" { + bind Scrollbar <4> {tk::ScrollByUnits %W v -5} + bind Scrollbar <5> {tk::ScrollByUnits %W v 5} + bind Scrollbar <Shift-4> {tk::ScrollByUnits %W h -5} + bind Scrollbar <Shift-5> {tk::ScrollByUnits %W h 5} } } else { bind Scrollbar <MouseWheel> { diff --git a/library/spinbox.tcl b/library/spinbox.tcl index cb501ee..6a5f829 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -52,7 +52,6 @@ bind Spinbox <<Copy>> { } } bind Spinbox <<Paste>> { - global tcl_platform catch { if {[tk windowingsystem] ne "x11"} { catch { @@ -74,8 +73,8 @@ bind Spinbox <<PasteSelection>> { } bind Spinbox <<TraverseIn>> { - %W selection range 0 end - %W icursor end + %W selection range 0 end + %W icursor end } # Standard Motif bindings: @@ -120,52 +119,52 @@ bind Spinbox <Control-1> { %W icursor @%x } -bind Spinbox <Up> { +bind Spinbox <<PrevLine>> { %W invoke buttonup } -bind Spinbox <Down> { +bind Spinbox <<NextLine>> { %W invoke buttondown } -bind Spinbox <Left> { +bind Spinbox <<PrevChar>> { ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } -bind Spinbox <Right> { +bind Spinbox <<NextChar>> { ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } -bind Spinbox <Shift-Left> { +bind Spinbox <<SelectPrevChar>> { ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] ::tk::EntrySeeInsert %W } -bind Spinbox <Shift-Right> { +bind Spinbox <<SelectNextChar>> { ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}] ::tk::EntrySeeInsert %W } -bind Spinbox <Control-Left> { +bind Spinbox <<PrevWord>> { ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] } -bind Spinbox <Control-Right> { +bind Spinbox <<NextWord>> { ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert] } -bind Spinbox <Shift-Control-Left> { +bind Spinbox <<SelectPrevWord>> { ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert] ::tk::EntrySeeInsert %W } -bind Spinbox <Shift-Control-Right> { +bind Spinbox <<SelectNextWord>> { ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert] ::tk::EntrySeeInsert %W } -bind Spinbox <Home> { +bind Spinbox <<LineStart>> { ::tk::EntrySetCursor %W 0 } -bind Spinbox <Shift-Home> { +bind Spinbox <<SelectLineStart>> { ::tk::EntryKeySelect %W 0 ::tk::EntrySeeInsert %W } -bind Spinbox <End> { +bind Spinbox <<LineEnd>> { ::tk::EntrySetCursor %W end } -bind Spinbox <Shift-End> { +bind Spinbox <<SelectLineEnd>> { ::tk::EntryKeySelect %W end ::tk::EntrySeeInsert %W } @@ -193,10 +192,10 @@ bind Spinbox <Control-Shift-space> { bind Spinbox <Shift-Select> { %W selection adjust insert } -bind Spinbox <Control-slash> { +bind Spinbox <<SelectAll>> { %W selection range 0 end } -bind Spinbox <Control-backslash> { +bind Spinbox <<SelectNone>> { %W selection clear } bind Spinbox <KeyPress> { @@ -215,6 +214,8 @@ bind Spinbox <Escape> {# nothing} bind Spinbox <Return> {# nothing} bind Spinbox <KP_Enter> {# nothing} bind Spinbox <Tab> {# nothing} +bind Spinbox <Prior> {# nothing} +bind Spinbox <Next> {# nothing} if {[tk windowingsystem] eq "aqua"} { bind Spinbox <Command-KeyPress> {# nothing} } @@ -229,31 +230,11 @@ if {[tk windowingsystem] ne "win32"} { # Additional emacs-like bindings: -bind Spinbox <Control-a> { - if {!$tk_strictMotif} { - ::tk::EntrySetCursor %W 0 - } -} -bind Spinbox <Control-b> { - if {!$tk_strictMotif} { - ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] - } -} bind Spinbox <Control-d> { if {!$tk_strictMotif} { %W delete insert } } -bind Spinbox <Control-e> { - if {!$tk_strictMotif} { - ::tk::EntrySetCursor %W end - } -} -bind Spinbox <Control-f> { - if {!$tk_strictMotif} { - ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] - } -} bind Spinbox <Control-h> { if {!$tk_strictMotif} { ::tk::EntryBackspace %W @@ -394,7 +375,8 @@ proc ::tk::spinbox::ButtonDown {w x y} { $w selection clear } default { - return -code error "unknown spinbox element \"$Priv(element)\"" + return -code error -errorcode {TK SPINBOX UNKNOWN_ELEMENT} \ + "unknown spinbox element \"$Priv(element)\"" } } } diff --git a/library/tclIndex b/library/tclIndex index e7f5b81..b3f37fa 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -79,6 +79,7 @@ set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]] set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]] set auto_index(::tk::FocusOK) [list source [file join $dir focus.tcl]] set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]] +set auto_index(::tk::IconList) [list source [file join $dir iconlist.tcl]] set auto_index(::tk::ListboxBeginSelect) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxMotion) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxBeginExtend) [list source [file join $dir listbox.tcl]] @@ -89,6 +90,7 @@ set auto_index(::tk::ListboxExtendUpDown) [list source [file join $dir listbox.t set auto_index(::tk::ListboxDataExtend) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxCancel) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxSelectAll) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::Megawidget) [list source [file join $dir megawidget.tcl]] set auto_index(::tk::MbEnter) [list source [file join $dir menu.tcl]] set auto_index(::tk::MbLeave) [list source [file join $dir menu.tcl]] set auto_index(::tk::MbPost) [list source [file join $dir menu.tcl]] @@ -198,34 +200,6 @@ set auto_index(::tk::ScreenChanged) [list source [file join $dir tk.tcl]] set auto_index(::tk::EventMotifBindings) [list source [file join $dir tk.tcl]] set auto_index(::tk::CancelRepeat) [list source [file join $dir tk.tcl]] set auto_index(::tk::TabToWindow) [list source [file join $dir tk.tcl]] -set auto_index(::tk::IconList) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Index) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Selection) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_CurSelection) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_DrawSelection) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Get) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Config) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Create) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_AutoScan) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_DeleteAll) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Add) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Arrange) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Invoke) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_See) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Btn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_CtrlBtn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_ShiftBtn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Motion1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Double1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_ReturnKey) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Leave1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_FocusIn) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_FocusOut) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_UpDown) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_LeftRight) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_KeyPress) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Goto) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Reset) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Create) [list source [file join $dir tkfbox.tcl]] @@ -276,3 +250,4 @@ set auto_index(::tk::ListBoxKeyAccel_Reset) [list source [file join $dir xmfbox. set auto_index(tk_getFileType) [list source [file join $dir xmfbox.tcl]] set auto_index(::tk::unsupported::ExposePrivateCommand) [list source [file join $dir unsupported.tcl]] set auto_index(::tk::unsupported::ExposePrivateVariable) [list source [file join $dir unsupported.tcl]] +set auto_index(::tk::fontchooser) [list source [file join $dir fontchooser.tcl]] diff --git a/library/tearoff.tcl b/library/tearoff.tcl index 6da2a0f..b500023 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -150,7 +150,7 @@ proc ::tk::MenuDup {src dst type} { set tags [bindtags $src] set srcLen [string length $src] - + # Copy tags to x, replacing each substring of src with dst. while {[set index [string first $src $tags]] != -1} { diff --git a/library/text.tcl b/library/text.tcl index 68ca0f5..2bf1b2b 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -95,52 +95,52 @@ bind Text <Control-1> { bind Text <Double-Control-1> { # nothing } # stop an accidental movement triggering <B1-Motion> bind Text <Control-B1-Motion> { # nothing } -bind Text <Left> { +bind Text <<PrevChar>> { tk::TextSetCursor %W insert-1displayindices } -bind Text <Right> { +bind Text <<NextChar>> { tk::TextSetCursor %W insert+1displayindices } -bind Text <Up> { +bind Text <<PrevLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] } -bind Text <Down> { +bind Text <<NextLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } -bind Text <Shift-Left> { +bind Text <<SelectPrevChar>> { tk::TextKeySelect %W [%W index {insert - 1displayindices}] } -bind Text <Shift-Right> { +bind Text <<SelectNextChar>> { tk::TextKeySelect %W [%W index {insert + 1displayindices}] } -bind Text <Shift-Up> { +bind Text <<SelectPrevLine>> { tk::TextKeySelect %W [tk::TextUpDownLine %W -1] } -bind Text <Shift-Down> { +bind Text <<SelectNextLine>> { tk::TextKeySelect %W [tk::TextUpDownLine %W 1] } -bind Text <Control-Left> { +bind Text <<PrevWord>> { tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } -bind Text <Control-Right> { +bind Text <<NextWord>> { tk::TextSetCursor %W [tk::TextNextWord %W insert] } -bind Text <Control-Up> { +bind Text <<PrevPara>> { tk::TextSetCursor %W [tk::TextPrevPara %W insert] } -bind Text <Control-Down> { +bind Text <<NextPara>> { tk::TextSetCursor %W [tk::TextNextPara %W insert] } -bind Text <Shift-Control-Left> { +bind Text <<SelectPrevWord>> { tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } -bind Text <Shift-Control-Right> { +bind Text <<SelectNextWord>> { tk::TextKeySelect %W [tk::TextNextWord %W insert] } -bind Text <Shift-Control-Up> { +bind Text <<SelectPrevPara>> { tk::TextKeySelect %W [tk::TextPrevPara %W insert] } -bind Text <Shift-Control-Down> { +bind Text <<SelectNextPara>> { tk::TextKeySelect %W [tk::TextNextPara %W insert] } bind Text <Prior> { @@ -162,16 +162,16 @@ bind Text <Control-Next> { %W xview scroll 1 page } -bind Text <Home> { +bind Text <<LineStart>> { tk::TextSetCursor %W {insert display linestart} } -bind Text <Shift-Home> { +bind Text <<SelectLineStart>> { tk::TextKeySelect %W {insert display linestart} } -bind Text <End> { +bind Text <<LineEnd>> { tk::TextSetCursor %W {insert display lineend} } -bind Text <Shift-End> { +bind Text <<SelectLineEnd>> { tk::TextKeySelect %W {insert display lineend} } bind Text <Control-Home> { @@ -217,18 +217,22 @@ bind Text <Return> { bind Text <Delete> { if {[tk::TextCursorInSelection %W]} { %W delete sel.first sel.last - } elseif {[%W compare end != insert+1c]} { - %W delete insert + } else { + if {[%W compare end != insert+1c]} { + %W delete insert + } + %W see insert } - %W see insert } bind Text <BackSpace> { if {[tk::TextCursorInSelection %W]} { %W delete sel.first sel.last - } elseif {[%W compare insert != 1.0]} { - %W delete insert-1c + } else { + if {[%W compare insert != 1.0]} { + %W delete insert-1c + } + %W see insert } - %W see insert } bind Text <Control-space> { @@ -245,10 +249,10 @@ bind Text <Shift-Select> { set tk::Priv(selectMode) char tk::TextKeyExtend %W insert } -bind Text <Control-slash> { +bind Text <<SelectAll>> { %W tag add sel 1.0 end } -bind Text <Control-backslash> { +bind Text <<SelectNone>> { %W tag remove sel 1.0 end # An operation that clears the selection must insert an autoseparator, # because the selection operation may have moved the insert mark @@ -305,31 +309,11 @@ if {[tk windowingsystem] eq "aqua"} { # Additional emacs-like bindings: -bind Text <Control-a> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W {insert display linestart} - } -} -bind Text <Control-b> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W insert-1displayindices - } -} bind Text <Control-d> { if {!$tk_strictMotif && [%W compare end != insert+1c]} { %W delete insert } } -bind Text <Control-e> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W {insert display lineend} - } -} -bind Text <Control-f> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W insert+1displayindices - } -} bind Text <Control-k> { if {!$tk_strictMotif && [%W compare end != insert+1c]} { if {[%W compare insert == {insert lineend}]} { @@ -339,22 +323,12 @@ bind Text <Control-k> { } } } -bind Text <Control-n> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W [tk::TextUpDownLine %W 1] - } -} bind Text <Control-o> { if {!$tk_strictMotif} { %W insert insert \n %W mark set insert insert-1c } } -bind Text <Control-p> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W [tk::TextUpDownLine %W -1] - } -} bind Text <Control-t> { if {!$tk_strictMotif} { tk::TextTranspose %W @@ -417,30 +391,6 @@ bind Text <Meta-Delete> { # Macintosh only bindings: if {[tk windowingsystem] eq "aqua"} { -bind Text <Option-Left> { - tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] -} -bind Text <Option-Right> { - tk::TextSetCursor %W [tk::TextNextWord %W insert] -} -bind Text <Option-Up> { - tk::TextSetCursor %W [tk::TextPrevPara %W insert] -} -bind Text <Option-Down> { - tk::TextSetCursor %W [tk::TextNextPara %W insert] -} -bind Text <Shift-Option-Left> { - tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] -} -bind Text <Shift-Option-Right> { - tk::TextKeySelect %W [tk::TextNextWord %W insert] -} -bind Text <Shift-Option-Up> { - tk::TextKeySelect %W [tk::TextPrevPara %W insert] -} -bind Text <Shift-Option-Down> { - tk::TextKeySelect %W [tk::TextNextPara %W insert] -} bind Text <Control-v> { tk::TextScrollPages %W 1 } @@ -500,6 +450,13 @@ if {[tk windowingsystem] eq "aqua"} { %W yview scroll [expr {(2-%D)/3}] pixels } } + bind Text <Shift-MouseWheel> { + if {%D >= 0} { + %W xview scroll [expr {-%D/3}] pixels + } else { + %W xview scroll [expr {(2-%D)/3}] pixels + } + } } if {"x11" eq [tk windowingsystem]} { @@ -517,6 +474,16 @@ if {"x11" eq [tk windowingsystem]} { %W yview scroll 50 pixels } } + bind Text <Shift-4> { + if {!$tk_strictMotif} { + %W xview scroll -50 pixels + } + } + bind Text <Shift-5> { + if {!$tk_strictMotif} { + %W xview scroll 50 pixels + } + } } # ::tk::TextClosestGap -- @@ -607,7 +574,6 @@ proc ::tk::TextAnchor {w} { } proc ::tk::TextSelectTo {w x y {extend 0}} { - global tcl_platform variable ::tk::Priv set anchorname [tk::TextAnchor $w] @@ -904,16 +870,17 @@ proc ::tk::TextInsert {w s} { } set compound 0 if {[TextCursorInSelection $w]} { - set compound [$w cget -autoseparators] - if {$compound} { + set oldSeparator [$w cget -autoseparators] + if {$oldSeparator} { $w configure -autoseparators 0 $w edit separator + set compound 1 } $w delete sel.first sel.last } $w insert insert $s $w see insert - if {$compound} { + if {$compound && $oldSeparator} { $w edit separator $w configure -autoseparators 1 } @@ -1108,7 +1075,6 @@ proc ::tk_textCut w { # w - Name of a text widget. proc ::tk_textPaste w { - global tcl_platform if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} { set oldSeparator [$w cget -autoseparators] if {$oldSeparator} { diff --git a/library/tk.tcl b/library/tk.tcl index d045222..946ab7e 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -10,21 +10,19 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.5 ;# Guard against [source] in an 8.4- interp before - ;# using 8.5 [package] features. # Insist on running with compatible version of Tcl -package require Tcl 8.5.0 +package require Tcl 8.6 # Verify that we have Tk binary and script components from the same release -package require -exact Tk 8.5.18 - +package require -exact Tk 8.6.4 + # Create a ::tk namespace namespace eval ::tk { # Set up the msgcat commands namespace eval msgcat { namespace export mc mcmax if {[interp issafe] || [catch {package require msgcat}]} { - # The msgcat package is not available. Supply our own minimal - # replacement. + # The msgcat package is not available. Supply our own + # minimal replacement. proc mc {src args} { return [format $src {*}$args] } @@ -59,7 +57,8 @@ namespace eval ::ttk { # isn't already on the path: if {[info exists ::auto_path] && ($::tk_library ne "") - && ($::tk_library ni $::auto_path)} { + && ($::tk_library ni $::auto_path) +} then { lappend ::auto_path $::tk_library $::ttk::library } @@ -67,13 +66,13 @@ if {[info exists ::auto_path] && ($::tk_library ne "") set ::tk_strictMotif 0 -# Turn on useinputmethods (X Input Methods) by default. We catch this because -# safe interpreters may not allow the call. +# Turn on useinputmethods (X Input Methods) by default. +# We catch this because safe interpreters may not allow the call. catch {tk useinputmethods 1} # ::tk::PlaceWindow -- -# Place a toplevel at a particular position +# place a toplevel at a particular position # Arguments: # toplevel name of toplevel window # ?placement? pointer ?center? ; places $w centered on the pointer @@ -125,7 +124,9 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { } if {[tk windowingsystem] eq "aqua"} { # Avoid the native menu bar which sits on top of everything. - if {$y < 22} { set y 22 } + if {$y < 22} { + set y 22 + } } } wm maxsize $w [winfo vrootwidth $w] [winfo vrootheight $w] @@ -134,7 +135,7 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { } # ::tk::SetFocusGrab -- -# Swap out current focus and grab temporarily (for dialogs) +# swap out current focus and grab temporarily (for dialogs) # Arguments: # grab new window to grab # focus window to give focus to @@ -151,8 +152,8 @@ proc ::tk::SetFocusGrab {grab {focus {}}} { if {[winfo exists $oldGrab]} { lappend data [grab status $oldGrab] } - # The "grab" command will fail if another application already holds the - # grab. So catch it. + # The "grab" command will fail if another application + # already holds the grab. So catch it. catch {grab $grab} if {[winfo exists $focus]} { focus $focus @@ -160,7 +161,7 @@ proc ::tk::SetFocusGrab {grab {focus {}}} { } # ::tk::RestoreFocusGrab -- -# Restore old focus and grab (for dialogs) +# restore old focus and grab (for dialogs) # Arguments: # grab window that had taken grab # focus window that had taken focus @@ -194,10 +195,10 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { } # ::tk::GetSelection -- -# This tries to obtain the default selection. On Unix, we first try and get -# a UTF8_STRING, a type supported by modern Unix apps for passing Unicode -# data safely. We fall back on the default STRING type otherwise. On -# Windows, only the STRING type is necessary. +# This tries to obtain the default selection. On Unix, we first try +# and get a UTF8_STRING, a type supported by modern Unix apps for +# passing Unicode data safely. We fall back on the default STRING +# type otherwise. On Windows, only the STRING type is necessary. # Arguments: # w The widget for which the selection will be retrieved. # Important for the -displayof property. @@ -207,18 +208,24 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { # if {[tk windowingsystem] ne "win32"} { proc ::tk::GetSelection {w {sel PRIMARY}} { - if {[catch {selection get -displayof $w -selection $sel \ - -type UTF8_STRING} txt] \ - && [catch {selection get -displayof $w -selection $sel} txt]} { - return -code error "could not find default selection" + if {[catch { + selection get -displayof $w -selection $sel -type UTF8_STRING + } txt] && [catch { + selection get -displayof $w -selection $sel + } txt]} then { + return -code error -errorcode {TK SELECTION NONE} \ + "could not find default selection" } else { return $txt } } } else { proc ::tk::GetSelection {w {sel PRIMARY}} { - if {[catch {selection get -displayof $w -selection $sel} txt]} { - return -code error "could not find default selection" + if {[catch { + selection get -displayof $w -selection $sel + } txt]} then { + return -code error -errorcode {TK SELECTION NONE} \ + "could not find default selection" } else { return $txt } @@ -226,22 +233,18 @@ if {[tk windowingsystem] ne "win32"} { } # ::tk::ScreenChanged -- -# This procedure is invoked by the binding mechanism whenever the "current" -# screen is changing. The procedure does two things. First, it uses "upvar" -# to make variable "::tk::Priv" point at an array variable that holds state -# for the current display. Second, it initializes the array if it didn't -# already exist. +# This procedure is invoked by the binding mechanism whenever the +# "current" screen is changing. The procedure does two things. +# First, it uses "upvar" to make variable "::tk::Priv" point at an +# array variable that holds state for the current display. Second, +# it initializes the array if it didn't already exist. # # Arguments: # screen - The name of the new screen. -proc ::tk::ScreenChanged {screen} { - set x [string last . $screen] - if {$x > 0} { - set disp [string range $screen 0 [expr {$x - 1}]] - } else { - set disp $screen - } +proc ::tk::ScreenChanged screen { + # Extract the display name. + set disp [string range $screen 0 [string last . $screen]-1] # Ensure that namespace separators never occur in the display name (as # they cause problems in variable names). Double-colons exist in some VNC @@ -250,7 +253,6 @@ proc ::tk::ScreenChanged {screen} { uplevel #0 [list upvar #0 ::tk::Priv.$disp ::tk::Priv] variable ::tk::Priv - global tcl_platform if {[info exists Priv]} { set Priv(screen) $screen @@ -290,40 +292,53 @@ proc ::tk::ScreenChanged {screen} { tk::ScreenChanged [winfo screen .] # ::tk::EventMotifBindings -- -# This procedure is invoked as a trace whenever ::tk_strictMotif is changed. -# It is used to turn on or turn off the motif virtual bindings. +# This procedure is invoked as a trace whenever ::tk_strictMotif is +# changed. It is used to turn on or turn off the motif virtual +# bindings. # # Arguments: # n1 - the name of the variable being changed ("::tk_strictMotif"). proc ::tk::EventMotifBindings {n1 dummy dummy} { upvar $n1 name - + if {$name} { set op delete } else { set op add } - event $op <<Cut>> <Control-Key-w> - event $op <<Copy>> <Meta-Key-w> - event $op <<Paste>> <Control-Key-y> + event $op <<Cut>> <Control-Key-w> <Control-Lock-Key-W> <Shift-Key-Delete> + event $op <<Copy>> <Meta-Key-w> <Meta-Lock-Key-W> <Control-Key-Insert> + event $op <<Paste>> <Control-Key-y> <Control-Lock-Key-Y> <Shift-Key-Insert> + event $op <<PrevChar>> <Control-Key-b> <Control-Lock-Key-B> + event $op <<NextChar>> <Control-Key-f> <Control-Lock-Key-F> + event $op <<PrevLine>> <Control-Key-p> <Control-Lock-Key-P> + event $op <<NextLine>> <Control-Key-n> <Control-Lock-Key-N> + event $op <<LineStart>> <Control-Key-a> <Control-Lock-Key-A> + event $op <<LineEnd>> <Control-Key-e> <Control-Lock-Key-E> + event $op <<SelectPrevChar>> <Control-Key-B> <Control-Lock-Key-b> + event $op <<SelectNextChar>> <Control-Key-F> <Control-Lock-Key-f> + event $op <<SelectPrevLine>> <Control-Key-P> <Control-Lock-Key-p> + event $op <<SelectNextLine>> <Control-Key-N> <Control-Lock-Key-n> + event $op <<SelectLineStart>> <Control-Key-A> <Control-Lock-Key-a> + event $op <<SelectLineEnd>> <Control-Key-E> <Control-Lock-Key-e> } #---------------------------------------------------------------------- -# Define common dialogs on platforms where they are not implemented using -# compiled code. +# Define common dialogs on platforms where they are not implemented +# using compiled code. #---------------------------------------------------------------------- if {![llength [info commands tk_chooseColor]]} { proc ::tk_chooseColor {args} { - return [tk::dialog::color:: {*}$args] + return [::tk::dialog::color:: {*}$args] } } if {![llength [info commands tk_getOpenFile]]} { proc ::tk_getOpenFile {args} { if {$::tk_strictMotif} { - return [tk::MotifFDialog open {*}$args] + return [::tk::MotifFDialog open {*}$args] } else { return [::tk::dialog::file:: open {*}$args] } @@ -332,7 +347,7 @@ if {![llength [info commands tk_getOpenFile]]} { if {![llength [info commands tk_getSaveFile]]} { proc ::tk_getSaveFile {args} { if {$::tk_strictMotif} { - return [tk::MotifFDialog save {*}$args] + return [::tk::MotifFDialog save {*}$args] } else { return [::tk::dialog::file:: save {*}$args] } @@ -340,7 +355,7 @@ if {![llength [info commands tk_getSaveFile]]} { } if {![llength [info commands tk_messageBox]]} { proc ::tk_messageBox {args} { - return [tk::MessageBox {*}$args] + return [::tk::MessageBox {*}$args] } } if {![llength [info command tk_chooseDirectory]]} { @@ -355,49 +370,129 @@ if {![llength [info command tk_chooseDirectory]]} { switch -exact -- [tk windowingsystem] { "x11" { - event add <<Cut>> <Control-Key-x> <Key-F20> <Control-Lock-Key-X> - event add <<Copy>> <Control-Key-c> <Key-F16> <Control-Lock-Key-C> - event add <<Paste>> <Control-Key-v> <Key-F18> <Control-Lock-Key-V> - event add <<PasteSelection>> <ButtonRelease-2> - event add <<Undo>> <Control-Key-z> <Control-Lock-Key-Z> - event add <<Redo>> <Control-Key-Z> <Control-Lock-Key-z> + event add <<Cut>> <Control-Key-x> <Key-F20> <Control-Lock-Key-X> + event add <<Copy>> <Control-Key-c> <Key-F16> <Control-Lock-Key-C> + event add <<Paste>> <Control-Key-v> <Key-F18> <Control-Lock-Key-V> + event add <<PasteSelection>> <ButtonRelease-2> + event add <<Undo>> <Control-Key-z> <Control-Lock-Key-Z> + event add <<Redo>> <Control-Key-Z> <Control-Lock-Key-z> + event add <<ContextMenu>> <Button-3> + # On Darwin/Aqua, buttons from left to right are 1,3,2. On Darwin/X11 with recent + # XQuartz as the X server, they are 1,2,3; other X servers may differ. + + event add <<SelectAll>> <Control-Key-slash> + event add <<SelectNone>> <Control-Key-backslash> + event add <<NextChar>> <Right> + event add <<SelectNextChar>> <Shift-Right> + event add <<PrevChar>> <Left> + event add <<SelectPrevChar>> <Shift-Left> + event add <<NextWord>> <Control-Right> + event add <<SelectNextWord>> <Control-Shift-Right> + event add <<PrevWord>> <Control-Left> + event add <<SelectPrevWord>> <Control-Shift-Left> + event add <<LineStart>> <Home> + event add <<SelectLineStart>> <Shift-Home> + event add <<LineEnd>> <End> + event add <<SelectLineEnd>> <Shift-End> + event add <<PrevLine>> <Up> + event add <<NextLine>> <Down> + event add <<SelectPrevLine>> <Shift-Up> + event add <<SelectNextLine>> <Shift-Down> + event add <<PrevPara>> <Control-Up> + event add <<NextPara>> <Control-Down> + event add <<SelectPrevPara>> <Control-Shift-Up> + event add <<SelectNextPara>> <Control-Shift-Down> + event add <<ToggleSelection>> <Control-ButtonPress-1> + # Some OS's define a goofy (as in, not <Shift-Tab>) keysym that is # returned when the user presses <Shift-Tab>. In order for tab # traversal to work, we have to add these keysyms to the PrevWindow - # event. We use catch just in case the keysym isn't recognized. This - # is needed for XFree86 systems + # event. We use catch just in case the keysym isn't recognized. + + # This is needed for XFree86 systems catch { event add <<PrevWindow>> <ISO_Left_Tab> } # This seems to be correct on *some* HP systems. catch { event add <<PrevWindow>> <hpBackTab> } trace add variable ::tk_strictMotif write ::tk::EventMotifBindings set ::tk_strictMotif $::tk_strictMotif - # On unix, we want to always display entry/text selection, regardless - # of which window has focus + # On unix, we want to always display entry/text selection, + # regardless of which window has focus set ::tk::AlwaysShowSelection 1 } "win32" { - event add <<Cut>> <Control-Key-x> <Shift-Key-Delete> \ - <Control-Lock-Key-X> - event add <<Copy>> <Control-Key-c> <Control-Key-Insert> \ - <Control-Lock-Key-C> - event add <<Paste>> <Control-Key-v> <Shift-Key-Insert> \ - <Control-Lock-Key-V> - event add <<PasteSelection>> <ButtonRelease-2> - event add <<Undo>> <Control-Key-z> <Control-Lock-Key-Z> - event add <<Redo>> <Control-Key-y> <Control-Lock-Key-Y> + event add <<Cut>> <Control-Key-x> <Shift-Key-Delete> <Control-Lock-Key-X> + event add <<Copy>> <Control-Key-c> <Control-Key-Insert> <Control-Lock-Key-C> + event add <<Paste>> <Control-Key-v> <Shift-Key-Insert> <Control-Lock-Key-V> + event add <<PasteSelection>> <ButtonRelease-2> + event add <<Undo>> <Control-Key-z> <Control-Lock-Key-Z> + event add <<Redo>> <Control-Key-y> <Control-Lock-Key-Y> + event add <<ContextMenu>> <Button-3> + + event add <<SelectAll>> <Control-Key-slash> <Control-Key-a> <Control-Lock-Key-A> + event add <<SelectNone>> <Control-Key-backslash> + event add <<NextChar>> <Right> + event add <<SelectNextChar>> <Shift-Right> + event add <<PrevChar>> <Left> + event add <<SelectPrevChar>> <Shift-Left> + event add <<NextWord>> <Control-Right> + event add <<SelectNextWord>> <Control-Shift-Right> + event add <<PrevWord>> <Control-Left> + event add <<SelectPrevWord>> <Control-Shift-Left> + event add <<LineStart>> <Home> + event add <<SelectLineStart>> <Shift-Home> + event add <<LineEnd>> <End> + event add <<SelectLineEnd>> <Shift-End> + event add <<PrevLine>> <Up> + event add <<NextLine>> <Down> + event add <<SelectPrevLine>> <Shift-Up> + event add <<SelectNextLine>> <Shift-Down> + event add <<PrevPara>> <Control-Up> + event add <<NextPara>> <Control-Down> + event add <<SelectPrevPara>> <Control-Shift-Up> + event add <<SelectNextPara>> <Control-Shift-Down> + event add <<ToggleSelection>> <Control-ButtonPress-1> } "aqua" { - event add <<Cut>> <Command-Key-x> <Key-F2> <Control-Lock-Key-X> - event add <<Copy>> <Command-Key-c> <Key-F3> <Control-Lock-Key-C> - event add <<Paste>> <Command-Key-v> <Key-F4> <Control-Lock-Key-V> - event add <<PasteSelection>> <ButtonRelease-2> - event add <<Clear>> <Clear> - event add <<Undo>> <Command-Key-z> <Control-Lock-Key-Z> - event add <<Redo>> <Command-Key-y> <Control-Lock-Key-Y> + event add <<Cut>> <Command-Key-x> <Key-F2> <Command-Lock-Key-X> + event add <<Copy>> <Command-Key-c> <Key-F3> <Command-Lock-Key-C> + event add <<Paste>> <Command-Key-v> <Key-F4> <Command-Lock-Key-V> + event add <<PasteSelection>> <ButtonRelease-3> + event add <<Clear>> <Clear> + event add <<ContextMenu>> <Button-2> + + # Official bindings + # See http://support.apple.com/kb/HT1343 + event add <<SelectAll>> <Command-Key-a> + event add <<SelectNone>> <Option-Command-Key-a> + event add <<Undo>> <Command-Key-z> <Command-Lock-Key-Z> + event add <<Redo>> <Shift-Command-Key-z> <Shift-Command-Lock-Key-z> + event add <<NextChar>> <Right> <Control-Key-f> <Control-Lock-Key-F> + event add <<SelectNextChar>> <Shift-Right> <Shift-Control-Key-F> <Shift-Control-Lock-Key-F> + event add <<PrevChar>> <Left> <Control-Key-b> <Control-Lock-Key-B> + event add <<SelectPrevChar>> <Shift-Left> <Shift-Control-Key-B> <Shift-Control-Lock-Key-B> + event add <<NextWord>> <Option-Right> + event add <<SelectNextWord>> <Shift-Option-Right> + event add <<PrevWord>> <Option-Left> + event add <<SelectPrevWord>> <Shift-Option-Left> + event add <<LineStart>> <Home> <Command-Left> <Control-Key-a> <Control-Lock-Key-A> + event add <<SelectLineStart>> <Shift-Home> <Shift-Command-Left> <Shift-Control-Key-A> <Shift-Control-Lock-Key-A> + event add <<LineEnd>> <End> <Command-Right> <Control-Key-e> <Control-Lock-Key-E> + event add <<SelectLineEnd>> <Shift-End> <Shift-Command-Right> <Shift-Control-Key-E> <Shift-Control-Lock-Key-E> + event add <<PrevLine>> <Up> <Control-Key-p> <Control-Lock-Key-P> + event add <<SelectPrevLine>> <Shift-Up> <Shift-Control-Key-P> <Shift-Control-Lock-Key-P> + event add <<NextLine>> <Down> <Control-Key-n> <Control-Lock-Key-N> + event add <<SelectNextLine>> <Shift-Down> <Shift-Control-Key-N> <Shift-Control-Lock-Key-N> + # Not official, but logical extensions of above. Also derived from + # bindings present in MS Word on OSX. + event add <<PrevPara>> <Option-Up> + event add <<NextPara>> <Option-Down> + event add <<SelectPrevPara>> <Shift-Option-Up> + event add <<SelectNextPara>> <Shift-Option-Down> + event add <<ToggleSelection>> <Command-ButtonPress-1> } } - + # ---------------------------------------------------------------------- # Read in files that define all of the class bindings. # ---------------------------------------------------------------------- @@ -407,6 +502,7 @@ if {$::tk_library ne ""} { namespace eval :: [list source [file join $::tk_library $file.tcl]] } namespace eval ::tk { + SourceLibFile icons SourceLibFile button SourceLibFile entry SourceLibFile listbox @@ -424,13 +520,15 @@ if {$::tk_library ne ""} { # ---------------------------------------------------------------------- event add <<PrevWindow>> <Shift-Tab> -bind all <Tab> {tk::TabToWindow [tk_focusNext %W]} +event add <<NextWindow>> <Tab> +bind all <<NextWindow>> {tk::TabToWindow [tk_focusNext %W]} bind all <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]} # ::tk::CancelRepeat -- -# This procedure is invoked to cancel an auto-repeat action described by -# ::tk::Priv(afterId). It's used by several widgets to auto-scroll the widget -# when the mouse is dragged out of the widget with a button pressed. +# This procedure is invoked to cancel an auto-repeat action described +# by ::tk::Priv(afterId). It's used by several widgets to auto-scroll +# the widget when the mouse is dragged out of the widget with a +# button pressed. # # Arguments: # None. @@ -443,9 +541,9 @@ proc ::tk::CancelRepeat {} { # ::tk::TabToWindow -- # This procedure moves the focus to the given widget. -# It sends a <<TraverseOut>> virtual event to the previous focus window, if -# any, before changing the focus, and a <<TraverseIn>> event to the new focus -# window afterwards. +# It sends a <<TraverseOut>> virtual event to the previous focus window, +# if any, before changing the focus, and a <<TraverseIn>> event +# to the new focus window afterwards. # # Arguments: # w - Window to which focus should be set. @@ -460,9 +558,10 @@ proc ::tk::TabToWindow {w} { } # ::tk::UnderlineAmpersand -- -# This procedure takes some text with ampersand and returns text w/o ampersand -# and position of the ampersand. Double ampersands are converted to single -# ones. Position returned is -1 when there is no ampersand. +# This procedure takes some text with ampersand and returns text w/o +# ampersand and position of the ampersand. Double ampersands are +# converted to single ones. Position returned is -1 when there is no +# ampersand. # proc ::tk::UnderlineAmpersand {text} { set s [string map {&& & & \ufeff} $text] @@ -470,9 +569,9 @@ proc ::tk::UnderlineAmpersand {text} { return [list [string map {\ufeff {}} $s] $idx] } -# ::tk::SetAmpText -- -# Given widget path and text with "magic ampersands", sets -text and -# -underline options for the widget +# ::tk::SetAmpText -- +# Given widget path and text with "magic ampersands", sets -text and +# -underline options for the widget # proc ::tk::SetAmpText {widget text} { lassign [UnderlineAmpersand $text] newtext under @@ -480,8 +579,8 @@ proc ::tk::SetAmpText {widget text} { } # ::tk::AmpWidget -- -# Creates new widget, turning -text option into -text and -underline options, -# returned by ::tk::UnderlineAmpersand. +# Creates new widget, turning -text option into -text and -underline +# options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpWidget {class path args} { set options {} @@ -501,8 +600,8 @@ proc ::tk::AmpWidget {class path args} { } # ::tk::AmpMenuArgs -- -# Processes arguments for a menu entry, turning -label option into -label and -# -underline options, returned by ::tk::UnderlineAmpersand. +# Processes arguments for a menu entry, turning -label option into +# -label and -underline options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpMenuArgs {widget add type args} { set options {} @@ -516,47 +615,53 @@ proc ::tk::AmpMenuArgs {widget add type args} { } $widget add $type {*}$options } - + # ::tk::FindAltKeyTarget -- -# Search recursively through the hierarchy of visible widgets to find button -# or label which has $char as underlined character +# Search recursively through the hierarchy of visible widgets to find +# button or label which has $char as underlined character. # proc ::tk::FindAltKeyTarget {path char} { - switch -- [winfo class $path] { - Button - Label - - TButton - TLabel - TCheckbutton { - if {[string equal -nocase $char \ - [string index [$path cget -text] [$path cget -underline]]]} { - return $path - } else { - return {} + set class [winfo class $path] + if {$class in { + Button Checkbutton Label Radiobutton + TButton TCheckbutton TLabel TRadiobutton + } && [string equal -nocase $char \ + [string index [$path cget -text] [$path cget -underline]]]} { + return $path + } + set subwins [concat [grid slaves $path] [pack slaves $path] \ + [place slaves $path]] + if {$class eq "Canvas"} { + foreach item [$path find all] { + if {[$path type $item] eq "window"} { + set w [$path itemcget $item -window] + if {$w ne ""} {lappend subwins $w} } } - default { - foreach child [concat [grid slaves $path] \ - [pack slaves $path] [place slaves $path]] { - set target [FindAltKeyTarget $child $char] - if {$target ne ""} { - return $target - } - } + } elseif {$class eq "Text"} { + lappend subwins {*}[$path window names] + } + foreach child $subwins { + set target [FindAltKeyTarget $child $char] + if {$target ne ""} { + return $target } } - return {} } # ::tk::AltKeyInDialog -- -# <Alt-Key> event handler for standard dialogs. Sends <<AltUnderlined>> to -# button or label which has appropriate underlined character +# <Alt-Key> event handler for standard dialogs. Sends <<AltUnderlined>> +# to button or label which has appropriate underlined character. # proc ::tk::AltKeyInDialog {path key} { set target [FindAltKeyTarget $path $key] - if { $target eq ""} return - event generate $target <<AltUnderlined>> + if {$target ne ""} { + event generate $target <<AltUnderlined>> + } } - + # ::tk::mcmaxamp -- -# Replacement for mcmax, used for texts with "magic ampersand" in it. +# Replacement for mcmax, used for texts with "magic ampersand" in it. # proc ::tk::mcmaxamp {args} { @@ -576,13 +681,13 @@ proc ::tk::mcmaxamp {args} { if {[tk windowingsystem] eq "aqua"} { namespace eval ::tk::mac { - variable useCustomMDEF 0 + set useCustomMDEF 0 } } # Run the Ttk themed widget set initialization if {$::ttk::library ne ""} { - uplevel \#0 [list source [file join $::ttk::library ttk.tcl]] + uplevel \#0 [list source $::ttk::library/ttk.tcl] } # Local Variables: diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index fd0f6d7..a52465a 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -1,15 +1,14 @@ # tkfbox.tcl -- # -# Implements the "TK" standard file selection dialog box. This -# dialog box is used on the Unix platforms whenever the tk_strictMotif -# flag is not set. +# Implements the "TK" standard file selection dialog box. This dialog +# box is used on the Unix platforms whenever the tk_strictMotif flag is +# not set. # -# The "TK" standard file selection dialog box is similar to the -# file selection dialog box on Win95(TM). The user can navigate -# the directories by clicking on the folder icons or by -# selecting the "Directory" option menu. The user can select -# files by clicking on the file icons or by entering a filename -# in the "Filename:" entry. +# The "TK" standard file selection dialog box is similar to the file +# selection dialog box on Win95(TM). The user can navigate the +# directories by clicking on the folder icons or by selecting the +# "Directory" option menu. The user can select files by clicking on the +# file icons or by entering a filename in the "Filename:" entry. # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -17,794 +16,78 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -package require Ttk - -#---------------------------------------------------------------------- -# -# I C O N L I S T -# -# This is a pseudo-widget that implements the icon list inside the -# ::tk::dialog::file:: dialog box. -# -#---------------------------------------------------------------------- - -# ::tk::IconList -- -# -# Creates an IconList widget. -# -proc ::tk::IconList {w args} { - IconList_Config $w $args - IconList_Create $w -} - -proc ::tk::IconList_Index {w i} { - upvar #0 ::tk::$w data ::tk::$w:itemList itemList - if {![info exists data(list)]} { - set data(list) {} - } - switch -regexp -- $i { - "^-?[0-9]+$" { - if {$i < 0} { - set i 0 - } - if {$i >= [llength $data(list)]} { - set i [expr {[llength $data(list)] - 1}] - } - return $i - } - "^active$" { - return $data(index,active) - } - "^anchor$" { - return $data(index,anchor) - } - "^end$" { - return [llength $data(list)] - } - "@-?[0-9]+,-?[0-9]+" { - foreach {x y} [scan $i "@%d,%d"] { - break - } - set item [$data(canvas) find closest \ - [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]] - return [lindex [$data(canvas) itemcget $item -tags] 1] - } - } -} - -proc ::tk::IconList_Selection {w op args} { - upvar ::tk::$w data - switch -exact -- $op { - "anchor" { - if {[llength $args] == 1} { - set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]] - } else { - return $data(index,anchor) - } - } - "clear" { - if {[llength $args] == 2} { - foreach {first last} $args { - break - } - } elseif {[llength $args] == 1} { - set first [set last [lindex $args 0]] - } else { - error "wrong # args: should be [lindex [info level 0] 0] path\ - clear first ?last?" - } - set first [IconList_Index $w $first] - set last [IconList_Index $w $last] - if {$first > $last} { - set tmp $first - set first $last - set last $tmp - } - set ind 0 - foreach item $data(selection) { - if { $item >= $first } { - set first $ind - break - } - incr ind - } - set ind [expr {[llength $data(selection)] - 1}] - for {} {$ind >= 0} {incr ind -1} { - set item [lindex $data(selection) $ind] - if { $item <= $last } { - set last $ind - break - } - } - - if { $first > $last } { - return - } - set data(selection) [lreplace $data(selection) $first $last] - event generate $w <<ListboxSelect>> - IconList_DrawSelection $w - } - "includes" { - set index [lsearch -exact $data(selection) [lindex $args 0]] - return [expr {$index != -1}] - } - "set" { - if { [llength $args] == 2 } { - foreach {first last} $args { - break - } - } elseif { [llength $args] == 1 } { - set last [set first [lindex $args 0]] - } else { - error "wrong # args: should be [lindex [info level 0] 0] path\ - set first ?last?" - } - - set first [IconList_Index $w $first] - set last [IconList_Index $w $last] - if { $first > $last } { - set tmp $first - set first $last - set last $tmp - } - for {set i $first} {$i <= $last} {incr i} { - lappend data(selection) $i - } - set data(selection) [lsort -integer -unique $data(selection)] - event generate $w <<ListboxSelect>> - IconList_DrawSelection $w - } - } -} - -proc ::tk::IconList_CurSelection {w} { - upvar ::tk::$w data - return $data(selection) -} - -proc ::tk::IconList_DrawSelection {w} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - - $data(canvas) delete selection - $data(canvas) itemconfigure selectionText -fill black - $data(canvas) dtag selectionText - set cbg [ttk::style lookup TEntry -selectbackground focus] - set cfg [ttk::style lookup TEntry -selectforeground focus] - foreach item $data(selection) { - set rTag [lindex [lindex $data(list) $item] 2] - foreach {iTag tTag text serial} $itemList($rTag) { - break - } - - set bbox [$data(canvas) bbox $tTag] - $data(canvas) create rect $bbox -fill $cbg -outline $cbg \ - -tags selection - $data(canvas) itemconfigure $tTag -fill $cfg -tags selectionText - } - $data(canvas) lower selection - return -} - -proc ::tk::IconList_Get {w item} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - set rTag [lindex [lindex $data(list) $item] 2] - foreach {iTag tTag text serial} $itemList($rTag) { - break - } - return $text -} - -# ::tk::IconList_Config -- -# -# Configure the widget variables of IconList, according to the command -# line arguments. -# -proc ::tk::IconList_Config {w argList} { - - # 1: the configuration specs - # - set specs { - {-command "" "" ""} - {-multiple "" "" "0"} - } - - # 2: parse the arguments - # - tclParseConfigSpec ::tk::$w $specs "" $argList -} - -# ::tk::IconList_Create -- -# -# Creates an IconList widget by assembling a canvas widget and a -# scrollbar widget. Sets all the bindings necessary for the IconList's -# operations. -# -proc ::tk::IconList_Create {w} { - upvar ::tk::$w data - - ttk::frame $w - ttk::entry $w.cHull -takefocus 0 -cursor {} - set data(sbar) [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0] - catch {$data(sbar) configure -highlightthickness 0} - set data(canvas) [canvas $w.cHull.canvas -highlightthick 0 \ - -width 400 -height 120 -takefocus 1 -background white] - pack $data(sbar) -side bottom -fill x -padx 2 -in $w.cHull -pady {0 2} - pack $data(canvas) -expand yes -fill both -padx 2 -pady {2 0} - pack $w.cHull -expand yes -fill both -ipadx 2 -ipady 2 - - $data(sbar) configure -command [list $data(canvas) xview] - $data(canvas) configure -xscrollcommand [list $data(sbar) set] - - # Initializes the max icon/text width and height and other variables - # - set data(maxIW) 1 - set data(maxIH) 1 - set data(maxTW) 1 - set data(maxTH) 1 - set data(numItems) 0 - set data(noScroll) 1 - set data(selection) {} - set data(index,anchor) "" - set fg [option get $data(canvas) foreground Foreground] - if {$fg eq ""} { - set data(fill) black - } else { - set data(fill) $fg - } - - # Creates the event bindings. - # - bind $data(canvas) <Configure> [list tk::IconList_Arrange $w] - - bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x %y] - bind $data(canvas) <B1-Motion> [list tk::IconList_Motion1 $w %x %y] - bind $data(canvas) <B1-Leave> [list tk::IconList_Leave1 $w %x %y] - bind $data(canvas) <Control-1> [list tk::IconList_CtrlBtn1 $w %x %y] - bind $data(canvas) <Shift-1> [list tk::IconList_ShiftBtn1 $w %x %y] - bind $data(canvas) <B1-Enter> [list tk::CancelRepeat] - bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat] - bind $data(canvas) <Double-ButtonRelease-1> \ - [list tk::IconList_Double1 $w %x %y] - - bind $data(canvas) <Control-B1-Motion> {;} - bind $data(canvas) <Shift-B1-Motion> \ - [list tk::IconList_ShiftMotion1 $w %x %y] - - bind $data(canvas) <Up> [list tk::IconList_UpDown $w -1] - bind $data(canvas) <Down> [list tk::IconList_UpDown $w 1] - bind $data(canvas) <Left> [list tk::IconList_LeftRight $w -1] - bind $data(canvas) <Right> [list tk::IconList_LeftRight $w 1] - bind $data(canvas) <Return> [list tk::IconList_ReturnKey $w] - bind $data(canvas) <KeyPress> [list tk::IconList_KeyPress $w %A] - bind $data(canvas) <Control-KeyPress> ";" - bind $data(canvas) <Alt-KeyPress> ";" - - bind $data(canvas) <FocusIn> [list tk::IconList_FocusIn $w] - bind $data(canvas) <FocusOut> [list tk::IconList_FocusOut $w] - - return $w -} - -# ::tk::IconList_AutoScan -- -# -# This procedure is invoked when the mouse leaves an entry window -# with button 1 down. It scrolls the window up, down, left, or -# right, depending on where the mouse left the window, and reschedules -# itself as an "after" command so that the window continues to scroll until -# the mouse moves back into the window or the mouse button is released. -# -# Arguments: -# w - The IconList window. -# -proc ::tk::IconList_AutoScan {w} { - upvar ::tk::$w data - variable ::tk::Priv - - if {![winfo exists $w]} return - set x $Priv(x) - set y $Priv(y) - - if {$data(noScroll)} { - return - } - if {$x >= [winfo width $data(canvas)]} { - $data(canvas) xview scroll 1 units - } elseif {$x < 0} { - $data(canvas) xview scroll -1 units - } elseif {$y >= [winfo height $data(canvas)]} { - # do nothing - } elseif {$y < 0} { - # do nothing - } else { - return - } - - IconList_Motion1 $w $x $y - set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]] -} - -# Deletes all the items inside the canvas subwidget and reset the IconList's -# state. -# -proc ::tk::IconList_DeleteAll {w} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - - $data(canvas) delete all - unset -nocomplain data(selected) data(rect) data(list) itemList - set data(maxIW) 1 - set data(maxIH) 1 - set data(maxTW) 1 - set data(maxTH) 1 - set data(numItems) 0 - set data(noScroll) 1 - set data(selection) {} - set data(index,anchor) "" - $data(sbar) set 0.0 1.0 - $data(canvas) xview moveto 0 -} - -# Adds an icon into the IconList with the designated image and text -# -proc ::tk::IconList_Add {w image items} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - upvar ::tk::$w:textList textList - - foreach text $items { - set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \ - -tags [list icon $data(numItems) item$data(numItems)]] - set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \ - -font $data(font) -fill $data(fill) \ - -tags [list text $data(numItems) item$data(numItems)]] - set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline "" \ - -tags [list rect $data(numItems) item$data(numItems)]] - - foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] { - break - } - set iW [expr {$x2 - $x1}] - set iH [expr {$y2 - $y1}] - if {$data(maxIW) < $iW} { - set data(maxIW) $iW - } - if {$data(maxIH) < $iH} { - set data(maxIH) $iH - } - - foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] { - break - } - set tW [expr {$x2 - $x1}] - set tH [expr {$y2 - $y1}] - if {$data(maxTW) < $tW} { - set data(maxTW) $tW - } - if {$data(maxTH) < $tH} { - set data(maxTH) $tH - } - - lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \ - $tH $data(numItems)] - set itemList($rTag) [list $iTag $tTag $text $data(numItems)] - set textList($data(numItems)) [string tolower $text] - incr data(numItems) - } -} - -# Places the icons in a column-major arrangement. -# -proc ::tk::IconList_Arrange {w} { - upvar ::tk::$w data - - if {![info exists data(list)]} { - if {[info exists data(canvas)] && [winfo exists $data(canvas)]} { - set data(noScroll) 1 - $data(sbar) configure -command "" - } - return - } - - set W [winfo width $data(canvas)] - set H [winfo height $data(canvas)] - set pad [expr {[$data(canvas) cget -highlightthickness] + \ - [$data(canvas) cget -bd]}] - if {$pad < 2} { - set pad 2 - } - - incr W -[expr {$pad*2}] - incr H -[expr {$pad*2}] - - set dx [expr {$data(maxIW) + $data(maxTW) + 8}] - if {$data(maxTH) > $data(maxIH)} { - set dy $data(maxTH) - } else { - set dy $data(maxIH) - } - incr dy 2 - set shift [expr {$data(maxIW) + 4}] - - set x [expr {$pad * 2}] - set y [expr {$pad * 1}] ; # Why * 1 ? - set usedColumn 0 - foreach sublist $data(list) { - set usedColumn 1 - foreach {iTag tTag rTag iW iH tW tH} $sublist { - break - } - - set i_dy [expr {($dy - $iH)/2}] - set t_dy [expr {($dy - $tH)/2}] - - $data(canvas) coords $iTag $x [expr {$y + $i_dy}] - $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}] - $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}] - - incr y $dy - if {($y + $dy) > $H} { - set y [expr {$pad * 1}] ; # *1 ? - incr x $dx - set usedColumn 0 - } - } - - if {$usedColumn} { - set sW [expr {$x + $dx}] - } else { - set sW $x - } - - if {$sW < $W} { - $data(canvas) configure -scrollregion [list $pad $pad $sW $H] - $data(sbar) configure -command "" - $data(canvas) xview moveto 0 - set data(noScroll) 1 - } else { - $data(canvas) configure -scrollregion [list $pad $pad $sW $H] - $data(sbar) configure -command [list $data(canvas) xview] - set data(noScroll) 0 - } - - set data(itemsPerColumn) [expr {($H-$pad)/$dy}] - if {$data(itemsPerColumn) < 1} { - set data(itemsPerColumn) 1 - } - - IconList_DrawSelection $w -} - -# Gets called when the user invokes the IconList (usually by double-clicking -# or pressing the Return key). -# -proc ::tk::IconList_Invoke {w} { - upvar ::tk::$w data - - if {$data(-command) ne "" && [llength $data(selection)]} { - uplevel #0 $data(-command) - } -} - -# ::tk::IconList_See -- -# -# If the item is not (completely) visible, scroll the canvas so that -# it becomes visible. -proc ::tk::IconList_See {w rTag} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - - if {$data(noScroll)} { - return - } - set sRegion [$data(canvas) cget -scrollregion] - if {$sRegion eq ""} { - return - } - - if { $rTag < 0 || $rTag >= [llength $data(list)] } { - return - } - - set bbox [$data(canvas) bbox item$rTag] - set pad [expr {[$data(canvas) cget -highlightthickness] + \ - [$data(canvas) cget -bd]}] - - set x1 [lindex $bbox 0] - set x2 [lindex $bbox 2] - incr x1 -[expr {$pad * 2}] - incr x2 -[expr {$pad * 1}] ; # *1 ? - - set cW [expr {[winfo width $data(canvas)] - $pad*2}] - - set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}] - set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}] - set oldDispX $dispX - - # check if out of the right edge - # - if {($x2 - $dispX) >= $cW} { - set dispX [expr {$x2 - $cW}] - } - # check if out of the left edge - # - if {($x1 - $dispX) < 0} { - set dispX $x1 - } - - if {$oldDispX ne $dispX} { - set fraction [expr {double($dispX)/double($scrollW)}] - $data(canvas) xview moveto $fraction - } -} - -proc ::tk::IconList_Btn1 {w x y} { - upvar ::tk::$w data - - focus $data(canvas) - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i - IconList_Selection $w anchor $i -} - -proc ::tk::IconList_CtrlBtn1 {w x y} { - upvar ::tk::$w data - - if { $data(-multiple) } { - focus $data(canvas) - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - if { [IconList_Selection $w includes $i] } { - IconList_Selection $w clear $i - } else { - IconList_Selection $w set $i - IconList_Selection $w anchor $i - } - } -} - -proc ::tk::IconList_ShiftBtn1 {w x y} { - upvar ::tk::$w data - - if { $data(-multiple) } { - focus $data(canvas) - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - if {[IconList_Index $w anchor] eq ""} { - IconList_Selection $w anchor $i - } - IconList_Selection $w clear 0 end - IconList_Selection $w set anchor $i - } -} - -# Gets called on button-1 motions -# -proc ::tk::IconList_Motion1 {w x y} { - variable ::tk::Priv - set Priv(x) $x - set Priv(y) $y - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i -} - -proc ::tk::IconList_ShiftMotion1 {w x y} { - upvar ::tk::$w data - variable ::tk::Priv - set Priv(x) $x - set Priv(y) $y - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - IconList_Selection $w clear 0 end - IconList_Selection $w set anchor $i -} - -proc ::tk::IconList_Double1 {w x y} { - upvar ::tk::$w data - - if {[llength $data(selection)]} { - IconList_Invoke $w - } -} - -proc ::tk::IconList_ReturnKey {w} { - IconList_Invoke $w -} - -proc ::tk::IconList_Leave1 {w x y} { - variable ::tk::Priv - - set Priv(x) $x - set Priv(y) $y - IconList_AutoScan $w -} - -proc ::tk::IconList_FocusIn {w} { - upvar ::tk::$w data - - $w.cHull state focus - if {![info exists data(list)]} { - return - } - - if {[llength $data(selection)]} { - IconList_DrawSelection $w - } -} - -proc ::tk::IconList_FocusOut {w} { - $w.cHull state !focus - IconList_Selection $w clear 0 end -} - -# ::tk::IconList_UpDown -- -# -# Moves the active element up or down by one element -# -# Arguments: -# w - The IconList widget. -# amount - +1 to move down one item, -1 to move back one item. -# -proc ::tk::IconList_UpDown {w amount} { - upvar ::tk::$w data - - if {![info exists data(list)]} { - return - } - - set curr [tk::IconList_CurSelection $w] - if { [llength $curr] == 0 } { - set i 0 - } else { - set i [tk::IconList_Index $w anchor] - if {$i eq ""} { - return - } - incr i $amount - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i - IconList_Selection $w anchor $i - IconList_See $w $i -} - -# ::tk::IconList_LeftRight -- -# -# Moves the active element left or right by one column -# -# Arguments: -# w - The IconList widget. -# amount - +1 to move right one column, -1 to move left one column. -# -proc ::tk::IconList_LeftRight {w amount} { - upvar ::tk::$w data - - if {![info exists data(list)]} { - return - } - - set curr [IconList_CurSelection $w] - if { [llength $curr] == 0 } { - set i 0 - } else { - set i [IconList_Index $w anchor] - if {$i eq ""} { - return - } - incr i [expr {$amount*$data(itemsPerColumn)}] - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i - IconList_Selection $w anchor $i - IconList_See $w $i -} - -#---------------------------------------------------------------------- -# Accelerator key bindings -#---------------------------------------------------------------------- - -# ::tk::IconList_KeyPress -- -# -# Gets called when user enters an arbitrary key in the listbox. -# -proc ::tk::IconList_KeyPress {w key} { - variable ::tk::Priv - - append Priv(ILAccel,$w) $key - IconList_Goto $w $Priv(ILAccel,$w) - catch { - after cancel $Priv(ILAccel,$w,afterId) - } - set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]] -} - -proc ::tk::IconList_Goto {w text} { - upvar ::tk::$w data - upvar ::tk::$w:textList textList - - if {![info exists data(list)]} { - return - } - - if {$text eq "" || $data(numItems) == 0} { - return - } - - if {[llength [IconList_CurSelection $w]]} { - set start [IconList_Index $w anchor] - } else { - set start 0 - } - - set theIndex -1 - set less 0 - set len [string length $text] - set len0 [expr {$len-1}] - set i $start - - # Search forward until we find a filename whose prefix is a - # case-insensitive match with $text - while {1} { - if {[string equal -nocase -length $len0 $textList($i) $text]} { - set theIndex $i - break - } - incr i - if {$i == $data(numItems)} { - set i 0 - } - if {$i == $start} { - break - } - } - - if {$theIndex > -1} { - IconList_Selection $w clear 0 end - IconList_Selection $w set $theIndex - IconList_Selection $w anchor $theIndex - IconList_See $w $theIndex - } -} - -proc ::tk::IconList_Reset {w} { - variable ::tk::Priv - - unset -nocomplain Priv(ILAccel,$w) -} - -#---------------------------------------------------------------------- -# -# F I L E D I A L O G -# -#---------------------------------------------------------------------- - namespace eval ::tk::dialog {} namespace eval ::tk::dialog::file { namespace import -force ::tk::msgcat::* - set ::tk::dialog::file::showHiddenBtn 0 - set ::tk::dialog::file::showHiddenVar 1 + variable showHiddenBtn 0 + variable showHiddenVar 1 + + # Create the images if they did not already exist. + if {![info exists ::tk::Priv(updirImage)]} { + set ::tk::Priv(updirImage) [image create photo -data { + iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/gD+AP7rGN + SCAAAACXBIWXMAAA3WAAAN1gGQb3mcAAAACXZwQWcAAAAWAAAAFgDcxelYAAAENUlE + QVQ4y7WUbWiVZRjHf/f9POcc9+Kc5bC2aIq5sGG0XnTzNU13zAIlFMNc9CEhTCKwCC + JIgt7AglaR0RcrolAKg14+GBbiGL6xZiYyy63cmzvu7MVznnOe537rw7bDyvlBoT/c + n+6L3/3nf13XLZLJJP+HfICysjKvqqpq+rWKysvLR1tbW+11g+fPn/+bEGIe4KYqCs + Owu66u7oG2trah6wJrrRc0NTVhjME5h7Vj5pxzCCE4duxYZUdHx/aGhoZmgJ+yb+wF + uCO19RmAffv25f8LFslkktraWtvU1CS6u7vRWmOtxVpbAPu+T0tLS04pFU/J34Wd3S + cdFtlfZWeZBU4IcaS5uXn1ZLAEMMY4ay1aa4wx/zpKKYIgoL6+vmjxqoXe5ZLTcsPq + bTyycjODpe1y3WMrvDAMV14jCuW0VhhjiJQpOJ5w7Zwjk8/y9R+vsHHNNq6oFMrkeX + BxI+8d2sktap3YvOPD0lRQrH+Z81fE7t3WB4gihVKazsuaA20aKSUgAG/seQdy2l6W + 37+EyopqTv39I6HJUT2zlnlza2jLdgiTaxwmDov6alLHcZUTzXPGGAauWJbfO4dHl9 + bgJs3HyfNf0N4ZsOa+jbT3/ownY/hO09p1kBULtjBw+Tvq7xzwauds4dWPDleAcP5E + xlprgtBRUZRgYCRPTzoHwEi2g6OnX+eFrW/RM9qBE4p43CeTz5ATaU6nDrFm2cPs/+ + E1SopqkZ7MFJqntXZaa7IKppckwIEvJbg8LWd28OT6nVihCPQQ8UScWCLGqO4hXuQx + qDtJ204eWrqWb1ufRspwtABWaqx5gRKUFSdwDnxPcuLcyyxbuIyaqntIBV34MY9YzC + Owg+S9YeJFkniRpGPkCLMrZzG3+jbktA/KClMxFoUhiKC0OAbAhd79CO8i6xe/STyW + 4O7KVRgUJ/sP0heeJV4kEVKw/vZd40sFKxat4mLvp6VLdvnb/XHHGGPIKwBBpC1/9n + 3DpfRZnn9/AwCxRII9O79kVPdjvByxuET6Ai8mePeTt4lyheXzhOSpCcdWa00uckTG + kckbGu76nEhbIm2xznH4VB3OWYaiXqQn8GKSWGIMHuXyPL76LBcupmhp69pz4uMnXi + w4VloTGcdQRtGdzmHs1f+RdYZslMZJhzUOHVnceN1ooEiP5JUzdqCQMWCD0JCIeQzn + NNpO+clhrCYf5rC+A2cxWmDUWG2oHEOZMEKIwclgMnnLrTeXUV7sUzpNXgU9DmijWV + v9LEKCkAIhKIBnlvpks6F21qUZ31u/sbExPa9h0/RzwzMov2nGlG5TmW1YOzzlnSfL + mVnyGf19Q7lwZHBp+1fPtflAIgiC7389n9qkihP+lWyeqfUO15ZwQTqlw9H+o2cOvN + QJCAHEgEqgYnI0NyALjAJdyWQy7wMa6AEujUdzo3LjcAXwD/XCTKIRjWytAAAAJXRF + WHRjcmVhdGUtZGF0ZQAyMDA5LTA0LTA2VDIxOjI1OjQxLTAzOjAw8s+uCAAAACV0RV + h0bW9kaWZ5LWRhdGUAMjAwOC0wMS0wM1QxNTowODoyMS0wMjowMJEc/44AAAAZdEVY + dFNvZnR3YXJlAHd3dy5pbmtzY2FwZS5vcmeb7jwaAAAAAElFTkSuQmCC + }] + } + if {![info exists ::tk::Priv(folderImage)]} { + set ::tk::Priv(folderImage) [image create photo -data { + iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiA + AAAAlwSFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBl + Lm9yZ5vuPBoAAAHCSURBVDiNpZAxa5NRFIafc+9XLCni4BC6FBycMnbrLpkcgtDVX6 + C70D/g4lZX/4coxLlgxFkpiiSSUGm/JiXfveee45AmNlhawXc53HvPee55X+l2u/yP + qt3d3Tfu/viatwt3fzIYDI5uBJhZr9fr3TMzzAx3B+D09PR+v98/7HQ6z5fNOWdCCG + U4HH6s67oAVDlnV1UmkwmllBUkhMD29nYHeLuEAkyn06qU8qqu64MrgIyqYmZrkHa7 + 3drc3KTVahFjJITAaDRiPB4/XFlQVVMtHH5IzJo/P4EA4MyB+erWPQB7++zs7ccYvl + U5Z08pMW2cl88eIXLZeDUpXzsBkNQ5eP1+p0opmaoCTgzw6fjs6gLLsp58FB60t0Dc + K1Ul54yIEIMQ43Uj68pquDmCeJVztpwzuBNE2LgBoMVpslHMCUEAFgDVxQbzVAiA+a + K5uGPmmDtZF3VpoUm2ArhqQaRiUjcMf81p1G60UEVhcjZfAFTVUkrgkS+jc06mDX9n + vq4YhJ9nlxZExMwMEaHJRutOdWuIIsJFUoBSuTvHJ4YIfP46unV4qdlsjsBRZRtb/X + fHd5+C8+P7+J8BIoxFwovfRxYhnhxjpzEAAAAASUVORK5CYII= + }] + } + if {![info exists ::tk::Priv(fileImage)]} { + set ::tk::Priv(fileImage) [image create photo -data { + iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gva + eTAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QQWFA84umAmQgAAANpJREFU + OMutkj1uhDAQhb8HSLtbISGfgZ+zbJkix0HmFhwhUdocBnMBGvqtTIqIFSReWKK8ai + x73nwzHrVt+zEMwwvH9FrX9TsA1trpqKy10+yUzME4jnjvAZB0LzXHkojjmDRNVyh3 + A+89zrlVwlKSqKrqVy/J8lAUxSZBSMny4ZLgp54iyPM8UPHGNJ2IomibAKDv+9VlWZ + bABbgB5/0WQgSSkC4PF2JF4JzbHN430c4vhAm0TyCJruuClefph4yCBCGT3T3Isoy/ + KDHGfDZNcz2SZIx547/0BVRRX7n8uT/sAAAAAElFTkSuQmCC + }] + } } # ::tk::dialog::file:: -- # -# Implements the TK file selection dialog. This dialog is used when -# the tk_strictMotif flag is set to false. This procedure shouldn't -# be called directly. Call tk_getOpenFile or tk_getSaveFile instead. +# Implements the TK file selection dialog. This dialog is used when the +# tk_strictMotif flag is set to false. This procedure shouldn't be +# called directly. Call tk_getOpenFile or tk_getSaveFile instead. # # Arguments: # type "open" or "save" @@ -813,6 +96,7 @@ namespace eval ::tk::dialog::file { proc ::tk::dialog::file:: {type args} { variable ::tk::Priv + variable showHiddenBtn set dataName __tk_filedialog upvar ::tk::dialog::file::$dataName data @@ -845,7 +129,7 @@ proc ::tk::dialog::file:: {type args} { set data(hiddenBtn) $w.contents.f2.hidden SetSelectMode $w $data(-multiple) } - if {$::tk::dialog::file::showHiddenBtn} { + if {$showHiddenBtn} { $data(hiddenBtn) configure -state normal grid $data(hiddenBtn) } else { @@ -856,12 +140,12 @@ proc ::tk::dialog::file:: {type args} { # Make sure subseqent uses of this dialog are independent [Bug 845189] unset -nocomplain data(extUsed) - # Dialog boxes should be transient with respect to their parent, - # so that they will always stay on top of their parent window. However, - # some window managers will create the window as withdrawn if the parent - # window is withdrawn or iconified. Combined with the grab we put on the - # window, this can hang the entire application. Therefore we only make - # the dialog transient if the parent is viewable. + # Dialog boxes should be transient with respect to their parent, so that + # they will always stay on top of their parent window. However, some + # window managers will create the window as withdrawn if the parent window + # is withdrawn or iconified. Combined with the grab we put on the window, + # this can hang the entire application. Therefore we only make the dialog + # transient if the parent is viewable. if {[winfo viewable [winfo toplevel $data(-parent)]]} { wm transient $w $data(-parent) @@ -897,7 +181,7 @@ proc ::tk::dialog::file:: {type args} { set filter [lindex $type 1] $data(typeMenu) add command -label $title \ -command [list ::tk::dialog::file::SetFilter $w $type] - # string first avoids glob-pattern char issues + # [string first] avoids glob-pattern char issues if {[string first ${initialTypeName} $title] == 0} { set initialtype $type } @@ -927,11 +211,10 @@ proc ::tk::dialog::file:: {type args} { $data(ent) selection range 0 end $data(ent) icursor end - # Wait for the user to respond, then restore the focus and - # return the index of the selected button. Restore the focus - # before deleting the window, since otherwise the window manager - # may take the focus away so we can't redirect it. Finally, - # restore any grab that was in effect. + # Wait for the user to respond, then restore the focus and return the + # index of the selected button. Restore the focus before deleting the + # window, since otherwise the window manager may take the focus away so we + # can't redirect it. Finally, restore any grab that was in effect. vwait ::tk::Priv(selectFilePath) @@ -941,7 +224,7 @@ proc ::tk::dialog::file:: {type args} { # foreach trace [trace info variable data(selectPath)] { - trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] + trace remove variable data(selectPath) {*}$trace } $data(dirMenuBtn) configure -textvariable {} @@ -962,7 +245,7 @@ proc ::tk::dialog::file::Config {dataName type argList} { # if the dialog is now used with a different -parent option. foreach trace [trace info variable data(selectPath)] { - trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] + trace remove variable data(selectPath) {*}$trace } # 1: the configuration specs @@ -1030,11 +313,12 @@ proc ::tk::dialog::file::Config {dataName type argList} { set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)] if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } - # Set -multiple to a one or zero value (not other boolean types - # like "yes") so we can use it in tests more easily. + # Set -multiple to a one or zero value (not other boolean types like + # "yes") so we can use it in tests more easily. if {$type eq "save"} { set data(-multiple) 0 } elseif {$data(-multiple)} { @@ -1068,21 +352,10 @@ proc ::tk::dialog::file::Create {w class} { set data(dirMenu) $f1.menu.menu ttk::menubutton $f1.menu -menu $data(dirMenu) -direction flush \ -textvariable [format %s(selectPath) ::tk::dialog::file::$dataName] - [menu $data(dirMenu) -tearoff 0] add radiobutton -label "" -variable \ + menu $data(dirMenu) -tearoff 0 + $data(dirMenu) add radiobutton -label "" -variable \ [format %s(selectPath) ::tk::dialog::file::$dataName] set data(upBtn) [ttk::button $f1.up] - if {![info exists Priv(updirImage)]} { - set Priv(updirImage) [image create bitmap -data { -#define updir_width 28 -#define updir_height 16 -static char updir_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00, - 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01, - 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01, - 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, - 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01, - 0xf0, 0xff, 0xff, 0x01};}] - } $data(upBtn) configure -image $Priv(updirImage) $f1.menu configure -takefocus 1;# -highlightthickness 2 @@ -1119,8 +392,8 @@ static char updir_bits[] = { # -pady 0 set data(ent) [ttk::entry $f2.ent] - # The font to use for the icons. The default Canvas font on Unix - # is just deviant. + # The font to use for the icons. The default Canvas font on Unix is just + # deviant. set ::tk::$w.contents.icons(font) [$data(ent) cget -font] # Make the file types bits only if this is a File Dialog @@ -1137,9 +410,9 @@ static char updir_bits[] = { focus $data(typeMenuBtn)] } - # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn - # is true. Create it disabled so the binding doesn't trigger if it - # isn't shown. + # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn is + # true. Create it disabled so the binding doesn't trigger if it isn't + # shown. if {$class eq "TkFDialog"} { set text [mc "Show &Hidden Files and Directories"] } else { @@ -1242,36 +515,32 @@ proc ::tk::dialog::file::SetSelectMode {w multi} { } set iconListCommand [list ::tk::dialog::file::OkCmd $w] ::tk::SetAmpText $w.contents.f2.lab $fNameCaption - ::tk::IconList_Config $data(icons) \ - [list -multiple $multi -command $iconListCommand] + $data(icons) configure -multiple $multi -command $iconListCommand return } # ::tk::dialog::file::UpdateWhenIdle -- # -# Creates an idle event handler which updates the dialog in idle -# time. This is important because loading the directory may take a long -# time and we don't want to load the same directory for multiple times -# due to multiple concurrent events. +# Creates an idle event handler which updates the dialog in idle time. +# This is important because loading the directory may take a long time +# and we don't want to load the same directory for multiple times due to +# multiple concurrent events. # proc ::tk::dialog::file::UpdateWhenIdle {w} { upvar ::tk::dialog::file::[winfo name $w] data if {[info exists data(updateId)]} { return - } else { - set data(updateId) [after idle [list ::tk::dialog::file::Update $w]] } + set data(updateId) [after idle [list ::tk::dialog::file::Update $w]] } # ::tk::dialog::file::Update -- # -# Loads the files and directories into the IconList widget. Also -# sets up the directory option menu for quick access to parent -# directories. +# Loads the files and directories into the IconList widget. Also sets up +# the directory option menu for quick access to parent directories. # proc ::tk::dialog::file::Update {w} { - # This proc may be called within an idle handler. Make sure that the # window has not been destroyed before this proc is called if {![winfo exists $w]} { @@ -1285,30 +554,24 @@ proc ::tk::dialog::file::Update {w} { set dataName [winfo name $w] upvar ::tk::dialog::file::$dataName data variable ::tk::Priv + variable showHiddenVar global tk_library unset -nocomplain data(updateId) - if {![info exists Priv(folderImage)]} { - set Priv(folderImage) [image create photo -data { -R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB -QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}] - set Priv(fileImage) [image create photo -data { -R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO -rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] - } set folder $Priv(folderImage) set file $Priv(fileImage) set appPWD [pwd] if {[catch { cd $data(selectPath) - }]} { + }]} then { # We cannot change directory to $data(selectPath). $data(selectPath) - # should have been checked before ::tk::dialog::file::Update is called, so - # we normally won't come to here. Anyways, give an error and abort - # action. - tk_messageBox -type ok -parent $w -icon warning -message \ - [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)] + # should have been checked before ::tk::dialog::file::Update is + # called, so we normally won't come to here. Anyways, give an error + # and abort action. + tk_messageBox -type ok -parent $w -icon warning -message [mc \ + "Cannot change to the directory \"%1\$s\".\nPermission denied."\ + $data(selectPath)] cd $appPWD return } @@ -1322,24 +585,21 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] $w configure -cursor watch update idletasks - ::tk::IconList_DeleteAll $data(icons) + $data(icons) deleteall - set showHidden $::tk::dialog::file::showHiddenVar + set showHidden $showHiddenVar # Make the dir list. Note that using an explicit [pwd] (instead of '.') is # better in some VFS cases. - ::tk::IconList_Add $data(icons) $folder [GlobFiltered [pwd] d 1] + $data(icons) add $folder [GlobFiltered [pwd] d 1] if {$class eq "TkFDialog"} { # Make the file list if this is a File Dialog, selecting all but # 'd'irectory type files. # - ::tk::IconList_Add $data(icons) $file \ - [GlobFiltered [pwd] {f b c l p s}] + $data(icons) add $file [GlobFiltered [pwd] {f b c l p s}] } - ::tk::IconList_Arrange $data(icons) - # Update the Directory: option menu # set list "" @@ -1382,9 +642,10 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] proc ::tk::dialog::file::SetPathSilently {w path} { upvar ::tk::dialog::file::[winfo name $w] data - trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w] + set cb [list ::tk::dialog::file::SetPath $w] + trace remove variable data(selectPath) write $cb set data(selectPath) $path - trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w] + trace add variable data(selectPath) write $cb } @@ -1406,14 +667,13 @@ proc ::tk::dialog::file::SetPath {w name1 name2 op} { # proc ::tk::dialog::file::SetFilter {w type} { upvar ::tk::dialog::file::[winfo name $w] data - upvar ::tk::$data(icons) icons set data(filterType) $type set data(filter) [lindex $type 1] $data(typeMenuBtn) configure -text [lindex $type 0] ;#-indicatoron 1 - # If we aren't using a default extension, use the one suppled - # by the filter. + # If we aren't using a default extension, use the one suppled by the + # filter. if {![info exists data(extUsed)]} { if {[string length $data(-defaultextension)]} { set data(extUsed) 1 @@ -1423,8 +683,8 @@ proc ::tk::dialog::file::SetFilter {w type} { } if {!$data(extUsed)} { - # Get the first extension in the list that matches {^\*\.\w+$} - # and remove all * from the filter. + # Get the first extension in the list that matches {^\*\.\w+$} and + # remove all * from the filter. set index [lsearch -regexp $data(filter) {^\*\.\w+$}] if {$index >= 0} { set data(-defaultextension) \ @@ -1435,15 +695,14 @@ proc ::tk::dialog::file::SetFilter {w type} { } } - $icons(sbar) set 0.0 0.0 + $data(icons) see 0 UpdateWhenIdle $w } # tk::dialog::file::ResolveFile -- # -# Interpret the user's text input in a file selection dialog. -# Performs: +# Interpret the user's text input in a file selection dialog. Performs: # # (1) ~ substitution # (2) resolve all instances of . and .. @@ -1464,25 +723,24 @@ proc ::tk::dialog::file::SetFilter {w type} { # flag = OK : valid input # = PATTERN : valid directory/pattern # = PATH : the directory does not exist -# = FILE : the directory exists by the file doesn't -# exist +# = FILE : the directory exists by the file doesn't exist # = CHDIR : Cannot change to the directory # = ERROR : Invalid entry # # directory : valid only if flag = OK or PATTERN or FILE # file : valid only if flag = OK or PATTERN # -# directory may not be the same as context, because text may contain -# a subdirectory name +# directory may not be the same as context, because text may contain a +# subdirectory name # proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { set appPWD [pwd] set path [JoinFile $context $text] - # If the file has no extension, append the default. Be careful not - # to do this for directories, otherwise typing a dirname in the box - # will give back "dirname.extension" instead of trying to change dir. + # If the file has no extension, append the default. Be careful not to do + # this for directories, otherwise typing a dirname in the box will give + # back "dirname.extension" instead of trying to change dir. if { ![file isdirectory $path] && ([file ext $path] eq "") && ![string match {$*} [file tail $path]] @@ -1491,8 +749,8 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { } if {[catch {file exists $path}]} { - # This "if" block can be safely removed if the following code - # stop generating errors. + # This "if" block can be safely removed if the following code stop + # generating errors. # # file exists ~nonsuchuser # @@ -1691,8 +949,8 @@ proc ::tk::dialog::file::UpDirCmd {w} { } } -# Join a file name to a path name. The "file join" command will break -# if the filename begins with ~ +# Join a file name to a path name. The "file join" command will break if the +# filename begins with ~ # proc ::tk::dialog::file::JoinFile {path file} { if {[string match {~*} $file] && [file exists $path/$file]} { @@ -1708,12 +966,14 @@ proc ::tk::dialog::file::OkCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data set filenames {} - foreach item [::tk::IconList_CurSelection $data(icons)] { - lappend filenames [::tk::IconList_Get $data(icons) $item] + foreach item [$data(icons) selection get] { + lappend filenames [$data(icons) get $item] } - if {([llength $filenames] && !$data(-multiple)) || \ - ($data(-multiple) && ([llength $filenames] == 1))} { + if { + ([llength $filenames] && !$data(-multiple)) || + ($data(-multiple) && ([llength $filenames] == 1)) + } then { set filename [lindex $filenames 0] set file [JoinFile $data(selectPath) $filename] if {[file isdirectory $file]} { @@ -1751,8 +1011,8 @@ proc ::tk::dialog::file::ListBrowse {w} { upvar ::tk::dialog::file::[winfo name $w] data set text {} - foreach item [::tk::IconList_CurSelection $data(icons)] { - lappend text [::tk::IconList_Get $data(icons) $item] + foreach item [$data(icons) selection get] { + lappend text [$data(icons) get $item] } if {[llength $text] == 0} { return @@ -1788,8 +1048,8 @@ proc ::tk::dialog::file::ListBrowse {w} { } } -# Gets called when user invokes the IconList widget (double-click, -# Return key, etc) +# Gets called when user invokes the IconList widget (double-click, Return key, +# etc) # proc ::tk::dialog::file::ListInvoke {w filenames} { upvar ::tk::dialog::file::[winfo name $w] data @@ -1822,11 +1082,11 @@ proc ::tk::dialog::file::ListInvoke {w filenames} { # ::tk::dialog::file::Done -- # -# Gets called when user has input a valid filename. Pops up a -# dialog box to confirm selection when necessary. Sets the -# tk::Priv(selectFilePath) variable, which will break the "vwait" -# loop in ::tk::dialog::file:: and return the selected filename to the -# script that calls tk_getOpenFile or tk_getSaveFile +# Gets called when user has input a valid filename. Pops up a dialog +# box to confirm selection when necessary. Sets the +# tk::Priv(selectFilePath) variable, which will break the "vwait" loop +# in ::tk::dialog::file:: and return the selected filename to the script +# that calls tk_getOpenFile or tk_getSaveFile # proc ::tk::dialog::file::Done {w {selectFilePath ""}} { upvar ::tk::dialog::file::[winfo name $w] data @@ -1853,9 +1113,11 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { return } } - if {[info exists data(-typevariable)] && $data(-typevariable) ne "" - && [info exists data(-filetypes)] && [llength $data(-filetypes)] - && [info exists data(filterType)] && $data(filterType) ne ""} { + if { + [info exists data(-typevariable)] && $data(-typevariable) ne "" + && [info exists data(-filetypes)] && [llength $data(-filetypes)] + && [info exists data(filterType)] && $data(filterType) ne "" + } then { upvar #0 $data(-typevariable) typeVariable set typeVariable [lindex $data(filterType) 0] } @@ -1864,11 +1126,22 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { set Priv(selectFilePath) $selectFilePath } +# ::tk::dialog::file::GlobFiltered -- +# +# Gets called to do globbing, returning the results and filtering them +# according to the current filter (and removing the entries for '.' and +# '..' which are never shown). Deals with evil cases such as where the +# user is supplying a filter which is an invalid list or where it has an +# unbalanced brace. The resulting list will be dictionary sorted. +# +# Arguments: +# dir Which directory to search +# type List of filetypes to look for ('d' or 'f b c l p s') +# overrideFilter Whether to ignore the filter for this search. +# +# NB: Assumes that the caller has mapped the state variable to 'data'. +# proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} { - # $dir == where to search - # $type == what to look for ('d' or 'f b c l p s') - # $overrideFilter == whether to ignore the filter - variable showHiddenVar upvar 1 data(filter) filter diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index f16cf8b..b3ebcbd 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -42,7 +42,7 @@ option add *TEntry.cursor [ttk::cursor text] # # <Control-Key-space>, <Control-Shift-Key-space>, # <Key-Select>, <Shift-Key-Select>: -# ttk::entry widget doesn't use selection anchor. +# Ttk entry widget doesn't use selection anchor. # <Key-Insert>: # Inserts PRIMARY selection (on non-Windows platforms). # This is inconsistent with typical platform bindings. @@ -78,7 +78,7 @@ bind TEntry <B1-Leave> { ttk::entry::DragOut %W %m } bind TEntry <B1-Enter> { ttk::entry::DragIn %W } bind TEntry <ButtonRelease-1> { ttk::entry::Release %W } -bind TEntry <Control-ButtonPress-1> { +bind TEntry <<ToggleSelection>> { %W instate {!readonly !disabled} { %W icursor @%x ; focus %W } } @@ -93,22 +93,22 @@ bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x } ## Keyboard navigation bindings: # -bind TEntry <Key-Left> { ttk::entry::Move %W prevchar } -bind TEntry <Key-Right> { ttk::entry::Move %W nextchar } -bind TEntry <Control-Key-Left> { ttk::entry::Move %W prevword } -bind TEntry <Control-Key-Right> { ttk::entry::Move %W nextword } -bind TEntry <Key-Home> { ttk::entry::Move %W home } -bind TEntry <Key-End> { ttk::entry::Move %W end } +bind TEntry <<PrevChar>> { ttk::entry::Move %W prevchar } +bind TEntry <<NextChar>> { ttk::entry::Move %W nextchar } +bind TEntry <<PrevWord>> { ttk::entry::Move %W prevword } +bind TEntry <<NextWord>> { ttk::entry::Move %W nextword } +bind TEntry <<LineStart>> { ttk::entry::Move %W home } +bind TEntry <<LineEnd>> { ttk::entry::Move %W end } -bind TEntry <Shift-Key-Left> { ttk::entry::Extend %W prevchar } -bind TEntry <Shift-Key-Right> { ttk::entry::Extend %W nextchar } -bind TEntry <Shift-Control-Key-Left> { ttk::entry::Extend %W prevword } -bind TEntry <Shift-Control-Key-Right> { ttk::entry::Extend %W nextword } -bind TEntry <Shift-Key-Home> { ttk::entry::Extend %W home } -bind TEntry <Shift-Key-End> { ttk::entry::Extend %W end } +bind TEntry <<SelectPrevChar>> { ttk::entry::Extend %W prevchar } +bind TEntry <<SelectNextChar>> { ttk::entry::Extend %W nextchar } +bind TEntry <<SelectPrevWord>> { ttk::entry::Extend %W prevword } +bind TEntry <<SelectNextWord>> { ttk::entry::Extend %W nextword } +bind TEntry <<SelectLineStart>> { ttk::entry::Extend %W home } +bind TEntry <<SelectLineEnd>> { ttk::entry::Extend %W end } -bind TEntry <Control-Key-slash> { %W selection range 0 end } -bind TEntry <Control-Key-backslash> { %W selection clear } +bind TEntry <<SelectAll>> { %W selection range 0 end } +bind TEntry <<SelectNone>> { %W selection clear } bind TEntry <<TraverseIn>> { %W selection range 0 end; %W icursor end } @@ -136,16 +136,12 @@ if {[tk windowingsystem] eq "aqua"} { bind TEntry <Command-KeyPress> {# nothing} } # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] -bind TEntry <Down> {# nothing} -bind TEntry <Up> {# nothing} +bind TEntry <<PrevLine>> {# nothing} +bind TEntry <<NextLine>> {# nothing} ## Additional emacs-like bindings: # -bind TEntry <Control-Key-a> { ttk::entry::Move %W home } -bind TEntry <Control-Key-b> { ttk::entry::Move %W prevchar } -bind TEntry <Control-Key-d> { ttk::entry::Delete %W } -bind TEntry <Control-Key-e> { ttk::entry::Move %W end } -bind TEntry <Control-Key-f> { ttk::entry::Move %W nextchar } +bind TEntry <Control-Key-d> { ttk::entry::Delete %W } bind TEntry <Control-Key-h> { ttk::entry::Backspace %W } bind TEntry <Control-Key-k> { %W delete insert end } diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index d424b6c..72b85e6 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -108,7 +108,7 @@ proc ttk::notebook::enableTraversal {nb} { bind $top <Control-Key-Next> {+ttk::notebook::TLCycleTab %W 1} bind $top <Control-Key-Prior> {+ttk::notebook::TLCycleTab %W -1} bind $top <Control-Key-Tab> {+ttk::notebook::TLCycleTab %W 1} - bind $top <Shift-Control-Key-Tab> {+ttk::notebook::TLCycleTab %W -1} + bind $top <Control-Shift-Key-Tab> {+ttk::notebook::TLCycleTab %W -1} catch { bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1} } @@ -170,7 +170,7 @@ proc ttk::notebook::EnclosingNotebook {w} { } # TLCycleTab -- -# toplevel binding procedure for Control-Tab / Shift-Control-Tab +# toplevel binding procedure for Control-Tab / Control-Shift-Tab # Select the next/previous tab in the nearest ancestor notebook. # proc ttk::notebook::TLCycleTab {w dir} { diff --git a/library/ttk/scale.tcl b/library/ttk/scale.tcl index 4a534de..62c85bf 100644 --- a/library/ttk/scale.tcl +++ b/library/ttk/scale.tcl @@ -21,16 +21,19 @@ bind TScale <ButtonPress-3> { ttk::scale::Jump %W %x %y } bind TScale <B3-Motion> { ttk::scale::Drag %W %x %y } bind TScale <ButtonRelease-3> { ttk::scale::Release %W %x %y } -bind TScale <Left> { ttk::scale::Increment %W -1 } -bind TScale <Up> { ttk::scale::Increment %W -1 } -bind TScale <Right> { ttk::scale::Increment %W 1 } -bind TScale <Down> { ttk::scale::Increment %W 1 } -bind TScale <Control-Left> { ttk::scale::Increment %W -10 } -bind TScale <Control-Up> { ttk::scale::Increment %W -10 } -bind TScale <Control-Right> { ttk::scale::Increment %W 10 } -bind TScale <Control-Down> { ttk::scale::Increment %W 10 } -bind TScale <Home> { %W set [%W cget -from] } -bind TScale <End> { %W set [%W cget -to] } +## Keyboard navigation bindings: +# +bind TScale <<LineStart>> { %W set [%W cget -from] } +bind TScale <<LineEnd>> { %W set [%W cget -to] } + +bind TScale <<PrevChar>> { ttk::scale::Increment %W -1 } +bind TScale <<PrevLine>> { ttk::scale::Increment %W -1 } +bind TScale <<NextChar>> { ttk::scale::Increment %W 1 } +bind TScale <<NextLine>> { ttk::scale::Increment %W 1 } +bind TScale <<PrevWord>> { ttk::scale::Increment %W -10 } +bind TScale <<PrevPara>> { ttk::scale::Increment %W -10 } +bind TScale <<NextWord>> { ttk::scale::Increment %W 10 } +bind TScale <<NextPara>> { ttk::scale::Increment %W 10 } proc ttk::scale::Press {w x y} { variable State diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index 1160e9b..8772587 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -43,7 +43,7 @@ bind Treeview <KeyPress-space> { ttk::treeview::ToggleFocus %W } bind Treeview <Shift-ButtonPress-1> \ { ttk::treeview::Select %W %x %y extend } -bind Treeview <Control-ButtonPress-1> \ +bind Treeview <<ToggleSelection>> \ { ttk::treeview::Select %W %x %y toggle } ttk::copyBindings TtkScrollable Treeview diff --git a/library/unsupported.tcl b/library/unsupported.tcl index aeece38..b5f404a 100644 --- a/library/unsupported.tcl +++ b/library/unsupported.tcl @@ -16,7 +16,7 @@ namespace eval ::tk::unsupported { # Map from the old global names of Tk private commands to their # new namespace-encapsulated names. - variable PrivateCommands + variable PrivateCommands array set PrivateCommands { tkButtonAutoInvoke ::tk::ButtonAutoInvoke tkButtonDown ::tk::ButtonDown @@ -86,34 +86,6 @@ namespace eval ::tk::unsupported { tkFocusOK ::tk::FocusOK tkGenerateMenuSelect ::tk::GenerateMenuSelect tkIconList ::tk::IconList - tkIconList_Add ::tk::IconList_Add - tkIconList_Arrange ::tk::IconList_Arrange - tkIconList_AutoScan ::tk::IconList_AutoScan - tkIconList_Btn1 ::tk::IconList_Btn1 - tkIconList_Config ::tk::IconList_Config - tkIconList_Create ::tk::IconList_Create - tkIconList_CtrlBtn1 ::tk::IconList_CtrlBtn1 - tkIconList_Curselection ::tk::IconList_CurSelection - tkIconList_DeleteAll ::tk::IconList_DeleteAll - tkIconList_Double1 ::tk::IconList_Double1 - tkIconList_DrawSelection ::tk::IconList_DrawSelection - tkIconList_FocusIn ::tk::IconList_FocusIn - tkIconList_FocusOut ::tk::IconList_FocusOut - tkIconList_Get ::tk::IconList_Get - tkIconList_Goto ::tk::IconList_Goto - tkIconList_Index ::tk::IconList_Index - tkIconList_Invoke ::tk::IconList_Invoke - tkIconList_KeyPress ::tk::IconList_KeyPress - tkIconList_Leave1 ::tk::IconList_Leave1 - tkIconList_LeftRight ::tk::IconList_LeftRight - tkIconList_Motion1 ::tk::IconList_Motion1 - tkIconList_Reset ::tk::IconList_Reset - tkIconList_ReturnKey ::tk::IconList_ReturnKey - tkIconList_See ::tk::IconList_See - tkIconList_Select ::tk::IconList_Select - tkIconList_Selection ::tk::IconList_Selection - tkIconList_ShiftBtn1 ::tk::IconList_ShiftBtn1 - tkIconList_UpDown ::tk::IconList_UpDown tkListbox ::tk::Listbox tkListboxAutoScan ::tk::ListboxAutoScan tkListboxBeginExtend ::tk::ListboxBeginExtend @@ -259,7 +231,8 @@ proc ::tk::unsupported::ExposePrivateCommand {cmd} { variable PrivateCommands set cmds [array get PrivateCommands $cmd] if {[llength $cmds] == 0} { - return -code error "No compatibility support for \[$cmd]" + return -code error -errorcode {TK EXPOSE_PRIVATE_COMMAND} \ + "No compatibility support for \[$cmd]" } foreach {old new} $cmds { namespace eval :: [list interp alias {} $old {}] $new @@ -286,7 +259,8 @@ proc ::tk::unsupported::ExposePrivateVariable {var} { variable PrivateVariables set vars [array get PrivateVariables $var] if {[llength $vars] == 0} { - return -code error "No compatibility support for \$$var" + return -code error -errorcode {TK EXPOSE_PRIVATE_VARIABLE} \ + "No compatibility support for \$$var" } namespace eval ::tk::mac {} foreach {old new} $vars { diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 0cbf251..aa66f7f 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -27,7 +27,7 @@ namespace eval ::tk::dialog::file {} # When -multiple is set to 0, this returns the absolute pathname # of the selected file. (NOTE: This is not the same as a single # element list.) -# +# # When -multiple is set to > 0, this returns a Tcl list of absolute # pathnames. The argument for -multiple is ignored, but for consistency # with Windows it defines the maximum amount of memory to allocate for @@ -159,7 +159,7 @@ proc ::tk::MotifFDialog_FileTypes {w} { set initialTypeName [lindex $data(-filetypes) 0 0] if {$data(-typevariable) ne ""} { upvar #0 $data(-typevariable) typeVariable - if {[info exist typeVariable]} { + if {[info exists typeVariable]} { set initialTypeName $typeVariable } } @@ -305,7 +305,8 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { set data(filter) * } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } } @@ -504,7 +505,7 @@ proc ::tk::MotifFDialog_InterpFilter {w} { if {[file pathtype $text] eq "relative"} { set relative 1 } elseif {$badTilde} { - set relative 1 + set relative 1 } if {$relative} { @@ -551,7 +552,7 @@ proc ::tk::MotifFDialog_Update {w} { $data(sEnt) delete 0 end $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ $data(selectFile)] - + MotifFDialog_LoadFiles $w } @@ -625,7 +626,7 @@ proc ::tk::MotifFDialog_LoadFiles {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_BrowseDList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -671,7 +672,7 @@ proc ::tk::MotifFDialog_BrowseDList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateDList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -719,7 +720,7 @@ proc ::tk::MotifFDialog_ActivateDList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_BrowseFList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -739,9 +740,9 @@ proc ::tk::MotifFDialog_BrowseFList {w} { $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ $data(filter)] $data(fEnt) xview end - - # if it's a multiple selection box, just put in the filenames - # otherwise put in the full path as usual + + # if it's a multiple selection box, just put in the filenames + # otherwise put in the full path as usual $data(sEnt) delete 0 end if {$data(-multiple) != 0} { $data(sEnt) insert 0 $data(selectFile) @@ -761,7 +762,7 @@ proc ::tk::MotifFDialog_BrowseFList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateFList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -787,7 +788,7 @@ proc ::tk::MotifFDialog_ActivateFList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateFEnt {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -802,7 +803,7 @@ proc ::tk::MotifFDialog_ActivateFEnt {w} { # ::tk::MotifFDialog_ActivateSEnt -- # # This procedure is called when the user presses Return inside -# the "selection" entry. It sets the ::tk::Priv(selectFilePath) +# the "selection" entry. It sets the ::tk::Priv(selectFilePath) # variable so that the vwait loop in tk::MotifFDialog will be # terminated. # @@ -810,7 +811,7 @@ proc ::tk::MotifFDialog_ActivateFEnt {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateSEnt {w} { variable ::tk::Priv @@ -929,7 +930,7 @@ proc ::tk::ListBoxKeyAccel_Unset {w} { # key The key which the user just pressed. # # Results: -# None. +# None. proc ::tk::ListBoxKeyAccel_Key {w key} { variable ::tk::Priv diff --git a/license.terms b/license.terms index fc7b2c0..0126435 100644 --- a/license.terms +++ b/license.terms @@ -1,7 +1,8 @@ This software is copyrighted by the Regents of the University of -California, Sun Microsystems, Inc., and other parties. The following -terms apply to all files associated with the software unless explicitly -disclaimed in individual files. +California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState +Corporation, Apple Inc. and other parties. The following terms apply to +all files associated with the software unless explicitly disclaimed in +individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile index f3299e2..02240ed 100644 --- a/macosx/GNUmakefile +++ b/macosx/GNUmakefile @@ -132,9 +132,9 @@ wish := ${wish}-X11 override EMBEDDED_BUILD := endif -INSTALL_TARGETS = install-binaries install-headers install-libraries +INSTALL_TARGETS = install-binaries install-libraries ifeq (${EMBEDDED_BUILD},) -INSTALL_TARGETS += install-private-headers install-demos +INSTALL_TARGETS += install-private-headers install-headers install-demos endif ifeq (${INSTALL_BUILD}_${EMBEDDED_BUILD}_${BUILD_STYLE},1__Deployment) INSTALL_TARGETS += html-tk diff --git a/macosx/README b/macosx/README index 7b17fb8..202dbbd 100644 --- a/macosx/README +++ b/macosx/README @@ -260,9 +260,10 @@ These have the following targets: The following build configurations are available: Debug: debug build for the active architecture, with Fix & Continue enabled. - Debug gcc42: use gcc 4.2 compiler. - Debug gcc42 nogc: disable Objective-C garbage collection. - Debug llvmgcc42: use llvm-gcc 4.2 compiler. + Debug clang: use clang compiler. + Debug llvm-gcc: use llvm-gcc compiler. + Debug gcc40: use gcc 4.0 compiler. + DebugNoGC: disable Objective-C garbage collection. DebugNoFixAndContinue: disable Fix & Continue. DebugUnthreaded: disable threading. DebugNoCF: disable corefoundation (X11 only). @@ -274,8 +275,9 @@ The following build configurations are available: building on a 64bit capable processor). Release: release build for the active architecture. ReleaseUniversal: 32/64-bit universal build. - ReleaseUniversal gcc42: use gcc 4.2 compiler. - ReleaseUniversal llvmgcc42: use llvm-gcc 4.2 compiler. + ReleaseUniversal clang: use clang compiler. + ReleaseUniversal llvm-gcc: use llvm-gcc compiler. + ReleaseUniversal gcc40: use gcc 4.0 compiler. ReleaseUniversal10.5SDK: build against the 10.5 SDK (with 10.5 deployment target). Note that the non-SDK configurations have their deployment target set to @@ -283,7 +285,7 @@ The following build configurations are available: The Xcode projects refer to the toplevel tcl and tk source directories via the the TCL_SRCROOT and TK_SRCROOT user build settings, by default these are set to the project-relative paths '../../tcl' and '../../tk', if your source -directories are named differently, e.g. '../../tcl8.5' and '../../tk8.5', you +directories are named differently, e.g. '../../tcl8.6' and '../../tk8.6', you need to manually change the TCL_SRCROOT and TK_SRCROOT settings by editing your ${USER}.pbxuser file (located inside the Tk.xcodeproj bundle directory) with a text editor. @@ -319,9 +321,9 @@ trees in a common parent directory. - The following instructions assume the Tcl and Tk source trees are named "tcl${ver}" and "tk${ver}" (where ${ver} is a shell variable containing the -Tcl/Tk version number, e.g. '8.5'). +Tcl/Tk version number, e.g. '8.6'). Setup this shell variable as follows: - ver="8.5" + ver="8.6" If you are building from CVS, omit this step (CVS source tree names usually do not contain a version number). diff --git a/macosx/Wish-Common.xcconfig b/macosx/Tk-Common.xcconfig index 7bef051..0d6e474 100644 --- a/macosx/Wish-Common.xcconfig +++ b/macosx/Tk-Common.xcconfig @@ -1,5 +1,5 @@ // -// Wish-Common.xcconfig -- +// Tk-Common.xcconfig -- // // This file contains the Xcode build settings comon to all // project configurations in Wish.xcodeproj. @@ -9,7 +9,6 @@ // // See the file "license.terms" for information on usage and redistribution // of this file, and for a DISCLAIMER OF ALL WARRANTIES. -// HEADER_SEARCH_PATHS = $(TK_SRCROOT)/generic $(TK_SRCROOT)/xlib "$(DERIVED_FILE_DIR)/tcl" "$(DERIVED_FILE_DIR)/tk" $(HEADER_SEARCH_PATHS) REZ_SEARCH_PATHS = $(TK_SRCROOT)/generic $(TCL_SRCROOT)/generic $(REZ_SEARCH_PATHS) @@ -22,12 +21,9 @@ OTHER_CFLAGS = -imacros "$(DERIVED_FILE_DIR)/tcl/tclConfig.h" $(OTHER_CFLAGS) GCC_GENERATE_DEBUGGING_SYMBOLS = YES GCC_NO_COMMON_BLOCKS = YES GCC_DYNAMIC_NO_PIC = YES -GCC = $(DEVELOPER_DIR)/usr/bin/gcc -GCC_VERSION = 4.0 -CC = $(GCC)-$(GCC_VERSION) -LD = $(CC) -WARNING_CFLAGS_GCC3 = -Wall -Wno-implicit-int -Wno-unused-parameter -WARNING_CFLAGS = -Wextra -Wno-missing-field-initializers -Winit-self -Wpointer-arith -Wcast-align -Wdisabled-optimization -Winline $(WARNING_CFLAGS_GCC3) $(WARNING_CFLAGS) +GCC_VERSION = 4.2 +GCC = gcc-$(GCC_VERSION) +WARNING_CFLAGS = -Wall -Wextra -Wno-unused-parameter -Wno-missing-field-initializers -Wno-unused-value -Winit-self -Wpointer-arith -Wcast-align -Wdisabled-optimization -Winline $(WARNING_CFLAGS) REZ_RESOURCE_MAP_READ_ONLY = YES APPLICATION_INSTALL_PATH = /Applications/Utilities BINDIR = $(PREFIX)/bin @@ -47,4 +43,4 @@ TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H TK_LIBRARY = $(LIBDIR)/tk$(VERSION) TK_DEFS = HAVE_TK_CONFIG_H TCL_NO_DEPRECATED -VERSION = 8.5 +VERSION = 8.6 diff --git a/macosx/Wish-Debug.xcconfig b/macosx/Tk-Debug.xcconfig index d577d96..2382661 100644 --- a/macosx/Wish-Debug.xcconfig +++ b/macosx/Tk-Debug.xcconfig @@ -1,5 +1,5 @@ // -// Wish-Debug.xcconfig -- +// Tk-Debug.xcconfig -- // // This file contains the Xcode build settings for all Debug // project configurations in Wish.xcodeproj. @@ -8,9 +8,8 @@ // // See the file "license.terms" for information on usage and redistribution // of this file, and for a DISCLAIMER OF ALL WARRANTIES. -// -#include "Wish-Common.xcconfig" +#include "Tk-Common.xcconfig" DEBUG_INFORMATION_FORMAT = dwarf DEPLOYMENT_POSTPROCESSING = NO diff --git a/macosx/Tk-Info.plist.in b/macosx/Tk-Info.plist.in index 93dec7d..7b0c305 100644 --- a/macosx/Tk-Info.plist.in +++ b/macosx/Tk-Info.plist.in @@ -20,6 +20,7 @@ Copyright © 2002-@TK_YEAR@ Daniel A. Steffen, Copyright © 1989-@TK_YEAR@ Contributors, Copyright © 2011-@TK_YEAR@ Kevin Walzer/WordTech Communications LLC, + Copyright © 2014-@TK_YEAR@ Marc Culler, Copyright © 2001-2009 Apple Inc., Copyright © 2001-2002 Jim Ingham & Ian Reid</string> <key>CFBundleIdentifier</key> diff --git a/macosx/Wish-Release.xcconfig b/macosx/Tk-Release.xcconfig index a46aab5..505373c 100644 --- a/macosx/Wish-Release.xcconfig +++ b/macosx/Tk-Release.xcconfig @@ -1,5 +1,5 @@ // -// Wish-Release.xcconfig -- +// Tk-Release.xcconfig -- // // This file contains the Xcode build settings for all Release // project configurations in Wish.xcodeproj. @@ -8,9 +8,8 @@ // // See the file "license.terms" for information on usage and redistribution // of this file, and for a DISCLAIMER OF ALL WARRANTIES. -// -#include "Wish-Common.xcconfig" +#include "Tk-Common.xcconfig" DEBUG_INFORMATION_FORMAT = dwarf-with-dsym // DEPLOYMENT_POSTPROCESSING = YES diff --git a/macosx/Wish.xcode/default.pbxuser b/macosx/Tk.xcode/default.pbxuser index 188bbeb..c8456e8 100644 --- a/macosx/Wish.xcode/default.pbxuser +++ b/macosx/Tk.xcode/default.pbxuser @@ -15,7 +15,6 @@ }; sourceControlManager = F944EB9C08F798180049FDD4 /* Source Control */; userBuildSettings = { - CODE_SIGN_IDENTITY = ""; SYMROOT = "${SRCROOT}/../../build/tk"; TCL_SRCROOT = "${SRCROOT}/../../tcl"; TK_SRCROOT = "${SRCROOT}/../../tk"; @@ -101,12 +100,17 @@ }, { active = NO; + name = TK_CONSOLE; + value = 1; + }, + { + active = NO; name = DYLD_PRINT_LIBRARIES; }, { active = NO; - name = EventDebug; - value = 1; + name = NSTraceEvents; + value = YES; }, { active = NO; @@ -138,6 +142,41 @@ name = MallocScribble; value = 1; }, + { + active = NO; + name = NSZombieEnabled; + value = YES; + }, + { + active = NO; + name = NSDeallocateZombies; + value = YES; + }, + { + active = NO; + name = NSAutoreleaseFreedObjectCheckEnabled; + value = YES; + }, + { + active = NO; + name = NSEnableAutoreleasePool; + value = NO; + }, + { + active = NO; + name = AUTO_LOG_ALL; + value = YES; + }, + { + active = NO; + name = AUTO_LOG_NOISY; + value = YES; + }, + { + active = NO; + name = AUTO_REFERENCE_COUNT_LOGGING; + value = YES; + }, ); executableSystemSymbolLevel = 0; executableUserSymbolLevel = 0; @@ -154,6 +193,9 @@ CVSToolPath = /usr/bin/cvs; CVSUseSSH = NO; SubversionToolPath = /usr/bin/svn; + repositoryNamesForRoots = { + .. = ""; + }; }; scmType = scm.cvs; }; @@ -161,6 +203,12 @@ isa = PBXCodeSenseManager; indexTemplatePath = ""; }; + F97258A50A86873C00096C78 /* tktest-X11 */ = { + activeExec = 0; + executables = ( + F9FD31F50CC1AD070073837D /* tktest-X11 */, + ); + }; F9E61D16090A3E94002B3151 /* Tk */ = { activeExec = 0; executables = ( @@ -219,12 +267,6 @@ sourceDirectories = ( ); }; - F97258A50A86873C00096C78 /* tktest-X11 */ = { - activeExec = 0; - executables = ( - F9FD31F50CC1AD070073837D /* tktest-X11 */, - ); - }; F9FD31F50CC1AD070073837D /* tktest-X11 */ = { isa = PBXExecutable; activeArgIndices = ( diff --git a/macosx/Wish.xcode/project.pbxproj b/macosx/Tk.xcode/project.pbxproj index 02a197e..70c2472 100644 --- a/macosx/Wish.xcode/project.pbxproj +++ b/macosx/Tk.xcode/project.pbxproj @@ -8,7 +8,24 @@ /* Begin PBXBuildFile section */ F9067BCD0BFBA2900074F726 /* tkOldTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F966BAFE08F27A39005CB29B /* tkOldTest.c */; }; + F9152B090EAF8A5000CD5C7B /* tkBusy.c in Sources */ = {isa = PBXBuildFile; fileRef = F9152B080EAF8A5000CD5C7B /* tkBusy.c */; }; + F9152B0A0EAF8A5700CD5C7B /* tkBusy.c in Sources */ = {isa = PBXBuildFile; fileRef = F9152B080EAF8A5000CD5C7B /* tkBusy.c */; }; + F92EE8BF0E62F846001A6E80 /* tkImgPhInstance.c in Sources */ = {isa = PBXBuildFile; fileRef = F92EE8BE0E62F846001A6E80 /* tkImgPhInstance.c */; }; + F92EE8D30E62F939001A6E80 /* tkImgPhInstance.c in Sources */ = {isa = PBXBuildFile; fileRef = F92EE8BE0E62F846001A6E80 /* tkImgPhInstance.c */; }; + F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; }; + F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; }; + F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; }; + F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; }; + F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; + F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; + F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; + F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; F94523A20E6FC2AC00C1D987 /* Cocoa.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F94523A10E6FC2AC00C1D987 /* Cocoa.framework */; }; + F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; + F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; + F96437CB0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; + F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; + F96437E80EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; F966BDCF08F27A3F005CB29B /* tk3d.c in Sources */ = {isa = PBXBuildFile; fileRef = F966BAAC08F27A39005CB29B /* tk3d.c */; }; F966BDD108F27A3F005CB29B /* tkArgv.c in Sources */ = {isa = PBXBuildFile; fileRef = F966BAAE08F27A39005CB29B /* tkArgv.c */; }; F966BDD208F27A3F005CB29B /* tkAtom.c in Sources */ = {isa = PBXBuildFile; fileRef = F966BAAF08F27A39005CB29B /* tkAtom.c */; }; @@ -293,6 +310,8 @@ F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446908F272B9004A47F5 /* tclUnixThrd.c */; }; F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; }; F9C9CC000E84059800E00935 /* ApplicationServices.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F9C9CBFF0E84059800E00935 /* ApplicationServices.framework */; }; + F9DD99BD0F07DF850018B2E4 /* tkImgPNG.c in Sources */ = {isa = PBXBuildFile; fileRef = F9DD99BC0F07DF850018B2E4 /* tkImgPNG.c */; }; + F9DD99BE0F07DF850018B2E4 /* tkImgPNG.c in Sources */ = {isa = PBXBuildFile; fileRef = F9DD99BC0F07DF850018B2E4 /* tkImgPNG.c */; }; F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; }; F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; }; F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; }; @@ -590,14 +609,57 @@ F9FD349B0CC1BB0D0073837D /* libfreetype.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F9FD34990CC1BB0D0073837D /* libfreetype.dylib */; }; F9FD349C0CC1BB0D0073837D /* libXft.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F9FD349A0CC1BB0D0073837D /* libXft.dylib */; }; F9FD34C40CC1BBD70073837D /* libfontconfig.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F9FD34C30CC1BBD70073837D /* libfontconfig.dylib */; }; + F9FFAF1D0DFDDB26007F8A6A /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; + F9FFAF1F0DFDDB2F007F8A6A /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; }; + F9FFAF200DFDDB32007F8A6A /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; }; + F9FFAF210DFDDB32007F8A6A /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; }; + F9FFAF220DFDDB34007F8A6A /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; }; + F9FFAF230DFDDB35007F8A6A /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; + F9FFAF240DFDDB36007F8A6A /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; + F9FFAF250DFDDB37007F8A6A /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; + F9FFAF260DFDDB38007F8A6A /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; /* End PBXBuildFile section */ /* Begin PBXFileReference section */ 8DD76FB20486AB0100D96B5E /* tktest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tktest; sourceTree = BUILT_PRODUCTS_DIR; }; F9099B8A0CC67D30005A9580 /* textpeer.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = textpeer.tcl; sourceTree = "<group>"; }; F9099B8B0CC67D3E005A9580 /* ttkbut.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ttkbut.tcl; sourceTree = "<group>"; }; + F9152B080EAF8A5000CD5C7B /* tkBusy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tkBusy.c; sourceTree = "<group>"; }; + F91543270EF201A90032D1E8 /* fontchoose.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fontchoose.tcl; sourceTree = "<group>"; }; + F915432A0EF201CF0032D1E8 /* zlib.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = zlib.test; sourceTree = "<group>"; }; + F915432D0EF201EE0032D1E8 /* zlib.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = zlib.n; sourceTree = "<group>"; }; + F9183E640EFC80CD0030B814 /* throw.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = throw.n; sourceTree = "<group>"; }; + F9183E650EFC80D70030B814 /* try.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = try.n; sourceTree = "<group>"; }; + F9183E6A0EFC81560030B814 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; + F9183E8F0EFC817B0030B814 /* tdbc */ = {isa = PBXFileReference; lastKnownFileType = folder; path = tdbc; sourceTree = "<group>"; }; + F91DC23C0E44C51B002CB8D1 /* nre.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = nre.test; sourceTree = "<group>"; }; F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xml; path = "Tclsh-Info.plist.in"; sourceTree = "<group>"; }; F92240290D7C620F005EC715 /* knightstour.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = knightstour.tcl; sourceTree = "<group>"; }; + F92D7F100DE777240033A13A /* tsdPerf.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tsdPerf.tcl; sourceTree = "<group>"; }; + F92EE8BE0E62F846001A6E80 /* tkImgPhInstance.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tkImgPhInstance.c; sourceTree = "<group>"; }; + F93599B20DF1F75400E04F67 /* tclOO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOO.c; sourceTree = "<group>"; }; + F93599B40DF1F75900E04F67 /* tclOO.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclOO.decls; sourceTree = "<group>"; }; + F93599B50DF1F75D00E04F67 /* tclOO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOO.h; sourceTree = "<group>"; }; + F93599B60DF1F76100E04F67 /* tclOOBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOBasic.c; sourceTree = "<group>"; }; + F93599B80DF1F76600E04F67 /* tclOOCall.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOCall.c; sourceTree = "<group>"; }; + F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; }; + F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; }; + F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; }; + F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; }; + F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; }; + F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; }; + F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; }; + F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = "<group>"; }; + F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; }; + F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; }; + F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; }; + F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = "<group>"; }; + F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = "<group>"; }; + F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = "<group>"; }; + F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = "<group>"; }; + F93599D60DF1F95000E04F67 /* next.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = next.n; sourceTree = "<group>"; }; + F93599D70DF1F96800E04F67 /* object.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = object.n; sourceTree = "<group>"; }; + F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; }; F936FCD70CCD984500716967 /* ttkprogress.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ttkprogress.tcl; sourceTree = "<group>"; }; F936FCD80CCD984600716967 /* tree.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tree.tcl; sourceTree = "<group>"; }; F936FCD90CCD984600716967 /* toolbar.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = toolbar.tcl; sourceTree = "<group>"; }; @@ -605,10 +667,14 @@ F936FCDB0CCD984600716967 /* combo.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = combo.tcl; sourceTree = "<group>"; }; F93E5EFD09CF8711008FA367 /* tkMacOSXFont.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tkMacOSXFont.h; sourceTree = "<group>"; }; F94523A10E6FC2AC00C1D987 /* Cocoa.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Cocoa.framework; path = /System/Library/Frameworks/Cocoa.framework; sourceTree = "<absolute>"; }; + F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; }; + F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; }; F95D8D4B0F1715610006B020 /* Tk.icns */ = {isa = PBXFileReference; lastKnownFileType = image.icns; path = Tk.icns; sourceTree = "<group>"; }; F95D8D4C0F1715610006B020 /* Tk.tiff */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = Tk.tiff; sourceTree = "<group>"; }; F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; }; F962F7C60DADC26200648DB8 /* vsapi.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = vsapi.test; sourceTree = "<group>"; }; + F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; }; + F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; }; F966BA0408F27A37005CB29B /* error.xbm */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = error.xbm; sourceTree = "<group>"; }; F966BA0508F27A37005CB29B /* gray12.xbm */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = gray12.xbm; sourceTree = "<group>"; }; F966BA0608F27A37005CB29B /* gray25.xbm */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = gray25.xbm; sourceTree = "<group>"; }; @@ -756,7 +822,6 @@ F966BA9608F27A38005CB29B /* text.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = text.n; sourceTree = "<group>"; }; F966BA9708F27A38005CB29B /* TextLayout.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TextLayout.3; sourceTree = "<group>"; }; F966BA9808F27A38005CB29B /* tk.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tk.n; sourceTree = "<group>"; }; - F966BA9908F27A38005CB29B /* tk4.0.ps */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = tk4.0.ps; sourceTree = "<group>"; }; F966BA9A08F27A38005CB29B /* Tk_Init.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tk_Init.3; sourceTree = "<group>"; }; F966BA9B08F27A38005CB29B /* Tk_Main.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tk_Main.3; sourceTree = "<group>"; }; F966BA9C08F27A38005CB29B /* tkerror.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tkerror.n; sourceTree = "<group>"; }; @@ -770,7 +835,6 @@ F966BAA408F27A38005CB29B /* wm.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = wm.n; sourceTree = "<group>"; }; F966BAA608F27A38005CB29B /* default.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = default.h; sourceTree = "<group>"; }; F966BAA708F27A38005CB29B /* ks_names.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = ks_names.h; sourceTree = "<group>"; }; - F966BAA808F27A38005CB29B /* prolog.ps */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = prolog.ps; sourceTree = "<group>"; }; F966BAA908F27A39005CB29B /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F966BAAA08F27A39005CB29B /* tk.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tk.decls; sourceTree = "<group>"; }; F966BAAB08F27A39005CB29B /* tk.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tk.h; sourceTree = "<group>"; }; @@ -947,7 +1011,6 @@ F966BB8708F27A3A005CB29B /* optMenu.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = optMenu.tcl; sourceTree = "<group>"; }; F966BB8808F27A3A005CB29B /* palette.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = palette.tcl; sourceTree = "<group>"; }; F966BB8908F27A3B005CB29B /* panedwindow.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = panedwindow.tcl; sourceTree = "<group>"; }; - F966BB8A08F27A3B005CB29B /* prolog.ps */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = prolog.ps; sourceTree = "<group>"; }; F966BB8B08F27A3B005CB29B /* safetk.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safetk.tcl; sourceTree = "<group>"; }; F966BB8C08F27A3B005CB29B /* scale.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = scale.tcl; sourceTree = "<group>"; }; F966BB8D08F27A3B005CB29B /* scrlbar.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = scrlbar.tcl; sourceTree = "<group>"; }; @@ -1051,7 +1114,6 @@ F966BC2F08F27A3C005CB29B /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = "<group>"; }; F966BC3008F27A3C005CB29B /* grab.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = grab.test; sourceTree = "<group>"; }; F966BC3108F27A3C005CB29B /* grid.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = grid.test; sourceTree = "<group>"; }; - F966BC3208F27A3C005CB29B /* id.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = id.test; sourceTree = "<group>"; }; F966BC3308F27A3C005CB29B /* image.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = image.test; sourceTree = "<group>"; }; F966BC3408F27A3C005CB29B /* imgBmap.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = imgBmap.test; sourceTree = "<group>"; }; F966BC3508F27A3C005CB29B /* imgPhoto.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = imgPhoto.test; sourceTree = "<group>"; }; @@ -1644,18 +1706,10 @@ F96D402208F272AA004A47F5 /* tcltest.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.tcl; sourceTree = "<group>"; }; F96D402308F272AA004A47F5 /* tm.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.tcl; sourceTree = "<group>"; }; F96D425B08F272B2004A47F5 /* word.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = word.tcl; sourceTree = "<group>"; }; - F96D425F08F272B3004A47F5 /* bn.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = bn.pdf; sourceTree = "<group>"; }; - F96D426108F272B3004A47F5 /* bn_error.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_error.c; sourceTree = "<group>"; }; - F96D426208F272B3004A47F5 /* bn_fast_mp_invmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_mp_invmod.c; sourceTree = "<group>"; }; - F96D426308F272B3004A47F5 /* bn_fast_mp_montgomery_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_mp_montgomery_reduce.c; sourceTree = "<group>"; }; F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_digs.c; sourceTree = "<group>"; }; - F96D426508F272B3004A47F5 /* bn_fast_s_mp_mul_high_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_high_digs.c; sourceTree = "<group>"; }; F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_sqr.c; sourceTree = "<group>"; }; - F96D426708F272B3004A47F5 /* bn_mp_2expt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_2expt.c; sourceTree = "<group>"; }; - F96D426808F272B3004A47F5 /* bn_mp_abs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_abs.c; sourceTree = "<group>"; }; F96D426908F272B3004A47F5 /* bn_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add.c; sourceTree = "<group>"; }; F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add_d.c; sourceTree = "<group>"; }; - F96D426B08F272B3004A47F5 /* bn_mp_addmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_addmod.c; sourceTree = "<group>"; }; F96D426C08F272B3004A47F5 /* bn_mp_and.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_and.c; sourceTree = "<group>"; }; F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clamp.c; sourceTree = "<group>"; }; F96D426E08F272B3004A47F5 /* bn_mp_clear.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear.c; sourceTree = "<group>"; }; @@ -1663,7 +1717,6 @@ F96D427008F272B3004A47F5 /* bn_mp_cmp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp.c; sourceTree = "<group>"; }; F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_d.c; sourceTree = "<group>"; }; F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_mag.c; sourceTree = "<group>"; }; - F96D427308F272B3004A47F5 /* bn_mp_cnt_lsb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cnt_lsb.c; sourceTree = "<group>"; }; F96D427408F272B3004A47F5 /* bn_mp_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_copy.c; sourceTree = "<group>"; }; F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_count_bits.c; sourceTree = "<group>"; }; F96D427608F272B3004A47F5 /* bn_mp_div.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div.c; sourceTree = "<group>"; }; @@ -1671,104 +1724,49 @@ F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = "<group>"; }; F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = "<group>"; }; F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = "<group>"; }; - F96D427B08F272B3004A47F5 /* bn_mp_dr_is_modulus.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_is_modulus.c; sourceTree = "<group>"; }; - F96D427C08F272B3004A47F5 /* bn_mp_dr_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_reduce.c; sourceTree = "<group>"; }; - F96D427D08F272B3004A47F5 /* bn_mp_dr_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_setup.c; sourceTree = "<group>"; }; F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = "<group>"; }; F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d.c; sourceTree = "<group>"; }; - F96D428008F272B3004A47F5 /* bn_mp_exptmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exptmod.c; sourceTree = "<group>"; }; - F96D428108F272B3004A47F5 /* bn_mp_exptmod_fast.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exptmod_fast.c; sourceTree = "<group>"; }; - F96D428208F272B3004A47F5 /* bn_mp_exteuclid.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exteuclid.c; sourceTree = "<group>"; }; - F96D428308F272B3004A47F5 /* bn_mp_fread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_fread.c; sourceTree = "<group>"; }; - F96D428408F272B3004A47F5 /* bn_mp_fwrite.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_fwrite.c; sourceTree = "<group>"; }; - F96D428508F272B3004A47F5 /* bn_mp_gcd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_gcd.c; sourceTree = "<group>"; }; - F96D428608F272B3004A47F5 /* bn_mp_get_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_get_int.c; sourceTree = "<group>"; }; F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = "<group>"; }; F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = "<group>"; }; F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = "<group>"; }; F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = "<group>"; }; F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set.c; sourceTree = "<group>"; }; - F96D428C08F272B3004A47F5 /* bn_mp_init_set_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set_int.c; sourceTree = "<group>"; }; F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_size.c; sourceTree = "<group>"; }; - F96D428E08F272B3004A47F5 /* bn_mp_invmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_invmod.c; sourceTree = "<group>"; }; - F96D428F08F272B3004A47F5 /* bn_mp_invmod_slow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_invmod_slow.c; sourceTree = "<group>"; }; - F96D429008F272B3004A47F5 /* bn_mp_is_square.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_is_square.c; sourceTree = "<group>"; }; - F96D429108F272B3004A47F5 /* bn_mp_jacobi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_jacobi.c; sourceTree = "<group>"; }; F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_mul.c; sourceTree = "<group>"; }; F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_sqr.c; sourceTree = "<group>"; }; - F96D429408F272B3004A47F5 /* bn_mp_lcm.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lcm.c; sourceTree = "<group>"; }; F96D429508F272B3004A47F5 /* bn_mp_lshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lshd.c; sourceTree = "<group>"; }; F96D429608F272B3004A47F5 /* bn_mp_mod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod.c; sourceTree = "<group>"; }; F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_2d.c; sourceTree = "<group>"; }; - F96D429808F272B3004A47F5 /* bn_mp_mod_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_d.c; sourceTree = "<group>"; }; - F96D429908F272B3004A47F5 /* bn_mp_montgomery_calc_normalization.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_calc_normalization.c; sourceTree = "<group>"; }; - F96D429A08F272B3004A47F5 /* bn_mp_montgomery_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_reduce.c; sourceTree = "<group>"; }; - F96D429B08F272B3004A47F5 /* bn_mp_montgomery_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_setup.c; sourceTree = "<group>"; }; F96D429C08F272B3004A47F5 /* bn_mp_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul.c; sourceTree = "<group>"; }; F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2.c; sourceTree = "<group>"; }; F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2d.c; sourceTree = "<group>"; }; F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_d.c; sourceTree = "<group>"; }; - F96D42A008F272B3004A47F5 /* bn_mp_mulmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mulmod.c; sourceTree = "<group>"; }; - F96D42A108F272B3004A47F5 /* bn_mp_n_root.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_n_root.c; sourceTree = "<group>"; }; F96D42A208F272B3004A47F5 /* bn_mp_neg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_neg.c; sourceTree = "<group>"; }; F96D42A308F272B3004A47F5 /* bn_mp_or.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_or.c; sourceTree = "<group>"; }; - F96D42A408F272B3004A47F5 /* bn_mp_prime_fermat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_fermat.c; sourceTree = "<group>"; }; - F96D42A508F272B3004A47F5 /* bn_mp_prime_is_divisible.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_is_divisible.c; sourceTree = "<group>"; }; - F96D42A608F272B3004A47F5 /* bn_mp_prime_is_prime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_is_prime.c; sourceTree = "<group>"; }; - F96D42A708F272B3004A47F5 /* bn_mp_prime_miller_rabin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_miller_rabin.c; sourceTree = "<group>"; }; - F96D42A808F272B3004A47F5 /* bn_mp_prime_next_prime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_next_prime.c; sourceTree = "<group>"; }; - F96D42A908F272B3004A47F5 /* bn_mp_prime_rabin_miller_trials.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_rabin_miller_trials.c; sourceTree = "<group>"; }; - F96D42AA08F272B3004A47F5 /* bn_mp_prime_random_ex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_random_ex.c; sourceTree = "<group>"; }; F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_size.c; sourceTree = "<group>"; }; F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_smap.c; sourceTree = "<group>"; }; - F96D42AD08F272B3004A47F5 /* bn_mp_rand.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rand.c; sourceTree = "<group>"; }; F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_radix.c; sourceTree = "<group>"; }; - F96D42AF08F272B3004A47F5 /* bn_mp_read_signed_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_signed_bin.c; sourceTree = "<group>"; }; - F96D42B008F272B3004A47F5 /* bn_mp_read_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_unsigned_bin.c; sourceTree = "<group>"; }; - F96D42B108F272B3004A47F5 /* bn_mp_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce.c; sourceTree = "<group>"; }; - F96D42B208F272B3004A47F5 /* bn_mp_reduce_2k.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k.c; sourceTree = "<group>"; }; - F96D42B308F272B3004A47F5 /* bn_mp_reduce_2k_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_l.c; sourceTree = "<group>"; }; - F96D42B408F272B3004A47F5 /* bn_mp_reduce_2k_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_setup.c; sourceTree = "<group>"; }; - F96D42B508F272B3004A47F5 /* bn_mp_reduce_2k_setup_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_setup_l.c; sourceTree = "<group>"; }; - F96D42B608F272B3004A47F5 /* bn_mp_reduce_is_2k.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_is_2k.c; sourceTree = "<group>"; }; - F96D42B708F272B3004A47F5 /* bn_mp_reduce_is_2k_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_is_2k_l.c; sourceTree = "<group>"; }; - F96D42B808F272B3004A47F5 /* bn_mp_reduce_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_setup.c; sourceTree = "<group>"; }; F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rshd.c; sourceTree = "<group>"; }; F96D42BA08F272B3004A47F5 /* bn_mp_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set.c; sourceTree = "<group>"; }; - F96D42BB08F272B3004A47F5 /* bn_mp_set_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set_int.c; sourceTree = "<group>"; }; F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = "<group>"; }; - F96D42BD08F272B3004A47F5 /* bn_mp_signed_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_signed_bin_size.c; sourceTree = "<group>"; }; F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = "<group>"; }; - F96D42BF08F272B3004A47F5 /* bn_mp_sqrmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrmod.c; sourceTree = "<group>"; }; F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = "<group>"; }; F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = "<group>"; }; F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = "<group>"; }; - F96D42C308F272B3004A47F5 /* bn_mp_submod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_submod.c; sourceTree = "<group>"; }; - F96D42C408F272B3004A47F5 /* bn_mp_to_signed_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_signed_bin.c; sourceTree = "<group>"; }; - F96D42C508F272B3004A47F5 /* bn_mp_to_signed_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_signed_bin_n.c; sourceTree = "<group>"; }; F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin.c; sourceTree = "<group>"; }; F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin_n.c; sourceTree = "<group>"; }; F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = "<group>"; }; F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = "<group>"; }; - F96D42CA08F272B3004A47F5 /* bn_mp_toradix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix.c; sourceTree = "<group>"; }; F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix_n.c; sourceTree = "<group>"; }; F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_unsigned_bin_size.c; sourceTree = "<group>"; }; F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = "<group>"; }; F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = "<group>"; }; - F96D42CF08F272B3004A47F5 /* bn_prime_tab.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_prime_tab.c; sourceTree = "<group>"; }; F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = "<group>"; }; F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = "<group>"; }; - F96D42D208F272B3004A47F5 /* bn_s_mp_exptmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_exptmod.c; sourceTree = "<group>"; }; F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = "<group>"; }; - F96D42D408F272B3004A47F5 /* bn_s_mp_mul_high_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_high_digs.c; sourceTree = "<group>"; }; F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = "<group>"; }; F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = "<group>"; }; F96D42D708F272B3004A47F5 /* bncore.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bncore.c; sourceTree = "<group>"; }; - F96D42D908F272B3004A47F5 /* callgraph.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = callgraph.txt; sourceTree = "<group>"; }; - F96D42DA08F272B3004A47F5 /* changes.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = changes.txt; sourceTree = "<group>"; }; - F96D42F008F272B3004A47F5 /* LICENSE */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = LICENSE; sourceTree = "<group>"; }; - F96D431D08F272B4004A47F5 /* poster.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = poster.pdf; sourceTree = "<group>"; }; - F96D432608F272B4004A47F5 /* tommath.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = tommath.pdf; sourceTree = "<group>"; }; F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = "<group>"; }; F96D432A08F272B4004A47F5 /* tommath_superclass.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_superclass.h; sourceTree = "<group>"; }; F96D432B08F272B4004A47F5 /* license.terms */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = license.terms; sourceTree = "<group>"; }; @@ -1822,7 +1820,7 @@ F96D436E08F272B6004A47F5 /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = "<group>"; }; F96D436F08F272B6004A47F5 /* history.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.test; sourceTree = "<group>"; }; F96D437008F272B6004A47F5 /* http.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.test; sourceTree = "<group>"; }; - F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = httpd; sourceTree = "<group>"; }; + F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd; sourceTree = "<group>"; }; F96D437208F272B6004A47F5 /* httpold.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpold.test; sourceTree = "<group>"; }; F96D437308F272B6004A47F5 /* if-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "if-old.test"; sourceTree = "<group>"; }; F96D437408F272B6004A47F5 /* if.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = if.test; sourceTree = "<group>"; }; @@ -1835,7 +1833,6 @@ F96D437B08F272B6004A47F5 /* io.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = io.test; sourceTree = "<group>"; }; F96D437C08F272B6004A47F5 /* ioCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioCmd.test; sourceTree = "<group>"; }; F96D437D08F272B6004A47F5 /* iogt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iogt.test; sourceTree = "<group>"; }; - F96D437E08F272B6004A47F5 /* ioUtil.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioUtil.test; sourceTree = "<group>"; }; F96D437F08F272B6004A47F5 /* join.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = join.test; sourceTree = "<group>"; }; F96D438008F272B6004A47F5 /* lindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lindex.test; sourceTree = "<group>"; }; F96D438108F272B6004A47F5 /* link.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = link.test; sourceTree = "<group>"; }; @@ -1920,6 +1917,7 @@ F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = "<group>"; }; F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; }; F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; }; + F96D442208F272B8004A47F5 /* eolFix.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = eolFix.tcl; sourceTree = "<group>"; }; F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = "<group>"; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; }; @@ -1935,10 +1933,8 @@ F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = "<group>"; }; F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; }; - F96D443408F272B8004A47F5 /* str2c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = str2c; sourceTree = "<group>"; }; F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; }; F96D443608F272B8004A47F5 /* tcl.wse.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.wse.in; sourceTree = "<group>"; }; - F96D443708F272B9004A47F5 /* tclmin.wse */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclmin.wse; sourceTree = "<group>"; }; F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; }; F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; }; F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; }; @@ -2026,18 +2022,38 @@ F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = "<group>"; }; F96D449908F272BA004A47F5 /* tclWinThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinThrd.h; sourceTree = "<group>"; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = "<group>"; }; + F973E5960EE99384001A648E /* vistaTheme.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = vistaTheme.tcl; sourceTree = "<group>"; }; + F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = "<group>"; }; + F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = "<group>"; }; + F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = "<group>"; }; + F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = "<group>"; }; + F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = "<group>"; }; + F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = "<group>"; }; + F974D5790FBE7E9C00BF728B /* tcl.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.pc.in; sourceTree = "<group>"; }; + F974D57B0FBE7EC000BF728B /* tk.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tk.pc.in; sourceTree = "<group>"; }; + F974D57C0FBE7EFF00BF728B /* iconlist.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iconlist.tcl; sourceTree = "<group>"; }; + F974D57D0FBE7EFF00BF728B /* icons.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = icons.tcl; sourceTree = "<group>"; }; + F97590AE1039A96200558A9A /* Wish.sdef */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.sdef; path = Wish.sdef; sourceTree = "<group>"; }; F976F6A70C325FB6005066D9 /* tkMacOSXPrivate.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tkMacOSXPrivate.h; sourceTree = "<group>"; }; - F97AE7F10B65C1E900310EA2 /* Wish-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Wish-Common.xcconfig"; sourceTree = "<group>"; }; - F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Wish-Release.xcconfig"; sourceTree = "<group>"; }; - F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Wish-Debug.xcconfig"; sourceTree = "<group>"; }; + F97AE7F10B65C1E900310EA2 /* Tk-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tk-Common.xcconfig"; sourceTree = "<group>"; }; + F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tk-Release.xcconfig"; sourceTree = "<group>"; }; + F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tk-Debug.xcconfig"; sourceTree = "<group>"; }; + F98383650F0FA43900171CA6 /* checkbutton.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkbutton.test; sourceTree = "<group>"; }; + F98383680F0FA44700171CA6 /* radiobutton.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = radiobutton.test; sourceTree = "<group>"; }; F9903CAF094FAADA004613E9 /* tclTomMath.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclTomMath.decls; sourceTree = "<group>"; }; F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMathDecls.h; sourceTree = "<group>"; }; + F99388380EE0114B0065FE6B /* fontchooser.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fontchooser.tcl; sourceTree = "<group>"; }; + F99388950EE02D980065FE6B /* fontchooser.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fontchooser.test; sourceTree = "<group>"; }; + F99D61180EF5573A00BBFE01 /* TclZlib.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TclZlib.3; sourceTree = "<group>"; }; F9A3082D08F2D4AB00BAE1AB /* Tk.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tk.framework; sourceTree = BUILT_PRODUCTS_DIR; }; F9A3084B08F2D4CE00BAE1AB /* Wish.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = Wish.app; sourceTree = BUILT_PRODUCTS_DIR; }; F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; }; F9A493240CEBF38300B78AE2 /* chanio.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chanio.test; sourceTree = "<group>"; }; + F9C888C20EEF6571003F63AD /* fontchooser.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fontchooser.n; sourceTree = "<group>"; }; F9C9CBFF0E84059800E00935 /* ApplicationServices.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = ApplicationServices.framework; path = /System/Library/Frameworks/ApplicationServices.framework; sourceTree = "<absolute>"; }; F9D1360A0CDC252C00DBE0B5 /* mclist.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mclist.tcl; sourceTree = "<group>"; }; + F9DD99BC0F07DF850018B2E4 /* tkImgPNG.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tkImgPNG.c; sourceTree = "<group>"; }; + F9DD99BF0F07DFCD0018B2E4 /* imgPNG.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = imgPNG.test; sourceTree = "<group>"; }; F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; }; F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = "<group>"; }; F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = "<group>"; }; @@ -2064,6 +2080,7 @@ buildActionMask = 2147483647; files = ( F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */, + F96437E70EF0D652003F468E /* libz.dylib in Frameworks */, F966C07708F2821B005CB29B /* Carbon.framework in Frameworks */, F966C07908F28233005CB29B /* IOKit.framework in Frameworks */, F94523A20E6FC2AC00C1D987 /* Cocoa.framework in Frameworks */, @@ -2076,6 +2093,7 @@ buildActionMask = 2147483647; files = ( F9FD31E40CC1AD070073837D /* CoreFoundation.framework in Frameworks */, + F96437E80EF0D652003F468E /* libz.dylib in Frameworks */, F9FD32170CC1AF170073837D /* libX11.dylib in Frameworks */, F9FD32180CC1AF170073837D /* libXext.dylib in Frameworks */, F9FD32190CC1AF170073837D /* libXss.dylib in Frameworks */, @@ -2088,7 +2106,7 @@ /* End PBXFrameworksBuildPhase section */ /* Begin PBXGroup section */ - 08FB7794FE84155DC02AAC07 /* Wish */ = { + 08FB7794FE84155DC02AAC07 /* Tk */ = { isa = PBXGroup; children = ( F96D3DF708F271BE004A47F5 /* Tk Sources */, @@ -2097,7 +2115,7 @@ 1AB674ADFE9D54B511CA2CBB /* Products */, ); comments = "Copyright (c) 2004-2009 Daniel A. Steffen <das@users.sourceforge.net>\nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n"; - name = Wish; + name = Tk; path = .; sourceTree = SOURCE_ROOT; }; @@ -2114,6 +2132,16 @@ name = Products; sourceTree = "<group>"; }; + F9183E690EFC81560030B814 /* pkgs */ = { + isa = PBXGroup; + children = ( + F9183E6A0EFC81560030B814 /* README */, + F946FB8B0FBE3AED00CD6495 /* itcl */, + F9183E8F0EFC817B0030B814 /* tdbc */, + ); + path = pkgs; + sourceTree = "<group>"; + }; F966BA0308F27A37005CB29B /* bitmaps */ = { isa = PBXGroup; children = ( @@ -2177,6 +2205,7 @@ F966BA3908F27A37005CB29B /* focus.n */, F966BA3A08F27A37005CB29B /* focusNext.n */, F966BA3B08F27A37005CB29B /* font.n */, + F9C888C20EEF6571003F63AD /* fontchooser.n */, F966BA3C08F27A37005CB29B /* FontId.3 */, F966BA3D08F27A37005CB29B /* frame.n */, F966BA3E08F27A37005CB29B /* FreeXId.3 */, @@ -2269,7 +2298,6 @@ F966BA9608F27A38005CB29B /* text.n */, F966BA9708F27A38005CB29B /* TextLayout.3 */, F966BA9808F27A38005CB29B /* tk.n */, - F966BA9908F27A38005CB29B /* tk4.0.ps */, F966BA9A08F27A38005CB29B /* Tk_Init.3 */, F966BA9B08F27A38005CB29B /* Tk_Main.3 */, F966BA9C08F27A38005CB29B /* tkerror.n */, @@ -2312,7 +2340,6 @@ children = ( F966BAA608F27A38005CB29B /* default.h */, F966BAA708F27A38005CB29B /* ks_names.h */, - F966BAA808F27A38005CB29B /* prolog.ps */, F966BAA908F27A39005CB29B /* README */, F966BAAA08F27A39005CB29B /* tk.decls */, F966BAAB08F27A39005CB29B /* tk.h */, @@ -2322,6 +2349,7 @@ F966BAAF08F27A39005CB29B /* tkAtom.c */, F966BAB008F27A39005CB29B /* tkBind.c */, F966BAB108F27A39005CB29B /* tkBitmap.c */, + F9152B080EAF8A5000CD5C7B /* tkBusy.c */, F966BAB208F27A39005CB29B /* tkButton.c */, F966BAB308F27A39005CB29B /* tkButton.h */, F966BAB408F27A39005CB29B /* tkCanvArc.c */, @@ -2361,7 +2389,9 @@ F966BAD708F27A39005CB29B /* tkImage.c */, F966BAD808F27A39005CB29B /* tkImgBmap.c */, F966BAD908F27A39005CB29B /* tkImgGIF.c */, + F92EE8BE0E62F846001A6E80 /* tkImgPhInstance.c */, F966BADA08F27A39005CB29B /* tkImgPhoto.c */, + F9DD99BC0F07DF850018B2E4 /* tkImgPNG.c */, F966BADB08F27A39005CB29B /* tkImgPPM.c */, F966BADC08F27A39005CB29B /* tkImgUtil.c */, F966BADE08F27A39005CB29B /* tkInt.decls */, @@ -2433,6 +2463,9 @@ F966BB6208F27A3A005CB29B /* dialog.tcl */, F966BB6308F27A3A005CB29B /* entry.tcl */, F966BB6408F27A3A005CB29B /* focus.tcl */, + F99388380EE0114B0065FE6B /* fontchooser.tcl */, + F974D57C0FBE7EFF00BF728B /* iconlist.tcl */, + F974D57D0FBE7EFF00BF728B /* icons.tcl */, F966BB7308F27A3A005CB29B /* listbox.tcl */, F966BB7408F27A3A005CB29B /* menu.tcl */, F966BB7508F27A3A005CB29B /* mkpsenc.tcl */, @@ -2441,7 +2474,6 @@ F966BB8708F27A3A005CB29B /* optMenu.tcl */, F966BB8808F27A3A005CB29B /* palette.tcl */, F966BB8908F27A3B005CB29B /* panedwindow.tcl */, - F966BB8A08F27A3B005CB29B /* prolog.ps */, F966BB8B08F27A3B005CB29B /* safetk.tcl */, F966BB8C08F27A3B005CB29B /* scale.tcl */, F966BB8D08F27A3B005CB29B /* scrlbar.tcl */, @@ -2481,6 +2513,7 @@ F966BB2C08F27A39005CB29B /* entry3.tcl */, F966BB2D08F27A39005CB29B /* filebox.tcl */, F966BB2E08F27A39005CB29B /* floor.tcl */, + F91543270EF201A90032D1E8 /* fontchoose.tcl */, F966BB2F08F27A39005CB29B /* form.tcl */, F966BB3008F27A39005CB29B /* goldberg.tcl */, F966BB3108F27A39005CB29B /* hello */, @@ -2586,9 +2619,10 @@ F95D8D4B0F1715610006B020 /* Tk.icns */, F95D8D4C0F1715610006B020 /* Tk.tiff */, F966BBF708F27A3C005CB29B /* Wish-Info.plist.in */, - F97AE7F10B65C1E900310EA2 /* Wish-Common.xcconfig */, - F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */, - F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */, + F97590AE1039A96200558A9A /* Wish.sdef */, + F97AE7F10B65C1E900310EA2 /* Tk-Common.xcconfig */, + F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */, + F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */, ); path = macosx; sourceTree = "<group>"; @@ -2636,15 +2670,16 @@ F966BC2A08F27A3C005CB29B /* focus.test */, F966BC2B08F27A3C005CB29B /* focusTcl.test */, F966BC2C08F27A3C005CB29B /* font.test */, + F99388950EE02D980065FE6B /* fontchooser.test */, F966BC2D08F27A3C005CB29B /* frame.test */, F966BC2E08F27A3C005CB29B /* geometry.test */, F966BC2F08F27A3C005CB29B /* get.test */, F966BC3008F27A3C005CB29B /* grab.test */, F966BC3108F27A3C005CB29B /* grid.test */, - F966BC3208F27A3C005CB29B /* id.test */, F966BC3308F27A3C005CB29B /* image.test */, F966BC3408F27A3C005CB29B /* imgBmap.test */, F966BC3508F27A3C005CB29B /* imgPhoto.test */, + F9DD99BF0F07DFCD0018B2E4 /* imgPNG.test */, F966BC3608F27A3C005CB29B /* imgPPM.test */, F966BC3708F27A3C005CB29B /* listbox.test */, F966BC3808F27A3C005CB29B /* main.test */, @@ -2714,6 +2749,7 @@ F966BC7108F27A3D005CB29B /* Makefile.in */, F966BC7208F27A3D005CB29B /* README */, F966BC7308F27A3D005CB29B /* tcl.m4 */, + F974D57B0FBE7EC000BF728B /* tk.pc.in */, F966BC7408F27A3D005CB29B /* tk.spec */, F966BC7508F27A3D005CB29B /* tkAppInit.c */, F966BC7608F27A3D005CB29B /* tkConfig.h.in */, @@ -2849,6 +2885,7 @@ children = ( F9C9CBFF0E84059800E00935 /* ApplicationServices.framework */, F966C07408F2820D005CB29B /* CoreFoundation.framework */, + F96437E60EF0D652003F468E /* libz.dylib */, F966C07608F2821B005CB29B /* Carbon.framework */, F94523A10E6FC2AC00C1D987 /* Cocoa.framework */, F966C07808F28233005CB29B /* IOKit.framework */, @@ -2930,6 +2967,7 @@ F968884C0AF787B3000797B5 /* ttk.tcl */, F968884D0AF787B3000797B5 /* utils.tcl */, F968884E0AF787B3000797B5 /* winTheme.tcl */, + F973E5960EE99384001A648E /* vistaTheme.tcl */, F968884F0AF787B3000797B5 /* xpTheme.tcl */, ); path = ttk; @@ -2939,6 +2977,7 @@ isa = PBXGroup; children = ( F96888540AF7880C000797B5 /* all.tcl */, + F98383650F0FA43900171CA6 /* checkbutton.test */, F96888560AF7880C000797B5 /* combobox.test */, F96888570AF7880C000797B5 /* entry.test */, F96888580AF7880C000797B5 /* image.test */, @@ -2947,6 +2986,7 @@ F968885C0AF7880C000797B5 /* notebook.test */, F968885D0AF7880C000797B5 /* panedwindow.test */, F968885E0AF7880C000797B5 /* progressbar.test */, + F98383680F0FA44700171CA6 /* radiobutton.test */, F968885F0AF7880C000797B5 /* scrollbar.test */, F96888600AF7880C000797B5 /* treetags.test */, F96888610AF7880C000797B5 /* treeview.test */, @@ -2969,6 +3009,7 @@ F96D434408F272B5004A47F5 /* tests */, F96D3DFC08F272A4004A47F5 /* doc */, F96D43D008F272B8004A47F5 /* tools */, + F9183E690EFC81560030B814 /* pkgs */, F96D3DFA08F272A4004A47F5 /* ChangeLog */, F96D3DFB08F272A4004A47F5 /* changes */, F96D434308F272B5004A47F5 /* README */, @@ -3023,12 +3064,16 @@ F96D3E1108F272A5004A47F5 /* cd.n */, F96D3E1208F272A5004A47F5 /* chan.n */, F96D3E1308F272A5004A47F5 /* ChnlStack.3 */, + F93599CF0DF1F87F00E04F67 /* Class.3 */, + F93599D00DF1F89E00E04F67 /* class.n */, F96D3E1408F272A5004A47F5 /* clock.n */, F96D3E1508F272A5004A47F5 /* close.n */, F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */, F96D3E1708F272A5004A47F5 /* Concat.3 */, F96D3E1808F272A5004A47F5 /* concat.n */, F96D3E1908F272A5004A47F5 /* continue.n */, + F93599D20DF1F8DF00E04F67 /* copy.n */, + F974D5720FBE7DC600BF728B /* coroutine.n */, F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */, F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */, F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */, @@ -3041,6 +3086,7 @@ F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */, F96D3E2408F272A5004A47F5 /* CrtTrace.3 */, F96D3E2508F272A5004A47F5 /* dde.n */, + F93599D30DF1F8F500E04F67 /* define.n */, F96D3E2608F272A5004A47F5 /* DetachPids.3 */, F96D3E2708F272A5004A47F5 /* dict.n */, F96D3E2808F272A5004A47F5 /* DictObj.3 */, @@ -3118,11 +3164,15 @@ F96D3E7008F272A6004A47F5 /* man.macros */, F96D3E7108F272A6004A47F5 /* mathfunc.n */, F96D3E7208F272A6004A47F5 /* memory.n */, + F93599D40DF1F91900E04F67 /* Method.3 */, F96D3E7308F272A6004A47F5 /* msgcat.n */, + F93599D50DF1F93700E04F67 /* my.n */, F96D3E7408F272A6004A47F5 /* Namespace.3 */, F96D3E7508F272A6004A47F5 /* namespace.n */, + F93599D60DF1F95000E04F67 /* next.n */, F96D3E7608F272A6004A47F5 /* Notifier.3 */, F96D3E7708F272A6004A47F5 /* Object.3 */, + F93599D70DF1F96800E04F67 /* object.n */, F96D3E7808F272A6004A47F5 /* ObjectType.3 */, F96D3E7908F272A6004A47F5 /* open.n */, F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */, @@ -3156,6 +3206,7 @@ F96D3E9408F272A6004A47F5 /* SaveResult.3 */, F96D3E9508F272A6004A47F5 /* scan.n */, F96D3E9608F272A6004A47F5 /* seek.n */, + F93599D80DF1F98300E04F67 /* self.n */, F96D3E9708F272A6004A47F5 /* set.n */, F96D3E9808F272A6004A47F5 /* SetChanErr.3 */, F96D3E9908F272A6004A47F5 /* SetErrno.3 */, @@ -3178,7 +3229,9 @@ F96D3EAA08F272A7004A47F5 /* subst.n */, F96D3EAB08F272A7004A47F5 /* SubstObj.3 */, F96D3EAC08F272A7004A47F5 /* switch.n */, + F974D5760FBE7E1900BF728B /* tailcall.n */, F96D3EAD08F272A7004A47F5 /* Tcl.n */, + F99D61180EF5573A00BBFE01 /* TclZlib.3 */, F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */, F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */, F96D3EB008F272A7004A47F5 /* tclsh.1 */, @@ -3186,6 +3239,7 @@ F96D3EB208F272A7004A47F5 /* tclvars.n */, F96D3EB308F272A7004A47F5 /* tell.n */, F96D3EB408F272A7004A47F5 /* Thread.3 */, + F9183E640EFC80CD0030B814 /* throw.n */, F96D3EB508F272A7004A47F5 /* time.n */, F96D3EB608F272A7004A47F5 /* tm.n */, F96D3EB708F272A7004A47F5 /* ToUpper.3 */, @@ -3193,6 +3247,7 @@ F96D3EB908F272A7004A47F5 /* TraceCmd.3 */, F96D3EBA08F272A7004A47F5 /* TraceVar.3 */, F96D3EBB08F272A7004A47F5 /* Translate.3 */, + F9183E650EFC80D70030B814 /* try.n */, F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */, F96D3EBD08F272A7004A47F5 /* unknown.n */, F96D3EBE08F272A7004A47F5 /* unload.n */, @@ -3206,6 +3261,7 @@ F96D3EC608F272A7004A47F5 /* vwait.n */, F96D3EC708F272A7004A47F5 /* while.n */, F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */, + F915432D0EF201EE0032D1E8 /* zlib.n */, ); path = doc; sourceTree = "<group>"; @@ -3271,6 +3327,7 @@ F96D3F0008F272A7004A47F5 /* tclIOCmd.c */, F96D3F0108F272A7004A47F5 /* tclIOGT.c */, F96D3F0208F272A7004A47F5 /* tclIORChan.c */, + F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */, F96D3F0308F272A7004A47F5 /* tclIOSock.c */, F96D3F0408F272A7004A47F5 /* tclIOUtil.c */, F96D3F0508F272A7004A47F5 /* tclLink.c */, @@ -3282,6 +3339,19 @@ F96D3F0B08F272A7004A47F5 /* tclNamesp.c */, F96D3F0C08F272A7004A47F5 /* tclNotify.c */, F96D3F0D08F272A7004A47F5 /* tclObj.c */, + F93599B20DF1F75400E04F67 /* tclOO.c */, + F93599B40DF1F75900E04F67 /* tclOO.decls */, + F93599B50DF1F75D00E04F67 /* tclOO.h */, + F93599B60DF1F76100E04F67 /* tclOOBasic.c */, + F93599B80DF1F76600E04F67 /* tclOOCall.c */, + F93599BA0DF1F76A00E04F67 /* tclOODecls.h */, + F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */, + F93599BD0DF1F77400E04F67 /* tclOOInfo.c */, + F93599BF0DF1F77900E04F67 /* tclOOInt.h */, + F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, + F93599C10DF1F78300E04F67 /* tclOOMethod.c */, + F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, + F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, @@ -3320,6 +3390,7 @@ F96D3F3408F272A7004A47F5 /* tclUtf.c */, F96D3F3508F272A7004A47F5 /* tclUtil.c */, F96D3F3608F272A7004A47F5 /* tclVar.c */, + F96437C90EF0D4B2003F468E /* tclZlib.c */, F96D3F3708F272A7004A47F5 /* tommath.h */, ); path = generic; @@ -3414,18 +3485,10 @@ F96D425C08F272B2004A47F5 /* libtommath */ = { isa = PBXGroup; children = ( - F96D425F08F272B3004A47F5 /* bn.pdf */, - F96D426108F272B3004A47F5 /* bn_error.c */, - F96D426208F272B3004A47F5 /* bn_fast_mp_invmod.c */, - F96D426308F272B3004A47F5 /* bn_fast_mp_montgomery_reduce.c */, F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */, - F96D426508F272B3004A47F5 /* bn_fast_s_mp_mul_high_digs.c */, F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */, - F96D426708F272B3004A47F5 /* bn_mp_2expt.c */, - F96D426808F272B3004A47F5 /* bn_mp_abs.c */, F96D426908F272B3004A47F5 /* bn_mp_add.c */, F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */, - F96D426B08F272B3004A47F5 /* bn_mp_addmod.c */, F96D426C08F272B3004A47F5 /* bn_mp_and.c */, F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */, F96D426E08F272B3004A47F5 /* bn_mp_clear.c */, @@ -3433,7 +3496,6 @@ F96D427008F272B3004A47F5 /* bn_mp_cmp.c */, F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */, F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */, - F96D427308F272B3004A47F5 /* bn_mp_cnt_lsb.c */, F96D427408F272B3004A47F5 /* bn_mp_copy.c */, F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */, F96D427608F272B3004A47F5 /* bn_mp_div.c */, @@ -3441,104 +3503,49 @@ F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */, F96D427908F272B3004A47F5 /* bn_mp_div_3.c */, F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */, - F96D427B08F272B3004A47F5 /* bn_mp_dr_is_modulus.c */, - F96D427C08F272B3004A47F5 /* bn_mp_dr_reduce.c */, - F96D427D08F272B3004A47F5 /* bn_mp_dr_setup.c */, F96D427E08F272B3004A47F5 /* bn_mp_exch.c */, F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */, - F96D428008F272B3004A47F5 /* bn_mp_exptmod.c */, - F96D428108F272B3004A47F5 /* bn_mp_exptmod_fast.c */, - F96D428208F272B3004A47F5 /* bn_mp_exteuclid.c */, - F96D428308F272B3004A47F5 /* bn_mp_fread.c */, - F96D428408F272B3004A47F5 /* bn_mp_fwrite.c */, - F96D428508F272B3004A47F5 /* bn_mp_gcd.c */, - F96D428608F272B3004A47F5 /* bn_mp_get_int.c */, F96D428708F272B3004A47F5 /* bn_mp_grow.c */, F96D428808F272B3004A47F5 /* bn_mp_init.c */, F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */, F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */, F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */, - F96D428C08F272B3004A47F5 /* bn_mp_init_set_int.c */, F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */, - F96D428E08F272B3004A47F5 /* bn_mp_invmod.c */, - F96D428F08F272B3004A47F5 /* bn_mp_invmod_slow.c */, - F96D429008F272B3004A47F5 /* bn_mp_is_square.c */, - F96D429108F272B3004A47F5 /* bn_mp_jacobi.c */, F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */, F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */, - F96D429408F272B3004A47F5 /* bn_mp_lcm.c */, F96D429508F272B3004A47F5 /* bn_mp_lshd.c */, F96D429608F272B3004A47F5 /* bn_mp_mod.c */, F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */, - F96D429808F272B3004A47F5 /* bn_mp_mod_d.c */, - F96D429908F272B3004A47F5 /* bn_mp_montgomery_calc_normalization.c */, - F96D429A08F272B3004A47F5 /* bn_mp_montgomery_reduce.c */, - F96D429B08F272B3004A47F5 /* bn_mp_montgomery_setup.c */, F96D429C08F272B3004A47F5 /* bn_mp_mul.c */, F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */, F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */, F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */, - F96D42A008F272B3004A47F5 /* bn_mp_mulmod.c */, - F96D42A108F272B3004A47F5 /* bn_mp_n_root.c */, F96D42A208F272B3004A47F5 /* bn_mp_neg.c */, F96D42A308F272B3004A47F5 /* bn_mp_or.c */, - F96D42A408F272B3004A47F5 /* bn_mp_prime_fermat.c */, - F96D42A508F272B3004A47F5 /* bn_mp_prime_is_divisible.c */, - F96D42A608F272B3004A47F5 /* bn_mp_prime_is_prime.c */, - F96D42A708F272B3004A47F5 /* bn_mp_prime_miller_rabin.c */, - F96D42A808F272B3004A47F5 /* bn_mp_prime_next_prime.c */, - F96D42A908F272B3004A47F5 /* bn_mp_prime_rabin_miller_trials.c */, - F96D42AA08F272B3004A47F5 /* bn_mp_prime_random_ex.c */, F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */, F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */, - F96D42AD08F272B3004A47F5 /* bn_mp_rand.c */, F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */, - F96D42AF08F272B3004A47F5 /* bn_mp_read_signed_bin.c */, - F96D42B008F272B3004A47F5 /* bn_mp_read_unsigned_bin.c */, - F96D42B108F272B3004A47F5 /* bn_mp_reduce.c */, - F96D42B208F272B3004A47F5 /* bn_mp_reduce_2k.c */, - F96D42B308F272B3004A47F5 /* bn_mp_reduce_2k_l.c */, - F96D42B408F272B3004A47F5 /* bn_mp_reduce_2k_setup.c */, - F96D42B508F272B3004A47F5 /* bn_mp_reduce_2k_setup_l.c */, - F96D42B608F272B3004A47F5 /* bn_mp_reduce_is_2k.c */, - F96D42B708F272B3004A47F5 /* bn_mp_reduce_is_2k_l.c */, - F96D42B808F272B3004A47F5 /* bn_mp_reduce_setup.c */, F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */, F96D42BA08F272B3004A47F5 /* bn_mp_set.c */, - F96D42BB08F272B3004A47F5 /* bn_mp_set_int.c */, F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */, - F96D42BD08F272B3004A47F5 /* bn_mp_signed_bin_size.c */, F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */, - F96D42BF08F272B3004A47F5 /* bn_mp_sqrmod.c */, F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */, F96D42C108F272B3004A47F5 /* bn_mp_sub.c */, F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */, - F96D42C308F272B3004A47F5 /* bn_mp_submod.c */, - F96D42C408F272B3004A47F5 /* bn_mp_to_signed_bin.c */, - F96D42C508F272B3004A47F5 /* bn_mp_to_signed_bin_n.c */, F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */, F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */, F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */, F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */, - F96D42CA08F272B3004A47F5 /* bn_mp_toradix.c */, F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */, F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */, F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */, F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */, - F96D42CF08F272B3004A47F5 /* bn_prime_tab.c */, F96D42D008F272B3004A47F5 /* bn_reverse.c */, F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */, - F96D42D208F272B3004A47F5 /* bn_s_mp_exptmod.c */, F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */, - F96D42D408F272B3004A47F5 /* bn_s_mp_mul_high_digs.c */, F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */, F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */, F96D42D708F272B3004A47F5 /* bncore.c */, - F96D42D908F272B3004A47F5 /* callgraph.txt */, - F96D42DA08F272B3004A47F5 /* changes.txt */, - F96D42F008F272B3004A47F5 /* LICENSE */, - F96D431D08F272B4004A47F5 /* poster.pdf */, - F96D432608F272B4004A47F5 /* tommath.pdf */, F96D432908F272B4004A47F5 /* tommath_class.h */, F96D432A08F272B4004A47F5 /* tommath_superclass.h */, ); @@ -3585,6 +3592,7 @@ F96D435608F272B5004A47F5 /* compile.test */, F96D435708F272B5004A47F5 /* concat.test */, F96D435808F272B5004A47F5 /* config.test */, + F974D5770FBE7E6100BF728B /* coroutine.test */, F96D435908F272B5004A47F5 /* dcall.test */, F96D435A08F272B5004A47F5 /* dict.test */, F96D435C08F272B5004A47F5 /* dstring.test */, @@ -3607,7 +3615,9 @@ F96D436E08F272B6004A47F5 /* get.test */, F96D436F08F272B6004A47F5 /* history.test */, F96D437008F272B6004A47F5 /* http.test */, + F974D56C0FBE7D6300BF728B /* http11.test */, F96D437108F272B6004A47F5 /* httpd */, + F974D56D0FBE7D6300BF728B /* httpd11.tcl */, F96D437208F272B6004A47F5 /* httpold.test */, F96D437308F272B6004A47F5 /* if-old.test */, F96D437408F272B6004A47F5 /* if.test */, @@ -3620,7 +3630,6 @@ F96D437B08F272B6004A47F5 /* io.test */, F96D437C08F272B6004A47F5 /* ioCmd.test */, F96D437D08F272B6004A47F5 /* iogt.test */, - F96D437E08F272B6004A47F5 /* ioUtil.test */, F96D437F08F272B6004A47F5 /* join.test */, F96D438008F272B6004A47F5 /* lindex.test */, F96D438108F272B6004A47F5 /* link.test */, @@ -3644,7 +3653,9 @@ F96D439108F272B6004A47F5 /* namespace-old.test */, F96D439208F272B7004A47F5 /* namespace.test */, F96D439308F272B7004A47F5 /* notify.test */, + F91DC23C0E44C51B002CB8D1 /* nre.test */, F96D439408F272B7004A47F5 /* obj.test */, + F93599C80DF1F81900E04F67 /* oo.test */, F96D439508F272B7004A47F5 /* opt.test */, F96D439608F272B7004A47F5 /* package.test */, F96D439708F272B7004A47F5 /* parse.test */, @@ -3679,6 +3690,7 @@ F96D43B408F272B7004A47F5 /* stringObj.test */, F96D43B508F272B7004A47F5 /* subst.test */, F96D43B608F272B7004A47F5 /* switch.test */, + F974D5780FBE7E6100BF728B /* tailcall.test */, F96D43B708F272B7004A47F5 /* tcltest.test */, F96D43B808F272B7004A47F5 /* thread.test */, F96D43B908F272B7004A47F5 /* timer.test */, @@ -3704,6 +3716,7 @@ F96D43CD08F272B7004A47F5 /* winNotify.test */, F96D43CE08F272B7004A47F5 /* winPipe.test */, F96D43CF08F272B7004A47F5 /* winTime.test */, + F915432A0EF201CF0032D1E8 /* zlib.test */, ); path = tests; sourceTree = "<group>"; @@ -3714,6 +3727,7 @@ F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, F96D43D208F272B8004A47F5 /* configure */, F96D43D308F272B8004A47F5 /* configure.in */, + F96D442208F272B8004A47F5 /* eolFix.tcl */, F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */, F96D442508F272B8004A47F5 /* genStubs.tcl */, F96D442708F272B8004A47F5 /* index.tcl */, @@ -3729,12 +3743,11 @@ F96D443108F272B8004A47F5 /* man2tcl.c */, F96D443208F272B8004A47F5 /* README */, F96D443308F272B8004A47F5 /* regexpTestLib.tcl */, - F96D443408F272B8004A47F5 /* str2c */, F96D443508F272B8004A47F5 /* tcl.hpj.in */, F96D443608F272B8004A47F5 /* tcl.wse.in */, - F96D443708F272B9004A47F5 /* tclmin.wse */, F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */, F96D443A08F272B9004A47F5 /* tclZIC.tcl */, + F92D7F100DE777240033A13A /* tsdPerf.tcl */, F96D443B08F272B9004A47F5 /* uniClass.tcl */, F96D443C08F272B9004A47F5 /* uniParse.tcl */, ); @@ -3754,6 +3767,7 @@ F96D445008F272B9004A47F5 /* Makefile.in */, F96D445208F272B9004A47F5 /* README */, F96D445308F272B9004A47F5 /* tcl.m4 */, + F974D5790FBE7E9C00BF728B /* tcl.pc.in */, F96D445408F272B9004A47F5 /* tcl.spec */, F96D445508F272B9004A47F5 /* tclAppInit.c */, F96D445608F272B9004A47F5 /* tclConfig.h.in */, @@ -3864,8 +3878,8 @@ isa = PBXNativeTarget; buildConfigurationList = F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tktest" */; buildPhases = ( - F9A5C5F508F651A2008AE941 /* ShellScript */, - F9A5C5F608F651AB008AE941 /* ShellScript */, + F9A5C5F508F651A2008AE941 /* Configure Tcl */, + F9A5C5F608F651AB008AE941 /* Configure Tk */, 8DD76FAB0486AB0100D96B5E /* Sources */, 8DD76FAD0486AB0100D96B5E /* Frameworks */, ); @@ -3883,8 +3897,8 @@ isa = PBXNativeTarget; buildConfigurationList = F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tktest-X11" */; buildPhases = ( - F9FD30B40CC1AD070073837D /* ShellScript */, - F9FD30B50CC1AD070073837D /* ShellScript */, + F9FD30B40CC1AD070073837D /* Configure Tcl */, + F9FD30B50CC1AD070073837D /* Configure Tk */, F9FD30BB0CC1AD070073837D /* Sources */, F9FD31E30CC1AD070073837D /* Frameworks */, ); @@ -3902,7 +3916,7 @@ isa = PBXNativeTarget; buildConfigurationList = F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tk" */; buildPhases = ( - F97AF02F0B665DA900310EA2 /* ShellScript */, + F97AF02F0B665DA900310EA2 /* Build Tk */, ); buildRules = ( ); @@ -3921,10 +3935,10 @@ attributes = { BuildIndependentTargetsInParallel = YES; }; - buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Wish" */; + buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tk" */; compatibilityVersion = "Xcode 3.1"; hasScannedForEncodings = 1; - mainGroup = 08FB7794FE84155DC02AAC07 /* Wish */; + mainGroup = 08FB7794FE84155DC02AAC07 /* Tk */; projectDirPath = ""; projectRoot = ..; targets = ( @@ -3936,7 +3950,7 @@ /* End PBXProject section */ /* Begin PBXShellScriptBuildPhase section */ - F97AF02F0B665DA900310EA2 /* ShellScript */ = { + F97AF02F0B665DA900310EA2 /* Build Tk */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -3944,15 +3958,16 @@ inputPaths = ( "${TARGET_TEMP_DIR}/.none", ); + name = "Build Tk"; outputPaths = ( "${TARGET_BUILD_DIR}/${WRAPPER_NAME}", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "gnumake -C \"${TK_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" APPLICATION_INSTALL_PATH=\"${APPLICATION_INSTALL_PATH}\" TCL_BUILD_DIR=\"${TCL_BUILD_DIR}\" TCL_FRAMEWORK_DIR=\"${TCL_FRAMEWORK_DIR}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${BUILT_PRODUCTS_DIR}/tktest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tktest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n"; + shellScript = "export CC=$(xcrun -find ${GCC} || echo ${GCC}); export LD=${CC}\ngnumake -C \"${TK_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" APPLICATION_INSTALL_PATH=\"${APPLICATION_INSTALL_PATH}\" TCL_BUILD_DIR=\"${TCL_BUILD_DIR}\" TCL_FRAMEWORK_DIR=\"${TCL_FRAMEWORK_DIR}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${BUILT_PRODUCTS_DIR}/tktest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tktest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n"; showEnvVarsInLog = 0; }; - F9A5C5F508F651A2008AE941 /* ShellScript */ = { + F9A5C5F508F651A2008AE941 /* Configure Tcl */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -3966,15 +3981,16 @@ "$(TCL_SRCROOT)/unix/Makefile.in", "$(TCL_SRCROOT)/unix/dltest/Makefile.in", ); + name = "Configure Tcl"; outputPaths = ( "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; + shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; showEnvVarsInLog = 0; }; - F9A5C5F608F651AB008AE941 /* ShellScript */ = { + F9A5C5F608F651AB008AE941 /* Configure Tk */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -3986,15 +4002,16 @@ "$(TK_SRCROOT)/unix/aclocal.m4", "$(TK_SRCROOT)/unix/tkConfig.sh.in", ); + name = "Configure Tk"; outputPaths = ( "$(DERIVED_FILE_DIR)/tk/tkConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "## tk configure shell script phase\n\ncd \"${TK_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tk/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tk && cd tk &&\nif [ \"${TK_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tk\"\n \"${TK_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --enable-aqua --with-tcl=../tcl ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi"; + shellScript = "## tk configure shell script phase\n\ncd \"${TK_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tk/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tk && cd tk &&\nif [ \"${TK_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tk\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TK_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --enable-aqua --with-tcl=../tcl CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; showEnvVarsInLog = 0; }; - F9FD30B40CC1AD070073837D /* ShellScript */ = { + F9FD30B40CC1AD070073837D /* Configure Tcl */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -4008,15 +4025,16 @@ "$(TCL_SRCROOT)/unix/Makefile.in", "$(TCL_SRCROOT)/unix/dltest/Makefile.in", ); + name = "Configure Tcl"; outputPaths = ( "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --disable-corefoundation ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; + shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; showEnvVarsInLog = 0; }; - F9FD30B50CC1AD070073837D /* ShellScript */ = { + F9FD30B50CC1AD070073837D /* Configure Tk */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -4028,12 +4046,13 @@ "$(TK_SRCROOT)/unix/aclocal.m4", "$(TK_SRCROOT)/unix/tkConfig.sh.in", ); + name = "Configure Tk"; outputPaths = ( "$(DERIVED_FILE_DIR)/tk/tkConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "## tk configure shell script phase\n\ncd \"${TK_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tk/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tk && cd tk &&\nif [ \"${TK_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tk\"\n PATH=\"${PATH}:/usr/X11R6/bin\" \"${TK_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --disable-corefoundation --enable-xft --with-tcl=../tcl ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi"; + shellScript = "## tk configure shell script phase\n\ncd \"${TK_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tk/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tk && cd tk &&\nif [ \"${TK_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tk\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n PATH=\"${PATH}:/usr/X11R6/bin\" \"${TK_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --enable-xft --with-tcl=../tcl CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi"; showEnvVarsInLog = 0; }; /* End PBXShellScriptBuildPhase section */ @@ -4077,6 +4096,7 @@ F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */, F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */, F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */, + F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */, F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */, F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */, F96D45A408F272BC004A47F5 /* tclLink.c in Sources */, @@ -4087,6 +4107,14 @@ F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */, F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */, F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */, + F93599B30DF1F75400E04F67 /* tclOO.c in Sources */, + F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */, + F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */, + F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */, + F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, + F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, + F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, + F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, @@ -4114,6 +4142,7 @@ F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */, F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */, F96D45D508F272BC004A47F5 /* tclVar.c in Sources */, + F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */, F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */, F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */, F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */, @@ -4196,6 +4225,7 @@ F966BDD208F27A3F005CB29B /* tkAtom.c in Sources */, F966BDD308F27A3F005CB29B /* tkBind.c in Sources */, F966BDD408F27A3F005CB29B /* tkBitmap.c in Sources */, + F9152B090EAF8A5000CD5C7B /* tkBusy.c in Sources */, F966BDD508F27A3F005CB29B /* tkButton.c in Sources */, F966BDD708F27A3F005CB29B /* tkCanvArc.c in Sources */, F966BDD808F27A3F005CB29B /* tkCanvas.c in Sources */, @@ -4228,7 +4258,9 @@ F966BDFA08F27A3F005CB29B /* tkImage.c in Sources */, F966BDFB08F27A3F005CB29B /* tkImgBmap.c in Sources */, F966BDFC08F27A3F005CB29B /* tkImgGIF.c in Sources */, + F92EE8BF0E62F846001A6E80 /* tkImgPhInstance.c in Sources */, F966BDFD08F27A3F005CB29B /* tkImgPhoto.c in Sources */, + F9DD99BD0F07DF850018B2E4 /* tkImgPNG.c in Sources */, F966BDFE08F27A3F005CB29B /* tkImgPPM.c in Sources */, F966BE0708F27A3F005CB29B /* tkListbox.c in Sources */, F966BE0808F27A3F005CB29B /* tkMacWinMenu.c in Sources */, @@ -4378,6 +4410,7 @@ F9FD30DB0CC1AD070073837D /* tclIOCmd.c in Sources */, F9FD30DC0CC1AD070073837D /* tclIOGT.c in Sources */, F9FD30DD0CC1AD070073837D /* tclIORChan.c in Sources */, + F9FFAF1D0DFDDB26007F8A6A /* tclIORTrans.c in Sources */, F9FD30DE0CC1AD070073837D /* tclIOSock.c in Sources */, F9FD30DF0CC1AD070073837D /* tclIOUtil.c in Sources */, F9FD30E00CC1AD070073837D /* tclLink.c in Sources */, @@ -4388,6 +4421,14 @@ F9FD30E50CC1AD070073837D /* tclNamesp.c in Sources */, F9FD30E60CC1AD070073837D /* tclNotify.c in Sources */, F9FD30E70CC1AD070073837D /* tclObj.c in Sources */, + F9FFAF1F0DFDDB2F007F8A6A /* tclOO.c in Sources */, + F9FFAF200DFDDB32007F8A6A /* tclOOBasic.c in Sources */, + F9FFAF210DFDDB32007F8A6A /* tclOOCall.c in Sources */, + F9FFAF220DFDDB34007F8A6A /* tclOODefineCmds.c in Sources */, + F9FFAF230DFDDB35007F8A6A /* tclOOInfo.c in Sources */, + F9FFAF240DFDDB36007F8A6A /* tclOOMethod.c in Sources */, + F9FFAF250DFDDB37007F8A6A /* tclOOStubInit.c in Sources */, + F9FFAF260DFDDB38007F8A6A /* tclOOStubLib.c in Sources */, F9FD30E80CC1AD070073837D /* tclPanic.c in Sources */, F9FD30E90CC1AD070073837D /* tclParse.c in Sources */, F9FD30EA0CC1AD070073837D /* tclPathObj.c in Sources */, @@ -4415,6 +4456,7 @@ F9FD31000CC1AD070073837D /* tclUtf.c in Sources */, F9FD31010CC1AD070073837D /* tclUtil.c in Sources */, F9FD31020CC1AD070073837D /* tclVar.c in Sources */, + F96437CB0EF0D4B2003F468E /* tclZlib.c in Sources */, F9FD31030CC1AD070073837D /* bn_fast_s_mp_mul_digs.c in Sources */, F9FD31040CC1AD070073837D /* bn_fast_s_mp_sqr.c in Sources */, F9FD31050CC1AD070073837D /* bn_mp_add.c in Sources */, @@ -4497,6 +4539,7 @@ F9FD31510CC1AD070073837D /* tkAtom.c in Sources */, F9FD31520CC1AD070073837D /* tkBind.c in Sources */, F9FD31530CC1AD070073837D /* tkBitmap.c in Sources */, + F9152B0A0EAF8A5700CD5C7B /* tkBusy.c in Sources */, F9FD31540CC1AD070073837D /* tkButton.c in Sources */, F9FD31550CC1AD070073837D /* tkCanvArc.c in Sources */, F9FD31560CC1AD070073837D /* tkCanvas.c in Sources */, @@ -4529,7 +4572,9 @@ F9FD31710CC1AD070073837D /* tkImage.c in Sources */, F9FD31720CC1AD070073837D /* tkImgBmap.c in Sources */, F9FD31730CC1AD070073837D /* tkImgGIF.c in Sources */, + F92EE8D30E62F939001A6E80 /* tkImgPhInstance.c in Sources */, F9FD31740CC1AD070073837D /* tkImgPhoto.c in Sources */, + F9DD99BE0F07DF850018B2E4 /* tkImgPNG.c in Sources */, F9FD31750CC1AD070073837D /* tkImgPPM.c in Sources */, F9FD31760CC1AD070073837D /* tkListbox.c in Sources */, F9FD31770CC1AD070073837D /* tkMacWinMenu.c in Sources */, @@ -4627,59 +4672,51 @@ /* End PBXSourcesBuildPhase section */ /* Begin XCBuildConfiguration section */ - F90E36D50F3B5C8400810A10 /* Debug gcc42 nogc */ = { + F90E36D50F3B5C8400810A10 /* DebugNoGC */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = unsupported; GCC_ENABLE_PASCAL_STRINGS = NO; GCC_INPUT_FILETYPE = sourcecode.c.objc; - GCC_VERSION = 4.2; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; - name = "Debug gcc42 nogc"; + name = DebugNoGC; }; - F90E36D60F3B5C8400810A10 /* Debug gcc42 nogc */ = { + F90E36D60F3B5C8400810A10 /* DebugNoGC */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "Debug gcc42 nogc"; + name = DebugNoGC; }; - F90E36D70F3B5C8400810A10 /* Debug gcc42 nogc */ = { + F90E36D70F3B5C8400810A10 /* DebugNoGC */ = { isa = XCBuildConfiguration; buildSettings = { - CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; - GCC_DYNAMIC_NO_PIC = NO; - GCC_ENABLE_FIX_AND_CONTINUE = YES; - GCC_PREPROCESSOR_DEFINITIONS = ( - "__private_extern__=extern", - "$(GCC_PREPROCESSOR_DEFINITIONS)", - ); - GCC_SYMBOLS_PRIVATE_EXTERN = NO; OTHER_LDFLAGS = ( "$(OTHER_LDFLAGS_AQUA)", "$(OTHER_LDFLAGS)", ); PRODUCT_NAME = tktest; }; - name = "Debug gcc42 nogc"; + name = DebugNoGC; }; - F90E36D80F3B5C8400810A10 /* Debug gcc42 nogc */ = { + F90E36D80F3B5C8400810A10 /* DebugNoGC */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_INPUT_FILETYPE = sourcecode.c.c; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", @@ -4696,7 +4733,7 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "Debug gcc42 nogc"; + name = DebugNoGC; }; F91BCC4F093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; @@ -4719,7 +4756,7 @@ }; F91BCC51093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; @@ -4754,6 +4791,7 @@ F93084390BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -4769,11 +4807,11 @@ }; F930843A0BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --enable-symbols=all"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; @@ -4789,11 +4827,11 @@ }; F9359B250DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; @@ -4834,6 +4872,7 @@ F9359B280DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -4863,13 +4902,13 @@ }; name = Release; }; - F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */ = { + F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = DebugNoFixZL; + name = DebugNoFixAndContinue; }; F95CC8B109158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; @@ -4901,7 +4940,7 @@ }; name = Release; }; - F95CC8B309158F3100EA5ACE /* DebugNoFixZL */ = { + F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_LDFLAGS = ( @@ -4910,15 +4949,15 @@ ); PRODUCT_NAME = tktest; }; - name = DebugNoFixZL; + name = DebugNoFixAndContinue; }; F95CC8B609158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; @@ -4933,25 +4972,30 @@ }; F95CC8B709158F3100EA5ACE /* Release */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { - ARCHS = "$(NATIVE_ARCH_32_BIT)"; + ARCHS = ( + "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", + ); + CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; GCC_INPUT_FILETYPE = sourcecode.c.objc; MACOSX_DEPLOYMENT_TARGET = 10.5; + ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = Release; }; - F95CC8B809158F3100EA5ACE /* DebugNoFixZL */ = { + F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; @@ -4962,7 +5006,7 @@ ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; - name = DebugNoFixZL; + name = DebugNoFixAndContinue; }; F97258A90A86873D00096C78 /* Debug */ = { isa = XCBuildConfiguration; @@ -4970,6 +5014,7 @@ CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_INPUT_FILETYPE = sourcecode.c.c; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", @@ -4991,6 +5036,7 @@ F97258AA0A86873D00096C78 /* Release */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5004,9 +5050,10 @@ }; name = Release; }; - F97258AB0A86873D00096C78 /* DebugNoFixZL */ = { + F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5018,13 +5065,14 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = DebugNoFixZL; + name = DebugNoFixAndContinue; }; F97258AC0A86873D00096C78 /* ReleaseUniversal */ = { isa = XCBuildConfiguration; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5060,6 +5108,7 @@ F97AED1D0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5075,7 +5124,7 @@ }; F97AED1E0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = "$(NATIVE_ARCH_64_BIT)"; CONFIGURE_ARGS = "--enable-64bit $(CONFIGURE_ARGS)"; @@ -5091,11 +5140,11 @@ }; F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; @@ -5133,6 +5182,7 @@ F98751320DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5148,11 +5198,11 @@ }; F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; @@ -5190,6 +5240,7 @@ F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5203,35 +5254,35 @@ }; name = DebugNoCFUnthreaded; }; - F9988AB10D814C6500B6B03B /* Debug gcc42 */ = { + F9988AB10D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; GCC_INPUT_FILETYPE = sourcecode.c.objc; - GCC_VERSION = 4.2; + GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.5; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; - name = "Debug gcc42"; + name = "Debug gcc40"; }; - F9988AB20D814C6500B6B03B /* Debug gcc42 */ = { + F9988AB20D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "Debug gcc42"; + name = "Debug gcc40"; }; - F9988AB30D814C6500B6B03B /* Debug gcc42 */ = { + F9988AB30D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; @@ -5248,14 +5299,15 @@ ); PRODUCT_NAME = tktest; }; - name = "Debug gcc42"; + name = "Debug gcc40"; }; - F9988AB40D814C6500B6B03B /* Debug gcc42 */ = { + F9988AB40D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_INPUT_FILETYPE = sourcecode.c.c; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", @@ -5272,18 +5324,18 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "Debug gcc42"; + name = "Debug gcc40"; }; - F9988AB50D814C7500B6B03B /* Debug llvmgcc42 */ = { + F9988AB50D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); - CC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc-4.2"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; + GCC = "llvm-gcc"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; @@ -5293,17 +5345,17 @@ ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; - name = "Debug llvmgcc42"; + name = "Debug llvm-gcc"; }; - F9988AB60D814C7500B6B03B /* Debug llvmgcc42 */ = { + F9988AB60D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "Debug llvmgcc42"; + name = "Debug llvm-gcc"; }; - F9988AB70D814C7500B6B03B /* Debug llvmgcc42 */ = { + F9988AB70D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; @@ -5320,14 +5372,15 @@ ); PRODUCT_NAME = tktest; }; - name = "Debug llvmgcc42"; + name = "Debug llvm-gcc"; }; - F9988AB80D814C7500B6B03B /* Debug llvmgcc42 */ = { + F9988AB80D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_INPUT_FILETYPE = sourcecode.c.c; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", @@ -5344,11 +5397,11 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "Debug llvmgcc42"; + name = "Debug llvm-gcc"; }; - F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc42 */ = { + F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; @@ -5356,21 +5409,21 @@ GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; GCC_INPUT_FILETYPE = sourcecode.c.objc; - GCC_VERSION = 4.2; + GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; }; - name = "ReleaseUniversal gcc42"; + name = "ReleaseUniversal gcc40"; }; - F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc42 */ = { + F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "ReleaseUniversal gcc42"; + name = "ReleaseUniversal gcc40"; }; - F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc42 */ = { + F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_LDFLAGS = ( @@ -5379,13 +5432,14 @@ ); PRODUCT_NAME = tktest; }; - name = "ReleaseUniversal gcc42"; + name = "ReleaseUniversal gcc40"; }; - F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc42 */ = { + F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5397,16 +5451,16 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "ReleaseUniversal gcc42"; + name = "ReleaseUniversal gcc40"; }; - F9988BB50D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = { + F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; - CC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc-4.2"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; DEBUG_INFORMATION_FORMAT = dwarf; + GCC = "llvm-gcc"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; @@ -5415,19 +5469,18 @@ GCC_VERSION = com.apple.compilers.llvmgcc42; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; - TCL_CONFIGURE_ARGS = "$(TCL_CONFIGURE_ARGS) --disable-dtrace"; }; - name = "ReleaseUniversal llvmgcc42"; + name = "ReleaseUniversal llvm-gcc"; }; - F9988BB60D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = { + F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "ReleaseUniversal llvmgcc42"; + name = "ReleaseUniversal llvm-gcc"; }; - F9988BB70D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = { + F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_LDFLAGS = ( @@ -5436,13 +5489,14 @@ ); PRODUCT_NAME = tktest; }; - name = "ReleaseUniversal llvmgcc42"; + name = "ReleaseUniversal llvm-gcc"; }; - F9988BB80D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = { + F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5454,7 +5508,7 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "ReleaseUniversal llvmgcc42"; + name = "ReleaseUniversal llvm-gcc"; }; F99EE73B0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; @@ -5497,6 +5551,7 @@ F99EE73F0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5513,6 +5568,7 @@ F99EE7400BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5528,11 +5584,11 @@ }; F99EE7410BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; @@ -5548,11 +5604,11 @@ }; F99EE7420BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; @@ -5593,6 +5649,7 @@ buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5608,7 +5665,7 @@ }; F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; @@ -5630,10 +5687,10 @@ isa = XCConfigurationList; buildConfigurations = ( F95CC8AC09158F3100EA5ACE /* Debug */, - F9988AB20D814C6500B6B03B /* Debug gcc42 */, - F90E36D60F3B5C8400810A10 /* Debug gcc42 nogc */, - F9988AB60D814C7500B6B03B /* Debug llvmgcc42 */, - F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */, + F9988AB60D814C7500B6B03B /* Debug llvm-gcc */, + F9988AB20D814C6500B6B03B /* Debug gcc40 */, + F90E36D60F3B5C8400810A10 /* DebugNoGC */, + F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE73B0BE835310060D4AF /* DebugUnthreaded */, F98751300DE7B57E00B1C9EC /* DebugNoCF */, F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, @@ -5643,8 +5700,8 @@ F97AED1B0B660B2100310EA2 /* Debug64bit */, F95CC8AD09158F3100EA5ACE /* Release */, F91BCC4F093152310042A6BF /* ReleaseUniversal */, - F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc42 */, - F9988BB60D81587400B6B03B /* ReleaseUniversal llvmgcc42 */, + F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */, + F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; @@ -5654,10 +5711,10 @@ isa = XCConfigurationList; buildConfigurations = ( F95CC8B109158F3100EA5ACE /* Debug */, - F9988AB30D814C6500B6B03B /* Debug gcc42 */, - F90E36D70F3B5C8400810A10 /* Debug gcc42 nogc */, - F9988AB70D814C7500B6B03B /* Debug llvmgcc42 */, - F95CC8B309158F3100EA5ACE /* DebugNoFixZL */, + F9988AB70D814C7500B6B03B /* Debug llvm-gcc */, + F9988AB30D814C6500B6B03B /* Debug gcc40 */, + F90E36D70F3B5C8400810A10 /* DebugNoGC */, + F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE73D0BE835310060D4AF /* DebugUnthreaded */, F98751310DE7B57E00B1C9EC /* DebugNoCF */, F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, @@ -5667,21 +5724,21 @@ F97AED1C0B660B2100310EA2 /* Debug64bit */, F95CC8B209158F3100EA5ACE /* Release */, F91BCC50093152310042A6BF /* ReleaseUniversal */, - F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc42 */, - F9988BB70D81587400B6B03B /* ReleaseUniversal llvmgcc42 */, + F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */, + F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; - F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Wish" */ = { + F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tk" */ = { isa = XCConfigurationList; buildConfigurations = ( F95CC8B609158F3100EA5ACE /* Debug */, - F9988AB10D814C6500B6B03B /* Debug gcc42 */, - F90E36D50F3B5C8400810A10 /* Debug gcc42 nogc */, - F9988AB50D814C7500B6B03B /* Debug llvmgcc42 */, - F95CC8B809158F3100EA5ACE /* DebugNoFixZL */, + F9988AB50D814C7500B6B03B /* Debug llvm-gcc */, + F9988AB10D814C6500B6B03B /* Debug gcc40 */, + F90E36D50F3B5C8400810A10 /* DebugNoGC */, + F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE7410BE835310060D4AF /* DebugUnthreaded */, F987512F0DE7B57E00B1C9EC /* DebugNoCF */, F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, @@ -5691,8 +5748,8 @@ F97AED1E0B660B2100310EA2 /* Debug64bit */, F95CC8B709158F3100EA5ACE /* Release */, F91BCC51093152310042A6BF /* ReleaseUniversal */, - F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc42 */, - F9988BB50D81587400B6B03B /* ReleaseUniversal llvmgcc42 */, + F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */, + F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; @@ -5702,10 +5759,10 @@ isa = XCConfigurationList; buildConfigurations = ( F97258A90A86873D00096C78 /* Debug */, - F9988AB40D814C6500B6B03B /* Debug gcc42 */, - F90E36D80F3B5C8400810A10 /* Debug gcc42 nogc */, - F9988AB80D814C7500B6B03B /* Debug llvmgcc42 */, - F97258AB0A86873D00096C78 /* DebugNoFixZL */, + F9988AB80D814C7500B6B03B /* Debug llvm-gcc */, + F9988AB40D814C6500B6B03B /* Debug gcc40 */, + F90E36D80F3B5C8400810A10 /* DebugNoGC */, + F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */, F99EE73F0BE835310060D4AF /* DebugUnthreaded */, F98751320DE7B57E00B1C9EC /* DebugNoCF */, F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, @@ -5715,8 +5772,8 @@ F97AED1D0B660B2100310EA2 /* Debug64bit */, F97258AA0A86873D00096C78 /* Release */, F97258AC0A86873D00096C78 /* ReleaseUniversal */, - F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc42 */, - F9988BB80D81587400B6B03B /* ReleaseUniversal llvmgcc42 */, + F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */, + F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; diff --git a/macosx/Wish.xcodeproj/default.pbxuser b/macosx/Tk.xcodeproj/default.pbxuser index 188bbeb..30bcecb 100644 --- a/macosx/Wish.xcodeproj/default.pbxuser +++ b/macosx/Tk.xcodeproj/default.pbxuser @@ -11,11 +11,10 @@ F9FD31F50CC1AD070073837D /* tktest-X11 */, ); perUserDictionary = { - com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b73747265616d747970656481e8038401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f75708692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a0b707265666572656e63657386928497960892849a9a07666e6d617463688692849a9a008692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a0572656765788692849a9a065c2e286329248692849a9a097265637572736976658692848484084e534e756d626572008484074e5356616c7565009584012a849696018692849a9a0669734c656166869284b09db296008692849a9a0763616e536176658692af92849a9a1250425850726f6a65637453636f70654b65798692849a9a03594553868692849a9a08676c6f62616c49448692849a9a18314343304541343030343335304546393030343434313042868686>; + com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b73747265616d747970656481e8038401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a0b707265666572656e63657386928497960892849a9a0669734c6561668692848484084e534e756d626572008484074e5356616c7565009584012a849696008692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a09726563757273697665869284a29da496018692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a0763616e536176658692a892849a9a1250425850726f6a65637453636f70654b65798692849a9a035945538692849a9a0572656765788692849a9a065c2e286329248692849a9a07666e6d617463688692849a9a00868692849a9a146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a08676c6f62616c49448692849a9a183143433045413430303433353045463930303434343130428692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f7570868686>; }; sourceControlManager = F944EB9C08F798180049FDD4 /* Source Control */; userBuildSettings = { - CODE_SIGN_IDENTITY = ""; SYMROOT = "${SRCROOT}/../../build/tk"; TCL_SRCROOT = "${SRCROOT}/../../tcl"; TK_SRCROOT = "${SRCROOT}/../../tk"; @@ -74,6 +73,9 @@ }; }; customDataFormattersEnabled = 1; + dataTipCustomDataFormattersEnabled = 1; + dataTipShowTypeColumn = 1; + dataTipSortType = 0; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = ""; @@ -101,12 +103,17 @@ }, { active = NO; + name = TK_CONSOLE; + value = 1; + }, + { + active = NO; name = DYLD_PRINT_LIBRARIES; }, { active = NO; - name = EventDebug; - value = 1; + name = NSTraceEvents; + value = YES; }, { active = NO; @@ -138,11 +145,47 @@ name = MallocScribble; value = 1; }, + { + active = NO; + name = NSZombieEnabled; + value = YES; + }, + { + active = NO; + name = NSDeallocateZombies; + value = YES; + }, + { + active = NO; + name = NSAutoreleaseFreedObjectCheckEnabled; + value = YES; + }, + { + active = NO; + name = NSEnableAutoreleasePool; + value = NO; + }, + { + active = NO; + name = AUTO_LOG_ALL; + value = YES; + }, + { + active = NO; + name = AUTO_LOG_NOISY; + value = YES; + }, + { + active = NO; + name = AUTO_REFERENCE_COUNT_LOGGING; + value = YES; + }, ); executableSystemSymbolLevel = 0; executableUserSymbolLevel = 0; libgmallocEnabled = 0; name = tktest; + showTypeColumn = 0; sourceDirectories = ( ); }; @@ -150,10 +193,16 @@ isa = PBXSourceControlManager; fallbackIsa = XCSourceControlManager; isSCMEnabled = 0; + repositoryNamesForRoots = { + .. = ""; + }; scmConfiguration = { CVSToolPath = /usr/bin/cvs; CVSUseSSH = NO; SubversionToolPath = /usr/bin/svn; + repositoryNamesForRoots = { + .. = ""; + }; }; scmType = scm.cvs; }; @@ -161,6 +210,12 @@ isa = PBXCodeSenseManager; indexTemplatePath = ""; }; + F97258A50A86873C00096C78 /* tktest-X11 */ = { + activeExec = 0; + executables = ( + F9FD31F50CC1AD070073837D /* tktest-X11 */, + ); + }; F9E61D16090A3E94002B3151 /* Tk */ = { activeExec = 0; executables = ( @@ -202,6 +257,9 @@ }; }; customDataFormattersEnabled = 1; + dataTipCustomDataFormattersEnabled = 1; + dataTipShowTypeColumn = 1; + dataTipSortType = 0; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = ""; @@ -216,15 +274,10 @@ executableUserSymbolLevel = 0; libgmallocEnabled = 0; name = Wish; + showTypeColumn = 0; sourceDirectories = ( ); }; - F97258A50A86873C00096C78 /* tktest-X11 */ = { - activeExec = 0; - executables = ( - F9FD31F50CC1AD070073837D /* tktest-X11 */, - ); - }; F9FD31F50CC1AD070073837D /* tktest-X11 */ = { isa = PBXExecutable; activeArgIndices = ( @@ -272,6 +325,9 @@ }; }; customDataFormattersEnabled = 1; + dataTipCustomDataFormattersEnabled = 1; + dataTipShowTypeColumn = 1; + dataTipSortType = 0; debuggerPlugin = GDBDebugging; disassemblyDisplayState = 0; dylibVariantSuffix = ""; @@ -336,6 +392,7 @@ executableUserSymbolLevel = 0; libgmallocEnabled = 0; name = "tktest-X11"; + showTypeColumn = 0; sourceDirectories = ( ); }; diff --git a/macosx/Wish.xcodeproj/project.pbxproj b/macosx/Tk.xcodeproj/project.pbxproj index 0fd1bea..dcfe9fb 100644 --- a/macosx/Wish.xcodeproj/project.pbxproj +++ b/macosx/Tk.xcodeproj/project.pbxproj @@ -8,7 +8,24 @@ /* Begin PBXBuildFile section */ F9067BCD0BFBA2900074F726 /* tkOldTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F966BAFE08F27A39005CB29B /* tkOldTest.c */; }; + F9152B090EAF8A5000CD5C7B /* tkBusy.c in Sources */ = {isa = PBXBuildFile; fileRef = F9152B080EAF8A5000CD5C7B /* tkBusy.c */; }; + F9152B0A0EAF8A5700CD5C7B /* tkBusy.c in Sources */ = {isa = PBXBuildFile; fileRef = F9152B080EAF8A5000CD5C7B /* tkBusy.c */; }; + F92EE8BF0E62F846001A6E80 /* tkImgPhInstance.c in Sources */ = {isa = PBXBuildFile; fileRef = F92EE8BE0E62F846001A6E80 /* tkImgPhInstance.c */; }; + F92EE8D30E62F939001A6E80 /* tkImgPhInstance.c in Sources */ = {isa = PBXBuildFile; fileRef = F92EE8BE0E62F846001A6E80 /* tkImgPhInstance.c */; }; + F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; }; + F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; }; + F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; }; + F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; }; + F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; + F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; + F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; + F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; F94523A20E6FC2AC00C1D987 /* Cocoa.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F94523A10E6FC2AC00C1D987 /* Cocoa.framework */; }; + F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; + F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; + F96437CB0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; + F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; + F96437E80EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; F966BDCF08F27A3F005CB29B /* tk3d.c in Sources */ = {isa = PBXBuildFile; fileRef = F966BAAC08F27A39005CB29B /* tk3d.c */; }; F966BDD108F27A3F005CB29B /* tkArgv.c in Sources */ = {isa = PBXBuildFile; fileRef = F966BAAE08F27A39005CB29B /* tkArgv.c */; }; F966BDD208F27A3F005CB29B /* tkAtom.c in Sources */ = {isa = PBXBuildFile; fileRef = F966BAAF08F27A39005CB29B /* tkAtom.c */; }; @@ -293,6 +310,8 @@ F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446908F272B9004A47F5 /* tclUnixThrd.c */; }; F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; }; F9C9CC000E84059800E00935 /* ApplicationServices.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F9C9CBFF0E84059800E00935 /* ApplicationServices.framework */; }; + F9DD99BD0F07DF850018B2E4 /* tkImgPNG.c in Sources */ = {isa = PBXBuildFile; fileRef = F9DD99BC0F07DF850018B2E4 /* tkImgPNG.c */; }; + F9DD99BE0F07DF850018B2E4 /* tkImgPNG.c in Sources */ = {isa = PBXBuildFile; fileRef = F9DD99BC0F07DF850018B2E4 /* tkImgPNG.c */; }; F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; }; F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; }; F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; }; @@ -590,14 +609,57 @@ F9FD349B0CC1BB0D0073837D /* libfreetype.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F9FD34990CC1BB0D0073837D /* libfreetype.dylib */; }; F9FD349C0CC1BB0D0073837D /* libXft.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F9FD349A0CC1BB0D0073837D /* libXft.dylib */; }; F9FD34C40CC1BBD70073837D /* libfontconfig.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F9FD34C30CC1BBD70073837D /* libfontconfig.dylib */; }; + F9FFAF1D0DFDDB26007F8A6A /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; + F9FFAF1F0DFDDB2F007F8A6A /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; }; + F9FFAF200DFDDB32007F8A6A /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; }; + F9FFAF210DFDDB32007F8A6A /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; }; + F9FFAF220DFDDB34007F8A6A /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; }; + F9FFAF230DFDDB35007F8A6A /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; + F9FFAF240DFDDB36007F8A6A /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; + F9FFAF250DFDDB37007F8A6A /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; + F9FFAF260DFDDB38007F8A6A /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; /* End PBXBuildFile section */ /* Begin PBXFileReference section */ 8DD76FB20486AB0100D96B5E /* tktest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tktest; sourceTree = BUILT_PRODUCTS_DIR; }; F9099B8A0CC67D30005A9580 /* textpeer.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = textpeer.tcl; sourceTree = "<group>"; }; F9099B8B0CC67D3E005A9580 /* ttkbut.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ttkbut.tcl; sourceTree = "<group>"; }; + F9152B080EAF8A5000CD5C7B /* tkBusy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tkBusy.c; sourceTree = "<group>"; }; + F91543270EF201A90032D1E8 /* fontchoose.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fontchoose.tcl; sourceTree = "<group>"; }; + F915432A0EF201CF0032D1E8 /* zlib.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = zlib.test; sourceTree = "<group>"; }; + F915432D0EF201EE0032D1E8 /* zlib.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = zlib.n; sourceTree = "<group>"; }; + F9183E640EFC80CD0030B814 /* throw.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = throw.n; sourceTree = "<group>"; }; + F9183E650EFC80D70030B814 /* try.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = try.n; sourceTree = "<group>"; }; + F9183E6A0EFC81560030B814 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; + F9183E8F0EFC817B0030B814 /* tdbc */ = {isa = PBXFileReference; lastKnownFileType = folder; path = tdbc; sourceTree = "<group>"; }; + F91DC23C0E44C51B002CB8D1 /* nre.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = nre.test; sourceTree = "<group>"; }; F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xml; path = "Tclsh-Info.plist.in"; sourceTree = "<group>"; }; F92240290D7C620F005EC715 /* knightstour.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = knightstour.tcl; sourceTree = "<group>"; }; + F92D7F100DE777240033A13A /* tsdPerf.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tsdPerf.tcl; sourceTree = "<group>"; }; + F92EE8BE0E62F846001A6E80 /* tkImgPhInstance.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tkImgPhInstance.c; sourceTree = "<group>"; }; + F93599B20DF1F75400E04F67 /* tclOO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOO.c; sourceTree = "<group>"; }; + F93599B40DF1F75900E04F67 /* tclOO.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclOO.decls; sourceTree = "<group>"; }; + F93599B50DF1F75D00E04F67 /* tclOO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOO.h; sourceTree = "<group>"; }; + F93599B60DF1F76100E04F67 /* tclOOBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOBasic.c; sourceTree = "<group>"; }; + F93599B80DF1F76600E04F67 /* tclOOCall.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOCall.c; sourceTree = "<group>"; }; + F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; }; + F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; }; + F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; }; + F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; }; + F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; }; + F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; }; + F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; }; + F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = "<group>"; }; + F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; }; + F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; }; + F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; }; + F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = "<group>"; }; + F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = "<group>"; }; + F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = "<group>"; }; + F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = "<group>"; }; + F93599D60DF1F95000E04F67 /* next.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = next.n; sourceTree = "<group>"; }; + F93599D70DF1F96800E04F67 /* object.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = object.n; sourceTree = "<group>"; }; + F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; }; F936FCD70CCD984500716967 /* ttkprogress.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ttkprogress.tcl; sourceTree = "<group>"; }; F936FCD80CCD984600716967 /* tree.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tree.tcl; sourceTree = "<group>"; }; F936FCD90CCD984600716967 /* toolbar.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = toolbar.tcl; sourceTree = "<group>"; }; @@ -605,10 +667,14 @@ F936FCDB0CCD984600716967 /* combo.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = combo.tcl; sourceTree = "<group>"; }; F93E5EFD09CF8711008FA367 /* tkMacOSXFont.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tkMacOSXFont.h; sourceTree = "<group>"; }; F94523A10E6FC2AC00C1D987 /* Cocoa.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Cocoa.framework; path = /System/Library/Frameworks/Cocoa.framework; sourceTree = "<absolute>"; }; + F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; }; + F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; }; F95D8D4B0F1715610006B020 /* Tk.icns */ = {isa = PBXFileReference; lastKnownFileType = image.icns; path = Tk.icns; sourceTree = "<group>"; }; F95D8D4C0F1715610006B020 /* Tk.tiff */ = {isa = PBXFileReference; lastKnownFileType = image.tiff; path = Tk.tiff; sourceTree = "<group>"; }; F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; }; F962F7C60DADC26200648DB8 /* vsapi.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = vsapi.test; sourceTree = "<group>"; }; + F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; }; + F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; }; F966BA0408F27A37005CB29B /* error.xbm */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = error.xbm; sourceTree = "<group>"; }; F966BA0508F27A37005CB29B /* gray12.xbm */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = gray12.xbm; sourceTree = "<group>"; }; F966BA0608F27A37005CB29B /* gray25.xbm */ = {isa = PBXFileReference; explicitFileType = sourcecode.c.h; fileEncoding = 4; path = gray25.xbm; sourceTree = "<group>"; }; @@ -756,7 +822,6 @@ F966BA9608F27A38005CB29B /* text.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = text.n; sourceTree = "<group>"; }; F966BA9708F27A38005CB29B /* TextLayout.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TextLayout.3; sourceTree = "<group>"; }; F966BA9808F27A38005CB29B /* tk.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tk.n; sourceTree = "<group>"; }; - F966BA9908F27A38005CB29B /* tk4.0.ps */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = tk4.0.ps; sourceTree = "<group>"; }; F966BA9A08F27A38005CB29B /* Tk_Init.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tk_Init.3; sourceTree = "<group>"; }; F966BA9B08F27A38005CB29B /* Tk_Main.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Tk_Main.3; sourceTree = "<group>"; }; F966BA9C08F27A38005CB29B /* tkerror.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tkerror.n; sourceTree = "<group>"; }; @@ -770,7 +835,6 @@ F966BAA408F27A38005CB29B /* wm.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = wm.n; sourceTree = "<group>"; }; F966BAA608F27A38005CB29B /* default.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = default.h; sourceTree = "<group>"; }; F966BAA708F27A38005CB29B /* ks_names.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = ks_names.h; sourceTree = "<group>"; }; - F966BAA808F27A38005CB29B /* prolog.ps */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = prolog.ps; sourceTree = "<group>"; }; F966BAA908F27A39005CB29B /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F966BAAA08F27A39005CB29B /* tk.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tk.decls; sourceTree = "<group>"; }; F966BAAB08F27A39005CB29B /* tk.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tk.h; sourceTree = "<group>"; }; @@ -947,7 +1011,6 @@ F966BB8708F27A3A005CB29B /* optMenu.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = optMenu.tcl; sourceTree = "<group>"; }; F966BB8808F27A3A005CB29B /* palette.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = palette.tcl; sourceTree = "<group>"; }; F966BB8908F27A3B005CB29B /* panedwindow.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = panedwindow.tcl; sourceTree = "<group>"; }; - F966BB8A08F27A3B005CB29B /* prolog.ps */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = prolog.ps; sourceTree = "<group>"; }; F966BB8B08F27A3B005CB29B /* safetk.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safetk.tcl; sourceTree = "<group>"; }; F966BB8C08F27A3B005CB29B /* scale.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = scale.tcl; sourceTree = "<group>"; }; F966BB8D08F27A3B005CB29B /* scrlbar.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = scrlbar.tcl; sourceTree = "<group>"; }; @@ -1051,7 +1114,6 @@ F966BC2F08F27A3C005CB29B /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = "<group>"; }; F966BC3008F27A3C005CB29B /* grab.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = grab.test; sourceTree = "<group>"; }; F966BC3108F27A3C005CB29B /* grid.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = grid.test; sourceTree = "<group>"; }; - F966BC3208F27A3C005CB29B /* id.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = id.test; sourceTree = "<group>"; }; F966BC3308F27A3C005CB29B /* image.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = image.test; sourceTree = "<group>"; }; F966BC3408F27A3C005CB29B /* imgBmap.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = imgBmap.test; sourceTree = "<group>"; }; F966BC3508F27A3C005CB29B /* imgPhoto.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = imgPhoto.test; sourceTree = "<group>"; }; @@ -1644,18 +1706,10 @@ F96D402208F272AA004A47F5 /* tcltest.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.tcl; sourceTree = "<group>"; }; F96D402308F272AA004A47F5 /* tm.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.tcl; sourceTree = "<group>"; }; F96D425B08F272B2004A47F5 /* word.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = word.tcl; sourceTree = "<group>"; }; - F96D425F08F272B3004A47F5 /* bn.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = bn.pdf; sourceTree = "<group>"; }; - F96D426108F272B3004A47F5 /* bn_error.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_error.c; sourceTree = "<group>"; }; - F96D426208F272B3004A47F5 /* bn_fast_mp_invmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_mp_invmod.c; sourceTree = "<group>"; }; - F96D426308F272B3004A47F5 /* bn_fast_mp_montgomery_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_mp_montgomery_reduce.c; sourceTree = "<group>"; }; F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_digs.c; sourceTree = "<group>"; }; - F96D426508F272B3004A47F5 /* bn_fast_s_mp_mul_high_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_high_digs.c; sourceTree = "<group>"; }; F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_sqr.c; sourceTree = "<group>"; }; - F96D426708F272B3004A47F5 /* bn_mp_2expt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_2expt.c; sourceTree = "<group>"; }; - F96D426808F272B3004A47F5 /* bn_mp_abs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_abs.c; sourceTree = "<group>"; }; F96D426908F272B3004A47F5 /* bn_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add.c; sourceTree = "<group>"; }; F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add_d.c; sourceTree = "<group>"; }; - F96D426B08F272B3004A47F5 /* bn_mp_addmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_addmod.c; sourceTree = "<group>"; }; F96D426C08F272B3004A47F5 /* bn_mp_and.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_and.c; sourceTree = "<group>"; }; F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clamp.c; sourceTree = "<group>"; }; F96D426E08F272B3004A47F5 /* bn_mp_clear.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear.c; sourceTree = "<group>"; }; @@ -1663,7 +1717,6 @@ F96D427008F272B3004A47F5 /* bn_mp_cmp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp.c; sourceTree = "<group>"; }; F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_d.c; sourceTree = "<group>"; }; F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_mag.c; sourceTree = "<group>"; }; - F96D427308F272B3004A47F5 /* bn_mp_cnt_lsb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cnt_lsb.c; sourceTree = "<group>"; }; F96D427408F272B3004A47F5 /* bn_mp_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_copy.c; sourceTree = "<group>"; }; F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_count_bits.c; sourceTree = "<group>"; }; F96D427608F272B3004A47F5 /* bn_mp_div.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div.c; sourceTree = "<group>"; }; @@ -1671,104 +1724,49 @@ F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = "<group>"; }; F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = "<group>"; }; F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = "<group>"; }; - F96D427B08F272B3004A47F5 /* bn_mp_dr_is_modulus.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_is_modulus.c; sourceTree = "<group>"; }; - F96D427C08F272B3004A47F5 /* bn_mp_dr_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_reduce.c; sourceTree = "<group>"; }; - F96D427D08F272B3004A47F5 /* bn_mp_dr_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_setup.c; sourceTree = "<group>"; }; F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = "<group>"; }; F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d.c; sourceTree = "<group>"; }; - F96D428008F272B3004A47F5 /* bn_mp_exptmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exptmod.c; sourceTree = "<group>"; }; - F96D428108F272B3004A47F5 /* bn_mp_exptmod_fast.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exptmod_fast.c; sourceTree = "<group>"; }; - F96D428208F272B3004A47F5 /* bn_mp_exteuclid.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exteuclid.c; sourceTree = "<group>"; }; - F96D428308F272B3004A47F5 /* bn_mp_fread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_fread.c; sourceTree = "<group>"; }; - F96D428408F272B3004A47F5 /* bn_mp_fwrite.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_fwrite.c; sourceTree = "<group>"; }; - F96D428508F272B3004A47F5 /* bn_mp_gcd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_gcd.c; sourceTree = "<group>"; }; - F96D428608F272B3004A47F5 /* bn_mp_get_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_get_int.c; sourceTree = "<group>"; }; F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = "<group>"; }; F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = "<group>"; }; F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = "<group>"; }; F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = "<group>"; }; F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set.c; sourceTree = "<group>"; }; - F96D428C08F272B3004A47F5 /* bn_mp_init_set_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set_int.c; sourceTree = "<group>"; }; F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_size.c; sourceTree = "<group>"; }; - F96D428E08F272B3004A47F5 /* bn_mp_invmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_invmod.c; sourceTree = "<group>"; }; - F96D428F08F272B3004A47F5 /* bn_mp_invmod_slow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_invmod_slow.c; sourceTree = "<group>"; }; - F96D429008F272B3004A47F5 /* bn_mp_is_square.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_is_square.c; sourceTree = "<group>"; }; - F96D429108F272B3004A47F5 /* bn_mp_jacobi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_jacobi.c; sourceTree = "<group>"; }; F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_mul.c; sourceTree = "<group>"; }; F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_sqr.c; sourceTree = "<group>"; }; - F96D429408F272B3004A47F5 /* bn_mp_lcm.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lcm.c; sourceTree = "<group>"; }; F96D429508F272B3004A47F5 /* bn_mp_lshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lshd.c; sourceTree = "<group>"; }; F96D429608F272B3004A47F5 /* bn_mp_mod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod.c; sourceTree = "<group>"; }; F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_2d.c; sourceTree = "<group>"; }; - F96D429808F272B3004A47F5 /* bn_mp_mod_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_d.c; sourceTree = "<group>"; }; - F96D429908F272B3004A47F5 /* bn_mp_montgomery_calc_normalization.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_calc_normalization.c; sourceTree = "<group>"; }; - F96D429A08F272B3004A47F5 /* bn_mp_montgomery_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_reduce.c; sourceTree = "<group>"; }; - F96D429B08F272B3004A47F5 /* bn_mp_montgomery_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_setup.c; sourceTree = "<group>"; }; F96D429C08F272B3004A47F5 /* bn_mp_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul.c; sourceTree = "<group>"; }; F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2.c; sourceTree = "<group>"; }; F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2d.c; sourceTree = "<group>"; }; F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_d.c; sourceTree = "<group>"; }; - F96D42A008F272B3004A47F5 /* bn_mp_mulmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mulmod.c; sourceTree = "<group>"; }; - F96D42A108F272B3004A47F5 /* bn_mp_n_root.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_n_root.c; sourceTree = "<group>"; }; F96D42A208F272B3004A47F5 /* bn_mp_neg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_neg.c; sourceTree = "<group>"; }; F96D42A308F272B3004A47F5 /* bn_mp_or.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_or.c; sourceTree = "<group>"; }; - F96D42A408F272B3004A47F5 /* bn_mp_prime_fermat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_fermat.c; sourceTree = "<group>"; }; - F96D42A508F272B3004A47F5 /* bn_mp_prime_is_divisible.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_is_divisible.c; sourceTree = "<group>"; }; - F96D42A608F272B3004A47F5 /* bn_mp_prime_is_prime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_is_prime.c; sourceTree = "<group>"; }; - F96D42A708F272B3004A47F5 /* bn_mp_prime_miller_rabin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_miller_rabin.c; sourceTree = "<group>"; }; - F96D42A808F272B3004A47F5 /* bn_mp_prime_next_prime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_next_prime.c; sourceTree = "<group>"; }; - F96D42A908F272B3004A47F5 /* bn_mp_prime_rabin_miller_trials.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_rabin_miller_trials.c; sourceTree = "<group>"; }; - F96D42AA08F272B3004A47F5 /* bn_mp_prime_random_ex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_random_ex.c; sourceTree = "<group>"; }; F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_size.c; sourceTree = "<group>"; }; F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_smap.c; sourceTree = "<group>"; }; - F96D42AD08F272B3004A47F5 /* bn_mp_rand.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rand.c; sourceTree = "<group>"; }; F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_radix.c; sourceTree = "<group>"; }; - F96D42AF08F272B3004A47F5 /* bn_mp_read_signed_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_signed_bin.c; sourceTree = "<group>"; }; - F96D42B008F272B3004A47F5 /* bn_mp_read_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_unsigned_bin.c; sourceTree = "<group>"; }; - F96D42B108F272B3004A47F5 /* bn_mp_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce.c; sourceTree = "<group>"; }; - F96D42B208F272B3004A47F5 /* bn_mp_reduce_2k.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k.c; sourceTree = "<group>"; }; - F96D42B308F272B3004A47F5 /* bn_mp_reduce_2k_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_l.c; sourceTree = "<group>"; }; - F96D42B408F272B3004A47F5 /* bn_mp_reduce_2k_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_setup.c; sourceTree = "<group>"; }; - F96D42B508F272B3004A47F5 /* bn_mp_reduce_2k_setup_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_setup_l.c; sourceTree = "<group>"; }; - F96D42B608F272B3004A47F5 /* bn_mp_reduce_is_2k.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_is_2k.c; sourceTree = "<group>"; }; - F96D42B708F272B3004A47F5 /* bn_mp_reduce_is_2k_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_is_2k_l.c; sourceTree = "<group>"; }; - F96D42B808F272B3004A47F5 /* bn_mp_reduce_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_setup.c; sourceTree = "<group>"; }; F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rshd.c; sourceTree = "<group>"; }; F96D42BA08F272B3004A47F5 /* bn_mp_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set.c; sourceTree = "<group>"; }; - F96D42BB08F272B3004A47F5 /* bn_mp_set_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set_int.c; sourceTree = "<group>"; }; F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = "<group>"; }; - F96D42BD08F272B3004A47F5 /* bn_mp_signed_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_signed_bin_size.c; sourceTree = "<group>"; }; F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = "<group>"; }; - F96D42BF08F272B3004A47F5 /* bn_mp_sqrmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrmod.c; sourceTree = "<group>"; }; F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = "<group>"; }; F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = "<group>"; }; F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = "<group>"; }; - F96D42C308F272B3004A47F5 /* bn_mp_submod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_submod.c; sourceTree = "<group>"; }; - F96D42C408F272B3004A47F5 /* bn_mp_to_signed_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_signed_bin.c; sourceTree = "<group>"; }; - F96D42C508F272B3004A47F5 /* bn_mp_to_signed_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_signed_bin_n.c; sourceTree = "<group>"; }; F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin.c; sourceTree = "<group>"; }; F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin_n.c; sourceTree = "<group>"; }; F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = "<group>"; }; F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = "<group>"; }; - F96D42CA08F272B3004A47F5 /* bn_mp_toradix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix.c; sourceTree = "<group>"; }; F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix_n.c; sourceTree = "<group>"; }; F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_unsigned_bin_size.c; sourceTree = "<group>"; }; F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = "<group>"; }; F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = "<group>"; }; - F96D42CF08F272B3004A47F5 /* bn_prime_tab.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_prime_tab.c; sourceTree = "<group>"; }; F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = "<group>"; }; F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = "<group>"; }; - F96D42D208F272B3004A47F5 /* bn_s_mp_exptmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_exptmod.c; sourceTree = "<group>"; }; F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = "<group>"; }; - F96D42D408F272B3004A47F5 /* bn_s_mp_mul_high_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_high_digs.c; sourceTree = "<group>"; }; F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = "<group>"; }; F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = "<group>"; }; F96D42D708F272B3004A47F5 /* bncore.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bncore.c; sourceTree = "<group>"; }; - F96D42D908F272B3004A47F5 /* callgraph.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = callgraph.txt; sourceTree = "<group>"; }; - F96D42DA08F272B3004A47F5 /* changes.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = changes.txt; sourceTree = "<group>"; }; - F96D42F008F272B3004A47F5 /* LICENSE */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = LICENSE; sourceTree = "<group>"; }; - F96D431D08F272B4004A47F5 /* poster.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = poster.pdf; sourceTree = "<group>"; }; - F96D432608F272B4004A47F5 /* tommath.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = tommath.pdf; sourceTree = "<group>"; }; F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = "<group>"; }; F96D432A08F272B4004A47F5 /* tommath_superclass.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_superclass.h; sourceTree = "<group>"; }; F96D432B08F272B4004A47F5 /* license.terms */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = license.terms; sourceTree = "<group>"; }; @@ -1822,7 +1820,7 @@ F96D436E08F272B6004A47F5 /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = "<group>"; }; F96D436F08F272B6004A47F5 /* history.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.test; sourceTree = "<group>"; }; F96D437008F272B6004A47F5 /* http.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.test; sourceTree = "<group>"; }; - F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = httpd; sourceTree = "<group>"; }; + F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd; sourceTree = "<group>"; }; F96D437208F272B6004A47F5 /* httpold.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpold.test; sourceTree = "<group>"; }; F96D437308F272B6004A47F5 /* if-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "if-old.test"; sourceTree = "<group>"; }; F96D437408F272B6004A47F5 /* if.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = if.test; sourceTree = "<group>"; }; @@ -1835,7 +1833,6 @@ F96D437B08F272B6004A47F5 /* io.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = io.test; sourceTree = "<group>"; }; F96D437C08F272B6004A47F5 /* ioCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioCmd.test; sourceTree = "<group>"; }; F96D437D08F272B6004A47F5 /* iogt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iogt.test; sourceTree = "<group>"; }; - F96D437E08F272B6004A47F5 /* ioUtil.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioUtil.test; sourceTree = "<group>"; }; F96D437F08F272B6004A47F5 /* join.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = join.test; sourceTree = "<group>"; }; F96D438008F272B6004A47F5 /* lindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lindex.test; sourceTree = "<group>"; }; F96D438108F272B6004A47F5 /* link.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = link.test; sourceTree = "<group>"; }; @@ -1920,6 +1917,7 @@ F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = "<group>"; }; F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; }; F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; }; + F96D442208F272B8004A47F5 /* eolFix.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = eolFix.tcl; sourceTree = "<group>"; }; F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = "<group>"; }; F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; }; F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; }; @@ -1935,10 +1933,8 @@ F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = "<group>"; }; F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; }; F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; }; - F96D443408F272B8004A47F5 /* str2c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = str2c; sourceTree = "<group>"; }; F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; }; F96D443608F272B8004A47F5 /* tcl.wse.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.wse.in; sourceTree = "<group>"; }; - F96D443708F272B9004A47F5 /* tclmin.wse */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclmin.wse; sourceTree = "<group>"; }; F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; }; F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; }; F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; }; @@ -2026,18 +2022,38 @@ F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = "<group>"; }; F96D449908F272BA004A47F5 /* tclWinThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinThrd.h; sourceTree = "<group>"; }; F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = "<group>"; }; + F973E5960EE99384001A648E /* vistaTheme.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = vistaTheme.tcl; sourceTree = "<group>"; }; + F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = "<group>"; }; + F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = "<group>"; }; + F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = "<group>"; }; + F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = "<group>"; }; + F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = "<group>"; }; + F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = "<group>"; }; + F974D5790FBE7E9C00BF728B /* tcl.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.pc.in; sourceTree = "<group>"; }; + F974D57B0FBE7EC000BF728B /* tk.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tk.pc.in; sourceTree = "<group>"; }; + F974D57C0FBE7EFF00BF728B /* iconlist.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iconlist.tcl; sourceTree = "<group>"; }; + F974D57D0FBE7EFF00BF728B /* icons.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = icons.tcl; sourceTree = "<group>"; }; + F97590AE1039A96200558A9A /* Wish.sdef */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.sdef; path = Wish.sdef; sourceTree = "<group>"; }; F976F6A70C325FB6005066D9 /* tkMacOSXPrivate.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tkMacOSXPrivate.h; sourceTree = "<group>"; }; - F97AE7F10B65C1E900310EA2 /* Wish-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Wish-Common.xcconfig"; sourceTree = "<group>"; }; - F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Wish-Release.xcconfig"; sourceTree = "<group>"; }; - F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Wish-Debug.xcconfig"; sourceTree = "<group>"; }; + F97AE7F10B65C1E900310EA2 /* Tk-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tk-Common.xcconfig"; sourceTree = "<group>"; }; + F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tk-Release.xcconfig"; sourceTree = "<group>"; }; + F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tk-Debug.xcconfig"; sourceTree = "<group>"; }; + F98383650F0FA43900171CA6 /* checkbutton.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkbutton.test; sourceTree = "<group>"; }; + F98383680F0FA44700171CA6 /* radiobutton.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = radiobutton.test; sourceTree = "<group>"; }; F9903CAF094FAADA004613E9 /* tclTomMath.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclTomMath.decls; sourceTree = "<group>"; }; F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMathDecls.h; sourceTree = "<group>"; }; + F99388380EE0114B0065FE6B /* fontchooser.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fontchooser.tcl; sourceTree = "<group>"; }; + F99388950EE02D980065FE6B /* fontchooser.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fontchooser.test; sourceTree = "<group>"; }; + F99D61180EF5573A00BBFE01 /* TclZlib.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TclZlib.3; sourceTree = "<group>"; }; F9A3082D08F2D4AB00BAE1AB /* Tk.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tk.framework; sourceTree = BUILT_PRODUCTS_DIR; }; F9A3084B08F2D4CE00BAE1AB /* Wish.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = Wish.app; sourceTree = BUILT_PRODUCTS_DIR; }; F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; }; F9A493240CEBF38300B78AE2 /* chanio.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chanio.test; sourceTree = "<group>"; }; + F9C888C20EEF6571003F63AD /* fontchooser.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = fontchooser.n; sourceTree = "<group>"; }; F9C9CBFF0E84059800E00935 /* ApplicationServices.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = ApplicationServices.framework; path = /System/Library/Frameworks/ApplicationServices.framework; sourceTree = "<absolute>"; }; F9D1360A0CDC252C00DBE0B5 /* mclist.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mclist.tcl; sourceTree = "<group>"; }; + F9DD99BC0F07DF850018B2E4 /* tkImgPNG.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tkImgPNG.c; sourceTree = "<group>"; }; + F9DD99BF0F07DFCD0018B2E4 /* imgPNG.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = imgPNG.test; sourceTree = "<group>"; }; F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; }; F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = "<group>"; }; F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = "<group>"; }; @@ -2064,6 +2080,7 @@ buildActionMask = 2147483647; files = ( F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */, + F96437E70EF0D652003F468E /* libz.dylib in Frameworks */, F966C07708F2821B005CB29B /* Carbon.framework in Frameworks */, F966C07908F28233005CB29B /* IOKit.framework in Frameworks */, F94523A20E6FC2AC00C1D987 /* Cocoa.framework in Frameworks */, @@ -2076,6 +2093,7 @@ buildActionMask = 2147483647; files = ( F9FD31E40CC1AD070073837D /* CoreFoundation.framework in Frameworks */, + F96437E80EF0D652003F468E /* libz.dylib in Frameworks */, F9FD32170CC1AF170073837D /* libX11.dylib in Frameworks */, F9FD32180CC1AF170073837D /* libXext.dylib in Frameworks */, F9FD32190CC1AF170073837D /* libXss.dylib in Frameworks */, @@ -2088,7 +2106,7 @@ /* End PBXFrameworksBuildPhase section */ /* Begin PBXGroup section */ - 08FB7794FE84155DC02AAC07 /* Wish */ = { + 08FB7794FE84155DC02AAC07 /* Tk */ = { isa = PBXGroup; children = ( F96D3DF708F271BE004A47F5 /* Tk Sources */, @@ -2097,7 +2115,7 @@ 1AB674ADFE9D54B511CA2CBB /* Products */, ); comments = "Copyright (c) 2004-2009 Daniel A. Steffen <das@users.sourceforge.net>\nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n"; - name = Wish; + name = Tk; path = .; sourceTree = SOURCE_ROOT; }; @@ -2114,6 +2132,16 @@ name = Products; sourceTree = "<group>"; }; + F9183E690EFC81560030B814 /* pkgs */ = { + isa = PBXGroup; + children = ( + F9183E6A0EFC81560030B814 /* README */, + F946FB8B0FBE3AED00CD6495 /* itcl */, + F9183E8F0EFC817B0030B814 /* tdbc */, + ); + path = pkgs; + sourceTree = "<group>"; + }; F966BA0308F27A37005CB29B /* bitmaps */ = { isa = PBXGroup; children = ( @@ -2177,6 +2205,7 @@ F966BA3908F27A37005CB29B /* focus.n */, F966BA3A08F27A37005CB29B /* focusNext.n */, F966BA3B08F27A37005CB29B /* font.n */, + F9C888C20EEF6571003F63AD /* fontchooser.n */, F966BA3C08F27A37005CB29B /* FontId.3 */, F966BA3D08F27A37005CB29B /* frame.n */, F966BA3E08F27A37005CB29B /* FreeXId.3 */, @@ -2269,7 +2298,6 @@ F966BA9608F27A38005CB29B /* text.n */, F966BA9708F27A38005CB29B /* TextLayout.3 */, F966BA9808F27A38005CB29B /* tk.n */, - F966BA9908F27A38005CB29B /* tk4.0.ps */, F966BA9A08F27A38005CB29B /* Tk_Init.3 */, F966BA9B08F27A38005CB29B /* Tk_Main.3 */, F966BA9C08F27A38005CB29B /* tkerror.n */, @@ -2312,7 +2340,6 @@ children = ( F966BAA608F27A38005CB29B /* default.h */, F966BAA708F27A38005CB29B /* ks_names.h */, - F966BAA808F27A38005CB29B /* prolog.ps */, F966BAA908F27A39005CB29B /* README */, F966BAAA08F27A39005CB29B /* tk.decls */, F966BAAB08F27A39005CB29B /* tk.h */, @@ -2322,6 +2349,7 @@ F966BAAF08F27A39005CB29B /* tkAtom.c */, F966BAB008F27A39005CB29B /* tkBind.c */, F966BAB108F27A39005CB29B /* tkBitmap.c */, + F9152B080EAF8A5000CD5C7B /* tkBusy.c */, F966BAB208F27A39005CB29B /* tkButton.c */, F966BAB308F27A39005CB29B /* tkButton.h */, F966BAB408F27A39005CB29B /* tkCanvArc.c */, @@ -2361,7 +2389,9 @@ F966BAD708F27A39005CB29B /* tkImage.c */, F966BAD808F27A39005CB29B /* tkImgBmap.c */, F966BAD908F27A39005CB29B /* tkImgGIF.c */, + F92EE8BE0E62F846001A6E80 /* tkImgPhInstance.c */, F966BADA08F27A39005CB29B /* tkImgPhoto.c */, + F9DD99BC0F07DF850018B2E4 /* tkImgPNG.c */, F966BADB08F27A39005CB29B /* tkImgPPM.c */, F966BADC08F27A39005CB29B /* tkImgUtil.c */, F966BADE08F27A39005CB29B /* tkInt.decls */, @@ -2433,6 +2463,9 @@ F966BB6208F27A3A005CB29B /* dialog.tcl */, F966BB6308F27A3A005CB29B /* entry.tcl */, F966BB6408F27A3A005CB29B /* focus.tcl */, + F99388380EE0114B0065FE6B /* fontchooser.tcl */, + F974D57C0FBE7EFF00BF728B /* iconlist.tcl */, + F974D57D0FBE7EFF00BF728B /* icons.tcl */, F966BB7308F27A3A005CB29B /* listbox.tcl */, F966BB7408F27A3A005CB29B /* menu.tcl */, F966BB7508F27A3A005CB29B /* mkpsenc.tcl */, @@ -2441,7 +2474,6 @@ F966BB8708F27A3A005CB29B /* optMenu.tcl */, F966BB8808F27A3A005CB29B /* palette.tcl */, F966BB8908F27A3B005CB29B /* panedwindow.tcl */, - F966BB8A08F27A3B005CB29B /* prolog.ps */, F966BB8B08F27A3B005CB29B /* safetk.tcl */, F966BB8C08F27A3B005CB29B /* scale.tcl */, F966BB8D08F27A3B005CB29B /* scrlbar.tcl */, @@ -2481,6 +2513,7 @@ F966BB2C08F27A39005CB29B /* entry3.tcl */, F966BB2D08F27A39005CB29B /* filebox.tcl */, F966BB2E08F27A39005CB29B /* floor.tcl */, + F91543270EF201A90032D1E8 /* fontchoose.tcl */, F966BB2F08F27A39005CB29B /* form.tcl */, F966BB3008F27A39005CB29B /* goldberg.tcl */, F966BB3108F27A39005CB29B /* hello */, @@ -2586,9 +2619,10 @@ F95D8D4B0F1715610006B020 /* Tk.icns */, F95D8D4C0F1715610006B020 /* Tk.tiff */, F966BBF708F27A3C005CB29B /* Wish-Info.plist.in */, - F97AE7F10B65C1E900310EA2 /* Wish-Common.xcconfig */, - F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */, - F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */, + F97590AE1039A96200558A9A /* Wish.sdef */, + F97AE7F10B65C1E900310EA2 /* Tk-Common.xcconfig */, + F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */, + F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */, ); path = macosx; sourceTree = "<group>"; @@ -2636,15 +2670,16 @@ F966BC2A08F27A3C005CB29B /* focus.test */, F966BC2B08F27A3C005CB29B /* focusTcl.test */, F966BC2C08F27A3C005CB29B /* font.test */, + F99388950EE02D980065FE6B /* fontchooser.test */, F966BC2D08F27A3C005CB29B /* frame.test */, F966BC2E08F27A3C005CB29B /* geometry.test */, F966BC2F08F27A3C005CB29B /* get.test */, F966BC3008F27A3C005CB29B /* grab.test */, F966BC3108F27A3C005CB29B /* grid.test */, - F966BC3208F27A3C005CB29B /* id.test */, F966BC3308F27A3C005CB29B /* image.test */, F966BC3408F27A3C005CB29B /* imgBmap.test */, F966BC3508F27A3C005CB29B /* imgPhoto.test */, + F9DD99BF0F07DFCD0018B2E4 /* imgPNG.test */, F966BC3608F27A3C005CB29B /* imgPPM.test */, F966BC3708F27A3C005CB29B /* listbox.test */, F966BC3808F27A3C005CB29B /* main.test */, @@ -2714,6 +2749,7 @@ F966BC7108F27A3D005CB29B /* Makefile.in */, F966BC7208F27A3D005CB29B /* README */, F966BC7308F27A3D005CB29B /* tcl.m4 */, + F974D57B0FBE7EC000BF728B /* tk.pc.in */, F966BC7408F27A3D005CB29B /* tk.spec */, F966BC7508F27A3D005CB29B /* tkAppInit.c */, F966BC7608F27A3D005CB29B /* tkConfig.h.in */, @@ -2849,6 +2885,7 @@ children = ( F9C9CBFF0E84059800E00935 /* ApplicationServices.framework */, F966C07408F2820D005CB29B /* CoreFoundation.framework */, + F96437E60EF0D652003F468E /* libz.dylib */, F966C07608F2821B005CB29B /* Carbon.framework */, F94523A10E6FC2AC00C1D987 /* Cocoa.framework */, F966C07808F28233005CB29B /* IOKit.framework */, @@ -2930,6 +2967,7 @@ F968884C0AF787B3000797B5 /* ttk.tcl */, F968884D0AF787B3000797B5 /* utils.tcl */, F968884E0AF787B3000797B5 /* winTheme.tcl */, + F973E5960EE99384001A648E /* vistaTheme.tcl */, F968884F0AF787B3000797B5 /* xpTheme.tcl */, ); path = ttk; @@ -2939,6 +2977,7 @@ isa = PBXGroup; children = ( F96888540AF7880C000797B5 /* all.tcl */, + F98383650F0FA43900171CA6 /* checkbutton.test */, F96888560AF7880C000797B5 /* combobox.test */, F96888570AF7880C000797B5 /* entry.test */, F96888580AF7880C000797B5 /* image.test */, @@ -2947,6 +2986,7 @@ F968885C0AF7880C000797B5 /* notebook.test */, F968885D0AF7880C000797B5 /* panedwindow.test */, F968885E0AF7880C000797B5 /* progressbar.test */, + F98383680F0FA44700171CA6 /* radiobutton.test */, F968885F0AF7880C000797B5 /* scrollbar.test */, F96888600AF7880C000797B5 /* treetags.test */, F96888610AF7880C000797B5 /* treeview.test */, @@ -2969,6 +3009,7 @@ F96D434408F272B5004A47F5 /* tests */, F96D3DFC08F272A4004A47F5 /* doc */, F96D43D008F272B8004A47F5 /* tools */, + F9183E690EFC81560030B814 /* pkgs */, F96D3DFA08F272A4004A47F5 /* ChangeLog */, F96D3DFB08F272A4004A47F5 /* changes */, F96D434308F272B5004A47F5 /* README */, @@ -3023,12 +3064,16 @@ F96D3E1108F272A5004A47F5 /* cd.n */, F96D3E1208F272A5004A47F5 /* chan.n */, F96D3E1308F272A5004A47F5 /* ChnlStack.3 */, + F93599CF0DF1F87F00E04F67 /* Class.3 */, + F93599D00DF1F89E00E04F67 /* class.n */, F96D3E1408F272A5004A47F5 /* clock.n */, F96D3E1508F272A5004A47F5 /* close.n */, F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */, F96D3E1708F272A5004A47F5 /* Concat.3 */, F96D3E1808F272A5004A47F5 /* concat.n */, F96D3E1908F272A5004A47F5 /* continue.n */, + F93599D20DF1F8DF00E04F67 /* copy.n */, + F974D5720FBE7DC600BF728B /* coroutine.n */, F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */, F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */, F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */, @@ -3041,6 +3086,7 @@ F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */, F96D3E2408F272A5004A47F5 /* CrtTrace.3 */, F96D3E2508F272A5004A47F5 /* dde.n */, + F93599D30DF1F8F500E04F67 /* define.n */, F96D3E2608F272A5004A47F5 /* DetachPids.3 */, F96D3E2708F272A5004A47F5 /* dict.n */, F96D3E2808F272A5004A47F5 /* DictObj.3 */, @@ -3118,11 +3164,15 @@ F96D3E7008F272A6004A47F5 /* man.macros */, F96D3E7108F272A6004A47F5 /* mathfunc.n */, F96D3E7208F272A6004A47F5 /* memory.n */, + F93599D40DF1F91900E04F67 /* Method.3 */, F96D3E7308F272A6004A47F5 /* msgcat.n */, + F93599D50DF1F93700E04F67 /* my.n */, F96D3E7408F272A6004A47F5 /* Namespace.3 */, F96D3E7508F272A6004A47F5 /* namespace.n */, + F93599D60DF1F95000E04F67 /* next.n */, F96D3E7608F272A6004A47F5 /* Notifier.3 */, F96D3E7708F272A6004A47F5 /* Object.3 */, + F93599D70DF1F96800E04F67 /* object.n */, F96D3E7808F272A6004A47F5 /* ObjectType.3 */, F96D3E7908F272A6004A47F5 /* open.n */, F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */, @@ -3156,6 +3206,7 @@ F96D3E9408F272A6004A47F5 /* SaveResult.3 */, F96D3E9508F272A6004A47F5 /* scan.n */, F96D3E9608F272A6004A47F5 /* seek.n */, + F93599D80DF1F98300E04F67 /* self.n */, F96D3E9708F272A6004A47F5 /* set.n */, F96D3E9808F272A6004A47F5 /* SetChanErr.3 */, F96D3E9908F272A6004A47F5 /* SetErrno.3 */, @@ -3178,7 +3229,9 @@ F96D3EAA08F272A7004A47F5 /* subst.n */, F96D3EAB08F272A7004A47F5 /* SubstObj.3 */, F96D3EAC08F272A7004A47F5 /* switch.n */, + F974D5760FBE7E1900BF728B /* tailcall.n */, F96D3EAD08F272A7004A47F5 /* Tcl.n */, + F99D61180EF5573A00BBFE01 /* TclZlib.3 */, F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */, F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */, F96D3EB008F272A7004A47F5 /* tclsh.1 */, @@ -3186,6 +3239,7 @@ F96D3EB208F272A7004A47F5 /* tclvars.n */, F96D3EB308F272A7004A47F5 /* tell.n */, F96D3EB408F272A7004A47F5 /* Thread.3 */, + F9183E640EFC80CD0030B814 /* throw.n */, F96D3EB508F272A7004A47F5 /* time.n */, F96D3EB608F272A7004A47F5 /* tm.n */, F96D3EB708F272A7004A47F5 /* ToUpper.3 */, @@ -3193,6 +3247,7 @@ F96D3EB908F272A7004A47F5 /* TraceCmd.3 */, F96D3EBA08F272A7004A47F5 /* TraceVar.3 */, F96D3EBB08F272A7004A47F5 /* Translate.3 */, + F9183E650EFC80D70030B814 /* try.n */, F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */, F96D3EBD08F272A7004A47F5 /* unknown.n */, F96D3EBE08F272A7004A47F5 /* unload.n */, @@ -3206,6 +3261,7 @@ F96D3EC608F272A7004A47F5 /* vwait.n */, F96D3EC708F272A7004A47F5 /* while.n */, F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */, + F915432D0EF201EE0032D1E8 /* zlib.n */, ); path = doc; sourceTree = "<group>"; @@ -3271,6 +3327,7 @@ F96D3F0008F272A7004A47F5 /* tclIOCmd.c */, F96D3F0108F272A7004A47F5 /* tclIOGT.c */, F96D3F0208F272A7004A47F5 /* tclIORChan.c */, + F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */, F96D3F0308F272A7004A47F5 /* tclIOSock.c */, F96D3F0408F272A7004A47F5 /* tclIOUtil.c */, F96D3F0508F272A7004A47F5 /* tclLink.c */, @@ -3282,6 +3339,19 @@ F96D3F0B08F272A7004A47F5 /* tclNamesp.c */, F96D3F0C08F272A7004A47F5 /* tclNotify.c */, F96D3F0D08F272A7004A47F5 /* tclObj.c */, + F93599B20DF1F75400E04F67 /* tclOO.c */, + F93599B40DF1F75900E04F67 /* tclOO.decls */, + F93599B50DF1F75D00E04F67 /* tclOO.h */, + F93599B60DF1F76100E04F67 /* tclOOBasic.c */, + F93599B80DF1F76600E04F67 /* tclOOCall.c */, + F93599BA0DF1F76A00E04F67 /* tclOODecls.h */, + F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */, + F93599BD0DF1F77400E04F67 /* tclOOInfo.c */, + F93599BF0DF1F77900E04F67 /* tclOOInt.h */, + F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, + F93599C10DF1F78300E04F67 /* tclOOMethod.c */, + F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, + F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, @@ -3320,6 +3390,7 @@ F96D3F3408F272A7004A47F5 /* tclUtf.c */, F96D3F3508F272A7004A47F5 /* tclUtil.c */, F96D3F3608F272A7004A47F5 /* tclVar.c */, + F96437C90EF0D4B2003F468E /* tclZlib.c */, F96D3F3708F272A7004A47F5 /* tommath.h */, ); path = generic; @@ -3414,18 +3485,10 @@ F96D425C08F272B2004A47F5 /* libtommath */ = { isa = PBXGroup; children = ( - F96D425F08F272B3004A47F5 /* bn.pdf */, - F96D426108F272B3004A47F5 /* bn_error.c */, - F96D426208F272B3004A47F5 /* bn_fast_mp_invmod.c */, - F96D426308F272B3004A47F5 /* bn_fast_mp_montgomery_reduce.c */, F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */, - F96D426508F272B3004A47F5 /* bn_fast_s_mp_mul_high_digs.c */, F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */, - F96D426708F272B3004A47F5 /* bn_mp_2expt.c */, - F96D426808F272B3004A47F5 /* bn_mp_abs.c */, F96D426908F272B3004A47F5 /* bn_mp_add.c */, F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */, - F96D426B08F272B3004A47F5 /* bn_mp_addmod.c */, F96D426C08F272B3004A47F5 /* bn_mp_and.c */, F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */, F96D426E08F272B3004A47F5 /* bn_mp_clear.c */, @@ -3433,7 +3496,6 @@ F96D427008F272B3004A47F5 /* bn_mp_cmp.c */, F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */, F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */, - F96D427308F272B3004A47F5 /* bn_mp_cnt_lsb.c */, F96D427408F272B3004A47F5 /* bn_mp_copy.c */, F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */, F96D427608F272B3004A47F5 /* bn_mp_div.c */, @@ -3441,104 +3503,49 @@ F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */, F96D427908F272B3004A47F5 /* bn_mp_div_3.c */, F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */, - F96D427B08F272B3004A47F5 /* bn_mp_dr_is_modulus.c */, - F96D427C08F272B3004A47F5 /* bn_mp_dr_reduce.c */, - F96D427D08F272B3004A47F5 /* bn_mp_dr_setup.c */, F96D427E08F272B3004A47F5 /* bn_mp_exch.c */, F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */, - F96D428008F272B3004A47F5 /* bn_mp_exptmod.c */, - F96D428108F272B3004A47F5 /* bn_mp_exptmod_fast.c */, - F96D428208F272B3004A47F5 /* bn_mp_exteuclid.c */, - F96D428308F272B3004A47F5 /* bn_mp_fread.c */, - F96D428408F272B3004A47F5 /* bn_mp_fwrite.c */, - F96D428508F272B3004A47F5 /* bn_mp_gcd.c */, - F96D428608F272B3004A47F5 /* bn_mp_get_int.c */, F96D428708F272B3004A47F5 /* bn_mp_grow.c */, F96D428808F272B3004A47F5 /* bn_mp_init.c */, F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */, F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */, F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */, - F96D428C08F272B3004A47F5 /* bn_mp_init_set_int.c */, F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */, - F96D428E08F272B3004A47F5 /* bn_mp_invmod.c */, - F96D428F08F272B3004A47F5 /* bn_mp_invmod_slow.c */, - F96D429008F272B3004A47F5 /* bn_mp_is_square.c */, - F96D429108F272B3004A47F5 /* bn_mp_jacobi.c */, F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */, F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */, - F96D429408F272B3004A47F5 /* bn_mp_lcm.c */, F96D429508F272B3004A47F5 /* bn_mp_lshd.c */, F96D429608F272B3004A47F5 /* bn_mp_mod.c */, F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */, - F96D429808F272B3004A47F5 /* bn_mp_mod_d.c */, - F96D429908F272B3004A47F5 /* bn_mp_montgomery_calc_normalization.c */, - F96D429A08F272B3004A47F5 /* bn_mp_montgomery_reduce.c */, - F96D429B08F272B3004A47F5 /* bn_mp_montgomery_setup.c */, F96D429C08F272B3004A47F5 /* bn_mp_mul.c */, F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */, F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */, F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */, - F96D42A008F272B3004A47F5 /* bn_mp_mulmod.c */, - F96D42A108F272B3004A47F5 /* bn_mp_n_root.c */, F96D42A208F272B3004A47F5 /* bn_mp_neg.c */, F96D42A308F272B3004A47F5 /* bn_mp_or.c */, - F96D42A408F272B3004A47F5 /* bn_mp_prime_fermat.c */, - F96D42A508F272B3004A47F5 /* bn_mp_prime_is_divisible.c */, - F96D42A608F272B3004A47F5 /* bn_mp_prime_is_prime.c */, - F96D42A708F272B3004A47F5 /* bn_mp_prime_miller_rabin.c */, - F96D42A808F272B3004A47F5 /* bn_mp_prime_next_prime.c */, - F96D42A908F272B3004A47F5 /* bn_mp_prime_rabin_miller_trials.c */, - F96D42AA08F272B3004A47F5 /* bn_mp_prime_random_ex.c */, F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */, F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */, - F96D42AD08F272B3004A47F5 /* bn_mp_rand.c */, F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */, - F96D42AF08F272B3004A47F5 /* bn_mp_read_signed_bin.c */, - F96D42B008F272B3004A47F5 /* bn_mp_read_unsigned_bin.c */, - F96D42B108F272B3004A47F5 /* bn_mp_reduce.c */, - F96D42B208F272B3004A47F5 /* bn_mp_reduce_2k.c */, - F96D42B308F272B3004A47F5 /* bn_mp_reduce_2k_l.c */, - F96D42B408F272B3004A47F5 /* bn_mp_reduce_2k_setup.c */, - F96D42B508F272B3004A47F5 /* bn_mp_reduce_2k_setup_l.c */, - F96D42B608F272B3004A47F5 /* bn_mp_reduce_is_2k.c */, - F96D42B708F272B3004A47F5 /* bn_mp_reduce_is_2k_l.c */, - F96D42B808F272B3004A47F5 /* bn_mp_reduce_setup.c */, F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */, F96D42BA08F272B3004A47F5 /* bn_mp_set.c */, - F96D42BB08F272B3004A47F5 /* bn_mp_set_int.c */, F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */, - F96D42BD08F272B3004A47F5 /* bn_mp_signed_bin_size.c */, F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */, - F96D42BF08F272B3004A47F5 /* bn_mp_sqrmod.c */, F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */, F96D42C108F272B3004A47F5 /* bn_mp_sub.c */, F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */, - F96D42C308F272B3004A47F5 /* bn_mp_submod.c */, - F96D42C408F272B3004A47F5 /* bn_mp_to_signed_bin.c */, - F96D42C508F272B3004A47F5 /* bn_mp_to_signed_bin_n.c */, F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */, F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */, F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */, F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */, - F96D42CA08F272B3004A47F5 /* bn_mp_toradix.c */, F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */, F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */, F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */, F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */, - F96D42CF08F272B3004A47F5 /* bn_prime_tab.c */, F96D42D008F272B3004A47F5 /* bn_reverse.c */, F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */, - F96D42D208F272B3004A47F5 /* bn_s_mp_exptmod.c */, F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */, - F96D42D408F272B3004A47F5 /* bn_s_mp_mul_high_digs.c */, F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */, F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */, F96D42D708F272B3004A47F5 /* bncore.c */, - F96D42D908F272B3004A47F5 /* callgraph.txt */, - F96D42DA08F272B3004A47F5 /* changes.txt */, - F96D42F008F272B3004A47F5 /* LICENSE */, - F96D431D08F272B4004A47F5 /* poster.pdf */, - F96D432608F272B4004A47F5 /* tommath.pdf */, F96D432908F272B4004A47F5 /* tommath_class.h */, F96D432A08F272B4004A47F5 /* tommath_superclass.h */, ); @@ -3585,6 +3592,7 @@ F96D435608F272B5004A47F5 /* compile.test */, F96D435708F272B5004A47F5 /* concat.test */, F96D435808F272B5004A47F5 /* config.test */, + F974D5770FBE7E6100BF728B /* coroutine.test */, F96D435908F272B5004A47F5 /* dcall.test */, F96D435A08F272B5004A47F5 /* dict.test */, F96D435C08F272B5004A47F5 /* dstring.test */, @@ -3607,7 +3615,9 @@ F96D436E08F272B6004A47F5 /* get.test */, F96D436F08F272B6004A47F5 /* history.test */, F96D437008F272B6004A47F5 /* http.test */, + F974D56C0FBE7D6300BF728B /* http11.test */, F96D437108F272B6004A47F5 /* httpd */, + F974D56D0FBE7D6300BF728B /* httpd11.tcl */, F96D437208F272B6004A47F5 /* httpold.test */, F96D437308F272B6004A47F5 /* if-old.test */, F96D437408F272B6004A47F5 /* if.test */, @@ -3620,7 +3630,6 @@ F96D437B08F272B6004A47F5 /* io.test */, F96D437C08F272B6004A47F5 /* ioCmd.test */, F96D437D08F272B6004A47F5 /* iogt.test */, - F96D437E08F272B6004A47F5 /* ioUtil.test */, F96D437F08F272B6004A47F5 /* join.test */, F96D438008F272B6004A47F5 /* lindex.test */, F96D438108F272B6004A47F5 /* link.test */, @@ -3644,7 +3653,9 @@ F96D439108F272B6004A47F5 /* namespace-old.test */, F96D439208F272B7004A47F5 /* namespace.test */, F96D439308F272B7004A47F5 /* notify.test */, + F91DC23C0E44C51B002CB8D1 /* nre.test */, F96D439408F272B7004A47F5 /* obj.test */, + F93599C80DF1F81900E04F67 /* oo.test */, F96D439508F272B7004A47F5 /* opt.test */, F96D439608F272B7004A47F5 /* package.test */, F96D439708F272B7004A47F5 /* parse.test */, @@ -3679,6 +3690,7 @@ F96D43B408F272B7004A47F5 /* stringObj.test */, F96D43B508F272B7004A47F5 /* subst.test */, F96D43B608F272B7004A47F5 /* switch.test */, + F974D5780FBE7E6100BF728B /* tailcall.test */, F96D43B708F272B7004A47F5 /* tcltest.test */, F96D43B808F272B7004A47F5 /* thread.test */, F96D43B908F272B7004A47F5 /* timer.test */, @@ -3704,6 +3716,7 @@ F96D43CD08F272B7004A47F5 /* winNotify.test */, F96D43CE08F272B7004A47F5 /* winPipe.test */, F96D43CF08F272B7004A47F5 /* winTime.test */, + F915432A0EF201CF0032D1E8 /* zlib.test */, ); path = tests; sourceTree = "<group>"; @@ -3714,6 +3727,7 @@ F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */, F96D43D208F272B8004A47F5 /* configure */, F96D43D308F272B8004A47F5 /* configure.in */, + F96D442208F272B8004A47F5 /* eolFix.tcl */, F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */, F96D442508F272B8004A47F5 /* genStubs.tcl */, F96D442708F272B8004A47F5 /* index.tcl */, @@ -3729,12 +3743,11 @@ F96D443108F272B8004A47F5 /* man2tcl.c */, F96D443208F272B8004A47F5 /* README */, F96D443308F272B8004A47F5 /* regexpTestLib.tcl */, - F96D443408F272B8004A47F5 /* str2c */, F96D443508F272B8004A47F5 /* tcl.hpj.in */, F96D443608F272B8004A47F5 /* tcl.wse.in */, - F96D443708F272B9004A47F5 /* tclmin.wse */, F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */, F96D443A08F272B9004A47F5 /* tclZIC.tcl */, + F92D7F100DE777240033A13A /* tsdPerf.tcl */, F96D443B08F272B9004A47F5 /* uniClass.tcl */, F96D443C08F272B9004A47F5 /* uniParse.tcl */, ); @@ -3754,6 +3767,7 @@ F96D445008F272B9004A47F5 /* Makefile.in */, F96D445208F272B9004A47F5 /* README */, F96D445308F272B9004A47F5 /* tcl.m4 */, + F974D5790FBE7E9C00BF728B /* tcl.pc.in */, F96D445408F272B9004A47F5 /* tcl.spec */, F96D445508F272B9004A47F5 /* tclAppInit.c */, F96D445608F272B9004A47F5 /* tclConfig.h.in */, @@ -3864,8 +3878,8 @@ isa = PBXNativeTarget; buildConfigurationList = F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tktest" */; buildPhases = ( - F9A5C5F508F651A2008AE941 /* ShellScript */, - F9A5C5F608F651AB008AE941 /* ShellScript */, + F9A5C5F508F651A2008AE941 /* Configure Tcl */, + F9A5C5F608F651AB008AE941 /* Configure Tk */, 8DD76FAB0486AB0100D96B5E /* Sources */, 8DD76FAD0486AB0100D96B5E /* Frameworks */, ); @@ -3883,8 +3897,8 @@ isa = PBXNativeTarget; buildConfigurationList = F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tktest-X11" */; buildPhases = ( - F9FD30B40CC1AD070073837D /* ShellScript */, - F9FD30B50CC1AD070073837D /* ShellScript */, + F9FD30B40CC1AD070073837D /* Configure Tcl */, + F9FD30B50CC1AD070073837D /* Configure Tk */, F9FD30BB0CC1AD070073837D /* Sources */, F9FD31E30CC1AD070073837D /* Frameworks */, ); @@ -3902,7 +3916,7 @@ isa = PBXNativeTarget; buildConfigurationList = F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tk" */; buildPhases = ( - F97AF02F0B665DA900310EA2 /* ShellScript */, + F97AF02F0B665DA900310EA2 /* Build Tk */, ); buildRules = ( ); @@ -3921,12 +3935,15 @@ attributes = { BuildIndependentTargetsInParallel = YES; }; - buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Wish" */; + buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tk" */; compatibilityVersion = "Xcode 3.2"; hasScannedForEncodings = 1; - mainGroup = 08FB7794FE84155DC02AAC07 /* Wish */; + mainGroup = 08FB7794FE84155DC02AAC07 /* Tk */; projectDirPath = ""; - projectRoot = ..; + projectRoots = ( + .., + ../../tcl, + ); targets = ( F9E61D16090A3E94002B3151 /* Tk */, 8DD76FA90486AB0100D96B5E /* tktest */, @@ -3936,7 +3953,7 @@ /* End PBXProject section */ /* Begin PBXShellScriptBuildPhase section */ - F97AF02F0B665DA900310EA2 /* ShellScript */ = { + F97AF02F0B665DA900310EA2 /* Build Tk */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -3944,15 +3961,16 @@ inputPaths = ( "${TARGET_TEMP_DIR}/.none", ); + name = "Build Tk"; outputPaths = ( "${TARGET_BUILD_DIR}/${WRAPPER_NAME}", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "gnumake -C \"${TK_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" APPLICATION_INSTALL_PATH=\"${APPLICATION_INSTALL_PATH}\" TCL_BUILD_DIR=\"${TCL_BUILD_DIR}\" TCL_FRAMEWORK_DIR=\"${TCL_FRAMEWORK_DIR}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${BUILT_PRODUCTS_DIR}/tktest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tktest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n"; + shellScript = "export CC=$(xcrun -find ${GCC} || echo ${GCC}); export LD=${CC}\ngnumake -C \"${TK_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" APPLICATION_INSTALL_PATH=\"${APPLICATION_INSTALL_PATH}\" TCL_BUILD_DIR=\"${TCL_BUILD_DIR}\" TCL_FRAMEWORK_DIR=\"${TCL_FRAMEWORK_DIR}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${BUILT_PRODUCTS_DIR}/tktest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tktest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n"; showEnvVarsInLog = 0; }; - F9A5C5F508F651A2008AE941 /* ShellScript */ = { + F9A5C5F508F651A2008AE941 /* Configure Tcl */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -3966,15 +3984,16 @@ "$(TCL_SRCROOT)/unix/Makefile.in", "$(TCL_SRCROOT)/unix/dltest/Makefile.in", ); + name = "Configure Tcl"; outputPaths = ( "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; + shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; showEnvVarsInLog = 0; }; - F9A5C5F608F651AB008AE941 /* ShellScript */ = { + F9A5C5F608F651AB008AE941 /* Configure Tk */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -3986,15 +4005,16 @@ "$(TK_SRCROOT)/unix/aclocal.m4", "$(TK_SRCROOT)/unix/tkConfig.sh.in", ); + name = "Configure Tk"; outputPaths = ( "$(DERIVED_FILE_DIR)/tk/tkConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "## tk configure shell script phase\n\ncd \"${TK_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tk/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tk && cd tk &&\nif [ \"${TK_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tk\"\n \"${TK_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --enable-aqua --with-tcl=../tcl ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi"; + shellScript = "## tk configure shell script phase\n\ncd \"${TK_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tk/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tk && cd tk &&\nif [ \"${TK_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tk\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TK_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --enable-aqua --with-tcl=../tcl CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; showEnvVarsInLog = 0; }; - F9FD30B40CC1AD070073837D /* ShellScript */ = { + F9FD30B40CC1AD070073837D /* Configure Tcl */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -4008,15 +4028,16 @@ "$(TCL_SRCROOT)/unix/Makefile.in", "$(TCL_SRCROOT)/unix/dltest/Makefile.in", ); + name = "Configure Tcl"; outputPaths = ( "$(DERIVED_FILE_DIR)/tcl/tclConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --disable-corefoundation ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; + shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n"; showEnvVarsInLog = 0; }; - F9FD30B50CC1AD070073837D /* ShellScript */ = { + F9FD30B50CC1AD070073837D /* Configure Tk */ = { isa = PBXShellScriptBuildPhase; buildActionMask = 2147483647; files = ( @@ -4028,12 +4049,13 @@ "$(TK_SRCROOT)/unix/aclocal.m4", "$(TK_SRCROOT)/unix/tkConfig.sh.in", ); + name = "Configure Tk"; outputPaths = ( "$(DERIVED_FILE_DIR)/tk/tkConfig.sh", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "## tk configure shell script phase\n\ncd \"${TK_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tk/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tk && cd tk &&\nif [ \"${TK_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tk\"\n PATH=\"${PATH}:/usr/X11R6/bin\" \"${TK_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --disable-corefoundation --enable-xft --with-tcl=../tcl ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi"; + shellScript = "## tk configure shell script phase\n\ncd \"${TK_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tk/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tk && cd tk &&\nif [ \"${TK_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tk\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n PATH=\"${PATH}:/usr/X11R6/bin\" \"${TK_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared --enable-xft --with-tcl=../tcl CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi"; showEnvVarsInLog = 0; }; /* End PBXShellScriptBuildPhase section */ @@ -4077,6 +4099,7 @@ F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */, F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */, F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */, + F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */, F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */, F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */, F96D45A408F272BC004A47F5 /* tclLink.c in Sources */, @@ -4087,6 +4110,14 @@ F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */, F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */, F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */, + F93599B30DF1F75400E04F67 /* tclOO.c in Sources */, + F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */, + F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */, + F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */, + F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, + F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, + F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, + F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, @@ -4114,6 +4145,7 @@ F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */, F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */, F96D45D508F272BC004A47F5 /* tclVar.c in Sources */, + F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */, F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */, F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */, F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */, @@ -4196,6 +4228,7 @@ F966BDD208F27A3F005CB29B /* tkAtom.c in Sources */, F966BDD308F27A3F005CB29B /* tkBind.c in Sources */, F966BDD408F27A3F005CB29B /* tkBitmap.c in Sources */, + F9152B090EAF8A5000CD5C7B /* tkBusy.c in Sources */, F966BDD508F27A3F005CB29B /* tkButton.c in Sources */, F966BDD708F27A3F005CB29B /* tkCanvArc.c in Sources */, F966BDD808F27A3F005CB29B /* tkCanvas.c in Sources */, @@ -4228,7 +4261,9 @@ F966BDFA08F27A3F005CB29B /* tkImage.c in Sources */, F966BDFB08F27A3F005CB29B /* tkImgBmap.c in Sources */, F966BDFC08F27A3F005CB29B /* tkImgGIF.c in Sources */, + F92EE8BF0E62F846001A6E80 /* tkImgPhInstance.c in Sources */, F966BDFD08F27A3F005CB29B /* tkImgPhoto.c in Sources */, + F9DD99BD0F07DF850018B2E4 /* tkImgPNG.c in Sources */, F966BDFE08F27A3F005CB29B /* tkImgPPM.c in Sources */, F966BE0708F27A3F005CB29B /* tkListbox.c in Sources */, F966BE0808F27A3F005CB29B /* tkMacWinMenu.c in Sources */, @@ -4378,6 +4413,7 @@ F9FD30DB0CC1AD070073837D /* tclIOCmd.c in Sources */, F9FD30DC0CC1AD070073837D /* tclIOGT.c in Sources */, F9FD30DD0CC1AD070073837D /* tclIORChan.c in Sources */, + F9FFAF1D0DFDDB26007F8A6A /* tclIORTrans.c in Sources */, F9FD30DE0CC1AD070073837D /* tclIOSock.c in Sources */, F9FD30DF0CC1AD070073837D /* tclIOUtil.c in Sources */, F9FD30E00CC1AD070073837D /* tclLink.c in Sources */, @@ -4388,6 +4424,14 @@ F9FD30E50CC1AD070073837D /* tclNamesp.c in Sources */, F9FD30E60CC1AD070073837D /* tclNotify.c in Sources */, F9FD30E70CC1AD070073837D /* tclObj.c in Sources */, + F9FFAF1F0DFDDB2F007F8A6A /* tclOO.c in Sources */, + F9FFAF200DFDDB32007F8A6A /* tclOOBasic.c in Sources */, + F9FFAF210DFDDB32007F8A6A /* tclOOCall.c in Sources */, + F9FFAF220DFDDB34007F8A6A /* tclOODefineCmds.c in Sources */, + F9FFAF230DFDDB35007F8A6A /* tclOOInfo.c in Sources */, + F9FFAF240DFDDB36007F8A6A /* tclOOMethod.c in Sources */, + F9FFAF250DFDDB37007F8A6A /* tclOOStubInit.c in Sources */, + F9FFAF260DFDDB38007F8A6A /* tclOOStubLib.c in Sources */, F9FD30E80CC1AD070073837D /* tclPanic.c in Sources */, F9FD30E90CC1AD070073837D /* tclParse.c in Sources */, F9FD30EA0CC1AD070073837D /* tclPathObj.c in Sources */, @@ -4415,6 +4459,7 @@ F9FD31000CC1AD070073837D /* tclUtf.c in Sources */, F9FD31010CC1AD070073837D /* tclUtil.c in Sources */, F9FD31020CC1AD070073837D /* tclVar.c in Sources */, + F96437CB0EF0D4B2003F468E /* tclZlib.c in Sources */, F9FD31030CC1AD070073837D /* bn_fast_s_mp_mul_digs.c in Sources */, F9FD31040CC1AD070073837D /* bn_fast_s_mp_sqr.c in Sources */, F9FD31050CC1AD070073837D /* bn_mp_add.c in Sources */, @@ -4497,6 +4542,7 @@ F9FD31510CC1AD070073837D /* tkAtom.c in Sources */, F9FD31520CC1AD070073837D /* tkBind.c in Sources */, F9FD31530CC1AD070073837D /* tkBitmap.c in Sources */, + F9152B0A0EAF8A5700CD5C7B /* tkBusy.c in Sources */, F9FD31540CC1AD070073837D /* tkButton.c in Sources */, F9FD31550CC1AD070073837D /* tkCanvArc.c in Sources */, F9FD31560CC1AD070073837D /* tkCanvas.c in Sources */, @@ -4529,7 +4575,9 @@ F9FD31710CC1AD070073837D /* tkImage.c in Sources */, F9FD31720CC1AD070073837D /* tkImgBmap.c in Sources */, F9FD31730CC1AD070073837D /* tkImgGIF.c in Sources */, + F92EE8D30E62F939001A6E80 /* tkImgPhInstance.c in Sources */, F9FD31740CC1AD070073837D /* tkImgPhoto.c in Sources */, + F9DD99BE0F07DF850018B2E4 /* tkImgPNG.c in Sources */, F9FD31750CC1AD070073837D /* tkImgPPM.c in Sources */, F9FD31760CC1AD070073837D /* tkListbox.c in Sources */, F9FD31770CC1AD070073837D /* tkMacWinMenu.c in Sources */, @@ -4627,59 +4675,51 @@ /* End PBXSourcesBuildPhase section */ /* Begin XCBuildConfiguration section */ - F90E36D50F3B5C8400810A10 /* Debug gcc42 nogc */ = { + F90E36D50F3B5C8400810A10 /* DebugNoGC */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = unsupported; GCC_ENABLE_PASCAL_STRINGS = NO; GCC_INPUT_FILETYPE = sourcecode.c.objc; - GCC_VERSION = 4.2; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; - name = "Debug gcc42 nogc"; + name = DebugNoGC; }; - F90E36D60F3B5C8400810A10 /* Debug gcc42 nogc */ = { + F90E36D60F3B5C8400810A10 /* DebugNoGC */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "Debug gcc42 nogc"; + name = DebugNoGC; }; - F90E36D70F3B5C8400810A10 /* Debug gcc42 nogc */ = { + F90E36D70F3B5C8400810A10 /* DebugNoGC */ = { isa = XCBuildConfiguration; buildSettings = { - CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; - GCC_DYNAMIC_NO_PIC = NO; - GCC_ENABLE_FIX_AND_CONTINUE = YES; - GCC_PREPROCESSOR_DEFINITIONS = ( - "__private_extern__=extern", - "$(GCC_PREPROCESSOR_DEFINITIONS)", - ); - GCC_SYMBOLS_PRIVATE_EXTERN = NO; OTHER_LDFLAGS = ( "$(OTHER_LDFLAGS_AQUA)", "$(OTHER_LDFLAGS)", ); PRODUCT_NAME = tktest; }; - name = "Debug gcc42 nogc"; + name = DebugNoGC; }; - F90E36D80F3B5C8400810A10 /* Debug gcc42 nogc */ = { + F90E36D80F3B5C8400810A10 /* DebugNoGC */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_INPUT_FILETYPE = sourcecode.c.c; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", @@ -4696,7 +4736,7 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "Debug gcc42 nogc"; + name = DebugNoGC; }; F91BCC4F093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; @@ -4719,7 +4759,7 @@ }; F91BCC51093152310042A6BF /* ReleaseUniversal */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; @@ -4754,6 +4794,7 @@ F93084390BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -4769,11 +4810,11 @@ }; F930843A0BB93D2800CD0B9E /* DebugMemCompile */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --enable-symbols=all"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; @@ -4789,11 +4830,11 @@ }; F9359B250DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; @@ -4834,6 +4875,7 @@ F9359B280DF212DA00E04F67 /* DebugGCov */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -4863,13 +4905,13 @@ }; name = Release; }; - F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */ = { + F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = DebugNoFixZL; + name = DebugNoFixAndContinue; }; F95CC8B109158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; @@ -4901,7 +4943,7 @@ }; name = Release; }; - F95CC8B309158F3100EA5ACE /* DebugNoFixZL */ = { + F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_LDFLAGS = ( @@ -4910,15 +4952,15 @@ ); PRODUCT_NAME = tktest; }; - name = DebugNoFixZL; + name = DebugNoFixAndContinue; }; F95CC8B609158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; @@ -4933,25 +4975,30 @@ }; F95CC8B709158F3100EA5ACE /* Release */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { - ARCHS = "$(NATIVE_ARCH_32_BIT)"; + ARCHS = ( + "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", + ); + CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; GCC_INPUT_FILETYPE = sourcecode.c.objc; MACOSX_DEPLOYMENT_TARGET = 10.6; + ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; name = Release; }; - F95CC8B809158F3100EA5ACE /* DebugNoFixZL */ = { + F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; @@ -4962,7 +5009,7 @@ ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; - name = DebugNoFixZL; + name = DebugNoFixAndContinue; }; F97258A90A86873D00096C78 /* Debug */ = { isa = XCBuildConfiguration; @@ -4970,6 +5017,7 @@ CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_INPUT_FILETYPE = sourcecode.c.c; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", @@ -4991,6 +5039,7 @@ F97258AA0A86873D00096C78 /* Release */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5004,9 +5053,10 @@ }; name = Release; }; - F97258AB0A86873D00096C78 /* DebugNoFixZL */ = { + F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5018,13 +5068,14 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = DebugNoFixZL; + name = DebugNoFixAndContinue; }; F97258AC0A86873D00096C78 /* ReleaseUniversal */ = { isa = XCBuildConfiguration; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5060,6 +5111,7 @@ F97AED1D0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5075,7 +5127,7 @@ }; F97AED1E0B660B2100310EA2 /* Debug64bit */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = "$(NATIVE_ARCH_64_BIT)"; CONFIGURE_ARGS = "--enable-64bit $(CONFIGURE_ARGS)"; @@ -5091,11 +5143,11 @@ }; F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; @@ -5133,6 +5185,7 @@ F98751320DE7B57E00B1C9EC /* DebugNoCF */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5148,11 +5201,11 @@ }; F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; @@ -5190,6 +5243,7 @@ F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5203,35 +5257,35 @@ }; name = DebugNoCFUnthreaded; }; - F9988AB10D814C6500B6B03B /* Debug gcc42 */ = { + F9988AB10D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; GCC_INPUT_FILETYPE = sourcecode.c.objc; - GCC_VERSION = 4.2; + GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; - name = "Debug gcc42"; + name = "Debug gcc40"; }; - F9988AB20D814C6500B6B03B /* Debug gcc42 */ = { + F9988AB20D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "Debug gcc42"; + name = "Debug gcc40"; }; - F9988AB30D814C6500B6B03B /* Debug gcc42 */ = { + F9988AB30D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; @@ -5248,14 +5302,15 @@ ); PRODUCT_NAME = tktest; }; - name = "Debug gcc42"; + name = "Debug gcc40"; }; - F9988AB40D814C6500B6B03B /* Debug gcc42 */ = { + F9988AB40D814C6500B6B03B /* Debug gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_INPUT_FILETYPE = sourcecode.c.c; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", @@ -5272,18 +5327,18 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "Debug gcc42"; + name = "Debug gcc40"; }; - F9988AB50D814C7500B6B03B /* Debug llvmgcc42 */ = { + F9988AB50D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); - CC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc-4.2"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; + GCC = "llvm-gcc"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; @@ -5293,17 +5348,17 @@ ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; }; - name = "Debug llvmgcc42"; + name = "Debug llvm-gcc"; }; - F9988AB60D814C7500B6B03B /* Debug llvmgcc42 */ = { + F9988AB60D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "Debug llvmgcc42"; + name = "Debug llvm-gcc"; }; - F9988AB70D814C7500B6B03B /* Debug llvmgcc42 */ = { + F9988AB70D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; @@ -5320,14 +5375,15 @@ ); PRODUCT_NAME = tktest; }; - name = "Debug llvmgcc42"; + name = "Debug llvm-gcc"; }; - F9988AB80D814C7500B6B03B /* Debug llvmgcc42 */ = { + F9988AB80D814C7500B6B03B /* Debug llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; GCC_DYNAMIC_NO_PIC = NO; GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_INPUT_FILETYPE = sourcecode.c.c; GCC_PREPROCESSOR_DEFINITIONS = ( "__private_extern__=extern", "$(GCC_PREPROCESSOR_DEFINITIONS)", @@ -5344,11 +5400,11 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "Debug llvmgcc42"; + name = "Debug llvm-gcc"; }; - F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc42 */ = { + F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; @@ -5356,21 +5412,21 @@ GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; GCC_INPUT_FILETYPE = sourcecode.c.objc; - GCC_VERSION = 4.2; + GCC_VERSION = 4.0; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; }; - name = "ReleaseUniversal gcc42"; + name = "ReleaseUniversal gcc40"; }; - F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc42 */ = { + F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "ReleaseUniversal gcc42"; + name = "ReleaseUniversal gcc40"; }; - F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc42 */ = { + F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_LDFLAGS = ( @@ -5379,13 +5435,14 @@ ); PRODUCT_NAME = tktest; }; - name = "ReleaseUniversal gcc42"; + name = "ReleaseUniversal gcc40"; }; - F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc42 */ = { + F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */ = { isa = XCBuildConfiguration; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5397,40 +5454,37 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "ReleaseUniversal gcc42"; + name = "ReleaseUniversal gcc40"; }; - F9988BB50D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = { + F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { - ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", - "$(NATIVE_ARCH_64_BIT)", - ); - CC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc-4.2"; - CFLAGS = "-arch i386 -arch x86_64 $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; + CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; DEBUG_INFORMATION_FORMAT = dwarf; + GCC = "llvm-gcc"; GCC_C_LANGUAGE_STANDARD = gnu99; GCC_ENABLE_OBJC_GC = supported; GCC_ENABLE_PASCAL_STRINGS = NO; GCC_INPUT_FILETYPE = sourcecode.c.objc; GCC_OPTIMIZATION_LEVEL = 4; + "GCC_OPTIMIZATION_LEVEL[arch=ppc]" = s; GCC_VERSION = com.apple.compilers.llvmgcc42; MACOSX_DEPLOYMENT_TARGET = 10.6; PREBINDING = NO; - TCL_CONFIGURE_ARGS = "$(TCL_CONFIGURE_ARGS) --disable-dtrace"; }; - name = "ReleaseUniversal llvmgcc42"; + name = "ReleaseUniversal llvm-gcc"; }; - F9988BB60D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = { + F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = Wish; SKIP_INSTALL = NO; }; - name = "ReleaseUniversal llvmgcc42"; + name = "ReleaseUniversal llvm-gcc"; }; - F9988BB70D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = { + F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { OTHER_LDFLAGS = ( @@ -5439,13 +5493,14 @@ ); PRODUCT_NAME = tktest; }; - name = "ReleaseUniversal llvmgcc42"; + name = "ReleaseUniversal llvm-gcc"; }; - F9988BB80D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = { + F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = { isa = XCBuildConfiguration; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5457,7 +5512,7 @@ ); PRODUCT_NAME = "tktest-X11"; }; - name = "ReleaseUniversal llvmgcc42"; + name = "ReleaseUniversal llvm-gcc"; }; F99EE73B0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; @@ -5500,6 +5555,7 @@ F99EE73F0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5516,6 +5572,7 @@ F99EE7400BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; buildSettings = { + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5531,11 +5588,11 @@ }; F99EE7410BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads"; CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; @@ -5551,11 +5608,11 @@ }; F99EE7420BE835310060D4AF /* DebugLeaks */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Wish-Debug.xcconfig */; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; buildSettings = { ARCHS = ( - "$(NATIVE_ARCH_32_BIT)", "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", ); CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; GCC_C_LANGUAGE_STANDARD = gnu99; @@ -5569,9 +5626,141 @@ MACOSX_DEPLOYMENT_TARGET = 10.6; ONLY_ACTIVE_ARCH = YES; PREBINDING = NO; + RUN_CLANG_STATIC_ANALYZER = YES; }; name = DebugLeaks; }; + F9A9D1EF0FC77787002A2BE3 /* Debug clang */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tk-Debug.xcconfig */; + buildSettings = { + ARCHS = ( + "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", + ); + CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)"; + GCC = clang; + GCC_C_LANGUAGE_STANDARD = gnu99; + GCC_ENABLE_OBJC_GC = supported; + GCC_ENABLE_PASCAL_STRINGS = NO; + GCC_INPUT_FILETYPE = sourcecode.c.objc; + GCC_VERSION = com.apple.compilers.llvm.clang.1_0; + MACOSX_DEPLOYMENT_TARGET = 10.6; + ONLY_ACTIVE_ARCH = YES; + PREBINDING = NO; + }; + name = "Debug clang"; + }; + F9A9D1F00FC77787002A2BE3 /* Debug clang */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = Wish; + SKIP_INSTALL = NO; + }; + name = "Debug clang"; + }; + F9A9D1F10FC77787002A2BE3 /* Debug clang */ = { + isa = XCBuildConfiguration; + buildSettings = { + CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; + GCC_DYNAMIC_NO_PIC = NO; + GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_PREPROCESSOR_DEFINITIONS = ( + "__private_extern__=extern", + "$(GCC_PREPROCESSOR_DEFINITIONS)", + ); + GCC_SYMBOLS_PRIVATE_EXTERN = NO; + OTHER_LDFLAGS = ( + "$(OTHER_LDFLAGS_AQUA)", + "$(OTHER_LDFLAGS)", + ); + PRODUCT_NAME = tktest; + }; + name = "Debug clang"; + }; + F9A9D1F20FC77787002A2BE3 /* Debug clang */ = { + isa = XCBuildConfiguration; + buildSettings = { + CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)"; + GCC_DYNAMIC_NO_PIC = NO; + GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_PREPROCESSOR_DEFINITIONS = ( + "__private_extern__=extern", + "$(GCC_PREPROCESSOR_DEFINITIONS)", + ); + GCC_SYMBOLS_PRIVATE_EXTERN = NO; + HEADER_SEARCH_PATHS = ( + /usr/X11R6/include, + /usr/X11R6/include/freetype2, + "$(HEADER_SEARCH_PATHS)", + ); + LIBRARY_SEARCH_PATHS = ( + /usr/X11R6/lib, + "$(LIBRARY_SEARCH_PATHS)", + ); + PRODUCT_NAME = "tktest-X11"; + }; + name = "Debug clang"; + }; + F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; + buildSettings = { + ARCHS = ( + "$(NATIVE_ARCH_64_BIT)", + "$(NATIVE_ARCH_32_BIT)", + ); + CFLAGS = "-arch i386 -arch x86_64 $(CFLAGS)"; + DEBUG_INFORMATION_FORMAT = dwarf; + GCC = clang; + GCC_C_LANGUAGE_STANDARD = gnu99; + GCC_ENABLE_OBJC_GC = supported; + GCC_ENABLE_PASCAL_STRINGS = NO; + GCC_INPUT_FILETYPE = sourcecode.c.objc; + GCC_OPTIMIZATION_LEVEL = 4; + GCC_VERSION = com.apple.compilers.llvm.clang.1_0; + MACOSX_DEPLOYMENT_TARGET = 10.6; + PREBINDING = NO; + }; + name = "ReleaseUniversal clang"; + }; + F9A9D1F40FC77799002A2BE3 /* ReleaseUniversal clang */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = Wish; + SKIP_INSTALL = NO; + }; + name = "ReleaseUniversal clang"; + }; + F9A9D1F50FC77799002A2BE3 /* ReleaseUniversal clang */ = { + isa = XCBuildConfiguration; + buildSettings = { + OTHER_LDFLAGS = ( + "$(OTHER_LDFLAGS_AQUA)", + "$(OTHER_LDFLAGS)", + ); + PRODUCT_NAME = tktest; + }; + name = "ReleaseUniversal clang"; + }; + F9A9D1F60FC77799002A2BE3 /* ReleaseUniversal clang */ = { + isa = XCBuildConfiguration; + buildSettings = { + ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; + CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + HEADER_SEARCH_PATHS = ( + /usr/X11R6/include, + /usr/X11R6/include/freetype2, + "$(HEADER_SEARCH_PATHS)", + ); + LIBRARY_SEARCH_PATHS = ( + /usr/X11R6/lib, + "$(LIBRARY_SEARCH_PATHS)", + ); + PRODUCT_NAME = "tktest-X11"; + }; + name = "ReleaseUniversal clang"; + }; F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; buildSettings = { @@ -5596,6 +5785,7 @@ buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; + GCC_INPUT_FILETYPE = sourcecode.c.c; HEADER_SEARCH_PATHS = ( /usr/X11R6/include, /usr/X11R6/include/freetype2, @@ -5611,7 +5801,7 @@ }; F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = { isa = XCBuildConfiguration; - baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Wish-Release.xcconfig */; + baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tk-Release.xcconfig */; buildSettings = { ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)"; @@ -5633,10 +5823,11 @@ isa = XCConfigurationList; buildConfigurations = ( F95CC8AC09158F3100EA5ACE /* Debug */, - F9988AB20D814C6500B6B03B /* Debug gcc42 */, - F90E36D60F3B5C8400810A10 /* Debug gcc42 nogc */, - F9988AB60D814C7500B6B03B /* Debug llvmgcc42 */, - F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */, + F9A9D1F00FC77787002A2BE3 /* Debug clang */, + F9988AB60D814C7500B6B03B /* Debug llvm-gcc */, + F9988AB20D814C6500B6B03B /* Debug gcc40 */, + F90E36D60F3B5C8400810A10 /* DebugNoGC */, + F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE73B0BE835310060D4AF /* DebugUnthreaded */, F98751300DE7B57E00B1C9EC /* DebugNoCF */, F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, @@ -5646,8 +5837,9 @@ F97AED1B0B660B2100310EA2 /* Debug64bit */, F95CC8AD09158F3100EA5ACE /* Release */, F91BCC4F093152310042A6BF /* ReleaseUniversal */, - F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc42 */, - F9988BB60D81587400B6B03B /* ReleaseUniversal llvmgcc42 */, + F9A9D1F40FC77799002A2BE3 /* ReleaseUniversal clang */, + F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */, + F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; @@ -5657,10 +5849,11 @@ isa = XCConfigurationList; buildConfigurations = ( F95CC8B109158F3100EA5ACE /* Debug */, - F9988AB30D814C6500B6B03B /* Debug gcc42 */, - F90E36D70F3B5C8400810A10 /* Debug gcc42 nogc */, - F9988AB70D814C7500B6B03B /* Debug llvmgcc42 */, - F95CC8B309158F3100EA5ACE /* DebugNoFixZL */, + F9A9D1F10FC77787002A2BE3 /* Debug clang */, + F9988AB70D814C7500B6B03B /* Debug llvm-gcc */, + F9988AB30D814C6500B6B03B /* Debug gcc40 */, + F90E36D70F3B5C8400810A10 /* DebugNoGC */, + F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE73D0BE835310060D4AF /* DebugUnthreaded */, F98751310DE7B57E00B1C9EC /* DebugNoCF */, F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, @@ -5670,21 +5863,23 @@ F97AED1C0B660B2100310EA2 /* Debug64bit */, F95CC8B209158F3100EA5ACE /* Release */, F91BCC50093152310042A6BF /* ReleaseUniversal */, - F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc42 */, - F9988BB70D81587400B6B03B /* ReleaseUniversal llvmgcc42 */, + F9A9D1F50FC77799002A2BE3 /* ReleaseUniversal clang */, + F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */, + F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; defaultConfigurationName = Debug; }; - F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Wish" */ = { + F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tk" */ = { isa = XCConfigurationList; buildConfigurations = ( F95CC8B609158F3100EA5ACE /* Debug */, - F9988AB10D814C6500B6B03B /* Debug gcc42 */, - F90E36D50F3B5C8400810A10 /* Debug gcc42 nogc */, - F9988AB50D814C7500B6B03B /* Debug llvmgcc42 */, - F95CC8B809158F3100EA5ACE /* DebugNoFixZL */, + F9A9D1EF0FC77787002A2BE3 /* Debug clang */, + F9988AB50D814C7500B6B03B /* Debug llvm-gcc */, + F9988AB10D814C6500B6B03B /* Debug gcc40 */, + F90E36D50F3B5C8400810A10 /* DebugNoGC */, + F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */, F99EE7410BE835310060D4AF /* DebugUnthreaded */, F987512F0DE7B57E00B1C9EC /* DebugNoCF */, F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, @@ -5694,8 +5889,9 @@ F97AED1E0B660B2100310EA2 /* Debug64bit */, F95CC8B709158F3100EA5ACE /* Release */, F91BCC51093152310042A6BF /* ReleaseUniversal */, - F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc42 */, - F9988BB50D81587400B6B03B /* ReleaseUniversal llvmgcc42 */, + F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */, + F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */, + F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; @@ -5705,10 +5901,11 @@ isa = XCConfigurationList; buildConfigurations = ( F97258A90A86873D00096C78 /* Debug */, - F9988AB40D814C6500B6B03B /* Debug gcc42 */, - F90E36D80F3B5C8400810A10 /* Debug gcc42 nogc */, - F9988AB80D814C7500B6B03B /* Debug llvmgcc42 */, - F97258AB0A86873D00096C78 /* DebugNoFixZL */, + F9A9D1F20FC77787002A2BE3 /* Debug clang */, + F9988AB80D814C7500B6B03B /* Debug llvm-gcc */, + F9988AB40D814C6500B6B03B /* Debug gcc40 */, + F90E36D80F3B5C8400810A10 /* DebugNoGC */, + F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */, F99EE73F0BE835310060D4AF /* DebugUnthreaded */, F98751320DE7B57E00B1C9EC /* DebugNoCF */, F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, @@ -5718,8 +5915,9 @@ F97AED1D0B660B2100310EA2 /* Debug64bit */, F97258AA0A86873D00096C78 /* Release */, F97258AC0A86873D00096C78 /* ReleaseUniversal */, - F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc42 */, - F9988BB80D81587400B6B03B /* ReleaseUniversal llvmgcc42 */, + F9A9D1F60FC77799002A2BE3 /* ReleaseUniversal clang */, + F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */, + F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */, F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */, ); defaultConfigurationIsVisible = 0; diff --git a/macosx/Wish-Info.plist.in b/macosx/Wish-Info.plist.in index dd79d75..db75cf2 100644 --- a/macosx/Wish-Info.plist.in +++ b/macosx/Wish-Info.plist.in @@ -40,13 +40,14 @@ <string>Wish</string> <key>CFBundleGetInfoString</key> <string>Wish Shell @TK_VERSION@@TK_PATCH_LEVEL@, -Copyright © 1989-@TK_YEAR@ Tcl Core Team, -Copyright © 2002-@TK_YEAR@ Daniel A. Steffen, + Copyright © 1989-@TK_YEAR@ Tcl Core Team, Copyright © 1989-@TK_YEAR@ Contributors, Copyright © 2011-@TK_YEAR@ Kevin Walzer/WordTech Communications LLC, -Copyright © 2001-2009 Apple Inc., -Copyright © 2001-2002 Jim Ingham & Ian Reid</string> + Copyright © 2014-@TK_YEAR@ Marc Culler, + Copyright © 2002-@TK_YEAR@ Daniel A. Steffen, + Copyright © 2001-2009 Apple Inc., + Copyright © 2001-2002 Jim Ingham & Ian Reid</string> <key>CFBundleIconFile</key> <string>Wish.icns</string> <key>CFBundleIdentifier</key> diff --git a/macosx/Wish.icns b/macosx/Wish.icns Binary files differdeleted file mode 100644 index 394b588..0000000 --- a/macosx/Wish.icns +++ /dev/null diff --git a/macosx/tkMacOSXBitmap.c b/macosx/tkMacOSXBitmap.c index f503460..52768c6 100644 --- a/macosx/tkMacOSXBitmap.c +++ b/macosx/tkMacOSXBitmap.c @@ -55,7 +55,7 @@ typedef struct { char *value; } IconBitmap; -static const char *iconBitmapOptionStrings[] = { +static const char *const iconBitmapOptionStrings[] = { "-file", "-fileType", "-osType", "-systemType", "-namedImage", "-imageFile", NULL }; @@ -97,8 +97,8 @@ TkpDefineNativeBitmaps(void) name = Tk_GetUid(builtInPtr->name); predefHashPtr = Tcl_CreateHashEntry(tablePtr, name, &isNew); if (isNew) { - TkPredefBitmap *predefPtr = (TkPredefBitmap *) - ckalloc(sizeof(TkPredefBitmap)); + TkPredefBitmap *predefPtr = ckalloc(sizeof(TkPredefBitmap)); + predefPtr->source = UINT2PTR(builtInPtr->iconType); predefPtr->width = builtInIconSize; predefPtr->height = builtInIconSize; @@ -166,7 +166,7 @@ GetBitmapForIcon( Pixmap TkpCreateNativeBitmap( Display *display, - const char *source) /* Info about the icon to build. */ + const void *source) /* Info about the icon to build. */ { Pixmap pixmap; IconRef icon; @@ -394,7 +394,8 @@ TkMacOSXIconBitmapObjCmd( } name = Tcl_GetStringFromObj(objv[i++], &len); if (!len) { - Tcl_AppendResult(interp, "empty bitmap name", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty bitmap name", -1)); + Tcl_SetErrorCode(interp, "TK", "MACBITMAP", "BAD", NULL); goto end; } if (Tcl_GetIntFromObj(interp, objv[i++], &ib.width) != TCL_OK) { @@ -403,25 +404,29 @@ TkMacOSXIconBitmapObjCmd( if (Tcl_GetIntFromObj(interp, objv[i++], &ib.height) != TCL_OK) { goto end; } - if (Tcl_GetIndexFromObj(interp, objv[i++], iconBitmapOptionStrings, - "kind", TCL_EXACT, &ib.kind) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i++], iconBitmapOptionStrings, + sizeof(char *), "kind", TCL_EXACT, &ib.kind) != TCL_OK) { goto end; } value = Tcl_GetStringFromObj(objv[i++], &len); if (!len) { - Tcl_AppendResult(interp, "empty bitmap value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty bitmap value", -1)); + Tcl_SetErrorCode(interp, "TK", "MACBITMAP", "EMPTY", NULL); goto end; } #if 0 if ((kind == ICON_TYPE || kind == ICON_SYSTEM)) { Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); + Tcl_UtfToExternalDString(encoding, value, -1, &ds); len = Tcl_DStringLength(&ds); Tcl_DStringFree(&ds); Tcl_FreeEncoding(encoding); if (len > 4) { - Tcl_AppendResult(interp, "invalid bitmap value", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invalid bitmap value", -1)); + Tcl_SetErrorCode(interp, "TK", "MACBITMAP", "INVALID", NULL); goto end; } } @@ -436,12 +441,12 @@ TkMacOSXIconBitmapObjCmd( iconBitmap = Tcl_GetHashValue(hPtr); ckfree(iconBitmap->value); } else { - iconBitmap = (IconBitmap *) ckalloc(sizeof(IconBitmap)); + iconBitmap = ckalloc(sizeof(IconBitmap)); Tcl_SetHashValue(hPtr, iconBitmap); } *iconBitmap = ib; result = TCL_OK; -end: + end: return result; } diff --git a/macosx/tkMacOSXButton.c b/macosx/tkMacOSXButton.c index adb78c6..59d394e 100644 --- a/macosx/tkMacOSXButton.c +++ b/macosx/tkMacOSXButton.c @@ -102,7 +102,7 @@ static void PulseDefaultButtonProc(ClientData clientData); * The class procedure table for the button widgets. */ -Tk_ClassProcs tkpButtonProcs = { +const Tk_ClassProcs tkpButtonProcs = { sizeof(Tk_ClassProcs), /* size */ TkButtonWorldChanged, /* worldChangedProc */ }; @@ -387,7 +387,7 @@ TkpComputeButtonGeometry( butPtr->inset = 0; butPtr->inset += butPtr->highlightWidth; - + if (TkMacOSXComputeButtonDrawParams(butPtr,&drawParams)) { HIRect tmpRect; HIRect contBounds; @@ -519,7 +519,7 @@ DrawButtonImageAndText( /* * Image is left or right of text */ - + if (butPtr->compound == COMPOUND_LEFT) { textXOffset = width + butPtr->padX; } else { @@ -536,7 +536,7 @@ DrawButtonImageAndText( /* * Image and text are superimposed */ - + fullWidth = (width > butPtr->textWidth ? width : butPtr->textWidth); fullHeight = (height > butPtr->textHeight ? height : @@ -593,7 +593,7 @@ DrawButtonImageAndText( imageXOffset, imageYOffset, 1); XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0); } - + Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->gc, butPtr->textLayout, x + textXOffset, y + textYOffset, 0, -1); @@ -618,7 +618,7 @@ DrawButtonImageAndText( imageYOffset += y; if (butPtr->image != NULL) { - + if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) { Tk_RedrawImage(butPtr->selectImage, 0, 0, width, @@ -1210,3 +1210,4 @@ PulseDefaultButtonProc(ClientData clientData) mbPtr->defaultPulseHandler = Tcl_CreateTimerHandler( PULSE_TIMER_MSECS, PulseDefaultButtonProc, clientData); } + diff --git a/macosx/tkMacOSXClipboard.c b/macosx/tkMacOSXClipboard.c index 6ac7830..07a8419 100644 --- a/macosx/tkMacOSXClipboard.c +++ b/macosx/tkMacOSXClipboard.c @@ -20,8 +20,10 @@ static Tk_Window clipboardOwner = NULL; #pragma mark TKApplication(TKClipboard) @implementation TKApplication(TKClipboard) -- (void)tkProvidePasteboard:(TkDisplay *)dispPtr - pasteboard:(NSPasteboard *)sender provideDataForType:(NSString *)type { +- (void) tkProvidePasteboard: (TkDisplay *) dispPtr + pasteboard: (NSPasteboard *) sender + provideDataForType: (NSString *) type +{ NSMutableString *string = [NSMutableString new]; if (dispPtr && dispPtr->clipboardActive && @@ -35,6 +37,7 @@ static Tk_Window clipboardOwner = NULL; NSString *s = [[NSString alloc] initWithBytesNoCopy: cbPtr->buffer length:cbPtr->length encoding:NSUTF8StringEncoding freeWhenDone:NO]; + [string appendString:s]; [s release]; } @@ -45,18 +48,25 @@ static Tk_Window clipboardOwner = NULL; [sender setString:string forType:type]; [string release]; } -- (void)tkProvidePasteboard:(TkDisplay *)dispPtr { + +- (void) tkProvidePasteboard: (TkDisplay *) dispPtr +{ if (dispPtr && dispPtr->clipboardActive) { [self tkProvidePasteboard:dispPtr pasteboard:[NSPasteboard generalPasteboard] provideDataForType:NSStringPboardType]; } } -- (void)pasteboard:(NSPasteboard *)sender provideDataForType:(NSString *)type { + +- (void) pasteboard: (NSPasteboard *) sender + provideDataForType: (NSString *) type +{ [self tkProvidePasteboard:TkGetDisplayList() pasteboard:sender provideDataForType:type]; } -- (void)tkCheckPasteboard { + +- (void) tkCheckPasteboard +{ if (clipboardOwner && [[NSPasteboard generalPasteboard] changeCount] != changeCount) { TkDisplay *dispPtr = TkGetDisplayList(); @@ -125,12 +135,13 @@ TkSelGetSelection( if (type) { string = [pb stringForType:type]; } - result = proc(clientData, interp, string ? (char*)[string UTF8String] - : ""); + result = proc(clientData, interp, string ? [string UTF8String] : ""); } else { - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, target), "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", + Tk_GetAtomName(tkwin, selection), + Tk_GetAtomName(tkwin, target))); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "EXISTS", NULL); } return result; } @@ -165,6 +176,7 @@ XSetSelectionOwner( clipboardOwner = owner ? Tk_IdToWindow(display, owner) : NULL; if (!dispPtr->clipboardActive) { NSPasteboard *pb = [NSPasteboard generalPasteboard]; + changeCount = [pb declareTypes:[NSArray array] owner:NSApp]; } } @@ -221,6 +233,7 @@ TkSelUpdateClipboard( /* Info about the content. */ { NSPasteboard *pb = [NSPasteboard generalPasteboard]; + changeCount = [pb addTypes:[NSArray arrayWithObject:NSStringPboardType] owner:NSApp]; } diff --git a/macosx/tkMacOSXColor.c b/macosx/tkMacOSXColor.c index 6f34c74..3380087 100644 --- a/macosx/tkMacOSXColor.c +++ b/macosx/tkMacOSXColor.c @@ -595,7 +595,7 @@ TkpGetColor( color.red = color.green = color.blue = rgba[0] * 65535.0; break; default: - Tcl_Panic("CGColor with %d components", n); + Tcl_Panic("CGColor with %d components", (int) n); } color.pixel = ((((((pixelCode << 8) | ((color.red >> 8) & 0xff)) << 8) @@ -609,11 +609,11 @@ TkpGetColor( } if (TkParseColor(display, colormap, name, &color) == 0) { - return (TkColor *) NULL; + return NULL; } validXColor: - tkColPtr = (TkColor *) ckalloc(sizeof(TkColor)); + tkColPtr = ckalloc(sizeof(TkColor)); tkColPtr->color = color; return tkColPtr; @@ -647,7 +647,7 @@ TkpGetColorByValue( XColor *colorPtr) /* Red, green, and blue fields indicate * desired color. */ { - TkColor *tkColPtr = (TkColor *) ckalloc(sizeof(TkColor)); + TkColor *tkColPtr = ckalloc(sizeof(TkColor)); tkColPtr->color.red = colorPtr->red; tkColPtr->color.green = colorPtr->green; diff --git a/macosx/tkMacOSXCursor.c b/macosx/tkMacOSXCursor.c index 08dec9e..b6394b7 100644 --- a/macosx/tkMacOSXCursor.c +++ b/macosx/tkMacOSXCursor.c @@ -381,19 +381,21 @@ TkGetCursorByName( if (Tcl_SplitList(interp, string, &argc, &argv) == TCL_OK) { if (argc) { - macCursorPtr = (TkMacOSXCursor *) ckalloc(sizeof(TkMacOSXCursor)); + macCursorPtr = ckalloc(sizeof(TkMacOSXCursor)); macCursorPtr->info.cursor = (Tk_Cursor) macCursorPtr; macCursorPtr->macCursor = nil; macCursorPtr->type = 0; FindCursorByName(macCursorPtr, argv[0]); } - ckfree((char *) argv); + ckfree(argv); } if (!macCursorPtr || (!macCursorPtr->macCursor && macCursorPtr->type != NONE)) { - Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad cursor spec \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL); if (macCursorPtr) { - ckfree((char *)macCursorPtr); + ckfree(macCursorPtr); macCursorPtr = NULL; } } diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h index 60d6cda..528ea10 100644 --- a/macosx/tkMacOSXDefault.h +++ b/macosx/tkMacOSXDefault.h @@ -521,6 +521,7 @@ #define DEF_TEXT_INSERT_BD_MONO "0" #define DEF_TEXT_INSERT_OFF_TIME "300" #define DEF_TEXT_INSERT_ON_TIME "600" +#define DEF_TEXT_INSERT_UNFOCUSSED "none" #define DEF_TEXT_INSERT_WIDTH "1" #define DEF_TEXT_MAX_UNDO "0" #define DEF_TEXT_PADX "1" @@ -564,4 +565,10 @@ #define DEF_TOPLEVEL_SCREEN "" #define DEF_TOPLEVEL_USE "" +/* + * Defaults for busy windows (not really used yet): + */ + +#define DEF_BUSY_CURSOR "watch" + #endif /* _TKMACDEFAULT */ diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index eebff3c..a3510f8 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -24,8 +24,6 @@ #define modalOther -1 #define modalError -2 -static int TkBackgroundEvalObjv(Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv, int flags); static const char *const colorOptionStrings[] = { "-initialcolor", "-parent", "-title", NULL @@ -190,13 +188,14 @@ static NSURL *getFileURL(NSString *directory, NSString *filename) { Tcl_Obj **objv, **tmpv; int objc, result = Tcl_ListObjGetElements(callbackInfo->interp, callbackInfo->cmdObj, &objc, &objv); + if (result == TCL_OK && objc) { - tmpv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); + tmpv = ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc); tmpv[objc] = resultObj; TkBackgroundEvalObjv(callbackInfo->interp, objc + 1, tmpv, TCL_EVAL_GLOBAL); - ckfree((char *)tmpv); + ckfree(tmpv); } } else { Tcl_SetObjResult(callbackInfo->interp, resultObj); @@ -209,28 +208,32 @@ static NSURL *getFileURL(NSString *directory, NSString *filename) { } if (callbackInfo->cmdObj) { Tcl_DecrRefCount(callbackInfo->cmdObj); - ckfree((char *)callbackInfo); + ckfree(callbackInfo); } } -- (void)tkAlertDidEnd:(NSAlert *)alert returnCode:(NSInteger)returnCode - contextInfo:(void *)contextInfo { + +- (void) tkAlertDidEnd: (NSAlert *) alert returnCode: (NSInteger) returnCode + contextInfo: (void *) contextInfo +{ AlertCallbackInfo *callbackInfo = contextInfo; if (returnCode >= NSAlertFirstButtonReturn) { Tcl_Obj *resultObj = Tcl_NewStringObj(alertButtonStrings[ alertNativeButtonIndexAndTypeToButtonIndex[callbackInfo-> typeIndex][returnCode - NSAlertFirstButtonReturn]], -1); + if (callbackInfo->cmdObj) { Tcl_Obj **objv, **tmpv; int objc, result = Tcl_ListObjGetElements(callbackInfo->interp, callbackInfo->cmdObj, &objc, &objv); + if (result == TCL_OK && objc) { - tmpv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); + tmpv = ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc); tmpv[objc] = resultObj; TkBackgroundEvalObjv(callbackInfo->interp, objc + 1, tmpv, TCL_EVAL_GLOBAL); - ckfree((char *)tmpv); + ckfree(tmpv); } } else { Tcl_SetObjResult(callbackInfo->interp, resultObj); @@ -241,7 +244,7 @@ static NSURL *getFileURL(NSString *directory, NSString *filename) { } if (callbackInfo->cmdObj) { Tcl_DecrRefCount(callbackInfo->cmdObj); - ckfree((char *) callbackInfo); + ckfree(callbackInfo); } } @end @@ -499,7 +502,7 @@ Tk_GetOpenFileObjCmd( } [panel setAllowedFileTypes:fileTypes]; if (cmdObj) { - callbackInfo = (FilePanelCallbackInfo *)ckalloc(sizeof(FilePanelCallbackInfo)); + callbackInfo = ckalloc(sizeof(FilePanelCallbackInfo)); if (Tcl_IsShared(cmdObj)) { cmdObj = Tcl_DuplicateObj(cmdObj); } @@ -698,7 +701,7 @@ Tk_GetSaveFileObjCmd( [panel setCanSelectHiddenExtension:YES]; [panel setExtensionHidden:NO]; if (cmdObj) { - callbackInfo = (FilePanelCallbackInfo *)ckalloc(sizeof(FilePanelCallbackInfo)); + callbackInfo = ckalloc(sizeof(FilePanelCallbackInfo)); if (Tcl_IsShared(cmdObj)) { cmdObj = Tcl_DuplicateObj(cmdObj); } @@ -836,7 +839,7 @@ Tk_ChooseDirectoryObjCmd( [panel setCanChooseDirectories:YES]; [panel setCanCreateDirectories:!mustexist]; if (cmdObj) { - callbackInfo = (FilePanelCallbackInfo *)ckalloc(sizeof(FilePanelCallbackInfo)); + callbackInfo = ckalloc(sizeof(FilePanelCallbackInfo)); if (Tcl_IsShared(cmdObj)) { cmdObj = Tcl_DuplicateObj(cmdObj); } @@ -1128,7 +1131,7 @@ Tk_MessageBoxObjCmd( [[buttons objectAtIndex: defaultNativeButtonIndex-1] setKeyEquivalent: @"\r"]; if (cmdObj) { - callbackInfo = (AlertCallbackInfo *)ckalloc(sizeof(AlertCallbackInfo)); + callbackInfo = ckalloc(sizeof(AlertCallbackInfo)); if (Tcl_IsShared(cmdObj)) { cmdObj = Tcl_DuplicateObj(cmdObj); } @@ -1159,73 +1162,582 @@ Tk_MessageBoxObjCmd( contextInfo:callbackInfo]; } result = (modalReturnCode >= NSAlertFirstButtonReturn) ? TCL_OK : TCL_ERROR; - end: + end: [alert release]; return result; } /* + *---------------------------------------------------------------------- + */ +#pragma mark [tk fontchooser] implementation (TIP 324) +/* + *---------------------------------------------------------------------- + */ + +#include "tkMacOSXEvent.h" +#include "tkMacOSXFont.h" + +typedef struct FontchooserData { + Tcl_Obj *titleObj; + Tcl_Obj *cmdObj; + Tk_Window parent; +} FontchooserData; + +enum FontchooserEvent { FontchooserClosed, FontchooserSelection }; + +static void FontchooserEvent(int kind); +static Tcl_Obj * FontchooserCget(FontchooserData *fcdPtr, + int optionIndex); +static int FontchooserConfigureCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int FontchooserShowCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int FontchooserHideCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static void FontchooserParentEventHandler(ClientData clientData, + XEvent *eventPtr); +static void DeleteFontchooserData(ClientData clientData, + Tcl_Interp *interp); + +MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[]; +const TkEnsemble tkFontchooserEnsemble[] = { + { "configure", FontchooserConfigureCmd, NULL }, + { "show", FontchooserShowCmd, NULL }, + { "hide", FontchooserHideCmd, NULL }, + { NULL, NULL, NULL } +}; + +static Tcl_Interp *fontchooserInterp = NULL; +static NSFont *fontPanelFont = nil; +static NSMutableDictionary *fontPanelFontAttributes = nil; + +static const char *const fontchooserOptionStrings[] = { + "-parent", "-title", "-font", "-command", + "-visible", NULL +}; +enum FontchooserOption { + FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd, + FontchooserVisible +}; + +@implementation TKApplication(TKFontPanel) + +- (void) changeFont: (id) sender +{ + NSFontManager *fm = [NSFontManager sharedFontManager]; + + if ([fm currentFontAction] == NSViaPanelFontAction) { + NSFont *font = [fm convertFont:fontPanelFont]; + + if (![fontPanelFont isEqual:font]) { + [fontPanelFont release]; + fontPanelFont = [font retain]; + FontchooserEvent(FontchooserSelection); + } + } +} + +- (void) changeAttributes: (id) sender +{ + NSDictionary *attributes = [sender convertAttributes: + fontPanelFontAttributes]; + + if (![fontPanelFontAttributes isEqual:attributes]) { + [fontPanelFontAttributes setDictionary:attributes]; + FontchooserEvent(FontchooserSelection); + } +} + +- (NSUInteger) validModesForFontPanel: (NSFontPanel *) fontPanel +{ + return (NSFontPanelStandardModesMask & ~NSFontPanelAllEffectsModeMask) | + NSFontPanelUnderlineEffectModeMask | + NSFontPanelStrikethroughEffectModeMask; +} + +- (void) windowDidOrderOffScreen: (NSNotification *) notification +{ +#ifdef TK_MAC_DEBUG_NOTIFICATIONS + TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification); +#endif + if ([[notification object] isEqual:[[NSFontManager sharedFontManager] + fontPanel:NO]]) { + FontchooserEvent(FontchooserClosed); + } +} +@end + +/* + *---------------------------------------------------------------------- + * + * FontchooserEvent -- + * + * This processes events generated by user interaction with the + * font panel. + * + * Results: + * None. + * + * Side effects: + * Additional events may be place on the Tk event queue. + * + *---------------------------------------------------------------------- + */ + +static void +FontchooserEvent( + int kind) +{ + FontchooserData *fcdPtr; + Tcl_Obj *fontObj; + + if (!fontchooserInterp) { + return; + } + fcdPtr = Tcl_GetAssocData(fontchooserInterp, "::tk::fontchooser", NULL); + switch (kind) { + case FontchooserClosed: + if (fcdPtr->parent != None) { + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility"); + fontchooserInterp = NULL; + } + break; + case FontchooserSelection: + fontObj = TkMacOSXFontDescriptionForNSFontAndNSFontAttributes( + fontPanelFont, fontPanelFontAttributes); + if (fontObj) { + if (fcdPtr->cmdObj) { + int objc, result; + Tcl_Obj **objv, **tmpv; + + result = Tcl_ListObjGetElements(fontchooserInterp, + fcdPtr->cmdObj, &objc, &objv); + if (result == TCL_OK) { + tmpv = ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); + memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc); + tmpv[objc] = fontObj; + TkBackgroundEvalObjv(fontchooserInterp, objc + 1, tmpv, + TCL_EVAL_GLOBAL); + ckfree(tmpv); + } + } + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged"); + } + break; + } +} + +/* + *---------------------------------------------------------------------- + * + * FontchooserCget -- + * + * Helper for the FontchooserConfigure command to return the + * current value of any of the options (which may be NULL in + * the structure) + * + * Results: + * Tcl object of option value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static Tcl_Obj * +FontchooserCget( + FontchooserData *fcdPtr, + int optionIndex) +{ + Tcl_Obj *resObj = NULL; + + switch(optionIndex) { + case FontchooserParent: + if (fcdPtr->parent != None) { + resObj = Tcl_NewStringObj( + ((TkWindow *) fcdPtr->parent)->pathName, -1); + } else { + resObj = Tcl_NewStringObj(".", 1); + } + break; + case FontchooserTitle: + if (fcdPtr->titleObj) { + resObj = fcdPtr->titleObj; + } else { + resObj = Tcl_NewObj(); + } + break; + case FontchooserFont: + resObj = TkMacOSXFontDescriptionForNSFontAndNSFontAttributes( + fontPanelFont, fontPanelFontAttributes); + if (!resObj) { + resObj = Tcl_NewObj(); + } + break; + case FontchooserCmd: + if (fcdPtr->cmdObj) { + resObj = fcdPtr->cmdObj; + } else { + resObj = Tcl_NewObj(); + } + break; + case FontchooserVisible: + resObj = Tcl_NewBooleanObj([[[NSFontManager sharedFontManager] + fontPanel:NO] isVisible]); + break; + default: + resObj = Tcl_NewObj(); + } + return resObj; +} + +/* * ---------------------------------------------------------------------- * - * TkBackgroundEvalObjv -- + * FontchooserConfigureCmd -- * - * Evaluate a command while ensuring that we do not affect the - * interpreters state. This is important when evaluating script - * during background tasks. + * Implementation of the 'tk fontchooser configure' ensemble command. + * See the user documentation for what it does. * * Results: - * A standard Tcl result code. + * See the user documentation. * - * Side Effects: - * The interpreters variables and code may be modified by the script - * but the result will not be modified. + * Side effects: + * Per-interp data structure may be modified * * ---------------------------------------------------------------------- */ -int -TkBackgroundEvalObjv( +static int +FontchooserConfigureCmd( + ClientData clientData, /* Main window */ Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv, - int flags) + Tcl_Obj *const objv[]) { - Tcl_InterpState state; - int n, r = TCL_OK; + Tk_Window tkwin = (Tk_Window)clientData; + FontchooserData *fcdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", + NULL); + int i, r = TCL_OK; /* - * Record the state of the interpreter. + * With no arguments we return all the options in a dict */ - Tcl_Preserve(interp); - state = Tcl_SaveInterpState(interp, TCL_OK); + if (objc == 1) { + Tcl_Obj *keyObj, *valueObj; + Tcl_Obj *dictObj = Tcl_NewDictObj(); - /* - * Evaluate the command and handle any error. - */ + for (i = 0; r == TCL_OK && fontchooserOptionStrings[i] != NULL; ++i) { + keyObj = Tcl_NewStringObj(fontchooserOptionStrings[i], -1); + valueObj = FontchooserCget(fcdPtr, i); + r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj); + } + if (r == TCL_OK) { + Tcl_SetObjResult(interp, dictObj); + } + return r; + } + + for (i = 1; i < objc; i += 2) { + int optionIndex, len; + + if (Tcl_GetIndexFromObjStruct(interp, objv[i], fontchooserOptionStrings, + sizeof(char *), "option", 0, &optionIndex) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 2) { + /* + * With one option and no arg, return the current value. + */ + + Tcl_SetObjResult(interp, FontchooserCget(fcdPtr, optionIndex)); + return TCL_OK; + } + if (i + 1 == objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case FontchooserVisible: { + const char *msg = "cannot change read-only option " + "\"-visible\": use the show or hide command"; + + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL); + return TCL_ERROR; + } + case FontchooserParent: { + Tk_Window parent = Tk_NameToWindow(interp, + Tcl_GetString(objv[i+1]), tkwin); + + if (parent == None) { + return TCL_ERROR; + } + if (fcdPtr->parent) { + Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + } + fcdPtr->parent = parent; + Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + break; + } + case FontchooserTitle: + if (fcdPtr->titleObj) { + Tcl_DecrRefCount(fcdPtr->titleObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + fcdPtr->titleObj = objv[i+1]; + if (Tcl_IsShared(fcdPtr->titleObj)) { + fcdPtr->titleObj = Tcl_DuplicateObj(fcdPtr->titleObj); + } + Tcl_IncrRefCount(fcdPtr->titleObj); + } else { + fcdPtr->titleObj = NULL; + } + break; + case FontchooserFont: + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, objv[i+1]); + + if (!f) { + return TCL_ERROR; + } + [fontPanelFont autorelease]; + fontPanelFont = [TkMacOSXNSFontForFont(f) retain]; + [fontPanelFontAttributes setDictionary: + TkMacOSXNSFontAttributesForFont(f)]; + [fontPanelFontAttributes removeObjectsForKeys:[NSArray + arrayWithObjects:NSFontAttributeName, + NSLigatureAttributeName, NSKernAttributeName, nil]]; + Tk_FreeFont(f); + } else { + [fontPanelFont release]; + fontPanelFont = nil; + [fontPanelFontAttributes removeAllObjects]; + } - for (n = 0; n < objc; ++n) { - Tcl_IncrRefCount(objv[n]); + NSFontManager *fm = [NSFontManager sharedFontManager]; + NSFontPanel *fp = [fm fontPanel:NO]; + + [fp setPanelFont:fontPanelFont isMultiple:NO]; + [fm setSelectedFont:fontPanelFont isMultiple:NO]; + [fm setSelectedAttributes:fontPanelFontAttributes + isMultiple:NO]; + if ([fp isVisible]) { + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged"); + } + break; + case FontchooserCmd: + if (fcdPtr->cmdObj) { + Tcl_DecrRefCount(fcdPtr->cmdObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + fcdPtr->cmdObj = objv[i+1]; + if (Tcl_IsShared(fcdPtr->cmdObj)) { + fcdPtr->cmdObj = Tcl_DuplicateObj(fcdPtr->cmdObj); + } + Tcl_IncrRefCount(fcdPtr->cmdObj); + } else { + fcdPtr->cmdObj = NULL; + } + break; + } } - r = Tcl_EvalObjv(interp, objc, objv, flags); - for (n = 0; n < objc; ++n) { - Tcl_DecrRefCount(objv[n]); + return TCL_OK; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserShowCmd -- + * + * Implements the 'tk fontchooser show' ensemble command. The + * per-interp configuration data for the dialog is held in an interp + * associated structure. + * + * Results: + * See the user documentation. + * + * Side effects: + * Font Panel may be shown. + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserShowCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + FontchooserData *fcdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", + NULL); + + if (fcdPtr->parent == None) { + fcdPtr->parent = (Tk_Window) clientData; + Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + } + NSFontManager *fm = [NSFontManager sharedFontManager]; + NSFontPanel *fp = [fm fontPanel:YES]; + if ([fp delegate] != NSApp) { + [fp setDelegate:NSApp]; } - if (r == TCL_ERROR) { - Tcl_AddErrorInfo(interp, "\n (background event handler)"); - Tcl_BackgroundError(interp); + if (![fp isVisible]) { + [fm orderFrontFontPanel:NSApp]; + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility"); } + fontchooserInterp = interp; - /* - * Restore the state of the interpreter. - */ + return TCL_OK; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserHideCmd -- + * + * Implementation of the 'tk fontchooser hide' ensemble. See the + * user documentation for details. + * + * Results: + * See the user documentation. + * + * Side effects: + * Font Panel may be hidden. + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserHideCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + NSFontPanel *fp = [[NSFontManager sharedFontManager] fontPanel:NO]; + if ([fp isVisible]) { + [fp orderOut:NSApp]; + } + return TCL_OK; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserParentEventHandler -- + * + * Event handler for StructureNotify events on the font chooser's parent + * window. + * + * Results: + * None. + * + * Side effects: + * Font chooser parent info is cleared and font panel is hidden. + * + * ---------------------------------------------------------------------- + */ - (void) Tcl_RestoreInterpState(interp, state); - Tcl_Release(interp); +static void +FontchooserParentEventHandler( + ClientData clientData, + XEvent *eventPtr) +{ + FontchooserData *fcdPtr = clientData; - return r; + if (eventPtr->type == DestroyNotify) { + Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + fcdPtr->parent = None; + FontchooserHideCmd(NULL, NULL, 0, NULL); + } } + +/* + * ---------------------------------------------------------------------- + * + * DeleteFontchooserData -- + * + * Clean up the font chooser configuration data when the interp is + * destroyed. + * + * Results: + * None. + * + * Side effects: + * per-interp configuration data is destroyed. + * + * ---------------------------------------------------------------------- + */ + +static void +DeleteFontchooserData( + ClientData clientData, + Tcl_Interp *interp) +{ + FontchooserData *fcdPtr = clientData; + + if (fcdPtr->titleObj) { + Tcl_DecrRefCount(fcdPtr->titleObj); + } + if (fcdPtr->cmdObj) { + Tcl_DecrRefCount(fcdPtr->cmdObj); + } + ckfree(fcdPtr); + if (fontchooserInterp == interp) { + fontchooserInterp = NULL; + } +} + +/* + * ---------------------------------------------------------------------- + * + * TkInitFontchooser -- + * + * Associate the font chooser configuration data with the Tcl + * interpreter. There is one font chooser per interp. + * + * Results: + * None. + * + * Side effects: + * per-interp configuration data is destroyed. + * + * ---------------------------------------------------------------------- + */ + +MODULE_SCOPE int +TkInitFontchooser( + Tcl_Interp *interp, + ClientData clientData) +{ + FontchooserData *fcdPtr = ckalloc(sizeof(FontchooserData)); + + bzero(fcdPtr, sizeof(FontchooserData)); + Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteFontchooserData, + fcdPtr); + if (!fontPanelFontAttributes) { + fontPanelFontAttributes = [NSMutableDictionary new]; + } + return TCL_OK; +} + /* * Local Variables: * mode: objc diff --git a/macosx/tkMacOSXDraw.c b/macosx/tkMacOSXDraw.c index f376591..6a0b409 100644 --- a/macosx/tkMacOSXDraw.c +++ b/macosx/tkMacOSXDraw.c @@ -148,7 +148,7 @@ BitmapRepFromDrawableRect( cg_image = CGBitmapContextCreateImage( (CGContextRef) cg_context); sub_cg_image = CGImageCreateWithImageInRect(cg_image, image_rect); if ( sub_cg_image ) { - /*This can be dealloc'ed prematurely if set for autorelease, causing crashes.*/ + /*This can be dealloc'ed prematurely if set for autorelease, causing crashes.*/ bitmap_rep = [NSBitmapImageRep alloc]; [bitmap_rep initWithCGImage:sub_cg_image]; } @@ -163,7 +163,7 @@ BitmapRepFromDrawableRect( width,height); if ( [view lockFocusIfCanDraw] ) { - /*This can be dealloc'ed prematurely if set for autorelease, causing crashes.*/ + /*This can be dealloc'ed prematurely if set for autorelease, causing crashes.*/ bitmap_rep = [NSBitmapImageRep alloc]; bitmap_rep = [bitmap_rep initWithFocusedViewRect:view_rect]; [view unlockFocus]; @@ -481,7 +481,7 @@ CreateCGImageWithXImage( bitsPerPixel = 32; bitmapInfo = (image->byte_order == MSBFirst ? kCGBitmapByteOrder32Big : kCGBitmapByteOrder32Little) | - kCGImageAlphaNoneSkipFirst; + kCGImageAlphaNoneSkipFirst; data = memcpy(ckalloc(len), image->data + image->xoffset, len); if (data) { provider = CGDataProviderCreateWithData(data, data, len, releaseData); @@ -1689,13 +1689,13 @@ TkMacOSXSetupDrawingContext( CGContextSetTextDrawingMode(dc.context, kCGTextFill); CGContextConcatCTM(dc.context, t); if (dc.clipRgn) { -#ifdef TK_MAC_DEBUG_DRAWING + #ifdef TK_MAC_DEBUG_DRAWING CGContextSaveGState(dc.context); ChkErr(HIShapeReplacePathInCGContext, dc.clipRgn, dc.context); CGContextSetRGBFillColor(dc.context, 1.0, 0.0, 0.0, 0.1); CGContextEOFillPath(dc.context); CGContextRestoreGState(dc.context); -#endif /* TK_MAC_DEBUG_DRAWING */ + #endif /* TK_MAC_DEBUG_DRAWING */ CGRect r; if (!HIShapeIsRectangular(dc.clipRgn) || !CGRectContainsRect( *HIShapeGetBounds(dc.clipRgn, &r), @@ -1828,7 +1828,7 @@ TkMacOSXGetClipRgn( { MacDrawable *macDraw = (MacDrawable *) drawable; HIShapeRef clipRgn = NULL; - + if (macDraw->winPtr && macDraw->flags & TK_CLIP_INVALID) { TkMacOSXUpdateClipRgn(macDraw->winPtr); #ifdef TK_MAC_DEBUG_DRAWING @@ -1905,7 +1905,7 @@ TkpClipDrawableToRect( { MacDrawable *macDraw = (MacDrawable *) d; NSView *view = TkMacOSXDrawableView(macDraw); - + if (macDraw->drawRgn) { CFRelease(macDraw->drawRgn); macDraw->drawRgn = NULL; diff --git a/macosx/tkMacOSXEmbed.c b/macosx/tkMacOSXEmbed.c index bd7e0a8..99f7584 100644 --- a/macosx/tkMacOSXEmbed.c +++ b/macosx/tkMacOSXEmbed.c @@ -13,9 +13,10 @@ * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ + */ #include "tkMacOSXPrivate.h" +#include "tkBusy.h" /* * One of the following structures exists for each container in this @@ -89,8 +90,7 @@ Tk_MacOSXSetEmbedHandler( Tk_MacOSXEmbedGetOffsetInParentProc *getOffsetProc) { if (tkMacOSXEmbedHandler == NULL) { - tkMacOSXEmbedHandler = (TkMacOSXEmbedHandler *) - ckalloc(sizeof(TkMacOSXEmbedHandler)); + tkMacOSXEmbedHandler = ckalloc(sizeof(TkMacOSXEmbedHandler)); } tkMacOSXEmbedHandler->registerWinProc = registerWinProc; tkMacOSXEmbedHandler->getPortProc = getPortProc; @@ -134,7 +134,7 @@ TkpMakeWindow( * Allocate sub window */ - macWin = (MacDrawable *) ckalloc(sizeof(MacDrawable)); + macWin = ckalloc(sizeof(MacDrawable)); if (macWin == NULL) { winPtr->privatePtr = NULL; return None; @@ -252,8 +252,9 @@ TkpUseWindow( Container *containerPtr; if (winPtr->window != None) { - Tcl_AppendResult(interp, "can't modify container after widget is " - "created", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't modify container after widget is created", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL); return TCL_ERROR; } @@ -271,12 +272,12 @@ TkpUseWindow( } usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, (Window) parent); - if (usePtr != NULL) { - if (!(usePtr->flags & TK_CONTAINER)) { - Tcl_AppendResult(interp, "window \"", usePtr->pathName, - "\" doesn't have -container option set", NULL); - return TCL_ERROR; - } + if (usePtr != NULL && !(usePtr->flags & TK_CONTAINER)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" doesn't have -container option set", + usePtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL); + return TCL_ERROR; } /* @@ -304,7 +305,7 @@ TkpUseWindow( * Make the embedded window. */ - macWin = (MacDrawable *) ckalloc(sizeof(MacDrawable)); + macWin = ckalloc(sizeof(MacDrawable)); if (macWin == NULL) { winPtr->privatePtr = NULL; return TCL_ERROR; @@ -349,25 +350,27 @@ TkpUseWindow( if (containerPtr == NULL) { /* - * If someone has registered an in process embedding handler, then + * If someone has registered an in-process embedding handler, then * see if it can handle this window... */ if (tkMacOSXEmbedHandler == NULL || tkMacOSXEmbedHandler->registerWinProc((long) parent, (Tk_Window) winPtr) != TCL_OK) { - Tcl_AppendResult(interp, "The window ID ", string, - " does not correspond to a valid Tk Window.", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "The window ID %s does not correspond to a valid Tk Window", + string)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "HANDLE", NULL); return TCL_ERROR; - } else { - containerPtr = (Container *) ckalloc(sizeof(Container)); - - containerPtr->parentPtr = NULL; - containerPtr->embedded = (Window) macWin; - containerPtr->embeddedPtr = macWin->winPtr; - containerPtr->nextPtr = firstContainerPtr; - firstContainerPtr = containerPtr; } + + containerPtr = ckalloc(sizeof(Container)); + + containerPtr->parentPtr = NULL; + containerPtr->embedded = (Window) macWin; + containerPtr->embeddedPtr = macWin->winPtr; + containerPtr->nextPtr = firstContainerPtr; + firstContainerPtr = containerPtr; } else { /* * The window is embedded in another Tk window. @@ -433,7 +436,7 @@ TkpMakeContainer( */ Tk_MakeWindowExist(tkwin); - containerPtr = (Container *) ckalloc(sizeof(Container)); + containerPtr = ckalloc(sizeof(Container)); containerPtr->parent = Tk_WindowId(tkwin); containerPtr->parentPtr = winPtr; containerPtr->embedded = None; @@ -604,15 +607,15 @@ int TkpTestembedCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { int all; Container *containerPtr; Tcl_DString dString; char buffer[50]; - if ((argc > 1) && (strcmp(argv[1], "all") == 0)) { + if ((objc > 1) && (strcmp(Tcl_GetString(objv[1]), "all") == 0)) { all = 1; } else { all = 0; @@ -1158,11 +1161,65 @@ EmbedWindowDeleted( } else { prevPtr->nextPtr = containerPtr->nextPtr; } - ckfree((char *) containerPtr); + ckfree(containerPtr); } } /* + *---------------------------------------------------------------------- + * + * TkpShowBusyWindow, TkpHideBusyWindow, TkpMakeTransparentWindowExist, + * TkpCreateBusy -- + * + * Portability layer for busy windows. Holds platform-specific gunk for + * the [tk busy] command, which is currently a dummy implementation for + * OSX/Aqua. The individual functions are supposed to do the following: + * + * TkpShowBusyWindow -- + * Make the busy window appear. + * + * TkpHideBusyWindow -- + * Make the busy window go away. + * + * TkpMakeTransparentWindowExist -- + * Actually make a transparent window. + * + * TkpCreateBusy -- + * Creates the platform-specific part of a busy window structure. + * + *---------------------------------------------------------------------- + */ + +void +TkpShowBusyWindow( + TkBusy busy) +{ +} + +void +TkpHideBusyWindow( + TkBusy busy) +{ +} + +void +TkpMakeTransparentWindowExist( + Tk_Window tkwin, /* Token for window. */ + Window parent) /* Parent window. */ +{ +} + +void +TkpCreateBusy( + Tk_FakeWin *winPtr, + Tk_Window tkRef, + Window* parentPtr, + Tk_Window tkParent, + TkBusy busy) +{ +} + +/* * Local Variables: * mode: objc * c-basic-offset: 4 diff --git a/macosx/tkMacOSXEvent.c b/macosx/tkMacOSXEvent.c index 3c59ac3..7f3357f 100644 --- a/macosx/tkMacOSXEvent.c +++ b/macosx/tkMacOSXEvent.c @@ -23,7 +23,8 @@ enum { @implementation TKApplication(TKEvent) /* TODO: replace by +[addLocalMonitorForEventsMatchingMask ? */ -- (NSEvent *)tkProcessEvent:(NSEvent *)theEvent { +- (NSEvent *) tkProcessEvent: (NSEvent *) theEvent +{ #ifdef TK_MAC_DEBUG_EVENTS TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, theEvent); #endif @@ -123,6 +124,7 @@ enum { * *---------------------------------------------------------------------- */ + MODULE_SCOPE void TkMacOSXFlushWindows(void) { @@ -134,6 +136,7 @@ TkMacOSXFlushWindows(void) } } } + /* * Local Variables: diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c index f329071..c48e56e 100644 --- a/macosx/tkMacOSXFont.c +++ b/macosx/tkMacOSXFont.c @@ -104,9 +104,9 @@ static void DrawCharsInContext(Display *display, Drawable drawable, GC gc, int rangeLength, int x, int y, double angle); @interface NSFont(TKFont) -- (NSFont *)bestMatchingFontForCharacters:(const UTF16Char *)characters - length:(NSUInteger)length attributes:(NSDictionary *)attributes - actualCoveredLength:(NSUInteger *)coveredLength; +- (NSFont *) bestMatchingFontForCharacters: (const UTF16Char *) characters + length: (NSUInteger) length attributes: (NSDictionary *) attributes + actualCoveredLength: (NSUInteger *) coveredLength; @end #pragma mark - @@ -466,7 +466,7 @@ TkpGetNativeFont( ctFont = CTFontCreateUIFontForLanguage(HIThemeGetUIFontType( themeFontId), 0, NULL); if (ctFont) { - fontPtr = (MacFont *) ckalloc(sizeof(MacFont)); + fontPtr = ckalloc(sizeof(MacFont)); InitFont((NSFont*) ctFont, NULL, fontPtr); } @@ -522,7 +522,7 @@ TkpGetFontFromAttributes( nsFont = FindNSFont(faPtr->family, traits, weight, points, 0); if (!nsFont) { - char *const *aliases = TkFontGetAliasList(faPtr->family); + const char *const *aliases = TkFontGetAliasList(faPtr->family); while (aliases && !nsFont) { nsFont = FindNSFont(*aliases++, traits, weight, points, 0); @@ -535,7 +535,7 @@ TkpGetFontFromAttributes( Tcl_Panic("Could not determine NSFont from TkFontAttributes"); } if (tkFontPtr == NULL) { - fontPtr = (MacFont *) ckalloc(sizeof(MacFont)); + fontPtr = ckalloc(sizeof(MacFont)); } else { fontPtr = (MacFont *) tkFontPtr; TkpDeleteFont(tkFontPtr); @@ -897,7 +897,8 @@ TkpMeasureCharsInContext( /* The call to CTTypesetterSuggestClusterBreak above will always return at least one character regardless of whether it exceeded it or not. Clean that up now. */ - while (width > maxWidth && !(flags & TK_PARTIAL_OK) && index > start+(flags & TK_AT_LEAST_ONE)) { + while (width > maxWidth && !(flags & TK_PARTIAL_OK) + && index > start+(flags & TK_AT_LEAST_ONE)) { range.length = --index; line = CTTypesetterCreateLine(typesetter, range); width = CTLineGetTypographicBounds(line, NULL, NULL, NULL); @@ -967,6 +968,29 @@ Tk_DrawChars( 0, numBytes, x, y, 0.0); } +void +TkDrawAngledChars( + Display *display, /* Display on which to draw. */ + Drawable drawable, /* Window or pixmap in which to draw. */ + GC gc, /* Graphics context for drawing characters. */ + Tk_Font tkfont, /* Font in which characters will be drawn; + * must be the same as font used in GC. */ + const char *source, /* UTF-8 string to be displayed. Need not be + * '\0' terminated. All Tk meta-characters + * (tabs, control characters, and newlines) + * should be stripped out of the string that + * is passed to this function. If they are not + * stripped out, they will be displayed as + * regular printing characters. */ + int numBytes, /* Number of bytes in string. */ + double x, double y, /* Coordinates at which to place origin of + * string when drawing. */ + double angle) /* What angle to put text at, in degrees. */ +{ + DrawCharsInContext(display, drawable, gc, tkfont, source, numBytes, + 0, numBytes, x, y, angle); +} + /* *--------------------------------------------------------------------------- * @@ -1079,7 +1103,7 @@ DrawCharsInContext( t = CGAffineTransformMake(1.0, 0.0, 0.0, -1.0, 0.0, h); if (angle != 0.0) { t = CGAffineTransformTranslate(CGAffineTransformRotate( - CGAffineTransformTranslate(t, x, y), angle*M_PI/180.0), -x, -y); + CGAffineTransformTranslate(t, x, y), angle*PI/180.0), -x, -y); } CGContextConcatCTM(context, t); CGContextSetTextPosition(context, x, y); @@ -1180,6 +1204,58 @@ TkMacOSXIsCharacterMissing( /* *---------------------------------------------------------------------- * + * TkMacOSXFontDescriptionForNSFontAndNSFontAttributes -- + * + * Get text description of a font specified by NSFont and attributes. + * + * Results: + * List object or NULL. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE Tcl_Obj * +TkMacOSXFontDescriptionForNSFontAndNSFontAttributes( + NSFont *nsFont, + NSDictionary *nsAttributes) +{ + Tcl_Obj *objv[6]; + int i = 0; + const char *familyName = [[nsFont familyName] UTF8String]; + + if (nsFont && familyName) { + NSFontTraitMask traits = [[NSFontManager sharedFontManager] + traitsOfFont:nsFont]; + id underline = [nsAttributes objectForKey: + NSUnderlineStyleAttributeName]; + id strikethrough = [nsAttributes objectForKey: + NSStrikethroughStyleAttributeName]; + objv[i++] = Tcl_NewStringObj(familyName, -1); + objv[i++] = Tcl_NewIntObj([nsFont pointSize]); +#define S(s) Tcl_NewStringObj(STRINGIFY(s),(int)(sizeof(STRINGIFY(s))-1)) + objv[i++] = (traits & NSBoldFontMask) ? S(bold) : S(normal); + objv[i++] = (traits & NSItalicFontMask) ? S(italic) : S(roman); + if ([underline respondsToSelector:@selector(intValue)] && + ([underline intValue] & (NSUnderlineStyleSingle | + NSUnderlineStyleThick | NSUnderlineStyleDouble))) { + objv[i++] = S(underline); + } + if ([strikethrough respondsToSelector:@selector(intValue)] && + ([strikethrough intValue] & (NSUnderlineStyleSingle | + NSUnderlineStyleThick | NSUnderlineStyleDouble))) { + objv[i++] = S(overstrike); + } +#undef S + } + return i ? Tcl_NewListObj(i, objv) : NULL; +} + +/* + *---------------------------------------------------------------------- + * * TkMacOSXUseAntialiasedText -- * * Enables or disables application-wide use of antialiased text (where diff --git a/macosx/tkMacOSXFont.h b/macosx/tkMacOSXFont.h index c852e9c..08380c4 100644 --- a/macosx/tkMacOSXFont.h +++ b/macosx/tkMacOSXFont.h @@ -22,4 +22,11 @@ #include "tkMacOSXInt.h" #endif +/* + * Function prototypes + */ + +MODULE_SCOPE Tcl_Obj * TkMacOSXFontDescriptionForNSFontAndNSFontAttributes( + NSFont *nsFont, NSDictionary *nsAttributes); + #endif /*TKMACOSXFONT_H*/ diff --git a/macosx/tkMacOSXHLEvents.c b/macosx/tkMacOSXHLEvents.c index 9c0f9d1..f5aeff0 100644 --- a/macosx/tkMacOSXHLEvents.c +++ b/macosx/tkMacOSXHLEvents.c @@ -33,7 +33,7 @@ typedef struct KillEvent { * Static functions used only in this file. */ -static void tkMacOSXProcessFiles(NSAppleEventDescriptor* event, +static void tkMacOSXProcessFiles(NSAppleEventDescriptor* event, NSAppleEventDescriptor* replyEvent, Tcl_Interp *interp, char* procedure); @@ -53,7 +53,7 @@ static int ReallyKillMe(Tcl_Event *eventPtr, int flags); [self handleShowPreferencesEvent:Nil withReplyEvent:Nil]; } -- (void) handleQuitApplicationEvent: (NSAppleEventDescriptor *)event +- (void) handleQuitApplicationEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent { KillEvent *eventPtr; @@ -67,7 +67,7 @@ static int ReallyKillMe(Tcl_Event *eventPtr, int flags); * quickly as possible. */ - eventPtr = (KillEvent*)ckalloc(sizeof(KillEvent)); + eventPtr = ckalloc(sizeof(KillEvent)); eventPtr->header.proc = ReallyKillMe; eventPtr->interp = _eventInterp; @@ -75,7 +75,7 @@ static int ReallyKillMe(Tcl_Event *eventPtr, int flags); } } -- (void) handleOpenApplicationEvent: (NSAppleEventDescriptor *)event +- (void) handleOpenApplicationEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent { Tcl_Interp *interp = _eventInterp; @@ -85,12 +85,12 @@ static int ReallyKillMe(Tcl_Event *eventPtr, int flags); int code = Tcl_EvalEx(_eventInterp, "::tk::mac::OpenApplication", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { - Tcl_BackgroundError(_eventInterp); + Tcl_BackgroundException(_eventInterp, code); } } } -- (void) handleReopenApplicationEvent: (NSAppleEventDescriptor *)event +- (void) handleReopenApplicationEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent { #if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 @@ -104,12 +104,12 @@ static int ReallyKillMe(Tcl_Event *eventPtr, int flags); int code = Tcl_EvalEx(_eventInterp, "::tk::mac::ReopenApplication", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK){ - Tcl_BackgroundError(_eventInterp); + Tcl_BackgroundException(_eventInterp, code); } } } -- (void) handleShowPreferencesEvent: (NSAppleEventDescriptor *)event +- (void) handleShowPreferencesEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent { if (_eventInterp && @@ -117,24 +117,24 @@ static int ReallyKillMe(Tcl_Event *eventPtr, int flags); int code = Tcl_EvalEx(_eventInterp, "::tk::mac::ShowPreferences", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { - Tcl_BackgroundError(_eventInterp); + Tcl_BackgroundException(_eventInterp, code); } } } -- (void) handleOpenDocumentsEvent: (NSAppleEventDescriptor *)event +- (void) handleOpenDocumentsEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent { tkMacOSXProcessFiles(event, replyEvent, _eventInterp, "::tk::mac::OpenDocument"); } -- (void) handlePrintDocumentsEvent: (NSAppleEventDescriptor *)event +- (void) handlePrintDocumentsEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent { tkMacOSXProcessFiles(event, replyEvent, _eventInterp, "::tk::mac::PrintDocument"); } -- (void) handleDoScriptEvent: (NSAppleEventDescriptor *)event +- (void) handleDoScriptEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent { OSStatus err; @@ -164,7 +164,7 @@ static int ReallyKillMe(Tcl_Event *eventPtr, int flags); errString, strlen(errString)); return; } - + if (MissedAnyParameters((AppleEvent*)theDesc)) { sprintf(errString, "AEDoScriptHandler: extra parameters"); AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorString, typeChar, @@ -202,7 +202,7 @@ static int ReallyKillMe(Tcl_Event *eventPtr, int flags); * The descriptor can be coerced to UTF8 text. Evaluate as Tcl, or * or pass the text as a string argument to ::tk::mac::DoScriptText * if that procedure exists. - */ + */ char *data = ckalloc(actual + 1); if (noErr == AEGetParamPtr(theDesc, keyDirectObject, typeUTF8Text, &type, data, actual, NULL)) { @@ -274,7 +274,7 @@ static int ReallyKillMe(Tcl_Event *eventPtr, int flags); static void tkMacOSXProcessFiles( - NSAppleEventDescriptor* event, + NSAppleEventDescriptor* event, NSAppleEventDescriptor* replyEvent, Tcl_Interp *interp, char* procedure) @@ -298,12 +298,12 @@ tkMacOSXProcessFiles( if (!interp || !Tcl_FindCommand(interp, procedure, NULL, 0)) { return; } - + fileSpecDesc = [event aeDesc]; if (fileSpecDesc == nil ) { return; } - + /* * The AppleEvent's descriptor should either contain a value of * typeObjectSpecifier or typeAEList. In the first case, the descriptor @@ -312,23 +312,23 @@ tkMacOSXProcessFiles( * itself. Values in the list will be coerced into fileURL's if possible; * otherwise they will be ignored. */ - + /* Get a copy of the AppleEvent's descriptor. */ AEGetParamDesc(fileSpecDesc, keyDirectObject, typeWildCard, &contents); if (contents.descriptorType == typeAEList) { fileSpecDesc = &contents; } - + if (AECountItems(fileSpecDesc, &count) != noErr) { AEDisposeDesc(&contents); return; } - - /* + + /* * Construct a Tcl command which calls the procedure, passing the * paths contained in the AppleEvent as arguments. */ - + Tcl_DStringInit(&command); Tcl_DStringAppend(&command, procedure, -1); @@ -341,7 +341,7 @@ tkMacOSXProcessFiles( continue; } URLString[actual] = '\0'; - fileURL = [NSURL URLWithString:[NSString stringWithUTF8String:(char*)URLString]]; + fileURL = [NSURL URLWithString:[NSString stringWithUTF8String:(char*)URLString]]; if (fileURL == nil) { continue; } @@ -358,7 +358,7 @@ tkMacOSXProcessFiles( code = Tcl_EvalEx(interp, Tcl_DStringValue(&command), Tcl_DStringLength(&command), TCL_EVAL_GLOBAL); if (code != TCL_OK) { - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); } Tcl_DStringFree(&command); return; @@ -473,8 +473,8 @@ TkMacOSXDoHLEvent( * * ReallyKillMe -- * - * This proc tries to kill the shell by running exit, called from an - * event scheduled by the "Quit" AppleEvent handler. + * This procedure tries to kill the shell by running exit, called from + * an event scheduled by the "Quit" AppleEvent handler. * * Results: * Runs the "exit" command which might kill the shell. @@ -484,14 +484,14 @@ TkMacOSXDoHLEvent( * *---------------------------------------------------------------------- */ + static int ReallyKillMe( Tcl_Event *eventPtr, int flags) { Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp; - Tcl_CmdInfo dummy; - int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy); + int quit = Tcl_FindCommand(interp, "::tk::mac::Quit", NULL, 0)!=NULL; int code = Tcl_EvalEx(interp, quit ? "::tk::mac::Quit" : "exit", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { @@ -499,7 +499,7 @@ ReallyKillMe( * Should be never reached... */ - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); } return 1; } @@ -533,6 +533,7 @@ MissedAnyParameters( return (err != errAEDescNotFound); } + /* * Local Variables: diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c index cb97f47..997d306 100644 --- a/macosx/tkMacOSXInit.c +++ b/macosx/tkMacOSXInit.c @@ -14,8 +14,6 @@ #include "tkMacOSXPrivate.h" -#include "tclInt.h" /* for Tcl_GetStartupScript() & Tcl_SetStartupScript() */ - #include <sys/stat.h> #include <sys/utsname.h> #include <dlfcn.h> @@ -32,7 +30,7 @@ static char scriptPath[PATH_MAX + 1] = ""; long tkMacOSXMacOSXVersion = 0; -#pragma mark TKApplication(TKInit) +#pragma mark TKApplication(TKInit) #if MAC_OS_X_VERSION_MIN_REQUIRED < 1060 #define NSTextInputContextKeyboardSelectionDidChangeNotification @"NSTextInputContextKeyboardSelectionDidChangeNotification" @@ -42,7 +40,7 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt #endif @interface TKApplication(TKKeyboard) -- (void)keyboardChanged:(NSNotification *)notification; +- (void) keyboardChanged: (NSNotification *) notification; @end #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1060 @@ -51,11 +49,11 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt #define TKApplication_NSApplicationDelegate #endif @interface TKApplication(TKWindowEvent) TKApplication_NSApplicationDelegate -- (void)_setupWindowNotifications; +- (void) _setupWindowNotifications; @end @interface TKApplication(TKMenus) -- (void)_setupMenus; +- (void) _setupMenus; @end @implementation TKApplication @@ -73,13 +71,17 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt } } #ifdef TK_MAC_DEBUG_NOTIFICATIONS -- (void)_postedNotification:(NSNotification *)notification { +- (void) _postedNotification: (NSNotification *) notification +{ TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification); } #endif -- (void)_setupApplicationNotifications { + +- (void) _setupApplicationNotifications +{ NSNotificationCenter *nc = [NSNotificationCenter defaultCenter]; -#define observe(n, s) [nc addObserver:self selector:@selector(s) name:(n) object:nil] +#define observe(n, s) \ + [nc addObserver:self selector:@selector(s) name:(n) object:nil] observe(NSApplicationDidBecomeActiveNotification, applicationActivate:); observe(NSApplicationDidResignActiveNotification, applicationDeactivate:); observe(NSApplicationDidUnhideNotification, applicationShowHide:); @@ -91,13 +93,17 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt CFNotificationCenterAddObserver(CFNotificationCenterGetDistributedCenter(), NULL, &keyboardChanged, kTISNotifySelectedKeyboardInputSourceChanged, NULL, CFNotificationSuspensionBehaviorCoalesce); #endif } -- (void)_setupEventLoop { + +- (void) _setupEventLoop +{ NSAutoreleasePool *pool = [NSAutoreleasePool new]; [self finishLaunching]; [self setWindowsNeedUpdate:YES]; [pool drain]; } -- (void)_setup:(Tcl_Interp *)interp { + +- (void) _setup: (Tcl_Interp *) interp +{ _eventInterp = interp; _mainPool = nil; [NSApp setPoolProtected:NO]; @@ -113,7 +119,9 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt [self _setupApplicationNotifications]; [pool drain]; } -- (NSString *)tkFrameworkImagePath:(NSString*)image { + +- (NSString *) tkFrameworkImagePath: (NSString *) image +{ NSString *path = nil; NSAutoreleasePool *pool = [NSAutoreleasePool new]; if (tkLibPath[0] != '\0') { @@ -124,8 +132,10 @@ static void keyboardChanged(CFNotificationCenterRef center, void *observer, CFSt if (!path) { const char *tk_library = Tcl_GetVar2(_eventInterp, "tk_library", NULL, TCL_GLOBAL_ONLY); + if (tk_library) { NSFileManager *fm = [NSFileManager defaultManager]; + path = [[NSString stringWithUTF8String:tk_library] stringByAppendingFormat:@"/%@", image]; if (![fm isReadableFileAtPath:path]) { @@ -236,7 +246,7 @@ TkpInit( if (!uname(&name)) { tkMacOSXMacOSXVersion = (strtod(name.release, NULL) + 96) * 10; } - /*Check for new versioning scheme on Yosemite (10.10) and later.*/ + /*Check for new versioning scheme on Yosemite (10.10) and later.*/ if (MAC_OS_X_VERSION_MIN_REQUIRED > 100000) { tkMacOSXMacOSXVersion = MAC_OS_X_VERSION_MIN_REQUIRED/100; } @@ -245,7 +255,7 @@ TkpInit( Tcl_Panic("Mac OS X 10.%d or later required !", (MAC_OS_X_VERSION_MIN_REQUIRED/10)-100); } - + #ifdef TK_FRAMEWORK /* @@ -338,7 +348,7 @@ TkpInit( TkMacOSXInitCGDrawing(interp, TRUE, 0); [pool drain]; } - + /* * FIXME: Close stdin & stdout for remote debugging otherwise we will * fight with gdb for stdin & stdout @@ -369,11 +379,11 @@ TkpInit( */ if (Tcl_GetStartupScript(NULL) == NULL) { - const char *intvar = Tcl_GetVar(interp, - "tcl_interactive", TCL_GLOBAL_ONLY); + const char *intvar = Tcl_GetVar2(interp, + "tcl_interactive", NULL, TCL_GLOBAL_ONLY); if (intvar == NULL) { - Tcl_SetVar(interp, "tcl_interactive", "1", + Tcl_SetVar2(interp, "tcl_interactive", NULL, "1", TCL_GLOBAL_ONLY); } } @@ -386,11 +396,11 @@ TkpInit( Tk_MacOSXSetupTkNotifier(); if (tkLibPath[0] != '\0') { - Tcl_SetVar(interp, "tk_library", tkLibPath, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tk_library", NULL, tkLibPath, TCL_GLOBAL_ONLY); } if (scriptPath[0] != '\0') { - Tcl_SetVar(interp, "auto_path", scriptPath, + Tcl_SetVar2(interp, "auto_path", NULL, scriptPath, TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT|TCL_APPEND_VALUE); } @@ -427,7 +437,7 @@ TkpGetAppName( { const char *p, *name; - name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); + name = Tcl_GetVar2(interp, "argv0", NULL, TCL_GLOBAL_ONLY); if ((name == NULL) || (*name == 0)) { name = "tk"; } else { diff --git a/macosx/tkMacOSXKeyEvent.c b/macosx/tkMacOSXKeyEvent.c index da74e60..151b4f2 100644 --- a/macosx/tkMacOSXKeyEvent.c +++ b/macosx/tkMacOSXKeyEvent.c @@ -7,7 +7,7 @@ * Copyright 2001-2009, Apple Inc. * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net> * Copyright (c) 2012 Adrian Robert. - * Copyright 2015 Marc Culler. + * Copyright 2015 Marc Culler. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. diff --git a/macosx/tkMacOSXKeyboard.c b/macosx/tkMacOSXKeyboard.c index 7579ee6..7ac087d 100644 --- a/macosx/tkMacOSXKeyboard.c +++ b/macosx/tkMacOSXKeyboard.c @@ -416,7 +416,7 @@ XKeycodeToKeysym( *---------------------------------------------------------------------- */ -char * +const char * TkpGetString( TkWindow *winPtr, /* Window where event occurred: Needed to get * input context. */ @@ -458,7 +458,7 @@ XGetModifierMapping( * don't generate them either. So there is no modifier map. */ - modmap = (XModifierKeymap *) ckalloc(sizeof(XModifierKeymap)); + modmap = ckalloc(sizeof(XModifierKeymap)); modmap->max_keypermod = 0; modmap->modifiermap = NULL; return modmap; @@ -485,9 +485,9 @@ XFreeModifiermap( XModifierKeymap *modmap) { if (modmap->modifiermap != NULL) { - ckfree((char *) modmap->modifiermap); + ckfree(modmap->modifiermap); } - ckfree((char *) modmap); + ckfree(modmap); return Success; } @@ -734,6 +734,7 @@ TkpGetKeySym( */ if (eventPtr->xany.send_event == -1) { + int modifier = eventPtr->xkey.keycode & NSDeviceIndependentModifierFlagsMask; if (modifier == NSCommandKeyMask) { @@ -898,7 +899,7 @@ TkpInitKeymapInfo( */ if (dispPtr->modKeyCodes != NULL) { - ckfree((char *) dispPtr->modKeyCodes); + ckfree(dispPtr->modKeyCodes); } dispPtr->numModKeyCodes = 0; dispPtr->modKeyCodes = NULL; diff --git a/macosx/tkMacOSXMenu.c b/macosx/tkMacOSXMenu.c index 8f20447..c7e3a78 100644 --- a/macosx/tkMacOSXMenu.c +++ b/macosx/tkMacOSXMenu.c @@ -270,7 +270,7 @@ static int ModifierCharWidth(Tk_Font tkfont); if (result != TCL_OK && result != TCL_CONTINUE && result != TCL_BREAK) { Tcl_AddErrorInfo(interp, "\n (menu invoke)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_Release(menuPtr); Tcl_Release(interp); @@ -360,7 +360,7 @@ static int ModifierCharWidth(Tk_Font tkfont); if (result!=TCL_OK && result!=TCL_CONTINUE && result!=TCL_BREAK) { Tcl_AddErrorInfo(interp, "\n (menu preprocess)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_Release(menuPtr); Tcl_Release(interp); @@ -682,18 +682,18 @@ TkpConfigureMenuEntry( int i = 0; NSArray *itemArray = [submenu itemArray]; for (NSMenuItem *item in itemArray) { - TkMenuEntry *submePtr = menuRefPtr->menuPtr->entries[i]; - /* Work around an apparent bug where itemArray can have + TkMenuEntry *submePtr = menuRefPtr->menuPtr->entries[i]; + /* Work around an apparent bug where itemArray can have more items than the menu's entries[] array. */ if (i >= menuRefPtr->menuPtr->numEntries) break; - [item setEnabled: !(submePtr->state == ENTRY_DISABLED)]; - i++; + [item setEnabled: !(submePtr->state == ENTRY_DISABLED)]; + i++; } } + } } } - [menuItem setSubmenu:submenu]; return TCL_OK; @@ -761,7 +761,7 @@ TkpPostMenu( * to be posted. */ int y) /* The global y-coordinate */ { - + /* Get the object that holds this Tk Window.*/ Tk_Window root; @@ -769,11 +769,11 @@ TkpPostMenu( if (root == NULL) { return TCL_ERROR; } - + Drawable d = Tk_WindowId(root); NSView *rootview = TkMacOSXGetRootControl(d); NSWindow *win = [rootview window]; - + inPostMenu = 1; int oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); @@ -847,12 +847,12 @@ TkpSetWindowMenuBar( * *---------------------------------------------------------------------- */ - + void TkpSetMainMenubar( Tcl_Interp *interp, /* The interpreter of the application */ Tk_Window tkwin, /* The frame we are setting up */ - char *menuName) /* The name of the menu to put in front.*/ + const char *menuName) /* The name of the menu to put in front. */ { static Tcl_Interp *currentInterp = NULL; TKMenu *menu = nil; @@ -1462,10 +1462,10 @@ TkpMenuInit(void) [NSMenuItem setUsesUserKeyEquivalents:NO]; tkColPtr = TkpGetColor(None, DEF_MENU_BG_COLOR); defaultBg = tkColPtr->color.pixel; - ckfree((char *) tkColPtr); + ckfree(tkColPtr); tkColPtr = TkpGetColor(None, DEF_MENU_FG); defaultFg = tkColPtr->color.pixel; - ckfree((char *) tkColPtr); + ckfree(tkColPtr); ChkErr(GetThemeMetric, kThemeMetricMenuMarkColumnWidth, &menuMarkColumnWidth); @@ -1528,7 +1528,7 @@ TkpMenuThreadInit(void) void TkpMenuNotifyToplevelCreate( Tcl_Interp *interp, /* The interp the menu lives in. */ - char *menuName) /* The name of the menu to reconfigure. */ + const char *menuName) /* The name of the menu to reconfigure. */ { /* * Nothing to do. diff --git a/macosx/tkMacOSXMenubutton.c b/macosx/tkMacOSXMenubutton.c index 4a3c7f8..a85e572 100644 --- a/macosx/tkMacOSXMenubutton.c +++ b/macosx/tkMacOSXMenubutton.c @@ -7,8 +7,8 @@ * Copyright (c) 1996 by Sun Microsystems, Inc. * Copyright 2001, Apple Computer, Inc. * Copyright (c) 2006-2007 Daniel A. Steffen <das@users.sourceforge.net> - * Copyright 2007 Revar Desmera. - * Copyright 2015 Kevin Walzer/WordTech Communications LLC. + * Copyright 2007 Revar Desmera. + * Copyright 2015 Kevin Walzer/WordTech Communications LLC. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -138,12 +138,12 @@ TkpDisplayMenuButton( pixmap = (Pixmap) Tk_WindowId(tkwin); TkMacOSXComputeMenuButtonDrawParams(butPtr, dpPtr); - - /* + + /* * set up clipping region. Make sure the we are using the port - * for this button, or we will set the wrong window's clip. + * for this button, or we will set the wrong window's clip. */ - + TkMacOSXSetUpClippingRgn(pixmap); /* Draw the native portion of the buttons. */ @@ -214,7 +214,7 @@ TkpComputeMenuButtonGeometry(butPtr) /* * First figure out the size of the contents of the button. */ - + width = 0; height = 0; txtWidth = 0; @@ -255,36 +255,36 @@ TkpComputeMenuButtonGeometry(butPtr) switch ((enum compound) butPtr->compound) { case COMPOUND_TOP: case COMPOUND_BOTTOM: { - /* - * Image is above or below text + /* + * Image is above or below text */ - + height += txtHeight + butPtr->padY; width = (width > txtWidth ? width : txtWidth); break; } case COMPOUND_LEFT: case COMPOUND_RIGHT: { - /* - * Image is left or right of text + /* + * Image is left or right of text */ - + width += txtWidth + butPtr->padX; height = (height > txtHeight ? height : txtHeight); break; } case COMPOUND_CENTER: { - /* - * Image and text are superimposed + /* + * Image and text are superimposed */ - + width = (width > txtWidth ? width : txtWidth); height = (height > txtHeight ? height : txtHeight); break; } case COMPOUND_NONE: {break;} } - + if (butPtr->width > 0) { width = butPtr->width; } @@ -316,11 +316,11 @@ TkpComputeMenuButtonGeometry(butPtr) /*Add padding for button arrows.*/ width += 22; - + /* * Now figure out the size of the border decorations for the button. */ - + if (butPtr->highlightWidth < 0) { butPtr->highlightWidth = 0; } @@ -351,7 +351,7 @@ TkpComputeMenuButtonGeometry(butPtr) /* Pad to fill difference between content bounds and button bounds. */ paddingx = tmpRect.origin.x - contBounds.origin.x; paddingy = tmpRect.origin.y - contBounds.origin.y; - + if (paddingx > 0) { width += paddingx; } @@ -406,7 +406,7 @@ DrawMenuButtonImageAndText( if (tkwin == NULL || !Tk_IsMapped(tkwin)) { return; } - + DrawParams* dpPtr = &mbPtr->drawParams; pixmap = (Pixmap)Tk_WindowId(tkwin); @@ -426,7 +426,7 @@ DrawMenuButtonImageAndText( /* Offset bitmaps by a bit when the button is pressed. */ pressed = 1; } - + haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0); if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) { int x = 0; @@ -437,7 +437,7 @@ DrawMenuButtonImageAndText( fullHeight = 0; switch ((enum compound) butPtr->compound) { - case COMPOUND_TOP: + case COMPOUND_TOP: case COMPOUND_BOTTOM: { /* Image is above or below text */ if (butPtr->compound == COMPOUND_TOP) { @@ -454,10 +454,10 @@ DrawMenuButtonImageAndText( } case COMPOUND_LEFT: case COMPOUND_RIGHT: { - /* - * Image is left or right of text + /* + * Image is left or right of text */ - + if (butPtr->compound == COMPOUND_LEFT) { textXOffset = width + butPtr->padX - 2; } else { @@ -471,10 +471,10 @@ DrawMenuButtonImageAndText( break; } case COMPOUND_CENTER: { - /* - * Image and text are superimposed + /* + * Image and text are superimposed */ - + fullWidth = (width > butPtr->textWidth ? width : butPtr->textWidth); fullHeight = (height > butPtr->textHeight ? height : @@ -508,11 +508,11 @@ DrawMenuButtonImageAndText( XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0); } - Tk_DrawTextLayout(butPtr->display, pixmap, + Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->gc, butPtr->textLayout, x + textXOffset, y + textYOffset, 0, -1); Tk_UnderlineTextLayout(butPtr->display, pixmap, dpPtr->gc, - butPtr->textLayout, + butPtr->textLayout, x + textXOffset, y + textYOffset, butPtr->underline); } else { @@ -522,10 +522,10 @@ DrawMenuButtonImageAndText( TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX + butPtr->borderWidth, butPtr->padY + butPtr->borderWidth, - width, height, &x, &y); + width, height, &x, &y); imageXOffset += x; imageYOffset += y; - + if (butPtr->image != NULL) { Tk_RedrawImage(butPtr->image, 0, 0, width, height, pixmap, imageXOffset, imageYOffset); @@ -552,7 +552,7 @@ DrawMenuButtonImageAndText( } } - + /* *-------------------------------------------------------------- @@ -560,7 +560,7 @@ DrawMenuButtonImageAndText( * TkMacOSXDrawMenuButton -- * * This function draws the tk menubutton using Mac controls - * In addition, this code may apply custom colors passed + * In addition, this code may apply custom colors passed * in the TkMenubutton. * * Results: @@ -578,7 +578,7 @@ TkMacOSXDrawMenuButton( * the bevel button */ Pixmap pixmap) /* The pixmap we are drawing into - needed * for the bevel button */ - + { TkMenuButton * butPtr = ( TkMenuButton *)mbPtr; TkWindow * winPtr; @@ -588,11 +588,11 @@ TkMacOSXDrawMenuButton( int useNewerHITools = 1; winPtr = (TkWindow *)butPtr->tkwin; - + TkMacOSXComputeMenuButtonParams(butPtr, &mbPtr->btnkind, &mbPtr->drawinfo); cntrRect = CGRectMake(winPtr->privatePtr->xOff, winPtr->privatePtr->yOff, Tk_Width(butPtr->tkwin),Tk_Height(butPtr->tkwin)); - + cntrRect = CGRectInset(cntrRect, butPtr->inset, butPtr->inset); @@ -626,7 +626,7 @@ TkMacOSXDrawMenuButton( if (!TkMacOSXSetupDrawingContext(pixmap, dpPtr->gc, 1, &dc)) { return; } - + TkMacOSXRestoreDrawingContext(&dc); } @@ -777,7 +777,7 @@ TkMacOSXComputeMenuButtonParams(TkMenuButton * butPtr, ThemeButtonKind* btnkind, } drawinfo->value = kThemeButtonOff; - + if ((mbPtr->flags & FIRST_DRAW) != 0) { mbPtr->flags &= ~FIRST_DRAW; if (Tk_MacOSXIsAppInFront()) { @@ -828,7 +828,7 @@ TkMacOSXComputeMenuButtonParams(TkMenuButton * butPtr, ThemeButtonKind* btnkind, static int TkMacOSXComputeMenuButtonDrawParams(TkMenuButton * butPtr, DrawParams * dpPtr) { - dpPtr->hasImageOrBitmap = ((butPtr->image != NULL) + dpPtr->hasImageOrBitmap = ((butPtr->image != NULL) || (butPtr->bitmap != None)); dpPtr->border = butPtr->normalBorder; if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) { diff --git a/macosx/tkMacOSXMenus.c b/macosx/tkMacOSXMenus.c index 8b0c013..68b2c00 100644 --- a/macosx/tkMacOSXMenus.c +++ b/macosx/tkMacOSXMenus.c @@ -16,24 +16,29 @@ static void GenerateEditEvent(const char *name); static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); - + #pragma mark TKApplication(TKMenus) @implementation TKApplication(TKMenus) -- (void)_setupMenus { +- (void) _setupMenus +{ if (_defaultMainMenu) { return; } TkMenuInit(); + NSString *applicationName = [[NSBundle mainBundle] objectForInfoDictionaryKey:@"CFBundleName"]; + if (!applicationName) { applicationName = [[NSProcessInfo processInfo] processName]; } + NSString *aboutName = (applicationName && ![applicationName isEqualToString:@"Wish"] && ![applicationName hasPrefix:@"tclsh"]) ? applicationName : @"Tcl & Tk"; + _servicesMenu = [NSMenu menuWithTitle:@"Services"]; _defaultApplicationMenuItems = [[NSArray arrayWithObjects: [NSMenuItem separatorItem], @@ -63,6 +68,7 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); [NSMenuItem itemWithTitle: [NSString stringWithFormat:@"About %@", aboutName] action:@selector(orderFrontStandardAboutPanel:)] atIndex:0]; + TKMenu *fileMenu = [TKMenu menuWithTitle:@"File" menuItems: [NSArray arrayWithObjects: [NSMenuItem itemWithTitle: @@ -89,6 +95,7 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); [NSMenuItem itemWithTitle:@"Delete" action:@selector(delete:) target:nil], nil]]; + _defaultWindowsMenuItems = [[NSArray arrayWithObjects: [NSMenuItem itemWithTitle:@"Minimize" action:@selector(performMiniaturize:) target:nil @@ -99,15 +106,19 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); [NSMenuItem itemWithTitle:@"Bring All to Front" action:@selector(arrangeInFront:)], nil] retain]; + TKMenu *windowsMenu = [TKMenu menuWithTitle:@"Window" menuItems: _defaultWindowsMenuItems]; + _defaultHelpMenuItems = [[NSArray arrayWithObjects: [NSMenuItem itemWithTitle: [NSString stringWithFormat:@"%@ Help", applicationName] action:@selector(showHelp:) keyEquivalent:@"?"], nil] retain]; + TKMenu *helpMenu = [TKMenu menuWithTitle:@"Help" menuItems: _defaultHelpMenuItems]; + [self setServicesMenu:_servicesMenu]; [self setWindowsMenu:windowsMenu]; _defaultMainMenu = [[TKMenu menuWithTitle:@"" submenus:[NSArray @@ -119,22 +130,27 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); [helpMenu setSpecial:tkHelpMenu]; [self tkSetMainMenu:nil]; } -- (void)dealloc { + +- (void) dealloc +{ [_defaultMainMenu release]; [_defaultHelpMenuItems release]; [_defaultWindowsMenuItems release]; [_defaultApplicationMenuItems release]; [super dealloc]; } -- (BOOL)validateUserInterfaceItem:(id <NSValidatedUserInterfaceItem>)anItem { + +- (BOOL) validateUserInterfaceItem: (id <NSValidatedUserInterfaceItem>) anItem +{ SEL action = [anItem action]; if (sel_isEqual(action, @selector(preferences:))) { - Tcl_CmdInfo dummy; - return (_eventInterp && Tcl_GetCommandInfo(_eventInterp, - "::tk::mac::ShowPreferences", &dummy)); + + return (_eventInterp && Tcl_FindCommand(_eventInterp, + "::tk::mac::ShowPreferences", NULL, 0)); } else if (sel_isEqual(action, @selector(tkDemo:))) { BOOL haveDemo = NO; + if (_eventInterp) { Tcl_Obj *path = GetWidgetDemoPath(_eventInterp); @@ -149,47 +165,56 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); return [super validateUserInterfaceItem:anItem]; } } -- (void)orderFrontStandardAboutPanel:(id)sender { - Tcl_CmdInfo dummy; - if (!_eventInterp || !Tcl_GetCommandInfo(_eventInterp, "tkAboutDialog", - &dummy) || (GetCurrentEventKeyModifiers() & optionKey)) { + +- (void) orderFrontStandardAboutPanel: (id) sender +{ + if (!_eventInterp || !Tcl_FindCommand(_eventInterp, "tkAboutDialog", + NULL, 0) || (GetCurrentEventKeyModifiers() & optionKey)) { TkAboutDlg(); } else { int code = Tcl_EvalEx(_eventInterp, "tkAboutDialog", -1, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { - Tcl_BackgroundError(_eventInterp); + Tcl_BackgroundException(_eventInterp, code); } Tcl_ResetResult(_eventInterp); } } -- (void)showHelp:(id)sender { - Tcl_CmdInfo dummy; - if (!_eventInterp || !Tcl_GetCommandInfo(_eventInterp, - "::tk::mac::ShowHelp", &dummy)) { + +- (void) showHelp: (id) sender +{ + if (!_eventInterp || !Tcl_FindCommand(_eventInterp, + "::tk::mac::ShowHelp", NULL, 0)) { [super showHelp:sender]; } else { int code = Tcl_EvalEx(_eventInterp, "::tk::mac::ShowHelp", -1, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { - Tcl_BackgroundError(_eventInterp); + Tcl_BackgroundException(_eventInterp, code); } Tcl_ResetResult(_eventInterp); } } -- (void)tkSource:(id)sender { + +- (void) tkSource: (id) sender +{ if (_eventInterp) { if (Tcl_EvalEx(_eventInterp, "tk_getOpenFile -filetypes {" "{{TCL Scripts} {.tcl} TEXT} {{Text Files} {} TEXT}}", -1, TCL_EVAL_GLOBAL) == TCL_OK) { Tcl_Obj *path = Tcl_GetObjResult(_eventInterp); int len; + Tcl_GetStringFromObj(path, &len); if (len) { Tcl_IncrRefCount(path); - int code = Tcl_FSEvalFile(_eventInterp, path); + + int code = Tcl_FSEvalFileEx(_eventInterp, path, NULL); + if (code != TCL_OK) { - Tcl_BackgroundError(_eventInterp); + Tcl_BackgroundException(_eventInterp, code); } Tcl_DecrRefCount(path); } @@ -197,14 +222,19 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); Tcl_ResetResult(_eventInterp); } } -- (void)tkDemo:(id)sender { + +- (void) tkDemo: (id) sender +{ if (_eventInterp) { Tcl_Obj *path = GetWidgetDemoPath(_eventInterp); + if (path) { Tcl_IncrRefCount(path); - int code = Tcl_FSEvalFile(_eventInterp, path); + + int code = Tcl_FSEvalFileEx(_eventInterp, path, NULL); + if (code != TCL_OK) { - Tcl_BackgroundError(_eventInterp); + Tcl_BackgroundException(_eventInterp, code); } Tcl_DecrRefCount(path); Tcl_ResetResult(_eventInterp); @@ -212,15 +242,19 @@ static Tcl_Obj * GetWidgetDemoPath(Tcl_Interp *interp); } } @end - + #pragma mark TKContentView(TKMenus) @implementation TKContentView(TKMenus) -- (BOOL)validateUserInterfaceItem:(id <NSValidatedUserInterfaceItem>)anItem { + +- (BOOL) validateUserInterfaceItem: (id <NSValidatedUserInterfaceItem>) anItem +{ return YES; } + #define EDIT_ACTION(a, e) \ - - (void) a:(id)sender { \ + - (void) a: (id) sender \ + { \ if ([sender isKindOfClass:[NSMenuItem class]]) { \ GenerateEditEvent(#e); \ } \ @@ -371,90 +405,129 @@ GenerateEditEvent( } #pragma mark - + #pragma mark NSMenu & NSMenuItem Utilities @implementation NSMenu(TKUtils) -+ (id)menuWithTitle:(NSString *)title { + ++ (id) menuWithTitle: (NSString *) title +{ NSMenu *m = [[self alloc] initWithTitle:title]; + return [m autorelease]; } -+ (id)menuWithTitle:(NSString *)title menuItems:(NSArray *)items { + ++ (id) menuWithTitle: (NSString *) title menuItems: (NSArray *) items +{ NSMenu *m = [[self alloc] initWithTitle:title]; + for (NSMenuItem *i in items) { [m addItem:i]; } return [m autorelease]; } -+ (id)menuWithTitle:(NSString *)title submenus:(NSArray *)submenus { + ++ (id) menuWithTitle: (NSString *) title submenus: (NSArray *) submenus +{ NSMenu *m = [[self alloc] initWithTitle:title]; + for (NSMenu *i in submenus) { [m addItem:[NSMenuItem itemWithSubmenu:i]]; } return [m autorelease]; } -- (NSMenuItem *)itemWithSubmenu:(NSMenu *)submenu { + +- (NSMenuItem *) itemWithSubmenu: (NSMenu *) submenu +{ return [self itemAtIndex:[self indexOfItemWithSubmenu:submenu]]; } -- (NSMenuItem *)itemInSupermenu { + +- (NSMenuItem *) itemInSupermenu +{ NSMenu *supermenu = [self supermenu]; + return (supermenu ? [supermenu itemWithSubmenu:self] : nil); } @end @implementation NSMenuItem(TKUtils) -+ (id)itemWithSubmenu:(NSMenu *)submenu { + ++ (id) itemWithSubmenu: (NSMenu *) submenu +{ NSMenuItem *i = [[self alloc] initWithTitle:[submenu title] action:NULL keyEquivalent:@""]; + [i setSubmenu:submenu]; return [i autorelease]; } -+ (id)itemWithTitle:(NSString *)title submenu:(NSMenu *)submenu { + ++ (id) itemWithTitle: (NSString *) title submenu: (NSMenu *) submenu +{ NSMenuItem *i = [[self alloc] initWithTitle:title action:NULL keyEquivalent:@""]; + [i setSubmenu:submenu]; return [i autorelease]; } -+ (id)itemWithTitle:(NSString *)title action:(SEL)action { + ++ (id) itemWithTitle: (NSString *) title action: (SEL) action +{ NSMenuItem *i = [[self alloc] initWithTitle:title action:action keyEquivalent:@""]; + [i setTarget:NSApp]; return [i autorelease]; } -+ (id)itemWithTitle:(NSString *)title action:(SEL)action - target:(id)target { + ++ (id) itemWithTitle: (NSString *) title action: (SEL) action + target: (id) target +{ NSMenuItem *i = [[self alloc] initWithTitle:title action:action keyEquivalent:@""]; + [i setTarget:target]; return [i autorelease]; } -+ (id)itemWithTitle:(NSString *)title action:(SEL)action - keyEquivalent:(NSString *)keyEquivalent { + ++ (id) itemWithTitle: (NSString *) title action: (SEL) action + keyEquivalent: (NSString *) keyEquivalent +{ NSMenuItem *i = [[self alloc] initWithTitle:title action:action keyEquivalent:keyEquivalent]; + [i setTarget:NSApp]; return [i autorelease]; } -+ (id)itemWithTitle:(NSString *)title action:(SEL)action - target:(id)target keyEquivalent:(NSString *)keyEquivalent { + ++ (id) itemWithTitle: (NSString *) title action: (SEL) action + target: (id) target keyEquivalent: (NSString *) keyEquivalent +{ NSMenuItem *i = [[self alloc] initWithTitle:title action:action keyEquivalent:keyEquivalent]; + [i setTarget:target]; return [i autorelease]; } -+ (id)itemWithTitle:(NSString *)title action:(SEL)action - keyEquivalent:(NSString *)keyEquivalent - keyEquivalentModifierMask:(NSUInteger)keyEquivalentModifierMask { + ++ (id) itemWithTitle: (NSString *) title action: (SEL) action + keyEquivalent: (NSString *) keyEquivalent + keyEquivalentModifierMask: (NSUInteger) keyEquivalentModifierMask +{ NSMenuItem *i = [[self alloc] initWithTitle:title action:action keyEquivalent:keyEquivalent]; + [i setTarget:NSApp]; [i setKeyEquivalentModifierMask:keyEquivalentModifierMask]; return [i autorelease]; } -+ (id)itemWithTitle:(NSString *)title action:(SEL)action - target:(id)target keyEquivalent:(NSString *)keyEquivalent - keyEquivalentModifierMask:(NSUInteger)keyEquivalentModifierMask { + ++ (id) itemWithTitle: (NSString *) title action: (SEL) action + target: (id) target keyEquivalent: (NSString *) keyEquivalent + keyEquivalentModifierMask: (NSUInteger) keyEquivalentModifierMask +{ NSMenuItem *i = [[self alloc] initWithTitle:title action:action keyEquivalent:keyEquivalent]; + [i setTarget:target]; [i setKeyEquivalentModifierMask:keyEquivalentModifierMask]; return [i autorelease]; diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index cd3eac1..c4197f7 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -33,7 +33,6 @@ static unsigned int ButtonModifiers2State(UInt32 buttonState, enum { NSWindowWillMoveEventType = 20 }; - /* * In OS X 10.6 an NSEvent of type NSMouseMoved would always have a non-Nil * window attribute pointing to the active window. As of 10.8 this behavior @@ -45,7 +44,8 @@ enum { */ @implementation TKApplication(TKMouseEvent) -- (NSEvent *)tkProcessMouseEvent:(NSEvent *)theEvent { +- (NSEvent *) tkProcessMouseEvent: (NSEvent *) theEvent +{ #ifdef TK_MAC_DEBUG_EVENTS TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, theEvent); #endif @@ -55,18 +55,8 @@ enum { NSTrackingArea *trackingArea = nil; NSInteger eventNumber, clickCount, buttonNumber; #endif - switch (eventType) { case NSMouseEntered: - /* Remember which window has the mouse. */ - if (_windowWithMouse) { - [_windowWithMouse release]; - } - _windowWithMouse = [theEvent window]; - if (_windowWithMouse) { - [_windowWithMouse retain]; - } - break; case NSMouseExited: case NSCursorUpdate: case NSLeftMouseDown: @@ -79,13 +69,6 @@ enum { case NSRightMouseDragged: case NSOtherMouseDragged: case NSMouseMoved: -#if 0 - eventNumber = [theEvent eventNumber]; - if (!trackingArea) { - clickCount = [theEvent clickCount]; - buttonNumber = [theEvent buttonNumber]; - } -#endif case NSTabletPoint: case NSTabletProximity: case NSScrollWheel: @@ -145,24 +128,24 @@ enum { EventRef eventRef = (EventRef)[theEvent eventRef]; UInt32 buttons; OSStatus err = GetEventParameter(eventRef, kEventParamMouseChord, - typeUInt32, NULL, sizeof(UInt32), NULL, &buttons); + typeUInt32, NULL, sizeof(UInt32), NULL, &buttons); + if (err == noErr) { - state |= (buttons & ((1<<5) - 1)) << 8; - } else { - if (button < 5) { - switch (eventType) { - case NSLeftMouseDown: - case NSRightMouseDown: - case NSLeftMouseDragged: - case NSRightMouseDragged: - case NSOtherMouseDown: - state |= 1 << (button + 8); - break; - default: - break; - } + state |= (buttons & ((1<<5) - 1)) << 8; + } else if (button < 5) { + switch (eventType) { + case NSLeftMouseDown: + case NSRightMouseDown: + case NSLeftMouseDragged: + case NSRightMouseDragged: + case NSOtherMouseDown: + state |= 1 << (button + 8); + break; + default: + break; } } + NSUInteger modifiers = [theEvent modifierFlags]; if (modifiers & NSAlphaShiftKeyMask) { @@ -554,6 +537,39 @@ GenerateButtonEvent( return true; } +void +TkpWarpPointer( + TkDisplay *dispPtr) +{ + CGPoint pt; + UInt32 buttonState; + + if (dispPtr->warpWindow) { + int x, y; + + Tk_GetRootCoords(dispPtr->warpWindow, &x, &y); + pt.x = x + dispPtr->warpX; + pt.y = y + dispPtr->warpY; + } else { + pt.x = dispPtr->warpX; + pt.y = dispPtr->warpY; + } + + /* + * Tell the OSX core to generate the events to make it happen. + */ + + buttonState = [NSEvent pressedMouseButtons]; + CGEventType type = kCGEventMouseMoved; + CGEventRef theEvent = CGEventCreateMouseEvent(NULL, + type, + pt, + buttonState); + CGWarpMouseCursorPosition(pt); + CGEventPost(kCGHIDEventTap, theEvent); + CFRelease(theEvent); +} + /* * Local Variables: * mode: objc diff --git a/macosx/tkMacOSXNotify.c b/macosx/tkMacOSXNotify.c index 0737d74..1455688 100644 --- a/macosx/tkMacOSXNotify.c +++ b/macosx/tkMacOSXNotify.c @@ -7,7 +7,7 @@ * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright 2001-2009, Apple Inc. * Copyright (c) 2005-2009 Daniel A. Steffen <das@users.sourceforge.net> - * Copyright 2015 Marc Culler. + * Copyright 2015 Marc Culler. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -25,8 +25,8 @@ typedef struct ThreadSpecificData { } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -#define TSD_INIT() ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, \ - sizeof(ThreadSpecificData)) +#define TSD_INIT() ThreadSpecificData *tsdPtr = \ + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)) static void TkMacOSXNotifyExitHandler(ClientData clientData); static void TkMacOSXEventsSetupProc(ClientData clientData, int flags); @@ -36,11 +36,12 @@ static void TkMacOSXEventsCheckProc(ClientData clientData, int flags); @interface NSApplication(TKNotify) /* We need to declare this hidden method. */ -- (void)_modalSession:(NSModalSession)session sendEvent:(NSEvent *)event; +- (void) _modalSession: (NSModalSession) session sendEvent: (NSEvent *) event; @end @implementation NSWindow(TKNotify) -- (id)tkDisplayIfNeeded { +- (id) tkDisplayIfNeeded +{ if (![self isAutodisplay]) { [self displayIfNeeded]; } @@ -50,9 +51,10 @@ static void TkMacOSXEventsCheckProc(ClientData clientData, int flags); @implementation TKApplication(TKNotify) /* Display all windows each time an event is removed from the queue.*/ -- (NSEvent *)nextEventMatchingMask:(NSUInteger)mask - untilDate:(NSDate *)expiration inMode:(NSString *)mode - dequeue:(BOOL)deqFlag { +- (NSEvent *) nextEventMatchingMask: (NSUInteger) mask + untilDate: (NSDate *) expiration inMode: (NSString *) mode + dequeue: (BOOL) deqFlag +{ NSEvent *event = [super nextEventMatchingMask:mask untilDate:expiration inMode:mode @@ -63,10 +65,11 @@ static void TkMacOSXEventsCheckProc(ClientData clientData, int flags); return event; } - /* +/* * Call super then check the pasteboard. - */ -- (void)sendEvent:(NSEvent *)theEvent { + */ +- (void) sendEvent: (NSEvent *) theEvent +{ [super sendEvent:theEvent]; [NSApp tkCheckPasteboard]; } @@ -128,6 +131,7 @@ void Tk_MacOSXSetupTkNotifier(void) { TSD_INIT(); + if (!tsdPtr->initialized) { tsdPtr->initialized = 1; @@ -177,6 +181,7 @@ TkMacOSXNotifyExitHandler( ClientData clientData) /* Not used. */ { TSD_INIT(); + Tcl_DeleteEventSource(TkMacOSXEventsSetupProc, TkMacOSXEventsCheckProc, GetMainEventQueue()); @@ -213,7 +218,7 @@ TkMacOSXEventsSetupProc( NSString *runloopMode = [[NSRunLoop currentRunLoop] currentMode]; /* runloopMode will be nil if we are in the Tcl event loop. */ if (flags & TCL_WINDOW_EVENTS && !runloopMode) { - static Tcl_Time zeroBlockTime = { 0, 0 }; + static const Tcl_Time zeroBlockTime = { 0, 0 }; /* Call this with dequeue=NO -- just checking if the queue is empty. */ NSEvent *currentEvent = [NSApp nextEventMatchingMask:NSAnyEventMask untilDate:[NSDate distantPast] @@ -274,7 +279,6 @@ TkMacOSXEventsCheckProc( inMode:GetRunLoopMode(modalSession) dequeue:YES]; if (currentEvent) { - [NSApp _resetAutoreleasePool]; /* Generate Xevents. */ int oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); NSEvent *processedEvent = [NSApp tkProcessEvent:currentEvent]; diff --git a/macosx/tkMacOSXPort.h b/macosx/tkMacOSXPort.h index 2ccbac3..0c3b347 100644 --- a/macosx/tkMacOSXPort.h +++ b/macosx/tkMacOSXPort.h @@ -16,21 +16,6 @@ #ifndef _TKMACPORT #define _TKMACPORT -/* - * Macro to use instead of "void" for arguments that must have - * type "void *" in ANSI C; maps them to type "char *" in - * non-ANSI systems. This macro may be used in some of the include - * files below, which is why it is defined here. - */ - -#ifndef VOID -# ifdef __STDC__ -# define VOID void -# else -# define VOID char -# endif -#endif - #include <stdio.h> #include <ctype.h> #include <fcntl.h> @@ -127,7 +112,7 @@ */ #define XFlush(display) -#define XFree(data) {if ((data) != NULL) ckfree((char *) (data));} +#define XFree(data) {if ((data) != NULL) ckfree(data);} #define XGrabServer(display) #define XNoOp(display) {display->request++;} #define XUngrabServer(display) @@ -138,8 +123,6 @@ * The following functions are not used on the Mac, so we stub them out. */ -#define TkFreeWindowId(dispPtr,w) -#define TkInitXId(dispPtr) #define TkpCmapStressed(tkwin,colormap) (0) #define TkpFreeColor(tkColPtr) #define TkSetPixmapColormap(p,c) {} diff --git a/macosx/tkMacOSXPrivate.h b/macosx/tkMacOSXPrivate.h index e635020..2a411f6 100644 --- a/macosx/tkMacOSXPrivate.h +++ b/macosx/tkMacOSXPrivate.h @@ -8,8 +8,10 @@ * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id$ */ - + #ifndef _TKMACPRIV #define _TKMACPRIV @@ -300,19 +302,19 @@ VISIBILITY_HIDDEN @interface TKApplication(TKHLEvents) - (void) terminate: (id) sender; - (void) preferences: (id) sender; -- (void) handleQuitApplicationEvent: (NSAppleEventDescriptor *)event +- (void) handleQuitApplicationEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent; -- (void) handleOpenApplicationEvent: (NSAppleEventDescriptor *)event +- (void) handleOpenApplicationEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent; -- (void) handleReopenApplicationEvent: (NSAppleEventDescriptor *)event +- (void) handleReopenApplicationEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent; - (void) handleShowPreferencesEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent; -- (void) handleOpenDocumentsEvent: (NSAppleEventDescriptor *)event +- (void) handleOpenDocumentsEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent; -- (void) handlePrintDocumentsEvent: (NSAppleEventDescriptor *)event +- (void) handlePrintDocumentsEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent; -- (void) handleDoScriptEvent: (NSAppleEventDescriptor *)event +- (void) handleDoScriptEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent; @end diff --git a/macosx/tkMacOSXRegion.c b/macosx/tkMacOSXRegion.c index c716ab7..0f2a74a 100644 --- a/macosx/tkMacOSXRegion.c +++ b/macosx/tkMacOSXRegion.c @@ -207,7 +207,7 @@ TkRectInRegion( if ( TkMacOSXIsEmptyRegion(region) ) { return RectangleOut; } - else { + else { const CGRect r = CGRectMake(x, y, width, height); return HIShapeIntersectsRect((HIShapeRef) region, &r) ? RectanglePart : RectangleOut; diff --git a/macosx/tkMacOSXScale.c b/macosx/tkMacOSXScale.c index a37029c..c5a6f76 100644 --- a/macosx/tkMacOSXScale.c +++ b/macosx/tkMacOSXScale.c @@ -76,7 +76,7 @@ TkScale * TkpCreateScale( Tk_Window tkwin) { - MacScale *macScalePtr = (MacScale *) ckalloc(sizeof(MacScale)); + MacScale *macScalePtr = ckalloc(sizeof(MacScale)); macScalePtr->scaleHandle = NULL; if (scaleActionProc == NULL) { @@ -154,6 +154,7 @@ TkpDisplayScale( MacDrawable *macDraw; SInt32 initialValue, minValue, maxValue; UInt16 numTicks; + Tcl_DString buf; #ifdef TK_MAC_DEBUG_SCALE TkMacOSXDbgMsg("TkpDisplayScale"); @@ -171,10 +172,15 @@ TkpDisplayScale( if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) { Tcl_Preserve((ClientData) interp); sprintf(string, scalePtr->format, scalePtr->value); - result = Tcl_VarEval(interp, scalePtr->command, " ", string, NULL); + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, scalePtr->command, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, string, -1); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command executed by scale)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_Release((ClientData) interp); } diff --git a/macosx/tkMacOSXScrlbr.c b/macosx/tkMacOSXScrlbr.c index 7dde501..91cf112 100644 --- a/macosx/tkMacOSXScrlbr.c +++ b/macosx/tkMacOSXScrlbr.c @@ -1,5 +1,5 @@ /* - * tkMacOSXScrollbar.c -- + * tkMacOSXScrollbar.c -- * * This file implements the Macintosh specific portion of the scrollbar * widget. @@ -35,7 +35,7 @@ typedef struct MacScrollbar { TkScrollbar information; /* Generic scrollbar info. */ GC troughGC; /* For drawing trough. */ - GC copyGC; /* Used for copying from pixmap onto screen. */ + GC copyGC; /* Used for copying from pixmap onto screen. */ } MacScrollbar; /* @@ -44,7 +44,7 @@ typedef struct MacScrollbar { * variable is declared at this scope. */ -Tk_ClassProcs tkpScrollbarProcs = { +const Tk_ClassProcs tkpScrollbarProcs = { sizeof(Tk_ClassProcs), /* size */ NULL, /* worldChangedProc */ NULL, /* createProc */ @@ -108,7 +108,7 @@ TkpCreateScrollbar( scrollPtr->copyGC = None; Tk_CreateEventHandler(tkwin,ExposureMask|StructureNotifyMask|FocusChangeMask|ButtonPressMask|VisibilityChangeMask, ScrollbarEventProc, scrollPtr); - + return (TkScrollbar *) scrollPtr; } @@ -138,9 +138,9 @@ TkpDisplayScrollbar( register Tk_Window tkwin = scrollPtr->tkwin; TkWindow *winPtr = (TkWindow *) tkwin; TkMacOSXDrawingContext dc; - + scrollPtr->flags &= ~REDRAW_PENDING; - + if (tkwin == NULL || !Tk_IsMapped(tkwin)) { return; } @@ -182,7 +182,7 @@ TkpDisplayScrollbar( Tk_Width(tkwin) - 2*scrollPtr->inset, Tk_Height(tkwin) - 2*scrollPtr->inset, 0, TK_RELIEF_FLAT); - /*Update values and draw in native rect.*/ + /*Update values and draw in native rect.*/ UpdateControlValues(scrollPtr); if (MOUNTAIN_LION_STYLE) { HIThemeDrawTrack (&info, 0, dc.context, kHIThemeOrientationInverted); @@ -190,7 +190,7 @@ TkpDisplayScrollbar( HIThemeDrawTrack (&info, 0, dc.context, kHIThemeOrientationNormal); } TkMacOSXRestoreDrawingContext(&dc); - + scrollPtr->flags &= ~REDRAW_PENDING; } @@ -278,7 +278,7 @@ TkpComputeScrollbarGeometry( Tk_GeometryRequest(scrollPtr->tkwin, 2 * (scrollPtr->arrowLength + scrollPtr->borderWidth + scrollPtr->inset) + metrics[variant].minThumbHeight, scrollPtr->width + 2 * scrollPtr->inset); } Tk_SetInternalBorder(scrollPtr->tkwin, scrollPtr->inset); - + } /* @@ -384,7 +384,7 @@ TkpScrollbarPosition( x = y; y = tmp; length = Tk_Width(scrollPtr->tkwin); - fieldlength = length - 2 * arrowSize; + fieldlength = length - 2 * arrowSize; width = Tk_Height(scrollPtr->tkwin); } fieldlength = fieldlength < 0 ? 0 : fieldlength; @@ -437,12 +437,11 @@ static void UpdateControlValues( TkScrollbar *scrollPtr) /* Scrollbar data struct. */ { - Tk_Window tkwin = scrollPtr->tkwin; MacDrawable *macWin = (MacDrawable *) Tk_WindowId(scrollPtr->tkwin); double dViewSize; HIRect contrlRect; - int variant; + int variant; short width, height; NSView *view = TkMacOSXDrawableView(macWin); @@ -455,16 +454,16 @@ UpdateControlValues( contrlRect = NSRectToCGRect(frame); info.bounds = contrlRect; - + width = contrlRect.size.width; height = contrlRect.size.height; variant = contrlRect.size.width < metrics[0].width ? 1 : 0; - + /* * Ensure we set scrollbar control bounds only once all size adjustments * have been computed. - */ + */ info.bounds = contrlRect; if (scrollPtr->vertical) { @@ -472,7 +471,7 @@ UpdateControlValues( } else { info.attributes |= kThemeTrackHorizontal; } - + /* * Given the Tk parameters for the fractions of the start and end of the * thumb, the following calculation determines the location for the @@ -499,7 +498,7 @@ UpdateControlValues( } else { info.value = MIN_SCROLLBAR_VALUE + factor * scrollPtr->firstFraction; } - + if((scrollPtr->firstFraction <= 0.0 && scrollPtr->lastFraction >= 1.0) || height <= metrics[variant].minHeight) { info.enableState = kThemeTrackHideTrack; @@ -526,7 +525,7 @@ ScrollbarPress(TkScrollbar *scrollPtr, XEvent *eventPtr) { if (eventPtr->type == ButtonPress) { - UpdateControlValues(scrollPtr); + UpdateControlValues(scrollPtr); } return TCL_OK; } @@ -573,4 +572,3 @@ ScrollbarEventProc( TkScrollbarEventProc(clientData, eventPtr); } } - diff --git a/macosx/tkMacOSXSend.c b/macosx/tkMacOSXSend.c index 603d70e..3b24a56 100644 --- a/macosx/tkMacOSXSend.c +++ b/macosx/tkMacOSXSend.c @@ -281,7 +281,7 @@ Tk_SetAppName( * We have found a unique name. Now add it to the registry. */ - riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); + riPtr = ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; riPtr->name = ckalloc(strlen(actualName) + 1); riPtr->nextPtr = interpListPtr; @@ -325,7 +325,7 @@ Tk_SendObjCmd( int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* The arguments */ { - const char *sendOptions[] = {"-async", "-displayof", "-", NULL}; + const char *const sendOptions[] = {"-async", "-displayof", "-", NULL}; char *stringRep, *destName; /*int async = 0;*/ int i, index, firstArg; @@ -336,8 +336,8 @@ Tk_SendObjCmd( for (i = 1; i < (objc - 1); ) { stringRep = Tcl_GetString(objv[i]); if (stringRep[0] == '-') { - if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], sendOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == 0) { diff --git a/macosx/tkMacOSXSubwindows.c b/macosx/tkMacOSXSubwindows.c index c1f16f3..f026318 100644 --- a/macosx/tkMacOSXSubwindows.c +++ b/macosx/tkMacOSXSubwindows.c @@ -65,7 +65,7 @@ XDestroyWindow( TkMacOSXSelDeadWindow(macWin->winPtr); macWin->toplevel->referenceCount--; - if (!Tk_IsTopLevel(macWin->winPtr)) { + if (!Tk_IsTopLevel(macWin->winPtr) ) { TkMacOSXInvalidateWindow(macWin, TK_PARENT_WINDOW); if (macWin->winPtr->parentPtr != NULL) { TkMacOSXInvalClipRgns((Tk_Window) macWin->winPtr->parentPtr); @@ -81,9 +81,9 @@ XDestroyWindow( } if (macWin->toplevel->referenceCount == 0) { - ckfree((char *) macWin->toplevel); + ckfree(macWin->toplevel); } - ckfree((char *) macWin); + ckfree(macWin); return; } if (macWin->visRgn) { @@ -103,7 +103,7 @@ XDestroyWindow( */ if (macWin->toplevel->referenceCount == 0) { - ckfree((char *) macWin->toplevel); + ckfree(macWin->toplevel); } } @@ -1347,7 +1347,7 @@ Tk_GetPixmap( if (display != NULL) { display->request++; } - macPix = (MacDrawable *) ckalloc(sizeof(MacDrawable)); + macPix = ckalloc(sizeof(MacDrawable)); macPix->winPtr = NULL; macPix->xOff = 0; macPix->yOff = 0; @@ -1396,7 +1396,7 @@ Tk_FreePixmap( } CFRelease(macPix->context); } - ckfree((char *) macPix); + ckfree(macPix); } /* diff --git a/macosx/tkMacOSXTest.c b/macosx/tkMacOSXTest.c index 0e43785..1882ce6 100644 --- a/macosx/tkMacOSXTest.c +++ b/macosx/tkMacOSXTest.c @@ -18,9 +18,8 @@ * Forward declarations of procedures defined later in this file: */ -static int DebuggerCmd (ClientData dummy, Tcl_Interp *interp, - int argc, const char **argv); -MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); +static int DebuggerObjCmd (ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- @@ -47,7 +46,7 @@ TkplatformtestInit( * Add commands for platform specific tests on MacOS here. */ - Tcl_CreateCommand(interp, "debugger", DebuggerCmd, + Tcl_CreateObjCommand(interp, "debugger", DebuggerObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; @@ -56,7 +55,7 @@ TkplatformtestInit( /* *---------------------------------------------------------------------- * - * DebuggerCmd -- + * DebuggerObjCmd -- * * This procedure simply calls the low level debugger. * @@ -70,11 +69,11 @@ TkplatformtestInit( */ static int -DebuggerCmd( +DebuggerObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Not used. */ - int argc, /* Not used. */ - const char **argv) /* Not used. */ + int objc, /* Not used. */ + Tcl_Obj *const objv[]) /* Not used. */ { Debugger(); return TCL_OK; diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index 91cc348..95ebb25 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -17,7 +17,7 @@ #include "tkMacOSXWm.h" #include "tkMacOSXEvent.h" #include "tkMacOSXDebug.h" - + /* #ifdef TK_MAC_DEBUG #define TK_MAC_DEBUG_EVENTS @@ -268,13 +268,12 @@ extern BOOL opaqueTag; const char *cmd = ([[notification name] isEqualToString: NSApplicationDidUnhideNotification] ? "::tk::mac::OnShow" : "::tk::mac::OnHide"); - Tcl_CmdInfo dummy; - if (_eventInterp && Tcl_GetCommandInfo(_eventInterp, cmd, &dummy)) { + if (_eventInterp && Tcl_FindCommand(_eventInterp, cmd, NULL, 0)) { int code = Tcl_EvalEx(_eventInterp, cmd, -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { - Tcl_BackgroundError(_eventInterp); + Tcl_BackgroundException(_eventInterp, code); } Tcl_ResetResult(_eventInterp); } @@ -391,7 +390,7 @@ GenerateUpdates( /* * TODO: Here we should handle out of process embedding. */ - } + } return 1; } @@ -706,11 +705,10 @@ TkWmProtocolEventProc( Tcl_Preserve(interp); result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL); if (result != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n (command for \""); - Tcl_AddErrorInfo(interp, - Tk_GetAtomName((Tk_Window) winPtr, protocol)); - Tcl_AddErrorInfo(interp, "\" window manager protocol)"); - Tcl_BackgroundError(interp); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (command for \"%s\" window manager protocol)", + Tk_GetAtomName((Tk_Window) winPtr, protocol))); + Tcl_BackgroundException(interp, result); } Tcl_Release(interp); Tcl_Release(protPtr); @@ -766,7 +764,7 @@ Tk_MacOSXIsAppInFront(void) /* * Custom content view for use in Tk NSWindows. - * + * * Since Tk handles all drawing of widgets, we only use the AppKit event loop * as a source of input events. To do this, we overload the NSView drawRect * method with a method which generates Expose events for Tk but does no @@ -808,7 +806,7 @@ ConfigureRestrictProc( { const NSRect *rectsBeingDrawn; NSInteger rectsBeingDrawnCount; - + [self getRectsBeingDrawn:&rectsBeingDrawn count:&rectsBeingDrawnCount]; #ifdef TK_MAC_DEBUG_DRAWING @@ -818,7 +816,6 @@ ConfigureRestrictProc( NSCompositeSourceOver); #endif - CGFloat height = [self bounds].size.height; HIMutableShapeRef drawShape = HIShapeCreateMutable(); @@ -837,9 +834,8 @@ ConfigureRestrictProc( NSEventTrackingRunLoopMode, NSModalPanelRunLoopMode, nil]]; } - + CFRelease(drawShape); - } -(void) setFrameSize: (NSSize)newsize @@ -859,16 +855,16 @@ ConfigureRestrictProc( * don't clobber the AutoreleasePool set up by the caller. */ [NSApp setPoolProtected:YES]; - + /* * Try to prevent flickers and flashes. * - * This stops the flickers, but on OSX 10.11 flashes still occur when + * This stops the flickers on OSX 10.11. But flashes still occur when * the width of the window is 16, 32, 48, 64, 80, 96, 112, 256, 512, - * 768, ... + * 768, ... :^( */ [w disableFlushWindow]; - + /* Disable Tk drawing until the window has been completely configured.*/ TkMacOSXSetDrawingEnabled(winPtr, 0); @@ -907,15 +903,12 @@ ConfigureRestrictProc( HIShapeRef shape = HIShapeCreateWithRect(&bounds); [super viewDidEndLiveResize]; [self generateExposeEvents: shape]; - } -/* Core method of this class: generates expose events for redrawing. - * Whereas drawRect is intended to be called only from the Appkit event - * loop, this can be called from Tk. If the Tcl_ServiceMode is set to - * TCL_SERVICE_ALL then the expose events will be immediately removed - * from the Tcl event loop and processed. Typically, they should be queued, - * however. +/* Core method of this class: generates expose events for redrawing. If the + * Tcl_ServiceMode is set to TCL_SERVICE_ALL then the expose events will be + * immediately removed from the Tcl event loop and processed. Typically, they + * should be queued, however. */ - (void) generateExposeEvents: (HIShapeRef) shape { diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c index 50cac20..308ee11 100644 --- a/macosx/tkMacOSXWm.c +++ b/macosx/tkMacOSXWm.c @@ -20,9 +20,6 @@ #include "tkMacOSXWm.h" #include "tkMacOSXEvent.h" #include "tkMacOSXDebug.h" -#include <Carbon/Carbon.h> - -#define DEBUG_ZOMBIES 0 #define DEBUG_ZOMBIES 0 @@ -56,7 +53,6 @@ | tkCanJoinAllSpacesAttribute | tkMoveToActiveSpaceAttribute \ | tkNonactivatingPanelAttribute | tkHUDWindowAttribute) - /*Objects for use in setting background color and opacity of window.*/ NSColor *colorName = NULL; BOOL opaqueTag = FALSE; @@ -512,6 +508,7 @@ SetWindowSizeLimits( wmPtr->maxAspect.x && wmPtr->minAspect.y == wmPtr->maxAspect.y) { NSSize aspect = NSMakeSize(wmPtr->minAspect.x, wmPtr->minAspect.y); CGFloat ratio = aspect.width/aspect.height; + [macWindow setContentAspectRatio:aspect]; if ((CGFloat)minWidth/(CGFloat)minHeight > ratio) { minHeight = lround(minWidth / ratio); @@ -597,7 +594,7 @@ void TkWmNewWindow( TkWindow *winPtr) /* Newly-created top-level window. */ { - WmInfo *wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo)); + WmInfo *wmPtr = ckalloc(sizeof(WmInfo)); wmPtr->winPtr = winPtr; wmPtr->reparent = None; @@ -644,7 +641,7 @@ TkWmNewWindow( wmPtr->configHeight = -1; wmPtr->vRoot = None; wmPtr->protPtr = NULL; - wmPtr->cmdArgv = NULL; + wmPtr->commandObj = NULL; wmPtr->clientMachine = NULL; wmPtr->flags = WM_NEVER_MAPPED; wmPtr->macClass = kDocumentWindowClass; @@ -656,7 +653,6 @@ TkWmNewWindow( UpdateVRootGeometry(wmPtr); - /* * Tk must monitor structure events for top-level windows, in order to * detect size and position changes caused by window managers. @@ -824,7 +820,7 @@ TkWmDeadWindow( if (wmPtr == NULL) { return; } - Tk_ManageGeometry((Tk_Window) winPtr, NULL, NULL); + Tk_ManageGeometry((Tk_Window) winPtr, NULL, NULL); Tk_DeleteEventHandler((Tk_Window) winPtr, StructureNotifyMask, TopLevelEventProc, winPtr); if (wmPtr->hints.flags & IconPixmapHint) { @@ -852,14 +848,13 @@ TkWmDeadWindow( wmPtr2->hints.flags &= ~IconWindowHint; } while (wmPtr->protPtr != NULL) { - ProtocolHandler *protPtr; + ProtocolHandler *protPtr = wmPtr->protPtr; - protPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr->nextPtr; Tcl_EventuallyFree(protPtr, TCL_DYNAMIC); } - if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + if (wmPtr->commandObj != NULL) { + Tcl_DecrRefCount(wmPtr->commandObj); } if (wmPtr->clientMachine != NULL) { ckfree(wmPtr->clientMachine); @@ -911,9 +906,9 @@ TkWmDeadWindow( fprintf(stderr, "================= Pool dump ===================\n"); [NSAutoreleasePool showPools]; #endif - ckfree((char *)wmPtr); - winPtr->wmInfoPtr = NULL; } + ckfree(wmPtr); + winPtr->wmInfoPtr = NULL; } /* @@ -1000,20 +995,20 @@ Tk_WmObjCmd( argv1 = Tcl_GetStringFromObj(objv[1], &length); if ((argv1[0] == 't') && (strncmp(argv1, "tracing", length) == 0) - && (length >= 3)) { + && (length >= 3)) { if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); return TCL_ERROR; } if (objc == 2) { - Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(wmTracing)); return TCL_OK; } return Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing); } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1027,8 +1022,10 @@ Tk_WmObjCmd( } if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -1138,12 +1135,13 @@ WmAspectCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, - wmPtr->minAspect.y, wmPtr->maxAspect.x, - wmPtr->maxAspect.y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->minAspect.x); + results[1] = Tcl_NewIntObj(wmPtr->minAspect.y); + results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x); + results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1158,7 +1156,9 @@ WmAspectCmd( } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - Tcl_SetResult(interp, "aspect number can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "aspect number can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "ASPECT", NULL); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -1398,18 +1398,18 @@ WmAttributesCmd( macWindow = TkMacOSXDrawableWindow(winPtr->window); if (objc == 3) { /* wm attributes $win */ - Tcl_Obj *result = Tcl_NewListObj(0,0); + Tcl_Obj *result = Tcl_NewObj(); for (attribute = 0; attribute < _WMATT_LAST_ATTRIBUTE; ++attribute) { - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(WmAttributeNames[attribute], -1)); - Tcl_ListObjAppendElement(interp, result, + Tcl_ListObjAppendElement(NULL, result, WmGetAttribute(winPtr, macWindow, attribute)); } Tcl_SetObjResult(interp, result); } else if (objc == 4) { /* wm attributes $win -attribute */ - if (Tcl_GetIndexFromObj(interp, objv[3], WmAttributeNames, - "attribute", 0, &attribute) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], WmAttributeNames, + sizeof(char *), "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, WmGetAttribute(winPtr, macWindow, attribute)); @@ -1417,8 +1417,8 @@ WmAttributesCmd( int i; for (i = 3; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], WmAttributeNames, - "attribute", 0, &attribute) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], WmAttributeNames, + sizeof(char *), "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } if (WmSetAttribute(winPtr, macWindow, interp, attribute, objv[i+1]) @@ -1468,7 +1468,8 @@ WmClientCmd( } if (objc == 3) { if (wmPtr->clientMachine != NULL) { - Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->clientMachine, -1)); } return TCL_OK; } @@ -1514,10 +1515,9 @@ WmColormapwindowsCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - TkWindow **cmapList; - TkWindow *winPtr2; + TkWindow **cmapList, *winPtr2; int i, windowObjc, gotToplevel = 0; - Tcl_Obj **windowObjv; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -1525,24 +1525,27 @@ WmColormapwindowsCmd( } if (objc == 3) { Tk_MakeWindowExist((Tk_Window) winPtr); + resultObj = Tcl_NewObj(); for (i = 0; i < wmPtr->cmapCount; i++) { if ((i == (wmPtr->cmapCount-1)) - && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { + && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } - Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) wmPtr->cmapList[i])); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) - != TCL_OK) { + != TCL_OK) { return TCL_ERROR; } - cmapList = (TkWindow **) ckalloc((windowObjc+1) * sizeof(TkWindow*)); + cmapList = ckalloc((windowObjc+1) * sizeof(TkWindow*)); for (i = 0; i < windowObjc; i++) { if (TkGetWindowFromObj(interp, tkwin, windowObjv[i], (Tk_Window *) &winPtr2) != TCL_OK) { - ckfree((char *) cmapList); + ckfree(cmapList); return TCL_ERROR; } if (winPtr2 == winPtr) { @@ -1562,7 +1565,7 @@ WmColormapwindowsCmd( } wmPtr->flags |= WM_COLORMAPS_EXPLICIT; if (wmPtr->cmapList != NULL) { - ckfree((char *) wmPtr->cmapList); + ckfree(wmPtr->cmapList); } wmPtr->cmapList = cmapList; wmPtr->cmapCount = windowObjc; @@ -1601,38 +1604,34 @@ WmCommandCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; - int cmdArgc; - const char **cmdArgv; + int len; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?value?"); return TCL_ERROR; } if (objc == 3) { - if (wmPtr->cmdArgv != NULL) { - argv3 = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); - Tcl_SetResult(interp, argv3, TCL_VOLATILE); - ckfree(argv3); + if (wmPtr->commandObj != NULL) { + Tcl_SetObjResult(interp, wmPtr->commandObj); } return TCL_OK; } - argv3 = Tcl_GetString(objv[3]); - if (argv3[0] == 0) { - if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); - wmPtr->cmdArgv = NULL; + if (Tcl_GetString(objv[3])[0] == 0) { + if (wmPtr->commandObj != NULL) { + Tcl_DecrRefCount(wmPtr->commandObj); + wmPtr->commandObj = NULL; } return TCL_OK; } - if (Tcl_SplitList(interp, argv3, &cmdArgc, &cmdArgv) != TCL_OK) { + if (Tcl_ListObjLength(interp, objv[3], &len) != TCL_OK) { return TCL_ERROR; } - if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + if (wmPtr->commandObj != NULL) { + Tcl_DecrRefCount(wmPtr->commandObj); } - wmPtr->cmdArgc = cmdArgc; - wmPtr->cmdArgv = cmdArgv; + wmPtr->commandObj = Tcl_DuplicateObj(objv[3]); + Tcl_IncrRefCount(wmPtr->commandObj); + Tcl_InvalidateStringRep(wmPtr->commandObj); return TCL_OK; } @@ -1667,16 +1666,21 @@ WmDeiconifyCmd( Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } + if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL); return TCL_ERROR; - } - if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, - ": it is an embedded window", NULL); + } else if (winPtr->flags & TK_EMBEDDED) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } + TkpWmSetState(winPtr, TkMacOSXIsWindowZoomed(winPtr) ? ZoomState : NormalState); return TCL_OK; @@ -1719,13 +1723,13 @@ WmFocusmodelCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->hints.input ? "passive" : "active", -1)); return TCL_OK; } - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_ACTIVE) { @@ -1761,11 +1765,9 @@ WmForgetCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - - register Tk_Window frameWin = (Tk_Window)winPtr; + register Tk_Window frameWin = (Tk_Window) winPtr; if (Tk_IsTopLevel(frameWin)) { - MacDrawable *macWin; Tk_MakeWindowExist(frameWin); @@ -1773,8 +1775,8 @@ WmForgetCmd( macWin = (MacDrawable *) winPtr->window; - TkFocusJoin(winPtr); - Tk_UnmapWindow(frameWin); + TkFocusJoin(winPtr); + Tk_UnmapWindow(frameWin); macWin->toplevel->referenceCount--; macWin->toplevel = winPtr->parentPtr->privatePtr->toplevel; @@ -1784,15 +1786,17 @@ WmForgetCmd( TkWmDeadWindow(winPtr); RemapWindows(winPtr, (MacDrawable *) winPtr->parentPtr->window); - winPtr->flags &=~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); + winPtr->flags &= ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); /* - * Flags (above) must be cleared before calling TkMapTopFrame (below). - */ + * Flags (above) must be cleared before calling TkMapTopFrame (below). + */ TkMapTopFrame(frameWin); } else { - /* Already not managed by wm - ignore it */ + /* + * Already not managed by wm - ignore it. + */ } return TCL_OK; } @@ -1824,7 +1828,6 @@ WmFrameCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window window; - char buf[TCL_INTEGER_SPACE]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -1834,8 +1837,7 @@ WmFrameCmd( if (window == None) { window = Tk_WindowId((Tk_Window) winPtr); } - sprintf(buf, "0x%x", (unsigned) window); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned) window)); return TCL_OK; } @@ -1874,8 +1876,6 @@ WmGeometryCmd( return TCL_ERROR; } if (objc == 3) { - char buf[16 + TCL_INTEGER_SPACE * 4]; - xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { @@ -1887,9 +1887,8 @@ WmGeometryCmd( width = winPtr->changes.width; height = winPtr->changes.height; } - sprintf(buf, "%dx%d%c%d%c%d", - width, height, xSign, wmPtr->x, ySign, wmPtr->y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d%c%d%c%d", + width, height, xSign, wmPtr->x, ySign, wmPtr->y)); return TCL_OK; } argv3 = Tcl_GetString(objv[3]); @@ -1929,6 +1928,7 @@ WmGridCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; int reqWidth, reqHeight, widthInc, heightInc; + char *errorMsg; if ((objc != 3) && (objc != 7)) { Tcl_WrongNumArgs(interp, 2, objv, @@ -1937,12 +1937,13 @@ WmGridCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth); + results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight); + results[2] = Tcl_NewIntObj(wmPtr->widthInc); + results[3] = Tcl_NewIntObj(wmPtr->heightInc); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1969,20 +1970,17 @@ WmGridCmd( return TCL_ERROR; } if (reqWidth < 0) { - Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (reqHeight < 0) { - Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); - return TCL_ERROR; - } - if (widthInc <= 0) { - Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC); - return TCL_ERROR; - } - if (heightInc <= 0) { - Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC); - return TCL_ERROR; + errorMsg = "baseWidth can't be < 0"; + goto error; + } else if (reqHeight < 0) { + errorMsg = "baseHeight can't be < 0"; + goto error; + } else if (widthInc <= 0) { + errorMsg = "widthInc can't be <= 0"; + goto error; + } else if (heightInc <= 0) { + errorMsg = "heightInc can't be <= 0"; + goto error; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, heightInc); @@ -1990,6 +1988,11 @@ WmGridCmd( wmPtr->flags |= WM_UPDATE_SIZE_HINTS; WmUpdateGeom(wmPtr, winPtr); return TCL_OK; + + error: + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMsg, -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "GRID", NULL); + return TCL_ERROR; } /* @@ -2028,10 +2031,11 @@ WmGroupCmd( } if (objc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->leaderName, -1)); } return TCL_OK; } + argv3 = Tcl_GetStringFromObj(objv[3], &length); if (*argv3 == '\0') { wmPtr->hints.flags &= ~WindowGroupHint; @@ -2091,8 +2095,9 @@ WmIconbitmapCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPixmapHint) { - Tcl_SetResult(interp, (char*)Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_pixmap), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfBitmap(winPtr->display,wmPtr->hints.icon_pixmap), + -1)); } return TCL_OK; } @@ -2153,26 +2158,33 @@ WmIconifyCmd( Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } + if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT", + NULL); return TCL_ERROR; - } - if (wmPtr->master != None) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + } else if (wmPtr->master != None) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL); return TCL_ERROR; - } - if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + } else if (wmPtr->iconFor != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an icon for %s", + winPtr->pathName, Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "ICON", NULL); return TCL_ERROR; - } - if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an embedded window", NULL); + } else if (winPtr->flags & TK_EMBEDDED) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } + TkpWmSetState(winPtr, IconicState); return TCL_OK; } @@ -2210,13 +2222,16 @@ WmIconmaskCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - Tcl_SetResult(interp, (char *) Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_mask), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), + -1)); } return TCL_OK; } + argv3 = Tcl_GetString(objv[3]); if (*argv3 == '\0') { if (wmPtr->hints.icon_mask != None) { @@ -2337,8 +2352,10 @@ WmIconphotoCmd( for (i = 3 + isDefault; i < objc; i++) { photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { - Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]), - "\" as iconphoto: not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as iconphoto: not a photo image", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL); return TCL_ERROR; } Tk_PhotoGetSize(photo, &width, &height); @@ -2384,16 +2401,18 @@ WmIconpositionCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?x y?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x); + results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } return TCL_OK; } + if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->hints.flags &= ~IconPositionHint; } else { @@ -2441,12 +2460,14 @@ WmIconwindowCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->icon != NULL) { - Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon)); } return TCL_OK; } + if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->hints.flags &= ~IconWindowHint; if (wmPtr->icon != NULL) { @@ -2460,19 +2481,24 @@ WmIconwindowCmd( return TCL_ERROR; } if (!Tk_IsTopLevel(tkwin2)) { - Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), - " as icon window: not at top level", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as icon window: not at top level", + Tk_PathName(tkwin2))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "TOPLEVEL", + NULL); return TCL_ERROR; } wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, Tcl_GetString(objv[3]), - " is already an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is already an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "ICON", NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; + wmPtr3->iconFor = NULL; } Tk_MakeWindowExist(tkwin2); @@ -2516,17 +2542,18 @@ WmManageCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - - register Tk_Window frameWin = (Tk_Window)winPtr; + register Tk_Window frameWin = (Tk_Window) winPtr; register WmInfo *wmPtr = winPtr->wmInfoPtr; if (!Tk_IsTopLevel(frameWin)) { MacDrawable *macWin = (MacDrawable *) winPtr->window; if (!Tk_IsManageable(frameWin)) { - Tcl_AppendResult(interp, "window \"", - Tk_PathName(frameWin), "\" is not manageable: must be " - "a frame, labelframe or toplevel", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not manageable: must be a" + " frame, labelframe or toplevel", + Tk_PathName(frameWin))); + Tcl_SetErrorCode(interp, "TK", "WM", "MANAGE", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); @@ -2587,16 +2614,19 @@ WmMaxsizeCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); return TCL_ERROR; } + if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMaxSize(winPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } + if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) - || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { + || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; } wmPtr->maxWidth = width; @@ -2638,14 +2668,17 @@ WmMinsizeCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); return TCL_ERROR; } + if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMinSize(winPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } + if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; @@ -2689,11 +2722,13 @@ WmOverrideredirectCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?"); return TCL_ERROR; } + if (objc == 3) { Tcl_SetObjResult(interp, Tcl_NewBooleanObj( Tk_Attributes((Tk_Window) winPtr)->override_redirect)); return TCL_OK; } + if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) { return TCL_ERROR; } @@ -2739,19 +2774,21 @@ WmPositionfromCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?user/program?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->sizeHintsFlags & USPosition) { - Tcl_SetResult(interp, "user", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("user", -1)); } else if (wmPtr->sizeHintsFlags & PPosition) { - Tcl_SetResult(interp, "program", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("program", -1)); } return TCL_OK; } + if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~(USPosition|PPosition); } else { - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_USER) { @@ -2797,23 +2834,28 @@ WmProtocolCmd( Atom protocol; char *cmd; int cmdLength; + Tcl_Obj *resultObj; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); return TCL_ERROR; } + if (objc == 3) { /* * Return a list of all defined protocols for the window. */ + resultObj = Tcl_NewObj(); for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol),-1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } + protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); if (objc == 4) { /* @@ -2823,7 +2865,8 @@ WmProtocolCmd( for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - Tcl_SetResult(interp, protPtr->command, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(protPtr->command, -1)); return TCL_OK; } } @@ -2849,7 +2892,7 @@ WmProtocolCmd( } cmd = Tcl_GetStringFromObj(objv[4], &cmdLength); if (cmdLength > 0) { - protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength)); + protPtr = ckalloc(HANDLER_SIZE(cmdLength)); protPtr->protocol = protocol; protPtr->nextPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr; @@ -2893,17 +2936,18 @@ WmResizableCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?width height?"); return TCL_ERROR; } + if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", - (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE)); + results[1] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } + if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) - || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) { + || (Tcl_GetBooleanFromObj(interp, objv[4], &height) != TCL_OK)) { return TCL_ERROR; } if (width) { @@ -2971,11 +3015,12 @@ WmSizefromCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?user|program?"); return TCL_ERROR; } + if (objc == 3) { if (wmPtr->sizeHintsFlags & USSize) { - Tcl_SetResult(interp, "user", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("user", -1)); } else if (wmPtr->sizeHintsFlags & PSize) { - Tcl_SetResult(interp, "program", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("program", -1)); } return TCL_OK; } @@ -2983,8 +3028,8 @@ WmSizefromCmd( if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~(USSize|PSize); } else { - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_USER) { @@ -3025,11 +3070,14 @@ WmStackorderCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - TkWindow **windows, **window_ptr; + TkWindow **windows, **windowPtr; static const char *const optionStrings[] = { - "isabove", "isbelow", NULL }; + "isabove", "isbelow", NULL + }; enum options { - OPT_ISABOVE, OPT_ISBELOW }; + OPT_ISABOVE, OPT_ISBELOW + }; + Tcl_Obj *resultObj; int index; if ((objc != 3) && (objc != 5)) { @@ -3043,35 +3091,40 @@ WmStackorderCmd( Tcl_Panic("TkWmStackorderToplevel failed"); } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + resultObj = Tcl_NewObj(); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) *windowPtr)); } - ckfree((char *) windows); + Tcl_SetObjResult(interp, resultObj); + ckfree(windows); return TCL_OK; } else { TkWindow *winPtr2; - int index1=-1, index2=-1, result; + int index1 = -1, index2 = -1, result; if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) &winPtr2) - != TCL_OK) { + != TCL_OK) { return TCL_ERROR; } if (!Tk_IsTopLevel(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", + winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "TOPLEVEL", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; - } - - if (!Tk_IsMapped(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't mapped", NULL); + } else if (!Tk_IsMapped(winPtr2)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } @@ -3082,29 +3135,30 @@ WmStackorderCmd( windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); if (windows == NULL) { - Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "TkWmStackorderToplevel failed", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "FAIL", NULL); return TCL_ERROR; } - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) { - index1 = (window_ptr - windows); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + if (*windowPtr == winPtr) { + index1 = windowPtr - windows; } - if (*window_ptr == winPtr2) { - index2 = (window_ptr - windows); + if (*windowPtr == winPtr2) { + index2 = windowPtr - windows; } } if (index1 == -1) { Tcl_Panic("winPtr window not found"); - } - if (index2 == -1) { + } else if (index2 == -1) { Tcl_Panic("winPtr2 window not found"); } - ckfree((char *) windows); + ckfree(windows); - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_ISABOVE) { @@ -3115,7 +3169,6 @@ WmStackorderCmd( Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } - return TCL_OK; } /* @@ -3154,21 +3207,25 @@ WmStateCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?state?"); return TCL_ERROR; } + if (objc == 4) { if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't change state of ", - Tcl_GetString(objv[2]), ": it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't change state of ", - winPtr->pathName, ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "EMBEDDED", NULL); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -3181,13 +3238,19 @@ WmStateCmd( */ } else if (index == OPT_ICONIC) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", + "OVERRIDE_REDIRECT", NULL); return TCL_ERROR; } if (wmPtr->master != None) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "TRANSIENT", + NULL); return TCL_ERROR; } TkpWmSetState(winPtr, IconicState); @@ -3197,7 +3260,7 @@ WmStateCmd( TkpWmSetState(winPtr, ZoomState); } } else if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("icon", -1)); } else { if (wmPtr->hints.initial_state == NormalState || wmPtr->hints.initial_state == ZoomState) { @@ -3206,16 +3269,16 @@ WmStateCmd( } switch (wmPtr->hints.initial_state) { case NormalState: - Tcl_SetResult(interp, "normal", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("normal", -1)); break; case IconicState: - Tcl_SetResult(interp, "iconic", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("iconic", -1)); break; case WithdrawnState: - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("withdrawn", -1)); break; case ZoomState: - Tcl_SetResult(interp, "zoomed", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("zoomed", -1)); break; } } @@ -3255,11 +3318,13 @@ WmTitleCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?newTitle?"); return TCL_ERROR; } + if (objc == 3) { - Tcl_SetResult(interp, (char *)((wmPtr->titleUid != NULL) ? - wmPtr->titleUid : winPtr->nameUid), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->titleUid ? wmPtr->titleUid : winPtr->nameUid, -1)); return TCL_OK; } + argv3 = Tcl_GetStringFromObj(objv[3], &length); wmPtr->titleUid = Tk_GetUid(argv3); if (!(wmPtr->flags & WM_NEVER_MAPPED) && !Tk_IsEmbedded(winPtr)) { @@ -3305,7 +3370,8 @@ WmTransientCmd( } if (objc == 3) { if (wmPtr->master != None) { - Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->masterWindowName, -1)); } return TCL_OK; } @@ -3322,9 +3388,10 @@ WmTransientCmd( Tk_MakeWindowExist(master); if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]), - "\" a transient: it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a transient: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } @@ -3332,15 +3399,17 @@ WmTransientCmd( /* Under some circumstances, wmPtr2 is NULL here */ if (wmPtr2 != NULL && wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]), - "\" a master: it is an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a master: it is an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } if ((TkWindow *) master == winPtr) { - Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), - "\" its own master", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" its own master", Tk_PathName(winPtr))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL); return TCL_ERROR; } @@ -3387,9 +3456,12 @@ WmWithdrawCmd( Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } + if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't withdraw %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL); return TCL_ERROR; } TkpWmSetState(winPtr, WithdrawnState); @@ -3805,7 +3877,7 @@ UpdateGeometryInfo( if (((width != winPtr->changes.width) || (height != winPtr->changes.height)) && (wmPtr->gridWin == NULL) - && ((wmPtr->sizeHintsFlags & (PMinSize|PMaxSize)) == 0)) { + && !(wmPtr->sizeHintsFlags & (PMinSize|PMaxSize))) { wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) { @@ -4009,7 +4081,7 @@ ParseGeometry( * them. */ - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; flags |= WM_UPDATE_SIZE_HINTS; } @@ -4044,7 +4116,9 @@ ParseGeometry( return TCL_OK; error: - Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad geometry specifier \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GEOMETRY", NULL); return TCL_ERROR; } @@ -4381,7 +4455,7 @@ UpdateVRootGeometry( wmPtr->flags &= ~WM_VROOT_OFFSET_STALE; if (wmPtr->vRoot == None) { - noVRoot: + noVRoot: wmPtr->vRootX = wmPtr->vRootY = 0; wmPtr->vRootWidth = DisplayWidth(winPtr->display, winPtr->screenNum); wmPtr->vRootHeight = DisplayHeight(winPtr->display, winPtr->screenNum); @@ -4504,7 +4578,7 @@ Tk_MoveToplevelWindow( wmPtr->y = y; wmPtr->flags |= WM_MOVE_PENDING; wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y); - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } @@ -4660,7 +4734,7 @@ TkWmAddToColormapWindows( * add the toplevel itself as the last element of the list. */ - newPtr = (TkWindow**)ckalloc((count+2) * sizeof(TkWindow *)); + newPtr = ckalloc((count+2) * sizeof(TkWindow *)); if (count > 0) { memcpy(newPtr, oldPtr, count * sizeof(TkWindow *)); } @@ -4670,7 +4744,7 @@ TkWmAddToColormapWindows( newPtr[count-1] = winPtr; newPtr[count] = topPtr; if (oldPtr != NULL) { - ckfree((char *) oldPtr); + ckfree(oldPtr); } topPtr->wmInfoPtr->cmapList = newPtr; @@ -5112,83 +5186,69 @@ TkUnsupported1ObjCmd( }; Tk_Window tkwin = clientData; TkWindow *winPtr; - int index; + int index, i; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg ...?"); return TCL_ERROR; } + /* + * Iterate through objc/objv to set correct background color and toggle + * opacity of window. + */ - /* Iterate through objc/objv to set correct background color and toggle opacity of window. */ - int i; for (i= 0; i < objc; i++) { - - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*black*") == 1) { - colorName = [NSColor blackColor]; // use #000000 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*dark*") == 1) { + if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*black*")) { + colorName = [NSColor blackColor]; // use #000000 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*dark*")) { colorName = [NSColor darkGrayColor]; //use #545454 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*light*") == 1) { + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*light*")) { colorName = [NSColor lightGrayColor]; //use #ababab in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*white*")) { + colorName = [NSColor whiteColor]; //use #ffffff in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "gray*")) { + colorName = [NSColor grayColor]; //use #7f7f7f in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*red*")) { + colorName = [NSColor redColor]; //use #ff0000 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*green*")) { + colorName = [NSColor greenColor]; //use #00ff00 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*blue*")) { + colorName = [NSColor blueColor]; //use #0000ff in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*cyan*")) { + colorName = [NSColor cyanColor]; //use #00ffff in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*yellow*")) { + colorName = [NSColor yellowColor]; //use #ffff00 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*magenta*")) { + colorName = [NSColor magentaColor]; //use #ff00ff in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*orange*")) { + colorName = [NSColor orangeColor]; //use #ff8000 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*purple*")) { + colorName = [NSColor purpleColor]; //use #800080 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*brown*")){ + colorName = [NSColor brownColor]; //use #996633 in Tk scripts to match + } else if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*clear*")) { + colorName = [NSColor clearColor]; //use systemTransparent in Tk scripts to match } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*white*") == 1) { - colorName = [NSColor whiteColor]; //use #ffffff in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "gray*") == 1) { - colorName = [NSColor grayColor]; //use #7f7f7f in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*red*") == 1) { - colorName = [NSColor redColor]; //use #ff0000 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*green*") == 1) { - colorName = [NSColor greenColor]; //use #00ff00 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*blue*") == 1) { - colorName = [NSColor blueColor]; //use #0000ff in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*cyan*") == 1) { - colorName = [NSColor cyanColor]; //use #00ffff in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*yellow*") == 1) { - colorName = [NSColor yellowColor]; //use #ffff00 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*magenta*") == 1) { - colorName = [NSColor magentaColor]; //use #ff00ff in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*orange*") == 1) { - colorName = [NSColor orangeColor]; //use #ff8000 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*purple*") == 1) { - colorName = [NSColor purpleColor]; //use #800080 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*brown*") == 1){ - colorName = [NSColor brownColor]; //use #996633 in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*clear*") == 1) { - colorName = [NSColor clearColor]; //use systemTransparent in Tk scripts to match - } - if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*opacity*") == 1) { - opaqueTag=YES; + if (Tcl_StringMatch(Tcl_GetString(objv[i]), "*opacity*")) { + opaqueTag = YES; } } - winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); if (winPtr == NULL) { return TCL_ERROR; } if (!(winPtr->flags & TK_TOP_LEVEL)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WINDOWSTYLE", "TOPLEVEL", NULL); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmds, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (((enum SubCmds) index) == TKMWS_STYLE) { @@ -5258,7 +5318,10 @@ WmWinStyle( { NULL } }; - /* Map window attributes. Color and opacity are mapped to NULL; these are parsed from the objv in TkUnsupported1ObjCmd.*/ + /* + * Map window attributes. Color and opacity are mapped to NULL; these are + * parsed from the objv in TkUnsupported1ObjCmd. + */ static const struct StrIntMap attrMap[] = { { "closeBox", kWindowCloseBoxAttribute }, @@ -5304,7 +5367,6 @@ WmWinStyle( { "brown", 0 }, { "clear", 0 }, { "opacity", 0 }, - { "fullscreen", 0 }, { NULL } }; @@ -5325,7 +5387,6 @@ WmWinStyle( Tcl_Panic("invalid class"); } - attributeList = Tcl_NewListObj(0, NULL); attributes = wmPtr->attributes; @@ -5333,7 +5394,7 @@ WmWinStyle( UInt64 intValue = compositeAttrMap[i].intValue; if (intValue && (attributes & intValue) == intValue) { - Tcl_ListObjAppendElement(interp, attributeList, + Tcl_ListObjAppendElement(NULL, attributeList, Tcl_NewStringObj(compositeAttrMap[i].strValue, -1)); attributes &= ~intValue; @@ -5342,11 +5403,11 @@ WmWinStyle( } for (i = 0; attrMap[i].strValue != NULL; i++) { if (attributes & attrMap[i].intValue) { - Tcl_ListObjAppendElement(interp, attributeList, + Tcl_ListObjAppendElement(NULL, attributeList, Tcl_NewStringObj(attrMap[i].strValue, -1)); } } - Tcl_ListObjAppendElement(interp, newResult, attributeList); + Tcl_ListObjAppendElement(NULL, newResult, attributeList); Tcl_SetObjResult(interp, newResult); } else { int attrObjc; @@ -5398,7 +5459,6 @@ WmWinStyle( return TCL_ERROR; } - return TCL_OK; } @@ -5981,7 +6041,7 @@ TkpChangeFocus( [win makeKeyAndOrderFront:NSApp]; } } - + /* * Remember the current serial number for the X server and issue a dummy * server request. This marks the position at which we changed the focus, @@ -6069,7 +6129,7 @@ TkWmStackorderToplevel( Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS); WmStackorderToplevelWrapperMap(parentPtr, parentPtr->display, &table); - windows = (TkWindow**)ckalloc((table.numEntries+1) * sizeof(TkWindow *)); + windows = ckalloc((table.numEntries+1) * sizeof(TkWindow *)); /* * Special cases: If zero or one toplevels were mapped there is no need to @@ -6091,7 +6151,7 @@ TkWmStackorderToplevel( NSInteger windowCount = [macWindows count]; if (!windowCount) { - ckfree((char *)windows); + ckfree(windows); windows = NULL; } else { windowPtr = windows + table.numEntries; @@ -6407,7 +6467,6 @@ 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*/ @@ -6423,10 +6482,11 @@ TkMacOSXMakeFullscreen( if ((wmPtr->maxWidth > 0 && wmPtr->maxWidth < screenWidth) || (wmPtr->maxHeight > 0 && wmPtr->maxHeight < screenHeight)) { if (interp) { - Tcl_AppendResult(interp, - "can't set fullscreen attribute for \"", - winPtr->pathName, - "\": max width/height is too small", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set fullscreen attribute for \"%s\": max" + " width/height is too small", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "FULLSCREEN", + "CONSTRAINT_FAILURE", NULL); } result = TCL_ERROR; wmPtr->flags &= ~WM_FULLSCREEN; @@ -6434,7 +6494,7 @@ TkMacOSXMakeFullscreen( NSRect bounds = [window contentRectForFrameRect:[window frame]]; NSRect screenBounds = NSMakeRect(0, 0, screenWidth, screenHeight); - if (!NSEqualRects(bounds, screenBounds) && !wasFullscreen) { + if (!NSEqualRects(bounds, screenBounds) && !wasFullscreen) { wmPtr->configX = wmPtr->x; wmPtr->configY = wmPtr->y; wmPtr->configAttributes = wmPtr->attributes; @@ -6443,8 +6503,7 @@ TkMacOSXMakeFullscreen( wmPtr->configAttributes, wmPtr->flags, 1, 0); wmPtr->flags |= WM_SYNC_PENDING; [window setFrame:[window frameRectForContentRect: - screenBounds] display:YES]; - + screenBounds] display:YES]; wmPtr->flags &= ~WM_SYNC_PENDING; } wmPtr->flags |= WM_FULLSCREEN; @@ -6462,11 +6521,11 @@ TkMacOSXMakeFullscreen( prevPres = [NSApp presentationOptions]; [window setStyleMask: NSBorderlessWindowMask]; [NSApp setPresentationOptions: NSApplicationPresentationAutoHideDock - | NSApplicationPresentationAutoHideMenuBar]; - + | 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]; @@ -6491,8 +6550,6 @@ TkMacOSXMakeFullscreen( return result; } - - /* *---------------------------------------------------------------------- * @@ -6691,8 +6748,6 @@ RemapWindows( RemapWindows(childPtr, (MacDrawable *) winPtr->window); } } - - /* * Local Variables: diff --git a/macosx/tkMacOSXWm.h b/macosx/tkMacOSXWm.h index bfc7fac..d98010f 100644 --- a/macosx/tkMacOSXWm.h +++ b/macosx/tkMacOSXWm.h @@ -6,8 +6,8 @@ * Copyright 2001-2009, Apple Inc. * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net> * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TKMACWM @@ -17,25 +17,23 @@ #include "tkMenu.h" /* - * A data structure of the following type holds information for - * each window manager protocol (such as WM_DELETE_WINDOW) for - * which a handler (i.e. a Tcl command) has been defined for a - * particular top-level window. + * A data structure of the following type holds information for each window + * manager protocol (such as WM_DELETE_WINDOW) for which a handler (i.e. a Tcl + * command) has been defined for a particular top-level window. */ typedef struct ProtocolHandler { Atom protocol; /* Identifies the protocol. */ struct ProtocolHandler *nextPtr; - /* Next in list of protocol handlers for - * the same top-level window, or NULL for - * end of list. */ + /* Next in list of protocol handlers for the + * same top-level window, or NULL for end of + * list. */ Tcl_Interp *interp; /* Interpreter in which to invoke command. */ - char command[4]; /* Tcl command to invoke when a client - * message for this protocol arrives. - * The actual size of the structure varies - * to accommodate the needs of the actual - * command. THIS MUST BE THE LAST FIELD OF - * THE STRUCTURE. */ + char command[4]; /* Tcl command to invoke when a client message + * for this protocol arrives. The actual size + * of the structure varies to accommodate the + * needs of the actual command. THIS MUST BE + * THE LAST FIELD OF THE STRUCTURE. */ } ProtocolHandler; #define HANDLER_SIZE(cmdLength) \ @@ -47,84 +45,80 @@ typedef struct ProtocolHandler { */ typedef struct TkWmInfo { - TkWindow *winPtr; /* Pointer to main Tk information for - * this window. */ + TkWindow *winPtr; /* Pointer to main Tk information for this + * window. */ Window reparent; /* If the window has been reparented, this * gives the ID of the ancestor of the window - * that is a child of the root window (may - * not be window's immediate parent). If - * the window isn't reparented, this has the - * value None. */ - Tk_Uid titleUid; /* Title to display in window caption. If - * NULL, use name of widget. */ + * that is a child of the root window (may not + * be window's immediate parent). If the window + * isn't reparented, this has the value + * None. */ + Tk_Uid titleUid; /* Title to display in window caption. If NULL, + * use name of widget. */ char *iconName; /* Name to display in icon. */ - Window master; /* Master window for TRANSIENT_FOR property, - * or None. */ - XWMHints hints; /* Various pieces of information for - * window manager. */ + Window master; /* Master window for TRANSIENT_FOR property, or + * None. */ + XWMHints hints; /* Various pieces of information for window + * manager. */ char *leaderName; /* Path name of leader of window group * (corresponds to hints.window_group). - * Malloc-ed. Note: this field doesn't - * get updated if leader is destroyed. */ - char *masterWindowName; /* Path name of window specified as master - * in "wm transient" command, or NULL. - * Malloc-ed. Note: this field doesn't - * get updated if masterWindowName is - * destroyed. */ - Tk_Window icon; /* Window to use as icon for this window, - * or NULL. */ + * Malloc-ed. Note: this field doesn't get + * updated if leader is destroyed. */ + char *masterWindowName; /* Path name of window specified as master in + * "wm transient" command, or NULL. Malloc-ed. + * Note: this field doesn't get updated if + * masterWindowName is destroyed. */ + Tk_Window icon; /* Window to use as icon for this window, or + * NULL. */ Tk_Window iconFor; /* Window for which this window is icon, or * NULL if this isn't an icon for anyone. */ /* - * Information used to construct an XSizeHints structure for - * the window manager: + * Information used to construct an XSizeHints structure for the window + * manager: */ - int sizeHintsFlags; /* Flags word for XSizeHints structure. - * If the PBaseSize flag is set then the - * window is gridded; otherwise it isn't - * gridded. */ - int minWidth, minHeight; /* Minimum dimensions of window, in - * grid units, not pixels. */ - int maxWidth, maxHeight; /* Maximum dimensions of window, in - * grid units, not pixels. */ - Tk_Window gridWin; /* Identifies the window that controls - * gridding for this top-level, or NULL if - * the top-level isn't currently gridded. */ - int widthInc, heightInc; /* Increments for size changes (# pixels - * per step). */ + int sizeHintsFlags; /* Flags word for XSizeHints structure. If the + * PBaseSize flag is set then the window is + * gridded; otherwise it isn't gridded. */ + int minWidth, minHeight; /* Minimum dimensions of window, in grid units, + * not pixels. */ + int maxWidth, maxHeight; /* Maximum dimensions of window, in grid units, + * not pixels. */ + Tk_Window gridWin; /* Identifies the window that controls gridding + * for this top-level, or NULL if the top-level + * isn't currently gridded. */ + int widthInc, heightInc; /* Increments for size changes (# pixels per + * step). */ struct { int x; /* numerator */ int y; /* denominator */ } minAspect, maxAspect; /* Min/max aspect ratios for window. */ int reqGridWidth, reqGridHeight; - /* The dimensions of the window (in - * grid units) requested through - * the geometry manager. */ + /* The dimensions of the window (in grid units) + * requested through the geometry manager. */ int gravity; /* Desired window gravity. */ /* * Information used to manage the size and location of a window. */ - int width, height; /* Desired dimensions of window, specified - * in grid units. These values are - * set by the "wm geometry" command and by - * ConfigureNotify events (for when wm - * resizes window). -1 means user hasn't - * requested dimensions. */ + int width, height; /* Desired dimensions of window, specified in + * grid units. These values are set by the "wm + * geometry" command and by ConfigureNotify + * events (for when wm resizes window). -1 + * means user hasn't requested dimensions. */ int x, y; /* Desired X and Y coordinates for window. - * These values are set by "wm geometry", - * plus by ConfigureNotify events (when wm - * moves window). These numbers are - * different than the numbers stored in - * winPtr->changes because (a) they could be - * measured from the right or bottom edge - * of the screen (see WM_NEGATIVE_X and - * WM_NEGATIVE_Y flags) and (b) if the window - * has been reparented then they refer to the - * parent rather than the window itself. */ + * These values are set by "wm geometry", plus + * by ConfigureNotify events (when wm moves + * window). These numbers are different than + * the numbers stored in winPtr->changes + * because (a) they could be measured from the + * right or bottom edge of the screen (see + * WM_NEGATIVE_X and WM_NEGATIVE_Y flags) and + * (b) if the window has been reparented then + * they refer to the parent rather than the + * window itself. */ int parentWidth, parentHeight; /* Width and height of reparent, in pixels * *including border*. If window hasn't been @@ -140,29 +134,29 @@ typedef struct TkWmInfo { * switched into fullscreen state, */ int configWidth, configHeight; /* Dimensions passed to last request that we - * issued to change geometry of window. Used - * to eliminate redundant resize operations. */ + * issued to change geometry of window. Used to + * eliminate redundant resize operations. */ /* - * Information about the virtual root window for this top-level, - * if there is one. + * Information about the virtual root window for this top-level, if there + * is one. */ - Window vRoot; /* Virtual root window for this top-level, - * or None if there is no virtual root - * window (i.e. just use the screen's root). */ - int vRootX, vRootY; /* Position of the virtual root inside the - * root window. If the WM_VROOT_OFFSET_STALE - * flag is set then this information may be - * incorrect and needs to be refreshed from - * the X server. If vRoot is None then these - * values are both 0. */ + Window vRoot; /* Virtual root window for this top-level, or + * None if there is no virtual root window + * (i.e. just use the screen's root). */ + int vRootX, vRootY; /* Position of the virtual root inside the root + * window. If the WM_VROOT_OFFSET_STALE flag is + * set then this information may be incorrect + * and needs to be refreshed from the OS. If + * vRoot is None then these values are both + * 0. */ unsigned int vRootWidth, vRootHeight; - /* Dimensions of the virtual root window. - * If vRoot is None, gives the dimensions - * of the containing screen. This information - * is never stale, even though vRootX and - * vRootY can be. */ + /* Dimensions of the virtual root window. If + * vRoot is None, gives the dimensions of the + * containing screen. This information is never + * stale, even though vRootX and vRootY can + * be. */ /* * List of children of the toplevel which have private colormaps. @@ -175,11 +169,10 @@ typedef struct TkWmInfo { * Miscellaneous information. */ - ProtocolHandler *protPtr; /* First in list of protocol handlers for - * this window (NULL means none). */ - int cmdArgc; /* Number of elements in cmdArgv below. */ - const char **cmdArgv; /* Array of strings to store in the - * WM_COMMAND property. NULL means nothing + ProtocolHandler *protPtr; /* First in list of protocol handlers for this + * window (NULL means none). */ + Tcl_Obj *commandObj; /* The command (guaranteed to be a list) for + * the WM_COMMAND property. NULL means nothing * available. */ char *clientMachine; /* String to store in WM_CLIENT_MACHINE * property, or NULL. */ @@ -188,6 +181,7 @@ typedef struct TkWmInfo { /* * Macintosh information. */ + WindowClass macClass; UInt64 attributes, configAttributes; TkWindow *scrollWinPtr; /* Ptr to scrollbar handling grow widget. */ @@ -195,19 +189,18 @@ typedef struct TkWmInfo { NSWindow *window; } WmInfo; - /* * Flag values for WmInfo structures: * - * WM_NEVER_MAPPED - non-zero means window has never been - * mapped; need to update all info when - * window is first mapped. + * WM_NEVER_MAPPED - non-zero means window has never been mapped; + * need to update all info when window is first + * mapped. * WM_UPDATE_PENDING - non-zero means a call to UpdateGeometryInfo - * has already been scheduled for this - * window; no need to schedule another one. + * has already been scheduled for this window; no + * need to schedule another one. * WM_NEGATIVE_X - non-zero means x-coordinate is measured in - * pixels from right edge of screen, rather - * than from left edge. + * pixels from right edge of screen, rather than + * from left edge. * WM_NEGATIVE_Y - non-zero means y-coordinate is measured in * pixels up from bottom of screen, rather than * down from top. @@ -218,27 +211,24 @@ typedef struct TkWmInfo { * WM_VROOT_OFFSET_STALE - non-zero means that (x,y) offset information * about the virtual root window is stale and * needs to be fetched fresh from the X server. - * WM_ABOUT_TO_MAP - non-zero means that the window is about to - * be mapped by TkWmMapWindow. This is used - * by UpdateGeometryInfo to modify its behavior. - * WM_MOVE_PENDING - non-zero means the application has requested - * a new position for the window, but it hasn't - * been reflected through the window manager - * yet. - * WM_COLORMAPS_EXPLICIT - non-zero means the colormap windows were - * set explicitly via "wm colormapwindows". + * WM_ABOUT_TO_MAP - non-zero means that the window is about to be + * mapped by TkWmMapWindow. This is used by + * UpdateGeometryInfo to modify its behavior. + * WM_MOVE_PENDING - non-zero means the application has requested a + * new position for the window, but it hasn't + * been reflected through the window manager yet. + * WM_COLORMAPS_EXPLICIT - non-zero means the colormap windows were set + * explicitly via "wm colormapwindows". * WM_ADDED_TOPLEVEL_COLORMAP - non-zero means that when "wm colormapwindows" * was called the top-level itself wasn't - * specified, so we added it implicitly at - * the end of the list. + * specified, so we added it implicitly at the + * end of the list. * WM_WIDTH_NOT_RESIZABLE - non-zero means that we're not supposed to * allow the user to change the width of the - * window (controlled by "wm resizable" - * command). + * window (controlled by "wm resizable" command). * WM_HEIGHT_NOT_RESIZABLE - non-zero means that we're not supposed to * allow the user to change the height of the - * window (controlled by "wm resizable" - * command). + * window (controlled by "wm resizable" command). */ #define WM_NEVER_MAPPED 0x0001 @@ -258,5 +248,13 @@ typedef struct TkWmInfo { #define WM_FULLSCREEN 0x4000 #define WM_TRANSPARENT 0x8000 -#endif - +#endif /* _TKMACWM */ + +/* + * Local Variables: + * mode: objc + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ diff --git a/macosx/tkMacOSXXStubs.c b/macosx/tkMacOSXXStubs.c index a16daa8..5d6ffb9 100644 --- a/macosx/tkMacOSXXStubs.c +++ b/macosx/tkMacOSXXStubs.c @@ -152,8 +152,8 @@ TkpOpenDisplay( } } - display = (Display *) ckalloc(sizeof(Display)); - screen = (Screen *) ckalloc(sizeof(Screen)); + display = ckalloc(sizeof(Display)); + screen = ckalloc(sizeof(Screen)); bzero(display, sizeof(Display)); bzero(screen, sizeof(Screen)); @@ -205,7 +205,7 @@ TkpOpenDisplay( screen->white_pixel = 0x00FFFFFF | PIXEL_MAGIC << 24; screen->ext_data = (XExtData *) &maxBounds; - screen->root_visual = (Visual *) ckalloc(sizeof(Visual)); + screen->root_visual = ckalloc(sizeof(Visual)); screen->root_visual->visualid = 0; screen->root_visual->class = TrueColor; screen->root_visual->red_mask = 0x00FF0000; @@ -220,7 +220,7 @@ TkpOpenDisplay( TkMacOSXDisplayChanged(display); - gMacDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay)); + gMacDisplay = ckalloc(sizeof(TkDisplay)); /* * This is the quickest way to make sure that all the *Init flags get @@ -262,11 +262,11 @@ TkpCloseDisplay( gMacDisplay = NULL; if (display->screens != NULL) { if (display->screens->root_visual != NULL) { - ckfree((char *) display->screens->root_visual); + ckfree(display->screens->root_visual); } - ckfree((char *) display->screens); + ckfree(display->screens); } - ckfree((char *) display); + ckfree(display); } /* @@ -346,33 +346,6 @@ MacXIdAlloc( /* *---------------------------------------------------------------------- * - * TkpWindowWasRecentlyDeleted -- - * - * Tries to determine whether the given window was recently deleted. - * Called from the generic code error handler to attempt to deal with - * async BadWindow errors under some circumstances. - * - * Results: - * Always 0, we do not keep this information on the Mac, so we do not - * know whether the window was destroyed. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TkpWindowWasRecentlyDeleted( - Window win, - TkDisplay *dispPtr) -{ - return 0; -} - -/* - *---------------------------------------------------------------------- - * * DefaultErrorHandler -- * * This procedure is the default X error handler. Tk uses it's own error @@ -823,7 +796,7 @@ XCreateImage( { XImage *ximage; display->request++; - ximage = (XImage *) ckalloc(sizeof(XImage)); + ximage = ckalloc(sizeof(XImage)); ximage->height = height; ximage->width = width; @@ -924,9 +897,9 @@ XGetImage( bitmap_rep = BitmapRepFromDrawableRect(d, x, y,width, height); bitmap_fmt = [bitmap_rep bitmapFormat]; - if ( bitmap_rep == Nil || - (bitmap_fmt != 0 && bitmap_fmt != 1) || - [bitmap_rep samplesPerPixel] != 4 || + if ( bitmap_rep == Nil || + (bitmap_fmt != 0 && bitmap_fmt != 1) || + [bitmap_rep samplesPerPixel] != 4 || [bitmap_rep isPlanar] != 0 ) { TkMacOSXDbgMsg("XGetImage: Failed to construct NSBitmapRep"); return NULL; @@ -1008,7 +981,7 @@ DestroyImage( if (image->data) { ckfree(image->data); } - ckfree((char*) image); + ckfree(image); } return 0; } diff --git a/macosx/ttkMacOSXTheme.c b/macosx/ttkMacOSXTheme.c index 87ec4c2..4753a40 100644 --- a/macosx/ttkMacOSXTheme.c +++ b/macosx/ttkMacOSXTheme.c @@ -294,13 +294,12 @@ static Ttk_StateTable TabPositionTable[] = { * TP30000359-TPXREF116> */ - static void TabElementSize( void *clientData, void *elementRecord, Tk_Window tkwin, int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr) { - *heightPtr = GetThemeMetric(kThemeMetricLargeTabHeight, heightPtr); - *paddingPtr = Ttk_MakePadding(0, 0, 0, 2); + *heightPtr = GetThemeMetric(kThemeMetricLargeTabHeight, heightPtr); + *paddingPtr = Ttk_MakePadding(0, 0, 0, 2); } @@ -519,6 +518,10 @@ static Ttk_ElementSpec ComboboxElementSpec = { ComboboxElementDraw }; + + + + /*---------------------------------------------------------------------- * +++ Spinbuttons. * @@ -591,6 +594,7 @@ static TrackElementData ScaleData = { kThemeSlider, kThemeMetricHSliderHeight }; + typedef struct { Tcl_Obj *fromObj; /* minimum value */ Tcl_Obj *toObj; /* maximum value */ @@ -652,6 +656,7 @@ static void TrackElementDraw( info.trackInfo.slider.thumbDir = kThemeThumbPlain; } + BEGIN_DRAWING(d) ChkErr(HIThemeDrawTrack, &info, NULL, dc.context, HIOrientation); END_DRAWING diff --git a/tests/bell.test b/tests/bell.test index 16fea0f..4f7df97 100644 --- a/tests/bell.test +++ b/tests/bell.test @@ -5,32 +5,40 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test bell-1.1 {bell command} { - list [catch {bell a} msg] $msg -} {1 {bad option "a": must be -displayof or -nice}} -test bell-1.2 {bell command} { - list [catch {bell a b} msg] $msg -} {1 {bad option "a": must be -displayof or -nice}} -test bell-1.3 {bell command} { - list [catch {bell -displayof gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test bell-1.4 {bell command} { - list [catch {bell -nice -displayof} msg] $msg -} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}} -test bell-1.5 {bell command} { - list [catch {bell -nice -nice -nice} msg] $msg -} {0 {}} -test bell-1.6 {bell command} { - list [catch {bell -displayof . -nice} msg] $msg -} {0 {}} -test bell-1.7 {bell command} { - list [catch {bell -nice -displayof . -nice} msg] $msg -} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}} -test bell-1.8 {bell command} { +test bell-1.1 {bell command} -body { + bell a +} -returnCodes {error} -result {bad option "a": must be -displayof or -nice} + +test bell-1.2 {bell command} -body { + bell a b +} -returnCodes {error} -result {bad option "a": must be -displayof or -nice} + +test bell-1.3 {bell command} -body { + bell -displayof gorp +} -returnCodes {error} -result {bad window path name "gorp"} + +test bell-1.4 {bell command} -body { + bell -nice -displayof +} -returnCodes {error} -result {wrong # args: should be "bell ?-displayof window? ?-nice?"} + +test bell-1.5 {bell command} -body { + bell -nice -nice -nice +} -returnCodes {ok} -result {} ;#keep -result {} and -retutnCodes {ok} for clarity? + +test bell-1.6 {bell command} -body { + bell -displayof . -nice +} -returnCodes {ok} -result {} + +test bell-1.7 {bell command} -body { + bell -nice -displayof . -nice +} -returnCodes {error} -result {wrong # args: should be "bell ?-displayof window? ?-nice?"} + +test bell-1.8 {bell command} -body { puts "Bell should ring now ..." flush stdout after 200 @@ -39,8 +47,7 @@ test bell-1.8 {bell command} { bell -nice after 200 bell -} {} +} -result {} -# cleanup cleanupTests return diff --git a/tests/bgerror.test b/tests/bgerror.test index fa33d31..fd9594a 100644 --- a/tests/bgerror.test +++ b/tests/bgerror.test @@ -5,49 +5,58 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test bgerror-1.1 {bgerror / tkerror compat} { +test bgerror-1.1 {bgerror / tkerror compat} -setup { set errRes {} proc tkerror {err} { - global errRes; - set errRes $err; + global errRes; + set errRes $err; } +} -body { after 0 {error err1} vwait errRes; - set errRes; -} err1 + return $errRes; +} -cleanup { + catch {rename tkerror {}} +} -result {err1} -test bgerror-1.2 {bgerror / tkerror compat / accumulation} { +test bgerror-1.2 {bgerror / tkerror compat / accumulation} -setup { set errRes {} proc tkerror {err} { - global errRes; - lappend errRes $err; + global errRes; + lappend errRes $err; } +} -body { after 0 {error err1} after 0 {error err2} after 0 {error err3} update - set errRes; -} {err1 err2 err3} + return $errRes; +} -cleanup { + catch {rename tkerror {}} +} -result {err1 err2 err3} -test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} { +test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} -setup { set errRes {} proc tkerror {err} { - global errRes; - lappend errRes $err; - return -code break "skip!"; + global errRes; + lappend errRes $err; + return -code break "skip!"; } +} -body { after 0 {error err1} after 0 {error err2} after 0 {error err3} update - set errRes; -} err1 + return $errRes; +} -cleanup { + catch {rename tkerror {}} +} -result {err1} -catch {rename tkerror {}} # some testing of the default error dialog # would be needed too, but that's not easy at all diff --git a/tests/bind.test b/tests/bind.test index 3abb615..474771d 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -7,2785 +7,6092 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands tk useinputmethods 0 -catch {destroy .b} -toplevel .b -width 100 -height 50 -wm geom .b +0+0 +toplevel .t -width 100 -height 50 +wm geom .t +0+0 update idletasks -proc setup {} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - pack .b.f - focus -force .b.f - foreach p [event info] {event delete $p} - update +foreach p [event info] {event delete $p} +foreach event [bind Test] { + bind Test $event {} } -proc setup2 {} { - catch {destroy .b.e} - entry .b.e - pack .b.e - focus -force .b.e - foreach p [event info] {event delete $p} - update +foreach event [bind all] { + bind all $event {} } -setup -foreach i [bind Test] { - bind Test $i {} -} -foreach i [bind all] { - bind all $i {} +proc unsetBindings {} { + bind all <Enter> {} + bind Test <Enter> {} + bind Toplevel <Enter> {} + bind xyz <Enter> {} + bind {a b} <Enter> {} + bind .t <Enter> {} } -test bind-1.1 {bind command} { - list [catch {bind} msg] $msg -} {1 {wrong # args: should be "bind window ?pattern? ?command?"}} -test bind-1.2 {bind command} { - list [catch {bind a b c d} msg] $msg -} {1 {wrong # args: should be "bind window ?pattern? ?command?"}} -test bind-1.3 {bind command} { - list [catch {bind .gorp} msg] $msg -} {1 {bad window path name ".gorp"}} -test bind-1.4 {bind command} { - list [catch {bind foo} msg] $msg -} {0 {}} -test bind-1.5 {bind command} { - list [catch {bind .b <gorp-> {}} msg] $msg -} {0 {}} -test bind-1.6 {bind command} { - catch {destroy .b.f} - frame .b.f - bind .b.f <Enter> {test script} - set result [bind .b.f <Enter>] - bind .b.f <Enter> {} - list $result [bind .b.f <Enter>] -} {{test script} {}} -test bind-1.7 {bind command} { - catch {destroy .b.f} - frame .b.f - bind .b.f <Enter> {test script} - bind .b.f <Enter> {+more text} - bind .b.f <Enter> -} {test script + +test bind-1.1 {bind command} -body { + bind +} -returnCodes error -result {wrong # args: should be "bind window ?pattern? ?command?"} +test bind-1.2 {bind command} -body { + bind a b c d +} -returnCodes error -result {wrong # args: should be "bind window ?pattern? ?command?"} +test bind-1.3 {bind command} -body { + bind .gorp +} -returnCodes error -result {bad window path name ".gorp"} +test bind-1.4 {bind command} -body { + bind foo +} -returnCodes ok -result {} +test bind-1.5 {bind command} -body { + bind .t <gorp-> {} +} -returnCodes ok -result {} +test bind-1.6 {bind command} -body { + frame .t.f + bind .t.f <Enter> {test script} + set result [bind .t.f <Enter>] + bind .t.f <Enter> {} + list $result [bind .t.f <Enter>] +} -cleanup { + destroy .t.f +} -result {{test script} {}} +test bind-1.7 {bind command} -body { + frame .t.f + bind .t.f <Enter> {test script} + bind .t.f <Enter> {+more text} + bind .t.f <Enter> +} -cleanup { + destroy .t.f +} -result {test script more text} -test bind-1.8 {bind command} { - list [catch {bind .b <gorp-> {test script}} msg] $msg [bind .b] -} {1 {bad event type or keysym "gorp"} {}} -test bind-1.9 {bind command} { - list [catch {bind .b <gorp->} msg] $msg -} {0 {}} -test bind-1.10 {bind command} { - catch {destroy .b.f} - frame .b.f - bind .b.f <Enter> {script 1} - bind .b.f <Leave> {script 2} - bind .b.f a {script for a} - bind .b.f b {script for b} - lsort [bind .b.f] -} {<Enter> <Leave> a b} - -test bind-2.1 {bindtags command} { - list [catch {bindtags} msg] $msg -} {1 {wrong # args: should be "bindtags window ?taglist?"}} -test bind-2.2 {bindtags command} { - list [catch {bindtags a b c} msg] $msg -} {1 {wrong # args: should be "bindtags window ?taglist?"}} -test bind-2.3 {bindtags command} { - list [catch {bindtags .foo} msg] $msg -} {1 {bad window path name ".foo"}} -test bind-2.4 {bindtags command} { - bindtags .b -} {.b Toplevel all} -test bind-2.5 {bindtags command} { - catch {destroy .b.f} - frame .b.f - bindtags .b.f -} {.b.f Frame .b all} -test bind-2.6 {bindtags command} { - catch {destroy .b.f} - frame .b.f - bindtags .b.f {{x y z} b c d} - bindtags .b.f -} {{x y z} b c d} -test bind-2.7 {bindtags command} { - catch {destroy .b.f} - frame .b.f - bindtags .b.f {x y z} - bindtags .b.f {} - bindtags .b.f -} {.b.f Frame .b all} -test bind-2.8 {bindtags command} { - catch {destroy .b.f} - frame .b.f - bindtags .b.f {x y z} - bindtags .b.f {a b c d} - bindtags .b.f -} {a b c d} -test bind-2.9 {bindtags command} { - catch {destroy .b.f} - frame .b.f - bindtags .b.f {a b c} - list [catch {bindtags .b.f "\{"} msg] $msg [bindtags .b.f] -} {1 {unmatched open brace in list} {.b.f Frame .b all}} -test bind-2.10 {bindtags command} { - catch {destroy .b.f} - frame .b.f - bindtags .b.f {a b c} - list [catch {bindtags .b.f "a .gorp b"} msg] $msg [bindtags .b.f] -} {0 {} {a .gorp b}} -test bind-3.1 {TkFreeBindingTags procedure} { - catch {destroy .b.f} - frame .b.f - bindtags .b.f "a b c d" - destroy .b.f -} {} -test bind-3.2 {TkFreeBindingTags procedure} { - catch {destroy .b.f} - frame .b.f - catch {bindtags .b.f "a .gorp b .b.f"} - destroy .b.f -} {} - -bind all <Enter> {lappend x "%W enter all"} -bind Test <Enter> {lappend x "%W enter frame"} -bind Toplevel <Enter> {lappend x "%W enter toplevel"} -bind xyz <Enter> {lappend x "%W enter xyz"} -bind {a b} <Enter> {lappend x "%W enter {a b}"} -bind .b <Enter> {lappend x "%W enter .b"} -test bind-4.1 {TkBindEventProc procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - pack .b.f - update - bind .b.f <Enter> {lappend x "%W enter .b.f"} - set x {} - event gen .b.f <Enter> - set x -} {{.b.f enter .b.f} {.b.f enter frame} {.b.f enter .b} {.b.f enter all}} -test bind-4.2 {TkBindEventProc procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - pack .b.f - update - bind .b.f <Enter> {lappend x "%W enter .b.f"} - bindtags .b.f {.b.f {a b} xyz} - set x {} - event gen .b.f <Enter> - set x -} {{.b.f enter .b.f} {.b.f enter {a b}} {.b.f enter xyz}} -test bind-4.3 {TkBindEventProc procedure} { - set x {} - event gen .b <Enter> - set x -} {{.b enter .b} {.b enter toplevel} {.b enter all}} -test bind-4.4 {TkBindEventProc procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - pack .b.f - update - bindtags .b.f {.b.f .b.f2 .b.f3} - frame .b.f3 -width 50 -height 50 - pack .b.f3 - bind .b.f <Enter> {lappend x "%W enter .b.f"} - bind .b.f3 <Enter> {lappend x "%W enter .b.f3"} - set x {} - event gen .b.f <Enter> - destroy .b.f3 - set x -} {{.b.f enter .b.f} {.b.f enter .b.f3}} -test bind-4.5 {TkBindEventProc procedure} { +test bind-1.8 {bind command} -body { + bind .t <gorp-> {test script} +} -returnCodes error -result {bad event type or keysym "gorp"} +test bind-1.9 {bind command} -body { + catch {bind .t <gorp-> {test script}} + bind .t +} -result {} +test bind-1.10 {bind command} -body { + bind .t <gorp-> +} -returnCodes ok -result {} +test bind-1.11 {bind command} -body { + frame .t.f + bind .t.f <Enter> {script 1} + bind .t.f <Leave> {script 2} + bind .t.f a {script for a} + bind .t.f b {script for b} + lsort [bind .t.f] +} -cleanup { + destroy .t.f +} -result {<Enter> <Leave> a b} + +test bind-2.1 {bindtags command} -body { + bindtags +} -returnCodes error -result {wrong # args: should be "bindtags window ?taglist?"} +test bind-2.2 {bindtags command} -body { + bindtags a b c +} -returnCodes error -result {wrong # args: should be "bindtags window ?taglist?"} +test bind-2.3 {bindtags command} -body { + bindtags .foo +} -returnCodes error -result {bad window path name ".foo"} +test bind-2.4 {bindtags command} -body { + bindtags .t +} -result {.t Toplevel all} +test bind-2.5 {bindtags command} -body { + frame .t.f + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {.t.f Frame .t all} +test bind-2.6 {bindtags command} -body { + frame .t.f + bindtags .t.f {{x y z} b c d} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {{x y z} b c d} +test bind-2.7 {bindtags command} -body { + frame .t.f + bindtags .t.f {x y z} + bindtags .t.f {} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {.t.f Frame .t all} +test bind-2.8 {bindtags command} -body { + frame .t.f + bindtags .t.f {x y z} + bindtags .t.f {a b c d} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {a b c d} +test bind-2.9 {bindtags command} -body { + frame .t.f + bindtags .t.f {a b c} + bindtags .t.f "\{" +} -cleanup { + destroy .t.f +} -returnCodes error -result {unmatched open brace in list} +test bind-2.10 {bindtags command} -body { + frame .t.f + bindtags .t.f {a b c} + catch {bindtags .t.f "\{"} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {.t.f Frame .t all} +test bind-2.11 {bindtags command} -body { + frame .t.f + bindtags .t.f {a b c} + bindtags .t.f "a .gorp b" +} -cleanup { + destroy .t.f +} -returnCodes ok +test bind-2.12 {bindtags command} -body { + frame .t.f + bindtags .t.f {a b c} + catch {bindtags .t.f "a .gorp b"} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {a .gorp b} + + +test bind-3.1 {TkFreeBindingTags procedure} -body { + frame .t.f + bindtags .t.f "a b c d" + destroy .t.f +} -cleanup { + destroy .t.f +} -result {} +test bind-3.2 {TkFreeBindingTags procedure} -body { + frame .t.f + catch {bindtags .t.f "a .gorp b .t.f"} + destroy .t.f +} -cleanup { + destroy .t.f +} -result {} + + +test bind-4.1 {TkBindEventProc procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + update + set x {} +} -body { + bind all <Enter> {lappend x "%W enter all"} + bind Test <Enter> {lappend x "%W enter frame"} + bind Toplevel <Enter> {lappend x "%W enter toplevel"} + bind xyz <Enter> {lappend x "%W enter xyz"} + bind {a b} <Enter> {lappend x "%W enter {a b}"} + bind .t <Enter> {lappend x "%W enter .t"} + bind .t.f <Enter> {lappend x "%W enter .t.f"} + + event generate .t.f <Enter> + return $x +} -cleanup { + destroy .t.f + unsetBindings +} -result {{.t.f enter .t.f} {.t.f enter frame} {.t.f enter .t} {.t.f enter all}} +test bind-4.2 {TkBindEventProc procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + update + set x {} +} -body { + bind all <Enter> {lappend x "%W enter all"} + bind Test <Enter> {lappend x "%W enter frame"} + bind Toplevel <Enter> {lappend x "%W enter toplevel"} + bind xyz <Enter> {lappend x "%W enter xyz"} + bind {a b} <Enter> {lappend x "%W enter {a b}"} + bind .t <Enter> {lappend x "%W enter .t"} + bind .t.f <Enter> {lappend x "%W enter .t.f"} + + bindtags .t.f {.t.f {a b} xyz} + event generate .t.f <Enter> + return $x +} -cleanup { + destroy .t.f + unsetBindings +} -result {{.t.f enter .t.f} {.t.f enter {a b}} {.t.f enter xyz}} +test bind-4.3 {TkBindEventProc procedure} -body { + set x {} + bind all <Enter> {lappend x "%W enter all"} + bind Test <Enter> {lappend x "%W enter frame"} + bind Toplevel <Enter> {lappend x "%W enter toplevel"} + bind xyz <Enter> {lappend x "%W enter xyz"} + bind {a b} <Enter> {lappend x "%W enter {a b}"} + bind .t <Enter> {lappend x "%W enter .t"} + + event generate .t <Enter> + return $x +} -cleanup { + unsetBindings +} -result {{.t enter .t} {.t enter toplevel} {.t enter all}} +test bind-4.4 {TkBindEventProc procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + frame .t.f3 -width 50 -height 50 + pack .t.f3 + update + set x {} +} -body { + bind all <Enter> {lappend x "%W enter all"} + bind Test <Enter> {lappend x "%W enter frame"} + bind Toplevel <Enter> {lappend x "%W enter toplevel"} + bind xyz <Enter> {lappend x "%W enter xyz"} + bind {a b} <Enter> {lappend x "%W enter {a b}"} + bind .t <Enter> {lappend x "%W enter .t"} + + bindtags .t.f {.t.f .t.f2 .t.f3} + bind .t.f <Enter> {lappend x "%W enter .t.f"} + bind .t.f3 <Enter> {lappend x "%W enter .t.f3"} + event generate .t.f <Enter> + return $x +} -cleanup { + destroy .t.f .t.f3 + unsetBindings +} -result {{.t.f enter .t.f} {.t.f enter .t.f3}} +test bind-4.5 {TkBindEventProc procedure} -setup { # This tests memory allocation for objPtr; it won't serve any useful # purpose unless run with some sort of allocation checker turned on. - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - pack .b.f - update - bindtags .b.f {a b c d e f g h i j k l m n o p q r s t u v w x y z} - event gen .b.f <Enter> -} {} -bind all <Enter> {} -bind Test <Enter> {} -bind Toplevel <Enter> {} -bind xyz <Enter> {} -bind {a b} <Enter> {} -bind .b <Enter> {} - -test bind-5.1 {Tk_CreateBindingTable procedure} { - catch {destroy .b.c} - canvas .b.c - .b.c bind foo -} {} - -test bind-6.1 {Tk_DeleteBindTable procedure} { - catch {destroy .b.c} - canvas .b.c - .b.c bind foo <1> {string 1} - .b.c create rectangle 0 0 100 100 - .b.c bind 1 <2> {string 2} - destroy .b.c -} {} -test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} testcbind { - catch {interp delete foo} - interp create foo - foo eval { - load {} Tk - tk useinputmethods 0 - load {} Tktest - wm geometry . +0+0 - frame .t -width 50 -height 50 - bindtags .t {a b c d} - pack .t - update - set x {} - testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1" - bind b <1> "lappend x b1" - testcbind c <1> "lappend x c1" "lappend x bye.c1" - testcbind c <2> "lappend x all2" "lappend x bye.all2" - event gen .t <1> - } - set x [foo eval set x] - interp delete foo - set x -} {a1 bye.all2 bye.a1 b1 bye.c1} - -test bind-7.1 {Tk_CreateBinding procedure: bad binding} { - catch {destroy .b.c} - canvas .b.c - list [catch {.b.c bind foo <} msg] $msg -} {1 {no event type or button # or keysym}} -test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} testcbind { - catch {destroy .b.f} - frame .b.f - testcbind .b.f <1> "xyz" "lappend x bye.1" - set x {} - bind .b.f <1> "abc" - destroy .b.f - set x -} {bye.1} -test bind-7.3 {Tk_CreateBinding procedure: append} { - catch {destroy .b.c} - canvas .b.c - .b.c bind foo <1> "button 1" - .b.c bind foo <1> "+more button 1" - .b.c bind foo <1> -} {button 1 + frame .t.f -class Test -width 150 -height 100 + pack .t.f + update +} -body { + bind all <Enter> {lappend x "%W enter all"} + bind Test <Enter> {lappend x "%W enter frame"} + bind Toplevel <Enter> {lappend x "%W enter toplevel"} + bind xyz <Enter> {lappend x "%W enter xyz"} + bind {a b} <Enter> {lappend x "%W enter {a b}"} + bind .t <Enter> {lappend x "%W enter .t"} + bindtags .t.f {a b c d e f g h i j k l m n o p q r s t u v w x y z} + + event generate .t.f <Enter> +} -cleanup { + destroy .t.f + unsetBindings +} -result {} + + +test bind-5.1 {Tk_CreateBindingTable procedure} -body { + canvas .t.c + .t.c bind foo +} -cleanup { + destroy .t.c +} -result {} + + +test bind-6.1 {Tk_DeleteBindTable procedure} -body { + canvas .t.c + .t.c bind foo <1> {string 1} + .t.c create rectangle 0 0 100 100 + .t.c bind 1 <2> {string 2} + destroy .t.c +} -cleanup { + destroy .t.c +} -result {} +test bind-7.1 {Tk_CreateBinding procedure: bad binding} -body { + canvas .t.c + .t.c bind foo < +} -cleanup { + destroy .t.c +} -returnCodes error -result {no event type or button # or keysym} +test bind-7.3 {Tk_CreateBinding procedure: append} -body { + canvas .t.c + .t.c bind foo <1> "button 1" + .t.c bind foo <1> "+more button 1" + .t.c bind foo <1> +} -cleanup { + destroy .t.c +} -result {button 1 more button 1} -test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} { - catch {destroy .b.c} - canvas .b.c - .b.c bind foo <1> "+button 1" - .b.c bind foo <1> -} {button 1} - -test bind-8.1 {TkCreateBindingProcedure: error} testcbind { - list [catch {testcbind . <xyz> "xyz"} msg] $msg -} {1 {bad event type or keysym "xyz"}} -test bind-8.2 {TkCreateBindingProcedure: new binding} testcbind { - catch {destroy .b.f} - frame .b.f - testcbind .b.f <1> "lappend x 1" "lappend x bye.1" - set x {} - event gen .b.f <1> - destroy .b.f - set x -} {bye.1} -test bind-8.3 {TkCreateBindingProcedure: replace existing} testcbind { - catch {destroy .b.f} - frame .b.f - pack .b.f - set x {} - testcbind .b.f <1> "lappend x old1" "lappend x bye.old1" - testcbind .b.f <1> "lappend x new1" "lappend x bye.new1" - set x -} {bye.old1} -test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} testcbind { - catch {destroy .b.f} - frame .b.f - pack .b.f - update - testcbind .b.f <1> "lappend x .b.f; testcbind Frame <1> {lappend x Frame}" - testcbind Frame <1> "lappend x never" - set x {} - event gen .b.f <1> - bind .b.f <1> {} - set x -} {.b.f Frame} - -test bind-9.1 {Tk_DeleteBinding procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - list [catch {bind .b.f <} msg] $msg -} {0 {}} -test bind-9.2 {Tk_DeleteBinding procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 +test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} -body { + canvas .t.c + .t.c bind foo <1> "+button 1" + .t.c bind foo <1> +} -cleanup { + destroy .t.c +} -result {button 1} + +test bind-8.1 {Tk_CreateBinding: error} -body { + bind . <xyz> "xyz" +} -returnCodes error -result {bad event type or keysym "xyz"} + +test bind-9.1 {Tk_DeleteBinding procedure} -body { + frame .t.f -class Test -width 150 -height 100 + bind .t.f < +} -cleanup { + destroy .t.f +} -returnCodes ok +test bind-9.2 {Tk_DeleteBinding procedure} -setup { + set result {} +} -body { + frame .t.f -class Test -width 150 -height 100 foreach i {a b c d} { - bind .b.f $i "binding for $i" + bind .t.f $i "binding for $i" } - set result {} foreach i {b d a c} { - bind .b.f $i {} - lappend result [lsort [bind .b.f]] + bind .t.f $i {} + lappend result [lsort [bind .t.f]] } - set result -} {{a c d} {a c} c {}} -test bind-9.3 {Tk_DeleteBinding procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 + return $result +} -cleanup { + destroy .t.f +} -result {{a c d} {a c} c {}} +test bind-9.3 {Tk_DeleteBinding procedure} -setup { + set result {} +} -body { + frame .t.f -class Test -width 150 -height 100 foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} { - bind .b.f $i "binding for $i" + bind .t.f $i "binding for $i" } - set result {} foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} { - bind .b.f $i {} - lappend result [lsort [bind .b.f]] + bind .t.f $i {} + lappend result [lsort [bind .t.f]] } - set result -} {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}} -test bind-9.4 {Tk_DeleteBinding procedure: pending bindings delete later} testcbind { - catch {destroy .b.f} - frame .b.f - pack .b.f - update - bindtags .b.f {a b c} - testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1} - bind b <1> {lappend x b1} - testcbind c <1> {lappend x c1} {lappend x bye.c1} - testcbind c <2> {lappend x c2} {lappend x bye.c2} - set x {} - event gen .b.f <1> - bind a <1> {} - bind b <1> {} - set x -} {a1 bye.c2 b1 bye.c1 bye.a1} - -test bind-10.1 {Tk_GetBinding procedure} { - catch {destroy .b.c} - canvas .b.c - list [catch {.b.c bind foo <} msg] $msg -} {1 {no event type or button # or keysym}} -test bind-10.2 {Tk_GetBinding procedure} { - catch {destroy .b.c} - canvas .b.c - .b.c bind foo a Test - .b.c bind foo a -} {Test} -test bind-10.3 {Tk_GetBinding procedure: C binding} testcbind { - catch {destroy .b.f} - frame .b.f - testcbind .b.f <1> "foo" - list [bind .b.f] [bind .b.f <1>] -} {<Button-1> {}} - -test bind-11.1 {Tk_GetAllBindings procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 + return $result +} -cleanup { + destroy .t.f +} -result {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}} + +test bind-10.1 {Tk_GetBinding procedure} -body { + canvas .t.c + .t.c bind foo < +} -cleanup { + destroy .t.c +} -returnCodes error -result {no event type or button # or keysym} +test bind-10.2 {Tk_GetBinding procedure} -body { + canvas .t.c + .t.c bind foo a Test + .t.c bind foo a +} -cleanup { + destroy .t.c +} -result {Test} + +test bind-11.1 {Tk_GetAllBindings procedure} -body { + frame .t.f foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" { - bind .b.f $i Test + bind .t.f $i Test } - lsort [bind .b.f] -} {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~} -test bind-11.2 {Tk_GetAllBindings procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 + lsort [bind .t.f] +} -cleanup { + destroy .t.f +} -result {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~} +test bind-11.2 {Tk_GetAllBindings procedure} -body { + frame .t.f foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" { - bind .b.f $i Test + bind .t.f $i Test } - lsort [bind .b.f] -} {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>} -test bind-11.3 {Tk_GetAllBindings procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 + lsort [bind .t.f] +} -cleanup { + destroy .t.f +} -result {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>} +test bind-11.3 {Tk_GetAllBindings procedure} -body { + frame .t.f foreach i "<Double-Triple-1> abcd a<Leave>b" { - bind .b.f $i Test + bind .t.f $i Test } - lsort [bind .b.f] -} {<Triple-Button-1> a<Leave>b abcd} - - -test bind-12.1 {Tk_DeleteAllBindings procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - destroy .b.f -} {} -test bind-12.2 {Tk_DeleteAllBindings procedure} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 + lsort [bind .t.f] +} -cleanup { + destroy .t.f +} -result {<Triple-Button-1> a<Leave>b abcd} + + +test bind-12.1 {Tk_DeleteAllBindings procedure} -body { + frame .t.f -class Test -width 150 -height 100 + destroy .t.f +} -result {} +test bind-12.2 {Tk_DeleteAllBindings procedure} -body { + frame .t.f -class Test -width 150 -height 100 foreach i "a b c <Meta-1> <Alt-a> <Control-a>" { - bind .b.f $i x + bind .t.f $i x } - destroy .b.f -} {} -test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} testcbind { - catch {destroy .b.f} - frame .b.f - pack .b.f + destroy .t.f +} -result {} + +test bind-13.1 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f update - testcbind .b.f <1> {lappend x before; event gen .b.f <2>; lappend x after} {lappend x bye.f1} - testcbind .b.f <2> {destroy .b.f} {lappend x bye.f2} - bind .b.f <Destroy> {lappend x fDestroy} - testcbind .b.f <3> {foo} {lappend x bye.f3} set x {} - event gen .b.f <1> - set x -} {before fDestroy bye.f3 bye.f2 after bye.f1} - -bind Test <KeyPress> {lappend x "%W %K Test press any"} -bind all <KeyPress> {lappend x "%W %K all press any"} -bind Test a {lappend x "%W %K Test press a"} -bind all x {lappend x "%W %K all press x"} +} -body { + bind Test <KeyPress> {lappend x "%W %K Test KeyPress"} + bind all <KeyPress> {lappend x "%W %K all KeyPress"} + bind Test : {lappend x "%W %K Test :"} + bind all _ {lappend x "%W %K all _"} + bind .t.f : {lappend x "%W %K .t.f :"} + + event generate .t.f <Key-colon> + event generate .t.f <Key-plus> + event generate .t.f <Key-underscore> + return $x +} -cleanup { + destroy .t.f + bind all <KeyPress> {} + bind Test <KeyPress> {} + bind all _ {} + bind Test : {} +} -result {{.t.f colon .t.f :} {.t.f colon Test :} {.t.f colon all KeyPress} {.t.f plus Test KeyPress} {.t.f plus all KeyPress} {.t.f underscore Test KeyPress} {.t.f underscore all _}} -test bind-13.1 {Tk_BindEvent procedure} { - setup - bind .b.f a {lappend x "%W %K .b.f press a"} +test bind-13.2 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Key-a> - event gen .b.f <Key-b> - event gen .b.f <Key-x> - set x -} {{.b.f a .b.f press a} {.b.f a Test press a} {.b.f a all press any} {.b.f b Test press any} {.b.f b all press any} {.b.f x Test press any} {.b.f x all press x}} - -bind Test <KeyPress> {lappend x "%W %K Test press any"; break} -bind all <KeyPress> {continue; lappend x "%W %K all press any"} +} -body { + bind Test <KeyPress> {lappend x "%W %K Test press any"; break} + bind all <KeyPress> {continue; lappend x "%W %K all press any"} + bind .t.f : {lappend x "%W %K .t.f pressed colon"} + + event generate .t.f <Key-colon> + return $x +} -cleanup { + destroy .t.f + bind all <KeyPress> {} + bind Test <KeyPress> {} +} -result {{.t.f colon .t.f pressed colon} {.t.f colon Test press any}} -test bind-13.2 {Tk_BindEvent procedure} { - setup - bind .b.f b {lappend x "%W %K .b.f press a"} - set x {} - event gen .b.f <Key-b> - set x -} {{.b.f b .b.f press a} {.b.f b Test press any}} -if {[info procs bgerror] == "bgerror"} { - rename bgerror {} -} -proc bgerror args {} -bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test} -test bind-13.3 {Tk_BindEvent procedure} { - setup - bind .b.f b {lappend x "%W %K .b.f press a"} +test bind-13.3 {Tk_BindEvent procedure} -setup { + proc bgerror args {} + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Key-b> +} -body { + bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test} + bind .t.f : {lappend x "%W %K .t.f pressed colon"} + event generate .t.f <Key-colon> update list $x $errorInfo -} {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test +} -cleanup { + destroy .t.f + bind Test <KeyPress> {} + rename bgerror {} +} -result {{{.t.f colon .t.f pressed colon} {.t.f colon Test press any}} {Test while executing "error Test" (command bound to event)}} -rename bgerror {} -test bind-13.4 {Tk_BindEvent procedure} { +test bind-13.4 {Tk_BindEvent procedure} -setup { proc foo {} { - set x 44 - event gen .b.f <Key-a> + set x 44 + event generate .t.f <Key-colon> } - setup - bind .b.f a {lappend x "%W %K .b.f press a"} + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} +} -body { + bind Test : {lappend x "%W %K Test"} + bind .t.f : {lappend x "%W %K .t.f"} foo - set x -} {{.b.f a .b.f press a} {.b.f a Test press a}} -test bind-13.5 {Tk_BindEvent procedure} { + return $x +} -cleanup { + destroy .t.f + bind Test : {} +} -result {{.t.f colon .t.f} {.t.f colon Test}} + +test bind-13.5 {Tk_BindEvent procedure} -body { bind all <Destroy> {lappend x "%W destroyed"} set x {} - list [catch {frame .b.g -gorp foo} msg] $msg $x -} {1 {unknown option "-gorp"} {{.b.g destroyed}}} -foreach i [bind all] { - bind all $i {} -} -foreach i [bind Test] { - bind Test $i {} -} -test bind-13.6 {Tk_BindEvent procedure} { - setup - bind .b.f z {lappend x "%W z (.b.f binding)"} - bind Test z {lappend x "%W z (.b.f binding)"} - bind all z {bind .b.f z {}; lappend x "%W z (.b.f binding)"} - set x {} - event gen .b.f <Key-z> - bind Test z {} - bind all z {} - set x -} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}} -test bind-13.7 {Tk_BindEvent procedure} { - setup - bind .b.f z {lappend x "%W z (.b.f binding)"} - bind Test z {lappend x "%W z (.b.f binding)"} - bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"} - set x {} - event gen .b.f <Key-z> - bind Test z {} - bind all z {} - set x -} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}} -test bind-13.8 {Tk_BindEvent procedure} { - setup - bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"} - bind .b.f <ButtonPress> {lappend x "%W z (.b.f <ButtonPress> binding)"} - set x {} - event gen .b.f <Button-1> - event gen .b.f <Button-2> - set x -} {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f <ButtonPress> binding)}} -test bind-13.9 {Tk_BindEvent procedure: ignore NotifyInferior} { - setup - bind .b.f <Enter> "lappend x Enter%#" - bind .b.f <Leave> "lappend x Leave%#" - set x {} - event gen .b.f <Enter> -serial 100 -detail NotifyAncestor - event gen .b.f <Enter> -serial 101 -detail NotifyInferior - event gen .b.f <Leave> -serial 102 -detail NotifyAncestor - event gen .b.f <Leave> -serial 103 -detail NotifyInferior - set x -} {Enter100 Leave102} -test bind-13.10 {Tk_BindEvent procedure: collapse Motions} { - setup - bind .b.f <Motion> "lappend x Motion%#(%x,%y)" - set x {} - event gen .b.f <Motion> -serial 100 -x 100 -y 200 -when tail - update - event gen .b.f <Motion> -serial 101 -x 200 -y 300 -when tail - event gen .b.f <Motion> -serial 102 -x 300 -y 400 -when tail - update - set x -} {Motion100(100,200) Motion102(300,400)} -test bind-13.11 {Tk_BindEvent procedure: collapse repeating modifiers} { - setup - bind .b.f <Key> "lappend x %K%#" - bind .b.f <KeyRelease> "lappend x %K%#" - event gen .b.f <Key-Shift_L> -serial 100 -when tail - event gen .b.f <KeyRelease-Shift_L> -serial 101 -when tail - event gen .b.f <Key-Shift_L> -serial 102 -when tail - event gen .b.f <KeyRelease-Shift_L> -serial 103 -when tail - update -} {} -test bind-13.12 {Tk_BindEvent procedure: valid key detail} { - setup - bind .b.f <Key> "lappend x Key%K" - bind .b.f <KeyRelease> "lappend x Release%K" - set x {} - event gen .b.f <Key> -keysym a - event gen .b.f <KeyRelease> -keysym a - set x -} {Keya Releasea} -test bind-13.13 {Tk_BindEvent procedure: invalid key detail} { - setup - bind .b.f <Key> "lappend x Key%K" - bind .b.f <KeyRelease> "lappend x Release%K" - set x {} - event gen .b.f <Key> -keycode 0 - event gen .b.f <KeyRelease> -keycode 0 - set x -} {Key?? Release??} -test bind-13.14 {Tk_BindEvent procedure: button detail} { - setup - bind .b.f <Button> "lappend x Button%b" - bind .b.f <ButtonRelease> "lappend x Release%b" - set x {} - event gen .b.f <Button> -button 1 - event gen .b.f <ButtonRelease> -button 3 - set x -} {Button1 Release3} -test bind-13.15 {Tk_BindEvent procedure: virtual detail} { - setup - bind .b.f <<Paste>> "lappend x Paste" - set x {} - event gen .b.f <<Paste>> - set x -} {Paste} -test bind-13.16 {Tk_BindEvent procedure: virtual event in event stream} { - setup - bind .b.f <<Paste>> "lappend x Paste" - set x {} - event gen .b.f <<Paste>> - set x -} {Paste} -test bind-13.17 {Tk_BindEvent procedure: match detail physical} { - setup - bind .b.f <Button-2> {set x Button-2} - event add <<Paste>> <Button-2> - bind .b.f <<Paste>> {set x Paste} + frame .t.g -gorp foo +} -cleanup { + bind all <Destroy> {} +} -returnCodes error -result {unknown option "-gorp"} +test bind-13.6 {Tk_BindEvent procedure} -body { + bind all <Destroy> {lappend x "%W destroyed"} set x {} - event gen .b.f <Button-2> + catch {frame .t.g -gorp foo} + return $x +} -cleanup { + bind all <Destroy> {} +} -result {{.t.g destroyed}} + +test bind-13.7 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f : {lappend x "%W (.t.f binding)"} + bind Test : {lappend x "%W (Test binding)"} + bind all : {bind .t.f : {}; lappend x "%W (all binding)"} + event generate .t.f <Key-colon> + return $x +} -cleanup { + bind Test : {} + bind all : {} + destroy .t.f +} -result {{.t.f (.t.f binding)} {.t.f (Test binding)} {.t.f (all binding)}} +test bind-13.8 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f : {lappend x "%W (.t.f binding)"} + bind Test : {lappend x "%W (Test binding)"} + bind all : {destroy .t.f; lappend x "%W (all binding)"} + event generate .t.f <Key-colon> + return $x +} -cleanup { + bind Test : {} + bind all : {} + destroy .t.f +} -result {{.t.f (.t.f binding)} {.t.f (Test binding)} {.t.f (all binding)}} + +test bind-13.9 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <1> {lappend x "%W z (.t.f <1> binding)"} + bind .t.f <ButtonPress> {lappend x "%W z (.t.f <ButtonPress> binding)"} + event generate .t.f <Button-1> + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f +} -result {{.t.f z (.t.f <1> binding)} {.t.f z (.t.f <ButtonPress> binding)}} +test bind-13.10 {Tk_BindEvent procedure: ignore NotifyInferior} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x Enter%#" + bind .t.f <Leave> "lappend x Leave%#" + event generate .t.f <Enter> -serial 100 -detail NotifyAncestor + event generate .t.f <Enter> -serial 101 -detail NotifyInferior + event generate .t.f <Leave> -serial 102 -detail NotifyAncestor + event generate .t.f <Leave> -serial 103 -detail NotifyInferior + return $x +} -cleanup { + destroy .t.f +} -result {Enter100 Leave102} +test bind-13.11 {Tk_BindEvent procedure: collapse Motions} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x Motion%#(%x,%y)" + event generate .t.f <Motion> -serial 100 -x 100 -y 200 -when tail + update + event generate .t.f <Motion> -serial 101 -x 200 -y 300 -when tail + event generate .t.f <Motion> -serial 102 -x 300 -y 400 -when tail + update + return $x +} -cleanup { + destroy .t.f +} -result {Motion100(100,200) Motion102(300,400)} +test bind-13.12 {Tk_BindEvent procedure: collapse repeating modifiers} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> "lappend x %K%#" + bind .t.f <KeyRelease> "lappend x %K%#" + event generate .t.f <Key-Shift_L> -serial 100 -when tail + event generate .t.f <KeyRelease-Shift_L> -serial 101 -when tail + event generate .t.f <Key-Shift_L> -serial 102 -when tail + event generate .t.f <KeyRelease-Shift_L> -serial 103 -when tail + update +} -cleanup { + destroy .t.f +} -result {} +test bind-13.13 {Tk_BindEvent procedure: valid key detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x Key%K" + bind .t.f <KeyRelease> "lappend x Release%K" + event generate .t.f <Key> -keysym colon + event generate .t.f <KeyRelease> -keysym colon + return $x +} -cleanup { + destroy .t.f +} -result {Keycolon Releasecolon} +test bind-13.14 {Tk_BindEvent procedure: invalid key detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x Key%K" + bind .t.f <KeyRelease> "lappend x Release%K" + event generate .t.f <Key> -keycode 0 + event generate .t.f <KeyRelease> -keycode 0 + return $x +} -cleanup { + destroy .t.f +} -result {Key?? Release??} +test bind-13.15 {Tk_BindEvent procedure: button detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x Button%b" + bind .t.f <ButtonRelease> "lappend x Release%b" + event generate .t.f <Button> -button 1 + event generate .t.f <ButtonRelease> -button 3 set x -} {Button-2} -test bind-13.18 {Tk_BindEvent procedure: no match detail physical} { - setup +} -cleanup { + destroy .t.f +} -result {Button1 Release3} +test bind-13.16 {Tk_BindEvent procedure: virtual detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x Paste" + event generate .t.f <<Paste>> + return $x +} -cleanup { + destroy .t.f +} -result {Paste} +test bind-13.17 {Tk_BindEvent procedure: virtual event in event stream} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x Paste" + event generate .t.f <<Paste>> + return $x +} -cleanup { + destroy .t.f +} -result {Paste} +test bind-13.18 {Tk_BindEvent procedure: match detail physical} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-2> {set x Button-2} event add <<Paste>> <Button-2> - bind .b.f <<Paste>> {set x Paste} + bind .t.f <<Paste>> {set x Paste} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {Button-2} + +test bind-13.19 {Tk_BindEvent procedure: no match detail physical} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.19 {Tk_BindEvent procedure: match detail virtual} { - setup +} -body { event add <<Paste>> <Button-2> - bind .b.f <<Paste>> "lappend x Paste" + bind .t.f <<Paste>> {set x Paste} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {Paste} +test bind-13.20 {Tk_BindEvent procedure: match detail virtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.20 {Tk_BindEvent procedure: no match detail virtual} { - setup +} -body { event add <<Paste>> <Button-2> - bind .b.f <<Paste>> "lappend x Paste" + bind .t.f <<Paste>> "lappend x Paste" + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {Paste} +test bind-13.21 {Tk_BindEvent procedure: no match detail virtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button> - set x -} {} -test bind-13.21 {Tk_BindEvent procedure: match no-detail physical} { - setup - bind .b.f <Button> {set x Button} +} -body { + event add <<Paste>> <Button-2> + bind .t.f <<Paste>> "lappend x Paste" + event generate .t.f <Button> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {} +test bind-13.22 {Tk_BindEvent procedure: match no-detail physical} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> {set x Button} event add <<Paste>> <Button> - bind .b.f <<Paste>> {set x Paste} + bind .t.f <<Paste>> {set x Paste} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button> +} -result {Button} +test bind-13.23 {Tk_BindEvent procedure: no match no-detail physical} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Button} -test bind-13.22 {Tk_BindEvent procedure: no match no-detail physical} { - setup +} -body { event add <<Paste>> <Button> - bind .b.f <<Paste>> {set x Paste} + bind .t.f <<Paste>> {set x Paste} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button> +} -result {Paste} +test bind-13.24 {Tk_BindEvent procedure: match no-detail virtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.23 {Tk_BindEvent procedure: match no-detail virtual} { - setup +} -body { event add <<Paste>> <Button> - bind .b.f <<Paste>> "lappend x Paste" + bind .t.f <<Paste>> "lappend x Paste" + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button> +} -result {Paste} +test bind-13.25 {Tk_BindEvent procedure: no match no-detail virtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.24 {Tk_BindEvent procedure: no match no-detail virtual} { - setup +} -body { event add <<Paste>> <Key> - bind .b.f <<Paste>> "lappend x Paste" + bind .t.f <<Paste>> "lappend x Paste" + event generate .t.f <Button> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Key> +} -result {} +test bind-13.26 {Tk_BindEvent procedure: precedence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button> - set x -} {} -test bind-13.25 {Tk_BindEvent procedure: precedence} { - setup +} -body { event add <<Paste>> <Button-2> event add <<Copy>> <Button> - bind .b.f <Button-2> "lappend x Button-2" - bind .b.f <<Paste>> "lappend x Paste" - bind .b.f <Button> "lappend x Button" - bind .b.f <<Copy>> "lappend x Copy" - - set x {} - event gen .b.f <Button-2> - bind .b.f <Button-2> {} - event gen .b.f <Button-2> - bind .b.f <<Paste>> {} - event gen .b.f <Button-2> - bind .b.f <Button> {} - event gen .b.f <Button-2> - bind .b.f <<Copy>> {} - event gen .b.f <Button-2> - set x -} {Button-2 Paste Button Copy} -test bind-13.26 {Tk_BindEvent procedure: no detail virtual pattern list} { - setup - bind .b.f <Button-2> {set x Button-2} - set x {} - event gen .b.f <Button-2> - set x -} {Button-2} -test bind-13.27 {Tk_BindEvent procedure: detail virtual pattern list} { - setup + bind .t.f <Button-2> "lappend x Button-2" + bind .t.f <<Paste>> "lappend x Paste" + bind .t.f <Button> "lappend x Button" + bind .t.f <<Copy>> "lappend x Copy" + + event generate .t.f <Button-2> + bind .t.f <Button-2> {} + event generate .t.f <Button-2> + bind .t.f <<Paste>> {} + event generate .t.f <Button-2> + bind .t.f <Button> {} + event generate .t.f <Button-2> + bind .t.f <<Copy>> {} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> + event delete <<Copy>> <Button> +} -result {Button-2 Paste Button Copy} +test bind-13.27 {Tk_BindEvent procedure: no detail virtual pattern list} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-2> {set x Button-2} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f +} -result {Button-2} +test bind-13.28 {Tk_BindEvent procedure: detail virtual pattern list} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { event add <<Paste>> <Button-2> - bind .b.f <<Paste>> {set x Paste} + bind .t.f <<Paste>> {set x Paste} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {Paste} +test bind-13.29 {Tk_BindEvent procedure: no no-detail virtual pattern list} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.28 {Tk_BindEvent procedure: no no-detail virtual pattern list} { - setup - bind .b.f <Button> {set x Button} +} -body { + bind .t.f <Button> {set x Button} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f +} -result {Button} +test bind-13.30 {Tk_BindEvent procedure: no-detail virtual pattern list} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Button} -test bind-13.29 {Tk_BindEvent procedure: no-detail virtual pattern list} { - setup +} -body { event add <<Paste>> <Button> - bind .b.f <<Paste>> {set x Paste} - set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.30 {Tk_BindEvent procedure: no match} { - setup - event gen .b.f <Button-2> -} {} -test bind-13.31 {Tk_BindEvent procedure: match} { - setup - bind .b.f <Button-2> {set x Button-2} - set x {} - event gen .b.f <Button-2> - set x -} {Button-2} -test bind-13.32 {Tk_BindEvent procedure: many C bindings cause realloc} testcbind { - setup - bindtags .b.f {a b c d e f g h i j k l m n o p} - foreach p [bindtags .b.f] { - testcbind $p <1> "lappend x $p" - } + bind .t.f <<Paste>> {set x Paste} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button> +} -result {Paste} +test bind-13.31 {Tk_BindEvent procedure: no match} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + event generate .t.f <Button-2> +} -cleanup { + destroy .t.f +} -result {} +test bind-13.32 {Tk_BindEvent procedure: match} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-2> {set x Button-2} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f +} -result {Button-2} +test bind-13.33 {Tk_BindEvent procedure: many C bindings cause realloc} -setup { + # this test might not be useful anymore [#3009998] + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <1> - foreach p [bindtags .b.f] { - bind $p <1> {} +} -body { + bindtags .t.f {a b c d e f g h i j k l m n o p} + foreach p [bindtags .t.f] { + bind $p <1> "lappend x $p" } - set x -} {a b c d e f g h i j k l m n o p} -test bind-13.33 {Tk_BindEvent procedure: multiple tags} { - setup - bind .b.f <Button-2> {lappend x .b.f} - bind Test <Button-2> {lappend x Button} + event generate .t.f <1> + return $x +} -cleanup { + foreach p [bindtags .t.f] {bind $p <1> {}} + destroy .t.f +} -result {a b c d e f g h i j k l m n o p} +test bind-13.34 {Tk_BindEvent procedure: multiple tags} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> +} -body { + bind .t.f <Button-2> {lappend x .t.f} + bind Test <Button-2> {lappend x Button} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f bind Test <Button-2> {} - set x -} {.b.f Button} -test bind-13.34 {Tk_BindEvent procedure: execute C binding} testcbind { - setup - testcbind .b.f <1> {lappend x 1} +} -result {.t.f Button} +test bind-13.35 {Tk_BindEvent procedure: execute binding} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <1> - set x -} {1} -test bind-13.35 {Tk_BindEvent procedure: pending list marked deleted} testcbind { - setup - testcbind Test <1> {lappend x Test} {lappend x Deleted} - bind .b.f <1> {lappend x .b.f; destroy .b.f} +} -body { + bind .t.f <1> {lappend x 1} + event generate .t.f <1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-13.38 {Tk_BindEvent procedure: binding gets to run} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <1> - set y [list $x [bind Test]] - bind Test <1> {} - set y -} {.b.f <Button-1>} -test bind-13.36 {Tk_BindEvent procedure: C binding marked deleted} testcbind { - setup - testcbind Test <1> {lappend x Test} {lappend x Deleted} - bind .b.f <1> {lappend x .b.f; bind Test <1> {}; lappend x after} - set x {} - event gen .b.f <1> - set x -} {.b.f after Deleted} -test bind-13.37 {Tk_BindEvent procedure: C binding gets to run} testcbind { - setup - testcbind Test <1> {lappend x Test} - bind .b.f <1> {lappend x .b.f} - set x {} - event gen .b.f <1> +} -body { + bind Test <1> {lappend x Test} + bind .t.f <1> {lappend x .t.f} + event generate .t.f <1> + return $x +} -cleanup { + destroy .t.f bind Test <1> {} - set x -} {.b.f Test} -test bind-13.38 {Tk_BindEvent procedure: C binding deleted, refcount == 0} testcbind { - setup - testcbind .b.f <1> {lappend x hi; bind .b.f <1> {}} {lappend x bye} - set x {} - event gen .b.f <1> - set x -} {hi bye} -test bind-13.39 {Tk_BindEvent procedure: C binding deleted, refcount != 0} testcbind { - setup - testcbind .b.f <1> { - lappend x before$n - if {$n==0} { - bind .b.f <1> {} - } else { - set n [expr $n-1] - event gen .b.f <1> - } - lappend x after$n - } {lappend x Deleted} - set n 3 - set x {} - event gen .b.f <1> - set x -} {before3 before2 before1 before0 after0 after0 after0 after0 Deleted} -test bind-13.40 {Tk_BindEvent procedure: continue in script} { - setup - bind .b.f <Button-2> {lappend x b1; continue; lappend x b2} - bind Test <Button-2> {lappend x B1; continue; lappend x B2} +} -result {.t.f Test} +test bind-13.41 {Tk_BindEvent procedure: continue in script} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> +} -body { + bind .t.f <Button-2> {lappend x b1; continue; lappend x b2} + bind Test <Button-2> {lappend x B1; continue; lappend x B2} + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f bind Test <Button-2> {} - set x -} {b1 B1} -test bind-13.41 {Tk_BindEvent procedure: continue in script} testcbind { - setup - testcbind .b.f <Button-2> {lappend x b1; continue; lappend x b2} - testcbind Test <Button-2> {lappend x B1; continue; lappend x B2} +} -result {b1 B1} +test bind-13.43 {Tk_BindEvent procedure: break in script} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - bind Test <Button-2> {} - set x -} {b1 B1} -test bind-13.42 {Tk_BindEvent procedure: break in script} { - setup - bind .b.f <Button-2> {lappend x b1; break; lappend x b2} +} -body { + bind .t.f <Button-2> {lappend x b1; break; lappend x b2} bind Test <Button-2> {lappend x B1; break; lappend x B2} - set x {} - event gen .b.f <Button-2> + event generate .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f bind Test <Button-2> {} - set x -} {b1} -test bind-13.43 {Tk_BindEvent procedure: break in script} testcbind { - setup - testcbind .b.f <Button-2> {lappend x b1; break; lappend x b2} - testcbind Test <Button-2> {lappend x B1; break; lappend x B2} +} -result {b1} +test bind-13.45 {Tk_BindEvent procedure: error in script} -setup { + proc bgerror msg { + global x + lappend x $msg + } + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - bind Test <Button-2> {} - set x -} {b1} - -proc bgerror msg { - global x - lappend x $msg -} -test bind-13.44 {Tk_BindEvent procedure: error in script} { - setup - bind .b.f <Button-2> {lappend x b1; blap} +} -body { + bind .t.f <Button-2> {lappend x b1; blap} bind Test <Button-2> {lappend x B1} - set x {} - event gen .b.f <Button-2> + event generate .t.f <Button-2> update + return $x +} -cleanup { + destroy .t.f bind Test <Button-2> {} - set x -} {b1 {invalid command name "blap"}} -test bind-13.45 {Tk_BindEvent procedure: error in script} testcbind { - setup - testcbind .b.f <Button-2> {lappend x b1; blap} - testcbind Test <Button-2> {lappend x B1} - set x {} - event gen .b.f <Button-2> + proc bgerror args {} +} -result {b1 {invalid command name "blap"}} + +test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f update - bind Test <Button-2> {} - set x -} {b1 {invalid command name "blap"}} - -test bind-14.1 {TkBindDeadWindow: no C bindings pending} testcbind { - setup - bind .b.f <1> x - testcbind .b.f <2> y - destroy .b.f -} {} -test bind-14.2 {TkBindDeadWindow: is called after <Destroy>} testcbind { - setup - testcbind .b.f <Destroy> "lappend x .b.f" - testcbind Test <Destroy> "lappend x Test" - set x {} - destroy .b.f - bind Test <Destroy> {} - set x -} {.b.f Test} -test bind-14.3 {TkBindDeadWindow: pending C bindings} testcbind { - setup - bindtags .b.f {a b c d} - testcbind a <1> "lappend x a1" "lappend x bye.a1" - testcbind b <1> "destroy .b.f; lappend x b1" "lappend x bye.b1" - testcbind c <1> "lappend x c1" "lappend x bye.c1" - testcbind d <1> "lappend x d1" "lappend x bye.d1" - bind a <2> "event gen .b.f <1>" - testcbind b <2> "lappend x b2" "lappend x bye.b2" - testcbind c <2> "lappend x c2" "lappend x bye.d2" - bind d <2> "lappend x d2" - testcbind a <3> "event gen .b.f <2>" - set x {} - event gen .b.f <3> - set y $x - foreach tag {a b c d} { - foreach event {<1> <2> <3>} { - bind $tag $event {} - } - } - set y -} {a1 b1 d2} - -test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} { - setup - bind .b.f ab {set x 1} +} -body { + bind .t.f 12 {set x 1} set x 0 - event gen .b.f <Key-a> - event gen .b.f <KeyRelease-a> - event gen .b.f <Key-b> - event gen .b.f <KeyRelease-b> - set x -} 1 -test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} { - setup - bind .b.f ab {set x 1} + event generate .t.f <Key-1> + event generate .t.f <KeyRelease-1> + event generate .t.f <Key-2> + event generate .t.f <KeyRelease-2> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f 12 {set x 1} set x 0 - event gen .b.f <Key-a> - event gen .b.f <Enter> - event gen .b.f <KeyRelease-a> - event gen .b.f <Leave> - event gen .b.f <Key-b> - event gen .b.f <KeyRelease-b> - set x -} 1 -test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} { - setup - bind .b.f ab {set x 1} + event generate .t.f <Key-1> + event generate .t.f <Enter> + event generate .t.f <KeyRelease-1> + event generate .t.f <Leave> + event generate .t.f <Key-2> + event generate .t.f <KeyRelease-2> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f 12 {set x 1} set x 0 - event gen .b.f <Key-a> - event gen .b.f <Button-1> - event gen .b.f <Key-b> - set x -} 0 -test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Key-1> + event generate .t.f <Button-1> + event generate .t.f <Key-2> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - set x -} 1 -test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} { - setup - bind .b.f <Double-ButtonRelease> {set x 1} + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-ButtonRelease> {set x 1} set x 0 - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - set x -} 1 -test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-1> - event gen .b.f <Key-a> - event gen .b.f <ButtonRelease-1> - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - set x -} 0 -test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-1> + event generate .t.f <Key-a> + event generate .t.f <ButtonRelease-1> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-1> - event gen .b.f <Key-Shift_L> - event gen .b.f <ButtonRelease-1> - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - set x -} 1 -test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} { - setup - bind .b.f ab {set x 1} + event generate .t.f <Button-1> + event generate .t.f <Key-Shift_L> + event generate .t.f <ButtonRelease-1> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f ab {set x 1} set x 0 - event gen .b.f <Key-a> - event gen .b.f <Key-c> - event gen .b.f <Key-b> - set x -} 0 -test bind-15.9 {MatchPatterns procedure, modifier checks} { - setup - bind .b.f <M1-M2-Key> {set x 1} + event generate .t.f <Key-a> + event generate .t.f <Key-c> + event generate .t.f <Key-b> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.9 {MatchPatterns procedure, modifier checks} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <M1-M2-Key> {set x 1} set x 0 - event gen .b.f <Key-a> -state 0x18 - set x -} 1 -test bind-15.10 {MatchPatterns procedure, modifier checks} { - setup - bind .b.f <M1-M2-Key> {set x 1} + event generate .t.f <Key-a> -state 0x18 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.10 {MatchPatterns procedure, modifier checks} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <M1-M2-Key> {set x 1} set x 0 - event gen .b.f <Key-a> -state 0xfc - set x -} 1 -test bind-15.11 {MatchPatterns procedure, modifier checks} { - setup - bind .b.f <M1-M2-Key> {set x 1} + event generate .t.f <Key-a> -state 0xfc + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.11 {MatchPatterns procedure, modifier checks} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <M1-M2-Key> {set x 1} set x 0 - event gen .b.f <Key-a> -state 0x8 - set x -} 0 -test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} {nonPortable} { + event generate .t.f <Key-a> -state 0x8 + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} -constraints { + nonPortable +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { # This test is non-portable because the Shift_L keysym may behave # differently on some platforms. - setup - bind .b.f aB {set x 1} + bind .t.f aB {set x 1} set x 0 - event gen .b.f <Key-a> - event gen .b.f <Key-Shift_L> - event gen .b.f <Key-b> -state 1 - set x -} 1 -test bind-15.13 {MatchPatterns procedure, checking detail} { - setup - bind .b.f ab {set x 1} + event generate .t.f <Key-a> + event generate .t.f <Key-Shift_L> + event generate .t.f <Key-b> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.13 {MatchPatterns procedure, checking detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f ab {set x 1} set x 0 - event gen .b.f <Key-a> - event gen .b.f <Key-c> - set x -} 0 -test bind-15.14 {MatchPatterns procedure, checking "nearby"} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Key-a> + event generate .t.f <Key-c> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.14 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> -x 30 -y 40 - event gen .b.f <Button-1> -x 31 -y 39 - event gen .b.f <ButtonRelease-1> - set x -} 1 -test bind-15.15 {MatchPatterns procedure, checking "nearby"} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> -x 30 -y 40 + event generate .t.f <Button-1> -x 31 -y 39 + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.15 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> -x 30 -y 40 - event gen .b.f <Button-1> -x 29 -y 41 - event gen .b.f <ButtonRelease-1> - set x -} 1 -test bind-15.16 {MatchPatterns procedure, checking "nearby"} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> -x 30 -y 40 + event generate .t.f <Button-1> -x 29 -y 41 + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.16 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> -x 30 -y 40 - event gen .b.f <Button-1> -x 40 -y 40 - event gen .b.f <ButtonRelease-2> - set x -} 0 -test bind-15.17 {MatchPatterns procedure, checking "nearby"} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> -x 30 -y 40 + event generate .t.f <Button-1> -x 40 -y 40 + event generate .t.f <ButtonRelease-2> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.17 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> -x 30 -y 40 - event gen .b.f <Button-1> -x 20 -y 40 - event gen .b.f <ButtonRelease-1> - set x -} 0 -test bind-15.18 {MatchPatterns procedure, checking "nearby"} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> -x 30 -y 40 + event generate .t.f <Button-1> -x 20 -y 40 + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.18 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> -x 30 -y 40 - event gen .b.f <Button-1> -x 30 -y 30 - event gen .b.f <ButtonRelease-1> - set x -} 0 -test bind-15.19 {MatchPatterns procedure, checking "nearby"} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> -x 30 -y 40 + event generate .t.f <Button-1> -x 30 -y 30 + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.19 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> -x 30 -y 40 - event gen .b.f <Button-1> -x 30 -y 50 - event gen .b.f <ButtonRelease-1> - set x -} 0 -test bind-15.20 {MatchPatterns procedure, checking "nearby"} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> -x 30 -y 40 + event generate .t.f <Button-1> -x 30 -y 50 + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.20 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> -time 300 - event gen .b.f <Button-1> -time 700 - event gen .b.f <ButtonRelease-1> - set x -} 1 -test bind-15.21 {MatchPatterns procedure, checking "nearby"} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> -time 300 + event generate .t.f <Button-1> -time 700 + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.21 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> -time 300 - event gen .b.f <Button-1> -time 900 - event gen .b.f <ButtonRelease-1> - set x -} 0 -test bind-15.22 {MatchPatterns procedure, time wrap-around} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> -time 300 + event generate .t.f <Button-1> -time 900 + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.22 {MatchPatterns procedure, time wrap-around} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-1> -time [expr -100] - event gen .b.f <Button-1> -time 200 - event gen .b.f <ButtonRelease-1> - set x -} 1 -test bind-15.23 {MatchPatterns procedure, time wrap-around} { - setup - bind .b.f <Double-1> {set x 1} + event generate .t.f <Button-1> -time [expr -100] + event generate .t.f <Button-1> -time 200 + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.23 {MatchPatterns procedure, time wrap-around} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Double-1> {set x 1} set x 0 - event gen .b.f <Button-1> -time -100 - event gen .b.f <Button-1> -time 500 - event gen .b.f <ButtonRelease-1> - set x -} 0 -test bind-15.24 {MatchPatterns procedure, virtual event} { - setup - event add <<Paste>> <Button-1> - bind .b.f <<Paste>> {lappend x paste} + event generate .t.f <Button-1> -time -100 + event generate .t.f <Button-1> -time 500 + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} + +test bind-15.24 {MatchPatterns procedure, virtual event} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> +} -body { + event add <<Paste>> <Button-1> + bind .t.f <<Paste>> {lappend x paste} + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> set x -} {paste} -test bind-15.25 {MatchPatterns procedure, reject a virtual event} { - setup - event add <<Paste>> <Shift-Button-1> - bind .b.f <<Paste>> {lappend x paste} +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-1> +} -result {paste} +test bind-15.25 {MatchPatterns procedure, reject a virtual event} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> +} -body { + event add <<Paste>> <Shift-Button-1> + bind .t.f <<Paste>> {lappend x paste} + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> set x -} {} -test bind-15.26 {MatchPatterns procedure, reject a virtual event} { - setup +} -cleanup { + destroy .t.f + event delete <<Paste>> <Shift-Button-1> +} -result {} +test bind-15.26 {MatchPatterns procedure, reject a virtual event} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { event add <<V1>> <Button> event add <<V2>> <Button-1> event add <<V3>> <Shift-Button-1> - bind .b.f <<V2>> "lappend x V2%#" - set x {} - event gen .b.f <Button> -serial 101 - event gen .b.f <Button-1> -serial 102 - event gen .b.f <Shift-Button-1> -serial 103 - event gen .b.f <ButtonRelease-1> - bind .b.f <Shift-Button-1> "lappend x Shift-Button-1" - event gen .b.f <Button> -serial 104 - event gen .b.f <Button-1> -serial 105 - event gen .b.f <Shift-Button-1> -serial 106 - event gen .b.f <ButtonRelease-1> - set x -} {V2102 V2103 V2105 Shift-Button-1} -test bind-15.27 {MatchPatterns procedure, conflict resolution} { - setup - bind .b.f <KeyPress> {set x 0} - bind .b.f a {set x 1} - set x none - event gen .b.f <Key-a> + bind .t.f <<V2>> "lappend x V2%#" + event generate .t.f <Button> -serial 101 + event generate .t.f <Button-1> -serial 102 + event generate .t.f <Shift-Button-1> -serial 103 + event generate .t.f <ButtonRelease-1> + bind .t.f <Shift-Button-1> "lappend x Shift-Button-1" + event generate .t.f <Button> -serial 104 + event generate .t.f <Button-1> -serial 105 + event generate .t.f <Shift-Button-1> -serial 106 + event generate .t.f <ButtonRelease-1> set x -} 1 -test bind-15.28 {MatchPatterns procedure, conflict resolution} { - setup - bind .b.f <KeyPress> {set x 0} - bind .b.f a {set x 1} - set x none - event gen .b.f <Key-b> - set x -} 0 -test bind-15.29 {MatchPatterns procedure, conflict resolution} { - setup - bind .b.f <KeyPress> {lappend x 0} - bind .b.f a {lappend x 1} - bind .b.f ba {lappend x 2} +} -cleanup { + destroy .t.f + event delete <<V1>> <Button> + event delete <<V2>> <Button-1> + event delete <<V3>> <Shift-Button-1> +} -result {V2102 V2103 V2105 Shift-Button-1} +test bind-15.27 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyPress> {set x 0} + bind .t.f 1 {set x 1} set x none - event gen .b.f <Key-b> - event gen .b.f <KeyRelease-b> - event gen .b.f <Key-a> - set x -} {none 0 2} -test bind-15.30 {MatchPatterns procedure, conflict resolution} { - setup - bind .b.f <ButtonPress> {set x 0} - bind .b.f <1> {set x 1} + event generate .t.f <Key-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.28 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyPress> {set x 0} + bind .t.f 1 {set x 1} set x none - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - set x -} 1 -test bind-15.31 {MatchPatterns procedure, conflict resolution} { - setup - bind .b.f <M1-Key> {set x 0} - bind .b.f <M2-Key> {set x 1} + event generate .t.f <Key-2> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.29 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyPress> {lappend x 0} + bind .t.f 1 {lappend x 1} + bind .t.f 21 {lappend x 2} set x none - event gen .b.f <Key-a> -state 0x18 + event generate .t.f <Key-2> + event generate .t.f <KeyRelease-2> + event generate .t.f <Key-1> set x -} 1 -test bind-15.32 {MatchPatterns procedure, conflict resolution} { - setup - bind .b.f <M2-Key> {set x 0} - bind .b.f <M1-Key> {set x 1} +} -cleanup { + destroy .t.f +} -result {none 0 2} +test bind-15.30 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <ButtonPress> {set x 0} + bind .t.f <1> {set x 1} set x none - event gen .b.f <Key-a> -state 0x18 - set x -} 1 -test bind-15.33 {MatchPatterns procedure, conflict resolution} { - setup - bind .b.f <1> {lappend x single} + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.31 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <M1-Key> {set x 0} + bind .t.f <M2-Key> {set x 1} + event generate .t.f <Key-a> -state 0x18 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.32 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <M2-Key> {set x 0} + bind .t.f <M1-Key> {set x 1} + set x none + event generate .t.f <Key-a> -state 0x18 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <1> {lappend x single} bind Test <1> {lappend x single(Test)} bind Test <Double-1> {lappend x double(Test)} - set x {} - event gen .b.f <Button-1> - event gen .b.f <Button-1> - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> set x -} {single single(Test) single double(Test) single double(Test)} -foreach i [bind Test] { - bind Test $i {} -} -test bind-16.1 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x abcd} +} -cleanup { + destroy .t.f + bind Test <1> {} + bind Test <Double-1> {} +} -result {single single(Test) single double(Test) single double(Test)} + + +test bind-16.1 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x abcd} set x none - event gen .b.f <Enter> + event generate .t.f <Enter> set x -} abcd -test bind-16.2 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %#} +} -cleanup { + destroy .t.f +} -result {abcd} +test bind-16.2 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %#} set x none - event gen .b.f <Enter> -serial 1234 + event generate .t.f <Enter> -serial 1234 set x -} 1234 -test bind-16.3 {ExpandPercents procedure} { - setup - bind .b.f <Configure> {set x %a} +} -cleanup { + destroy .t.f +} -result {1234} +test bind-16.3 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Configure> {set x %a} set x none - event gen .b.f <Configure> -above .b -window .b.f + event generate .t.f <Configure> -above .t -window .t.f set x -} [winfo id .b] -test bind-16.4 {ExpandPercents procedure} { - setup - bind .b.f <Button> {set x %b} +} -cleanup { + destroy .t.f +} -result [winfo id .t] +test bind-16.4 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {set x %b} set x none - event gen .b.f <Button-3> - event gen .b.f <ButtonRelease-3> + event generate .t.f <Button-3> + event generate .t.f <ButtonRelease-3> set x -} 3 -test bind-16.5 {ExpandPercents procedure} { - setup - bind .b.f <Expose> {set x %c} +} -cleanup { + destroy .t.f +} -result {3} +test bind-16.5 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Expose> {set x %c} set x none - event gen .b.f <Expose> -count 47 + event generate .t.f <Expose> -count 47 set x -} 47 -test bind-16.6 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {47} +test bind-16.6 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyAncestor + event generate .t.f <Enter> -detail NotifyAncestor set x -} NotifyAncestor -test bind-16.7 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyAncestor} +test bind-16.7 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyVirtual + event generate .t.f <Enter> -detail NotifyVirtual set x -} NotifyVirtual -test bind-16.8 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyVirtual} +test bind-16.8 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyNonlinear + event generate .t.f <Enter> -detail NotifyNonlinear set x -} NotifyNonlinear -test bind-16.9 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyNonlinear} +test bind-16.9 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyNonlinearVirtual + event generate .t.f <Enter> -detail NotifyNonlinearVirtual set x -} NotifyNonlinearVirtual -test bind-16.10 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyNonlinearVirtual} +test bind-16.10 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyPointer + event generate .t.f <Enter> -detail NotifyPointer set x -} NotifyPointer -test bind-16.11 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyPointer} +test bind-16.11 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyPointerRoot + event generate .t.f <Enter> -detail NotifyPointerRoot set x -} NotifyPointerRoot -test bind-16.12 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyPointerRoot} +test bind-16.12 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyDetailNone + event generate .t.f <Enter> -detail NotifyDetailNone set x -} NotifyDetailNone -test bind-16.13 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %f} +} -cleanup { + destroy .t.f +} -result {NotifyDetailNone} +test bind-16.13 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %f} set x none - event gen .b.f <Enter> -focus 1 - set x -} 1 -test bind-16.14 {ExpandPercents procedure} { - setup - bind .b.f <Expose> {set x "%x %y %w %h"} + event generate .t.f <Enter> -focus 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.14 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Expose> {set x "%x %y %w %h"} set x none - event gen .b.f <Expose> -x 24 -y 18 -width 147 -height 61 + event generate .t.f <Expose> -x 24 -y 18 -width 147 -height 61 set x -} {24 18 147 61} -test bind-16.15 {ExpandPercents procedure} { - setup - bind .b.f <Configure> {set x "%x %y %w %h"} +} -cleanup { + destroy .t.f +} -result {24 18 147 61} +test bind-16.15 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Configure> {set x "%x %y %w %h"} set x none - event gen .b.f <Configure> -x 24 -y 18 -width 147 -height 61 -window .b.f + event generate .t.f <Configure> -x 24 -y 18 -width 147 -height 61 -window .t.f set x -} {24 18 147 61} -test bind-16.16 {ExpandPercents procedure} { - setup - bind .b.f <Key> {set x "%k"} +} -cleanup { + destroy .t.f +} -result {24 18 147 61} +test bind-16.16 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> {set x "%k"} set x none - event gen .b.f <Key> -keycode 146 + event generate .t.f <Key> -keycode 146 set x -} 146 -test bind-16.17 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%m"} +} -cleanup { + destroy .t.f +} -result {146} +test bind-16.17 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%m"} set x none - event gen .b.f <Enter> -mode NotifyNormal + event generate .t.f <Enter> -mode NotifyNormal set x -} NotifyNormal -test bind-16.18 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%m"} +} -cleanup { + destroy .t.f +} -result {NotifyNormal} +test bind-16.18 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%m"} set x none - event gen .b.f <Enter> -mode NotifyGrab + event generate .t.f <Enter> -mode NotifyGrab set x -} NotifyGrab -test bind-16.19 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%m"} +} -cleanup { + destroy .t.f +} -result {NotifyGrab} +test bind-16.19 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%m"} set x none - event gen .b.f <Enter> -mode NotifyUngrab + event generate .t.f <Enter> -mode NotifyUngrab set x -} NotifyUngrab -test bind-16.20 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%m"} +} -cleanup { + destroy .t.f +} -result {NotifyUngrab} +test bind-16.20 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> {set x "%m"} set x none - event gen .b.f <Enter> -mode NotifyWhileGrabbed + event generate .t.f <Enter> -mode NotifyWhileGrabbed set x -} NotifyWhileGrabbed -test bind-16.21 {ExpandPercents procedure} { - setup - bind .b.f <Map> {set x "%o"} +} -cleanup { + destroy .t.f +} -result {NotifyWhileGrabbed} +test bind-16.21 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Map> {set x "%o"} set x none - event gen .b.f <Map> -override 1 -window .b.f - set x -} 1 -test bind-16.22 {ExpandPercents procedure} { - setup - bind .b.f <Reparent> {set x "%o"} + event generate .t.f <Map> -override 1 -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.22 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Reparent> {set x "%o"} set x none - event gen .b.f <Reparent> -override true -window .b.f - set x -} 1 -test bind-16.23 {ExpandPercents procedure} { - setup - bind .b.f <Configure> {set x "%o"} + event generate .t.f <Reparent> -override true -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.23 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Configure> {set x "%o"} set x none - event gen .b.f <Configure> -override 1 -window .b.f - set x -} 1 -test bind-16.24 {ExpandPercents procedure} { - setup - bind .b.f <Circulate> {set x "%p"} + event generate .t.f <Configure> -override 1 -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.24 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Circulate> {set x "%p"} set x none - event gen .b.f <Circulate> -place PlaceOnTop -window .b.f + event generate .t.f <Circulate> -place PlaceOnTop -window .t.f set x -} PlaceOnTop -test bind-16.25 {ExpandPercents procedure} { - setup - bind .b.f <Circulate> {set x "%p"} +} -cleanup { + destroy .t.f +} -result {PlaceOnTop} +test bind-16.25 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Circulate> {set x "%p"} set x none - event gen .b.f <Circulate> -place PlaceOnBottom -window .b.f + event generate .t.f <Circulate> -place PlaceOnBottom -window .t.f set x -} PlaceOnBottom -test bind-16.26 {ExpandPercents procedure} { - setup - bind .b.f <1> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {PlaceOnBottom} +test bind-16.26 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <1> {set x "%s"} set x none - event gen .b.f <Button-1> -state 1402 - event gen .b.f <ButtonRelease-1> + event generate .t.f <Button-1> -state 1402 + event generate .t.f <ButtonRelease-1> set x -} 1402 -test bind-16.27 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {1402} +test bind-16.27 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%s"} set x none - event gen .b.f <Enter> -state 0x3ff + event generate .t.f <Enter> -state 0x3ff set x -} 1023 -test bind-16.28 {ExpandPercents procedure} { - setup - bind .b.f <Visibility> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {1023} +test bind-16.28 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Visibility> {set x "%s"} set x none - event gen .b.f <Visibility> -state VisibilityPartiallyObscured + event generate .t.f <Visibility> -state VisibilityPartiallyObscured set x -} VisibilityPartiallyObscured -test bind-16.29 {ExpandPercents procedure} { - setup - bind .b.f <Visibility> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {VisibilityPartiallyObscured} +test bind-16.29 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Visibility> {set x "%s"} set x none - event gen .b.f <Visibility> -state VisibilityUnobscured + event generate .t.f <Visibility> -state VisibilityUnobscured set x -} VisibilityUnobscured -test bind-16.30 {ExpandPercents procedure} { - setup - bind .b.f <Visibility> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {VisibilityUnobscured} +test bind-16.30 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Visibility> {set x "%s"} set x none - event gen .b.f <Visibility> -state VisibilityFullyObscured + event generate .t.f <Visibility> -state VisibilityFullyObscured set x -} VisibilityFullyObscured -test bind-16.31 {ExpandPercents procedure} { - setup - bind .b.f <Button> {set x "%t"} +} -cleanup { + destroy .t.f +} -result {VisibilityFullyObscured} +test bind-16.31 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {set x "%t"} set x none - event gen .b.f <Button> -time 4294 - event gen .b.f <ButtonRelease> + event generate .t.f <Button> -time 4294 + event generate .t.f <ButtonRelease> set x -} 4294 -test bind-16.32 {ExpandPercents procedure} { - setup - bind .b.f <Button> {set x "%x %y"} +} -cleanup { + destroy .t.f +} -result {4294} +test bind-16.32 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {set x "%x %y"} set x none - event gen .b.f <Button> -x 881 -y 432 - event gen .b.f <ButtonRelease> + event generate .t.f <Button> -x 881 -y 432 + event generate .t.f <ButtonRelease> set x -} {881 432} -test bind-16.33 {ExpandPercents procedure} { - setup - bind .b.f <Reparent> {set x "%x %y"} +} -cleanup { + destroy .t.f +} -result {881 432} +test bind-16.33 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Reparent> {set x "%x %y"} set x none - event gen .b.f <Reparent> -x 882 -y 431 -window .b.f + event generate .t.f <Reparent> -x 882 -y 431 -window .t.f set x -} {882 431} -test bind-16.34 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%x %y"} +} -cleanup { + destroy .t.f +} -result {882 431} +test bind-16.34 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%x %y"} set x none - event gen .b.f <Enter> -x 781 -y 632 - set x -} {781 632} -test bind-16.35 {ExpandPercents procedure} {nonPortable} { - setup - bind .b.f <Key> {lappend x "%A"} - set x {} - event gen .b.f <Key-a> - event gen .b.f <Key-A> -state 1 - event gen .b.f <Key-Tab> - event gen .b.f <Key-Return> - event gen .b.f <Key-F1> - event gen .b.f <Key-Shift_L> - event gen .b.f <Key-space> - event gen .b.f <Key-dollar> -state 1 - event gen .b.f <Key-braceleft> -state 1 - event gen .b.f <Key-Multi_key> - event gen .b.f <Key-e> - event gen .b.f <Key-apostrophe> - set x -} "a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9" -test bind-16.36 {ExpandPercents procedure} { - setup - bind .b.f <Configure> {set x "%B"} + event generate .t.f <Enter> -x 781 -y 632 + set x +} -cleanup { + destroy .t.f +} -result {781 632} +test bind-16.35 {ExpandPercents procedure} -constraints { + nonPortable +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> {lappend x "%A"} + event generate .t.f <Key-a> + event generate .t.f <Key-A> -state 1 + event generate .t.f <Key-Tab> + event generate .t.f <Key-Return> + event generate .t.f <Key-F1> + event generate .t.f <Key-Shift_L> + event generate .t.f <Key-space> + event generate .t.f <Key-dollar> -state 1 + event generate .t.f <Key-braceleft> -state 1 + event generate .t.f <Key-Multi_key> + event generate .t.f <Key-e> + event generate .t.f <Key-apostrophe> + set x +} -cleanup { + destroy .t.f +} -result {a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9} +test bind-16.36 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Configure> {set x "%B"} set x none - event gen .b.f <Configure> -borderwidth 24 -window .b.f + event generate .t.f <Configure> -borderwidth 24 -window .t.f set x -} 24 -test bind-16.37 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%E"} +} -cleanup { + destroy .t.f +} -result {24} +test bind-16.37 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%E"} set x none - event gen .b.f <Enter> -sendevent 1 - set x -} 1 -test bind-16.38 {ExpandPercents procedure} {nonPortable} { - setup - bind .b.f <Key> {lappend x %K} - set x {} - event gen .b.f <Key-a> - event gen .b.f <Key-A> -state 1 - event gen .b.f <Key-Tab> - event gen .b.f <Key-F1> - event gen .b.f <Key-Shift_L> - event gen .b.f <Key-space> - event gen .b.f <Key-dollar> -state 1 - event gen .b.f <Key-braceleft> -state 1 - set x -} {a A Tab F1 Shift_L space dollar braceleft} -test bind-16.39 {ExpandPercents procedure} { - setup - bind .b.f <Key> {set x "%N"} + event generate .t.f <Enter> -sendevent 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.38 {ExpandPercents procedure} -constraints { + nonPortable +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> {lappend x %K} + event generate .t.f <Key-a> + event generate .t.f <Key-A> -state 1 + event generate .t.f <Key-Tab> + event generate .t.f <Key-F1> + event generate .t.f <Key-Shift_L> + event generate .t.f <Key-space> + event generate .t.f <Key-dollar> -state 1 + event generate .t.f <Key-braceleft> -state 1 + set x +} -cleanup { + destroy .t.f +} -result {a A Tab F1 Shift_L space dollar braceleft} +test bind-16.39 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> {set x "%N"} set x none - event gen .b.f <Key-a> + event generate .t.f <Key-space> set x -} 97 -test bind-16.40 {ExpandPercents procedure} { - setup - bind .b.f <Key> {set x "%S"} +} -cleanup { + destroy .t.f +} -result {32} +test bind-16.40 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> {set x "%S"} set x none - event gen .b.f <Key-a> -subwindow .b + event generate .t.f <Key-space> -subwindow .t set x -} [winfo id .b] -test bind-16.41 {ExpandPercents procedure} { - setup - bind .b.f <Key> {set x "%T"} +} -cleanup { + destroy .t.f +} -result [winfo id .t] +test bind-16.41 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> {set x "%T"} set x none - event gen .b.f <Key> + event generate .t.f <Key> set x -} 2 -test bind-16.42 {ExpandPercents procedure} { - setup - bind .b.f <Key> {set x "%W"} +} -cleanup { + destroy .t.f +} -result {2} +test bind-16.42 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> {set x "%W"} set x none - event gen .b.f <Key> + event generate .t.f <Key> set x -} .b.f -test bind-16.43 {ExpandPercents procedure} { - setup - bind .b.f <Button> {set x "%X %Y"} +} -cleanup { + destroy .t.f +} -result {.t.f} +test bind-16.43 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {set x "%X %Y"} set x none - event gen .b.f <Button> -rootx 422 -rooty 13 - event gen .b.f <ButtonRelease> + event generate .t.f <Button> -rootx 422 -rooty 13 + event generate .t.f <ButtonRelease> set x -} {422 13} -test bind-16.44 {ExpandPercents procedure} { - setup - bind .b.f <Gravity> {set x "%R %S"} +} -cleanup { + destroy .t.f +} -result {422 13} +test bind-16.44 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Gravity> {set x "%R %S"} set x none - event gen .b.f <Gravity> + event generate .t.f <Gravity> set x -} {?? ??} +} -cleanup { + destroy .t.f +} -result {?? ??} + test bind-16.45 {ExpandPercents procedure} -setup { set savedBind(Entry) [bind Entry <Key>] set savedBind(All) [bind all <Key>] - - setup2 - - bind .b.e <Key> {set x "%M"} + entry .t.e + pack .t.e + focus -force .t.e + foreach p [event info] {event delete $p} + update +} -body { + bind .t.e <Key> {set x "%M"} bind Entry <Key> {set y "%M"} bind all <Key> {set z "%M"} -} -body { set x none; set y none; set z none - event gen .b.e <Key-a> + event gen .t.e <Key-a> list $x $y $z } -cleanup { + destroy .t.e bind all <Key> $savedBind(All) bind Entry <Key> $savedBind(Entry) unset savedBind } -result {0 1 2} test bind-16.46 {ExpandPercents procedure} -setup { - set savedBind(Entry) [bind Entry <Key>] set savedBind(All) [bind all <Key>] - - setup2 - + set savedBind(Entry) [bind Entry <Key>] + entry .t.e + pack .t.e + focus -force .t.e + foreach p [event info] {event delete $p} + update +} -body { bind all <Key> {set z "%M"} bind Entry <Key> {set y "%M"} - bind .b.e <Key> {set x "%M"} -} -body { + bind .t.e <Key> {set x "%M"} set x none; set y none; set z none - event gen .b.e <Key-a> + event gen .t.e <Key-a> list $x $y $z } -cleanup { + destroy .t.e bind Entry <Key> $savedBind(Entry) bind all <Key> $savedBind(All) unset savedBind } -result {0 1 2} - -test bind-17.1 {event command} { - list [catch {event} msg] $msg -} {1 {wrong # args: should be "event option ?arg?"}} -test bind-17.2 {event command} { - list [catch {event xyz} msg] $msg -} {1 {bad option "xyz": must be add, delete, generate, or info}} -test bind-17.3 {event command: add} { - list [catch {event add} msg] $msg -} {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}} -test bind-17.4 {event command: add 1} { - setup +test bind-17.1 {event command} -body { + event +} -returnCodes error -result {wrong # args: should be "event option ?arg?"} +test bind-17.2 {event command} -body { + event xyz +} -returnCodes error -result {bad option "xyz": must be add, delete, generate, or info} +test bind-17.3 {event command: add} -body { + event add +} -returnCodes error -result {wrong # args: should be "event add virtual sequence ?sequence ...?"} +test bind-17.4 {event command: add 1} -body { + event delete <<Paste>> event add <<Paste>> <Control-v> event info <<Paste>> -} {<Control-Key-v>} -test bind-17.5 {event command: add 2} { - setup +} -cleanup { + event delete <<Paste>> <Control-v> +} -result {<Control-Key-v>} +test bind-17.5 {event command: add 2} -body { + event delete <<Paste>> event add <<Paste>> <Control-v> <Button-2> lsort [event info <<Paste>>] -} {<Button-2> <Control-Key-v>} -test bind-17.6 {event command: add with error} { - setup - list [catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>} \ - msg] $msg [lsort [event info <<Paste>>]] -} {1 {bad event type or keysym "xyz"} {<Button-2> <Control-Key-v> abc}} -test bind-17.7 {event command: delete} { - list [catch {event delete} msg] $msg -} {1 {wrong # args: should be "event delete virtual ?sequence sequence ...?"}} -test bind-17.8 {event command: delete many} { - setup +} -cleanup { + event delete <<Paste>> <Control-v> <Button-2> +} -result {<Button-2> <Control-Key-v>} + +test bind-17.6 {event command: add with error} -body { + event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1> +} -cleanup { + event delete <<Paste>> +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-17.7 {event command: add with error} -body { + event delete <<Paste>> + catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>} + lsort [event info <<Paste>>] +} -cleanup { + event delete <<Paste>> +} -result {<Button-2> <Control-Key-v> abc} + +test bind-17.8 {event command: delete} -body { + event delete +} -returnCodes error -result {wrong # args: should be "event delete virtual ?sequence ...?"} +test bind-17.9 {event command: delete many} -body { + event delete <<Paste>> event add <<Paste>> <3> <1> <2> t event delete <<Paste>> <1> <2> lsort [event info <<Paste>>] -} {<Button-3> t} -test bind-17.9 {event command: delete all} { - setup +} -cleanup { + event delete <<Paste>> <3> t +} -result {<Button-3> t} +test bind-17.10 {event command: delete all} -body { event add <<Paste>> a b event delete <<Paste>> event info <<Paste>> -} {} -test bind-17.10 {event command: delete 1} { - setup +} -cleanup { + event delete <<Paste>> a b +} -result {} +test bind-17.11 {event command: delete 1} -body { + event delete <<Paste>> event add <<Paste>> a b c event delete <<Paste>> b lsort [event info <<Paste>>] -} {a c} -test bind-17.11 {event command: info name} { - setup +} -cleanup { + event delete <<Paste>> +} -result {a c} +test bind-17.12 {event command: info name} -body { + event delete <<Paste>> event add <<Paste>> a b c lsort [event info <<Paste>>] -} {a b c} -test bind-17.12 {event command: info all} { - setup +} -cleanup { + event delete <<Paste>> +} -result {a b c} +test bind-17.13 {event command: info all} -body { + foreach p [event info] {event delete $p} event add <<Paste>> a event add <<Alive>> b lsort [event info] -} {<<Alive>> <<Paste>>} -test bind-17.13 {event command: info error} { - list [catch {event info <<Paste>> <Control-v>} msg] $msg -} {1 {wrong # args: should be "event info ?virtual?"}} -test bind-17.14 {event command: generate} { - list [catch {event generate} msg] $msg -} {1 {wrong # args: should be "event generate window event ?options?"}} -test bind-17.15 {event command: generate} { - setup - bind .b.f <1> "lappend x 1" - set x {} - event generate .b.f <1> - set x -} {1} -test bind-17.16 {event command: generate} { - list [catch {event generate .b.f <xyz>} msg] $msg -} {1 {bad event type or keysym "xyz"}} -test bind-17.17 {event command} { - list [catch {event foo} msg] $msg -} {1 {bad option "foo": must be add, delete, generate, or info}} - -test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} { - list [catch {event add asd <Ctrl-v>} msg] $msg -} {1 {virtual event "asd" is badly formed}} -test bind-18.2 {CreateVirtualEvent procedure: FindSequence} { - list [catch {event add <<asd>> <Ctrl-v>} msg] $msg -} {1 {bad event type or keysym "Ctrl"}} -test bind-18.3 {CreateVirtualEvent procedure: new physical} { - setup +} -cleanup { + event delete <<Paste>> + event delete <<Alive>> +} -result {<<Alive>> <<Paste>>} + +test bind-17.14 {event command: info error} -body { + event info <<Paste>> <Control-v> +} -returnCodes error -result {wrong # args: should be "event info ?virtual?"} +test bind-17.15 {event command: generate} -body { + event generate +} -returnCodes error -result {wrong # args: should be "event generate window event ?-option value ...?"} + +test bind-17.16 {event command: generate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <1> "lappend x 1" + event generate .t.f <1> + set x +} -cleanup { + destroy .t.f +} -result {1} +test bind-17.17 {event command: generate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + event generate .t.f <xyz> +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-17.18 {event command} -body { + event foo +} -returnCodes error -result {bad option "foo": must be add, delete, generate, or info} + + +test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} -body { + event add asd <Ctrl-v> +} -returnCodes error -result {virtual event "asd" is badly formed} +test bind-18.2 {CreateVirtualEvent procedure: FindSequence} -body { + event add <<asd>> <Ctrl-v> +} -returnCodes error -result {bad event type or keysym "Ctrl"} +test bind-18.3 {CreateVirtualEvent procedure: new physical} -body { + event delete <<xyz>> event add <<xyz>> <Control-v> event info <<xyz>> -} {<Control-Key-v>} -test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} { - setup +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v>} +test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} -body { + event delete <<xyz>> event add <<xyz>> <Control-v> event add <<xyz>> <Control-v> event info <<xyz>> -} {<Control-Key-v>} -test bind-18.5 {CreateVirtualEvent procedure: existing physical} { - setup +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v>} +test bind-18.5 {CreateVirtualEvent procedure: existing physical} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event add <<abc>> <Control-v> list [lsort [event info]] [event info <<xyz>>] [event info <<abc>>] -} {{<<abc>> <<xyz>>} <Control-Key-v> <Control-Key-v>} -test bind-18.6 {CreateVirtualEvent procedure: new virtual} { - setup +} -cleanup { + event delete <<xyz>> + event delete <<abc>> +} -result {{<<abc>> <<xyz>>} <Control-Key-v> <Control-Key-v>} +test bind-18.6 {CreateVirtualEvent procedure: new virtual} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> list [event info] [event info <<xyz>>] -} {<<xyz>> <Control-Key-v>} -test bind-18.7 {CreateVirtualEvent procedure: existing virtual} { - setup +} -cleanup { + event delete <<abc>> +} -result {<<xyz>> <Control-Key-v>} +test bind-18.7 {CreateVirtualEvent procedure: existing virtual} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event add <<xyz>> <Button-2> list [event info] [lsort [event info <<xyz>>]] -} {<<xyz>> {<Button-2> <Control-Key-v>}} +} -cleanup { + event delete <<xyz>> +} -result {<<xyz>> {<Button-2> <Control-Key-v>}} -test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} { - list [catch {event add xyz {}} msg] $msg -} {1 {virtual event "xyz" is badly formed}} -test bind-19.2 {DeleteVirtualEvent procedure: non-existent virtual} { - setup +test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} -body { + event add xyz {} +} -returnCodes error -result {virtual event "xyz" is badly formed} +test bind-19.2 {DeleteVirtualEvent procedure: non-existent virtual} -setup { + foreach p [event info] {event delete $p} +} -body { event delete <<xyz>> event info -} {} -test bind-19.3 {DeleteVirtualEvent procedure: delete 1} { - setup +} -result {} +test bind-19.3 {DeleteVirtualEvent procedure: delete 1} -setup { + event delete <<xyz>> +} -body { event add <<xyz>> <Control-v> event delete <<xyz>> <Control-v> event info <<xyz>> -} {} -test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} { - setup +} -result {} +test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} -setup { + event delete <<xyz>> +} -body { event add <<xyz>> <Control-v> event delete <<xyz>> <Button-1> event info <<xyz>> -} {<Control-Key-v>} -test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} { - setup +} -result {<Control-Key-v>} +test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} -body { event add <<xyz>> <Control-v> - list [catch {event delete <<xyz>> <xyz>} msg] $msg -} {1 {bad event type or keysym "xyz"}} -test bind-19.6 {DeleteVirtualEvent procedure: delete 1, badly formed} { - setup + event delete <<xyz>> <xyz> +} -cleanup { + event delete <<xyz>> +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-19.6 {DeleteVirtualEvent procedure: delete 1, badly formed} -body { event add <<xyz>> <Control-v> - list [catch {event delete <<xyz>> <<Paste>>} msg] $msg -} {1 {virtual event not allowed in definition of another virtual event}} -test bind-19.7 {DeleteVirtualEvent procedure: owns 1, delete all} { - setup + event delete <<xyz>> <<Paste>> +} -cleanup { + event delete <<xyz>> +} -returnCodes error -result {virtual event not allowed in definition of another virtual event} +test bind-19.7 {DeleteVirtualEvent procedure: owns 1, delete all} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event delete <<xyz>> event info -} {} -test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} { - setup +} -result {} +test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event delete <<xyz>> <Control-v> event info -} {} -test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} { - setup +} -result {} +test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> <Control-w> <Control-x> event delete <<xyz>> event info -} {} -test bind-19.10 {DeleteVirtualEvent procedure: owns many, delete 1} { - setup +} -result {} +test bind-19.10 {DeleteVirtualEvent procedure: owns many, delete 1} -body { + event delete <<xyz>> event add <<xyz>> <Control-v> <Control-w> <Control-x> event delete <<xyz>> <Control-w> lsort [event info <<xyz>>] -} {<Control-Key-v> <Control-Key-x>} -test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} { - setup - event add <<xyz>> <Button-2> - bind .b.f <<xyz>> {lappend x %#} +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v> <Control-Key-x>} +test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> -serial 101 - event gen .b.f <ButtonRelease-2> event delete <<xyz>> - event gen .b.f <Button-2> -serial 102 - event gen .b.f <ButtonRelease-2> +} -body { + event add <<xyz>> <Button-2> + bind .t.f <<xyz>> {lappend x %#} + event generate .t.f <Button-2> -serial 101 + event generate .t.f <ButtonRelease-2> + event delete <<xyz>> + event generate .t.f <Button-2> -serial 102 + event generate .t.f <ButtonRelease-2> set x -} {101} -test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} { - setup +} -cleanup { + destroy .t.f +} -result {101} +test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} + event delete <<xyz>> + event delete <<abc>> +} -body { event add <<abc>> <Control-Button-2> event add <<xyz>> <Button-2> - bind .b.f <<xyz>> {lappend x xyz} - bind .b.f <<abc>> {lappend x abc} - set x {} - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Control-Button-2> - event gen .b.f <Control-ButtonRelease-2> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.f <<abc>> {lappend x abc} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Control-Button-2> + event generate .t.f <Control-ButtonRelease-2> event delete <<xyz>> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Control-Button-2> - event gen .b.f <Control-ButtonRelease-2> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Control-Button-2> + event generate .t.f <Control-ButtonRelease-2> list $x [event info <<abc>>] -} {{xyz abc abc} <Control-Button-2>} -test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} { - setup +} -cleanup { + destroy .t.f + event delete <<abc>> +} -result {{xyz abc abc} <Control-Button-2>} +test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { event add <<def>> <Shift-Button-2> event add <<xyz>> <Button-2> event add <<abc>> <Control-Button-2> - bind .b.f <<xyz>> {lappend x xyz} - bind .b.f <<abc>> {lappend x abc} - bind .b.f <<def>> {lappend x def} - set x {} - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Control-Button-2> - event gen .b.f <Control-ButtonRelease-2> - event gen .b.f <Shift-Button-2> - event gen .b.f <Shift-ButtonRelease-2> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.f <<abc>> {lappend x abc} + bind .t.f <<def>> {lappend x def} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Control-Button-2> + event generate .t.f <Control-ButtonRelease-2> + event generate .t.f <Shift-Button-2> + event generate .t.f <Shift-ButtonRelease-2> event delete <<xyz>> - event gen .b.f <Button-2> - event gen .b.f <Control-Button-2> - event gen .b.f <Shift-Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Control-ButtonRelease-2> - event gen .b.f <Shift-ButtonRelease-2> + event generate .t.f <Button-2> + event generate .t.f <Control-Button-2> + event generate .t.f <Shift-Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Control-ButtonRelease-2> + event generate .t.f <Shift-ButtonRelease-2> list $x [event info <<def>>] [event info <<xyz>>] [event info <<abc>>] -} {{xyz abc def abc def} <Shift-Button-2> {} <Control-Button-2>} -test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} { - setup +} -cleanup { + destroy .t.f + event delete <<abc>> + event delete <<def>> +} -result {{xyz abc def abc def} <Shift-Button-2> {} <Control-Button-2>} +test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { event add <<xyz>> <Button-2> event add <<abc>> <Control-Button-2> event add <<def>> <Shift-Button-2> - bind .b.f <<xyz>> {lappend x xyz} - bind .b.f <<abc>> {lappend x abc} - bind .b.f <<def>> {lappend x def} - set x {} - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Control-Button-2> - event gen .b.f <Control-ButtonRelease-2> - event gen .b.f <Shift-Button-2> - event gen .b.f <Shift-ButtonRelease-2> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.f <<abc>> {lappend x abc} + bind .t.f <<def>> {lappend x def} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Control-Button-2> + event generate .t.f <Control-ButtonRelease-2> + event generate .t.f <Shift-Button-2> + event generate .t.f <Shift-ButtonRelease-2> event delete <<xyz>> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Control-Button-2> - event gen .b.f <Control-ButtonRelease-2> - event gen .b.f <Shift-Button-2> - event gen .b.f <Shift-ButtonRelease-2> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Control-Button-2> + event generate .t.f <Control-ButtonRelease-2> + event generate .t.f <Shift-Button-2> + event generate .t.f <Shift-ButtonRelease-2> list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] -} {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>} -test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} { - setup - pack [frame .b.g -class Test -width 150 -height 100] - pack [frame .b.h -class Test -width 150 -height 100] +} -cleanup { + destroy .t.f + event delete <<def>> + event delete <<abc>> +} -result {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>} +test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} -setup { + pack [frame .t.f -class Test -width 150 -height 100] + pack [frame .t.g -class Test -width 150 -height 100] + pack [frame .t.h -class Test -width 150 -height 100] + focus -force .t.f update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { event add <<xyz>> <Button-2> event add <<abc>> <Button-2> event add <<def>> <Button-2> - bind .b.f <<xyz>> {lappend x xyz} - bind .b.g <<abc>> {lappend x abc} - bind .b.h <<def>> {lappend x def} - set x {} - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.g <Button-2> - event gen .b.g <ButtonRelease-2> - event gen .b.h <Button-2> - event gen .b.h <ButtonRelease-2> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.g <<abc>> {lappend x abc} + bind .t.h <<def>> {lappend x def} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.g <Button-2> + event generate .t.g <ButtonRelease-2> + event generate .t.h <Button-2> + event generate .t.h <ButtonRelease-2> event delete <<xyz>> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.g <Button-2> - event gen .b.g <ButtonRelease-2> - event gen .b.h <Button-2> - event gen .b.h <ButtonRelease-2> - destroy .b.g - destroy .b.h + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.g <Button-2> + event generate .t.g <ButtonRelease-2> + event generate .t.h <Button-2> + event generate .t.h <ButtonRelease-2> list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] -} {{xyz abc def abc def} {} <Button-2> <Button-2>} -test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} { - setup - pack [frame .b.g -class Test -width 150 -height 100] - pack [frame .b.h -class Test -width 150 -height 100] +} -cleanup { + destroy .t.f .t.g .t.h + event delete <<def>> + event delete <<abc>> +} -result {{xyz abc def abc def} {} <Button-2> <Button-2>} +test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} -setup { + pack [frame .t.f -class Test -width 150 -height 100] + pack [frame .t.g -class Test -width 150 -height 100] + pack [frame .t.h -class Test -width 150 -height 100] + focus -force .t.f update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { event add <<xyz>> <Button-2> event add <<abc>> <Button-2> event add <<def>> <Button-2> - bind .b.f <<xyz>> {lappend x xyz} - bind .b.g <<abc>> {lappend x abc} - bind .b.h <<def>> {lappend x def} - set x {} - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.g <Button-2> - event gen .b.g <ButtonRelease-2> - event gen .b.h <Button-2> - event gen .b.h <ButtonRelease-2> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.g <<abc>> {lappend x abc} + bind .t.h <<def>> {lappend x def} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.g <Button-2> + event generate .t.g <ButtonRelease-2> + event generate .t.h <Button-2> + event generate .t.h <ButtonRelease-2> event delete <<abc>> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.g <Button-2> - event gen .b.g <ButtonRelease-2> - event gen .b.h <Button-2> - event gen .b.h <ButtonRelease-2> - destroy .b.g - destroy .b.h + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.g <Button-2> + event generate .t.g <ButtonRelease-2> + event generate .t.h <Button-2> + event generate .t.h <ButtonRelease-2> list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] -} {{xyz abc def xyz def} <Button-2> {} <Button-2>} -test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} { - setup - pack [frame .b.g -class Test -width 150 -height 100] - pack [frame .b.h -class Test -width 150 -height 100] +} -cleanup { + destroy .t.f .t.g .t.h + event delete <<def>> + event delete <<xyz>> +} -result {{xyz abc def xyz def} <Button-2> {} <Button-2>} +test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} -setup { + pack [frame .t.f -class Test -width 150 -height 100] + pack [frame .t.g -class Test -width 150 -height 100] + pack [frame .t.h -class Test -width 150 -height 100] + focus -force .t.f update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { event add <<xyz>> <Button-2> event add <<abc>> <Button-2> event add <<def>> <Button-2> - bind .b.f <<xyz>> {lappend x xyz} - bind .b.g <<abc>> {lappend x abc} - bind .b.h <<def>> {lappend x def} - set x {} - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.g <Button-2> - event gen .b.g <ButtonRelease-2> - event gen .b.h <Button-2> - event gen .b.h <ButtonRelease-2> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.g <<abc>> {lappend x abc} + bind .t.h <<def>> {lappend x def} + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.g <Button-2> + event generate .t.g <ButtonRelease-2> + event generate .t.h <Button-2> + event generate .t.h <ButtonRelease-2> event delete <<def>> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.g <Button-2> - event gen .b.g <ButtonRelease-2> - event gen .b.h <Button-2> - event gen .b.h <ButtonRelease-2> - destroy .b.g - destroy .b.h + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.g <Button-2> + event generate .t.g <ButtonRelease-2> + event generate .t.h <Button-2> + event generate .t.h <ButtonRelease-2> list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] -} {{xyz abc def xyz abc} <Button-2> <Button-2> {}} +} -cleanup { + destroy .t.f .t.g .t.h + event delete <<xyz>> + event delete <<abc>> +} -result {{xyz abc def xyz abc} <Button-2> <Button-2> {}} -test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} { - list [catch {event info asd} msg] $msg -} {1 {virtual event "asd" is badly formed}} -test bind-20.2 {GetVirtualEvent procedure: non-existent event} { +test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} -body { + event info asd +} -returnCodes error -result {virtual event "asd" is badly formed} +test bind-20.2 {GetVirtualEvent procedure: non-existent event} -body { + event delete <<asd>> event info <<asd>> -} {} -test bind-20.3 {GetVirtualEvent procedure: owns 1} { - setup +} -result {} +test bind-20.3 {GetVirtualEvent procedure: owns 1} -setup { + event delete <<xyz>> +} -body { event add <<xyz>> <Control-Key-v> event info <<xyz>> -} {<Control-Key-v>} -test bind-20.4 {GetVirtualEvent procedure: owns many} { - setup +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v>} +test bind-20.4 {GetVirtualEvent procedure: owns many} -setup { + event delete <<xyz>> +} -body { event add <<xyz>> <Control-v> <Button-2> spack event info <<xyz>> -} {<Control-Key-v> <Button-2> spack} +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v> <Button-2> spack} -test bind-21.1 {GetAllVirtualEvents procedure: no events} { - setup +test bind-21.1 {GetAllVirtualEvents procedure: no events} -body { + foreach p [event info] {event delete $p} event info -} {} -test bind-21.2 {GetAllVirtualEvents procedure: 1 event} { - setup +} -result {} +test bind-21.2 {GetAllVirtualEvents procedure: 1 event} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event info -} {<<xyz>>} -test bind-21.3 {GetAllVirtualEvents procedure: many events} { - setup +} -cleanup { + event delete <<xyz>> +} -result {<<xyz>>} +test bind-21.3 {GetAllVirtualEvents procedure: many events} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event add <<xyz>> <Button-2> event add <<abc>> <Control-v> event add <<def>> <Key-F6> lsort [event info] -} {<<abc>> <<def>> <<xyz>>} - -test bind-22.1 {HandleEventGenerate} { - list [catch {event gen .xyz <Control-v>} msg] $msg -} {1 {bad window path name ".xyz"}} -test bind-22.2 {HandleEventGenerate} { - list [catch {event gen zzz <Control-v>} msg] $msg -} {1 {bad window name/identifier "zzz"}} -test bind-22.3 {HandleEventGenerate} { - list [catch {event gen 47 <Control-v>} msg] $msg -} {1 {bad window name/identifier "47"}} -test bind-22.4 {HandleEventGenerate} { - setup - bind .b.f <Button> {set x "%s %b"} - set x {} - event gen [winfo id .b.f] <Control-Button-1> -state 260 - set x -} {260 1} -test bind-22.5 {HandleEventGenerate} { - list [catch {event gen . <xyz>} msg] $msg -} {1 {bad event type or keysym "xyz"}} -test bind-22.6 {HandleEventGenerate} { - list [catch {event gen . <Double-Button-1>} msg] $msg -} {1 {Double or Triple modifier not allowed}} -test bind-22.7 {HandleEventGenerate} { - list [catch {event gen . xyz} msg] $msg -} {1 {only one event specification allowed}} -test bind-22.8 {HandleEventGenerate} { - list [catch {event gen . <Button> -button} msg] $msg -} {1 {value for "-button" missing}} -test bind-22.9 {HandleEventGenerate} { - setup - bind .b.f <Button> {set x "%s %b"} - set x {} - event gen .b.f <ButtonRelease-1> - event gen .b.f <ButtonRelease-2> - event gen .b.f <ButtonRelease-3> - event gen .b.f <Control-Button-1> - event gen .b.f <Control-ButtonRelease-1> - set x -} {4 1} -test bind-22.10 {HandleEventGenerate} { - setup - bind .b.f <Key> {set x "%s %K"} - set x {} - event gen .b.f <Control-Key-space> - set x -} {4 space} -test bind-22.11 {HandleEventGenerate} { - setup - bind .b.f <<Paste>> {set x "%s"} - set x {} - event gen .b.f <<Paste>> -state 1 - set x -} {1} -test bind-22.12 {HandleEventGenerate} { - setup - bind .b.f <Motion> {set x "%s"} - set x {} - event gen .b.f <Control-Motion> - set x -} {4} -test bind-22.13 {HandleEventGenerate} { - setup - bind .b.f <Button> {lappend x %#} - set x {} - event gen .b.f <Button> -when now -serial 100 - event gen .b.f <ButtonRelease> -when now - set x -} {100} -test bind-22.14 {HandleEventGenerate} { - setup - bind .b.f <Button> {lappend x %#} - set x {} - event gen .b.f <Button> -when head -serial 100 - event gen .b.f <Button> -when head -serial 101 - event gen .b.f <Button> -when head -serial 102 - event gen .b.f <ButtonRelease> -when tail +} -cleanup { + event delete <<xyz>> + event delete <<abc>> + event delete <<def>> +} -result {<<abc>> <<def>> <<xyz>>} + +test bind-22.1 {HandleEventGenerate} -setup { + destroy .xyz +} -body { + event generate .xyz <Control-v> +} -returnCodes error -result {bad window path name ".xyz"} +test bind-22.2 {HandleEventGenerate} -body { + event generate zzz <Control-v> +} -returnCodes error -result {bad window name/identifier "zzz"} +test bind-22.3 {HandleEventGenerate} -body { + event generate 47 <Control-v> +} -returnCodes error -result {bad window name/identifier "47"} +test bind-22.4 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> {set x "%s %b"} + event generate [winfo id .t.f] <Control-Button-1> -state 260 + set x +} -cleanup { + destroy .t.f +} -result {260 1} +test bind-22.5 {HandleEventGenerate} -body { + event generate . <xyz> +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-22.6 {HandleEventGenerate} -body { + event generate . <Double-Button-1> +} -returnCodes error -result {Double or Triple modifier not allowed} +test bind-22.7 {HandleEventGenerate} -body { + event generate . xyz +} -returnCodes error -result {only one event specification allowed} +test bind-22.8 {HandleEventGenerate} -body { + event generate . <Button> -button +} -returnCodes error -result {value for "-button" missing} +test bind-22.9 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> {set x "%s %b"} + event generate .t.f <ButtonRelease-1> + event generate .t.f <ButtonRelease-2> + event generate .t.f <ButtonRelease-3> + event generate .t.f <Control-Button-1> + event generate .t.f <Control-ButtonRelease-1> + set x +} -cleanup { + destroy .t.f +} -result {4 1} +test bind-22.10 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> {set x "%s %K"} + event generate .t.f <Control-Key-space> + set x +} -cleanup { + destroy .t.f +} -result {4 space} +test bind-22.11 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> {set x "%s"} + event generate .t.f <<Paste>> -state 1 + set x +} -cleanup { + destroy .t.f +} -result {1} +test bind-22.12 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> {set x "%s"} + event generate .t.f <Control-Motion> + set x +} -cleanup { + destroy .t.f +} -result {4} +test bind-22.13 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> {lappend x %#} + event generate .t.f <Button> -when now -serial 100 + event generate .t.f <ButtonRelease> -when now + set x +} -cleanup { + destroy .t.f +} -result {100} +test bind-22.14 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> {lappend x %#} + event generate .t.f <Button> -when head -serial 100 + event generate .t.f <Button> -when head -serial 101 + event generate .t.f <Button> -when head -serial 102 + event generate .t.f <ButtonRelease> -when tail lappend x foo update set x -} {foo 102 101 100} -test bind-22.15 {HandleEventGenerate} { - setup - bind .b.f <Button> {lappend x %#} +} -cleanup { + destroy .t.f +} -result {foo 102 101 100} +test bind-22.15 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button> -when head -serial 99 - event gen .b.f <Button> -when mark -serial 100 - event gen .b.f <Button> -when mark -serial 101 - event gen .b.f <Button> -when mark -serial 102 - event gen .b.f <ButtonRelease> -when tail +} -body { + bind .t.f <Button> {lappend x %#} + event generate .t.f <Button> -when head -serial 99 + event generate .t.f <Button> -when mark -serial 100 + event generate .t.f <Button> -when mark -serial 101 + event generate .t.f <Button> -when mark -serial 102 + event generate .t.f <ButtonRelease> -when tail lappend x foo update set x -} {foo 100 101 102 99} -test bind-22.16 {HandleEventGenerate} { - setup - bind .b.f <Button> {lappend x %#} +} -cleanup { + destroy .t.f +} -result {foo 100 101 102 99} +test bind-22.16 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button> -when head -serial 99 - event gen .b.f <Button> -when tail -serial 100 - event gen .b.f <Button> -when tail -serial 101 - event gen .b.f <Button> -when tail -serial 102 - event gen .b.f <ButtonRelease> -when tail +} -body { + bind .t.f <Button> {lappend x %#} + event generate .t.f <Button> -when head -serial 99 + event generate .t.f <Button> -when tail -serial 100 + event generate .t.f <Button> -when tail -serial 101 + event generate .t.f <Button> -when tail -serial 102 + event generate .t.f <ButtonRelease> -when tail lappend x foo update set x -} {foo 99 100 101 102} -test bind-22.17 {HandleEventGenerate} { - list [catch {event gen . <Button> -when xyz} msg] $msg -} {1 {bad -when value "xyz": must be now, head, mark, or tail}} -test bind-22.18 {HandleEventGenerate} { +} -cleanup { + destroy .t.f +} -result {foo 99 100 101 102} +test bind-22.17 {HandleEventGenerate} -body { + event generate . <Button> -when xyz +} -returnCodes error -result {bad -when value "xyz": must be now, head, mark, or tail} +test bind-22.18 {HandleEventGenerate} -body { # Bug 411307 - list [catch {event gen . <a> -root 98765} msg] $msg -} {1 {bad window name/identifier "98765"}} -foreach check { - {bind-22.19 <Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}} - {bind-22.20 <Configure> %a {-above .b} {[winfo id .b]}} - {bind-22.21 <Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}} - {bind-22.22 <Configure> %a {-above [winfo id .b]} {[winfo id .b]}} - {bind-22.23 <Key> %b {-above .} {{1 {<Key> event doesn't accept "-above" option}}}} - - {bind-22.24 <Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}} - {bind-22.25 <Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}} - {bind-22.26 <Key> %k {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}} - - {bind-22.27 <Button> %b {-button xyz} {{1 {expected integer but got "xyz"}}}} - {bind-22.28 <Button> %b {-button 1} 1} - {bind-22.29 <ButtonRelease> %b {-button 1} 1} - {bind-22.30 <Key> %k {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}} - - {bind-22.31 <Expose> %c {-count xyz} {{1 {expected integer but got "xyz"}}}} - {bind-22.32 <Expose> %c {-count 20} 20} - {bind-22.33 <Key> %b {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}} - - {bind-22.34 <Enter> %d {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}} - {bind-22.35 <FocusIn> %d {-detail NotifyVirtual} {{}}} - {bind-22.36 <Enter> %d {-detail NotifyVirtual} NotifyVirtual} - {bind-22.37 <Key> %k {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}} - - {bind-22.38 <Enter> %f {-focus xyz} {{1 {expected boolean value but got "xyz"}}}} - {bind-22.39 <Enter> %f {-focus 1} 1} - {bind-22.40 <Key> %k {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}} - - {bind-22.41 <Expose> %h {-height xyz} {{1 {bad screen distance "xyz"}}}} - {bind-22.42 <Expose> %h {-height 2i} {[winfo pixels .b.f 2i]}} - {bind-22.43 <Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}} - {bind-22.44 <Key> %k {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}} - - {bind-22.45 <Key> %k {-keycode xyz} {{1 {expected integer but got "xyz"}}}} - {bind-22.46 <Key> %k {-keycode 20} 20} - {bind-22.47 <Button> %b {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}} - - {bind-22.48 <Key> %K {-keysym xyz} {{1 {unknown keysym "xyz"}}}} - {bind-22.49 <Key> %K {-keysym a} a} - {bind-22.50 <Button> %b {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}} - - {bind-22.51 <Enter> %m {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}} - {bind-22.52 <Enter> %m {-mode NotifyNormal} NotifyNormal} - {bind-22.53 <FocusIn> %m {-mode NotifyNormal} {{}}} - {bind-22.54 <Key> %k {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}} - - {bind-22.55 <Map> %o {-override xyz} {{1 {expected boolean value but got "xyz"}}}} - {bind-22.56 <Map> %o {-override 1} 1} - {bind-22.57 <Reparent> %o {-override 1} 1} - {bind-22.58 <Configure> %o {-override 1} 1} - {bind-22.59 <Key> %k {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}} - - {bind-22.60 <Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}} - {bind-22.61 <Circulate> %p {-place PlaceOnTop} PlaceOnTop} - {bind-22.62 <Key> %k {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}} - - {bind-22.63 <Key> %R {-root .xyz} {{1 {bad window path name ".xyz"}}}} - {bind-22.64 <Key> %R {-root .b} {[winfo id .b]}} - {bind-22.65 <Key> %R {-root xyz} {{1 {bad window name/identifier "xyz"}}}} - {bind-22.66 <Key> %R {-root [winfo id .b]} {[winfo id .b]}} - {bind-22.67 <Button> %R {-root .b} {[winfo id .b]}} - {bind-22.68 <ButtonRelease> %R {-root .b} {[winfo id .b]}} - {bind-22.69 <Motion> %R {-root .b} {[winfo id .b]}} - {bind-22.70 <<Paste>> %R {-root .b} {[winfo id .b]}} - {bind-22.71 <Enter> %R {-root .b} {[winfo id .b]}} - {bind-22.72 <Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}} - - {bind-22.73 <Key> %X {-rootx xyz} {{1 {bad screen distance "xyz"}}}} - {bind-22.74 <Key> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} - {bind-22.75 <Button> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} - {bind-22.76 <ButtonRelease> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} - {bind-22.77 <Motion> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} - {bind-22.78 <<Paste>> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} - {bind-22.79 <Enter> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} - {bind-22.80 <Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}} - - {bind-22.81 <Key> %Y {-rooty xyz} {{1 {bad screen distance "xyz"}}}} - {bind-22.82 <Key> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} - {bind-22.83 <Button> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} - {bind-22.84 <ButtonRelease> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} - {bind-22.85 <Motion> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} - {bind-22.86 <<Paste>> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} - {bind-22.87 <Enter> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} - {bind-22.88 <Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}} - - {bind-22.89 <Key> %E {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}} - {bind-22.90 <Key> %E {-sendevent 1} 1} - {bind-22.91 <Key> %E {-sendevent yes} 1} - {bind-22.92 <Key> %E {-sendevent 43} 43} - - {bind-22.93 <Key> %# {-serial xyz} {{1 {expected integer but got "xyz"}}}} - {bind-22.94 <Key> %# {-serial 100} 100} - - {bind-22.95 <Key> %s {-state xyz} {{1 {expected integer but got "xyz"}}}} - {bind-22.96 <Key> %s {-state 1} 1} - {bind-22.97 <Button> %s {-state 1025} 1025} - {bind-22.98 <ButtonRelease> %s {-state 1025} 1025} - {bind-22.99 <Motion> %s {-state 1} 1} - {bind-22.100 <<Paste>> %s {-state 1} 1} - {bind-22.101 <Enter> %s {-state 1} 1} - {bind-22.102 <Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}} - {bind-22.103 <Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured} - {bind-22.104 <Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}} - - {bind-22.105 <Key> %S {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}} - {bind-22.106 <Key> %S {-subwindow .b} {[winfo id .b]}} - {bind-22.107 <Key> %S {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}} - {bind-22.108 <Key> %S {-subwindow [winfo id .b]} {[winfo id .b]}} - {bind-22.109 <Button> %S {-subwindow .b} {[winfo id .b]}} - {bind-22.110 <ButtonRelease> %S {-subwindow .b} {[winfo id .b]}} - {bind-22.111 <Motion> %S {-subwindow .b} {[winfo id .b]}} - {bind-22.112 <<Paste>> %S {-subwindow .b} {[winfo id .b]}} - {bind-22.113 <Enter> %S {-subwindow .b} {[winfo id .b]}} - {bind-22.114 <Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}} - - {bind-22.115 <Key> %t {-time xyz} {{1 {expected integer but got "xyz"}}}} - {bind-22.116 <Key> %t {-time 100} 100} - {bind-22.117 <Button> %t {-time 100} 100} - {bind-22.118 <ButtonRelease> %t {-time 100} 100} - {bind-22.119 <Motion> %t {-time 100} 100} - {bind-22.120 <<Paste>> %t {-time 100} 100} - {bind-22.121 <Enter> %t {-time 100} 100} - {bind-22.122 <Property> %t {-time 100} 100} - {bind-22.123 <Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}} - - {bind-22.124 <Expose> %w {-width xyz} {{1 {bad screen distance "xyz"}}}} - {bind-22.125 <Expose> %w {-width 2i} {[winfo pixels .b.f 2i]}} - {bind-22.126 <Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}} - {bind-22.127 <Key> %k {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}} - - {bind-22.128 <Unmap> %W {-window .xyz} {{1 {bad window path name ".xyz"}}}} - {bind-22.129 <Unmap> %W {-window .b.f} .b.f} - {bind-22.130 <Unmap> %W {-window xyz} {{1 {bad window name/identifier "xyz"}}}} - {bind-22.131 <Unmap> %W {-window [winfo id .b.f]} .b.f} - {bind-22.132 <Unmap> %W {-window .b.f} .b.f} - {bind-22.133 <Map> %W {-window .b.f} .b.f} - {bind-22.134 <Reparent> %W {-window .b.f} .b.f} - {bind-22.135 <Configure> %W {-window .b.f} .b.f} - {bind-22.136 <Gravity> %W {-window .b.f} .b.f} - {bind-22.137 <Circulate> %W {-window .b.f} .b.f} - {bind-22.138 <Key> %W {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}} - - {bind-22.139 <Key> %x {-x xyz} {{1 {bad screen distance "xyz"}}}} - {bind-22.140 <Key> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.141 <Button> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.142 <ButtonRelease> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.143 <Motion> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.144 <<Paste>> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.145 <Enter> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.146 <Expose> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.147 <Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.148 <Gravity> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.149 <Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}} - {bind-22.150 <Map> %x {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}} - - {bind-22.151 <Key> %y {-y xyz} {{1 {bad screen distance "xyz"}}}} - {bind-22.152 <Key> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.153 <Button> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.154 <ButtonRelease> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.155 <Motion> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.156 <<Paste>> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.157 <Enter> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.158 <Expose> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.159 <Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.160 <Gravity> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.161 <Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}} - {bind-22.162 <Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}} - - {bind-22.163 <Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -data, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -warp, -width, -window, -x, or -y}}}} -} { - lassign $check name event substitution generator result - test $name "HandleEventGenerate: options $event $generator" { - setup - bind .b.f $event "lappend x $substitution" - set x {} - if [catch {eval event gen .b.f $event $generator} msg] { - set x [list 1 $msg] - } - set x - } [eval set x $result] -} + event generate . <a> -root 98765 +} -returnCodes error -result {bad window name/identifier "98765"} + +test bind-22.19 {HandleEventGenerate: options <Configure> -above .xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %a" + event generate .t.f <Configure> -above .xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window path name ".xyz"} +test bind-22.20 {HandleEventGenerate: options <Configure> -above .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %a" + event generate .t.f <Configure> -above .t + return $x +} -cleanup { + destroy .t.f +} -result [winfo id .t] +test bind-22.21 {HandleEventGenerate: options <Configure> -above xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %a" + event generate .t.f <Configure> -above xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window name/identifier "xyz"} +test bind-22.22 {HandleEventGenerate: options <Configure> -above [winfo id .t]} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %a" + event generate .t.f <Configure> -above [winfo id .t] + return $x +} -cleanup { + destroy .t.f +} -result [winfo id .t] + +test bind-22.23 {HandleEventGenerate: options <Key> -above .} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %b" + event generate .t.f <Key> -above . + return $x +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-above" option} + +test bind-22.24 {HandleEventGenerate: options <Configure> -borderwidth xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %B" + event generate .t.f <Configure> -borderwidth xyz + return $x +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.25 {HandleEventGenerate: options <Configure> -borderwidth 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %B" + event generate .t.f <Configure> -borderwidth 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.26 {HandleEventGenerate: options <Key> -borderwidth 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -borderwidth 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-borderwidth" option} + +test bind-22.27 {HandleEventGenerate: options <Button> -button xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %b" + event generate .t.f <Button> -button xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.28 {HandleEventGenerate: options <Button> -button 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %b" + event generate .t.f <Button> -button 1 + return $x +} -cleanup { + destroy .t.f +} -result 1 + +test bind-22.29 {HandleEventGenerate: options <ButtonRelease> -button 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %b" + event generate .t.f <ButtonRelease> -button 1 + return $x +} -cleanup { + destroy .t.f +} -result 1 + +test bind-22.30 {HandleEventGenerate: options <Key> -button 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -button 1 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-button" option} + +test bind-22.31 {HandleEventGenerate: options <Expose> -count xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %c" + event generate .t.f <Expose> -count xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.32 {HandleEventGenerate: options <Expose> -count 20} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %c" + event generate .t.f <Expose> -count 20 + return $x +} -cleanup { + destroy .t.f +} -result {20} + +test bind-22.33 {HandleEventGenerate: options <Key> -count 20} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %b" + event generate .t.f <Key> -count 20 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-count" option} + +test bind-22.34 {HandleEventGenerate: options <Enter> -detail xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %d" + event generate .t.f <Enter> -detail xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone} + +test bind-22.35 {HandleEventGenerate: options <FocusIn> -detail NotifyVirtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <FocusIn> "lappend x FocusIn %d" + event generate .t.f <FocusIn> -detail NotifyVirtual + return $x +} -cleanup { + destroy .t.f +} -result {FocusIn NotifyVirtual} + +test bind-22.35.1 {HandleEventGenerate: options <FocusOut> -detail NotifyVirtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <FocusOut> "lappend x FocusOut %d" + event generate .t.f <FocusOut> -detail NotifyVirtual + return $x +} -cleanup { + destroy .t.f +} -result {FocusOut NotifyVirtual} + +test bind-22.36 {HandleEventGenerate: options <Enter> -detail NotifyVirtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %d" + event generate .t.f <Enter> -detail NotifyVirtual + return $x +} -cleanup { + destroy .t.f +} -result {NotifyVirtual} + +test bind-22.37 {HandleEventGenerate: options <Key> -detail NotifyVirtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -detail NotifyVirtual +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-detail" option} + +test bind-22.38 {HandleEventGenerate: options <Enter> -focus xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %f" + event generate .t.f <Enter> -focus xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected boolean value but got "xyz"} + +test bind-22.39 {HandleEventGenerate: options <Enter> -focus 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %f" + event generate .t.f <Enter> -focus 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.40 {HandleEventGenerate: options <Key> -focus 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -focus 1 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-focus" option} + +test bind-22.41 {HandleEventGenerate: options <Expose> -height xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %h" + event generate .t.f <Expose> -height xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.42 {HandleEventGenerate: options <Expose> -height 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %h" + event generate .t.f <Expose> -height 2i + expr {$x eq [winfo pixels .t.f 2i]} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.43 {HandleEventGenerate: options <Configure> -height 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %h" + event generate .t.f <Configure> -height 2i + expr {$x eq [winfo pixels .t.f 2i]} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.44 {HandleEventGenerate: options <Key> -height 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -height 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-height" option} + +test bind-22.45 {HandleEventGenerate: options <Key> -keycode xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -keycode xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.46 {HandleEventGenerate: options <Key> -keycode 20} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -keycode 20 + return $x +} -cleanup { + destroy .t.f +} -result {20} + +test bind-22.47 {HandleEventGenerate: options <Button> -keycode 20} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %b" + event generate .t.f <Button> -keycode 20 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Button> event doesn't accept "-keycode" option} + +test bind-22.48 {HandleEventGenerate: options <Key> -keysym xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %K" + event generate .t.f <Key> -keysym xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {unknown keysym "xyz"} + +test bind-22.49 {HandleEventGenerate: options <Key> -keysym space} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %K" + event generate .t.f <Key> -keysym space + return $x +} -cleanup { + destroy .t.f +} -result {space} + +test bind-22.50 {HandleEventGenerate: options <Button> -keysym space} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %b" + event generate .t.f <Button> -keysym space +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Button> event doesn't accept "-keysym" option} + +test bind-22.51 {HandleEventGenerate: options <Enter> -mode xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %m" + event generate .t.f <Enter> -mode xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed} + +test bind-22.52 {HandleEventGenerate: options <Enter> -mode NotifyNormal} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %m" + event generate .t.f <Enter> -mode NotifyNormal + return $x +} -cleanup { + destroy .t.f +} -result {NotifyNormal} + +test bind-22.53 {HandleEventGenerate: options <FocusIn> -mode NotifyNormal} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <FocusIn> "lappend x %m" + event generate .t.f <FocusIn> -mode NotifyNormal + return $x +} -cleanup { + destroy .t.f +} -result {NotifyNormal} + +test bind-22.54 {HandleEventGenerate: options <Key> -mode NotifyNormal} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -mode NotifyNormal +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-mode" option} +test bind-22.55 {HandleEventGenerate: options <Map> -override xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %o" + event generate .t.f <Map> -override xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected boolean value but got "xyz"} + +test bind-22.56 {HandleEventGenerate: options <Map> -override 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %o" + event generate .t.f <Map> -override 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.57 {HandleEventGenerate: options <Reparent> -override 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Reparent> "lappend x %o" + event generate .t.f <Reparent> -override 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.58 {HandleEventGenerate: options <Configure> -override 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %o" + event generate .t.f <Configure> -override 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.59 {HandleEventGenerate: options <Key> -override 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -override 1 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-override" option} + +test bind-22.60 {HandleEventGenerate: options <Circulate> -place xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Circulate> "lappend x %p" + event generate .t.f <Circulate> -place xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom} + +test bind-22.61 {HandleEventGenerate: options <Circulate> -place PlaceOnTop} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Circulate> "lappend x %p" + event generate .t.f <Circulate> -place PlaceOnTop + return $x +} -cleanup { + destroy .t.f +} -result {PlaceOnTop} + +test bind-22.62 {HandleEventGenerate: options <Key> -place PlaceOnTop} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -place PlaceOnTop +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-place" option} + +test bind-22.63 {HandleEventGenerate: options <Key> -root .xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %R" + event generate .t.f <Key> -root .xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window path name ".xyz"} + +test bind-22.64 {HandleEventGenerate: options <Key> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %R" + event generate .t.f <Key> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.65 {HandleEventGenerate: options <Key> -root xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %R" + event generate .t.f <Key> -root xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window name/identifier "xyz"} + +test bind-22.66 {HandleEventGenerate: options <Key> -root [winfo id .t]} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %R" + event generate .t.f <Key> -root [winfo id .t] + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.67 {HandleEventGenerate: options <Button> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %R" + event generate .t.f <Button> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.68 {HandleEventGenerate: options <ButtonRelease> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %R" + event generate .t.f <ButtonRelease> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.69 {HandleEventGenerate: options <Motion> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %R" + event generate .t.f <Motion> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.70 {HandleEventGenerate: options <<Paste>> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %R" + event generate .t.f <<Paste>> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.71 {HandleEventGenerate: options <Enter> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %R" + event generate .t.f <Enter> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.72 {HandleEventGenerate: options <Configure> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %R" + event generate .t.f <Configure> -root .t +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-root" option} + +test bind-22.73 {HandleEventGenerate: options <Key> -rootx xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %X" + event generate .t.f <Key> -rootx xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.74 {HandleEventGenerate: options <Key> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %X" + event generate .t.f <Key> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.75 {HandleEventGenerate: options <Button> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %X" + event generate .t.f <Button> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.76 {HandleEventGenerate: options <ButtonRelease> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %X" + event generate .t.f <ButtonRelease> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.77 {HandleEventGenerate: options <Motion> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %X" + event generate .t.f <Motion> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.78 {HandleEventGenerate: options <<Paste>> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %X" + event generate .t.f <<Paste>> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.79 {HandleEventGenerate: options <Enter> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %X" + event generate .t.f <Enter> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.80 {HandleEventGenerate: options <Configure> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %X" + event generate .t.f <Configure> -rootx 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-rootx" option} + +test bind-22.81 {HandleEventGenerate: options <Key> -rooty xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %Y" + event generate .t.f <Key> -rooty xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.82 {HandleEventGenerate: options <Key> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %Y" + event generate .t.f <Key> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.83 {HandleEventGenerate: options <Button> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %Y" + event generate .t.f <Button> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.84 {HandleEventGenerate: options <ButtonRelease> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %Y" + event generate .t.f <ButtonRelease> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.85 {HandleEventGenerate: options <Motion> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %Y" + event generate .t.f <Motion> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.86 {HandleEventGenerate: options <<Paste>> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %Y" + event generate .t.f <<Paste>> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.87 {HandleEventGenerate: options <Enter> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %Y" + event generate .t.f <Enter> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.88 {HandleEventGenerate: options <Configure> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %Y" + event generate .t.f <Configure> -rooty 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-rooty" option} + +test bind-22.89 {HandleEventGenerate: options <Key> -sendevent xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %E" + event generate .t.f <Key> -sendevent xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected boolean value but got "xyz"} + +test bind-22.90 {HandleEventGenerate: options <Key> -sendevent 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %E" + event generate .t.f <Key> -sendevent 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.91 {HandleEventGenerate: options <Key> -sendevent yes} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %E" + event generate .t.f <Key> -sendevent yes + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.92 {HandleEventGenerate: options <Key> -sendevent 43} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %E" + event generate .t.f <Key> -sendevent 43 + return $x +} -cleanup { + destroy .t.f +} -result {43} + +test bind-22.93 {HandleEventGenerate: options <Key> -serial xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %#" + event generate .t.f <Key> -serial xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.94 {HandleEventGenerate: options <Key> -serial 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %#" + event generate .t.f <Key> -serial 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.95 {HandleEventGenerate: options <Key> -state xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %s" + event generate .t.f <Key> -state xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.96 {HandleEventGenerate: options <Key> -state 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %s" + event generate .t.f <Key> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.97 {HandleEventGenerate: options <Button> -state 1025} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %s" + event generate .t.f <Button> -state 1025 + return $x +} -cleanup { + destroy .t.f +} -result {1025} + +test bind-22.98 {HandleEventGenerate: options <ButtonRelease> -state 1025} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %s" + event generate .t.f <ButtonRelease> -state 1025 + return $x +} -cleanup { + destroy .t.f +} -result {1025} + +test bind-22.99 {HandleEventGenerate: options <Motion> -state 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %s" + event generate .t.f <Motion> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.100 {HandleEventGenerate: options <<Paste>> -state 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %s" + event generate .t.f <<Paste>> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.101 {HandleEventGenerate: options <Enter> -state 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %s" + event generate .t.f <Enter> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.102 {HandleEventGenerate: options <Visibility> -state xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Visibility> "lappend x %s" + event generate .t.f <Visibility> -state xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured} + +test bind-22.103 {HandleEventGenerate: options <Visibility> -state VisibilityUnobscured} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Visibility> "lappend x %s" + event generate .t.f <Visibility> -state VisibilityUnobscured + return $x +} -cleanup { + destroy .t.f +} -result {VisibilityUnobscured} + +test bind-22.104 {HandleEventGenerate: options <Configure> -state xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %s" + event generate .t.f <Configure> -state xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-state" option} + +test bind-22.105 {HandleEventGenerate: options <Key> -subwindow .xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %S" + event generate .t.f <Key> -subwindow .xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window path name ".xyz"} + +test bind-22.106 {HandleEventGenerate: options <Key> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %S" + event generate .t.f <Key> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.107 {HandleEventGenerate: options <Key> -subwindow xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %S" + event generate .t.f <Key> -subwindow xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window name/identifier "xyz"} + +test bind-22.108 {HandleEventGenerate: options <Key> -subwindow [winfo id .t]} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %S" + event generate .t.f <Key> -subwindow [winfo id .t] + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.109 {HandleEventGenerate: options <Button> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %S" + event generate .t.f <Button> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.110 {HandleEventGenerate: options <ButtonRelease> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %S" + event generate .t.f <ButtonRelease> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.111 {HandleEventGenerate: options <Motion> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %S" + event generate .t.f <Motion> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.112 {HandleEventGenerate: options <<Paste>> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %S" + event generate .t.f <<Paste>> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.113 {HandleEventGenerate: options <Enter> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %S" + event generate .t.f <Enter> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.114 {HandleEventGenerate: options <Configure> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %S" + event generate .t.f <Configure> -subwindow .t +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-subwindow" option} + +test bind-22.115 {HandleEventGenerate: options <Key> -time xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %t" + event generate .t.f <Key> -time xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.116 {HandleEventGenerate: options <Key> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %t" + event generate .t.f <Key> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.117 {HandleEventGenerate: options <Button> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %t" + event generate .t.f <Button> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.118 {HandleEventGenerate: options <ButtonRelease> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %t" + event generate .t.f <ButtonRelease> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.119 {HandleEventGenerate: options <Motion> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %t" + event generate .t.f <Motion> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.120 {HandleEventGenerate: options <<Paste>> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %t" + event generate .t.f <<Paste>> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.121 {HandleEventGenerate: options <Enter> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %t" + event generate .t.f <Enter> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.122 {HandleEventGenerate: options <Property> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Property> "lappend x %t" + event generate .t.f <Property> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.123 {HandleEventGenerate: options <Configure> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %t" + event generate .t.f <Configure> -time 100 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-time" option} + +test bind-22.124 {HandleEventGenerate: options <Expose> -width xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %w" + event generate .t.f <Expose> -width xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.125 {HandleEventGenerate: options <Expose> -width 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %w" + event generate .t.f <Expose> -width 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.126 {HandleEventGenerate: options <Configure> -width 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %w" + event generate .t.f <Configure> -width 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.127 {HandleEventGenerate: options <Key> -width 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -width 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-width" option} + +test bind-22.128 {HandleEventGenerate: options <Unmap> -window .xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event generate .t.f <Unmap> -window .xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window path name ".xyz"} + +test bind-22.129 {HandleEventGenerate: options <Unmap> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event generate .t.f <Unmap> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.130 {HandleEventGenerate: options <Unmap> -window xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event generate .t.f <Unmap> -window xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window name/identifier "xyz"} + +test bind-22.131 {HandleEventGenerate: options <Unmap> -window [winfo id .t.f]} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event generate .t.f <Unmap> -window [winfo id .t.f] + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.132 {HandleEventGenerate: options <Unmap> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event generate .t.f <Unmap> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.133 {HandleEventGenerate: options <Map> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %W" + event generate .t.f <Map> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.134 {HandleEventGenerate: options <Reparent> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Reparent> "lappend x %W" + event generate .t.f <Reparent> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.135 {HandleEventGenerate: options <Configure> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %W" + event generate .t.f <Configure> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.136 {HandleEventGenerate: options <Gravity> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Gravity> "lappend x %W" + event generate .t.f <Gravity> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.137 {HandleEventGenerate: options <Circulate> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Circulate> "lappend x %W" + event generate .t.f <Circulate> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.138 {HandleEventGenerate: options <Key> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %W" + event generate .t.f <Key> -window .t.f +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-window" option} + +test bind-22.139 {HandleEventGenerate: options <Key> -x xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %x" + event generate .t.f <Key> -x xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.140 {HandleEventGenerate: options <Key> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %x" + event generate .t.f <Key> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.141 {HandleEventGenerate: options <Button> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %x" + event generate .t.f <Button> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.142 {HandleEventGenerate: options <ButtonRelease> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %x" + event generate .t.f <ButtonRelease> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.143 {HandleEventGenerate: options <Motion> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %x" + event generate .t.f <Motion> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.144 {HandleEventGenerate: options <<Paste>> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %x" + event generate .t.f <<Paste>> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.145 {HandleEventGenerate: options <Enter> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %x" + event generate .t.f <Enter> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.146 {HandleEventGenerate: options <Expose> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %x" + event generate .t.f <Expose> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.147 {HandleEventGenerate: options <Configure> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %x" + event generate .t.f <Configure> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.148 {HandleEventGenerate: options <Gravity> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Gravity> "lappend x %x" + event generate .t.f <Gravity> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.149 {HandleEventGenerate: options <Reparent> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Reparent> "lappend x %x" + event generate .t.f <Reparent> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.150 {HandleEventGenerate: options <Map> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %x" + event generate .t.f <Map> -x 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Map> event doesn't accept "-x" option} + +test bind-22.151 {HandleEventGenerate: options <Key> -y xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %y" + event generate .t.f <Key> -y xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.152 {HandleEventGenerate: options <Key> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %y" + event generate .t.f <Key> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.153 {HandleEventGenerate: options <Button> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %y" + event generate .t.f <Button> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.154 {HandleEventGenerate: options <ButtonRelease> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %y" + event generate .t.f <ButtonRelease> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.155 {HandleEventGenerate: options <Motion> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %y" + event generate .t.f <Motion> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.156 {HandleEventGenerate: options <<Paste>> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %y" + event generate .t.f <<Paste>> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.157 {HandleEventGenerate: options <Enter> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %y" + event generate .t.f <Enter> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.158 {HandleEventGenerate: options <Expose> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %y" + event generate .t.f <Expose> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.159 {HandleEventGenerate: options <Configure> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %y" + event generate .t.f <Configure> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.160 {HandleEventGenerate: options <Gravity> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Gravity> "lappend x %y" + event generate .t.f <Gravity> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.161 {HandleEventGenerate: options <Reparent> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Reparent> "lappend x %y" + event generate .t.f <Reparent> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.162 {HandleEventGenerate: options <Map> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %y" + event generate .t.f <Map> -y 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Map> event doesn't accept "-y" option} + +test bind-22.163 {HandleEventGenerate: options <Key> -xyz 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event generate .t.f <Key> -xyz 1 +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -data, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -warp, -width, -window, -x, or -y} # Note that the -data option is tested in bind-32.* because it has # more demanding requirements in memory handling -test bind-23.1 {GetVirtualEventUid procedure} { - list [catch {event info <<asd} msg] $msg -} {1 {virtual event "<<asd" is badly formed}} -test bind-23.2 {GetVirtualEventUid procedure} { - list [catch {event info <<>>} msg] $msg -} {1 {virtual event "<<>>" is badly formed}} -test bind-23.3 {GetVirtualEventUid procedure} { - list [catch {event info <<asd>} msg] $msg -} {1 {virtual event "<<asd>" is badly formed}} -test bind-23.4 {GetVirtualEventUid procedure} { + +test bind-23.1 {GetVirtualEventUid procedure} -body { + event info <<asd +} -returnCodes error -result {virtual event "<<asd" is badly formed} +test bind-23.2 {GetVirtualEventUid procedure} -body { + event info <<>> +} -returnCodes error -result {virtual event "<<>>" is badly formed} +test bind-23.3 {GetVirtualEventUid procedure} -body { + event info <<asd> +} -returnCodes error -result {virtual event "<<asd>" is badly formed} +test bind-23.4 {GetVirtualEventUid procedure} -setup { + event delete <<asd>> +} -body { event info <<asd>> -} {} - - -test bind-24.1 {FindSequence procedure: no event} { - list [catch {bind .b {} test} msg] $msg -} {1 {no events specified in binding}} -test bind-24.2 {FindSequence procedure: bad event} { - list [catch {bind .b <xyz> test} msg] $msg -} {1 {bad event type or keysym "xyz"}} -test bind-24.3 {FindSequence procedure: virtual allowed} { - bind .b.f <<Paste>> test -} {} -test bind-24.4 {FindSequence procedure: virtual not allowed} { - list [catch {event add <<Paste>> <<Alive>>} msg] $msg -} {1 {virtual event not allowed in definition of another virtual event}} -test bind-24.5 {FindSequence procedure, multiple bindings} { - setup - bind .b.f <1> {lappend x single} - bind .b.f <Double-1> {lappend x double} - bind .b.f <Triple-1> {lappend x triple} - bind .b.f <Quadruple-1> {lappend x quadruple} +} -result {} + + +test bind-24.1 {FindSequence procedure: no event} -body { + bind .t {} test +} -returnCodes error -result {no events specified in binding} +test bind-24.2 {FindSequence procedure: bad event} -body { + bind .t <xyz> test +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-24.3 {FindSequence procedure: virtual allowed} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> test +} -cleanup { + destroy .t.f +} -result {} +test bind-24.4 {FindSequence procedure: virtual not allowed} -body { + event add <<Paste>> <<Alive>> +} -returnCodes error -result {virtual event not allowed in definition of another virtual event} +test bind-24.5 {FindSequence procedure, multiple bindings} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <1> {lappend x single} + bind .t.f <Double-1> {lappend x double} + bind .t.f <Triple-1> {lappend x triple} + bind .t.f <Quadruple-1> {lappend x quadruple} set x press - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> lappend x press - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> lappend x press - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> lappend x press - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> lappend x press - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - set x -} {press single press double press triple press quadruple press quadruple} -test bind-24.6 {FindSequence procedure: virtual composed} { - list [catch {bind .b <Control-b><<Paste>> "puts hi"} msg] $msg -} {1 {virtual events may not be composed}} -test bind-24.7 {FindSequence procedure: new pattern sequence} { - setup - bind .b.f <Button-1><Button-2> {lappend x 1-2} - set x {} - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - set x -} {1-2} -test bind-24.8 {FindSequence procedure: similar pattern sequence} { - setup - bind .b.f <Button-1><Button-2> {lappend x 1-2} - bind .b.f <Button-2> {lappend x 2} - set x {} - event gen .b.f <Button-3> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - set x -} {2 1-2} -test bind-24.9 {FindSequence procedure: similar pattern sequence} { - setup - bind .b.f <Button-1><Button-2> {lappend x 1-2} - bind .b.f <Button-2><Button-2> {lappend x 2-2} - set x {} - event gen .b.f <Button-3> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - set x -} {2-2 1-2} -test bind-24.10 {FindSequence procedure: similar pattern sequence} { - setup - bind .b.f <Button-2><Button-2> {lappend x 2-2} - bind .b.f <Double-Button-2> {lappend x d-2} - set x {} - event gen .b.f <Button-3> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - event gen .b.f <Button-2> -x 100 - event gen .b.f <ButtonRelease-2> - event gen .b.f <Button-2> -x 200 - event gen .b.f <ButtonRelease-2> - set x -} {d-2 2-2} -test bind-24.11 {FindSequence procedure: new sequence, don't create} { - setup - bind .b.f <Button-2> -} {} -test bind-24.12 {FindSequence procedure: not new sequence, don't create} { - setup - bind .b.f <Control-Button-2> "foo" - bind .b.f <Button-2> -} {} -test bind-24.13 {FindSequence procedure: no binding} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - list [catch {bind .b.f <a>} msg] $msg -} {0 {}} -test bind-24.14 {FindSequence procedure: no binding} { - catch {destroy .b.f} - canvas .b.f - set i [.b.f create rect 10 10 100 100] - list [catch {.b.f bind $i <a>} msg] $msg -} {0 {}} + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + set x +} -cleanup { + destroy .t.f +} -result {press single press double press triple press quadruple press quadruple} +test bind-24.6 {FindSequence procedure: virtual composed} -body { + bind .t <Control-b><<Paste>> "puts hi" +} -returnCodes error -result {virtual events may not be composed} +test bind-24.7 {FindSequence procedure: new pattern sequence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-1><Button-2> {lappend x 1-2} + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {1-2} +test bind-24.8 {FindSequence procedure: similar pattern sequence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-1><Button-2> {lappend x 1-2} + bind .t.f <Button-2> {lappend x 2} + event generate .t.f <Button-3> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {2 1-2} +test bind-24.9 {FindSequence procedure: similar pattern sequence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-1><Button-2> {lappend x 1-2} + bind .t.f <Button-2><Button-2> {lappend x 2-2} + event generate .t.f <Button-3> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {2-2 1-2} +test bind-24.10 {FindSequence procedure: similar pattern sequence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-2><Button-2> {lappend x 2-2} + bind .t.f <Double-Button-2> {lappend x d-2} + event generate .t.f <Button-3> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + event generate .t.f <Button-2> -x 100 + event generate .t.f <ButtonRelease-2> + event generate .t.f <Button-2> -x 200 + event generate .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {d-2 2-2} +test bind-24.11 {FindSequence procedure: new sequence, don't create} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-2> +} -cleanup { + destroy .t.f +} -result {} +test bind-24.12 {FindSequence procedure: not new sequence, don't create} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Control-Button-2> "foo" + bind .t.f <Button-2> +} -cleanup { + destroy .t.f +} -result {} +test bind-24.13 {FindSequence procedure: no binding} -body { + frame .t.f -class Test -width 150 -height 100 + bind .t.f <a> +} -cleanup { + destroy .t.f +} -returnCodes ok +test bind-24.14 {FindSequence procedure: no binding} -body { + canvas .t.c + set i [.t.c create rect 10 10 100 100] + .t.c bind $i <a> +} -cleanup { + destroy .t.c +} -returnCodes ok test bind-25.1 {ParseEventDescription procedure} -setup { - setup + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update } -body { - bind .b.f a test - bind .b.f a + bind .t.f a test + bind .t.f a +} -cleanup { + destroy .t.f } -result test test bind-25.2 {ParseEventDescription procedure: misinterpreted modifier} -setup { - button .x + button .b } -body { - bind .x <Control-M> a - bind .x <M-M> b - lsort [bind .x] + bind .b <Control-M> a + bind .b <M-M> b + lsort [bind .b] } -cleanup { - destroy .x + destroy .b } -result {<Control-Key-M> <Meta-Key-M>} test bind-25.3 {ParseEventDescription procedure} -setup { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 + frame .t.f -class Test -width 150 -height 100 } -body { - bind .b.f <a---> {nothing} - bind .b.f + bind .t.f <a---> {nothing} + bind .t.f +} -cleanup { + destroy .t.f } -result a -test bind-25.4 {ParseEventDescription} -setup { - setup -} -body { - bind .b <<Shift-Paste>> {puts hi} - bind .b +test bind-25.4 {ParseEventDescription} -body { + bind .t <<Shift-Paste>> {puts hi} + bind .t } -result {<<Shift-Paste>>} + # Assorted error cases in event sequence parsing -foreach {testname testinfo} { - bind-25.5 {\x7 {bad ASCII character 0x7}} - bind-25.6 {\x7f {bad ASCII character 0x7f}} - bind-25.7 {\x4 {bad ASCII character 0x4}} - bind-25.8 {<<>> {virtual event "<<>>" is badly formed}} - bind-25.9 {<<Paste {missing ">" in virtual binding}} - bind-25.10 {<<Paste> {missing ">" in virtual binding}} - bind-25.11 {<<Paste>>h {virtual events may not be composed}} - bind-25.12 {<> "no event type or button # or keysym"} - bind-25.13 {<a-- {missing ">" in binding}} - bind-25.14 {<a-b> {extra characters after detail in binding}} - bind-25.15 {<<abc {missing ">" in virtual binding}} - bind-25.16 {<<abc> {missing ">" in virtual binding}} -} { - lassign $testinfo sequence errorMessage - test $testname {ParseEventDescription procedure error cases} \ - -setup { setup } \ - -body [list bind .b $sequence {puts hi}] \ - -returnCodes error -result $errorMessage -} -test bind-25.17 {ParseEventDescription} -setup { - setup -} -returnCodes error -body { +test bind-25.5 {ParseEventDescription procedure error cases} -body { + bind .t \x7 {puts hi} +} -returnCodes error -result {bad ASCII character 0x7} +test bind-25.6 {ParseEventDescription procedure error cases} -body { + bind .t \x7f {puts hi} +} -returnCodes error -result {bad ASCII character 0x7f} +test bind-25.7 {ParseEventDescription procedure error cases} -body { + bind .t \x4 {puts hi} +} -returnCodes error -result {bad ASCII character 0x4} +test bind-25.8 {ParseEventDescription procedure error cases} -body { + bind .t <<>> {puts hi} +} -returnCodes error -result {virtual event "<<>>" is badly formed} +test bind-25.9 {ParseEventDescription procedure error cases} -body { + bind .t <<Paste {puts hi} +} -returnCodes error -result {missing ">" in virtual binding} +test bind-25.10 {ParseEventDescription procedure error cases} -body { + bind .t <<Paste> {puts hi} +} -returnCodes error -result {missing ">" in virtual binding} +test bind-25.11 {ParseEventDescription procedure error cases} -body { + bind .t <<Paste>>h {puts hi} +} -returnCodes error -result {virtual events may not be composed} +test bind-25.12 {ParseEventDescription procedure error cases} -body { + bind .t <> {puts hi} +} -returnCodes error -result {no event type or button # or keysym} +test bind-25.13 {ParseEventDescription procedure error cases} -body { + bind .t <a-- {puts hi} +} -returnCodes error -result {missing ">" in binding} +test bind-25.14 {ParseEventDescription procedure error cases} -body { + bind .t <a-b> {puts hi} +} -returnCodes error -result {extra characters after detail in binding} +test bind-25.15 {ParseEventDescription procedure error cases} -body { + bind .t <<abc {puts hi} +} -returnCodes error -result {missing ">" in virtual binding} +test bind-25.16 {ParseEventDescription procedure error cases} -body { + bind .t <<abc> {puts hi} +} -returnCodes error -result {missing ">" in virtual binding} +test bind-25.17 {ParseEventDescription} -body { event add <<xyz>> <<abc>> -} -result {virtual event not allowed in definition of another virtual event} +} -returnCodes error -result {virtual event not allowed in definition of another virtual event} + # Modifier canonicalization tests -foreach {name check} { - bind-25.18 {{<Control- a>} <Control-Key-a>} - bind-25.19 {<Shift-a> <Shift-Key-a>} - bind-25.20 {<Lock-a> <Lock-Key-a>} - bind-25.21 {<Meta---a> <Meta-Key-a>} - bind-25.22 {<M-a> <Meta-Key-a>} - bind-25.23 {<Alt-a> <Alt-Key-a>} - bind-25.24 {<B1-a> <B1-Key-a>} - bind-25.25 {<B2-a> <B2-Key-a>} - bind-25.26 {<B3-a> <B3-Key-a>} - bind-25.27 {<B4-a> <B4-Key-a>} - bind-25.28 {<B5-a> <B5-Key-a>} - bind-25.29 {<Button1-a> <B1-Key-a>} - bind-25.30 {<Button2-a> <B2-Key-a>} - bind-25.31 {<Button3-a> <B3-Key-a>} - bind-25.32 {<Button4-a> <B4-Key-a>} - bind-25.33 {<Button5-a> <B5-Key-a>} - bind-25.34 {<M1-a> <Mod1-Key-a>} - bind-25.35 {<M2-a> <Mod2-Key-a>} - bind-25.36 {<M3-a> <Mod3-Key-a>} - bind-25.37 {<M4-a> <Mod4-Key-a>} - bind-25.38 {<M5-a> <Mod5-Key-a>} - bind-25.39 {<Mod1-a> <Mod1-Key-a>} - bind-25.40 {<Mod2-a> <Mod2-Key-a>} - bind-25.41 {<Mod3-a> <Mod3-Key-a>} - bind-25.42 {<Mod4-a> <Mod4-Key-a>} - bind-25.43 {<Mod5-a> <Mod5-Key-a>} - bind-25.44 {<Double-a> <Double-Key-a>} - bind-25.45 {<Triple-a> <Triple-Key-a>} - bind-25.46 {{<Double 1>} <Double-Button-1>} - bind-25.47 {<Triple-1> <Triple-Button-1>} - bind-25.48 {{<M1-M2 M3-M4 B1-Control-a>} - <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>} - bind-25.49 {<Extended-Return> <Extended-Key-Return>} -} { - lassign $check shortBind longBind - test $name {modifier names} -setup { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - } -body { - bind .b.f $shortBind foo - bind .b.f - } -result $longBind -cleanup { - bind .b.f [lindex $check 1] {} - } -} -foreach event [bind Test] { - bind Test $event {} -} -foreach event [bind all] { - bind all $event {} -} -test bind-26.1 {event names} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - bind .b.f <FocusIn> {nothing} - bind .b.f -} <FocusIn> -test bind-26.2 {event names} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - bind .b.f <FocusOut> {nothing} - bind .b.f -} <FocusOut> -test bind-26.3 {event names} { - setup - bind .b.f <Destroy> {lappend x "destroyed"} - set x [bind .b.f] - destroy .b.f - set x -} {<Destroy> destroyed} -foreach check { - {bind-26.4 Motion Motion} - {bind-26.5 Button Button} - {bind-26.6 ButtonPress Button} - {bind-26.7 ButtonRelease ButtonRelease} - {bind-26.8 Colormap Colormap} - {bind-26.9 Enter Enter} - {bind-26.10 Leave Leave} - {bind-26.11 Expose Expose} - {bind-26.12 Key Key} - {bind-26.13 KeyPress Key} - {bind-26.14 KeyRelease KeyRelease} - {bind-26.15 Property Property} - {bind-26.16 Visibility Visibility} - {bind-26.17 Activate Activate} - {bind-26.18 Deactivate Deactivate} -} { - lassign $check name event canonicalEvent - test $name "event names: $event" { - setup - bind .b.f <$event> "set x {event $event}" +test bind-25.18 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f {<Control- a>} foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Control-Key-a> + +test bind-25.19 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Shift-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Shift-Key-a> + +test bind-25.20 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Lock-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Lock-Key-a> + +test bind-25.21 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Meta---a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Meta-Key-a> + +test bind-25.22 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Meta-Key-a> + +test bind-25.23 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Alt-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Alt-Key-a> + +test bind-25.24 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B1-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B1-Key-a> + +test bind-25.25 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B2-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B2-Key-a> + +test bind-25.26 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B3-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B3-Key-a> + +test bind-25.27 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B4-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B4-Key-a> + +test bind-25.28 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B5-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B5-Key-a> + +test bind-25.29 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button1-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B1-Key-a> + +test bind-25.30 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button2-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B2-Key-a> + +test bind-25.31 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button3-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B3-Key-a> + +test bind-25.32 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button4-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B4-Key-a> + +test bind-25.33 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button5-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B5-Key-a> + +test bind-25.34 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M1-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod1-Key-a> + +test bind-25.35 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M2-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod2-Key-a> + +test bind-25.36 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M3-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod3-Key-a> + +test bind-25.37 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M4-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod4-Key-a> + +test bind-25.38 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M5-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod5-Key-a> + +test bind-25.39 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod1-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod1-Key-a> + +test bind-25.40 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod2-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod2-Key-a> + +test bind-25.41 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod3-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod3-Key-a> + +test bind-25.42 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod4-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod4-Key-a> + +test bind-25.43 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod5-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod5-Key-a> + +test bind-25.44 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Double-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Double-Key-a> + +test bind-25.45 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Triple-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Triple-Key-a> + +test bind-25.46 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f {<Double 1>} foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Double-Button-1> + +test bind-25.47 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Triple-1> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Triple-Button-1> + +test bind-25.48 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f {<M1-M2 M3-M4 B1-Control-a>} foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a> + +test bind-25.49 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Extended-Return> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Extended-Key-Return> + + + +test bind-26.1 {event names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <FocusIn> {nothing} + bind .t.f +} -cleanup { + destroy .t.f +} -result <FocusIn> +test bind-26.2 {event names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <FocusOut> {nothing} + bind .t.f +} -cleanup { + destroy .t.f +} -result <FocusOut> +test bind-26.3 {event names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Destroy> {lappend x "destroyed"} + set x [bind .t.f] + destroy .t.f + set x +} -cleanup { + destroy .t.f +} -result {<Destroy> destroyed} + +test bind-26.4 {event names: Motion} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Motion> "set x {event Motion}" set x xyzzy - event gen .b.f <$event> - list $x [bind .b.f] - } [list "event $event" <$canonicalEvent>] -} + event generate .t.f <Motion> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Motion} <Motion>} + +test bind-26.5 {event names: Button} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> "set x {event Button}" + set x xyzzy + event generate .t.f <Button> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Button} <Button>} + +test bind-26.6 {event names: ButtonPress} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <ButtonPress> "set x {event ButtonPress}" + set x xyzzy + event generate .t.f <ButtonPress> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event ButtonPress} <Button>} + +test bind-26.7 {event names: ButtonRelease} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <ButtonRelease> "set x {event ButtonRelease}" + set x xyzzy + event generate .t.f <ButtonRelease> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event ButtonRelease} <ButtonRelease>} + +test bind-26.8 {event names: Colormap} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Colormap> "set x {event Colormap}" + set x xyzzy + event generate .t.f <Colormap> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Colormap} <Colormap>} + +test bind-26.9 {event names: Enter} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> "set x {event Enter}" + set x xyzzy + event generate .t.f <Enter> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Enter} <Enter>} + +test bind-26.10 {event names: Leave} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Leave> "set x {event Leave}" + set x xyzzy + event generate .t.f <Leave> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Leave} <Leave>} + +test bind-26.11 {event names: Expose} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Expose> "set x {event Expose}" + set x xyzzy + event generate .t.f <Expose> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Expose} <Expose>} + +test bind-26.12 {event names: Key} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> "set x {event Key}" + set x xyzzy + event generate .t.f <Key> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Key} <Key>} + +test bind-26.13 {event names: KeyPress} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyPress> "set x {event KeyPress}" + set x xyzzy + event generate .t.f <KeyPress> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event KeyPress} <Key>} + +test bind-26.14 {event names: KeyRelease} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyRelease> "set x {event KeyRelease}" + set x xyzzy + event generate .t.f <KeyRelease> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event KeyRelease} <KeyRelease>} + +test bind-26.15 {event names: Property} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Property> "set x {event Property}" + set x xyzzy + event generate .t.f <Property> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Property} <Property>} + +test bind-26.16 {event names: Visibility} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Visibility> "set x {event Visibility}" + set x xyzzy + event generate .t.f <Visibility> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Visibility} <Visibility>} + +test bind-26.17 {event names: Activate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Activate> "set x {event Activate}" + set x xyzzy + event generate .t.f <Activate> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Activate} <Activate>} + +test bind-26.18 {event names: Deactivate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Deactivate> "set x {event Deactivate}" + set x xyzzy + event generate .t.f <Deactivate> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Deactivate} <Deactivate>} + + # These events require an extra argument to [event generate] -foreach check { - {bind-26.19 Circulate Circulate} - {bind-26.20 Configure Configure} - {bind-26.21 Gravity Gravity} - {bind-26.22 Map Map} - {bind-26.23 Reparent Reparent} - {bind-26.24 Unmap Unmap} -} { - lassign $check name event canonicalEvent - test $name "event names: $event" { - setup - bind .b.f <$event> "set x {event $event}" +test bind-26.19 {event names: Circulate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Circulate> "set x {event Circulate}" set x xyzzy - event gen .b.f <$event> -window .b.f - list $x [bind .b.f] - } [list "event $event" <$canonicalEvent>] -} + event generate .t.f <Circulate> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Circulate} <Circulate>} -test bind-27.1 {button names} { - list [catch {bind .b <Expose-1> foo} msg] $msg -} {1 {specified button "1" for non-button event}} -test bind-27.2 {button names} { - list [catch {bind .b <Button-6> foo} msg] $msg -} {1 {specified keysym "6" for non-key event}} -test bind-27.3 {button names} { - setup - bind .b.f <Button-1> {lappend x "button 1"} - set x [bind .b.f] - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> - set x -} {<Button-1> {button 1}} -test bind-27.4 {button names} { - setup - bind .b.f <Button-2> {lappend x "button 2"} - set x [bind .b.f] - event gen .b.f <Button-2> - event gen .b.f <ButtonRelease-2> - set x -} {<Button-2> {button 2}} -test bind-27.5 {button names} { - setup - bind .b.f <Button-3> {lappend x "button 3"} - set x [bind .b.f] - event gen .b.f <Button-3> - event gen .b.f <ButtonRelease-3> - set x -} {<Button-3> {button 3}} -test bind-27.6 {button names} { - setup - bind .b.f <Button-4> {lappend x "button 4"} - set x [bind .b.f] - event gen .b.f <Button-4> - event gen .b.f <ButtonRelease-4> - set x -} {<Button-4> {button 4}} -test bind-27.7 {button names} { - setup - bind .b.f <Button-5> {lappend x "button 5"} - set x [bind .b.f] - event gen .b.f <Button-5> - event gen .b.f <ButtonRelease-5> - set x -} {<Button-5> {button 5}} - -test bind-28.1 {keysym names} { - list [catch {bind .b <Expose-a> foo} msg] $msg -} {1 {specified keysym "a" for non-key event}} -test bind-28.2 {keysym names} { - list [catch {bind .b <Gorp> foo} msg] $msg -} {1 {bad event type or keysym "Gorp"}} -test bind-28.3 {keysym names} { - list [catch {bind .b <Key-Stupid> foo} msg] $msg -} {1 {bad event type or keysym "Stupid"}} -test bind-28.4 {keysym names} { - catch {destroy .b.f} - frame .b.f -class Test -width 150 -height 100 - bind .b.f <a> foo - bind .b.f -} a -foreach check { - {bind-28.5 a 0 a} - {bind-28.6 space 0 <Key-space>} - {bind-28.7 Return 0 <Key-Return>} - {bind-28.8 X 1 X} -} { - lassign $check name keysym state result - test $name {keysym names} { - setup - bind .b.f <Key-$keysym> "lappend x \"keysym $keysym\"" - bind .b.f <Key-x> "lappend x {bad binding match}" - set x [lsort [bind .b.f]] - event gen .b.f <Key-$keysym> -state $state - set x - } [concat [lsort "x $result"] "{keysym $keysym}"] -} +test bind-26.20 {event names: Configure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Configure> "set x {event Configure}" + set x xyzzy + event generate .t.f <Configure> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Configure} <Configure>} -test bind-29.1 {dummy test to help ensure proper numbering} {} {} -setup -bind .b.f <KeyPress> {set x %K} -foreach check { - {bind-29.2 a 0 a} - {bind-29.3 x 1 X} - {bind-29.4 x 2 X} - {bind-29.5 space 0 space} - {bind-29.6 F1 1 F1} -} { - lassign $check name keysym state result - test $name {GetKeySym procedure} nonPortable { - set x nothing - event gen .b.f <KeyPress> -keysym $keysym -state $state - set x - } $result -} +test bind-26.21 {event names: Gravity} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Gravity> "set x {event Gravity}" + set x xyzzy + event generate .t.f <Gravity> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Gravity} <Gravity>} -proc bgerror msg { - global x errorInfo - set x [list $msg $errorInfo] -} -test bind-30.1 {Tk_BackgroundError procedure} { - setup - bind .b.f <Button> {error "This is a test"} +test bind-26.22 {event names: Map} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Map> "set x {event Map}" + set x xyzzy + event generate .t.f <Map> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Map} <Map>} + +test bind-26.23 {event names: Reparent} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Reparent> "set x {event Reparent}" + set x xyzzy + event generate .t.f <Reparent> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Reparent} <Reparent>} + +test bind-26.24 {event names: Unmap} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Unmap> "set x {event Unmap}" + set x xyzzy + event generate .t.f <Unmap> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Unmap} <Unmap>} + + +test bind-27.1 {button names} -body { + bind .t <Expose-1> foo +} -returnCodes error -result {specified button "1" for non-button event} +test bind-27.2 {button names} -body { + bind .t <Button-6> foo +} -returnCodes error -result {specified keysym "6" for non-key event} +test bind-27.3 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-1> {lappend x "button 1"} + set x [bind .t.f] + event generate .t.f <Button-1> + event generate .t.f <ButtonRelease-1> + set x +} -cleanup { + destroy .t.f +} -result {<Button-1> {button 1}} +test bind-27.4 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-2> {lappend x "button 2"} + set x [bind .t.f] + event generate .t.f <Button-2> + event generate .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {<Button-2> {button 2}} +test bind-27.5 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-3> {lappend x "button 3"} + set x [bind .t.f] + event generate .t.f <Button-3> + event generate .t.f <ButtonRelease-3> + set x +} -cleanup { + destroy .t.f +} -result {<Button-3> {button 3}} +test bind-27.6 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-4> {lappend x "button 4"} + set x [bind .t.f] + event generate .t.f <Button-4> + event generate .t.f <ButtonRelease-4> + set x +} -cleanup { + destroy .t.f +} -result {<Button-4> {button 4}} +test bind-27.7 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-5> {lappend x "button 5"} + set x [bind .t.f] + event generate .t.f <Button-5> + event generate .t.f <ButtonRelease-5> + set x +} -cleanup { + destroy .t.f +} -result {<Button-5> {button 5}} + +test bind-28.1 {keysym names} -body { + bind .t <Expose-a> foo +} -returnCodes error -result {specified keysym "a" for non-key event} +test bind-28.2 {keysym names} -body { + bind .t <Gorp> foo +} -returnCodes error -result {bad event type or keysym "Gorp"} +test bind-28.3 {keysym names} -body { + bind .t <Key-Stupid> foo +} -returnCodes error -result {bad event type or keysym "Stupid"} +test bind-28.4 {keysym names} -body { + frame .t.f -class Test -width 150 -height 100 + bind .t.f <a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result {a} + +test bind-28.5 {keysym names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key-colon> "lappend x \"keysym received\"" + bind .t.f <Key-underscore> "lappend x {bad binding match}" + set x [lsort [bind .t.f]] + event generate .t.f <Key-colon> ;# -state 0 + set x +} -cleanup { + destroy .t.f +} -result {: _ {keysym received}} +test bind-28.6 {keysym names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key-Return> "lappend x \"keysym Return\"" + bind .t.f <Key-x> "lappend x {bad binding match}" + set x [lsort [bind .t.f]] + event generate .t.f <Key-Return> -state 0 + set x +} -cleanup { + destroy .t.f +} -result {<Key-Return> x {keysym Return}} +test bind-28.7 {keysym names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key-X> "lappend x \"keysym X\"" + bind .t.f <Key-x> "lappend x {bad binding match}" + set x [lsort [bind .t.f]] + event generate .t.f <Key-X> -state 1 + set x +} -cleanup { + destroy .t.f +} -result {X x {keysym X}} +test bind-28.8 {keysym names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key-X> "lappend x \"keysym X\"" + bind .t.f <Key-x> "lappend x {bad binding match}" + set x [lsort [bind .t.f]] + event generate .t.f <Key-X> -state 1 + set x +} -cleanup { + destroy .t.f +} -result {X x {keysym X}} + + +test bind-29.1 {Tk_BackgroundError procedure} -setup { + proc bgerror msg { + global x errorInfo + set x [list $msg $errorInfo] + } + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {error "This is a test"} set x none - event gen .b.f <Button> - event gen .b.f <ButtonRelease> + event generate .t.f <Button> + event generate .t.f <ButtonRelease> update set x -} {{This is a test} {This is a test +} -cleanup { + destroy .t.f + rename bgerror {} +} -result {{This is a test} {This is a test while executing "error "This is a test"" (command bound to event)}} -test bind-30.2 {Tk_BackgroundError procedure} { + +test bind-29.2 {Tk_BackgroundError procedure} -setup { proc do {} { - event gen .b.f <Button> - event gen .b.f <ButtonRelease> + event generate .t.f <Button> + event generate .t.f <ButtonRelease> + } + proc bgerror msg { + global x errorInfo + set x [list $msg $errorInfo] } - setup - bind .b.f <Button> {error Message2} + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {error Message2} set x none do update set x -} {Message2 {Message2 +} -cleanup { + destroy .t.f + rename bgerror {} + rename do {} +} -result {Message2 {Message2 while executing "error Message2" (command bound to event)}} -rename bgerror {} -test bind-31.1 {MouseWheel events} { - setup + +test bind-30.1 {MouseWheel events} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <MouseWheel> {set x Wheel} - event gen .b.f <MouseWheel> +} -body { + bind .t.f <MouseWheel> {set x Wheel} + event generate .t.f <MouseWheel> set x -} {Wheel} -test bind-31.2 {MouseWheel events} { - setup +} -cleanup { + destroy .t.f +} -result {Wheel} +test bind-30.2 {MouseWheel events} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <MouseWheel> {set x %D} - event gen .b.f <MouseWheel> -delta 120 +} -body { + bind .t.f <MouseWheel> {set x %D} + event generate .t.f <MouseWheel> -delta 120 set x -} {120} -test bind-31.3 {MouseWheel events} { - setup +} -cleanup { + destroy .t.f +} -result {120} +test bind-30.3 {MouseWheel events} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <MouseWheel> {set x "%D %x %y"} - event gen .b.f <MouseWheel> -delta 240 -x 10 -y 30 +} -body { + bind .t.f <MouseWheel> {set x "%D %x %y"} + event generate .t.f <MouseWheel> -delta 240 -x 10 -y 30 set x -} {240 10 30} +} -cleanup { + destroy .t.f +} -result {240 10 30} + -test bind-32.1 {virtual event user_data field - bad generation} { - setup - # Check no confusion, since Focus events use %d for something else - list [catch {event gen .b.f <FocusIn> -data foo} msg] $msg -} {1 {<FocusIn> event doesn't accept "-data" option}} -test bind-32.2 {virtual event user_data field - NULL, synch} { - setup +test bind-31.1 {virtual event user_data field - bad generation} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { +# Check no confusion, since Focus events use %d for something else + event generate .t.f <FocusIn> -data foo +} -cleanup { + destroy .t.f +} -returnCodes error -result {<FocusIn> event doesn't accept "-data" option} +test bind-31.2 {virtual event user_data field - NULL, synch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event generate .t.f <<TestUserData>> set x -} {TestUserData >{}<} -test bind-32.3 {virtual event user_data field - shared, synch} { - setup +} -cleanup { + destroy .t.f +} -result {TestUserData >{}<} +test bind-31.3 {virtual event user_data field - shared, synch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -data "foo bar" +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event generate .t.f <<TestUserData>> -data "foo bar" set x -} {TestUserData >foo bar<} -test bind-32.4 {virtual event user_data field - unshared, synch} { - setup +} -cleanup { + destroy .t.f +} -result {TestUserData >foo bar<} +test bind-31.4 {virtual event user_data field - unshared, synch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -data [string index abc 1] +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event generate .t.f <<TestUserData>> -data [string index abc 1] set x -} {TestUserData >b<} +} -cleanup { + destroy .t.f +} -result {TestUserData >b<} # Note that asynch event handling can only really catch any potential # extra errors when used in combination with a tool like Purify or # Valgrind. Such testing is rarely done, but at least any problem with # reference handling will eventually show up with these tests... -test bind-32.5 {virtual event user_data field - NULL, asynch} { - setup +test bind-31.5 {virtual event user_data field - NULL, asynch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -when head +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event generate .t.f <<TestUserData>> -when head list $x [update] $x -} {{} {} {TestUserData >{}<}} -test bind-32.6 {virtual event user_data field - shared, asynch} { - setup +} -cleanup { + destroy .t.f +} -result {{} {} {TestUserData >{}<}} +test bind-31.6 {virtual event user_data field - shared, asynch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -data "foo bar" -when head +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event generate .t.f <<TestUserData>> -data "foo bar" -when head list $x [update] $x -} {{} {} {TestUserData >foo bar<}} -test bind-32.7 {virtual event user_data field - unshared, asynch} { - setup +} -cleanup { + destroy .t.f +} -result {{} {} {TestUserData >foo bar<}} +test bind-31.7 {virtual event user_data field - unshared, asynch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -data [string index abc 1] -when head +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event generate .t.f <<TestUserData>> -data [string index abc 1] -when head list $x [update] $x -} {{} {} {TestUserData >b<}} +} -cleanup { + destroy .t.f +} -result {{} {} {TestUserData >b<}} -destroy .b # cleanup cleanupTests diff --git a/tests/bitmap.test b/tests/bitmap.test index 6e2255c..6e2573f 100644 --- a/tests/bitmap.test +++ b/tests/bitmap.test @@ -6,55 +6,71 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} testbitmap { +test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} -constraints { + testbitmap +} -body { set x gray25 - lindex $x 0 - destroy .b1 - button .b1 -bitmap $x + lindex $x 0 + button .b -bitmap $x lindex $x 0 testbitmap gray25 -} {{1 0}} -test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} testbitmap { +} -cleanup { + destroy .b +} -result {{1 0}} +test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} -constraints { + testbitmap +} -setup { + set result {} +} -body { set x gray25 - destroy .b1 .b2 button .b1 -bitmap $x destroy .b1 - set result {} lappend result [testbitmap gray25] button .b2 -bitmap $x lappend result [testbitmap gray25] -} {{} {{1 1}}} -test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} testbitmap { - set x gray25 +} -cleanup { destroy .b1 .b2 - button .b1 -bitmap $x +} -result {{} {{1 1}}} +test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} -constraints { + testbitmap +} -setup { set result {} +} -body { + set x gray25 + button .b1 -bitmap $x lappend result [testbitmap gray25] button .b2 -bitmap $x pack .b1 .b2 -side top lappend result [testbitmap gray25] -} {{{1 1}} {{2 1}}} +} -cleanup { + destroy .b1 .b2 +} -result {{{1 1}} {{2 1}}} -test bitmap-2.1 {Tk_GetBitmap procedure} { - destroy .b1 - list [catch {button .b1 -bitmap bad_name} msg] $msg -} {1 {bitmap "bad_name" not defined}} -test bitmap-2.2 {Tk_GetBitmap procedure} { - destroy .b1 - list [catch {button .b1 -bitmap @xyzzy} msg] $msg -} {1 {error reading bitmap file "xyzzy"}} +test bitmap-2.1 {Tk_GetBitmap procedure} -body { + button .b1 -bitmap bad_name +} -cleanup { + destroy .b1 +} -returnCodes error -result {bitmap "bad_name" not defined} +test bitmap-2.2 {Tk_GetBitmap procedure} -body { + button .b1 -bitmap @xyzzy +} -cleanup { + destroy .b1 +} -returnCodes error -result {error reading bitmap file "xyzzy"} -test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} testbitmap { +test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} -constraints { + testbitmap +} -setup { + set result {} +} -body { set x questhead - destroy .b1 .b2 .b3 button .b1 -bitmap $x button .b3 -bitmap $x button .b2 -bitmap $x - set result {} lappend result [testbitmap questhead] destroy .b1 lappend result [testbitmap questhead] @@ -62,15 +78,18 @@ test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} testbitmap { lappend result [testbitmap questhead] destroy .b3 lappend result [testbitmap questhead] -} {{{3 1}} {{2 1}} {{1 1}} {}} +} -cleanup { + destroy .b1 .b2 .b3 ;# destroying just in case +} -result {{{3 1}} {{2 1}} {{1 1}} {}} -test bitmap-4.1 {FreeBitmapObjProc} testbitmap { - destroy .b - set x [format questhead] +test bitmap-4.1 {FreeBitmapObjProc} -constraints { + testbitmap +} -body { + set x [join questhead] button .b -bitmap $x - set y [format questhead] + set y [join questhead] .b configure -bitmap $y - set z [format questhead] + set z [join questhead] .b configure -bitmap $z set result {} lappend result [testbitmap questhead] @@ -81,10 +100,11 @@ test bitmap-4.1 {FreeBitmapObjProc} testbitmap { destroy .b lappend result [testbitmap questhead] set y bogus - set result -} {{{1 3}} {{1 2}} {{1 1}} {}} + return $result +} -cleanup { + destroy .b +} -result {{{1 3}} {{1 2}} {{1 1}} {}} -destroy .t # cleanup cleanupTests diff --git a/tests/border.test b/tests/border.test index 30aed91..981e640 100644 --- a/tests/border.test +++ b/tests/border.test @@ -5,49 +5,60 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -if {[testConstraint pseudocolor8]} { - toplevel .t -visual {pseudocolor 8} -colormap new - wm geom .t +0+0 -} - -test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} testborder { +test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} -constraints { + testborder +} -body { set x orange lindex $x 0 - destroy .b1 button .b1 -bg $x -text .b1 lindex $x 0 testborder orange -} {{1 0}} -test border-1.3 {Tk_AllocBorderFromObj - discard stale border} testborder { +} -cleanup { + destroy .b1 +} -result {{1 0}} +test border-1.2 {Tk_AllocBorderFromObj - discard stale border} -constraints { + testborder +} -setup { + set result {} +} -body { set x orange - destroy .b1 .b2 button .b1 -bg $x -text First destroy .b1 - set result {} lappend result [testborder orange] button .b2 -bg $x -text Second lappend result [testborder orange] -} {{} {{1 1}}} -test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} testborder { - set x orange +} -cleanup { destroy .b1 .b2 - button .b1 -bg $x -text First +} -result {{} {{1 1}}} +test border-1.3 {Tk_AllocBorderFromObj - reuse existing border} -constraints { + testborder +} -setup { set result {} +} -body { + set x orange + button .b1 -bg $x -text First lappend result [testborder orange] button .b2 -bg $x -text Second pack .b1 .b2 -side top lappend result [testborder orange] -} {{{1 1}} {{2 1}}} -test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {pseudocolor8 testborder} { +} -cleanup { + destroy .b1 .b2 +} -result {{{1 1}} {{2 1}}} +test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} -constraints { + testborder pseudocolor8 +} -setup { + toplevel .t -visual {pseudocolor 8} -colormap new + wm geom .t +0+0 + set result {} +} -body { set x purple - destroy .b1 .b2 .t.b button .b1 -bg $x -text First pack .b1 -side top - set result {} lappend result [testborder purple] button .t.b -bg $x -text Second pack .t.b -side top @@ -55,18 +66,24 @@ test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {pseudocolor button .b2 -bg $x -text Third pack .b2 -side top lappend result [testborder purple] -} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} +} -cleanup { + destroy .b1 .b2 .t +} -result {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} -test border-3.1 {Tk_Free3DBorder - reference counts} {pseudocolor8 testborder} { +test border-2.1 {Tk_Free3DBorder - reference counts} -constraints { + testborder pseudocolor8 +} -setup { + toplevel .t -visual {pseudocolor 8} -colormap new + wm geom .t +0+0 + set result {} +} -body { set x purple - destroy .b1 .b2 .t.b button .b1 -bg $x -text First pack .b1 -side top button .t.b -bg $x -text Second pack .t.b -side top button .b2 -bg $x -text Third pack .b2 -side top - set result {} lappend result [testborder purple] destroy .b1 lappend result [testborder purple] @@ -74,11 +91,18 @@ test border-3.1 {Tk_Free3DBorder - reference counts} {pseudocolor8 testborder} { lappend result [testborder purple] destroy .t.b lappend result [testborder purple] -} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}} -test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder} { - destroy .b .t.b .t2 .t3 +} -cleanup { + destroy .b1 .b2 .t +} -result {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}} +test border-2.2 {Tk_Free3DBorder - unlinking from list} -constraints { + testborder pseudocolor8 +} -setup { + toplevel .t -visual {pseudocolor 8} -colormap new + wm geom .t +0+0 toplevel .t2 -visual {pseudocolor 8} -colormap new toplevel .t3 -visual {pseudocolor 8} -colormap new + set result {} +} -body { set x purple button .b -bg $x -text .b1 button .t.b1 -bg $x -text .t.b1 @@ -90,7 +114,6 @@ test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder button .t3.b2 -bg $x -text .t3.b2 button .t3.b3 -bg $x -text .t3.b3 button .t3.b4 -bg $x -text .t3.b4 - set result {} lappend result [testborder purple] destroy .t2 lappend result [testborder purple] @@ -100,17 +123,21 @@ test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder lappend result [testborder purple] destroy .t lappend result [testborder purple] -} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}} +} -cleanup { + destroy .b .t2 .t3 .t +} -result {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}} -test border-4.1 {FreeBorderObjProc} testborder { - destroy .b - set x [format purple] +test border-3.1 {FreeBorderObjProc} -constraints { + testborder +} -setup { + set result {} +} -body { + set x [join purple] button .b -bg $x -text .b1 - set y [format purple] + set y [join purple] .b configure -bg $y - set z [format purple] + set z [join purple] .b configure -bg $z - set result {} lappend result [testborder purple] set x red lappend result [testborder purple] @@ -119,42 +146,53 @@ test border-4.1 {FreeBorderObjProc} testborder { destroy .b lappend result [testborder purple] set y bogus - set result -} {{{1 3}} {{1 2}} {{1 1}} {}} + return $result +} -cleanup { + destroy .b +} -result {{{1 3}} {{1 2}} {{1 1}} {}} -catch {destroy .b} -button .b -test border-5.1 {Tk_GetReliefFromObj} { - .b configure -relief flat +test border-4.1 {Tk_GetReliefFromObj} -body { + button .b -relief flat .b cget -relief -} {flat} -test border-5.2 {Tk_GetReliefFromObj} { - .b configure -relief groove +} -cleanup { + destroy .b +} -result {flat} +test border-4.2 {Tk_GetReliefFromObj} -body { + button .b -relief groove .b cget -relief -} {groove} -test border-5.3 {Tk_GetReliefFromObj} { - .b configure -relief raised +} -cleanup { + destroy .b +} -result {groove} +test border-4.3 {Tk_GetReliefFromObj} -body { + button .b -relief raised .b cget -relief -} {raised} -test border-5.4 {Tk_GetReliefFromObj} { - .b configure -relief ridge +} -cleanup { + destroy .b +} -result {raised} +test border-4.4 {Tk_GetReliefFromObj} -body { + button .b -relief ridge .b cget -relief -} {ridge} -test border-5.5 {Tk_GetReliefFromObj} { - .b configure -relief solid +} -cleanup { + destroy .b +} -result {ridge} +test border-4.5 {Tk_GetReliefFromObj} -body { + button .b -relief solid .b cget -relief -} {solid} -test border-5.6 {Tk_GetReliefFromObj} { - .b configure -relief sunken +} -cleanup { + destroy .b +} -result {solid} +test border-4.6 {Tk_GetReliefFromObj} -body { + button .b -relief sunken .b cget -relief -} {sunken} -test border-5.7 {Tk_GetReliefFromObj - error} { - list [catch {.b configure -relief upanddown} msg] $msg -} {1 {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}} +} -cleanup { + destroy .b +} -result {sunken} +test border-4.7 {Tk_GetReliefFromObj - error} -body { + button .b -relief upanddown +} -cleanup { + destroy .b +} -returnCodes error -result {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken} -if {[testConstraint pseudocolor8]} { - destroy .t -} # cleanup cleanupTests diff --git a/tests/bugs.tcl b/tests/bugs.tcl index 83d9519..55e5f84 100644 --- a/tests/bugs.tcl +++ b/tests/bugs.tcl @@ -1,6 +1,6 @@ # This file is a Tcl script to test out various known bugs that will # cause Tk to crash. This file ends with .tcl instead of .test to make -# sure it isn't run when you type "source all". We currently are not +# sure it isn't run when you type "source all". We currently are not # shipping this file with the rest of the source release. # # Copyright (c) 1996 Sun Microsystems, Inc. diff --git a/tests/busy.test b/tests/busy.test new file mode 100644 index 0000000..304c2eb --- /dev/null +++ b/tests/busy.test @@ -0,0 +1,477 @@ +# Tests for the tk busy command. +# +# This file contains a collection of tests for one or more of the Tk built-in +# commands. Sourcing this file runs the tests and generates output for errors. +# No output means no errors were found. +# +# Copyright (c) 1998-2000 by Jos Decoster. All rights reserved. + +package require tcltest 2.1 +tcltest::configure {*}$argv +tcltest::loadTestedCommands +namespace import -force tcltest::test + +# There's currently no way to test the actual grab effect, per se, in an +# automated test. Therefore, this test suite only covers the interface to the +# grab command (ie, error messages, etc.) + +test busy-1.1 {Tk_BusyObjCmd} -returnCodes error -body { + tk busy +} -result {wrong # args: should be "tk busy options ?arg arg ...?"} + +test busy-2.1 {tk busy hold} -returnCodes error -body { + tk busy hold +} -result {wrong # args: should be "tk busy hold window ?option value ...?"} +test busy-2.2 {tk busy hold root window} -body { + tk busy hold . + update +} -cleanup { + tk busy forget . +} -result {} +test busy-2.3 {tk busy hold root window with shortcut} -body { + tk busy . + update +} -cleanup { + tk busy forget . +} -result {} +test busy-2.4 {tk busy hold nested window} -setup { + pack [frame .f] +} -body { + tk busy hold .f + update +} -cleanup { + tk busy forget .f + destroy .f +} -result {} +test busy-2.5 {tk busy hold nested window with shortcut} -setup { + pack [frame .f] +} -body { + tk busy .f + update +} -cleanup { + tk busy forget .f + destroy .f +} -result {} +test busy-2.6 {tk busy hold toplevel window} -setup { + toplevel .f +} -body { + tk busy hold .f + update +} -cleanup { + tk busy forget .f + destroy .f +} -result {} +test busy-2.7 {tk busy hold toplevel window with shortcut} -setup { + toplevel .f +} -body { + tk busy .f + update +} -cleanup { + tk busy forget .f + destroy .f +} -result {} +test busy-2.8 {tk busy hold non existing window} -body { + tk busy hold .f + update +} -returnCodes error -result {bad window path name ".f"} +test busy-2.9 {tk busy hold (shortcut) non existing window} -body { + tk busy .f + update +} -returnCodes {error} -result {bad window path name ".f"} +test busy-2.10 {tk busy hold root window with cursor} -body { + tk busy hold . -cursor arrow + update +} -cleanup { + tk busy forget . +} -result {} +test busy-2.11 {tk busy hold (shortcut) root window, cursor} -body { + tk busy . -cursor arrow + update +} -cleanup { + tk busy forget . +} -result {} +test busy-2.12 {tk busy hold root window, invalid cursor} -body { + tk busy hold . -cursor nonExistingCursor + update +} -constraints tempNotMac -returnCodes error -cleanup { + tk busy forget . +} -result {bad cursor spec "nonExistingCursor"} +test busy-2.13 {tk busy hold (shortcut) root window, invalid cursor} -body { + tk busy . -cursor nonExistingCursor + update +} -constraints tempNotMac -returnCodes error -cleanup { + tk busy forget . +} -result {bad cursor spec "nonExistingCursor"} +test busy-2.14 {tk busy hold root window, invalid option} -body { + tk busy hold . -invalidOption 1 + update +} -constraints tempNotMac -returnCodes error -cleanup { + tk busy forget . +} -result {unknown option "-invalidOption"} +test busy-2.15 {tk busy hold (shortcut) root window, invalid option} -body { + tk busy . -invalidOption 1 + update +} -constraints tempNotMac -returnCodes error -cleanup { + tk busy forget . +} -result {unknown option "-invalidOption"} + +test busy-3.1 {tk busy cget no window} -returnCodes error -body { + tk busy cget +} -result {wrong # args: should be "tk busy cget window option"} +test busy-3.2 {tk busy cget no option} -returnCodes error -body { + tk busy cget +} -result {wrong # args: should be "tk busy cget window option"} +test busy-3.3 {tk busy cget invalid window} -returnCodes error -body { + tk busy cget .f -cursor +} -result {bad window path name ".f"} +test busy-3.4 {tk busy cget non-busy window} -setup { + pack [frame .f] +} -body { + tk busy cget .f -cursor +} -cleanup { + destroy .f +} -returnCodes error -result {can't find busy window ".f"} +test busy-3.5 {tk busy cget invalid option} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy cget .f -invalidOption +} -cleanup { + tk busy forget .f + destroy .f +} -returnCodes error -result {unknown option "-invalidOption"} +test busy-3.6unix {tk busy cget unix} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy cget .f -cursor +} -cleanup { + tk busy forget .f + destroy .f +} -result {watch} -constraints unix +test busy-3.6win {tk busy cget win} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy cget .f -cursor +} -cleanup { + tk busy forget .f + destroy .f +} -result {wait} -constraints win +test busy-3.7 {tk busy cget unix} -setup { + pack [frame .f] + tk busy hold .f -cursor hand1 + update +} -body { + tk busy cget .f -cursor +} -cleanup { + tk busy forget .f + destroy .f +} -result {hand1} -constraints tempNotMac + +test busy-4.1 {tk busy configure no window} -returnCodes error -body { + tk busy configure +} -result {wrong # args: should be "tk busy configure window ?option? ?value ...?"} + +test busy-4.2 {tk busy configure invalid window} -body { + tk busy configure .f +} -returnCodes error -result {bad window path name ".f"} + +test busy-4.3 {tk busy configure non-busy window} -setup { + pack [frame .f] +} -body { + tk busy configure .f +} -cleanup { + destroy .f +} -returnCodes error -result {can't find busy window ".f"} + +test busy-4.4 {tk busy configure} -constraints {nonwin} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy configure .f +} -cleanup { + tk busy forget .f + destroy .f +} -result {{-cursor cursor Cursor watch watch}} + +test busy-4.4-win {tk busy configure} -constraints {win} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy configure .f +} -cleanup { + tk busy forget .f + destroy .f +} -result {{-cursor cursor Cursor wait wait}} + +test busy-4.5 {tk busy configure} -constraints {nonwin tempNotMac} -setup { + pack [frame .f] + tk busy hold .f -cursor hand2 + update +} -body { + tk busy configure .f +} -cleanup { + tk busy forget .f + destroy .f +} -result {{-cursor cursor Cursor watch hand2}} + +test busy-4.5-win {tk busy configure} -constraints win -setup { + pack [frame .f] + tk busy hold .f -cursor hand2 + update +} -body { + tk busy configure .f +} -cleanup { + tk busy forget .f + destroy .f +} -result {{-cursor cursor Cursor wait hand2}} + +test busy-4.6 {tk busy configure invalid option} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy configure .f -invalidOption +} -cleanup { + tk busy forget .f + destroy .f +} -returnCodes error -result {unknown option "-invalidOption"} + +test busy-4.7 {tk busy configure valid option} -constraints {nonwin} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy configure .f -cursor +} -cleanup { + tk busy forget .f + destroy .f +} -result {-cursor cursor Cursor watch watch} + +test busy-4.7-win {tk busy configure valid option} -constraints {win} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy configure .f -cursor +} -cleanup { + tk busy forget .f + destroy .f +} -result {-cursor cursor Cursor wait wait} + +test busy-4.8 {tk busy configure valid option} -constraints { + nonwin tempNotMac +} -setup { + pack [frame .f] + tk busy hold .f -cursor circle + update +} -body { + tk busy configure .f -cursor +} -cleanup { + tk busy forget .f + destroy .f +} -result {-cursor cursor Cursor watch circle} + +test busy-4.8-win {tk busy configure valid option} -constraints win -setup { + pack [frame .f] + tk busy hold .f -cursor circle + update +} -body { + tk busy configure .f -cursor +} -cleanup { + tk busy forget .f + destroy .f +} -result {-cursor cursor Cursor wait circle} + +test busy-4.9 {tk busy configure valid option with value} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy configure .f -cursor pencil + tk busy cget .f -cursor +} -cleanup { + tk busy forget .f + destroy .f +} -result {pencil} -constraints tempNotMac + +test busy-4.10 {tk busy configure valid option with invalid value} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy configure .f -cursor nonExistingCursor +} -constraints tempNotMac -returnCodes error -cleanup { + tk busy forget .f + destroy .f +} -result {bad cursor spec "nonExistingCursor"} + +test busy-5.1 {tk busy forget} -returnCodes error -body { + tk busy forget +} -result {wrong # args: should be "tk busy forget window"} +test busy-5.2 {tk busy forget non existing window} -body { + tk busy forget .f +} -returnCodes error -result {bad window path name ".f"} +test busy-5.3 {tk busy forget non busy window} -setup { + pack [frame .f] +} -body { + tk busy forget .f +} -cleanup { + destroy .f +} -returnCodes error -result {can't find busy window ".f"} +test busy-5.4 {tk busy forget window} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + set r [tk busy status .f] + tk busy forget .f + lappend r [tk busy status .f] +} -cleanup { + destroy .f +} -result {1 0} + +test busy-6.1 {tk busy status} -returnCodes error -body { + tk busy status +} -result {wrong # args: should be "tk busy status window"} +test busy-6.2 {tk busy status non existing window} -body { + tk busy status .f +} -result {0} +test busy-6.3 {tk busy status non busy window} -setup { + pack [frame .f] +} -body { + tk busy status .f +} -cleanup { + destroy .f +} -result {0} +test busy-6.4 {tk busy status busy window} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy status .f +} -cleanup { + tk busy forget .f + destroy .f +} -result {1} +test busy-6.5 {tk busy status forgotten busy window} -setup { + pack [frame .f] + tk busy hold .f + update + tk busy forget .f +} -body { + tk busy status .f +} -cleanup { + destroy .f +} -result {0} + +test busy-7.1 {tk busy current no busy} -body { + tk busy current +} -result {} +test busy-7.2 {tk busy current 1 busy} -setup { + pack [frame .f] + tk busy hold .f + update +} -body { + tk busy current +} -cleanup { + tk busy forget .f + destroy .f +} -result {.f} +test busy-7.3 {tk busy current 2 busy} -setup { + pack [frame .f1] + pack [frame .f2] + tk busy hold .f1 + tk busy hold .f2 + update +} -body { + lsort [tk busy current] +} -cleanup { + tk busy forget .f1 + tk busy forget .f2 + destroy .f1 .f2 +} -result {.f1 .f2} +test busy-7.4 {tk busy current 2 busy with matching filter} -setup { + pack [frame .f1] + pack [frame .f2] + tk busy hold .f1 + tk busy hold .f2 + update +} -body { + lsort [tk busy current *2*] +} -cleanup { + tk busy forget .f1 + tk busy forget .f2 + destroy .f1 .f2 +} -result {.f2} +test busy-7.5 {tk busy current 2 busy with non matching filter} -setup { + pack [frame .f1] + pack [frame .f2] + tk busy hold .f1 + tk busy hold .f2 + update +} -body { + lsort [tk busy current *3*] +} -cleanup { + tk busy forget .f1 + tk busy forget .f2 + destroy .f1 .f2 +} -result {} +test busy-7.6 {tk busy current 1 busy after forget} -setup { + pack [frame .f] + tk busy hold .f + update + tk busy forget .f +} -body { + tk busy current +} -cleanup { + destroy .f +} -result {} +test busy-7.7 {tk busy current 2 busy after forget} -setup { + pack [frame .f1] + pack [frame .f2] + tk busy hold .f1 + tk busy hold .f2 + update + tk busy forget .f1 +} -body { + lsort [tk busy current] +} -cleanup { + tk busy forget .f2 + destroy .f1 .f2 +} -result {.f2} +test busy-7.8 {tk busy current 2 busy with matching filter after forget} -setup { + pack [frame .f1] + pack [frame .f2] + tk busy hold .f1 + tk busy hold .f2 + update + tk busy forget .f1 +} -body { + lsort [tk busy current *2*] +} -cleanup { + tk busy forget .f2 + destroy .f1 .f2 +} -result {.f2} +test busy-7.9 {tk busy current 2 busy with non matching filter after forget} -setup { + pack [frame .f1] + pack [frame .f2] + tk busy hold .f1 + tk busy hold .f2 + update + tk busy forget .f1 +} -body { + lsort [tk busy current *3*] +} -cleanup { + tk busy forget .f2 + destroy .f1 .f2 +} -result {} + +::tcltest::cleanupTests +return diff --git a/tests/butGeom2.tcl b/tests/butGeom2.tcl index 96ff209..096225c 100644 --- a/tests/butGeom2.tcl +++ b/tests/butGeom2.tcl @@ -35,7 +35,7 @@ pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top -anchor w foreach opt {activebackground activeforeground background disabledforeground foreground highlightbackground highlightcolor } { #button .t.color-$opt -text $opt -command "config -$opt \[tk_chooseColor]" menubutton .t.color-$opt -text $opt -menu .t.color-$opt.m -indicatoron 1 \ - -relief raised -bd 2 + -relief raised -bd 2 menu .t.color-$opt.m -tearoff 0 .t.color-$opt.m add command -label Red -command "config -$opt red" .t.color-$opt.m add command -label Green -command "config -$opt green" diff --git a/tests/button.test b/tests/button.test index 927aac0..984fd43 100644 --- a/tests/button.test +++ b/tests/button.test @@ -7,427 +7,3201 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +imageInit proc bogusTrace args { error "trace aborted" } -catch {unset value} -catch {unset value2} -# Create entries in the option database to be sure that geometry options -# like border width have predictable values. +test button-1.1 {configuration option: "activebackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -activebackground #012345 + .l cget -activebackground +} -cleanup { + destroy .l +} -result {#012345} +test button-1.2 {configuration option: "activebackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -activebackground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.3 {configuration option: "activebackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -activebackground #012345 + .b cget -activebackground +} -cleanup { + destroy .b +} -result {#012345} +test button-1.4 {configuration option: "activebackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -activebackground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.5 {configuration option: "activebackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -activebackground #012345 + .c cget -activebackground +} -cleanup { + destroy .c +} -result {#012345} +test button-1.6 {configuration option: "activebackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -activebackground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.7 {configuration option: "activebackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -activebackground #012345 + .r cget -activebackground +} -cleanup { + destroy .r +} -result {#012345} +test button-1.8 {configuration option: "activebackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -activebackground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.9 {configuration option: "activeforeground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -activeforeground #ff0000 + .l cget -activeforeground +} -cleanup { + destroy .l +} -result {#ff0000} +test button-1.10 {configuration option: "activeforeground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -activeforeground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.11 {configuration option: "activeforeground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -activeforeground #ff0000 + .b cget -activeforeground +} -cleanup { + destroy .b +} -result {#ff0000} +test button-1.12 {configuration option: "activeforeground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -activeforeground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.13 {configuration option: "activeforeground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -activeforeground #ff0000 + .c cget -activeforeground +} -cleanup { + destroy .c +} -result {#ff0000} +test button-1.14 {configuration option: "activeforeground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -activeforeground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.15 {configuration option: "activeforeground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -activeforeground #ff0000 + .r cget -activeforeground +} -cleanup { + destroy .r +} -result {#ff0000} +test button-1.16 {configuration option: "activeforeground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -activeforeground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.17 {configuration option: "anchor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -anchor nw + .l cget -anchor +} -cleanup { + destroy .l +} -result {nw} +test button-1.18 {configuration option: "anchor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -anchor bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} +test button-1.19 {configuration option: "anchor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -anchor nw + .b cget -anchor +} -cleanup { + destroy .b +} -result {nw} +test button-1.20 {configuration option: "anchor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -anchor bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} +test button-1.21 {configuration option: "anchor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -anchor nw + .c cget -anchor +} -cleanup { + destroy .c +} -result {nw} +test button-1.22 {configuration option: "anchor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -anchor bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} +test button-1.23 {configuration option: "anchor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -anchor nw + .r cget -anchor +} -cleanup { + destroy .r +} -result {nw} +test button-1.24 {configuration option: "anchor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -anchor bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} + +test button-1.25 {configuration option: "background" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -background #ff0000 + .l cget -background +} -cleanup { + destroy .l +} -result {#ff0000} +test button-1.26 {configuration option: "background" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -background non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.27 {configuration option: "background" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -background #ff0000 + .b cget -background +} -cleanup { + destroy .b +} -result {#ff0000} +test button-1.28 {configuration option: "background" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -background non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.29 {configuration option: "background" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -background #ff0000 + .c cget -background +} -cleanup { + destroy .c +} -result {#ff0000} +test button-1.30 {configuration option: "background" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -background non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.31 {configuration option: "background" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -background #ff0000 + .r cget -background +} -cleanup { + destroy .r +} -result {#ff0000} +test button-1.32 {configuration option: "background" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -background non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.33 {configuration option: "bd" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bd 4 + .l cget -bd +} -cleanup { + destroy .l +} -result {4} +test button-1.34 {configuration option: "bd" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bd badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.35 {configuration option: "bd" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bd 4 + .b cget -bd +} -cleanup { + destroy .b +} -result {4} +test button-1.36 {configuration option: "bd" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bd badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.37 {configuration option: "bd" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bd 4 + .c cget -bd +} -cleanup { + destroy .c +} -result {4} +test button-1.38 {configuration option: "bd" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bd badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.39 {configuration option: "bd" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bd 4 + .r cget -bd +} -cleanup { + destroy .r +} -result {4} +test button-1.40 {configuration option: "bd" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bd badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "badValue"} + +test button-1.41 {configuration option: "bg" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bg #ff0000 + .l cget -bg +} -cleanup { + destroy .l +} -result {#ff0000} +test button-1.42 {configuration option: "bg" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bg non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.43 {configuration option: "bg" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bg #ff0000 + .b cget -bg +} -cleanup { + destroy .b +} -result {#ff0000} +test button-1.44 {configuration option: "bg" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bg non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.45 {configuration option: "bg" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bg #ff0000 + .c cget -bg +} -cleanup { + destroy .c +} -result {#ff0000} +test button-1.46 {configuration option: "bg" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bg non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.47 {configuration option: "bg" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bg #ff0000 + .r cget -bg +} -cleanup { + destroy .r +} -result {#ff0000} +test button-1.48 {configuration option: "bg" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bg non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.49 {configuration option: "bitmap" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bitmap questhead + .l cget -bitmap +} -cleanup { + destroy .l +} -result {questhead} +test button-1.50 {configuration option: "bitmap" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -bitmap badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bitmap "badValue" not defined} +test button-1.51 {configuration option: "bitmap" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bitmap questhead + .b cget -bitmap +} -cleanup { + destroy .b +} -result {questhead} +test button-1.52 {configuration option: "bitmap" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -bitmap badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bitmap "badValue" not defined} +test button-1.53 {configuration option: "bitmap" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bitmap questhead + .c cget -bitmap +} -cleanup { + destroy .c +} -result {questhead} +test button-1.54 {configuration option: "bitmap" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -bitmap badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bitmap "badValue" not defined} +test button-1.55 {configuration option: "bitmap" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bitmap questhead + .r cget -bitmap +} -cleanup { + destroy .r +} -result {questhead} +test button-1.56 {configuration option: "bitmap" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -bitmap badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bitmap "badValue" not defined} + +test button-1.57 {configuration option: "borderwidth" for label} -setup { + label .l -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -borderwidth 1.3 + .l cget -borderwidth +} -cleanup { + destroy .l +} -result {1.3} +test button-1.58 {configuration option: "borderwidth" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -borderwidth badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.59 {configuration option: "borderwidth" for button} -setup { + button .b -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -borderwidth 1.3 + .b cget -borderwidth +} -cleanup { + destroy .b +} -result {1.3} +test button-1.60 {configuration option: "borderwidth" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -borderwidth badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.61 {configuration option: "borderwidth" for checkbutton} -setup { + checkbutton .c -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -borderwidth 1.3 + .c cget -borderwidth +} -cleanup { + destroy .c +} -result {1.3} +test button-1.62 {configuration option: "borderwidth" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -borderwidth badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.63 {configuration option: "borderwidth" for radiobutton} -setup { + radiobutton .r -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -borderwidth 1.3 + .r cget -borderwidth +} -cleanup { + destroy .r +} -result {1.3} +test button-1.64 {configuration option: "borderwidth" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -borderwidth badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "badValue"} + +test button-1.65 {configuration option: "command" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -command {set x} + .b cget -command +} -cleanup { + destroy .b +} -result {set x} +test button-1.66 {configuration option: "command" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -command {set x} + .b cget -command +} -cleanup { + destroy .b +} -result {set x} +test button-1.67 {configuration option: "command" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -command {set x} + .c cget -command +} -cleanup { + destroy .c +} -result {set x} +test button-1.68 {configuration option: "command" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -command {set x} + .r cget -command +} -cleanup { + destroy .r +} -result {set x} + +test button-1.69 {configuration option: "compound" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -compound left + .l cget -compound +} -cleanup { + destroy .l +} -result {left} +test button-1.70 {configuration option: "compound" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -compound bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad compound "bogus": must be bottom, center, left, none, right, or top} +test button-1.71 {configuration option: "compound" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -compound left + .b cget -compound +} -cleanup { + destroy .b +} -result {left} +test button-1.72 {configuration option: "compound" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -compound bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad compound "bogus": must be bottom, center, left, none, right, or top} +test button-1.73 {configuration option: "compound" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -compound left + .c cget -compound +} -cleanup { + destroy .c +} -result {left} +test button-1.74 {configuration option: "compound" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -compound bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad compound "bogus": must be bottom, center, left, none, right, or top} +test button-1.75 {configuration option: "compound" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -compound left + .r cget -compound +} -cleanup { + destroy .r +} -result {left} +test button-1.76 {configuration option: "compound" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -compound bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad compound "bogus": must be bottom, center, left, none, right, or top} + +test button-1.77 {configuration option: "cursor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -cursor arrow + .l cget -cursor +} -cleanup { + destroy .l +} -result {arrow} +test button-1.78 {configuration option: "cursor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -cursor badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad cursor spec "badValue"} +test button-1.79 {configuration option: "cursor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -cursor arrow + .b cget -cursor +} -cleanup { + destroy .b +} -result {arrow} +test button-1.80 {configuration option: "cursor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -cursor badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad cursor spec "badValue"} +test button-1.81 {configuration option: "cursor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -cursor arrow + .c cget -cursor +} -cleanup { + destroy .c +} -result {arrow} +test button-1.82 {configuration option: "cursor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -cursor badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad cursor spec "badValue"} +test button-1.83 {configuration option: "cursor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -cursor arrow + .r cget -cursor +} -cleanup { + destroy .r +} -result {arrow} +test button-1.84 {configuration option: "cursor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -cursor badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test button-1.85 {configuration option: "default" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -default active + .b cget -default +} -cleanup { + destroy .b +} -result {active} +test button-1.86 {configuration option: "default" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -default huh? +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad default "huh?": must be active, disabled, or normal} + +test button-1.87 {configuration option: "disabledforeground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -disabledforeground #00ff00 + .l cget -disabledforeground +} -cleanup { + destroy .l +} -result {#00ff00} +test button-1.88 {configuration option: "disabledforeground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -disabledforeground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.89 {configuration option: "disabledforeground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -disabledforeground #00ff00 + .b cget -disabledforeground +} -cleanup { + destroy .b +} -result {#00ff00} +test button-1.90 {configuration option: "disabledforeground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -disabledforeground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.91 {configuration option: "disabledforeground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -disabledforeground #00ff00 + .c cget -disabledforeground +} -cleanup { + destroy .c +} -result {#00ff00} +test button-1.92 {configuration option: "disabledforeground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -disabledforeground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.93 {configuration option: "disabledforeground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -disabledforeground #00ff00 + .r cget -disabledforeground +} -cleanup { + destroy .r +} -result {#00ff00} +test button-1.94 {configuration option: "disabledforeground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -disabledforeground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.95 {configuration option: "fg" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -fg #110022 + .l cget -fg +} -cleanup { + destroy .l +} -result {#110022} +test button-1.96 {configuration option: "fg" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -fg non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.97 {configuration option: "fg" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -fg #110022 + .b cget -fg +} -cleanup { + destroy .b +} -result {#110022} +test button-1.98 {configuration option: "fg" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -fg non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.99 {configuration option: "fg" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -fg #110022 + .c cget -fg +} -cleanup { + destroy .c +} -result {#110022} +test button-1.100 {configuration option: "fg" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -fg non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.101 {configuration option: "fg" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -fg #110022 + .r cget -fg +} -cleanup { + destroy .r +} -result {#110022} +test button-1.102 {configuration option: "fg" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -fg non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.103 {configuration option: "font" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 + pack .l + update +} -body { + .l configure -font {Helvetica -12} + .l cget -font +} -cleanup { + destroy .l +} -result {Helvetica -12} +test button-1.104 {configuration option: "activebackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 + pack .l + update +} -body { + .l configure -font {} +} -cleanup { + destroy .l +} -returnCodes {error} -result {font "" doesn't exist} +test button-1.105 {configuration option: "font" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 + pack .b + update +} -body { + .b configure -font {Helvetica -12} + .b cget -font +} -cleanup { + destroy .b +} -result {Helvetica -12} +test button-1.106 {configuration option: "activebackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 + pack .b + update +} -body { + .b configure -font {} +} -cleanup { + destroy .b +} -returnCodes {error} -result {font "" doesn't exist} +test button-1.107 {configuration option: "font" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 + pack .c + update +} -body { + .c configure -font {Helvetica -12} + .c cget -font +} -cleanup { + destroy .c +} -result {Helvetica -12} +test button-1.108 {configuration option: "activebackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 + pack .c + update +} -body { + .c configure -font {} +} -cleanup { + destroy .c +} -returnCodes {error} -result {font "" doesn't exist} +test button-1.109 {configuration option: "font" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 + pack .r + update +} -body { + .r configure -font {Helvetica -12} + .r cget -font +} -cleanup { + destroy .r +} -result {Helvetica -12} +test button-1.110 {configuration option: "activebackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 + pack .r + update +} -body { + .r configure -font {} +} -cleanup { + destroy .r +} -returnCodes {error} -result {font "" doesn't exist} -option add *Button.borderWidth 2 -option add *Button.highlightThickness 2 -option add *Button.font {Helvetica -12 bold} +test button-1.111 {configuration option: "foreground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -foreground #110022 + .l cget -foreground +} -cleanup { + destroy .l +} -result {#110022} +test button-1.112 {configuration option: "foreground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -foreground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.113 {configuration option: "foreground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -foreground #110022 + .b cget -foreground +} -cleanup { + destroy .b +} -result {#110022} +test button-1.114 {configuration option: "foreground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -foreground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.115 {configuration option: "foreground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -foreground #110022 + .c cget -foreground +} -cleanup { + destroy .c +} -result {#110022} +test button-1.116 {configuration option: "foreground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -foreground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.117 {configuration option: "foreground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -foreground #110022 + .r cget -foreground +} -cleanup { + destroy .r +} -result {#110022} +test button-1.118 {configuration option: "foreground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -foreground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} -eval image delete [image names] -if {[testConstraint testImageType]} { +test button-1.119 {configuration option: "height" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -height 18 + .l cget -height +} -cleanup { + destroy .l +} -result {18} +test button-1.120 {configuration option: "height" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -height 20.0 +} -cleanup { + destroy .l +} -returnCodes {error} -result {expected integer but got "20.0"} +test button-1.121 {configuration option: "height" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -height 18 + .b cget -height +} -cleanup { + destroy .b +} -result {18} +test button-1.122 {configuration option: "height" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -height 20.0 +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "20.0"} +test button-1.123 {configuration option: "height" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -height 18 + .c cget -height +} -cleanup { + destroy .c +} -result {18} +test button-1.124 {configuration option: "height" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -height 20.0 +} -cleanup { + destroy .c +} -returnCodes {error} -result {expected integer but got "20.0"} +test button-1.125 {configuration option: "height" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -height 18 + .r cget -height +} -cleanup { + destroy .r +} -result {18} +test button-1.126 {configuration option: "height" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -height 20.0 +} -cleanup { + destroy .r +} -returnCodes {error} -result {expected integer but got "20.0"} + +test button-1.127 {configuration option: "highlightbackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightbackground #110022 + .l cget -highlightbackground +} -cleanup { + destroy .l +} -result {#110022} +test button-1.128 {configuration option: "highlightbackground" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightbackground non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.129 {configuration option: "highlightbackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightbackground #110022 + .b cget -highlightbackground +} -cleanup { + destroy .b +} -result {#110022} +test button-1.130 {configuration option: "highlightbackground" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightbackground non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.131 {configuration option: "highlightbackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightbackground #110022 + .c cget -highlightbackground +} -cleanup { + destroy .c +} -result {#110022} +test button-1.132 {configuration option: "highlightbackground" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightbackground non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.133 {configuration option: "highlightbackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightbackground #110022 + .r cget -highlightbackground +} -cleanup { + destroy .r +} -result {#110022} +test button-1.134 {configuration option: "highlightbackground" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightbackground non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.135 {configuration option: "highlightcolor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightcolor #110022 + .l cget -highlightcolor +} -cleanup { + destroy .l +} -result {#110022} +test button-1.136 {configuration option: "highlightcolor" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightcolor non-existent +} -cleanup { + destroy .l +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.137 {configuration option: "highlightcolor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightcolor #110022 + .b cget -highlightcolor +} -cleanup { + destroy .b +} -result {#110022} +test button-1.138 {configuration option: "highlightcolor" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightcolor non-existent +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.139 {configuration option: "highlightcolor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightcolor #110022 + .c cget -highlightcolor +} -cleanup { + destroy .c +} -result {#110022} +test button-1.140 {configuration option: "highlightcolor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightcolor non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.141 {configuration option: "highlightcolor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightcolor #110022 + .r cget -highlightcolor +} -cleanup { + destroy .r +} -result {#110022} +test button-1.142 {configuration option: "highlightcolor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightcolor non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.143 {configuration option: "highlightthickness" for label} -setup { + label .l -borderwidth 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightthickness 6m + .l cget -highlightthickness +} -cleanup { + destroy .l +} -result {6m} +test button-1.144 {configuration option: "highlightthickness" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -highlightthickness badValue +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.145 {configuration option: "highlightthickness" for button} -setup { + button .b -borderwidth 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightthickness 6m + .b cget -highlightthickness +} -cleanup { + destroy .b +} -result {6m} +test button-1.146 {configuration option: "highlightthickness" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -highlightthickness badValue +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.147 {configuration option: "highlightthickness" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightthickness 6m + .c cget -highlightthickness +} -cleanup { + destroy .c +} -result {6m} +test button-1.148 {configuration option: "highlightthickness" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -highlightthickness badValue +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "badValue"} +test button-1.149 {configuration option: "highlightthickness" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightthickness 6m + .r cget -highlightthickness +} -cleanup { + destroy .r +} -result {6m} +test button-1.150 {configuration option: "highlightthickness" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -highlightthickness badValue +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "badValue"} + +test button-1.151 {configuration option: "image" for label} -constraints { + testImageType +} -setup { image create test image1 -} -label .l -text Label -button .b -text Button -checkbutton .c -text Checkbutton -radiobutton .r -text Radiobutton -pack .l .b .c .r -update -set i 1 -foreach test { - {-activebackground #012345 #012345 non-existent - {unknown color name "non-existent"} {1 1 1 1}} - {-activeforeground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"} {1 1 1 1}} - {-anchor nw nw bogus - {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} - {1 1 1 1}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"} {1 1 1 1}} - {-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"} - {1 1 1 1}} - {-bitmap questhead questhead badValue {bitmap "badValue" not defined} - {1 1 1 1}} - {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"} {1 1 1 1}} - {-command "set x" {set x} {} {} {0 1 1 1}} - {-compound left left bogus - {bad compound "bogus": must be bottom, center, left, none, right, or top} - {1 1 1 1}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"} {1 1 1 1}} - {-default active active huh? - {bad default "huh?": must be active, disabled, or normal} - {0 1 0 0}} - {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"} - {1 1 1 1}} - {-fg #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}} - {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist} {1 1 1 1}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}} - {-height 18 18 20.0 {expected integer but got "20.0"} {1 1 1 1}} - {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"} - {1 1 1 1}} - {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"} - {1 1 1 1}} - {-highlightthickness 6m 6m badValue {bad screen distance "badValue"} - {1 1 1 1}} - {-image image1 image1 bogus {image "bogus" doesn't exist} {1 1 1 1}} - {-indicatoron yes 1 no_way {expected boolean value but got "no_way"} - {0 0 1 1}} - {-justify right right bogus - {bad justification "bogus": must be left, right, or center} - {1 1 1 1}} - {-offrelief flat flat 1.5 - {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} - {0 0 1 1}} - {-offvalue lousy lousy {} {} {0 0 1 0}} - {-onvalue fantastic fantastic {} {} {0 0 1 0}} - {-overrelief "" "" 1.5 - {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} - {0 1 1 1}} - {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}} - {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}} - {-repeatdelay 100 100 foo {expected integer but got "foo"} {0 1 0 0}} - {-repeatinterval 100 100 foo {expected integer but got "foo"} {0 1 0 0}} - {-relief flat flat 1.5 - {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} - {1 1 1 1}} - {-selectcolor #110022 #110022 bogus {unknown color name "bogus"} {0 0 1 1}} - {-selectimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}} - {-state normal normal bogus - {bad state "bogus": must be active, disabled, or normal} - {1 1 1 1}} - {-takefocus "any string" "any string" {} {} {1 1 1 1}} - {-text "Sample text" {Sample text} {} {} {1 1 1 1}} - {-textvariable i i {} {} {1 1 1 1}} - {-tristateimage image1 image1 bogus {image "bogus" doesn't exist} - {0 0 1 1}} - {-tristatevalue unknowable unknowable {} {} {0 0 1 1}} - {-underline 5 5 3p {expected integer but got "3p"} {1 1 1 1}} - {-value anyString anyString {} {} {0 0 0 1}} - {-width 402 402 3p {expected integer but got "3p"} {1 1 1 1}} - {-wraplength 100 100 6x {bad screen distance "6x"} {1 1 1 1}} -} { - lassign $test name value okResult badValue badResult classes - foreach w {.l .b .c .r} hasOption $classes { - set classname [winfo class $w] - if {$hasOption} { - test button-1.$i "configuration option $name for $classname" \ - -constraints testImageType -body " - $w configure $name [list $value] - lindex \[$w configure $name] 4 - " -result $okResult - incr i - if {$badValue ne ""} { - test button-1.$i "configuration option $name for $classname" \ - -constraints testImageType \ - -body [list $w configure $name $badValue] \ - -returnCodes error -result $badResult - incr i - } - $w configure $name [lindex [$w configure $name] 3] - } else { - test button-1.$i "configuration option $name for $classname" \ - -constraints testImageType \ - -body [list $w configure $name $value] \ - -returnCodes error -result "unknown option \"$name\"" - incr i - } - } -} -test button-1.$i {configuration options} { - # Additional check to make sure that -selectcolor may be empty in - # checkbox widgets + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -image image1 + .l cget -image +} -cleanup { + destroy .l + image delete image1 +} -result {image1} +test button-1.152 {configuration option: "image" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -image bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.153 {configuration option: "image" for button} -constraints { + testImageType +} -setup { + image create test image1 + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -image image1 + .b cget -image +} -cleanup { + destroy .b + image delete image1 +} -result {image1} +test button-1.154 {configuration option: "image" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -image bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.155 {configuration option: "image" for checkbutton} -constraints { + testImageType +} -setup { + image create test image1 + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -image image1 + .c cget -image +} -cleanup { + destroy .c + image delete image1 +} -result {image1} +test button-1.156 {configuration option: "image" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -image bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.157 {configuration option: "image" for radiobutton} -constraints { + testImageType +} -setup { + image create test image1 + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -image image1 + .r cget -image +} -cleanup { + destroy .r + image delete image1 +} -result {image1} +test button-1.158 {configuration option: "image" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -image bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {image "bogus" doesn't exist} + +test button-1.159 {configuration option: "indicatoron" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -indicatoron yes + .c cget -indicatoron +} -cleanup { + destroy .c +} -result {1} +test button-1.160 {configuration option: "indicatoron" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -indicatoron no_way +} -cleanup { + destroy .c +} -returnCodes {error} -result {expected boolean value but got "no_way"} +test button-1.161 {configuration option: "indicatoron" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -indicatoron yes + .r cget -indicatoron +} -cleanup { + destroy .r +} -result {1} +test button-1.162 {configuration option: "indicatoron" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -indicatoron no_way +} -cleanup { + destroy .r +} -returnCodes {error} -result {expected boolean value but got "no_way"} + +test button-1.163 {configuration option: "justify" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -justify right + .l cget -justify +} -cleanup { + destroy .l +} -result {right} +test button-1.164 {configuration option: "justify" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -justify bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} +test button-1.165 {configuration option: "justify" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -justify right + .b cget -justify +} -cleanup { + destroy .b +} -result {right} +test button-1.166 {configuration option: "justify" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -justify bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} +test button-1.167 {configuration option: "justify" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -justify right + .c cget -justify +} -cleanup { + destroy .c +} -result {right} +test button-1.168 {configuration option: "justify" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -justify bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} +test button-1.169 {configuration option: "justify" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -justify right + .r cget -justify +} -cleanup { + destroy .r +} -result {right} +test button-1.170 {configuration option: "justify" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -justify bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} + +test button-1.171 {configuration option: "offrelief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -offrelief flat + .c cget -offrelief +} -cleanup { + destroy .c +} -result {flat} +test button-1.172 {configuration option: "offrelief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -offrelief 1.5 +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.173 {configuration option: "offrelief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -offrelief flat + .r cget -offrelief +} -cleanup { + destroy .r +} -result {flat} +test button-1.174 {configuration option: "offrelief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -offrelief 1.5 +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} + +test button-1.175 {configuration option: "offvalue" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -offvalue lousy + .c cget -offvalue +} -cleanup { + destroy .c +} -result {lousy} + +test button-1.176 {configuration option: "onvalue" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -onvalue fantastic + .c cget -onvalue +} -cleanup { + destroy .c +} -result {fantastic} + +test button-1.177 {configuration option: "overrelief" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -overrelief "" + .b cget -overrelief +} -cleanup { + destroy .b +} -result {} +test button-1.178 {configuration option: "overrelief" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -overrelief 1.5 +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.179 {configuration option: "overrelief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -overrelief "" + .c cget -overrelief +} -cleanup { + destroy .c +} -result {} +test button-1.180 {configuration option: "overrelief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -overrelief 1.5 +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.181 {configuration option: "overrelief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -overrelief "" + .r cget -overrelief +} -cleanup { + destroy .r +} -result {} +test button-1.182 {configuration option: "overrelief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -overrelief 1.5 +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} + +test button-1.183 {configuration option: "padx" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -padx 12m + .l cget -padx +} -cleanup { + destroy .l +} -result {12m} +test button-1.184 {configuration option: "padx" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -padx 420x +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.185 {configuration option: "padx" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -padx 12m + .b cget -padx +} -cleanup { + destroy .b +} -result {12m} +test button-1.186 {configuration option: "padx" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -padx 420x +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.187 {configuration option: "padx" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -padx 12m + .c cget -padx +} -cleanup { + destroy .c +} -result {12m} +test button-1.188 {configuration option: "padx" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -padx 420x +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.189 {configuration option: "padx" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -padx 12m + .r cget -padx +} -cleanup { + destroy .r +} -result {12m} +test button-1.190 {configuration option: "padx" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -padx 420x +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "420x"} + +test button-1.191 {configuration option: "pady" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -pady 12m + .l cget -pady +} -cleanup { + destroy .l +} -result {12m} +test button-1.192 {configuration option: "pady" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -pady 420x +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.193 {configuration option: "pady" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -pady 12m + .b cget -pady +} -cleanup { + destroy .b +} -result {12m} +test button-1.194 {configuration option: "pady" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -pady 420x +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.195 {configuration option: "pady" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -pady 12m + .c cget -pady +} -cleanup { + destroy .c +} -result {12m} +test button-1.196 {configuration option: "pady" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -pady 420x +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "420x"} +test button-1.197 {configuration option: "pady" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -pady 12m + .r cget -pady +} -cleanup { + destroy .r +} -result {12m} +test button-1.198 {configuration option: "pady" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -pady 420x +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "420x"} + +test button-1.199 {configuration option: "repeatdelay" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -repeatdelay 100 + .b cget -repeatdelay +} -cleanup { + destroy .b +} -result {100} +test button-1.200 {configuration option: "repeatdelay" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -repeatdelay foo +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "foo"} + +test button-1.201 {configuration option: "repeatinterval" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -repeatinterval 100 + .b cget -repeatinterval +} -cleanup { + destroy .b +} -result {100} +test button-1.202 {configuration option: "repeatinterval" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -repeatinterval foo +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "foo"} + +test button-1.203 {configuration option: "relief" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -relief flat + .l cget -relief +} -cleanup { + destroy .l +} -result {flat} +test button-1.204 {configuration option: "relief" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -relief 1.5 +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.205 {configuration option: "relief" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -relief flat + .b cget -relief +} -cleanup { + destroy .b +} -result {flat} +test button-1.206 {configuration option: "relief" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -relief 1.5 +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.207 {configuration option: "relief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -relief flat + .c cget -relief +} -cleanup { + destroy .c +} -result {flat} +test button-1.208 {configuration option: "relief" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -relief 1.5 +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test button-1.209 {configuration option: "relief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -relief flat + .r cget -relief +} -cleanup { + destroy .r +} -result {flat} +test button-1.210 {configuration option: "relief" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -relief 1.5 +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} + +test button-1.211 {configuration option: "selectcolor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -selectcolor #110022 + .c cget -selectcolor +} -cleanup { + destroy .c +} -result {#110022} +test button-1.212 {configuration option: "selectcolor" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -selectcolor non-existent +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown color name "non-existent"} +test button-1.213 {configuration option: "selectcolor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -selectcolor #110022 + .r cget -selectcolor +} -cleanup { + destroy .r +} -result {#110022} +test button-1.214 {configuration option: "selectcolor" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -selectcolor non-existent +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown color name "non-existent"} + +test button-1.215 {configuration option: "selectimage" for checkbutton} -constraints { + testImageType +} -setup { + image create test image1 + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -selectimage image1 + .c cget -selectimage +} -cleanup { + destroy .c + image delete image1 +} -result {image1} +test button-1.216 {configuration option: "selectimage" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -selectimage bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.217 {configuration option: "selectimage" for radiobutton} -constraints { + testImageType +} -setup { + image create test image1 + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -selectimage image1 + .r cget -selectimage +} -cleanup { + destroy .r + image delete image1 +} -result {image1} +test button-1.218 {configuration option: "selectimage" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -selectimage bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {image "bogus" doesn't exist} + +test button-1.219 {configuration option: "state" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -state normal + .l cget -state +} -cleanup { + destroy .l +} -result {normal} +test button-1.220 {configuration option: "state" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -state bogus +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad state "bogus": must be active, disabled, or normal} +test button-1.221 {configuration option: "state" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -state normal + .b cget -state +} -cleanup { + destroy .b +} -result {normal} +test button-1.222 {configuration option: "state" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -state bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad state "bogus": must be active, disabled, or normal} +test button-1.223 {configuration option: "state" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -state normal + .c cget -state +} -cleanup { + destroy .c +} -result {normal} +test button-1.224 {configuration option: "state" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -state bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad state "bogus": must be active, disabled, or normal} +test button-1.225 {configuration option: "state" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -state normal + .r cget -state +} -cleanup { + destroy .r +} -result {normal} +test button-1.226 {configuration option: "state" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -state bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad state "bogus": must be active, disabled, or normal} + +test button-1.227 {configuration option: "takefocus" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -takefocus "any string" + .l cget -takefocus +} -cleanup { + destroy .l +} -result {any string} +test button-1.228 {configuration option: "takefocus" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -takefocus "any string" + .b cget -takefocus +} -cleanup { + destroy .b +} -result {any string} +test button-1.229 {configuration option: "takefocus" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -takefocus "any string" + .c cget -takefocus +} -cleanup { + destroy .c +} -result {any string} +test button-1.230 {configuration option: "takefocus" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -takefocus "any string" + .r cget -takefocus +} -cleanup { + destroy .r +} -result {any string} + +test button-1.231 {configuration option: "text" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -text "Sample text" + .l cget -text +} -cleanup { + destroy .l +} -result {Sample text} +test button-1.232 {configuration option: "text" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -text "Sample text" + .b cget -text +} -cleanup { + destroy .b +} -result {Sample text} +test button-1.233 {configuration option: "text" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -text "Sample text" + .c cget -text +} -cleanup { + destroy .c +} -result {Sample text} +test button-1.234 {configuration option: "text" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -text "Sample text" + .r cget -text +} -cleanup { + destroy .r +} -result {Sample text} + +test button-1.235 {configuration option: "textvariable" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -textvariable i + .l cget -textvariable +} -cleanup { + destroy .l +} -result {i} +test button-1.236 {configuration option: "textvariable" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -textvariable i + .b cget -textvariable +} -cleanup { + destroy .b +} -result {i} +test button-1.237 {configuration option: "textvariable" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -textvariable i + .c cget -textvariable +} -cleanup { + destroy .c +} -result {i} +test button-1.238 {configuration option: "textvariable" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -textvariable i + .r cget -textvariable +} -cleanup { + destroy .r +} -result {i} + +test button-1.239 {configuration option: "tristateimage" for checkbutton} -constraints { + testImageType +} -setup { + image create test image1 + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -tristateimage image1 + .c cget -tristateimage +} -cleanup { + destroy .c + image delete image1 +} -result {image1} +test button-1.240 {configuration option: "tristateimage" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -tristateimage bogus +} -cleanup { + destroy .c +} -returnCodes {error} -result {image "bogus" doesn't exist} +test button-1.241 {configuration option: "tristateimage" for radiobutton} -constraints { + testImageType +} -setup { + image create test image1 + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -tristateimage image1 + .r cget -tristateimage +} -cleanup { + destroy .r + image delete image1 +} -result {image1} +test button-1.242 {configuration option: "tristateimage" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -tristateimage bogus +} -cleanup { + destroy .r +} -returnCodes {error} -result {image "bogus" doesn't exist} + +test button-1.243 {configuration option: "underline" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -underline 5 + .l cget -underline +} -cleanup { + destroy .l +} -result {5} +test button-1.244 {configuration option: "underline" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -underline 3p +} -cleanup { + destroy .l +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.245 {configuration option: "underline" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -underline 5 + .b cget -underline +} -cleanup { + destroy .b +} -result {5} +test button-1.246 {configuration option: "underline" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -underline 3p +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.247 {configuration option: "underline" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -underline 5 + .c cget -underline +} -cleanup { + destroy .c +} -result {5} +test button-1.248 {configuration option: "underline" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -underline 3p +} -cleanup { + destroy .c +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.249 {configuration option: "underline" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -underline 5 + .r cget -underline +} -cleanup { + destroy .r +} -result {5} +test button-1.250 {configuration option: "underline" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -underline 3p +} -cleanup { + destroy .r +} -returnCodes {error} -result {expected integer but got "3p"} + +test button-1.251 {configuration option: "tristatevalue" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -tristatevalue unknowable + .c cget -tristatevalue +} -cleanup { + destroy .c +} -result {unknowable} +test button-1.252 {configuration option: "tristatevalue" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -tristatevalue unknowable + .r cget -tristatevalue +} -cleanup { + destroy .r +} -result {unknowable} + +test button-1.253 {configuration option: "value" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -value anyString + .r cget -value +} -cleanup { + destroy .r +} -result {anyString} + +test button-1.254 {configuration option: "width" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -width 402 + .l cget -width +} -cleanup { + destroy .l +} -result {402} +test button-1.255 {configuration option: "width" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -width 3p +} -cleanup { + destroy .l +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.256 {configuration option: "width" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -width 402 + .b cget -width +} -cleanup { + destroy .b +} -result {402} +test button-1.257 {configuration option: "width" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -width 3p +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.258 {configuration option: "width" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -width 402 + .c cget -width +} -cleanup { + destroy .c +} -result {402} +test button-1.259 {configuration option: "width" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -width 3p +} -cleanup { + destroy .c +} -returnCodes {error} -result {expected integer but got "3p"} +test button-1.260 {configuration option: "width" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -width 402 + .r cget -width +} -cleanup { + destroy .r +} -result {402} +test button-1.261 {configuration option: "width" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -width 3p +} -cleanup { + destroy .r +} -returnCodes {error} -result {expected integer but got "3p"} + +test button-1.262 {configuration option: "wraplength" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -wraplength 100 + .l cget -wraplength +} -cleanup { + destroy .l +} -result {100} +test button-1.263 {configuration option: "wraplength" for label} -setup { + label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .l + update +} -body { + .l configure -wraplength 6x +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad screen distance "6x"} +test button-1.264 {configuration option: "wraplength" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -wraplength 100 + .b cget -wraplength +} -cleanup { + destroy .b +} -result {100} +test button-1.265 {configuration option: "wraplength" for button} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .b + update +} -body { + .b configure -wraplength 6x +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "6x"} +test button-1.266 {configuration option: "wraplength" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -wraplength 100 + .c cget -wraplength +} -cleanup { + destroy .c +} -result {100} +test button-1.267 {configuration option: "wraplength" for checkbutton} -setup { + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .c + update +} -body { + .c configure -wraplength 6x +} -cleanup { + destroy .c +} -returnCodes {error} -result {bad screen distance "6x"} +test button-1.268 {configuration option: "wraplength" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -wraplength 100 + .r cget -wraplength +} -cleanup { + destroy .r +} -result {100} +test button-1.269 {configuration option: "wraplength" for radiobutton} -setup { + radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .r + update +} -body { + .r configure -wraplength 6x +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad screen distance "6x"} + +test button-1.270 {configuration options} -body { +# Additional check to make sure that -selectcolor may be empty in +# checkbox widgets + checkbutton .c .c configure -selectcolor {} -} {} - -test button-3.1 {ButtonCreate - not enough cd ../unix -} { - list [catch {button} msg] $msg -} {1 {wrong # args: should be "button pathName ?options?"}} -test button-3.2 {ButtonCreate procedure - setting label class} { - catch {destroy .x} +} -cleanup { + destroy .c +} -result {} + +# ex-tests 3.* +test button-2.1 {ButtonCreate - not enough arguments} -body { + button +} -returnCodes {error} -result {wrong # args: should be "button pathName ?-option value ...?"} + +test button-2.2 {ButtonCreate procedure - setting label class} -body { label .x winfo class .x -} {Label} -test button-3.3 {ButtonCreate - setting button class} { - catch {destroy .x} +} -cleanup { + destroy .x +} -result {Label} +test button-2.3 {ButtonCreate - setting button class} -body { button .x winfo class .x -} {Button} -test button-3.4 {ButtonCreate - setting checkbutton class} { - catch {destroy .x} +} -cleanup { + destroy .x +} -result {Button} +test button-2.4 {ButtonCreate - setting checkbutton class} -body { checkbutton .x winfo class .x -} {Checkbutton} -test button-3.5 {ButtonCreate - setting radiobutton class} { - catch {destroy .x} +} -cleanup { + destroy .x +} -result {Checkbutton} +test button-2.5 {ButtonCreate - setting radiobutton class} -body { radiobutton .x winfo class .x -} {Radiobutton} -rename button gorp -test button-3.6 {ButtonCreate - setting class} { - catch {destroy .x} +} -cleanup { + destroy .x +} -result {Radiobutton} +test button-2.6 {ButtonCreate - setting class} -body { + rename button gorp gorp .x winfo class .x -} {Button} -rename gorp button -test button-3.7 {ButtonCreate - bad window name} { - list [catch {button foo} msg] $msg -} {1 {bad window path name "foo"}} -test button-3.8 {ButtonCreate procedure - error in default option value} { - catch {destroy .funny} +} -cleanup { + destroy .x + rename gorp button +} -result {Button} + +test button-2.7 {ButtonCreate - bad window name} -body { + button foo +} -cleanup { + destroy foo +} -returnCodes {error} -result {bad window path name "foo"} +######### test ex 3.8 +test button-2.8 {ButtonCreate procedure - error in default option value} -body { option add *funny.background bogus - list [catch {button .funny} msg] $msg $errorInfo -} {1 {unknown color name "bogus"} {unknown color name "bogus" + button .funny +} -cleanup { + option clear + destroy .funny +} -returnCodes {error} -result {unknown color name "bogus"} +test button-2.9 {ButtonCreate procedure - error in default option value} -body { + option add *funny.background bogus + catch {button .funny} + return $errorInfo +} -cleanup { + option clear + destroy .funny +} -result {unknown color name "bogus" (database entry for "-background" in widget ".funny") invoked from within -"button .funny"}} -test button-3.9 {ButtonCreate procedure - option error} { - catch {destroy .x} - list [catch {button .x -gorp foo} msg] $msg [winfo exists .x] -} {1 {unknown option "-gorp"} 0} -test button-3.10 {ButtonCreate procedure - return value} { - catch {destroy .abcd} +"button .funny"} + +test button-2.10 {ButtonCreate procedure - option error} -body { + button .x -gorp foo +} -cleanup { + destroy .x +} -returnCodes {error} -result {unknown option "-gorp"} +test button-2.11 {ButtonCreate procedure - option error} -body { + catch {button .x -gorp foo} + winfo exists .x +} -cleanup { + destroy .x +} -result 0 +######### ex 3.10 +test button-2.12 {ButtonCreate procedure - return value} -body { set x [button .abcd] - destroy .abc - set x -} {.abcd} - -test button-4.1 {ButtonWidgetCmd - too few arguments} { - list [catch {.b} msg] $msg -} {1 {wrong # args: should be ".b option ?arg arg ...?"}} -test button-4.2 {ButtonWidgetCmd - bad option name} { - list [catch {.b c} msg] $msg -} {1 {ambiguous option "c": must be cget, configure, flash, or invoke}} -test button-4.3 {ButtonWidgetCmd - bad option name} { - list [catch {.b bogus} msg] $msg -} {1 {bad option "bogus": must be cget, configure, flash, or invoke}} -test button-4.4 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.b cget a b} msg] $msg -} {1 {wrong # args: should be ".b cget option"}} -test button-4.5 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.b cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test button-4.6 {ButtonWidgetCmd procedure, "cget" option} { - .b configure -highlightthickness 3 - .b cget -highlightthickness -} {3} -test button-4.7 {ButtonWidgetCmd procedure, "cget" option} { - catch {.l cget -disabledforeground} -} {0} -test button-4.8 {ButtonWidgetCmd procedure, "cget" option} { - catch {.b cget -disabledforeground} -} {0} -test button-4.9 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.b cget -variable} msg] $msg -} {1 {unknown option "-variable"}} -test button-4.10 {ButtonWidgetCmd procedure, "cget" option} { - catch {.c cget -variable} -} {0} -test button-4.11 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.c cget -value} msg] $msg -} {1 {unknown option "-value"}} -test button-4.12 {ButtonWidgetCmd procedure, "cget" option} { - catch {.r cget -value} -} {0} -test button-4.13 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.r cget -onvalue} msg] $msg -} {1 {unknown option "-onvalue"}} -test button-4.14 {ButtonWidgetCmd procedure, "configure" option} { + return $x +} -cleanup { + destroy .abcd +} -result {.abcd} + +######### ex 4.* +test button-3.1 {ButtonWidgetCmd - too few arguments} -body { + button .b + .b +} -cleanup { + destroy .b +} -returnCodes {error} -result {wrong # args: should be ".b option ?arg ...?"} +test button-3.2 {ButtonWidgetCmd - bad option name} -body { + button .b + .b c +} -cleanup { + destroy .b +} -returnCodes {error} -result {ambiguous option "c": must be cget, configure, flash, or invoke} +test button-3.3 {ButtonWidgetCmd - bad option name} -body { + button .b + .b bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad option "bogus": must be cget, configure, flash, or invoke} +test button-3.4 {ButtonWidgetCmd procedure, "cget" option} -body { + button .b + .b cget a b +} -cleanup { + destroy .b +} -returnCodes {error} -result {wrong # args: should be ".b cget option"} +test button-3.5 {ButtonWidgetCmd procedure, "cget" option} -body { + button .b + .b cget -gorp +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown option "-gorp"} + +#ex 4.7 +test button-3.6 {ButtonWidgetCmd procedure, "cget" option} -body { + label .l + .l cget -disabledforeground +} -cleanup { + destroy .l +} -returnCodes {ok} -match {glob} -result {*} +test button-3.7 {ButtonWidgetCmd procedure, "cget" option} -body { + button .b + .b cget -disabledforeground +} -cleanup { + destroy .b +} -returnCodes {ok} -match {glob} -result {*} +test button-3.8 {ButtonWidgetCmd procedure, "cget" option} -body { + button .b + .b cget -variable +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown option "-variable"} + +test button-3.9 {ButtonWidgetCmd procedure, "cget" option} -body { + checkbutton .c + .c cget -variable +} -cleanup { + destroy .c +} -returnCodes {ok} -match {glob} -result {*} +test button-3.10 {ButtonWidgetCmd procedure, "cget" option} -body { + checkbutton .c + .c cget -value +} -cleanup { + destroy .c +} -returnCodes {error} -result {unknown option "-value"} + +test button-3.11 {ButtonWidgetCmd procedure, "cget" option} -body { + radiobutton .r + .r cget -value +} -cleanup { + destroy .r +} -returnCodes {ok} -match {glob} -result {*} +test button-3.12 {ButtonWidgetCmd procedure, "cget" option} -body { + radiobutton .r + .r cget -onvalue +} -cleanup { + destroy .r +} -returnCodes {error} -result {unknown option "-onvalue"} + +# ex 4.6 +test button-3.13 {ButtonWidgetCmd procedure, "configure" option} -body { + button .b -highlightthickness 3 + lindex [.b configure -highlightthickness] 4 +} -cleanup { + destroy .b +} -result {3} +test button-3.14 {ButtonWidgetCmd procedure, "configure" option} -body { + checkbutton .c llength [.c configure] -} {41} -test button-4.15 {ButtonWidgetCmd procedure, "configure" option} { - list [catch {.b configure -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test button-4.16 {ButtonWidgetCmd procedure, "configure" option} { - list [catch {.b co -bg #ffffff -fg} msg] $msg -} {1 {value for "-fg" missing}} -test button-4.17 {ButtonWidgetCmd procedure, "configure" option} { +} -cleanup { + destroy .c +} -result {41} +test button-3.15 {ButtonWidgetCmd procedure, "configure" option} -body { + button .b + .b configure -gorp +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown option "-gorp"} +test button-3.16 {ButtonWidgetCmd procedure, "configure" option} -setup { + button .b +} -body { + .b co -bg #ffffff -fg +} -cleanup { + destroy .b +} -returnCodes {error} -result {value for "-fg" missing} +test button-3.17 {ButtonWidgetCmd procedure, "configure" option} -setup { + button .b +} -body { .b configure -fg #123456 .b configure -bg #654321 lindex [.b configure -fg] 4 -} {#123456} -.c configure -variable value -onvalue 1 -offvalue 0 -.r configure -variable value2 -value red -test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} { - list [catch {.c deselect foo} msg] $msg -} {1 {wrong # args: should be ".c deselect"}} -test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} { - list [catch {.l deselect} msg] $msg -} {1 {bad option "deselect": must be cget or configure}} -test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} { - list [catch {.b deselect} msg] $msg -} {1 {bad option "deselect": must be cget, configure, flash, or invoke}} -test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} { - set value 1 +} -cleanup { + destroy .b +} -result {#123456} +test button-3.18 {ButtonWidgetCmd procedure, "deselect" option} -body { + checkbutton .c + .c deselect foo +} -cleanup { + destroy .c +} -returnCodes {error} -result {wrong # args: should be ".c deselect"} +test button-3.19 {ButtonWidgetCmd procedure, "deselect" option} -body { + label .l + .l deselect +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "deselect": must be cget or configure} +test button-3.20 {ButtonWidgetCmd procedure, "deselect" option} -body { + button .b + .b deselect +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad option "deselect": must be cget, configure, flash, or invoke} + +test button-3.21 {ButtonWidgetCmd procedure, "deselect" option} -body { + checkbutton .c -variable checkvar -onvalue 1 -offvalue 0 + set checkvar 1 .c d - set value -} {0} -test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} { - set value2 green + return $checkvar +} -cleanup { + destroy .c +} -result {0} +test button-3.22 {ButtonWidgetCmd procedure, "deselect" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar green .r deselect - set value2 -} {green} -test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} { - set value2 red + return $radiovar +} -cleanup { + destroy .r +} -result {green} +test button-3.23 {ButtonWidgetCmd procedure, "deselect" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar red .r deselect - set value2 -} {} -test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} -body { - set value 1 - trace variable value w bogusTrace - set result [list [catch {.c deselect} msg] $msg $errorInfo $value] - trace vdelete value w bogusTrace - set result -} -match glob -result {1 {can't set "value": trace aborted} {*trace aborted + return $radiovar +} -cleanup { + destroy .r +} -result {} + +test button-3.24 {ButtonWidgetCmd procedure, "deselect" option} -body { + checkbutton .c -variable checkvar -onvalue 1 -offvalue 0 + set checkvar 1 + trace variable checkvar w bogusTrace + .c deselect +} -cleanup { + destroy .c + trace vdelete checkvar w bogusTrace +} -returnCodes {error} -result {can't set "checkvar": trace aborted} +test button-3.25 {ButtonWidgetCmd procedure, "deselect" option} -body { + checkbutton .c -variable checkvar -onvalue 1 -offvalue 0 + set checkvar 1 + trace variable checkvar w bogusTrace + catch {.c deselect} + list $errorInfo $checkvar +} -cleanup { + trace vdelete checkvar w bogusTrace + destroy .c +} -match {glob} -result {{*trace aborted while executing * ".c deselect"} 0} -test button-4.25 {ButtonWidgetCmd procedure, "deselect" option} -body { - set value2 red - trace variable value2 w bogusTrace - set result [list [catch {.r deselect} msg] $msg $errorInfo $value2] - trace vdelete value2 w bogusTrace - set result -} -match glob -result {1 {can't set "value2": trace aborted} {*trace aborted +test button-3.26 {ButtonWidgetCmd procedure, "deselect" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar red + trace variable radiovar w bogusTrace + .r deselect +} -cleanup { + destroy .r + trace vdelete radiovar w bogusTrace +} -match {glob} -returnCodes {error} -result {can't set "radiovar": trace aborted} +test button-3.27 {ButtonWidgetCmd procedure, "deselect" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar red + trace variable radiovar w bogusTrace + catch {.r deselect} + list $errorInfo $radiovar +} -cleanup { + destroy .r + trace vdelete radiovar w bogusTrace +} -match glob -result {{*trace aborted while executing * ".r deselect"} {}} -test button-4.26 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.b flash foo} msg] $msg -} {1 {wrong # args: should be ".b flash"}} -test button-4.27 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.l flash} msg] $msg -} {1 {bad option "flash": must be cget or configure}} -test button-4.28 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.b flash} msg] $msg -} {0 {}} -test button-4.29 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.c flash} msg] $msg -} {0 {}} -test button-4.30 {ButtonWidgetCmd procedure, "flash" option} { - list [catch {.r f} msg] $msg -} {0 {}} -test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} { - list [catch {.b invoke foo} msg] $msg -} {1 {wrong # args: should be ".b invoke"}} -test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} { - list [catch {.l invoke} msg] $msg -} {1 {bad option "invoke": must be cget or configure}} -test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} { + +test button-3.28 {ButtonWidgetCmd procedure, "flash" option} -body { + button .b + .b flash foo +} -cleanup { + destroy .b +} -returnCodes {error} -result {wrong # args: should be ".b flash"} +test button-3.29 {ButtonWidgetCmd procedure, "flash" option} -body { + label .l + .l flash +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "flash": must be cget or configure} +test button-3.30 {ButtonWidgetCmd procedure, "flash" option} -body { + button .b + catch {.b flash} +} -cleanup { + destroy .b +} -returnCodes {ok} -match {glob} -result {*} +test button-3.31 {ButtonWidgetCmd procedure, "flash" option} -body { + checkbutton .c + catch {.c flash} +} -cleanup { + destroy .c +} -returnCodes {ok} -match {glob} -result {*} +test button-3.32 {ButtonWidgetCmd procedure, "flash" option} -body { + radiobutton .r + catch {.r f} +} -cleanup { + destroy .r +} -returnCodes {ok} -match {glob} -result {*} + +test button-3.33 {ButtonWidgetCmd procedure, "invoke" option} -body { + label .l + .l invoke +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "invoke": must be cget or configure} +test button-3.34 {ButtonWidgetCmd procedure, "invoke" option} -body { + button .b + .b invoke foo +} -cleanup { + destroy .b +} -returnCodes {error} -result {wrong # args: should be ".b invoke"} +test button-3.35 {ButtonWidgetCmd procedure, "invoke" option} -body { + button .b .b configure -command {set x invoked} set x "not invoked" .b invoke - set x -} {invoked} -test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} { + return $x +} -cleanup { + destroy .b +} -result {invoked} +test button-3.36 {ButtonWidgetCmd procedure, "invoke" option} -body { + button .b .b configure -command {set x invoked} -state disabled set x "not invoked" .b invoke - set x -} {not invoked} -test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} { - set value bogus - .c configure -command {set x invoked} -variable value -onvalue 1 \ - -offvalue 0 + return $x +} -cleanup { + destroy .b +} -result {not invoked} +test button-3.37 {ButtonWidgetCmd procedure, "invoke" option} -body { + checkbutton .c -variable checkvar -onvalue 1 -offvalue 0 \ + -command {set x invoked} + set checkvar bogus set x "not invoked" .c invoke - list $x $value -} {invoked 1} -test button-4.36 {ButtonWidgetCmd procedure, "invoke" option} { - set value2 green - .r configure -command {set x invoked} -variable value2 -value red + list $x $checkvar +} -cleanup { + destroy .c +} -result {invoked 1} +test button-3.38 {ButtonWidgetCmd procedure, "invoke" option} -body { + radiobutton .r -command {set x invoked} -variable radiovar -value red + set radiovar green set x "not invoked" .r i - list $x $value2 -} {invoked red} -test button-4.37 {ButtonWidgetCmd procedure, "select" option} { - list [catch {.l select} msg] $msg -} {1 {bad option "select": must be cget or configure}} -test button-4.38 {ButtonWidgetCmd procedure, "select" option} { - list [catch {.b select} msg] $msg -} {1 {bad option "select": must be cget, configure, flash, or invoke}} -test button-4.39 {ButtonWidgetCmd procedure, "select" option} { - list [catch {.c select foo} msg] $msg -} {1 {wrong # args: should be ".c select"}} -test button-4.40 {ButtonWidgetCmd procedure, "select" option} { - set value bogus - .c configure -command {} -variable value -onvalue lovely -offvalue 0 + list $x $radiovar +} -cleanup { + destroy .r +} -result {invoked red} + +test button-3.39 {ButtonWidgetCmd procedure, "select" option} -body { + label .l + .l select +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "select": must be cget or configure} +test button-3.40 {ButtonWidgetCmd procedure, "select" option} -body { + button .b + .b select +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad option "select": must be cget, configure, flash, or invoke} +test button-3.41 {ButtonWidgetCmd procedure, "select" option} -body { + checkbutton .c + .c select foo +} -cleanup { + destroy .c +} -returnCodes {error} -result {wrong # args: should be ".c select"} +test button-3.42 {ButtonWidgetCmd procedure, "select" option} -body { + checkbutton .c -variable checkvar -onvalue lovely -offvalue 0 + set checkvar bogus .c s - set value -} {lovely} -test button-4.41 {ButtonWidgetCmd procedure, "select" option} { - set value2 green - .r configure -command {} -variable value2 -value red + return $checkvar +} -cleanup { + destroy .c +} -result {lovely} +test button-3.43 {ButtonWidgetCmd procedure, "select" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar green + .r select + return $radiovar +} -cleanup { + destroy .r +} -result {red} +test button-3.44 {ButtonWidgetCmd procedure, "select" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar yellow + trace variable radiovar w bogusTrace .r select - set value2 -} {red} -test button-4.42 {ButtonWidgetCmd procedure, "select" option} -body { - set value2 yellow - trace variable value2 w bogusTrace - set result [list [catch {.r select} msg] $msg $errorInfo $value2] - trace vdelete value2 w bogusTrace - set result -} -match glob -result {1 {can't set "value2": trace aborted} {*trace aborted +} -cleanup { + destroy .r + trace vdelete radiovar w bogusTrace +} -returnCodes {error} -result {can't set "radiovar": trace aborted} +test button-3.45 {ButtonWidgetCmd procedure, "select" option} -body { + radiobutton .r -variable radiovar -value red + set radiovar yellow + trace variable radiovar w bogusTrace + catch {.r select} + list $errorInfo $radiovar +} -cleanup { + destroy .r + trace vdelete radiovar w bogusTrace +} -match {glob} -result {{*trace aborted while executing * ".r select"} red} -test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} { - list [catch {.l toggle} msg] $msg -} {1 {bad option "toggle": must be cget or configure}} -test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} { - list [catch {.b toggle} msg] $msg -} {1 {bad option "toggle": must be cget, configure, flash, or invoke}} -test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} { - list [catch {.r toggle} msg] $msg -} {1 {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select}} -test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} { - list [catch {.c toggle foo} msg] $msg -} {1 {wrong # args: should be ".c toggle"}} -test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} { - set value bogus - .c configure -command {} -variable value -onvalue sunshine -offvalue rain + +# ex 4.43 +test button-3.46 {ButtonWidgetCmd procedure, "toggle" option} -body { + label .l + .l toggle +} -cleanup { + destroy .l +} -returnCodes {error} -result {bad option "toggle": must be cget or configure} +test button-3.47 {ButtonWidgetCmd procedure, "toggle" option} -body { + button .b + .b toggle +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad option "toggle": must be cget, configure, flash, or invoke} +test button-3.48 {ButtonWidgetCmd procedure, "toggle" option} -body { + radiobutton .r + .r toggle +} -cleanup { + destroy .r +} -returnCodes {error} -result {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select} +test button-3.49 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c + .c toggle foo +} -cleanup { + destroy .c +} -returnCodes {error} -result {wrong # args: should be ".c toggle"} +test button-3.50 {ButtonWidgetCmd procedure, "toggle" option} -body { + set checkvar bogus + checkbutton .c -variable checkvar -onvalue sunshine -offvalue rain .c toggle - set result $value + set result $checkvar .c toggle - lappend result $value + lappend result $checkvar .c toggle - lappend result $value -} {sunshine rain sunshine} -test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} -body { - .c configure -onvalue xyz -offvalue abc - set value xyz - trace variable value w bogusTrace - set result [list [catch {.c toggle} msg] $msg $errorInfo $value] - trace vdelete value w bogusTrace - set result -} -match glob -result {1 {can't set "value": trace aborted} {*trace aborted + lappend result $checkvar + return $result +} -cleanup { + destroy .c +} -result {sunshine rain sunshine} +test button-3.51 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + set checkvar xyz + trace variable checkvar w bogusTrace + .c toggle +} -cleanup { + destroy .c + trace vdelete checkvar w bogusTrace +} -returnCodes {error} -result {can't set "checkvar": trace aborted} +test button-3.52 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + set checkvar xyz + trace variable checkvar w bogusTrace + catch {.c toggle} + list $errorInfo $checkvar +} -cleanup { + trace vdelete checkvar w bogusTrace + destroy .c +} -match {glob} -result {{*trace aborted while executing * ".c toggle"} abc} -test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} -body { - .c configure -onvalue xyz -offvalue abc - set value abc - trace variable value w bogusTrace - set result [list [catch {.c toggle} msg] $msg $errorInfo $value] - trace vdelete value w bogusTrace - set result -} -match glob -result {1 {can't set "value": trace aborted} {*trace aborted +test button-3.53 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + set checkvar abc + trace variable checkvar w bogusTrace + .c toggle +} -cleanup { + trace vdelete checkvar w bogusTrace + destroy .c +} -returnCodes {error} -result {can't set "checkvar": trace aborted} +test button-3.54 {ButtonWidgetCmd procedure, "toggle" option} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + set checkvar abc + trace variable checkvar w bogusTrace + catch {.c toggle} + list $errorInfo $checkvar +} -cleanup { + trace vdelete checkvar w bogusTrace + destroy .c +} -match {glob} -result {{*trace aborted while executing * ".c toggle"} xyz} -test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} { - catch {unset value}; set value(1) 1; - set result [list [catch {.c toggle} msg] $msg $errorInfo] - unset value; - set result -} {1 {can't set "value": variable is array} {can't set "value": variable is array +test button-3.55 {ButtonWidgetCmd procedure, "toggle" option} -setup { + unset -nocomplain checkvar +} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + unset checkvar + set checkvar(1) 1 + .c toggle +} -cleanup { + destroy .c +} -returnCodes {error} -result {can't set "checkvar": variable is array} +test button-3.56 {ButtonWidgetCmd procedure, "toggle" option} -setup { + unset -nocomplain checkvar +} -body { + checkbutton .c -variable checkvar -onvalue xyz -offvalue abc + unset checkvar + set checkvar(1) 1 + catch {.c toggle} + return $errorInfo +} -cleanup { + destroy .c +} -match {glob} -result {can't set "checkvar": variable is array while executing -".c toggle"}} +".c toggle"} -test button-5.1 {DestroyButton procedure} testImageType { +test button-4.1 {DestroyButton procedure} -constraints { + testImageType +} -setup { image create test image1 + unset -nocomplain x +} -body { button .b1 -image image1 button .b2 -fg #ff0000 -text "Button 2" button .b3 -state active -text "Button 3" @@ -435,402 +3209,709 @@ test button-5.1 {DestroyButton procedure} testImageType { checkbutton .b5 -variable x -text "Checkbutton 5" set x 1 pack .b1 .b2 .b3 .b4 .b5 - update - deleteWindows -} {} - -test button-6.1 {ConfigureButton - textvariable trace} { - catch {destroy .b1} - button .b1 -bd 4 -bg green - catch {.b1 configure -bd 7 -bg green -fg bogus} - list [catch {.b1 configure -bd 7 -bg red -fg bogus} msg] \ - $msg [.b1 cget -bd] [.b1 cget -bg] -} {1 {unknown color name "bogus"} 4 green} -test button-6.2 {ConfigureButton - textvariable trace} { - catch {destroy .b1} + update + deleteWindows +} -cleanup { + destroy .b1 .b2 .b3 .b4 .b5 + image delete image1 +} -result {} + +test button-5.1 {ConfigureButton - textvariable trace} -body { + button .b -bd 4 -bg green + .b configure -bd 7 -bg red -fg bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {unknown color name "bogus"} +test button-5.2 {ConfigureButton - textvariable trace} -body { + button .b -bd 4 -bg green + catch {.b configure -bd 7 -bg red -fg bogus} + list [.b cget -bd] [.b cget -bg] +} -cleanup { + destroy .b +} -result {4 green} +test button-5.3 {ConfigureButton - textvariable trace} -body { + button .b -textvariable x set x From-x set y From-y - button .b1 -textvariable x - .b1 configure -textvariable y + .b configure -textvariable y set x New - lindex [.b1 configure -text] 4 -} {From-y} -test button-6.2a {ConfigureButton - variable traces} { - catch {destroy .b1} - catch {unset x} - checkbutton .b1 -variable x + lindex [.b configure -text] 4 +} -cleanup { + destroy .b +} -result {From-y} +test button-5.4 {ConfigureButton - variable trace} -body { ;# ex 6.2a + checkbutton .c -variable x set x 1 set y 1 - .b1 configure -textvariable y + .c configure -textvariable y set x 0 - .b1 toggle - set y -} {1} -test button-6.3 {ConfigureButton - image handling} testImageType { - catch {destroy .b1} - eval image delete [image names] + .c toggle + return $y +} -cleanup { + destroy .c +} -result {1} + +test button-5.5 {ConfigureButton - image handling} -constraints { + testImageType +} -setup { + imageCleanup image create test image1 image create test image2 - button .b1 -image image1 +} -body { + button .b -image image1 image delete image1 - .b1 configure -image image2 - image names -} {image2} -test button-6.5 {ConfigureButton - default value for variable} { - catch {destroy .b1} - checkbutton .b1 - .b1 cget -variable -} {b1} -test button-6.6 {ConfigureButton - setting selected state from variable} { - catch {destroy .b1} + .b configure -image image2 + imageNames +} -cleanup { + destroy .b + imageCleanup +} -result {image2} + +test button-5.6 {ConfigureButton - default value for variable} -body { + checkbutton .c + .c cget -variable +} -cleanup { + destroy .c +} -result {c} +test button-5.7 {ConfigureButton - setting selected state from variable} -body { set x 0 set y Shiny - checkbutton .b1 -variable x - .b1 configure -variable y -onvalue Shiny - .b1 toggle - set y -} 0 -test button-6.7 {ConfigureButton - setting selected state from variable} { - catch {destroy .b1} - catch {unset x} - checkbutton .b1 -variable x -offvalue Bogus - set x -} Bogus -test button-6.8 {ConfigureButton - setting selected state from variable} { - catch {destroy .b1} - catch {unset x} - radiobutton .b1 -variable x - set x -} {} -test button-6.9 {ConfigureButton - error in setting variable} { - catch {destroy .b1} - catch {unset x} + checkbutton .c -variable x + .c configure -variable y -onvalue Shiny + .c toggle + return $y +} -cleanup { + destroy .c +} -result {0} +test button-5.8 {ConfigureButton - setting selected state from variable} -setup { + unset -nocomplain x +} -body { + checkbutton .c -variable x -offvalue Bogus + return $x +} -cleanup { + destroy .c +} -result {Bogus} + +test button-5.9 {ConfigureButton - setting selected state from variable} -setup { + unset -nocomplain x +} -body { + radiobutton .r -variable x + return $x +} -cleanup { + destroy .r +} -result {} + +test button-5.10 {ConfigureButton - error in setting variable} -setup { + unset -nocomplain x +} -body { trace variable x w bogusTrace - set result [list [catch {radiobutton .b1 -variable x} msg] $msg] + radiobutton .r -variable x +} -cleanup { + destroy .r trace vdelete x w bogusTrace - set result -} {1 {can't set "x": trace aborted}} -test button-6.10 {ConfigureButton - bad image name} { - catch {destroy .b1} - list [catch {button .b1 -image bogus} msg] $msg -} {1 {image "bogus" doesn't exist}} -test button-6.11 {ConfigureButton - setting variable from current text value} { - catch {destroy .b1} - catch {unset x} - button .b1 -textvariable x -text "Button 1" - set x -} {Button 1} -test button-6.12 {ConfigureButton - using current value of variable} { - catch {destroy .b1} +} -returnCodes {error} -result {can't set "x": trace aborted} + +test button-5.11 {ConfigureButton - bad image name} -body { + button .b -image bogus +} -cleanup { + destroy .b +} -returnCodes {error} -result {image "bogus" doesn't exist} + +test button-5.12 {ConfigureButton - setting variable from current text value} -setup { + unset -nocomplain x +} -body { + button .b -textvariable x -text "Button 1" + return $x +} -cleanup { + destroy .b +} -result {Button 1} + +test button-5.13 {ConfigureButton - using current value of variable} -body { set x Override - button .b1 -textvariable x -text "Button 1" - set x -} {Override} -test button-6.13 {ConfigureButton - variable handling} { - catch {destroy .b1} - catch {unset x} + button .b -textvariable x -text "Button 1" + return $x +} -cleanup { + destroy .b +} -result {Override} + +test button-5.14 {ConfigureButton - variable handling} -setup { + unset -nocomplain x +} -body { + trace variable x w bogusTrace + radiobutton .r -text foo -textvariable x +} -cleanup { + trace vdelete x w bogusTrace + destroy .r +} -returnCodes {error} -result {can't set "x": trace aborted} +test button-5.15 {ConfigureButton - variable handling} -setup { + unset -nocomplain x +} -body { trace variable x w bogusTrace - set result [list [catch {radiobutton .b1 -text foo -textvariable x} msg] \ - $msg $x] + catch {radiobutton .r -text foo -textvariable x} + return $x +} -cleanup { trace vdelete x w bogusTrace - set result -} {1 {can't set "x": trace aborted} foo} -test button-6.14 {ConfigureButton - -width option} { - catch {destroy .b1} - button .b1 -text "Button 1" - list [catch {.b1 configure -width 1i} msg] $msg $errorInfo -} {1 {expected integer but got "1i"} {expected integer but got "1i" + destroy .r +} -result {foo} + +#ex 6.14 +test button-5.16 {ConfigureButton - -width option} -body { + button .b -text "Button 1" + .b configure -width 1i +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "1i"} +test button-5.17 {ConfigureButton - -width option} -body { + button .b -text "Button 1" + catch {.b configure -width 1i} + return $errorInfo +} -cleanup { + destroy .b +} -result {expected integer but got "1i" (processing -width option) invoked from within -".b1 configure -width 1i"}} -test button-6.15 {ConfigureButton - -height option} { - catch {destroy .b1} - button .b1 -text "Button 1" - list [catch {.b1 configure -height 0.5c} msg] $msg $errorInfo -} {1 {expected integer but got "0.5c"} {expected integer but got "0.5c" +".b configure -width 1i"} +test button-5.18 {ConfigureButton - -height option} -body { + button .b -text "Button 1" + .b configure -height 0.5c +} -cleanup { + destroy .b +} -returnCodes {error} -result {expected integer but got "0.5c"} +test button-5.19 {ConfigureButton - -height option} -body { + button .b -text "Button 1" + catch {.b configure -height 0.5c} + return $errorInfo +} -cleanup { + destroy .b +} -result {expected integer but got "0.5c" (processing -height option) invoked from within -".b1 configure -height 0.5c"}} -test button-6.16 {ConfigureButton - -width option} { - catch {destroy .b1} - button .b1 -bitmap questhead - list [catch {.b1 configure -width abc} msg] $msg $errorInfo -} {1 {bad screen distance "abc"} {bad screen distance "abc" +".b configure -height 0.5c"} +#ex 6.16 +test button-5.20 {ConfigureButton - -width option} -body { + button .b -bitmap questhead + .b configure -width abc +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad screen distance "abc"} +test button-5.21 {ConfigureButton - -width option} -body { + button .b -bitmap questhead + catch {.b configure -width abc} + return $errorInfo +} -cleanup { + destroy .b +} -result {bad screen distance "abc" (processing -width option) invoked from within -".b1 configure -width abc"}} -test button-6.17 {ConfigureButton - -height option} testImageType { - catch {destroy .b1} - eval image delete [image names] +".b configure -width abc"} +test button-5.22 {ConfigureButton - -height option} -constraints { + testImageType +} -setup { image create test image1 - button .b1 -image image1 - list [catch {.b1 configure -height 0.5x} msg] $msg $errorInfo -} {1 {bad screen distance "0.5x"} {bad screen distance "0.5x" +} -body { + button .b -image image1 + .b configure -height 0.5x +} -cleanup { + destroy .b + image delete image1 +} -returnCodes {error} -result {bad screen distance "0.5x"} +test button-5.23 {ConfigureButton - -height option} -constraints { + testImageType +} -setup { + image create test image1 +} -body { +#ztestImageType + button .b -image image1 + catch {.b configure -height 0.5x} + return $errorInfo +} -cleanup { + destroy .b + image delete image1 +} -result {bad screen distance "0.5x" (processing -height option) invoked from within -".b1 configure -height 0.5x"}} -test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} { - catch {destroy .b1} - button .b1 -text "Sample text" -width 10 -height 2 - pack .b1 - set result "[winfo reqwidth .b1] [winfo reqheight .b1]" - .b1 configure -bitmap questhead - lappend result [winfo reqwidth .b1] [winfo reqheight .b1] -} {102 46 20 12} -test button-6.19 {ConfigureButton - computing geometry} { - catch {destroy .b1} - button .b1 -text "Button 1" - set old [winfo reqwidth .b1] - .b1 configure -text "Much longer text" - set new [winfo reqwidth .b1] - expr $old == $new -} {0} - -test button-7.1 {ButtonEventProc procedure} { - catch {destroy .b1} - button .b1 -text "Test Button" -command { - destroy .b1 - set x [list [winfo exists .b1] [info commands .b1]] - } - .b1 invoke - set x -} {0 {}} -test button-7.2 {ButtonEventProc procedure} { - deleteWindows +".b configure -height 0.5x"} +#ex 6.18 +test button-5.24 {ConfigureButton - computing geometry} -constraints { + fonts +} -body { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + .b configure -text "Sample text" -width 10 -height 2 + pack .b + set result "[winfo reqwidth .b] [winfo reqheight .b]" + .b configure -bitmap questhead + lappend result [winfo reqwidth .b] [winfo reqheight .b] +} -cleanup { + destroy .b +} -result {104 46 20 12} + +test button-5.25 {ConfigureButton - computing geometry} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} +} -body { + .b configure -text "Button 1" + set old [winfo reqwidth .b] + .b configure -text "Much longer text" + set new [winfo reqwidth .b] + expr {$old == $new} +} -cleanup { + destroy .b +} -result {0} + +test button-6.1 {ButtonEventProc procedure} -body { + button .b -text "Test Button" -command { + destroy .b + set x [list [winfo exists .b] [info commands .b]] +} + .b invoke + return $x +} -cleanup { + destroy .b +} -result {0 {}} + +test button-6.2 {ButtonEventProc procedure} -setup { + set x {} +} -body { button .b1 -bg #543210 rename .b1 .b2 - set x {} lappend x [winfo children .] lappend x [.b2 cget -bg] destroy .b1 lappend x [info command .b*] [winfo children .] -} {.b1 #543210 {} {}} +} -cleanup { + destroy .b1 +} -result {.b1 #543210 {} {}} -test button-8.1 {ButtonCmdDeletedProc procedure} { - deleteWindows - button .b1 - rename .b1 {} +test button-7.1 {ButtonCmdDeletedProc procedure} -body { + button .b + rename .b {} list [info command .b*] [winfo children .] -} {{} {}} +} -cleanup { + destroy .b +} -result {{} {}} -test button-9.1 {TkInvokeButton procedure} { - catch {destroy .b1} +test button-8.1 {TkInvokeButton procedure} -setup { set x 0 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set result $x - .b1 invoke + .c invoke lappend result $x - .b1 invoke + .c invoke lappend result $x -} {0 1 0} -test button-9.2 {TkInvokeButton procedure} { - catch {destroy .b1} +} -cleanup { + destroy .c +} -result {0 1 0} + +test button-8.2 {TkInvokeButton procedure} -setup { + set x 0 +} -body { + checkbutton .c -variable x + trace variable x w bogusTrace + .c invoke +} -cleanup { + destroy .c + trace vdelete x w bogusTrace +} -returnCodes {error} -result {can't set "x": trace aborted} +test button-8.3 {TkInvokeButton procedure} -setup { set x 0 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x trace variable x w bogusTrace - set result [list [catch {.b1 invoke} msg] $msg $x] + catch {.c invoke} + return $x +} -cleanup { + destroy .c trace vdelete x w bogusTrace - set result -} {1 {can't set "x": trace aborted} 1} -test button-9.3 {TkInvokeButton procedure} { - catch {destroy .b1} +} -result {1} +test button-8.4 {TkInvokeButton procedure} -setup { set x 1 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x trace variable x w bogusTrace - set result [list [catch {.b1 invoke} msg] $msg $x] + .c invoke +} -cleanup { + destroy .c + trace vdelete x w bogusTrace +} -returnCodes {error} -result {can't set "x": trace aborted} +test button-8.5 {TkInvokeButton procedure} -setup { + set x 1 +} -body { + checkbutton .c -variable x + trace variable x w bogusTrace + catch {.c invoke} + return $x +} -cleanup { + destroy .c trace vdelete x w bogusTrace - set result -} {1 {can't set "x": trace aborted} 0} -test button-9.4 {TkInvokeButton procedure} { - catch {destroy .b1} +} -result {0} + +test button-8.6 {TkInvokeButton procedure} -setup { set x 0 - radiobutton .b1 -variable x -value red +} -body { + radiobutton .r -variable x -value red set result $x - .b1 invoke + .r invoke lappend result $x - .b1 invoke + .r invoke lappend result $x -} {0 red red} -test button-9.5 {TkInvokeButton procedure} -body { - catch {destroy .b1} - radiobutton .b1 -variable x -value red +} -cleanup { + destroy .r +} -result {0 red red} + +test button-8.7 {TkInvokeButton procedure} -body { + radiobutton .r -variable x -value red + set x green + trace variable x w bogusTrace + .r invoke +} -cleanup { + destroy .r + trace vdelete x w bogusTrace +} -returnCodes {error} -result {can't set "x": trace aborted} +test button-8.8 {TkInvokeButton procedure} -body { + radiobutton .r -variable x -value red set x green trace variable x w bogusTrace - set result [list [catch {.b1 invoke} msg] $msg $errorInfo $x] + catch {.r invoke} + list $errorInfo $x +} -cleanup { + destroy .r trace vdelete x w bogusTrace - set result -} -match glob -result {1 {can't set "x": trace aborted} {*trace aborted +} -match {glob} -result {{*trace aborted while executing * -".b1 invoke"} red} -test button-9.6 {TkInvokeButton procedure} { - deleteWindows +".r invoke"} red} + +#ex 9.6 +test button-8.9 {TkInvokeButton procedure} -setup { set result untouched - button .b1 -command {set result invoked} - list [catch {.b1 invoke} msg] $msg $result -} {0 invoked invoked} -test button-9.7 {TkInvokeButton procedure} { - deleteWindows +} -body { + button .b -command {set result invoked} + set msg [.b invoke] + list $msg $result +} -cleanup { + destroy .b +} -result {invoked invoked} +test button-8.10 {TkInvokeButton procedure} -setup { set result untouched set x 0 - checkbutton .b1 -variable x -command {set result "invoked $x"} - list [catch {.b1 invoke} msg] $msg $result -} {0 {invoked 1} {invoked 1}} -test button-9.8 {TkInvokeButton procedure} { - deleteWindows +} -body { + checkbutton .c -variable x -command {set result "invoked $x"} + set msg [.c invoke] + list $msg $result +} -cleanup { + destroy .c +} -result {{invoked 1} {invoked 1}} +test button-8.11 {TkInvokeButton procedure} -setup { set result untouched set x 0 - radiobutton .b1 -variable x -value red -command {set result "invoked $x"} - list [catch {.b1 invoke} msg] $msg $result -} {0 {invoked red} {invoked red}} +} -body { + radiobutton .r -variable x -value red -command {set result "invoked $x"} + set msg [.r invoke] + list $msg $result +} -cleanup { + destroy .r +} -result {{invoked red} {invoked red}} -test button-10.1 {ButtonVarProc procedure} { - deleteWindows +test button-9.1 {ButtonVarProc procedure} -body { set x 1 - checkbutton .b1 -variable x + checkbutton .c -variable x unset x set result [info exists x] - .b1 toggle + .c toggle lappend result $x set x 0 - .b1 toggle + .c toggle lappend result $x -} {0 1 1} -test button-10.2 {ButtonVarProc procedure} { - deleteWindows +} -cleanup { + destroy .c +} -result {0 1 1} +test button-9.2 {ButtonVarProc procedure} -body { set x 0 - checkbutton .b1 -variable x + checkbutton .c -variable x set x 44 - .b1 toggle - set x -} {1} -test button-10.3 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {1} +test button-9.3 {ButtonVarProc procedure} -setup { set x 1 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 44 - .b1 toggle - set x -} {1} -test button-10.4 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {1} +test button-9.4 {ButtonVarProc procedure} -setup { set x 0 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 1 - .b1 toggle - set x -} {0} -test button-10.5 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {0} +test button-9.5 {ButtonVarProc procedure} -setup { set x 1 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 1 - .b1 toggle - set x -} {0} -test button-10.6 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {0} +test button-9.6 {ButtonVarProc procedure} -setup { set x 0 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 0 - .b1 toggle - set x -} {1} -test button-10.7 {ButtonVarProc procedure} { - deleteWindows + .c toggle + return $x +} -cleanup { + destroy .c +} -result {1} +test button-9.7 {ButtonVarProc procedure} -setup { set x 1 - checkbutton .b1 -variable x +} -body { + checkbutton .c -variable x set x 0 - .b1 toggle - set x -} {1} -test button-10.8 {ButtonVarProc procedure, can't read variable} { - # This test does nothing but produce a core dump if there's a prbblem. - deleteWindows - catch {unset a} - checkbutton .b1 -variable a + .c toggle + return $x +} -cleanup { + destroy .c +} -result {1} +test button-9.8 {ButtonVarProc procedure, can't read variable} -setup { +# This test does nothing but produce a core dump if there's a prbblem. + unset -nocomplain a +} -body { + checkbutton .c -variable a unset a set a(32) 0 unset a -} {} +} -cleanup { + destroy .c +} -result {} -test button-11.1 {ButtonTextVarProc procedure} { - deleteWindows +test button-10.1 {ButtonTextVarProc procedure} -body { set x Label - button .b1 -textvariable x + button .b -textvariable x unset x - set result [list $x [lindex [.b1 configure -text] 4]] + set result [list $x [.b cget -text]] set x New - lappend result [lindex [.b1 configure -text] 4] -} {Label Label New} -test button-11.2 {ButtonTextVarProc procedure} { - deleteWindows - # Windows buttons have a default min width, so we have to - # set this to be longer to force the wider button. + lappend result [.b cget -text] +} -cleanup { + destroy .b +} -result {Label Label New} +test button-10.2 {ButtonTextVarProc procedure} -setup { + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} +} -body { +# Windows buttons have a default min width, so we have to +# set this to be longer to force the wider button. set x ExtraLongLabel - button .b1 -textvariable x - set old [winfo reqwidth .b1] + .b configure -textvariable x + set old [winfo reqwidth .b] set x New - set new [winfo reqwidth .b1] - list [lindex [.b1 configure -text] 4] [expr $old == $new] -} {New 0} + set new [winfo reqwidth .b] + expr {$old == $new} +} -cleanup { + destroy .b +} -result {0} -test button-12.1 {ButtonImageProc procedure} testImageType { - deleteWindows - eval image delete [image names] +test button-11.1 {ButtonImageProc procedure} -constraints { + testImageType +} -setup { + label .l -highlightthickness 0 -font {Helvetica -12 bold} image create test image1 - label .b1 -image image1 -padx 0 -pady 0 -bd 0 - pack .b1 - set result "[winfo reqwidth .b1] [winfo reqheight .b1]" +} -body { + .l configure -image image1 -padx 0 -pady 0 -bd 0 + pack .l + set result "[winfo reqwidth .l] [winfo reqheight .l]" image1 changed 0 0 0 0 80 100 - lappend result [winfo reqwidth .b1] [winfo reqheight .b1] -} {30 15 80 100} - -deleteWindows -set l [interp hidden] + lappend result [winfo reqwidth .l] [winfo reqheight .l] +} -cleanup { + destroy .l + image delete image1 +} -result {30 15 80 100} -test button-13.1 {button widget vs hidden commands} { - catch {destroy .b} +test button-12.1 {button widget vs hidden commands} -body { button .b -text hello + set l [interp hidden] interp hide {} .b destroy .b - list [winfo children .] [interp hidden] -} [list {} $l] - -deleteWindows - -test button-14.1 {size behaviouor} { - set res {} - foreach class {label button radiobutton checkbutton} { - eval destroy [winfo children .] - - $class .a -text Hej - $class .b -text Hej -width 10 -height 1 - $class .c -text "" -width 10 -height 1 - - for {set t 0} {$t < 2} {incr t} { - set res2 {} - # With -width, width should not be affected by text change - lappend res2 [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] - # With -height, height should not be affected by text change - lappend res2 [expr {[winfo reqheight .b] == [winfo reqheight .c]}] - # A one line text should be as high as -height 1 - lappend res2 [expr {[winfo reqheight .a] == [winfo reqheight .b]}] - lappend res $res2 - - # Do the second round with another font - .a configure -font "Arial 20" - .b configure -font "Arial 20" - .c configure -font "Arial 20" - } - } - set res -} {{1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1} {1 1 1}} - -deleteWindows - -option clear - -# cleanup + + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 == $res2} +} -cleanup { + destroy .b +} -result {1} + +test button-13.1 {size behaviouor: label} -setup { + label .a -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + label .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + label .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + set result {} +} -body { + .a configure -text Hej + .b configure -text Hej -width 10 -height 1 + .c configure -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c +} -result {1 1 1} +test button-13.2 {size behaviouor: label} -setup { + label .a -borderwidth 2 -highlightthickness 2 -font {Arial 20} + label .b -borderwidth 2 -highlightthickness 2 -font {Arial 20} + label .c -borderwidth 2 -highlightthickness 2 -font {Arial 20} + set result {} +} -body { + .a configure -text Hej + .b configure -text Hej -width 10 -height 1 + .c configure -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c +} -result {1 1 1} + +test button-13.3 {size behaviouor: button} -setup { + button .a -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + button .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + set result {} +} -body { + .a configure -text Hej + .b configure -text Hej -width 10 -height 1 + .c configure -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c +} -result {1 1 1} +test button-13.4 {size behaviouor: button} -setup { + button .a -borderwidth 2 -highlightthickness 2 -font {Arial 20} + button .b -borderwidth 2 -highlightthickness 2 -font {Arial 20} + button .c -borderwidth 2 -highlightthickness 2 -font {Arial 20} + set result {} +} -body { + .a configure -text Hej + .b configure -text Hej -width 10 -height 1 + .c configure -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c +} -result {1 1 1} + +test button-13.5 {size behaviouor: radiobutton} -setup { + radiobutton .a -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + radiobutton .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + radiobutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + set result {} +} -body { + .a configure -text Hej + .b configure -text Hej -width 10 -height 1 + .c configure -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c +} -result {1 1 1} + +test button-13.6 {size behaviouor: radiobutton} -setup { + radiobutton .a -borderwidth 2 -highlightthickness 2 -font {Arial 20} + radiobutton .b -borderwidth 2 -highlightthickness 2 -font {Arial 20} + radiobutton .c -borderwidth 2 -highlightthickness 2 -font {Arial 20} + set result {} +} -body { + .a configure -text Hej + .b configure -text Hej -width 10 -height 1 + .c configure -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c +} -result {1 1 1} + +test button-13.7 {size behaviouor: checkbutton} -setup { + checkbutton .a -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + checkbutton .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + set result {} +} -body { + .a configure -text Hej + .b configure -text Hej -width 10 -height 1 + .c configure -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c +} -result {1 1 1} + +test button-13.8 {size behaviouor: checkbutton} -setup { + checkbutton .a -borderwidth 2 -highlightthickness 2 -font {Arial 20} + checkbutton .b -borderwidth 2 -highlightthickness 2 -font {Arial 20} + checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Arial 20} + set result {} +} -body { + .a configure -text Hej + .b configure -text Hej -width 10 -height 1 + .c configure -text "" -width 10 -height 1 + +# With -width, width should not be affected by text change + lappend result [expr {[winfo reqwidth .b] == [winfo reqwidth .c]}] +# With -height, height should not be affected by text change + lappend result [expr {[winfo reqheight .b] == [winfo reqheight .c]}] +# A one line text should be as high as -height 1 + lappend result [expr {[winfo reqheight .a] == [winfo reqheight .b]}] +} -cleanup { + destroy .a .b .c +} -result {1 1 1} + +imageFinish cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/canvImg.test b/tests/canvImg.test index 1dffc5e..776d268 100644 --- a/tests/canvImg.test +++ b/tests/canvImg.test @@ -7,103 +7,161 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +imageInit -eval image delete [image names] +# Canvas used in every test case of the whole file canvas .c pack .c update -if {[testConstraint testImageType]} { - image create test foo -variable x - image create test foo2 -variable y - foo2 changed 0 0 0 0 80 60 -} -test canvImg-1.1 {options for image items} { - .c delete all + + +test canvImg-1.1 {options for image items} -body { .c create image 50 50 -anchor nw -tags i1 .c itemconfigure i1 -anchor -} {-anchor {} {} center nw} -test canvImg-1.2 {options for image items} { - .c delete all - list [catch {.c create image 50 50 -anchor gorp -tags i1} msg] $msg -} {1 {bad anchor position "gorp": must be n, ne, e, se, s, sw, w, nw, or center}} -test canvImg-1.3 {options for image items} testImageType { - .c delete all +} -cleanup { + .c delete all +} -result {-anchor {} {} center nw} +test canvImg-1.2 {options for image items} -body { + .c create image 50 50 -anchor gorp -tags i1 +} -cleanup { + .c delete all +} -returnCodes {error} -result {bad anchor position "gorp": must be n, ne, e, se, s, sw, w, nw, or center} +test canvImg-1.3 {options for image items} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c create image 50 50 -image foo -tags i1 .c itemconfigure i1 -image -} {-image {} {} {} foo} -test canvImg-1.4 {options for image items} { - .c delete all - list [catch {.c create image 50 50 -image unknown -tags i1} msg] $msg -} {1 {image "unknown" doesn't exist}} -test canvImg-1.5 {options for image items} testImageType { - .c delete all +} -cleanup { + .c delete all + image delete foo +} -result {-image {} {} {} foo} +test canvImg-1.4 {options for image items} -body { + .c create image 50 50 -image unknown -tags i1 +} -cleanup { + .c delete all +} -returnCodes {error} -result {image "unknown" doesn't exist} +test canvImg-1.5 {options for image items} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c create image 50 50 -image foo -tags {i1 foo} .c itemconfigure i1 -tags -} {-tags {} {} {} {i1 foo}} +} -cleanup { + .c delete all + image delete foo +} -result {-tags {} {} {} {i1 foo}} -test canvImg-2.1 {CreateImage procedure} { - list [catch {.c create image 40} msg] $msg -} {1 {wrong # coordinates: expected 2, got 1}} -test canvImg-2.2 {CreateImage procedure} { - list [catch {.c create image 40 50 60} msg] $msg -} {1 {unknown option "60"}} -test canvImg-2.3 {CreateImage procedure} { +test canvImg-2.1 {CreateImage procedure} -body { + .c create image 40 +} -cleanup { + .c delete all +} -returnCodes {error} -result {wrong # coordinates: expected 2, got 1} +test canvImg-2.2 {CreateImage procedure} -body { + .c create image 40 50 60 +} -cleanup { + .c delete all +} -returnCodes {error} -result {unknown option "60"} +test canvImg-2.3 {CreateImage procedure} -body { .c delete all set i [.c create image 50 50] list [lindex [.c itemconf $i -anchor] 4] \ [lindex [.c itemconf $i -image] 4] \ [lindex [.c itemconf $i -tags] 4] -} {center {} {}} -test canvImg-2.4 {CreateImage procedure} { - list [catch {.c create image xyz 40} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvImg-2.5 {CreateImage procedure} { - list [catch {.c create image 50 qrs} msg] $msg -} {1 {bad screen distance "qrs"}} -test canvImg-2.6 {CreateImage procedure} testImageType { - list [catch {.c create image 50 50 -gorp foo} msg] $msg -} {1 {unknown option "-gorp"}} - -test canvImg-3.1 {ImageCoords procedure} testImageType { +} -cleanup { .c delete all - .c create image 50 100 -image foo -tags i1 - .c coords i1 -} {50.0 100.0} -test canvImg-3.2 {ImageCoords procedure} testImageType { +} -result {center {} {}} +test canvImg-2.4 {CreateImage procedure} -body { + .c create image xyz 40 +} -cleanup { .c delete all +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvImg-2.5 {CreateImage procedure} -body { + .c create image 50 qrs +} -cleanup { + .c delete all +} -returnCodes {error} -result {bad screen distance "qrs"} +test canvImg-2.6 {CreateImage procedure} -constraints testImageType -body { + .c create image 50 50 -gorp foo +} -cleanup { + .c delete all +} -returnCodes {error} -result {unknown option "-gorp"} + + +test canvImg-3.1 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { + .c create image 50 100 -image foo -tags i1 + format {%.6g %.6g} {*}[.c coords i1] +} -cleanup { + .c delete all + image delete foo +} -result {50 100} +test canvImg-3.2 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { .c create image 50 100 -image foo -tags i1 - list [catch {.c coords i1 dumb 100} msg] $msg -} {1 {bad screen distance "dumb"}} -test canvImg-3.3 {ImageCoords procedure} testImageType { + .c coords i1 dumb 100 +} -cleanup { + .c delete all + image delete foo +} -returnCodes {error} -result {bad screen distance "dumb"} +test canvImg-3.3 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { .c delete all .c create image 50 100 -image foo -tags i1 - list [catch {.c coords i1 250 dumb0} msg] $msg -} {1 {bad screen distance "dumb0"}} -test canvImg-3.4 {ImageCoords procedure} testImageType { + .c coords i1 250 dumb0 +} -cleanup { + .c delete all + image delete foo +} -returnCodes {error} -result {bad screen distance "dumb0"} +test canvImg-3.4 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { .c delete all .c create image 50 100 -image foo -tags i1 - list [catch {.c coords i1 250} msg] $msg -} {1 {wrong # coordinates: expected 2, got 1}} -test canvImg-3.5 {ImageCoords procedure} testImageType { + .c coords i1 250 +} -cleanup { + .c delete all + image delete foo +} -returnCodes {error} -result {wrong # coordinates: expected 2, got 1} +test canvImg-3.5 {ImageCoords procedure} -constraints testImageType -setup { + image create test foo +} -body { .c delete all .c create image 50 100 -image foo -tags i1 - list [catch {.c coords i1 250 300 400} msg] $msg -} {1 {wrong # coordinates: expected 0 or 2, got 3}} + .c coords i1 250 300 400 +} -cleanup { + .c delete all + image delete foo +} -returnCodes {error} -result {wrong # coordinates: expected 0 or 2, got 3} + -test canvImg-4.1 {ConfiugreImage procedure} testImageType { +test canvImg-4.1 {ConfiugreImage procedure} -constraints testImageType -setup { .c delete all +} -body { + image create test foo -variable x .c create image 50 100 -image foo -tags i1 update set x {} .c itemconfigure i1 -image {} update list $x [.c bbox i1] -} {{{foo free}} {}} -test canvImg-4.2 {ConfiugreImage procedure} testImageType { - .c delete all +} -cleanup { + .c delete all + image delete foo +} -result {{{foo free}} {}} +test canvImg-4.2 {ConfiugreImage procedure} -constraints testImageType -setup { + .c delete all +} -body { + image create test foo -variable x + image create test foo2 -variable y + foo2 changed 0 0 0 0 80 60 .c create image 50 100 -image foo -tags i1 -anchor nw update set x {} @@ -111,281 +169,628 @@ test canvImg-4.2 {ConfiugreImage procedure} testImageType { .c itemconfigure i1 -image foo2 update list $x $y [.c bbox i1] -} {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}} -test canvImg-4.3 {ConfiugreImage procedure} testImageType { - .c delete all +} -cleanup { + .c delete all + image delete foo + image delete foo2 +} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}} +test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup { + .c delete all +} -body { + image create test foo -variable x + image create test foo2 -variable y + foo2 changed 0 0 0 0 80 60 .c create image 50 100 -image foo -tags i1 -anchor nw update set x {} set y {} - list [catch {.c itemconfigure i1 -image lousy} msg] $msg -} {1 {image "lousy" doesn't exist}} + .c itemconfigure i1 -image lousy +} -cleanup { + .c delete all + image delete foo foo2 +} -returnCodes {error} -result {image "lousy" doesn't exist} -test canvImg-5.1 {DeleteImage procedure} testImageType { - image create test xyzzy -variable z + +test canvImg-5.1 {DeleteImage procedure} -constraints testImageType -setup { .c delete all + imageCleanup +} -body { + image create test foo -variable x + image create test foo2 -variable y + image create test xyzzy -variable z .c create image 50 100 -image xyzzy -tags i1 update - set names [lsort [image names]] + set names [lsort [imageNames]] image delete xyzzy set z {} - set names2 [lsort [image names]] + set names2 [lsort [imageNames]] .c delete i1 update - list $names $names2 $z [lsort [image names]] -} {{foo foo2 xyzzy} {foo foo2} {} {foo foo2}} -test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} { + list $names $names2 $z [lsort [imageNames]] +} -cleanup { + imageCleanup + .c delete all +} -result {{foo foo2 xyzzy} {foo foo2} {} {foo foo2}} +test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} -body { .c delete all .c create image 50 100 -tags i1 update .c delete i1 update -} {} +} -result {} + -test canvImg-6.1 {ComputeImageBbox procedure} testImageType { +test canvImg-6.1 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo .c delete all +} -body { .c create image 15.51 17.51 -image foo -tags i1 -anchor nw .c bbox i1 -} {16 18 46 33} -test canvImg-6.2 {ComputeImageBbox procedure} testImageType { +} -cleanup { .c delete all + imageCleanup +} -result {16 18 46 33} +test canvImg-6.2 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c create image 15.49 17.49 -image foo -tags i1 -anchor nw .c bbox i1 -} {15 17 45 32} -test canvImg-6.3 {ComputeImageBbox procedure} { +} -cleanup { + .c delete all + imageCleanup +} -result {15 17 45 32} +test canvImg-6.3 {ComputeImageBbox procedure} -setup { .c delete all +} -body { .c create image 20 30 -tags i1 -anchor nw .c bbox i1 -} {} -test canvImg-6.4 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-6.4 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor nw .c bbox i1 -} {20 30 50 45} -test canvImg-6.5 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + imageCleanup +} -result {20 30 50 45} +test canvImg-6.5 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor n .c bbox i1 -} {5 30 35 45} -test canvImg-6.6 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + imageCleanup +} -result {5 30 35 45} +test canvImg-6.6 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor ne .c bbox i1 -} {-10 30 20 45} -test canvImg-6.7 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + imageCleanup +} -result {-10 30 20 45} +test canvImg-6.7 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor e .c bbox i1 -} {-10 23 20 38} -test canvImg-6.8 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + imageCleanup +} -result {-10 23 20 38} +test canvImg-6.8 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor se .c bbox i1 -} {-10 15 20 30} -test canvImg-6.9 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + imageCleanup +} -result {-10 15 20 30} +test canvImg-6.9 {ComputeImageBbox procedure} -constraints testImageType -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor s .c bbox i1 -} {5 15 35 30} -test canvImg-6.10 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + imageCleanup +} -result {5 15 35 30} +test canvImg-6.10 {ComputeImageBbox procedure} -constraints { + testImageType +} -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor sw .c bbox i1 -} {20 15 50 30} -test canvImg-6.11 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {20 15 50 30} +test canvImg-6.11 {ComputeImageBbox procedure} -constraints { + testImageType +} -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor w .c bbox i1 -} {20 23 50 38} -test canvImg-6.12 {ComputeImageBbox procedure} testImageType { +} -cleanup { + .c delete all + image delete foo +} -result {20 23 50 38} +test canvImg-6.12 {ComputeImageBbox procedure} -constraints { + testImageType +} -setup { + image create test foo + .c delete all +} -body { .c delete all .c create image 20 30 -image foo -tags i1 -anchor center .c bbox i1 -} {5 23 35 38} +} -cleanup { + .c delete all + image delete foo +} -result {5 23 35 38} # The following test is non-portable because of differences in # coordinate rounding on some machines (does 0.5 round up?). -test canvImg-7.1 {DisplayImage procedure} {nonPortable testImageType} { +test canvImg-7.1 {DisplayImage procedure} -constraints { + nonPortable testImageType +} -setup { .c delete all +} -body { + image create test foo -variable x .c create image 50 100 -image foo -tags i1 -anchor nw update set x {} .c create rect 55 110 65 115 -width 1 -outline black -fill white update set x -} {{foo display 4 9 12 6 30 30}} -test canvImg-7.2 {DisplayImage procedure, no image} { +} -result {{foo display 4 9 12 6 30 30}} +test canvImg-7.2 {DisplayImage procedure, no image} -body { .c delete all .c create image 50 100 -tags i1 update .c create rect 55 110 65 115 -width 1 -outline black -fill white update -} {} +} -result {} -.c delete all + +# image used in 8.* test cases if {[testConstraint testImageType]} { - .c create image 50 100 -image foo -tags image -anchor nw + image create test foo } -.c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} -foreach check { - {canvImg-8.1 {50 70 80 81} {70 90} rect} - {canvImg-8.2 {50 70 80 79} {70 90} image} - {canvImg-8.3 {99 70 110 81} {90 90} rect} - {canvImg-8.4 {101 70 110 79} {90 90} image} - {canvImg-8.5 {99 100 110 115} {90 110} rect} - {canvImg-8.6 {101 100 110 115} {90 110} image} - {canvImg-8.7 {99 134 110 145} {90 125} rect} - {canvImg-8.8 {101 136 110 145} {90 125} image} - {canvImg-8.9 {50 134 80 145} {70 125} rect} - {canvImg-8.10 {50 136 80 145} {70 125} image} - {canvImg-8.11 {20 134 31 145} {40 125} rect} - {canvImg-8.12 {20 136 29 145} {40 125} image} - {canvImg-8.13 {20 100 31 115} {40 110} rect} - {canvImg-8.14 {20 100 29 115} {40 110} image} - {canvImg-8.15 {20 70 31 80} {40 90} rect} - {canvImg-8.16 {20 70 29 79} {40 90} image} - {canvImg-8.17 {60 70 69 109} {70 110} image} - {canvImg-8.18 {60 70 71 111} {70 110} rect} -} { - lassign $check name rectCoords testPoint result - test $name {ImageToPoint procedure} testImageType { - .c coords rect {*}$rectCoords - .c gettags [.c find closest {*}$testPoint] - } $result -} - +test canvImg-8.1 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect 50 70 80 81 + .c gettags [.c find closest 70 90] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.2 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{50 70 80 79} + .c gettags [.c find closest {*}{70 90}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.3 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{99 70 110 81} + .c gettags [.c find closest {*}{90 90}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.4 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{101 70 110 79} + .c gettags [.c find closest {*}{90 90}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.5 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{99 100 110 115} + .c gettags [.c find closest {*}{90 110}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.6 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{101 100 110 115} + .c gettags [.c find closest {*}{90 110}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.7 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{99 134 110 145} + .c gettags [.c find closest {*}{90 125}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.8 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{101 136 110 145} + .c gettags [.c find closest {*}{90 125}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.9 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{50 134 80 145} + .c gettags [.c find closest {*}{70 125}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.10 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{50 136 80 145} + .c gettags [.c find closest {*}{70 125}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.11 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 134 31 145} + .c gettags [.c find closest {*}{40 125}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.12 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 136 29 145} + .c gettags [.c find closest {*}{40 125}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.13 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 100 31 115} + .c gettags [.c find closest {*}{40 110}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.14 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 100 29 115} + .c gettags [.c find closest {*}{40 110}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.15 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 70 31 80} + .c gettags [.c find closest {*}{40 90}] +} -cleanup { + .c delete all +} -result {rect} +test canvImg-8.16 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{20 70 29 79} + .c gettags [.c find closest {*}{40 90}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.17 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{60 70 69 109} + .c gettags [.c find closest {*}{70 110}] +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.18 {ImageToArea procedure} -constraints testImageType -setup { + .c create image 50 100 -image foo -tags image -anchor nw + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} +} -body { + .c coords rect {*}{60 70 71 111} + .c gettags [.c find closest {*}{70 110}] +} -cleanup { + .c delete all +} -result {rect} .c delete all -if {[testConstraint testImageType]} { + +test canvImg-8.19 {ImageToArea procedure} -constraints testImageType -body { .c create image 50 100 -image foo -tags image -anchor nw -} -test canvImg-8.19 {ImageToArea procedure} testImageType { .c gettags [.c find overlapping 60 0 70 99] -} {} -test canvImg-8.20 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.20 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 0 70 99.999] -} {} -test canvImg-8.21 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.21 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 0 70 101] -} {image} -test canvImg-8.22 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.22 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 81 105 120 115] -} {} -test canvImg-8.23 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.23 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 80.001 105 120 115] -} {} -test canvImg-8.24 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.24 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 79 105 120 115] -} {image} -test canvImg-8.25 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.25 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 116 70 150] -} {} -test canvImg-8.26 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.26 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 115.001 70 150] -} {} -test canvImg-8.27 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.27 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 60 114 70 150] -} {image} -test canvImg-8.28 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.28 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 105 49 115] -} {} -test canvImg-8.29 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.29 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 105 50 114.999] -} {} -test canvImg-8.30 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.30 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 105 51 115] -} {image} -test canvImg-8.31 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.31 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 0 49.999 99.999] -} {} -test canvImg-8.32 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.32 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 0 51 101] -} {image} -test canvImg-8.33 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.33 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 80 0 150 100] -} {} -test canvImg-8.34 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.34 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 79 0 150 101] -} {image} -test canvImg-8.35 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.35 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 80.001 115.001 150 180] -} {} -test canvImg-8.36 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.36 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 79 114 150 180] -} {image} -test canvImg-8.37 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.37 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 115 50 180] -} {} -test canvImg-8.38 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.38 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find overlapping 0 114 51 180] -} {image} -test canvImg-8.39 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.39 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 0 0 200 200] -} {image} -test canvImg-8.40 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.40 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 49.999 99.999 80.001 115.001] -} {image} -test canvImg-8.41 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {image} +test canvImg-8.41 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 51 100 80 115] -} {} -test canvImg-8.42 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.42 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 50 101 80 115] -} {} -test canvImg-8.43 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.43 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 50 100 79 115] -} {} -test canvImg-8.44 {ImageToArea procedure} testImageType { +} -cleanup { + .c delete all +} -result {} +test canvImg-8.44 {ImageToArea procedure} -constraints testImageType -body { + .c create image 50 100 -image foo -tags image -anchor nw .c gettags [.c find enclosed 50 100 80 114] -} {} +} -cleanup { + .c delete all +} -result {} +if {[testConstraint testImageType]} { + image delete foo +} + -test canvImg-9.1 {DisplayImage procedure} testImageType { +test canvImg-9.1 {DisplayImage procedure} -constraints testImageType -setup { .c delete all + image create test foo +} -body { .c create image 50 100 -image foo -tags image -anchor nw .c scale image 25 0 2.0 1.5 .c bbox image -} {75 150 105 165} +} -cleanup { + .c delete all + image delete foo +} -result {75 150 105 165} -test canvImg-10.1 {TranslateImage procedure} testImageType { +test canvImg-10.1 {TranslateImage procedure} -constraints testImageType -setup { .c delete all +} -body { + image create test foo -variable x .c create image 50 100 -image foo -tags image -anchor nw update set x {} foo changed 2 4 6 8 30 15 update - set x -} {{foo display 2 4 6 8 30 30}} + return $x +} -cleanup { + .c delete all + image delete foo +} -result {{foo display 2 4 6 8 30 30}} -test canvImg-11.1 {TranslateImage procedure} testImageType { +test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup { .c delete all +} -body { + image create test foo -variable x .c create image 50 100 -image foo -tags image -anchor nw update set x {} foo changed 2 4 6 8 40 50 update - set x -} {{foo display 0 0 40 50 30 30}} -test canvImg-11.2 {ImageChangedProc procedure} testImageType { - .c delete all + return $x +} -cleanup { + .c delete all + image delete foo +} -result {{foo display 0 0 40 50 30 30}} +test canvImg-11.2 {ImageChangedProc procedure} -constraints { + testImageType +} -setup { + .c delete all +} -body { image create test foo -variable x .c create image 50 100 -image foo -tags image -anchor center update set x {} foo changed 0 0 0 0 40 50 .c bbox image -} {30 75 70 125} -test canvImg-11.3 {ImageChangedProc procedure} testImageType { - .c delete all +} -cleanup { + .c delete all + image delete foo +} -result {30 75 70 125} +test canvImg-11.3 {ImageChangedProc procedure} -constraints { + testImageType +} -setup { + .c delete all +} -body { image create test foo -variable x + image create test foo2 -variable y foo changed 0 0 0 0 40 50 + foo2 changed 0 0 0 0 80 60 + .c create image 50 100 -image foo -tags image -anchor nw .c create image 70 110 -image foo2 -anchor nw update set y {} image create test foo -variable x update - set y -} {{foo2 display 0 0 20 40 50 40}} + return $y +} -cleanup { + .c delete all + image delete foo foo2 +} -result {{foo2 display 0 0 20 40 50 40}} # cleanup +imageFinish cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/canvMoveto.test b/tests/canvMoveto.test new file mode 100644 index 0000000..79761a4 --- /dev/null +++ b/tests/canvMoveto.test @@ -0,0 +1,56 @@ +# This file is a Tcl script to test out the canvas "moveto" command. It is +# derived from canvRect.test. +# +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2004 Neil McKay. +# All rights reserved. + +package require tcltest 2.1 +eval tcltest::configure $argv +tcltest::loadTestedCommands + +canvas .c -width 400 -height 300 -bd 2 -relief sunken +.c create rectangle 20 20 80 80 -tag {test rect1} +.c create rectangle 40 40 90 100 -tag {test rect2} + +test canvMoveto-1.1 {Bad args handling for "moveto" command} -body { + .c moveto test +} -returnCodes error -result {wrong # args: should be ".c moveto tagOrId x y"} +test canvMoveto-1.2 {Bad args handling for "moveto" command} -body { + .c moveto rect +} -returnCodes error -result {wrong # args: should be ".c moveto tagOrId x y"} +test canvMoveto-1.3 {Bad args handling for "moveto" command} -body { + .c moveto test 12 +} -returnCodes error -result {wrong # args: should be ".c moveto tagOrId x y"} +test canvMoveto-1.4 {Bad args handling for "moveto" command} -body { + .c moveto test 12 y +} -returnCodes error -result {bad screen distance "y"} +test canvMoveto-1.5 {Bad args handling for "moveto" command} -body { + .c moveto test 12 20 -anchor +} -returnCodes error -result {wrong # args: should be ".c moveto tagOrId x y"} + +test canvMoveto-2.1 {Canvas "moveto" command coordinates} { + .c moveto test 200 150 + .c bbox test +} {200 150 272 232} +test canvMoveto-2.2 {Canvas "moveto" command, blank y coordinate} { + .c moveto test 200 150 + .c moveto test 150 {} + .c bbox test +} {150 150 222 232} +test canvMoveto-2.3 {Canvas "moveto" command, blank x coordinate} { + .c moveto test 200 150 + .c moveto test {} 200 + .c bbox test +} {200 200 272 282} + +.c delete withtag all + +# cleanup +cleanupTests +return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/canvPs.test b/tests/canvPs.test index f2df447..c7ba958 100644 --- a/tests/canvPs.test +++ b/tests/canvPs.test @@ -6,10 +6,13 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +imageInit +# canvas used in 1.* and 2.* test cases canvas .c -width 400 -height 300 -bd 2 -relief sunken .c create rectangle 20 20 80 80 -fill red pack .c @@ -43,6 +46,7 @@ test canvPs-1.2 {test writing to a file, idempotency} -constraints { removeFile bar.ps } -result ok + test canvPs-2.1 {test writing to a channel} -constraints { unixOrPc } -setup { @@ -75,7 +79,7 @@ test canvPs-2.2 {test writing to channel, idempotency} -constraints { close $c2 set status ok if {[file size $bar] != [file size $foo]} { - set status broken + set status broken } set status } -cleanup { @@ -97,7 +101,7 @@ test canvPs-2.3 {test writing to channel and file, same output} -constraints { .c postscript -file $bar set status ok if {[file size $foo] != [file size $bar]} { - set status broken + set status broken } set status } -cleanup { @@ -119,21 +123,22 @@ test canvPs-2.4 {test writing to channel and file, same output} -constraints { .c postscript -file $bar set status ok if {[file size $foo] != [file size $bar]} { - set status broken + set status broken } set status } -cleanup { removeFile foo.ps removeFile bar.ps } -result ok +destroy .c + -test canvPs-3.1 {test ps generation with an embedded window} -setup { +test canvPs-3.1 {test ps generation with an embedded window} -constraints { + notAqua +} -setup { set bar [makeFile {} bar.ps] file delete $bar -} -constraints { - notAqua } -body { - destroy .c pack [canvas .c -width 200 -height 200 -background white] .c create rect 20 20 150 150 -tags rect0 -dash . -width 2 .c create arc 0 50 200 200 -tags arc0 \ @@ -150,13 +155,14 @@ test canvPs-3.1 {test ps generation with an embedded window} -setup { .c postscript -file $bar file exists $bar } -cleanup { + destroy .c + imageCleanup removeFile bar.ps -} -result 1 +} -result {1} test canvPs-3.2 {test ps generation with an embedded window not mapped} -setup { set bar [makeFile {} bar.ps] file delete $bar } -body { - destroy .c pack [canvas .c -width 200 -height 200 -background white] entry .c.e -background pink -foreground blue -width 14 .c.e insert 0 "we gonna be postscripted" @@ -164,18 +170,27 @@ test canvPs-3.2 {test ps generation with an embedded window not mapped} -setup { .c postscript -file $bar file exists $bar } -cleanup { + destroy .c removeFile bar.ps -} -result 1 +} -result {1} -test canvPs-4.1 {test ps generation with single-point uncolored poly, bug 734498} {} { - destroy .c + +test canvPs-4.1 {test ps generation with single-point uncolored poly, bug 734498} -body { pack [canvas .c] .c create poly 10 20 10 20 - catch {.c postscript} -} 0 + .c postscript +} -cleanup { + destroy .c +} -returnCodes ok -match glob -result * + # cleanup unset -nocomplain foo bar +imageFinish deleteWindows cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/canvPsGrph.tcl b/tests/canvPsGrph.tcl index 343979f..08ccd74 100644 --- a/tests/canvPsGrph.tcl +++ b/tests/canvPsGrph.tcl @@ -50,13 +50,13 @@ proc mkObjs c { $c create rect 380 200 420 240 -fill black $c create rect 200 330 240 370 -fill black } - + if {$what == "oval"} { $c create oval 50 10 150 80 -fill black -stipple gray25 -outline {} $c create oval 100 100 200 150 -outline {} -fill black -stipple gray50 $c create oval 250 100 400 300 -width .5c } - + if {$what == "poly"} { $c create poly 100 200 200 50 300 200 -smooth yes -stipple gray25 \ -outline black -width 4 @@ -68,7 +68,7 @@ proc mkObjs c { $c create poly 20 200 100 220 90 100 40 250 \ -fill {} -outline brown -width 3 } - + if {$what == "line"} { $c create line 20 20 120 20 -arrow both -width 5 $c create line 20 80 150 80 20 200 150 200 -smooth yes diff --git a/tests/canvPsImg.tcl b/tests/canvPsImg.tcl index c06aeaa..1f46eca 100644 --- a/tests/canvPsImg.tcl +++ b/tests/canvPsImg.tcl @@ -35,7 +35,7 @@ toplevel .t wm title .t "Postscript Tests for Canvases: Images" wm iconname .t "Postscript" -message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for images. Click the buttons below to select a Visual type for the canvas and colormode for the Postscript output. Then click "Print" to send the results to the default printer, or "Print to file" to put the Postscript output in a file called "/tmp/test.ps". You can also click on items in the canvas to delete them. +message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for images. Click the buttons below to select a Visual type for the canvas and colormode for the Postscript output. Then click "Print" to send the results to the default printer, or "Print to file" to put the Postscript output in a file called "/tmp/test.ps". You can also click on items in the canvas to delete them. NOTE: Some Postscript printers may not be able to handle Postscript generated in color mode.} -width 6i pack .t.m -side top -fill both diff --git a/tests/canvRect.test b/tests/canvRect.test index b6c828e..a2cc51c 100644 --- a/tests/canvRect.test +++ b/tests/canvRect.test @@ -6,301 +6,444 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +# Canvas used in every test case of the whole file canvas .c -width 400 -height 300 -bd 2 -relief sunken pack .c -bind .c <1> { - puts "button down at (%x,%y)" -} update -set i 1 +# Rectangle used in canvRect-1.* tests .c create rectangle 20 20 80 80 -tag test -foreach test { - {-fill #ff0000 #ff0000 - non-existent {unknown color name "non-existent"}} - {-outline #123456 #123456 - bad_color {unknown color name "bad_color"}} - {-stipple gray50 gray50 - bogus {bitmap "bogus" not defined}} - {-tags {test a b c} {test a b c} - {} {}} - {-width 6.0 6.0 - abc {bad screen distance "abc"}} -} { - lassign $test name goodValue goodResult badValue badResult - test canvRect-1.$i "configuration options: good value for $name" { - .c itemconfigure test $name $goodValue - list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name] - } [list $goodResult $goodResult] - incr i - if {$badValue ne ""} { - test canvRect-1.$i "configuration options: bad value for $name" -body { - .c itemconfigure test $name $badValue - } -returnCodes error -result $badResult - } - incr i -} -test canvRect-1.$i {configuration options} { +test canvRect-1.1 {configuration options: good value for -fill} -body { + .c itemconfigure test -fill #ff0000 + list [.c itemcget test -fill] [lindex [.c itemconfigure test -fill] 4] +} -result {{#ff0000} #ff0000} +test canvRect-1.2 {configuration options: bad value for -fill} -body { + .c itemconfigure test -fill non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test canvRect-1.3 {configuration options: good value for -outline} -body { + .c itemconfigure test -outline #123456 + list [.c itemcget test -outline] [lindex [.c itemconfigure test -outline] 4] +} -result {{#123456} #123456} +test canvRect-1.4 {configuration options: bad value for -outline} -body { + .c itemconfigure test -outline non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test canvRect-1.5 {configuration options: good value for -stipple } -body { + .c itemconfigure test -stipple gray50 + list [.c itemcget test -stipple ] [lindex [.c itemconfigure test -stipple ] 4] +} -result {gray50 gray50} +test canvRect-1.6 {configuration options: bad value for -stipple } -body { + .c itemconfigure test -stipple bogus +} -returnCodes error -result {bitmap "bogus" not defined} +test canvRect-1.7 {configuration options: good value for -tags} -body { + .c itemconfigure test -tags {test a b c} + list [.c itemcget test -tags] [lindex [.c itemconfigure test -tags] 4] +} -result {{test a b c} {test a b c}} +test canvRect-1.8 {configuration options} -body { .c itemconfigure test -tags {test xyz} .c itemcget xyz -tags -} {test xyz} +} -result {test xyz} +test canvRect-1.9 {configuration options: good value for -width} -body { + .c itemconfigure test -width 6.0 + list [.c itemcget test -width] [lindex [.c itemconfigure test -width] 4] +} -result {6.0 6.0} +test canvRect-1.10 {configuration options: bad value for -width} -body { + .c itemconfigure test -width abc +} -returnCodes error -result {bad screen distance "abc"} +.c delete withtag all + -test canvRect-2.1 {CreateRectOval procedure} { - list [catch {.c create rect} msg] $msg -} {1 {wrong # args: should be ".c create rect coords ?arg arg ...?"}} -test canvRect-2.2 {CreateRectOval procedure} { - list [catch {.c create oval x y z} msg] $msg -} {1 {wrong # coordinates: expected 0 or 4, got 3}} -test canvRect-2.3 {CreateRectOval procedure} { - list [catch {.c create rectangle x 2 3 4} msg] $msg -} {1 {bad screen distance "x"}} -test canvRect-2.4 {CreateRectOval procedure} { - list [catch {.c create rectangle 1 y 3 4} msg] $msg -} {1 {bad screen distance "y"}} -test canvRect-2.5 {CreateRectOval procedure} { - list [catch {.c create rectangle 1 2 z 4} msg] $msg -} {1 {bad screen distance "z"}} -test canvRect-2.6 {CreateRectOval procedure} { - list [catch {.c create rectangle 1 2 3 q} msg] $msg -} {1 {bad screen distance "q"}} -test canvRect-2.7 {CreateRectOval procedure} { +test canvRect-2.1 {CreateRectOval procedure} -body { + .c create rect +} -returnCodes error -result {wrong # args: should be ".c create rect coords ?arg ...?"} +test canvRect-2.2 {CreateRectOval procedure} -body { + .c create oval x y z +} -returnCodes error -result {wrong # coordinates: expected 0 or 4, got 3} +test canvRect-2.3 {CreateRectOval procedure} -body { + .c create rectangle x 2 3 4 +} -returnCodes error -result {bad screen distance "x"} +test canvRect-2.4 {CreateRectOval procedure} -body { + .c create rectangle 1 y 3 4 +} -returnCodes error -result {bad screen distance "y"} +test canvRect-2.5 {CreateRectOval procedure} -body { + .c create rectangle 1 2 z 4 +} -returnCodes error -result {bad screen distance "z"} +test canvRect-2.6 {CreateRectOval procedure} -body { + .c create rectangle 1 2 3 q +} -returnCodes error -result {bad screen distance "q"} +test canvRect-2.7 {CreateRectOval procedure} -body { .c create rectangle 1 2 3 4 -tags x set result {} foreach element [.c coords x] { - lappend result [format %.1f $element] + lappend result [format %.1f $element] } set result -} {1.0 2.0 3.0 4.0} -test canvRect-2.8 {CreateRectOval procedure} { - list [catch {.c create rectangle 1 2 3 4 -gorp foo} msg] $msg -} {1 {unknown option "-gorp"}} - +} -result {1.0 2.0 3.0 4.0} +test canvRect-2.8 {CreateRectOval procedure} -body { + .c create rectangle 1 2 3 4 -gorp foo +} -returnCodes error -result {unknown option "-gorp"} .c delete withtag all -.c create rectangle 10 20 30 40 -tags x -test canvRect-3.1 {RectOvalCoords procedure} { + + +test canvRect-3.1 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x set result {} foreach element [.c coords x] { - lappend result [format %.1f $element] + lappend result [format %.1f $element] } - set result -} {10.0 20.0 30.0 40.0} -test canvRect-3.2 {RectOvalCoords procedure} { - list [catch {.c coords x a 2 3 4} msg] $msg -} {1 {bad screen distance "a"}} -test canvRect-3.3 {RectOvalCoords procedure} { - list [catch {.c coords x 1 b 3 4} msg] $msg -} {1 {bad screen distance "b"}} -test canvRect-3.4 {RectOvalCoords procedure} { - list [catch {.c coords x 1 2 c 4} msg] $msg -} {1 {bad screen distance "c"}} -test canvRect-3.5 {RectOvalCoords procedure} { - list [catch {.c coords x 1 2 3 d} msg] $msg -} {1 {bad screen distance "d"}} -test canvRect-3.6 {RectOvalCoords procedure} {nonPortable} { + return $result +} -cleanup { + .c delete withtag all +} -result {10.0 20.0 30.0 40.0} +test canvRect-3.2 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x a 2 3 4 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "a"} +test canvRect-3.3 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x 1 b 3 4 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "b"} +test canvRect-3.4 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x 1 2 c 4 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "c"} +test canvRect-3.5 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x 1 2 3 d +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "d"} +test canvRect-3.6 {RectOvalCoords procedure} -constraints { + nonPortable +} -body { + .c create rectangle 10 20 30 40 -tags x # Non-portable due to rounding differences. .c coords x 10 25 15 40 .c bbox x -} {9 24 16 41} -test canvRect-3.7 {RectOvalCoords procedure} { - list [catch {.c coords x 1 2 3 4 5} msg] $msg -} {1 {wrong # coordinates: expected 0 or 4, got 5}} +} -cleanup { + .c delete withtag all +} -result {9 24 16 41} +test canvRect-3.7 {RectOvalCoords procedure} -body { + .c create rectangle 10 20 30 40 -tags x + .c coords x 1 2 3 4 5 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {wrong # coordinates: expected 0 or 4, got 5} -.c delete withtag all -.c create rectangle 10 20 30 40 -tags x -width 1 -test canvRect-4.1 {ConfigureRectOval procedure} { - list [catch {.c itemconfigure x -width abc} msg] $msg \ - [.c itemcget x -width] -} {1 {bad screen distance "abc"} 1.0} -test canvRect-4.2 {ConfigureRectOval procedure} { - list [catch {.c itemconfigure x -width -5} msg] $msg -} {1 {bad screen distance "-5"}} -test canvRect-4.3 {ConfigureRectOval procedure} {nonPortable} { - # Non-portable due to rounding differences. + +test canvRect-4.1 {ConfigureRectOval procedure} -body { + .c create rectangle 10 20 30 40 -tags x -width 1 + .c itemconfigure x -width abc +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "abc"} +test canvRect-4.2 {ConfigureRectOval procedure} -body { + .c create rectangle 10 20 30 40 -tags x -width 1 + catch {.c itemconfigure x -width abc} + .c itemcget x -width +} -cleanup { + .c delete withtag all +} -result {1.0} +test canvRect-4.3 {ConfigureRectOval procedure} -body { + .c create rectangle 10 20 30 40 -tags x -width 1 + .c itemconfigure x -width -5 +} -cleanup { + .c delete withtag all +} -returnCodes error -result {bad screen distance "-5"} +test canvRect-4.4 {ConfigureRectOval procedure} -constraints nonPortable -body { + # Non-portable due to rounding differences + .c create rectangle 10 20 30 40 -tags x -width 1 .c itemconfigure x -width 10 .c bbox x -} {5 15 35 45} +} -cleanup { + .c delete withtag all +} -result {5 15 35 45} + # I can't come up with any good tests for DeleteRectOval. -.c delete withtag all -.c create rectangle 10 20 30 40 -tags x -width 1 -outline {} -test canvRect-5.1 {ComputeRectOvalBbox procedure} {nonPortable} { +test canvRect-5.1 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: + .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} .c coords x 20 15 10 5 .c bbox x -} {10 5 20 15} -test canvRect-5.2 {ComputeRectOvalBbox procedure} {nonPortable} { +} -cleanup { + .c delete withtag all +} -result {10 5 20 15} +test canvRect-5.2 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: + .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} .c coords x 10 20 30 10 .c itemconfigure x -width 1 -outline red .c bbox x -} {9 9 31 21} -test canvRect-5.3 {ComputeRectOvalBbox procedure} {nonPortable} { +} -cleanup { + .c delete withtag all +} -result {9 9 31 21} +test canvRect-5.3 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: + .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} .c coords x 10 20 30 10 .c itemconfigure x -width 2 -outline red .c bbox x -} {9 9 31 21} -test canvRect-5.4 {ComputeRectOvalBbox procedure} {nonPortable} { +} -cleanup { + .c delete withtag all +} -result {9 9 31 21} +test canvRect-5.4 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: + .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} .c coords x 10 20 30 10 .c itemconfigure x -width 3 -outline red .c bbox x -} {8 8 32 22} +} -cleanup { + .c delete withtag all +} -result {8 8 32 22} # I can't come up with any good tests for DisplayRectOval. -.c delete withtag all -set x [.c create rectangle 10 20 30 35 -tags x -fill green] -set y [.c create rectangle 15 25 25 30 -tags y -fill red] -test canvRect-6.1 {RectToPoint procedure} { +test canvRect-6.1 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] .c itemconfigure y -outline {} - list [.c find closest 14.9 28] [.c find closest 15.1 28] \ - [.c find closest 24.9 28] [.c find closest 25.1 28] -} "$x $y $y $x" -test canvRect-6.2 {RectToPoint procedure} { + list [expr {[.c find closest 14.9 28] eq $xId}] \ + [expr {[.c find closest 15.1 28] eq $yId}] \ + [expr {[.c find closest 24.9 28] eq $yId}] \ + [expr {[.c find closest 25.1 28] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} +test canvRect-6.2 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] .c itemconfigure y -outline {} - list [.c find closest 20 24.9] [.c find closest 20 25.1] \ - [.c find closest 20 29.9] [.c find closest 20 30.1] -} "$x $y $y $x" -test canvRect-6.3 {RectToPoint procedure} { + list [expr {[.c find closest 20 24.9] eq $xId}] \ + [expr {[.c find closest 20 25.1] eq $yId}] \ + [expr {[.c find closest 20 29.9] eq $yId}] \ + [expr {[.c find closest 20 30.1] eq $xId}] + +} -cleanup { + .c delete all +} -result {1 1 1 1} +test canvRect-6.3 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] .c itemconfigure y -width 1 -outline black - list [.c find closest 14.4 28] [.c find closest 14.6 28] \ - [.c find closest 25.4 28] [.c find closest 25.6 28] -} "$x $y $y $x" -test canvRect-6.4 {RectToPoint procedure} { + list [expr {[.c find closest 14.4 28] eq $xId}] \ + [expr {[.c find closest 14.6 28] eq $yId}] \ + [expr {[.c find closest 25.4 28] eq $yId}] \ + [expr {[.c find closest 25.6 28] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} +test canvRect-6.4 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] .c itemconfigure y -width 1 -outline black - list [.c find closest 20 24.4] [.c find closest 20 24.6] \ - [.c find closest 20 30.4] [.c find closest 20 30.6] -} "$x $y $y $x" -.c itemconfigure x -fill {} -outline black -width 3 -.c itemconfigure y -outline {} -test canvRect-6.5 {RectToPoint procedure} { - list [.c find closest 13.2 28] [.c find closest 13.3 28] \ - [.c find closest 26.7 28] [.c find closest 26.8 28] -} "$x $y $y $x" -test canvRect-6.6 {RectToPoint procedure} { - list [.c find closest 20 23.2] [.c find closest 20 23.3] \ - [.c find closest 20 31.7] [.c find closest 20 31.8] -} "$x $y $y $x" -.c delete withtag all -set x [.c create rectangle 10 20 30 40 -outline {} -fill black] -set y [.c create rectangle 40 40 50 50 -outline {} -fill black] -test canvRect-6.7 {RectToPoint procedure} { - list [.c find closest 35 35] [.c find closest 36 36] \ - [.c find closest 37 37] [.c find closest 38 38] -} "$x $y $y $y" + list [expr {[.c find closest 20 24.4] eq $xId}] \ + [expr {[.c find closest 20 24.6] eq $yId}] \ + [expr {[.c find closest 20 30.4] eq $yId}] \ + [expr {[.c find closest 20 30.6] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} -.c delete withtag all -set x [.c create rectangle 10 20 30 35 -fill green -outline {}] -set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] -set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] -test canvRect-7.1 {RectToArea procedure} { - list [.c find overlapping 20 50 38 60] \ - [.c find overlapping 20 50 39 60] \ - [.c find overlapping 20 50 70 60] \ - [.c find overlapping 61 50 70 60] \ - [.c find overlapping 62 50 70 60] -} "{} $y $y $y {}" -test canvRect-7.2 {RectToArea procedure} { - list [.c find overlapping 45 20 55 43] \ - [.c find overlapping 45 20 55 44] \ - [.c find overlapping 45 20 55 80] \ - [.c find overlapping 45 71 55 80] \ - [.c find overlapping 45 72 55 80] -} "{} $y $y $y {}" -test canvRect-7.3 {RectToArea procedure} { - list [.c find overlapping 5 25 9.9 30] [.c find overlapping 5 25 10.1 30] -} "{} $x" -test canvRect-7.4 {RectToArea procedure} { - list [.c find overlapping 102 152 118 168] \ - [.c find overlapping 101 152 118 168] \ - [.c find overlapping 102 151 118 168] \ - [.c find overlapping 102 152 119 168] \ - [.c find overlapping 102 152 118 169] -} "{} $z $z $z $z" -test canvRect-7.5 {RectToArea procedure} { - list [.c find enclosed 20 40 38 80] \ - [.c find enclosed 20 40 39 80] \ - [.c find enclosed 20 40 70 80] \ - [.c find enclosed 61 40 70 80] \ - [.c find enclosed 62 40 70 80] -} "{} {} $y {} {}" -test canvRect-7.6 {RectToArea procedure} { - list [.c find enclosed 20 20 65 43] \ - [.c find enclosed 20 20 65 44] \ - [.c find enclosed 20 20 65 80] \ - [.c find enclosed 20 71 65 80] \ - [.c find enclosed 20 72 65 80] -} "{} {} $y {} {}" +test canvRect-6.5 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] + .c itemconfigure x -fill {} -outline black -width 3 + .c itemconfigure y -outline {} + list [expr {[.c find closest 13.2 28] eq $xId}] \ + [expr {[.c find closest 13.3 28] eq $yId}] \ + [expr {[.c find closest 26.7 28] eq $yId}] \ + [expr {[.c find closest 26.8 28] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} +test canvRect-6.6 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 35 -tags x -fill green] + set yId [.c create rectangle 15 25 25 30 -tags y -fill red] + .c itemconfigure x -fill {} -outline black -width 3 + .c itemconfigure y -outline {} + list [expr {[.c find closest 20 23.2] eq $xId}] \ + [expr {[.c find closest 20 23.3] eq $yId}] \ + [expr {[.c find closest 20 31.7] eq $yId}] \ + [expr {[.c find closest 20 31.8] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} + +test canvRect-6.7 {RectToPoint procedure} -body { + set xId [.c create rectangle 10 20 30 40 -outline {} -fill black] + set yId [.c create rectangle 40 40 50 50 -outline {} -fill black] + list [expr {[.c find closest 35 35] eq $xId}] \ + [expr {[.c find closest 36 36] eq $yId}] \ + [expr {[.c find closest 37 37] eq $yId}] \ + [expr {[.c find closest 38 38] eq $yId}] +} -cleanup { + .c delete all +} -result {1 1 1 1} -.c delete withtag all -set x [.c create oval 50 100 200 150 -fill green -outline {}] -set y [.c create oval 50 100 200 150 -fill red -outline black -width 3] -set z [.c create oval 50 100 200 150 -fill {} -outline black -width 3] -test canvRect-8.1 {OvalToArea procedure} { - list [.c find overlapping 20 120 48 130] \ - [.c find overlapping 20 120 49 130] \ - [.c find overlapping 20 120 50.2 130] \ - [.c find overlapping 20 120 300 130] \ - [.c find overlapping 60 120 190 130] \ - [.c find overlapping 199.9 120 300 130] \ - [.c find overlapping 201 120 300 130] \ - [.c find overlapping 202 120 300 130] -} "{} {$y $z} {$x $y $z} {$x $y $z} {$x $y} {$x $y $z} {$y $z} {}" -test canvRect-8.2 {OvalToArea procedure} { - list [.c find overlapping 100 50 150 98] \ - [.c find overlapping 100 50 150 99] \ - [.c find overlapping 100 50 150 100.1] \ - [.c find overlapping 100 50 150 200] \ - [.c find overlapping 100 110 150 140] \ - [.c find overlapping 100 149.9 150 200] \ - [.c find overlapping 100 151 150 200] \ - [.c find overlapping 100 152 150 200] -} "{} {$y $z} {$x $y $z} {$x $y $z} {$x $y} {$x $y $z} {$y $z} {}" -test canvRect-8.3 {OvalToArea procedure} { - list [.c find overlapping 176 104 177 105] \ - [.c find overlapping 187 116 188 117] \ - [.c find overlapping 192 142 193 143] \ - [.c find overlapping 180 138 181 139] \ - [.c find overlapping 61 142 62 143] \ - [.c find overlapping 65 137 66 136] \ - [.c find overlapping 62 108 63 109] \ - [.c find overlapping 68 115 69 116] -} "{} {$x $y} {} {$x $y} {} {$x $y} {} {$x $y}" -test canvRect-9.1 {ScaleRectOval procedure} { +test canvRect-7.1 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 20 50 38 60] eq {}}] \ + [expr {[.c find overlapping 20 50 39 60] eq $yId}] \ + [expr {[.c find overlapping 20 50 70 60] eq $yId}] \ + [expr {[.c find overlapping 61 50 70 60] eq $yId}] \ + [expr {[.c find overlapping 62 50 70 60] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} +test canvRect-7.2 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 45 20 55 43] eq {}}] \ + [expr {[.c find overlapping 45 20 55 44] eq $yId}] \ + [expr {[.c find overlapping 45 20 55 80] eq $yId}] \ + [expr {[.c find overlapping 45 71 55 80] eq $yId}] \ + [expr {[.c find overlapping 45 72 55 80] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} +test canvRect-7.3 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 5 25 9.9 30] eq {}}] \ + [expr {[.c find overlapping 5 25 10.1 30] eq $xId}] +} -cleanup { + .c delete all +} -result {1 1} +test canvRect-7.4 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 102 152 118 168] eq {}}]\ + [expr {[.c find overlapping 101 152 118 168] eq $zId}] \ + [expr {[.c find overlapping 102 151 118 168] eq $zId}] \ + [expr {[.c find overlapping 102 152 119 168] eq $zId}] \ + [expr {[.c find overlapping 102 152 118 169] eq $zId}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} +test canvRect-7.5 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find enclosed 20 40 38 80] eq {}}] \ + [expr {[.c find enclosed 20 40 39 80] eq {}}] \ + [expr {[.c find enclosed 20 40 70 80] eq $yId}] \ + [expr {[.c find enclosed 61 40 70 80] eq {}}] \ + [expr {[.c find enclosed 62 40 70 80] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} +test canvRect-7.6 {RectToArea procedure} -body { + set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + list [expr {[.c find enclosed 20 20 65 43] eq {}}] \ + [expr {[.c find enclosed 20 20 65 44] eq {}}] \ + [expr {[.c find enclosed 20 20 65 80] eq $yId}] \ + [expr {[.c find enclosed 20 71 65 80] eq {}}] \ + [expr {[.c find enclosed 20 72 65 80] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1} + + +test canvRect-8.1 {OvalToArea procedure} -body { + set xId [.c create oval 50 100 200 150 -fill green -outline {}] + set yId [.c create oval 50 100 200 150 -fill red -outline black -width 3] + set zId [.c create oval 50 100 200 150 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 20 120 48 130] eq {}}] \ + [expr {[.c find overlapping 20 120 49 130] eq "$yId $zId"}] \ + [expr {[.c find overlapping 20 120 50.2 130] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 20 120 300 130] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 60 120 190 130] eq "$xId $yId"}] \ + [expr {[.c find overlapping 199.9 120 300 130] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 201 120 300 130] eq "$yId $zId"}] \ + [expr {[.c find overlapping 202 120 300 130] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1 1 1 1} +test canvRect-8.2 {OvalToArea procedure} -body { + set xId [.c create oval 50 100 200 150 -fill green -outline {}] + set yId [.c create oval 50 100 200 150 -fill red -outline black -width 3] + set zId [.c create oval 50 100 200 150 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 100 50 150 98] eq {}}] \ + [expr {[.c find overlapping 100 50 150 99] eq "$yId $zId"}] \ + [expr {[.c find overlapping 100 50 150 100.1] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 100 50 150 200] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 100 110 150 140] eq "$xId $yId"}] \ + [expr {[.c find overlapping 100 149.9 150 200] eq "$xId $yId $zId"}] \ + [expr {[.c find overlapping 100 151 150 200] eq "$yId $zId"}] \ + [expr {[.c find overlapping 100 152 150 200] eq {}}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1 1 1 1} +test canvRect-8.3 {OvalToArea procedure} -body { + set xId [.c create oval 50 100 200 150 -fill green -outline {}] + set yId [.c create oval 50 100 200 150 -fill red -outline black -width 3] + set zId [.c create oval 50 100 200 150 -fill {} -outline black -width 3] + list [expr {[.c find overlapping 176 104 177 105] eq {}}] \ + [expr {[.c find overlapping 187 116 188 117] eq "$xId $yId"}] \ + [expr {[.c find overlapping 192 142 193 143] eq {}}] \ + [expr {[.c find overlapping 180 138 181 139] eq "$xId $yId"}] \ + [expr {[.c find overlapping 61 142 62 143] eq {}}] \ + [expr {[.c find overlapping 65 137 66 136] eq "$xId $yId"}] \ + [expr {[.c find overlapping 62 108 63 109] eq {}}] \ + [expr {[.c find overlapping 68 115 69 116] eq "$xId $yId"}] +} -cleanup { + .c delete all +} -result {1 1 1 1 1 1 1 1} + + +test canvRect-9.1 {ScaleRectOval procedure} -setup { .c delete withtag all +} -body { .c create rect 100 300 200 350 -tags x .c scale x 50 100 2 4 - .c coords x -} {150.0 900.0 350.0 1100.0} + format {%.6g %.6g %.6g %.6g} {*}[.c coords x] +} -result {150 900 350 1100} -test canvRect-10.1 {TranslateRectOval procedure} { +test canvRect-10.1 {TranslateRectOval procedure} -setup { .c delete withtag all +} -body { .c create rect 100 300 200 350 -tags x .c move x 100 -10 - .c coords x -} {200.0 290.0 300.0 340.0} + format {%.6g %.6g %.6g %.6g} {*}[.c coords x] +} -result {200 290 300 340} + -# This test is non-portable because different color information -# will get generated on different displays (e.g. mono displays -# vs. color). -test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable macCrash} { +test canvRect-11.1 {RectOvalToPostscript procedure} -constraints { + nonPortable macCrash +} -setup { + .c delete withtag all +} -body { # Crashes on Mac because the XGetImage() call isn't implemented, causing a # dereference of NULL. - + # This test is non-portable because different color information + # will get generated on different displays (e.g. mono displays + # vs. color). .c configure -bd 0 -highlightthickness 0 - .c delete withtag all .c create rect 50 60 90 80 -fill black -stipple gray50 -outline {} .c create oval 100 150 200 200 -fill {} -outline #ff0000 -width 5 update set x [.c postscript] string range $x [string first "-200 -150 translate" $x] end -} {-200 -150 translate +} -result {-200 -150 translate 0 300 moveto 400 300 lineto 400 0 lineto 0 0 lineto closepath clip newpath gsave 50 240 moveto 40 0 rlineto 0 -20 rlineto -40 0 rlineto closepath @@ -326,3 +469,7 @@ end # cleanup cleanupTests return + + + + diff --git a/tests/canvText.test b/tests/canvText.test index 7eef938..ff5e4b9 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -6,134 +6,220 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +# Canvas used in 1.* - 17.* tests canvas .c -width 400 -height 300 -bd 2 -relief sunken pack .c update -set i 1 +# Item used in 1.* tests .c create text 20 20 -tag test - -set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" -set ay [font metrics $font -linespace] -set ax [font measure $font 0] - - -foreach test { - {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}} - {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}} - {-fill {} {} {} {}} - {-font {Times 40} {Times 40} {} {font "" doesn't exist}} - {-justify left left xyz {bad justification "xyz": must be left, right, or center}} - {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}} - {-tags {test a b c} {test a b c} {} {}} - {-text xyz xyz {} {}} - {-underline 0 0 xyz {expected integer but got "xyz"}} - {-width 6 6 xyz {bad screen distance "xyz"}} -} { - lassign $test name goodValue goodResult badValue badResult - test canvText-1.$i "configuration options: good value for $name" { - .c itemconfigure test $name $goodValue - list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name] - } [list $goodResult $goodResult] - incr i - if {$badValue ne ""} { - test canvText-1.$i "configuration options: bad value for $name" -body { - .c itemconfigure test $name $badValue - } -returnCodes error -result $badResult - } - incr i -} -test canvText-1.$i {configuration options} { - .c itemconfigure test -tags {test xyz} - .c itemcget xyz -tags -} {test xyz} - +test canvText-1.1 {configuration options: good value for "anchor"} -body { + .c itemconfigure test -anchor nw + list [lindex [.c itemconfigure test -anchor] 4] [.c itemcget test -anchor] +} -result {nw nw} +test canvasText-1.2 {configuration options: bad value for "anchor"} -body { + .c itemconfigure test -anchor xyz +} -returnCodes error -result {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center} +test canvText-1.3 {configuration options: good value for "fill"} -body { + .c itemconfigure test -fill #ff0000 + list [lindex [.c itemconfigure test -fill] 4] [.c itemcget test -fill] +} -result {{#ff0000} #ff0000} +test canvasText-1.4 {configuration options: bad value for "fill"} -body { + .c itemconfigure test -fill xyz +} -returnCodes error -result {unknown color name "xyz"} +test canvText-1.5 {configuration options: good value for "fill"} -body { + .c itemconfigure test -fill {} + list [lindex [.c itemconfigure test -fill] 4] [.c itemcget test -fill] +} -result {{} {}} +test canvText-1.6 {configuration options: good value for "font"} -body { + .c itemconfigure test -font {Times 40} + list [lindex [.c itemconfigure test -font] 4] [.c itemcget test -font] +} -result {{Times 40} {Times 40}} +test canvasText-1.7 {configuration options: bad value for "font"} -body { + .c itemconfigure test -font {} +} -returnCodes error -result {font "" doesn't exist} +test canvText-1.8 {configuration options: good value for "justify"} -body { + .c itemconfigure test -justify left + list [lindex [.c itemconfigure test -justify] 4] [.c itemcget test -justify] +} -result {left left} +test canvasText-1.9 {configuration options: bad value for "justify"} -body { + .c itemconfigure test -justify xyz +} -returnCodes error -result {bad justification "xyz": must be left, right, or center} +test canvText-1.10 {configuration options: good value for "stipple"} -body { + .c itemconfigure test -stipple gray50 + list [lindex [.c itemconfigure test -stipple] 4] [.c itemcget test -stipple] +} -result {gray50 gray50} +test canvasText-1.11 {configuration options: bad value for "stipple"} -body { + .c itemconfigure test -stipple xyz +} -returnCodes error -result {bitmap "xyz" not defined} +test canvText-1.12 {configuration options: good value for "underline"} -body { + .c itemconfigure test -underline 0 + list [lindex [.c itemconfigure test -underline] 4] [.c itemcget test -underline] +} -result {0 0} +test canvasText-1.13 {configuration options: bad value for "underline"} -body { + .c itemconfigure test -underline xyz +} -returnCodes error -result {expected integer but got "xyz"} +test canvText-1.14 {configuration options: good value for "width"} -body { + .c itemconfigure test -width 6 + list [lindex [.c itemconfigure test -width] 4] [.c itemcget test -width] +} -result {6 6} +test canvasText-1.15 {configuration options: bad value for "width"} -body { + .c itemconfigure test -width xyz +} -returnCodes error -result {bad screen distance "xyz"} +test canvText-1.16 {configuration options: good value for "tags"} -body { + .c itemconfigure test -tags {test a b c} + list [lindex [.c itemconfigure test -tags] 4] [.c itemcget test -tags] +} -result {{test a b c} {test a b c}} +test canvasText-1.17 {configuration options: bad value for "angle"} -body { + .c itemconfigure test -angle xyz +} -returnCodes error -result {expected floating-point number but got "xyz"} +test canvasText-1.18 {configuration options: good value for "angle"} -body { + .c itemconfigure test -angle 32.5 + list [lindex [.c itemconfigure test -angle] 4] [.c itemcget test -angle] +} -result {32.5 32.5} +test canvasText-1.19 {configuration options: bounding of "angle"} -body { + .c itemconfigure test -angle 390 + set result [.c itemcget test -angle] + .c itemconfigure test -angle -30 + lappend result [.c itemcget test -angle] + .c itemconfigure test -angle -360 + lappend result [.c itemcget test -angle] +} -result {30.0 330.0 0.0} .c delete test -.c create text 20 20 -tag test -test canvText-2.1 {CreateText procedure: args} { - list [catch {.c create text} msg] $msg -} {1 {wrong # args: should be ".c create text coords ?arg arg ...?"}} -test canvText-2.2 {CreateText procedure: args} { - list [catch {.c create text xyz 0} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvText-2.3 {CreateText procedure: args} { - list [catch {.c create text 0 xyz} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvText-2.4 {CreateText procedure: args} { - list [catch {.c create text 0 0 -xyz xyz} msg] $msg -} {1 {unknown option "-xyz"}} -test canvText-2.5 {CreateText procedure} { + +test canvText-2.1 {CreateText procedure: args} -body { + .c create text +} -returnCodes {error} -result {wrong # args: should be ".c create text coords ?arg ...?"} +test canvText-2.2 {CreateText procedure: args} -body { + .c create text xyz 0 +} -cleanup { + .c delete all +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvText-2.3 {CreateText procedure: args} -body { + .c create text 0 xyz +} -cleanup { + .c delete all +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvText-2.4 {CreateText procedure: args} -body { + .c create text 0 0 -xyz xyz +} -cleanup { + .c delete all +} -returnCodes {error} -result {unknown option "-xyz"} +test canvText-2.5 {CreateText procedure} -body { .c create text 0 0 -tags x - set x [.c coords x] + .c coords x +} -cleanup { .c delete x - set x -} {0.0 0.0} +} -result {0.0 0.0} -focus -force .c -.c focus test -.c coords test 0 0 -update -test canvText-3.1 {TextCoords procedure} { +test canvText-3.1 {TextCoords procedure} -body { + .c create text 20 20 -tag test + .c coords test 0 0 + update .c coords test -} {0.0 0.0} -test canvText-3.2 {TextCoords procedure} { - list [catch {.c coords test xyz 0} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvText-3.3 {TextCoords procedure} { - list [catch {.c coords test 0 xyz} msg] $msg -} {1 {bad screen distance "xyz"}} -test canvText-3.4 {TextCoords procedure} { +} -cleanup { + .c delete test +} -result {0.0 0.0} +test canvText-3.2 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c coords test xyz 0 +} -cleanup { + .c delete test +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvText-3.3 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c coords test 0 xyz +} -cleanup { + .c delete test +} -returnCodes {error} -result {bad screen distance "xyz"} +test canvText-3.4 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { .c coords test 10 10 set result {} foreach element [.c coords test] { lappend result [format %.1f $element] } - set result -} {10.0 10.0} -test canvText-3.5 {TextCoords procedure} { - list [catch {.c coords test 10} msg] $msg -} {1 {wrong # coordinates: expected 2, got 1}} -test canvText-3.6 {TextCoords procedure} { - list [catch {.c coords test 10 10 10} msg] $msg -} {1 {wrong # coordinates: expected 0 or 2, got 3}} - -test canvText-4.1 {ConfigureText procedure} { - list [catch {.c itemconfig test -fill xyz} msg] $msg -} {1 {unknown color name "xyz"}} -test canvText-4.2 {ConfigureText procedure} { + return $result +} -cleanup { + .c delete test +} -result {10.0 10.0} +test canvText-3.5 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c coords test 10 +} -cleanup { + .c delete test +} -returnCodes {error} -result {wrong # coordinates: expected 2, got 1} +test canvText-3.6 {TextCoords procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c coords test 10 10 10 +} -cleanup { + .c delete test +} -returnCodes {error} -result {wrong # coordinates: expected 0 or 2, got 3} + + +test canvText-4.1 {ConfigureText procedure} -setup { + .c create text 20 20 -tag test +} -body { + .c itemconfig test -fill xyz +} -cleanup { + .c delete test +} -returnCodes {error} -result {unknown color name "xyz"} +test canvText-4.2 {ConfigureText procedure} -setup { + .c create text 20 20 -tag test +} -body { .c itemconfig test -fill blue .c itemcget test -fill -} {blue} -test canvText-4.3 {ConfigureText procedure: construct font gcs} { +} -cleanup { + .c delete test +} -result {blue} +test canvText-4.3 {ConfigureText procedure: construct font gcs} -setup { + .c create text 20 20 -tag test +} -body { .c itemconfig test -font "times 20" -fill black -stipple gray50 list [.c itemcget test -font] [.c itemcget test -fill] [.c itemcget test -stipple] -} {{times 20} black gray50} -test canvText-4.4 {ConfigureText procedure: construct cursor gc} { +} -cleanup { + .c delete test +} -result {{times 20} black gray50} +test canvText-4.4 {ConfigureText procedure: construct cursor gc} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c icursor test 3 - # Both black -> cursor becomes white. .c config -insertbackground black .c config -selectbackground black .c itemconfig test -just left update - # Both same color (and not black) -> cursor becomes black. .c config -insertbackground red .c config -selectbackground red .c itemconfig test -just left update -} {} -test canvText-4.5 {ConfigureText procedure: adjust selection} { +} -cleanup { + .c delete test +} -result {} +test canvText-4.5 {ConfigureText procedure: adjust selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test set x {} +} -body { .c itemconfig test -text "abcdefghi" .c select from test 2 .c select to test 6 @@ -152,89 +238,250 @@ test canvText-4.5 {ConfigureText procedure: adjust selection} { lappend x [selection get] .c dchars test 4 end lappend x [selection get] -} {cdefg 1 cdefg cd cdef cd} -test canvText-4.6 {ConfigureText procedure: adjust cursor} { +} -cleanup { + .c delete test +} -result {cdefg 1 cdefg cd cdef cd} +test canvText-4.6 {ConfigureText procedure: adjust cursor} -setup { + .c create text 20 20 -tag test +} -body { .c itemconfig test -text "abcdefghi" - set x {} .c icursor test 6 .c dchars test 4 end .c index test insert -} {4} +} -cleanup { + .c delete test +} -result {4} + -test canvText-5.1 {ConfigureText procedure: adjust cursor} { - .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 -text "xyz" +test canvText-5.1 {ConfigureText procedure: adjust cursor} -body { + .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 \ + -text "xyz" .c delete x -} {} +} -result {} -test canvText-6.1 {ComputeTextBbox procedure} {fonts nonPortable} { + +test canvText-6.1 {ComputeTextBbox procedure} -constraints fonts -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + .c create text 0 0 -tag test .c itemconfig test -font $font -text 0 - .c coords test 0 0 - set x {} - lappend x [.c itemconfig test -anchor n; .c bbox test] - lappend x [.c itemconfig test -anchor nw; .c bbox test] - lappend x [.c itemconfig test -anchor w; .c bbox test] - lappend x [.c itemconfig test -anchor sw; .c bbox test] - lappend x [.c itemconfig test -anchor s; .c bbox test] - lappend x [.c itemconfig test -anchor se; .c bbox test] - lappend x [.c itemconfig test -anchor e; .c bbox test] - lappend x [.c itemconfig test -anchor ne; .c bbox test] - lappend x [.c itemconfig test -anchor center; .c bbox test] -} "{[expr -$ax/2-1] 0 [expr $ax/2+1] $ay}\ -{-1 0 [expr $ax+1] $ay}\ -{-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]}\ -{-1 -$ay [expr $ax+1] 0}\ -{[expr -$ax/2-1] -$ay [expr $ax/2+1] 0}\ -{[expr -$ax-1] -$ay 1 0}\ -{[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]}\ -{[expr -$ax-1] 0 1 $ay}\ -{[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]}" + expr {[.c itemconfig test -anchor n; .c bbox test] \ + eq "[expr -$ax/2-1] 0 [expr $ax/2+1] $ay"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.2 {ComputeTextBbox procedure} -constraints fonts -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor nw; .c bbox test] \ + eq "-1 0 [expr $ax+1] $ay"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.3 {ComputeTextBbox procedure} -constraints fonts -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor w; .c bbox test] \ + eq "-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.4 {ComputeTextBbox procedure} -constraints fonts -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor sw; .c bbox test] \ + eq "-1 -$ay [expr $ax+1] 0"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.5 {ComputeTextBbox procedure} -constraints fonts -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor s; .c bbox test] \ + eq "[expr -$ax/2-1] -$ay [expr $ax/2+1] 0"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.6 {ComputeTextBbox procedure} -constraints fonts -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor se; .c bbox test] \ + eq "[expr -$ax-1] -$ay 1 0"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.7 {ComputeTextBbox procedure} -constraints fonts -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor e; .c bbox test]\ + eq "[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.8 {ComputeTextBbox procedure} -constraints fonts -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor ne; .c bbox test] \ + eq "[expr -$ax-1] 0 1 $ay"} +} -cleanup { + .c delete test +} -result 1 +test canvText-6.9 {ComputeTextBbox procedure} -constraints fonts -setup { + .c delete test +} -body { + set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*" + set ay [font metrics $font -linespace] + set ax [font measure $font 0] + .c create text 0 0 -tag test + .c itemconfig test -font $font -text 0 + expr {[.c itemconfig test -anchor center; .c bbox test] \ + eq "[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]"} +} -cleanup { + .c delete test +} -result 1 + +#.c delete test +#.c create text 20 20 -tag test +#focus -force .c +#.c focus test focus .c .c focus test .c itemconfig test -text "abcd\nefghi\njklmnopq" -test canvText-7.0 {DisplayText procedure: stippling} { +test canvText-7.1 {DisplayText procedure: stippling} -body { + .c create text 20 20 -tag test .c itemconfig test -stipple gray50 update .c itemconfig test -stipple {} update -} {} -test canvText-7.2 {DisplayText procedure: draw selection} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.2 {DisplayText procedure: draw selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c select from test 0 .c select to test end update selection get -} "abcd\nefghi\njklmnopq" -test canvText-7.3 {DisplayText procedure: selection} { +} -cleanup { + .c delete test +} -result "abcd\nefghi\njklmnopq" +test canvText-7.3 {DisplayText procedure: selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c select from test 0 .c select to test end update selection get -} "abcd\nefghi\njklmnopq" -test canvText-7.4 {DisplayText procedure: one line selection} { +} -cleanup { + .c delete test +} -result "abcd\nefghi\njklmnopq" +test canvText-7.4 {DisplayText procedure: one line selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c select from test 2 .c select to test 3 update -} {} -test canvText-7.5 {DisplayText procedure: multi-line selection} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.5 {DisplayText procedure: multi-line selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c select from test 2 .c select to test 12 update -} {} -test canvText-7.6 {DisplayText procedure: draw cursor} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.6 {DisplayText procedure: draw cursor} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcd\nefghi\njklmnopq" .c icursor test 3 update -} {} -test canvText-7.7 {DisplayText procedure: selected text different color} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.7 {DisplayText procedure: selected text different color} -setup { + .c create text 20 20 -tag test + .c itemconfig test -text "abcd\nefghi\njklmnopq" + focus .c + .c focus test +} -body { .c config -selectforeground blue .c itemconfig test -anchor n update -} {} -test canvText-7.8 {DisplayText procedure: not selected} { +} -cleanup { + .c delete test +} -result {} +test canvText-7.8 {DisplayText procedure: not selected} -setup { + .c create text 20 20 -tag test + .c itemconfig test -text "abcd\nefghi\njklmnopq" + focus .c + .c focus test +} -body { .c select clear update -} {} -test canvText-7.9 {DisplayText procedure: select end} { - catch {destroy .t} +} -cleanup { + .c delete test +} -result {} +test canvText-7.9 {DisplayText procedure: select end} -setup { + destroy .t +} -body { toplevel .t wm geometry .t +0+0 canvas .t.c @@ -246,289 +493,399 @@ test canvText-7.9 {DisplayText procedure: select end} { update #catch {destroy .t} update -} {} - -test canvText-8.1 {TextInsert procedure: 0 length insert} { +} -cleanup { + destroy .t +} -result {} + +test canvText-8.1 {TextInsert procedure: 0 length insert} -setup { + .c create text 20 20 -tag test + .c itemconfig test -text "abcd\nefghi\njklmnopq" + focus .c + .c focus test +} -body { .c insert test end {} -} {} -test canvText-8.2 {TextInsert procedure: before beginning/after end} { +} -cleanup { + .c delete test +} -result {} +test canvText-8.2 {TextInsert procedure: before beginning/after end} -body { # Can't test this because GetTextIndex filters out those numbers. -} {} -test canvText-8.3 {TextInsert procedure: inserting in a selected item} { +} -result {} +test canvText-8.3 {TextInsert procedure: inserting in a selected item} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 1 "xyz" .c itemcget test -text -} {axyzbcdefg} -test canvText-8.4 {TextInsert procedure: inserting before selection} { +} -result {axyzbcdefg} +test canvText-8.4 {TextInsert procedure: inserting before selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 1 "xyz" list [.c index test sel.first] [.c index test sel.last] -} {5 7} -test canvText-8.5 {TextInsert procedure: inserting in selection} { +} -result {5 7} +test canvText-8.5 {TextInsert procedure: inserting in selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 3 "xyz" list [.c index test sel.first] [.c index test sel.last] -} {2 7} -test canvText-8.6 {TextInsert procedure: inserting after selection} { +} -result {2 7} +test canvText-8.6 {TextInsert procedure: inserting after selection} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c insert test 5 "xyz" list [.c index test sel.first] [.c index test sel.last] -} {2 4} -test canvText-8.7 {TextInsert procedure: inserting in unselected item} { +} -result {2 4} +test canvText-8.7 {TextInsert procedure: inserting in unselected item} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c select clear .c insert test 5 "xyz" .c itemcget test -text -} {abcdexyzfg} -test canvText-8.8 {TextInsert procedure: inserting before cursor} { +} -result {abcdexyzfg} +test canvText-8.8 {TextInsert procedure: inserting before cursor} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c icursor test 3 .c insert test 2 "xyz" .c index test insert -} {6} -test canvText-8.9 {TextInsert procedure: inserting after cursor} { +} -result {6} +test canvText-8.9 {TextInsert procedure: inserting after cursor} -setup { + .c create text 20 20 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefg" .c icursor test 3 .c insert test 4 "xyz" .c index test insert -} {3} +} -result {3} -test canvText-9.1 {TextInsert procedure: before beginning/after end} { +# Item used in 9.* tests +.c create text 20 20 -tag test +test canvText-9.1 {TextInsert procedure: before beginning/after end} -body { # Can't test this because GetTextIndex filters out those numbers. -} {} -test canvText-9.2 {TextInsert procedure: start > end} { +} -result {} +test canvText-9.2 {TextInsert procedure: start > end} -body { .c itemconfig test -text "abcdefg" .c dchars test 4 2 .c itemcget test -text -} {abcdefg} -test canvText-9.3 {TextInsert procedure: deleting from a selected item} { +} -result {abcdefg} +test canvText-9.3 {TextInsert procedure: deleting from a selected item} -body { .c itemconfig test -text "abcdefg" .c select from test 2 .c select to test 4 .c dchars test 3 5 .c itemcget test -text -} {abcg} -test canvText-9.4 {TextInsert procedure: deleting before start} { +} -result {abcg} +test canvText-9.4 {TextInsert procedure: deleting before start} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 1 1 list [.c index test sel.first] [.c index test sel.last] -} {3 7} -test canvText-9.5 {TextInsert procedure: keep start > first char deleted} { +} -result {3 7} +test canvText-9.5 {TextInsert procedure: keep start > first char deleted} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 2 6 list [.c index test sel.first] [.c index test sel.last] -} {2 3} -test canvText-9.6 {TextInsert procedure: deleting inside selection} { +} -result {2 3} +test canvText-9.6 {TextInsert procedure: deleting inside selection} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 6 6 list [.c index test sel.first] [.c index test sel.last] -} {4 7} -test canvText-9.7 {TextInsert procedure: keep end > first char deleted} { +} -result {4 7} +test canvText-9.7 {TextInsert procedure: keep end > first char deleted} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 6 10 list [.c index test sel.first] [.c index test sel.last] -} {4 5} -test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} { +} -result {4 5} +test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 3 10 - list [catch {.c index test sel.first} msg] $msg -} {1 {selection isn't in item}} -test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} { + .c index test sel.first +} -returnCodes {error} -result {selection isn't in item} +test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} -body { .c itemconfig test -text "abcdefghijk" .c select from test 4 .c select to test 8 .c dchars test 4 7 list [.c index test sel.first] [.c index test sel.last] -} {4 4} -test canvText-9.10 {TextInsert procedure: move anchor} { +} -result {4 4} +test canvText-9.10 {TextInsert procedure: move anchor} -body { .c itemconfig test -text "abcdefghijk" .c select from test 6 .c select to test 8 .c dchars test 2 4 .c select to test 1 list [.c index test sel.first] [.c index test sel.last] -} {1 2} -test canvText-9.11 {TextInsert procedure: keep anchor >= first} { +} -result {1 2} +test canvText-9.11 {TextInsert procedure: keep anchor >= first} -body { .c itemconfig test -text "abcdefghijk" .c select from test 6 .c select to test 8 .c dchars test 5 7 .c select to test 1 list [.c index test sel.first] [.c index test sel.last] -} {1 4} -test canvText-9.12 {TextInsert procedure: anchor doesn't move} { +} -result {1 4} +test canvText-9.12 {TextInsert procedure: anchor doesn't move} -body { .c itemconfig test -text "abcdefghijk" .c select from test 2 .c select to test 5 .c dchars test 6 8 .c select to test 8 list [.c index test sel.first] [.c index test sel.last] -} {2 8} -test canvText-9.13 {TextInsert procedure: move cursor} { +} -result {2 8} +test canvText-9.13 {TextInsert procedure: move cursor} -body { .c itemconfig test -text "abcdefghijk" .c icursor test 6 .c dchars test 2 4 .c index test insert -} {3} -test canvText-9.14 {TextInsert procedure: keep cursor >= first} { +} -result {3} +test canvText-9.14 {TextInsert procedure: keep cursor >= first} -body { .c itemconfig test -text "abcdefghijk" .c icursor test 6 .c dchars test 2 10 .c index test insert -} {2} -test canvText-9.15 {TextInsert procedure: cursor doesn't move} { +} -result {2} +test canvText-9.15 {TextInsert procedure: cursor doesn't move} -body { .c itemconfig test -text "abcdefghijk" .c icursor test 5 .c dchars test 7 9 .c index test insert -} {5} +} -result {5} +.c delete test -test canvText-10.1 {TextToPoint procedure} { - .c coords test 0 0 + +test canvText-10.1 {TextToPoint procedure} -body { + .c create text 0 0 -tag test .c itemconfig test -text 0 -anchor center .c index test @0,0 -} {0} +} -cleanup { + .c delete test +} -result {0} -test canvText-11.1 {TextToArea procedure} { - .c coords test 0 0 + +test canvText-11.1 {TextToArea procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text 0 -anchor center - .c find overlapping 0 0 1 1 -} [.c find withtag test] -test canvText-11.2 {TextToArea procedure} { - .c coords test 0 0 + set res1 [.c find overlapping 0 0 1 1] + set res2 [.c find withtag test] + expr {$res1 eq $res2} +} -cleanup { + .c delete test +} -result 1 +test canvText-11.2 {TextToArea procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text 0 -anchor center .c find overlapping 1000 1000 1001 1001 -} {} +} -cleanup { + .c delete test +} -result {} + -test canvText-12.1 {ScaleText procedure} { - .c coords test 100 100 +test canvText-12.1 {ScaleText procedure} -body { + .c create text 100 100 -tag test .c scale all 50 50 2 2 format {%.6g %.6g} {*}[.c coords test] -} {150 150} +} -cleanup { + .c delete test +} -result {150 150} + -test canvText-13.1 {TranslateText procedure} { - .c coords test 100 100 +test canvText-13.1 {TranslateText procedure} -body { + .c create text 100 100 -tag test .c move all 10 10 format {%.6g %.6g} {*}[.c coords test] -} {110 110} - -.c itemconfig test -text "abcdefghijklmno" -anchor nw -.c select from test 5 -.c select to test 8 -.c icursor test 12 -.c coords test 0 0 -test canvText-14.1 {GetTextIndex procedure} { +} -cleanup { + .c delete test +} -result {110 110} + + +test canvText-14.1 {GetTextIndex procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcdefghijklmno" -anchor nw + .c select from test 5 + .c select to test 8 + .c icursor test 12 + .c coords test 0 0 list [.c index test end] [.c index test insert] \ [.c index test sel.first] [.c index test sel.last] \ [.c index test @0,0] \ [.c index test -1] [.c index test 10] [.c index test 100] -} {15 12 5 8 0 0 10 15} -test canvText-14.2 {GetTextIndex procedure: select error} { +} -cleanup { + .c delete test +} -result {15 12 5 8 0 0 10 15} +test canvText-14.2 {GetTextIndex procedure: select error} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c select clear - list [catch {.c index test sel.first} msg] $msg -} {1 {selection isn't in item}} -test canvText-14.3 {GetTextIndex procedure: select error} { + .c index test sel.first +} -cleanup { + .c delete test +} -returnCodes {error} -result {selection isn't in item} +test canvText-14.3 {GetTextIndex procedure: select error} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c select clear - list [catch {.c index test sel.last} msg] $msg -} {1 {selection isn't in item}} -test canvText-14.4 {GetTextIndex procedure: select error} { + .c index test sel.last +} -cleanup { + .c delete test +} -returnCodes {error} -result {selection isn't in item} +test canvText-14.4 {GetTextIndex procedure: select error} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c select clear - list [catch {.c index test sel.} msg] $msg -} {1 {bad index "sel."}} -test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} { - list [catch {.c index test xyz} msg] $msg -} {1 {bad index "xyz"}} -test canvText-14.6 {select clear errors} -body { + .c index test sel. +} -cleanup { + .c delete test +} -returnCodes {error} -result {bad index "sel."} +test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { + .c index test xyz +} -cleanup { + .c delete test +} -returnCodes {error} -result {bad index "xyz"} +test canvText-14.6 {select clear errors} -setup { + .c create text 0 0 -tag test +} -body { .c select clear test +} -cleanup { + .c delete test } -returnCodes error -result "wrong \# args: should be \".c select clear\"" -test canvText-15.1 {SetTextCursor procedure} { +test canvText-15.1 {SetTextCursor procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { + .c itemconfig test -text "abcdefghijklmno" -anchor nw .c itemconfig -text "abcdefg" .c icursor test 3 .c index test insert -} {3} - -test canvText-16.1 {GetSelText procedure} { +} -cleanup { + .c delete test +} -result {3} + +test canvText-16.1 {GetSelText procedure} -setup { + .c create text 0 0 -tag test + focus .c + .c focus test +} -body { .c itemconfig test -text "abcdefghijklmno" -anchor nw .c select from test 5 .c select to test 8 selection get -} {fghi} - -set font {Courier 12 italic} -set ax [font measure $font 0] -set ay [font metrics $font -linespace] +} -cleanup { + .c delete test +} -result {fghi} -test canvText-17.1 {TextToPostscript procedure} { +test canvText-17.1 {TextToPostscript procedure} -setup { .c delete all - .c config -height 300 -highlightthickness 0 -bd 0 - update - .c create text 100 100 -tags test - .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax] - .c itemconfig test -anchor n -fill black - set x [.c postscript] - set x [string range $x [string first "findfont " $x] end] -} "findfont [font actual $font -size] scalefont ISOEncode setfont + set result {findfont [font actual $font -size] scalefont ISOEncode setfont 0.000 0.000 0.000 setrgbcolor AdjustColor -100 200 \[ +0 100 200 \[ \[(000)\] \[(000)\] \[(00)\] -] $ay -0.5 0.0 0 false DrawText +\] $ay -0.5 0 0 false DrawText grestore restore showpage %%Trailer end %%EOF -" +} +} -body { + set font {Courier 12 italic} + set ax [font measure $font 0] + set ay [font metrics $font -linespace] + .c config -height 300 -highlightthickness 0 -bd 0 + update + .c create text 100 100 -tags test + .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax] + .c itemconfig test -anchor n -fill black + set x [.c postscript] + set x [string range $x [string first "findfont " $x] end] + expr {$x eq [subst $result] ? "ok" : $x} +} -result ok -test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} -body { - catch {destroy .c} - canvas .c - pack .c - .c delete all +test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} -setup { + destroy .c +} -body { + pack [canvas .c] .c create text 100 100 -text Hello\n -anchor nw set bbox [.c bbox 1] set x2 [lindex $bbox 2] set y2 [lindex $bbox 3] incr y2 update - .c find enclosed 99 99 [expr $x2 + $i] [expr $y2 + 1] + .c find enclosed 99 99 [expr $x2 + 1] [expr $y2 + 1] } -cleanup { + destroy .c unset -nocomplain bbox x2 y2 } -result 1 -test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { - catch {destroy .c} +test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} -setup { + destroy .c set c [canvas .c -bg black -width 964] pack $c $c delete all - after 1000 "set done 1" ; vwait done - + after 100 "set done 1"; vwait done +} -body { set f {Arial 28 bold} - set s1 { Yeah-ah-ah-ah-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-Yow} set s2 { Yeah ah ah ah oh oh oh oh oh oh oh oh oh oh oh oh oh oh oh oh Yow} - $c create text 21 18 \ -font $f \ -text $s1 \ @@ -536,8 +893,7 @@ test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { -width 922 \ -anchor nw \ -tags tbox1 - eval {$c create rect} [$c bbox tbox1] -outline red - + $c create rect {*}[$c bbox tbox1] -outline red $c create text 21 160 \ -font $f \ -text $s2 \ @@ -545,32 +901,49 @@ test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { -width 922 \ -anchor nw \ -tags tbox2 - eval {$c create rect} [$c bbox tbox2] -outline red - - after 1000 "set done 1" ; vwait done - + $c create rect {*}[$c bbox tbox2] -outline red + after 500 "set done 1" ; vwait done set results [list] - $c select from tbox2 4 $c select to tbox2 8 lappend results [selection get] - $c select from tbox1 4 $c select to tbox1 8 lappend results [selection get] - array set metrics [font metrics $f] set x [expr {21 + [font measure $f " "] \ + ([font measure {Arial 28 bold} "Y"] / 2)}] set y1 [expr {18 + ($metrics(-linespace) / 2)}] set y2 [expr {160 + ($metrics(-linespace) / 2)}] - lappend results [$c index tbox1 @$x,$y1] lappend results [$c index tbox2 @$x,$y2] +} -cleanup { + destroy .c +} -result {{Yeah } Yeah- 4 4} - set results -} {{Yeah } Yeah- 4 4} - +test canvText-20.1 {angled text bounding box} -setup { + destroy .c + canvas .c + proc transpose {bbox} { + lassign $bbox a b c d + list $b $a $d $c + } +} -body { + .c create text 2 2 -tag t -anchor center -text 0 -font {Helvetica 24} + set bb0 [.c bbox t] + .c itemconf t -angle 90 + set bb1 [.c bbox t] + .c itemconf t -angle 180 + set bb2 [.c bbox t] + .c itemconf t -angle 270 + set bb3 [.c bbox t] + list [expr {$bb0 eq $bb2 ? "ok" : "$bb0,$bb2"}] \ + [expr {$bb1 eq $bb3 ? "ok" : "$bb1,$bb3"}] \ + [expr {$bb0 eq [transpose $bb1] ? "ok" : "$bb0,$bb1"}] \ +} -cleanup { + destroy .c + rename transpose {} +} -result {ok ok ok} # cleanup cleanupTests diff --git a/tests/canvWind.test b/tests/canvWind.test index 9844ff0..436ee2c 100644 --- a/tests/canvWind.test +++ b/tests/canvWind.test @@ -6,12 +6,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test canvWind-1.1 {DisplayWinItem, windows off-screen vertically} { - catch {destroy .t} +test canvWind-1.1 {DisplayWinItem, windows off-screen vertically} -setup { + destroy .t +} -body { toplevel .t canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \ @@ -37,9 +39,13 @@ test canvWind-1.1 {DisplayWinItem, windows off-screen vertically} { .t.c yview scroll -1 units update lappend x [list [winfo ismapped $f] [winfo y $f]] -} {{1 23} {1 -29} {0 -29} {1 225} {0 225}} -test canvWind-1.2 {DisplayWinItem, windows off-screen vertically} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {{1 23} {1 -29} {0 -29} {1 225} {0 225}} + +test canvWind-1.2 {DisplayWinItem, windows off-screen vertically} -setup { + destroy .t +} -body { toplevel .t canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \ @@ -65,9 +71,13 @@ test canvWind-1.2 {DisplayWinItem, windows off-screen vertically} { .t.c yview scroll -1 units update lappend x [list [winfo ismapped $f] [winfo y $f]] -} {{1 3} {1 -49} {0 -49} {1 205} {0 205}} -test canvWind-1.3 {DisplayWinItem, windows off-screen horizontally} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {{1 3} {1 -49} {0 -49} {1 205} {0 205}} + +test canvWind-1.3 {DisplayWinItem, windows off-screen horizontally} -setup { + destroy .t +} -body { toplevel .t canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \ @@ -93,9 +103,13 @@ test canvWind-1.3 {DisplayWinItem, windows off-screen horizontally} { .t.c xview scroll -1 units update lappend x [list [winfo ismapped $f] [winfo x $f]] -} {{1 23} {1 -59} {0 -59} {1 275} {0 275}} -test canvWind-1.4 {DisplayWinItem, windows off-screen horizontally} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {{1 23} {1 -59} {0 -59} {1 275} {0 275}} + +test canvWind-1.4 {DisplayWinItem, windows off-screen horizontally} -setup { + destroy .t +} -body { toplevel .t canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \ @@ -121,8 +135,9 @@ test canvWind-1.4 {DisplayWinItem, windows off-screen horizontally} { .t.c xview scroll -1 units update lappend x [list [winfo ismapped $f] [winfo x $f]] -} {{1 3} {1 -79} {0 -79} {1 255} {0 255}} -catch {destroy .t} +} -cleanup { + destroy .t +} -result {{1 3} {1 -79} {0 -79} {1 255} {0 255}} # cleanup cleanupTests diff --git a/tests/canvas.test b/tests/canvas.test index 6fea894..2b0da48 100644 --- a/tests/canvas.test +++ b/tests/canvas.test @@ -1,95 +1,213 @@ -# This file is a Tcl script to test out the procedures in tkCanvas.c, -# which implements generic code for canvases. It is organized in the -# standard fashion for Tcl tests. +# This file is a Tcl script to test out the procedures in tkCanvas.c, which +# implements generic code for canvases. It is organized in the standard +# fashion for Tcl tests. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. +# Copyright (c) 2008 Donal K. Fellows # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands +imageInit -# XXX - This test file is woefully incomplete. At present, only a -# few of the features are tested. +# XXX - This test file is woefully incomplete. At present, only a few of the +# features are tested. +# Canvas used in 1.* test cases canvas .c pack .c update -set i 1 -foreach {testname testinfo} { - canvas-1.1 {-background #ff0000 #ff0000 - non-existent {unknown color name "non-existent"}} - canvas-1.2 {-bg #ff0000 #ff0000 - non-existent {unknown color name "non-existent"}} - canvas-1.3 {-bd 4 4 badValue {bad screen distance "badValue"}} - canvas-1.4 {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - canvas-1.5 {-closeenough 24 24.0 - bogus {expected floating-point number but got "bogus"}} - canvas-1.6 {-confine true 1 silly {expected boolean value but got "silly"}} - canvas-1.7 {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - canvas-1.8 {-height 2.1 2 x42 {bad screen distance "x42"}} - canvas-1.9 {-highlightbackground #112233 #112233 - ugly {unknown color name "ugly"}} - canvas-1.10 {-highlightcolor #110022 #110022 - bogus {unknown color name "bogus"}} - canvas-1.11 {-highlightthickness 18 18 - badValue {bad screen distance "badValue"}} - canvas-1.12 {-insertbackground #110022 #110022 - bogus {unknown color name "bogus"}} - canvas-1.13 {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}} - canvas-1.14 {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} - canvas-1.15 {-insertontime 100 100 3.2 {expected integer but got "3.2"}} - canvas-1.16 {-insertwidth 1.3 1 6x {bad screen distance "6x"}} - canvas-1.17 {-relief groove groove - 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - canvas-1.18 {-selectbackground #110022 #110022 - bogus {unknown color name "bogus"}} - canvas-1.19 {-selectborderwidth 1.3 1 - badValue {bad screen distance "badValue"}} - canvas-1.20 {-selectforeground #654321 #654321 - bogus {unknown color name "bogus"}} - canvas-1.21 {-takefocus "any string" "any string" {} {}} - canvas-1.22 {-width 402 402 xyz {bad screen distance "xyz"}} - canvas-1.23 {-xscrollcommand {Some command} {Some command} {} {}} - canvas-1.24 {-yscrollcommand {Another command} {Another command} {} {}} -} { - lassign $testinfo name goodValue goodResult badValue badResult - test $testname-good "configuration options: good value for $name" { - .c configure $name $goodValue - lindex [.c configure $name] 4 - } $goodResult - incr i - if {$badValue ne ""} { - test $testname-bad "configuration options: bad value for $name" -body { - .c configure $name $badValue - } -returnCodes error -result $badResult - } - .c configure $name [lindex [.c configure $name] 3] - incr i -} -test canvas-1.25 {configure throws error on bad option} { - set res [list [catch {.c configure -gorp foo}]] - .c create rect 10 10 100 100 - lappend res [catch {.c configure -gorp foo}] - set res -} [list 1 1] +test canvas-1.1 {configuration options: good value for "background"} -body { + .c configure -background #ff0000 + .c cget -background +} -result {#ff0000} +test canvas-1.2 {configuration options: bad value for "background"} -body { + .c configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test canvas-1.3 {configuration options: good value for "bg"} -body { + .c configure -bg #ff0000 + .c cget -bg +} -result {#ff0000} +test canvas-1.4 {configuration options: bad value for "bg"} -body { + .c configure -bg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test canvas-1.5 {configuration options: good value for "bd"} -body { + .c configure -bd 4 + .c cget -bd +} -result {4} +test canvas-1.6 {configuration options: bad value for "bd"} -body { + .c configure -bd badValue +} -returnCodes error -result {bad screen distance "badValue"} +test canvas-1.7 {configuration options: good value for "borderwidth"} -body { + .c configure -borderwidth 1.3 + .c cget -borderwidth +} -result {1} +test canvas-1.8 {configuration options: bad value for "borderwidth"} -body { + .c configure -borderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test canvas-1.9 {configuration options: good value for "closeenough"} -body { + .c configure -closeenough 24 + .c cget -closeenough +} -result {24.0} +test canvas-1.10 {configuration options: bad value for "closeenough"} -body { + .c configure -closeenough bogus +} -returnCodes error -result {expected floating-point number but got "bogus"} +test canvas-1.11 {configuration options: good value for "confine"} -body { + .c configure -confine true + .c cget -confine +} -result {1} +test canvas-1.12 {configuration options: bad value for "confine"} -body { + .c configure -confine silly +} -returnCodes error -result {expected boolean value but got "silly"} +test canvas-1.13 {configuration options: good value for "cursor"} -body { + .c configure -cursor arrow + .c cget -cursor +} -result {arrow} +test canvas-1.14 {configuration options: bad value for "cursor"} -body { + .c configure -cursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} +test canvas-1.15 {configuration options: good value for "height"} -body { + .c configure -height 2.1 + .c cget -height +} -result {2} +test canvas-1.16 {configuration options: bad value for "height"} -body { + .c configure -height x42 +} -returnCodes error -result {bad screen distance "x42"} +test canvas-1.17 {configuration options: good value for "highlightbackground"} -body { + .c configure -highlightbackground #112233 + .c cget -highlightbackground +} -result {#112233} +test canvas-1.18 {configuration options: bad value for "highlightbackground"} -body { + .c configure -highlightbackground ugly +} -returnCodes error -result {unknown color name "ugly"} +test canvas-1.19 {configuration options: good value for "highlightcolor"} -body { + .c configure -highlightcolor #110022 + .c cget -highlightcolor +} -result {#110022} +test canvas-1.20 {configuration options: bad value for "highlightcolor"} -body { + .c configure -highlightcolor bogus +} -returnCodes error -result {unknown color name "bogus"} +test canvas-1.21 {configuration options: good value for "highlightthickness"} -body { + .c configure -highlightthickness 18 + .c cget -highlightthickness +} -result {18} +test canvas-1.22 {configuration options: bad value for "highlightthickness"} -body { + .c configure -highlightthickness badValue +} -returnCodes error -result {bad screen distance "badValue"} +test canvas-1.23 {configuration options: good value for "insertbackground"} -body { + .c configure -insertbackground #110022 + .c cget -insertbackground +} -result {#110022} +test canvas-1.24 {configuration options: bad value for "insertbackground"} -body { + .c configure -insertbackground bogus +} -returnCodes error -result {unknown color name "bogus"} +test canvas-1.25 {configuration options: good value for "insertborderwidth"} -body { + .c configure -insertborderwidth 1.3 + .c cget -insertborderwidth +} -result {1} +test canvas-1.26 {configuration options: bad value for "insertborderwidth"} -body { + .c configure -insertborderwidth 2.6x +} -returnCodes error -result {bad screen distance "2.6x"} +test canvas-1.27 {configuration options: good value for "insertofftime"} -body { + .c configure -insertofftime 100 + .c cget -insertofftime +} -result {100} +test canvas-1.28 {configuration options: bad value for "insertofftime"} -body { + .c configure -insertofftime 3.2 +} -returnCodes error -result {expected integer but got "3.2"} +test canvas-1.29 {configuration options: good value for "insertontime"} -body { + .c configure -insertontime 100 + .c cget -insertontime +} -result {100} +test canvas-1.30 {configuration options: bad value for "insertontime"} -body { + .c configure -insertontime 3.2 +} -returnCodes error -result {expected integer but got "3.2"} +test canvas-1.31 {configuration options: good value for "insertwidth"} -body { + .c configure -insertwidth 1.3 + .c cget -insertwidth +} -result {1} +test canvas-1.32 {configuration options: bad value for "insertwidth"} -body { + .c configure -insertwidth 6x +} -returnCodes error -result {bad screen distance "6x"} +test canvas-1.33 {configuration options: good value for "relief"} -body { + .c configure -relief groove + .c cget -relief +} -result {groove} +test canvas-1.34 {configuration options: bad value for "relief"} -body { + .c configure -relief 1.5 +} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test canvas-1.35 {configuration options: good value for "selectbackground"} -body { + .c configure -selectbackground #110022 + .c cget -selectbackground +} -result {#110022} +test canvas-1.36 {configuration options: bad value for "selectbackground"} -body { + .c configure -selectbackground bogus +} -returnCodes error -result {unknown color name "bogus"} +test canvas-1.37 {configuration options: good value for "selectborderwidth"} -body { + .c configure -selectborderwidth 1.3 + .c cget -selectborderwidth +} -result {1} +test canvas-1.38 {configuration options: bad value for "selectborderwidth"} -body { + .c configure -selectborderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test canvas-1.39 {configuration options: good value for "selectforeground"} -body { + .c configure -selectforeground #654321 + .c cget -selectforeground +} -result {#654321} +test canvas-1.40 {configuration options: bad value for "selectforeground"} -body { + .c configure -selectforeground bogus +} -returnCodes error -result {unknown color name "bogus"} +test canvas-1.41 {configuration options: good value for "takefocus"} -body { + .c configure -takefocus "any string" + .c cget -takefocus +} -result {any string} +test canvas-1.42 {configuration options: good value for "width"} -body { + .c configure -width 402 + .c cget -width +} -result {402} +test canvas-1.43 {configuration options: bad value for "width"} -body { + .c configure -width xyz +} -returnCodes error -result {bad screen distance "xyz"} +test canvas-1.44 {configuration options: good value for "xscrollcommand"} -body { + .c configure -xscrollcommand {Some command} + .c cget -xscrollcommand +} -result {Some command} +test canvas-1.45 {configuration options: good value for "yscrollcommand"} -body { + .c configure -yscrollcommand {Another command} + .c cget -yscrollcommand +} -result {Another command} +test canvas-1.46 {configure throws error on bad option} -body { + .c configure -gorp foo +} -returnCodes error -match glob -result {*} +test canvas-1.47 {configure throws error on bad option} -body { + catch {.c configure -gorp foo} + .c create rect 10 10 100 100 + .c configure -gorp foo +} -returnCodes error -match glob -result {*} catch {destroy .c} + +# Canvas used in 2.* test cases canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \ -highlightthickness 0 pack .c update -test canvas-2.1 {CanvasWidgetCmd, bind option} { +test canvas-2.1 {CanvasWidgetCmd, bind option} -body { set i [.c create rect 10 10 100 100] - list [catch {.c bind $i <a>} msg] $msg -} {0 {}} -test canvas-2.2 {CanvasWidgetCmd, bind option} { + .c bind $i <a> +} -cleanup { + .c delete $i +} -returnCodes ok +test canvas-2.2 {CanvasWidgetCmd, bind option} -body { set i [.c create rect 10 10 100 100] - list [catch {.c bind $i <} msg] $msg -} {1 {no event type or button # or keysym}} -test canvas-2.3 {CanvasWidgetCmd, xview option} { + .c bind $i < +} -cleanup { + .c delete $i +} -returnCodes error -result {no event type or button # or keysym} +test canvas-2.3 {CanvasWidgetCmd, xview option} -body { .c configure -xscrollincrement 40 -yscrollincrement 5 .c xview moveto 0 update @@ -97,10 +215,10 @@ test canvas-2.3 {CanvasWidgetCmd, xview option} { .c xview scroll 2 units update lappend x [.c xview] -} {{0.0 0.3} {0.4 0.7}} -test canvas-2.4 {CanvasWidgetCmd, xview option} {nonPortable} { - # This test gives slightly different results on platforms such - # as NetBSD. I don't know why... +} -result {{0.0 0.3} {0.4 0.7}} +test canvas-2.4 {CanvasWidgetCmd, xview option} -constraints nonPortable -body { + # This test gives slightly different results on platforms such as NetBSD. + # I don't know why... .c configure -xscrollincrement 0 -yscrollincrement 5 .c xview moveto 0.6 update @@ -108,14 +226,16 @@ test canvas-2.4 {CanvasWidgetCmd, xview option} {nonPortable} { .c xview scroll 2 units update lappend x [.c xview] -} {{0.6 0.9} {0.66 0.96}} - +} -result {{0.6 0.9} {0.66 0.96}} catch {destroy .c} + +# Canvas used in 3.* test cases canvas .c -width 60 -height 40 -scrollregion {0 0 200 80} \ -borderwidth 0 -highlightthickness 0 pack .c update -test canvas-3.1 {CanvasWidgetCmd, yview option} { + +test canvas-3.1 {CanvasWidgetCmd, yview option} -body { .c configure -xscrollincrement 40 -yscrollincrement 5 .c yview moveto 0 update @@ -123,8 +243,8 @@ test canvas-3.1 {CanvasWidgetCmd, yview option} { .c yview scroll 3 units update lappend x [.c yview] -} {{0.0 0.5} {0.1875 0.6875}} -test canvas-3.2 {CanvasWidgetCmd, yview option} { +} -result {{0.0 0.5} {0.1875 0.6875}} +test canvas-3.2 {CanvasWidgetCmd, yview option} -body { .c configure -xscrollincrement 40 -yscrollincrement 0 .c yview moveto 0 update @@ -132,39 +252,43 @@ test canvas-3.2 {CanvasWidgetCmd, yview option} { .c yview scroll 2 units update lappend x [.c yview] -} {{0.0 0.5} {0.1 0.6}} +} -result {{0.0 0.5} {0.1 0.6}} +destroy .c -test canvas-4.1 {ButtonEventProc procedure} { +test canvas-4.1 {ButtonEventProc procedure} -setup { deleteWindows + set x {} +} -body { canvas .c1 -bg #543210 rename .c1 .c2 - set x {} lappend x [winfo children .] lappend x [.c2 cget -bg] destroy .c1 lappend x [info command .c*] [winfo children .] -} {.c1 #543210 {} {}} +} -result {.c1 #543210 {} {}} -test canvas-5.1 {ButtonCmdDeletedProc procedure} { - deleteWindows +test canvas-5.1 {ButtonCmdDeletedProc procedure} -body { canvas .c1 rename .c1 {} list [info command .c*] [winfo children .] -} {{} {}} +} -cleanup { + destroy .c1 +} -result {{} {}} -catch {destroy .c} +# Canvas used in 6.* test cases canvas .c -width 100 -height 50 -scrollregion {-200 -100 305 102} \ -borderwidth 2 -highlightthickness 3 pack .c update -test canvas-6.1 {CanvasSetOrigin procedure} { + +test canvas-6.1 {CanvasSetOrigin procedure} -body { .c configure -xscrollincrement 0 -yscrollincrement 0 .c xview moveto 0 .c yview moveto 0 update list [.c canvasx 0] [.c canvasy 0] -} {-205.0 -105.0} -test canvas-6.2 {CanvasSetOrigin procedure} { +} -result {-205.0 -105.0} +test canvas-6.2 {CanvasSetOrigin procedure} -body { .c configure -xscrollincrement 20 -yscrollincrement 10 set x "" foreach i {.08 .10 .48 .50} { @@ -172,9 +296,9 @@ test canvas-6.2 {CanvasSetOrigin procedure} { update lappend x [.c canvasx 0] } - set x -} {-165.0 -145.0 35.0 55.0} -test canvas-6.3 {CanvasSetOrigin procedure} { + return $x +} -result {-165.0 -145.0 35.0 55.0} +test canvas-6.3 {CanvasSetOrigin procedure} -body { .c configure -xscrollincrement 20 -yscrollincrement 10 set x "" foreach i {.06 .08 .70 .72} { @@ -182,30 +306,29 @@ test canvas-6.3 {CanvasSetOrigin procedure} { update lappend x [.c canvasy 0] } - set x -} {-95.0 -85.0 35.0 45.0} -test canvas-6.4 {CanvasSetOrigin procedure} { + return $x +} -result {-95.0 -85.0 35.0 45.0} +test canvas-6.4 {CanvasSetOrigin procedure} -body { .c configure -xscrollincrement 20 -yscrollincrement 10 .c xview moveto 1.0 .c canvasx 0 -} {215.0} -test canvas-6.5 {CanvasSetOrigin procedure} { +} -result {215.0} +test canvas-6.5 {CanvasSetOrigin procedure} -body { .c configure -xscrollincrement 20 -yscrollincrement 10 .c yview moveto 1.0 .c canvasy 0 -} {55.0} - +} -result {55.0} deleteWindows -set l [lsort [interp hidden]] test canvas-7.1 {canvas widget vs hidden commands} -setup { - catch {destroy .c} -} -body { canvas .c +} -body { interp hide {} .c destroy .c list [winfo children .] [lsort [interp hidden]] -} -result [list {} $l] +} -cleanup { + destroy .c +} -result [list {} [lsort [interp hidden]]] test canvas-8.1 {canvas arc bbox} -setup { catch {destroy .c} @@ -224,11 +347,10 @@ test canvas-9.1 {canvas id creation and deletion} -setup { catch {destroy .c} canvas .c } -body { - # With Tk 8.0.4 the ids are now stored in a hash table. You - # can use this test as a performance test with older versions - # by changing the value of size. + # With Tk 8.0.4 the ids are now stored in a hash table. You can use this + # test as a performance test with older versions by changing the value of + # size. set size 15 - for {set i 0} {$i < $size} {incr i} { set x [expr {-10 + 3*$i}] for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} { @@ -238,10 +360,8 @@ test canvas-9.1 {canvas id creation and deletion} -setup { -anchor center -tags text } } - - # The actual bench mark - this code also exercises all the hash - # table changes. - + # The actual bench mark - this code also exercises all the hash table + # changes. set time [lindex [time { foreach id [.c find withtag all] { .c lower $id @@ -251,12 +371,13 @@ test canvas-9.1 {canvas id creation and deletion} -setup { .c delete $id } }] 0] - set x "" } -result {} + test canvas-10.1 {find items using tag expressions} -setup { catch {destroy .c} canvas .c + set res {} } -body { .c create oval 20 20 40 40 -fill red -tag [list a b c d] .c create oval 20 60 40 80 -fill yellow -tag [list b a] @@ -265,7 +386,6 @@ test canvas-10.1 {find items using tag expressions} -setup { .c create oval 20 180 40 200 -fill bisque -tag [list a d e] .c create oval 20 220 40 240 -fill bisque -tag b .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] - set res {} lappend res [.c find withtag {!a}] lappend res [.c find withtag {b&&c}] lappend res [.c find withtag {b||c}] @@ -286,7 +406,7 @@ test canvas-10.2 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {&&c} -} -returnCodes error -result {Unexpected operator in tag search expression} +} -returnCodes error -result {unexpected operator in tag search expression} test canvas-10.3 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -294,7 +414,7 @@ test canvas-10.3 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {!!c} -} -returnCodes error -result {Too many '!' in tag search expression} +} -returnCodes error -result {too many '!' in tag search expression} test canvas-10.4 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -302,7 +422,7 @@ test canvas-10.4 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {b||} -} -returnCodes error -result {Missing tag in tag search expression} +} -returnCodes error -result {missing tag in tag search expression} test canvas-10.5 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -310,7 +430,7 @@ test canvas-10.5 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {b&&(c||)} -} -returnCodes error -result {Unexpected operator in tag search expression} +} -returnCodes error -result {unexpected operator in tag search expression} test canvas-10.6 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -318,7 +438,7 @@ test canvas-10.6 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {d&&""} -} -returnCodes error -result {Null quoted tag string in tag search expression} +} -returnCodes error -result {null quoted tag string in tag search expression} test canvas-10.7 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -326,15 +446,15 @@ test canvas-10.7 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag "d&&\"tag with spaces" -} -returnCodes error -result {Missing endquote in tag search expression} +} -returnCodes error -result {missing endquote in tag search expression} test canvas-10.8 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c .c create oval 20 20 40 40 -fill red -tag [list a b c d] .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] -} -body { +} -returnCodes error -body { .c find withtag {a&&"tag with spaces"z} -} -returnCodes error -result {Invalid boolean operator in tag search expression} +} -result {invalid boolean operator in tag search expression} test canvas-10.9 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -342,7 +462,7 @@ test canvas-10.9 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {a&&b&c} -} -returnCodes error -result {Singleton '&' in tag search expression} +} -returnCodes error -result {singleton '&' in tag search expression} test canvas-10.10 {check errors from tag expressions} -setup { catch {destroy .c} canvas .c @@ -350,11 +470,12 @@ test canvas-10.10 {check errors from tag expressions} -setup { .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] } -body { .c find withtag {a||b|c} -} -returnCodes error -result {Singleton '|' in tag search expression} +} -returnCodes error -result {singleton '|' in tag search expression} test canvas-10.11 {backward compatility - strange tags that are not expressions} -setup { catch {destroy .c} canvas .c - .c create oval 20 20 40 40 -fill red -tag [list { strange tag(xxx&yyy|zzz) " && \" || ! ^ " }] + .c create oval 20 20 40 40 -fill red \ + -tag [list { strange tag(xxx&yyy|zzz) " && \" || ! ^ " }] } -body { .c find withtag { strange tag(xxx&yyy|zzz) " && \" || ! ^ " } } -result 1 @@ -386,22 +507,22 @@ test canvas-11.1 {canvas poly fill check, bug 5783} -setup { test canvas-11.2 {canvas poly overlap fill check, bug 226357} -setup { destroy .c pack [canvas .c] -} -body { set result {} +} -body { .c create poly 30 30 90 90 30 90 90 30 - lappend result [.c find over 40 40 45 45]; # rect region inc. edge - lappend result [.c find over 60 40 60 40]; # top-center point - lappend result [.c find over 0 0 0 0]; # not on poly - lappend result [.c find over 60 60 60 60]; # center-point - lappend result [.c find over 45 50 45 50]; # outside poly + lappend result [.c find over 40 40 45 45]; # rect region inc. edge + lappend result [.c find over 60 40 60 40]; # top-center point + lappend result [.c find over 0 0 0 0]; # not on poly + lappend result [.c find over 60 60 60 60]; # center-point + lappend result [.c find over 45 50 45 50]; # outside poly .c itemconfig 1 -fill "" -outline black - lappend result [.c find over 40 40 45 45]; # rect region inc. edge - lappend result [.c find over 60 40 60 40]; # top-center point - lappend result [.c find over 0 0 0 0]; # not on poly - lappend result [.c find over 60 60 60 60]; # center-point - lappend result [.c find over 45 50 45 50]; # outside poly + lappend result [.c find over 40 40 45 45]; # rect region inc. edge + lappend result [.c find over 60 40 60 40]; # top-center point + lappend result [.c find over 0 0 0 0]; # not on poly + lappend result [.c find over 60 60 60 60]; # center-point + lappend result [.c find over 45 50 45 50]; # outside poly .c itemconfig 1 -width 8 - lappend result [.c find over 45 50 45 50]; # outside poly + lappend result [.c find over 45 50 45 50]; # outside poly } -result {1 1 {} 1 {} 1 1 {} 1 {} 1} test canvas-11.3 {canvas poly dchars, bug 3291543} { # This would crash @@ -434,6 +555,7 @@ test canvas-12.2 {canvas mm obj, patch SF-403327, 102471} -setup { incr val } -result 12 +# procedure used in 13.1 test case proc kill_canvas {w} { destroy $w pack [canvas $w -height 200 -width 200] -fill both -expand yes @@ -443,11 +565,9 @@ proc kill_canvas {w} { $w bind blue <ButtonRelease-1> [subst { [lindex [info level 0] 0] $w append ::x ok - } - ] + }] } - -test canvas-13.1 {canvas delete during event, SF bug-228024} { +test canvas-13.1 {canvas delete during event, SF bug-228024} -body { kill_canvas .c set ::x {} # do this many times to improve chances of triggering the crash @@ -455,27 +575,27 @@ test canvas-13.1 {canvas delete during event, SF bug-228024} { event generate .c <1> -x 100 -y 100 event generate .c <ButtonRelease-1> -x 100 -y 100 } - set ::x -} okokokokokokokokokokokokokokokokokokokokokokokokokokokokokok + return $::x +} -result {okokokokokokokokokokokokokokokokokokokokokokokokokokokokokok} test canvas-14.1 {canvas scan SF bug 581560} -setup { destroy .c canvas .c -} -body { +} -returnCodes error -body { .c scan -} -returnCodes error -result {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"} +} -result {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"} test canvas-14.2 {canvas scan} -setup { destroy .c canvas .c -} -body { +} -returnCodes error -body { .c scan bogus -} -returnCodes error -result {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"} +} -result {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"} test canvas-14.3 {canvas scan} -setup { destroy .c canvas .c -} -body { +} -returnCodes error -body { .c scan mark -} -returnCodes error -result {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"} +} -result {wrong # args: should be ".c scan mark|dragto x y ?dragGain?"} test canvas-14.4 {canvas scan} -setup { destroy .c canvas .c @@ -495,37 +615,133 @@ test canvas-14.6 {canvas scan} -setup { .c scan dragto 10 10 5 } -result {} -set i 0 -proc create {w type args} { - eval [list $w create $type] $args -} -foreach type {arc bitmap image line oval polygon rect text window} { - incr i - test canvas-15.$i "basic types check: $type requires coords" -setup { - destroy .c - canvas .c - } -body { - .c create $type - } -returnCodes error -result [format {wrong # args: should be ".c create %s coords ?arg arg ...?"} $type] - incr i - test canvas-15.$i "basic coords check: $type coords are paired" -setup { - destroy .c - canvas .c - } -match glob -body { - .c create $type 0 - } -returnCodes error -result "wrong # coordinates: expected*" -} +test canvas-15.1 {basic types check: arc requires coords} -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create arc +} -result {wrong # args: should be ".c create arc coords ?arg ...?"} +test canvas-15.2 "basic coords check: arc coords are paired" -setup { + destroy .c + canvas .c +} -body { + .c create arc 0 +} -returnCodes error -result {wrong # coordinates: expected 4, got 1} +test canvas-15.3 {basic types check: bitmap requires coords} -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create bitmap +} -result {wrong # args: should be ".c create bitmap coords ?arg ...?"} +test canvas-15.4 "basic coords check: bitmap coords are paired" -setup { + destroy .c + canvas .c +} -body { + .c create bitmap 0 +} -returnCodes error -result {wrong # coordinates: expected 2, got 1} +test canvas-15.5 {basic types check: image requires coords} -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create image +} -result {wrong # args: should be ".c create image coords ?arg ...?"} +test canvas-15.6 "basic coords check: image coords are paired" -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create image 0 +} -result {wrong # coordinates: expected 2, got 1} +test canvas-15.7 {basic types check: line requires coords} -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create line +} -result {wrong # args: should be ".c create line coords ?arg ...?"} +test canvas-15.8 "basic coords check: line coords are paired" -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create line 0 +} -result {wrong # coordinates: expected an even number, got 1} +test canvas-15.9 {basic types check: oval requires coords} -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create oval +} -result {wrong # args: should be ".c create oval coords ?arg ...?"} +test canvas-15.10 "basic coords check: oval coords are paired" -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create oval 0 +} -result {wrong # coordinates: expected 0 or 4, got 1} +test canvas-15.11 {basic types check: polygon requires coords} -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create polygon +} -result {wrong # args: should be ".c create polygon coords ?arg ...?"} +test canvas-15.12 "basic coords check: polygon coords are paired" -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create polygon 0 +} -result {wrong # coordinates: expected an even number, got 1} +test canvas-15.13 {basic types check: rect requires coords} -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create rect +} -result {wrong # args: should be ".c create rect coords ?arg ...?"} +test canvas-15.14 "basic coords check: rect coords are paired" -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create rect 0 +} -result {wrong # coordinates: expected 0 or 4, got 1} +test canvas-15.15 {basic types check: text requires coords} -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create text +} -result {wrong # args: should be ".c create text coords ?arg ...?"} +test canvas-15.16 "basic coords check: text coords are paired" -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create text 0 +} -result {wrong # coordinates: expected 2, got 1} +test canvas-15.17 {basic types check: window requires coords} -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create window +} -result {wrong # args: should be ".c create window coords ?arg ...?"} +test canvas-15.18 "basic coords check: window coords are paired" -setup { + destroy .c + canvas .c +} -returnCodes error -body { + .c create window 0 +} -result {wrong # coordinates: expected 2, got 1} +test canvas-15.19 "basic coords check: centimeters are larger than pixels" -setup { + destroy .c + canvas .c +} -body { + set id [.c create rect 0 0 1cm 1cm] + expr {[lindex [.c coords $id] 2]>1} +} -result {1} +destroy .c test canvas-16.1 {arc coords check} -setup { - destroy .c canvas .c } -body { set id [.c create arc {0 10 20 30} -start 33] .c itemcget $id -start +} -cleanup { + destroy .c } -result {33.0} test canvas-17.1 {default smooth method handling} -setup { - destroy .c canvas .c } -body { set id [.c create line {0 0 1 1 2 2 3 3 4 4 5 5 6 6}] @@ -534,11 +750,211 @@ test canvas-17.1 {default smooth method handling} -setup { .c itemconfigure $id -smooth $smoother lappend result [.c itemcget $id -smooth] } - set result + return $result +} -cleanup { + destroy .c } -result {0 true true true raw raw true} -destroy .c +test canvas-18.1 {imove method - lines} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1 2 2 3 3] + .c imove $id 0 4 4 + .c coords $id +} -cleanup { + destroy .c +} -result {4.0 4.0 1.0 1.0 2.0 2.0 3.0 3.0} +test canvas-18.2 {imove method - lines} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1] + .c imove $id 0 4 4 + .c coords $id +} -cleanup { + destroy .c +} -result {4.0 4.0 1.0 1.0} +test canvas-18.3 {imove method - lines} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1 2 2 3 3] + .c imove $id @1,1 4 4 + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 4.0 4.0 2.0 2.0 3.0 3.0} +test canvas-18.4 {imove method - lines} -constraints knownBug -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1 2 2 3 3] + .c imove $id end 4 4 + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 1.0 1.0 2.0 2.0 4.0 4.0} +test canvas-18.5 {imove method - polygon} -setup { + canvas .c +} -body { + set id [.c create polygon 0 0 1 1 2 2 3 3] + .c imove $id 0 4 4 + .c coords $id +} -cleanup { + destroy .c +} -result {4.0 4.0 1.0 1.0 2.0 2.0 3.0 3.0} +test canvas-18.6 {imove method - polygon} -setup { + canvas .c +} -body { + set id [.c create polygon 0 0 1 1] + .c imove $id 0 4 4 + .c coords $id +} -cleanup { + destroy .c +} -result {4.0 4.0 1.0 1.0} +test canvas-18.7 {imove method - polygon} -setup { + canvas .c +} -body { + set id [.c create polygon 0 0 1 1 2 2 3 3] + .c imove $id @1,1 4 4 + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 4.0 4.0 2.0 2.0 3.0 3.0} +test canvas-18.8 {imove method - polygon} -constraints knownBug -setup { + canvas .c +} -body { + set id [.c create polygon 0 0 1 1 2 2 3 3] + .c imove $id end 4 4 + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 1.0 1.0 2.0 2.0 4.0 4.0} +test canvas-18.9 {imove method - errors} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1 2 2 3 3] + .c imove $id foobar 4 4 +} -cleanup { + destroy .c +} -returnCodes error -result {bad index "foobar"} +test canvas-18.10 {imove method - errors} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1 2 2 3 3] + .c imove $id 0 foobar 4 +} -cleanup { + destroy .c +} -returnCodes error -result {bad screen distance "foobar"} +test canvas-18.11 {imove method - errors} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1 2 2 3 3] + .c imove $id 0 4 foobar +} -cleanup { + destroy .c +} -returnCodes error -result {bad screen distance "foobar"} + +test canvas-19.1 {rchars method - lines} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1 2 2 3 3] + .c rchars $id 2 4 {4 4} + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 4.0 4.0 3.0 3.0} +test canvas-19.2 {rchars method - lines} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1 2 2 3 3] + .c rchars $id 2 4 {} + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 3.0 3.0} +test canvas-19.3 {rchars method - lines} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1 2 2 3 3] + .c rchars $id 2 4 {10 11 12 13 14 15} + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 10.0 11.0 12.0 13.0 14.0 15.0 3.0 3.0} +test canvas-19.4 {rchars method - polygon} -setup { + canvas .c +} -body { + set id [.c create polygon 0 0 1 1 2 2 3 3] + .c rchars $id 2 4 {4 4} + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 4.0 4.0 3.0 3.0} +test canvas-19.5 {rchars method - polygon} -setup { + canvas .c +} -body { + set id [.c create polygon 0 0 1 1 2 2 3 3] + .c rchars $id 2 4 {} + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 3.0 3.0} +test canvas-19.6 {rchars method - polygon} -setup { + canvas .c +} -body { + set id [.c create polygon 0 0 1 1 2 2 3 3] + .c rchars $id 2 4 {10 11 12 13 14 15} + .c coords $id +} -cleanup { + destroy .c +} -result {0.0 0.0 10.0 11.0 12.0 13.0 14.0 15.0 3.0 3.0} +test canvas-19.7 {rchars method - text} -setup { + canvas .c +} -body { + set id [.c create text 0 0 -text abcde] + .c rchars $id 1 3 XYZ + .c itemcget $id -text +} -cleanup { + destroy .c +} -result aXYZe +test canvas-19.8 {rchars method - text} -setup { + canvas .c +} -body { + set id [.c create text 0 0 -text abcde] + .c rchars $id 1 3 {} + .c itemcget $id -text +} -cleanup { + destroy .c +} -result ae +test canvas-19.9 {rchars method - text} -setup { + canvas .c +} -body { + set id [.c create text 0 0 -text abcde] + .c rchars $id 1 3 FOOBAR + .c itemcget $id -text +} -cleanup { + destroy .c +} -result aFOOBARe +test canvas-19.10 {rchars method - errors} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1] + .c rchars $id foo 1 {2 2} +} -cleanup { + destroy .c +} -returnCodes error -result {bad index "foo"} +test canvas-19.11 {rchars method - errors} -setup { + canvas .c +} -body { + set id [.c create line 0 0 1 1] + .c rchars $id 1 foo {2 2} +} -cleanup { + destroy .c +} -returnCodes error -result {bad index "foo"} # cleanup +imageCleanup cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/choosedir.test b/tests/choosedir.test index 01a319f..fb6e62d 100644 --- a/tests/choosedir.test +++ b/tests/choosedir.test @@ -5,7 +5,8 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands @@ -84,61 +85,86 @@ set fake [file join $dir non-existant] set parent . -foreach opt {-initialdir -mustexist -parent -title} { - test choosedir-1.1$opt "tk_chooseDirectory command" unix { - list [catch {tk_chooseDirectory $opt} msg] $msg - } [list 1 "value for \"$opt\" missing"] -} -test choosedir-1.2 "tk_chooseDirectory command" unix { - list [catch {tk_chooseDirectory -foo bar} msg] $msg -} [list 1 "bad option \"-foo\": must be -initialdir, -mustexist, -parent, or -title"] -test choosedir-1.3 "tk_chooseDirectory command" unix { - list [catch {tk_chooseDirectory -parent foo.bar} msg] $msg -} {1 {bad window path name "foo.bar"}} - - -test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unix notAqua} { +test choosedir-1.1 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -initialdir +} -returnCodes error -result {value for "-initialdir" missing} +test choosedir-1.2 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -mustexist +} -returnCodes error -result {value for "-mustexist" missing} +test choosedir-1.3 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -parent +} -returnCodes error -result {value for "-parent" missing} +test choosedir-1.4 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -title +} -returnCodes error -result {value for "-title" missing} + +test choosedir-1.5 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -foo bar +} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title} +test choosedir-1.6 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -parent foo.bar +} -returnCodes error -result {bad window path name "foo.bar"} + + +test choosedir-2.1 {tk_chooseDirectory command, cancel gives null} -constraints { + unix notAqua +} -body { ToPressButton $parent cancel tk_chooseDirectory -title "Press Cancel" -parent $parent -} "" +} -result {} -test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unix notAqua} { + +test choosedir-3.1 {tk_chooseDirectory -mustexist 1} -constraints { + unix notAqua +} -body { # first enter a bogus dirname, then enter a real one. ToEnterDirsByKey $parent [list $fake $real $real] set result [tk_chooseDirectory \ -title "Enter \"$fake\", press OK, enter \"$real\", press OK" \ -parent $parent -mustexist 1] set result -} $real -test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unix notAqua} { +} -result $real +test choosedir-3.2 {tk_chooseDirectory -mustexist 0} -constraints { + unix notAqua +} -body { ToEnterDirsByKey $parent [list $fake $fake] tk_chooseDirectory -title "Enter \"$fake\", press OK" \ -parent $parent -mustexist 0 -} $fake +} -result $fake + -test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unix notAqua} { +test choosedir-4.1 {tk_chooseDirectory command, initialdir} -constraints { + unix notAqua +} -body { ToPressButton $parent ok tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real -} $real -test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unix notAqua} { +} -result $real +test choosedir-4.2 {tk_chooseDirectory command, initialdir} -constraints { + unix notAqua +} -body { ToEnterDirsByKey $parent [list $fake $fake] tk_chooseDirectory \ -title "Enter \"$fake\" and press Ok" \ -parent $parent -initialdir $real -} $fake -test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unix notAqua} { +} -result $fake +test choosedir-4.3 {tk_chooseDirectory command, {} initialdir} -constraints { + unix notAqua +} -body { catch {unset ::tk::dialog::file::__tk_choosedir} ToPressButton $parent ok tk_chooseDirectory \ -title "Press OK" \ -parent $parent -initialdir "" -} [pwd] +} -result [pwd] + -test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" {unix notAqua} { +test choosedir-5.1 {tk_chooseDirectory, handles {} entry text} -constraints { + unix notAqua +} -body { ToEnterDirsByKey $parent [list "" $real $real] tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" \ -parent $parent -} $real +} -result $real # cleanup removeDirectory choosedirTest diff --git a/tests/clipboard.test b/tests/clipboard.test index 37e45a3..6077940 100644 --- a/tests/clipboard.test +++ b/tests/clipboard.test @@ -11,7 +11,8 @@ # environment variable TK_ALT_DISPLAY is set to an alternate display. # -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands @@ -23,124 +24,189 @@ foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} { } # Now we start the main body of the test code - -test clipboard-1.1 {ClipboardHandler procedure} { + +test clipboard-1.1 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append "test" clipboard get -} {test} -test clipboard-1.2 {ClipboardHandler procedure} { +} -cleanup { + clipboard clear +} -result {test} +test clipboard-1.2 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append "test" clipboard append "ing" clipboard get -} {testing} -test clipboard-1.3 {ClipboardHandler procedure} { +} -cleanup { clipboard clear +} -result {testing} +test clipboard-1.3 {ClipboardHandler procedure} -setup { + clipboard clear +} -body { clipboard append "t" clipboard append "e" clipboard append "s" clipboard append "t" clipboard get -} {test} -test clipboard-1.4 {ClipboardHandler procedure} { +} -cleanup { + clipboard clear +} -result {test} +test clipboard-1.4 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append $longValue clipboard get -} "$longValue" -test clipboard-1.5 {ClipboardHandler procedure} { +} -cleanup { clipboard clear +} -result "$longValue" +test clipboard-1.5 {ClipboardHandler procedure} -setup { + clipboard clear +} -body { clipboard append $longValue clipboard append "test" clipboard get -} "${longValue}test" -test clipboard-1.6 {ClipboardHandler procedure} { +} -cleanup { + clipboard clear +} -result "${longValue}test" +test clipboard-1.6 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append -t TEST $longValue clipboard append -t STRING "test" - list [clipboard get -t STRING] \ - [clipboard get -t TEST] -} [list test $longValue] -test clipboard-1.7 {ClipboardHandler procedure} { + list [clipboard get -t STRING] [clipboard get -t TEST] +} -cleanup { clipboard clear +} -result [list test $longValue] +test clipboard-1.7 {ClipboardHandler procedure} -setup { + clipboard clear +} -body { clipboard append -t TEST [string range $longValue 1 4000] clipboard append -t STRING "test" - list [clipboard get -t STRING] \ - [clipboard get -t TEST] -} [list test [string range $longValue 1 4000]] -test clipboard-1.8 {ClipboardHandler procedure} { + list [clipboard get -t STRING] [clipboard get -t TEST] +} -cleanup { + clipboard clear +} -result [list test [string range $longValue 1 4000]] +test clipboard-1.8 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append "" clipboard get -} {} -test clipboard-1.9 {ClipboardHandler procedure} { +} -cleanup { clipboard clear +} -result {} +test clipboard-1.9 {ClipboardHandler procedure} -setup { + clipboard clear +} -body { clipboard append "" clipboard append "Test" clipboard get -} {Test} +} -cleanup { + clipboard clear +} -result {Test} ############################################################################## -test clipboard-2.1 {ClipboardAppHandler procedure} { +test clipboard-2.1 {ClipboardAppHandler procedure} -setup { set oldAppName [tk appname] - tk appname UnexpectedName clipboard clear +} -body { + tk appname UnexpectedName clipboard append -type NEW_TYPE Data - set result [selection get -selection CLIPBOARD -type TK_APPLICATION] + selection get -selection CLIPBOARD -type TK_APPLICATION +} -cleanup { tk appname $oldAppName - set result -} {UnexpectedName} + clipboard clear +} -result {UnexpectedName} ############################################################################## -test clipboard-3.1 {ClipboardWindowHandler procedure} { +test clipboard-3.1 {ClipboardWindowHandler procedure} -setup { set oldAppName [tk appname] - tk appname UnexpectedName clipboard clear +} -body { + tk appname UnexpectedName clipboard append -type NEW_TYPE Data - set result [selection get -selection CLIPBOARD -type TK_WINDOW] + selection get -selection CLIPBOARD -type TK_WINDOW +} -cleanup { tk appname $oldAppName - set result -} {.} + clipboard clear +} -result {.} ############################################################################## -test clipboard-4.1 {ClipboardLostSel procedure} { +test clipboard-4.1 {ClipboardLostSel procedure} -setup { clipboard clear +} -body { clipboard append "Test" selection clear -s CLIPBOARD - list [catch {clipboard get} msg] $msg -} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}} -test clipboard-4.2 {ClipboardLostSel procedure} { + clipboard get +} -cleanup { + clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "STRING" not defined} +test clipboard-4.2 {ClipboardLostSel procedure} -setup { + clipboard clear +} -body { + clipboard append "Test" + clipboard append -t TEST "Test2" + selection clear -s CLIPBOARD + clipboard get +} -cleanup { + clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "STRING" not defined} +test clipboard-4.3 {ClipboardLostSel procedure} -setup { clipboard clear +} -body { clipboard append "Test" clipboard append -t TEST "Test2" selection clear -s CLIPBOARD - list [catch {clipboard get} msg] $msg \ - [catch {clipboard get -t TEST} msg] $msg -} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} -test clipboard-4.3 {ClipboardLostSel procedure} { + catch {clipboard get} + clipboard get -t TEST +} -cleanup { + clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "TEST" not defined} +test clipboard-4.4 {ClipboardLostSel procedure} -setup { + clipboard clear +} -body { + clipboard append "Test" + clipboard append -t TEST "Test2" + clipboard append "Test3" + selection clear -s CLIPBOARD + clipboard get +} -cleanup { clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "STRING" not defined} +test clipboard-4.5 {ClipboardLostSel procedure} -setup { + clipboard clear +} -body { clipboard append "Test" clipboard append -t TEST "Test2" clipboard append "Test3" selection clear -s CLIPBOARD - list [catch {clipboard get} msg] $msg \ - [catch {clipboard get -t TEST} msg] $msg -} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} + catch {clipboard get} + clipboard get -t TEST +} -cleanup { + clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "TEST" not defined} + + ############################################################################## -test clipboard-5.1 {Tk_ClipboardClear procedure} { +test clipboard-5.1 {Tk_ClipboardClear procedure} -setup { clipboard clear +} -body { clipboard append -t TEST "test" set result [lsort [clipboard get TARGETS]] clipboard clear list $result [lsort [clipboard get TARGETS]] -} {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test clipboard-5.2 {Tk_ClipboardClear procedure} { +} -cleanup { clipboard clear +} -result {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} +test clipboard-5.2 {Tk_ClipboardClear procedure} -setup { + clipboard clear +} -body { clipboard append -t TEST "test" set result [lsort [clipboard get TARGETS]] selection own -s CLIPBOARD . @@ -148,97 +214,148 @@ test clipboard-5.2 {Tk_ClipboardClear procedure} { clipboard clear clipboard append -t TEST "test" lappend result [lsort [clipboard get TARGETS]] -} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} +} -cleanup { + clipboard clear +} -result {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} ############################################################################## -test clipboard-6.1 {Tk_ClipboardAppend procedure} { +test clipboard-6.1 {Tk_ClipboardAppend procedure} -setup { clipboard clear +} -body { clipboard append "first chunk" selection own -s CLIPBOARD . - list [catch { clipboard append " second chunk" clipboard get - } msg] $msg -} {0 {first chunk second chunk}} -test clipboard-6.2 {Tk_ClipboardAppend procedure} unix { - setupbg +} -cleanup { + clipboard clear +} -returnCodes ok -result {first chunk second chunk} +test clipboard-6.2 {Tk_ClipboardAppend procedure} -constraints unix -setup { clipboard clear +} -body { + setupbg clipboard append -f INTEGER -t TEST "16" set result [dobg {clipboard get TEST}] + return $result +} -cleanup { + clipboard clear cleanupbg - set result -} {0x10 } -test clipboard-6.3 {Tk_ClipboardAppend procedure} { +} -result {0x10 } +test clipboard-6.3 {Tk_ClipboardAppend procedure} -setup { clipboard clear +} -body { clipboard append -f INTEGER -t TEST "16" - list [catch {clipboard append -t TEST "test"} msg] $msg -} {1 {format "STRING" does not match current format "INTEGER" for TEST}} + clipboard append -t TEST "test" +} -cleanup { + clipboard clear +} -returnCodes error -result {format "STRING" does not match current format "INTEGER" for TEST} ############################################################################## -test clipboard-7.1 {Tk_ClipboardCmd procedure} { - list [catch {clipboard} msg] $msg -} {1 {wrong # args: should be "clipboard option ?arg arg ...?"}} -test clipboard-7.2 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append --} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} --} -test clipboard-7.3 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append -- information} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} information} -test clipboard-7.4 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append --x a b} msg] $msg -} {1 {bad option "--x": must be -displayof, -format, or -type}} -test clipboard-7.5 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append -- a b} msg] $msg -} {1 {wrong # args: should be "clipboard append ?options? data"}} -test clipboard-7.6 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append -format} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} -format} -test clipboard-7.7 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append -displayofoo f} msg] $msg -} {1 {bad option "-displayofoo": must be -displayof, -format, or -type}} -test clipboard-7.8 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append -type TEST} msg] $msg -} {1 {wrong # args: should be "clipboard append ?options? data"}} -test clipboard-7.9 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append -displayof foo "test"} msg] $msg -} {1 {bad window path name "foo"}} - -test clipboard-7.10 {Tk_ClipboardCmd procedure} { - list [catch {clipboard clear -displayof} msg] $msg -} {1 {wrong # args: should be "clipboard clear ?-displayof window?"}} -test clipboard-7.11 {Tk_ClipboardCmd procedure} { - list [catch {clipboard clear -displayofoo f} msg] $msg -} {1 {bad option "-displayofoo": must be -displayof}} -test clipboard-7.12 {Tk_ClipboardCmd procedure} { - list [catch {clipboard clear foo} msg] $msg -} {1 {wrong # args: should be "clipboard clear ?-displayof window?"}} -test clipboard-7.13 {Tk_ClipboardCmd procedure} { - list [catch {clipboard clear -displayof foo} msg] $msg -} {1 {bad window path name "foo"}} - -test clipboard-7.14 {Tk_ClipboardCmd procedure} { - list [catch {clipboard error} msg] $msg -} {1 {bad option "error": must be append, clear, or get}} - -test clipboard-7.15 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append -displayof} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} -displayof} -test clipboard-7.16 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append -type} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} -type} - +test clipboard-7.1 {Tk_ClipboardCmd procedure} -body { + clipboard +} -returnCodes error -result {wrong # args: should be "clipboard option ?arg ...?"} +test clipboard-7.2 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -- +} -cleanup { + clipboard clear +} -returnCodes ok -result {} +test clipboard-7.3 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -- + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {--} +test clipboard-7.4 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -- information + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {information} +test clipboard-7.5 {Tk_ClipboardCmd procedure} -body { + clipboard append --x a b +} -returnCodes error -result {bad option "--x": must be -displayof, -format, or -type} +test clipboard-7.6 {Tk_ClipboardCmd procedure} -body { + clipboard append -- a b +} -returnCodes error -result {wrong # args: should be "clipboard append ?-option value ...? data"} +test clipboard-7.7 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -format +} -returnCodes ok -result {} +test clipboard-7.8 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -format + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {-format} +test clipboard-7.9 {Tk_ClipboardCmd procedure} -body { + clipboard append -displayofoo f +} -returnCodes error -result {bad option "-displayofoo": must be -displayof, -format, or -type} +test clipboard-7.10 {Tk_ClipboardCmd procedure} -body { + clipboard append -type TEST +} -returnCodes error -result {wrong # args: should be "clipboard append ?-option value ...? data"} +test clipboard-7.11 {Tk_ClipboardCmd procedure} -body { + clipboard append -displayof foo "test" +} -returnCodes error -result {bad window path name "foo"} +test clipboard-7.12 {Tk_ClipboardCmd procedure} -body { + clipboard clear -displayof +} -returnCodes error -result {wrong # args: should be "clipboard clear ?-displayof window?"} +test clipboard-7.13 {Tk_ClipboardCmd procedure} -body { + clipboard clear -displayofoo f +} -returnCodes error -result {bad option "-displayofoo": must be -displayof} +test clipboard-7.14 {Tk_ClipboardCmd procedure} -body { + clipboard clear foo +} -returnCodes error -result {wrong # args: should be "clipboard clear ?-displayof window?"} +test clipboard-7.15 {Tk_ClipboardCmd procedure} -body { + clipboard clear -displayof foo +} -returnCodes error -result {bad window path name "foo"} +test clipboard-7.16 {Tk_ClipboardCmd procedure} -body { + clipboard error +} -returnCodes error -result {bad option "error": must be append, clear, or get} +test clipboard-7.17 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -displayof +} -cleanup { + clipboard clear +} -returnCodes ok -result {} +test clipboard-7.18 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -displayof + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {-displayof} +test clipboard-7.19 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -type +} -cleanup { + clipboard clear +} -returnCodes ok -result {} +test clipboard-7.20 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -type + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {-type} + # cleanup cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/clrpick.test b/tests/clrpick.test index 8b3769e..5f1b8b5 100644 --- a/tests/clrpick.test +++ b/tests/clrpick.test @@ -5,9 +5,10 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test if {[testConstraint defaultPseudocolor8]} { # let's soak up a bunch of colors...so that @@ -43,51 +44,54 @@ if {[testConstraint defaultPseudocolor8]} { testConstraint colorsLeftover 0 } -test clrpick-1.1 {tk_chooseColor command} { - list [catch {tk_chooseColor -foo} msg] $msg -} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}} - -catch {tk_chooseColor -foo 1} msg -regsub -all , $msg "" options -regsub \"-foo\" $options "" options - -foreach option $options { - if {[string index $option 0] eq "-"} { - test clrpick-1.2$option {tk_chooseColor command} -body { - tk_chooseColor $option - } -returnCodes error -result "value for \"$option\" missing" - } -} - -test clrpick-1.3 {tk_chooseColor command} { - list [catch {tk_chooseColor -foo bar} msg] $msg -} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}} -test clrpick-1.4 {tk_chooseColor command} { - list [catch {tk_chooseColor -initialcolor} msg] $msg -} {1 {value for "-initialcolor" missing}} -test clrpick-1.5 {tk_chooseColor command} { - list [catch {tk_chooseColor -parent foo.bar} msg] $msg -} {1 {bad window path name "foo.bar"}} -test clrpick-1.6 {tk_chooseColor command} { - list [catch {tk_chooseColor -initialcolor badbadbaadcolor} msg] $msg -} {1 {unknown color name "badbadbaadcolor"}} -test clrpick-1.7 {tk_chooseColor command} { - list [catch {tk_chooseColor -initialcolor ##badbadbaadcolor} msg] $msg -} {1 {invalid color name "##badbadbaadcolor"}} - +test clrpick-1.1 {tk_chooseColor command} -body { + tk_chooseColor -foo +} -returnCodes error -result {bad option "-foo": must be -initialcolor, -parent, or -title} + +test clrpick-1.2 {tk_chooseColor command } -body { + tk_chooseColor -initialcolor +} -returnCodes error -result {value for "-initialcolor" missing} +test clrpick-1.2.1 {tk_chooseColor command } -body { + tk_chooseColor -parent +} -returnCodes error -result {value for "-parent" missing} +test clrpick-1.2.2 {tk_chooseColor command } -body { + tk_chooseColor -title +} -returnCodes error -result {value for "-title" missing} + +test clrpick-1.3 {tk_chooseColor command} -body { + tk_chooseColor -foo bar +} -returnCodes error -result {bad option "-foo": must be -initialcolor, -parent, or -title} +test clrpick-1.4 {tk_chooseColor command} -body { + tk_chooseColor -initialcolor +} -returnCodes error -result {value for "-initialcolor" missing} +test clrpick-1.5 {tk_chooseColor command} -body { + tk_chooseColor -parent foo.bar +} -returnCodes error -result {bad window path name "foo.bar"} +test clrpick-1.6 {tk_chooseColor command} -body { + tk_chooseColor -initialcolor badbadbaadcolor +} -returnCodes error -result {unknown color name "badbadbaadcolor"} +test clrpick-1.7 {tk_chooseColor command} -body { + tk_chooseColor -initialcolor ##badbadbaadcolor +} -returnCodes error -result {invalid color name "##badbadbaadcolor"} + + +# tests 3.1 and 3.2 fail when individually run +# if there is no catch {tk_chooseColor -foo 1} msg +# before settin isNative +catch {tk_chooseColor -foo 1} msg set isNative [expr {[info commands tk::dialog::color::] eq ""}] proc ToPressButton {parent btn} { global isNative if {!$isNative} { - after 200 "SendButtonPress $parent $btn mouse" + after 200 "SendButtonPress . $btn mouse" } } proc ToChooseColorByKey {parent r g b} { global isNative if {!$isNative} { - after 200 ChooseColorByKey $parent $r $g $b + after 200 ChooseColorByKey . $r $g $b } } @@ -115,7 +119,7 @@ proc ChooseColorByKey {parent r g b} { # the values for us. tk::dialog::color::HandleRGBEntry $w - SendButtonPress $parent ok mouse + SendButtonPress . ok mouse } proc SendButtonPress {parent btn type} { @@ -137,65 +141,76 @@ proc SendButtonPress {parent btn type} { } } -set parent . - -set verylongstring longstring: -set verylongstring $verylongstring$verylongstring -set verylongstring $verylongstring$verylongstring -set verylongstring $verylongstring$verylongstring -set verylongstring $verylongstring$verylongstring -#set verylongstring $verylongstring$verylongstring -# Interesting thing...when this is too long, the -# delay caused in processing it kills the automated testing, -# and makes a lot of the test cases fail. -#set verylongstring $verylongstring$verylongstring -#set verylongstring $verylongstring$verylongstring -#set verylongstring $verylongstring$verylongstring -#set verylongstring $verylongstring$verylongstring - -set color #404040 -test clrpick-2.1 {tk_chooseColor command} \ - {nonUnixUserInteraction colorsLeftover} { - ToPressButton $parent ok - tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color \ - -parent $parent -} "$color" -set color #808040 -test clrpick-2.2 {tk_chooseColor command} \ - {nonUnixUserInteraction colorsLeftover} { + + +test clrpick-2.1 {tk_chooseColor command} -constraints { + nonUnixUserInteraction colorsLeftover +} -setup { + set verylongstring longstring: + set verylongstring $verylongstring$verylongstring + set verylongstring $verylongstring$verylongstring + set verylongstring $verylongstring$verylongstring + set verylongstring $verylongstring$verylongstring + #set verylongstring $verylongstring$verylongstring + # Interesting thing...when this is too long, the + # delay caused in processing it kills the automated testing, + # and makes a lot of the test cases fail. + #set verylongstring $verylongstring$verylongstring + #set verylongstring $verylongstring$verylongstring + #set verylongstring $verylongstring$verylongstring + #set verylongstring $verylongstring$verylongstring +} -body { + ToPressButton . ok + tk_chooseColor -title "Press Ok $verylongstring" -initialcolor #404040 \ + -parent . +} -result {#404040} +test clrpick-2.2 {tk_chooseColor command} -constraints { + nonUnixUserInteraction colorsLeftover +} -body { set colors "128 128 64" - ToChooseColorByKey $parent 128 128 64 - tk_chooseColor -parent $parent -title "choose $colors" -} "$color" -test clrpick-2.3 {tk_chooseColor command} \ - {nonUnixUserInteraction colorsLeftover} { - ToPressButton $parent ok - tk_chooseColor -parent $parent -title "Press OK" -} "$color" -test clrpick-2.4 {tk_chooseColor command} {nonUnixUserInteraction} { - ToPressButton $parent cancel - tk_chooseColor -parent $parent -title "Press Cancel" -} "" - -set color "#000000" -test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} { + ToChooseColorByKey . 128 128 64 + tk_chooseColor -parent . -title "choose #808040" +} -result {#808040} +test clrpick-2.3 {tk_chooseColor command} -constraints { + nonUnixUserInteraction colorsLeftover +} -body { + ToPressButton . ok + tk_chooseColor -parent . -title "Press OK" +} -result {#808040} +test clrpick-2.4 {tk_chooseColor command} -constraints { + nonUnixUserInteraction colorsLeftover +} -body { + ToPressButton . cancel + tk_chooseColor -parent . -title "Press Cancel" +} -result {} + + +test clrpick-3.1 {tk_chooseColor: background events} -constraints { + nonUnixUserInteraction +} -body { after 1 {set x 53} - ToPressButton $parent ok - tk_chooseColor -parent $parent -title "Press OK" -initialcolor $color -} "#000000" -test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} { + ToPressButton . ok + tk_chooseColor -parent . -title "Press OK" -initialcolor #000000 +} -result {#000000} +test clrpick-3.2 {tk_chooseColor: background events} -constraints { + nonUnixUserInteraction +} -body { after 1 {set x 53} - ToPressButton $parent cancel - tk_chooseColor -parent $parent -title "Press Cancel" -} "" + ToPressButton . cancel + tk_chooseColor -parent . -title "Press Cancel" +} -result {} -test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} {unix notAqua} { + +test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} -constraints { + unix notAqua +} -body { after 50 {set ::scr [winfo screen .__tk__color]} - ToPressButton $parent cancel - tk_chooseColor -parent $parent + ToPressButton . cancel + tk_chooseColor -parent . set ::scr -} [winfo screen $parent] +} -result [winfo screen .] # cleanup cleanupTests return + diff --git a/tests/cmds.test b/tests/cmds.test index f630209..fa7e788 100644 --- a/tests/cmds.test +++ b/tests/cmds.test @@ -5,38 +5,56 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test update -test cmds-1.1 {tkwait visibility, argument errors} { - list [catch {tkwait visibility} msg] $msg -} {1 {wrong # args: should be "tkwait variable|visibility|window name"}} -test cmds-1.2 {tkwait visibility, argument errors} { - list [catch {tkwait visibility foo bar} msg] $msg -} {1 {wrong # args: should be "tkwait variable|visibility|window name"}} -test cmds-1.3 {tkwait visibility, argument errors} { - list [catch {tkwait visibility bad_window} msg] $msg -} {1 {bad window path name "bad_window"}} -test cmds-1.4 {tkwait visibility, waiting for window to be mapped} { +test cmds-1.1 {tkwait visibility, argument errors} -body { + tkwait visibility +} -returnCodes {error} -result {wrong # args: should be "tkwait variable|visibility|window name"} +test cmds-1.2 {tkwait visibility, argument errors} -body { + tkwait visibility foo bar +} -returnCodes {error} -result {wrong # args: should be "tkwait variable|visibility|window name"} +test cmds-1.3 {tkwait visibility, argument errors} -body { + tkwait visibility bad_window +} -returnCodes {error} -result {bad window path name "bad_window"} +test cmds-1.4 {tkwait visibility, waiting for window to be mapped} -setup { button .b -text "Test" set x init +} -body { after 100 {set x delay; place .b -x 0 -y 0} tkwait visibility .b + return $x +} -cleanup { destroy .b - set x -} {delay} -test cmds-1.5 {tkwait visibility, window gets deleted} { +} -result {delay} +test cmds-1.5 {tkwait visibility, window gets deleted} -setup { frame .f button .f.b -text "Test" pack .f.b set x init +} -body { after 100 {set x deleted; destroy .f} - list [catch {tkwait visibility .f.b} msg] $msg $x -} {1 {window ".f.b" was deleted before its visibility changed} deleted} + tkwait visibility .f.b +} -returnCodes {error} -result {window ".f.b" was deleted before its visibility changed} +test cmds-1.6 {tkwait visibility, window gets deleted} -setup { + frame .f + button .f.b -text "Test" + pack .f.b + set x init +} -body { + after 100 {set x deleted; destroy .f} + catch {tkwait visibility .f.b} + return $x +} -cleanup { + destroy .f +} -result {deleted} + # cleanup cleanupTests return + diff --git a/tests/config.test b/tests/config.test index 0d1e0e1..a0c1921 100644 --- a/tests/config.test +++ b/tests/config.test @@ -6,7 +6,8 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands @@ -14,436 +15,1038 @@ proc killTables {} { # Note: it's important to delete chain2 before chain1, because # chain2 depends on chain1. If chain1 is deleted first, the # delete of chain2 will crash. - - foreach t {alltypes chain2 chain1 configerror internal new notenoughparams - twowindows} { - while {[testobjconfig info $t] != ""} { - testobjconfig delete $t - } + deleteWindows + foreach t {alltypes chain3 chain2 chain1 configerror internal + new notenoughparams twowindows} { + while {[testobjconfig info $t] != ""} { + testobjconfig delete $t + } } } + +option clear +deleteWindows if {[testConstraint testobjconfig]} { killTables } -test config-1.1 {Tk_CreateOptionTable - reference counts} testobjconfig { - deleteWindows - killTables +test config-1.1 {Tk_CreateOptionTable - reference counts} -constraints { + testobjconfig +} -body { set x {} testobjconfig alltypes .a lappend x [testobjconfig info alltypes] testobjconfig alltypes .b lappend x [testobjconfig info alltypes] - deleteWindows set x -} {{1 16 -boolean} {2 16 -boolean}} -test config-1.2 {Tk_CreateOptionTable - synonym initialization} testobjconfig { - deleteWindows +} -cleanup { + killTables +} -result {{1 16 -boolean} {2 16 -boolean}} +test config-1.2 {Tk_CreateOptionTable - synonym initialization} -constraints { + testobjconfig +} -body { testobjconfig alltypes .a -synonym green .a cget -color -} {green} -test config-1.3 {Tk_CreateOptionTable - option database initialization} testobjconfig { - deleteWindows - option clear +} -cleanup { + killTables +} -result {green} +test config-1.3 {Tk_CreateOptionTable - option database initialization} -constraints { + testobjconfig +} -body { testobjconfig alltypes .a option add *b.string different testobjconfig alltypes .b list [.a cget -string] [.b cget -string] -} {foo different} -test config-1.4 {Tk_CreateOptionTable - option database initialization} testobjconfig { - deleteWindows +} -cleanup { + killTables option clear +} -result {foo different} +test config-1.4 {Tk_CreateOptionTable - option database initialization} -constraints { + testobjconfig +} -body { testobjconfig alltypes .a option add *b.String bar testobjconfig alltypes .b list [.a cget -string] [.b cget -string] -} {foo bar} -test config-1.5 {Tk_CreateOptionTable - default initialization} testobjconfig { - deleteWindows +} -cleanup { + killTables + option clear +} -result {foo bar} +test config-1.5 {Tk_CreateOptionTable - default initialization} -constraints { + testobjconfig +} -body { testobjconfig alltypes .a .a cget -relief -} {raised} -test config-1.6 {Tk_CreateOptionTable - chained tables} testobjconfig { - deleteWindows +} -cleanup { killTables +} -result {raised} +test config-1.6 {Tk_CreateOptionTable - chained tables} -constraints { + testobjconfig +} -body { testobjconfig chain1 .a testobjconfig chain2 .b testobjconfig info chain2 -} {1 4 -three 2 2 -one} -test config-1.7 {Tk_CreateOptionTable - chained tables} testobjconfig { - deleteWindows +} -cleanup { killTables +} -result {1 4 -three 2 2 -one} +test config-1.7 {Tk_CreateOptionTable - chained tables} -constraints { + testobjconfig +} -body { testobjconfig chain2 .b testobjconfig chain1 .a testobjconfig info chain2 -} {1 4 -three 2 2 -one} -test config-1.8 {Tk_CreateOptionTable - chained tables} testobjconfig { - deleteWindows +} -cleanup { + killTables +} -result {1 4 -three 2 2 -one} +test config-1.8 {Tk_CreateOptionTable - chained tables} -constraints { + testobjconfig +} -body { testobjconfig chain1 .a testobjconfig chain2 .b - list [catch {.a cget -four} msg] $msg [.a cget -one] \ - [.b cget -four] [.b cget -one] -} {1 {unknown option "-four"} one four one} - -test config-2.1 {Tk_DeleteOptionTable - reference counts} testobjconfig { - deleteWindows + .a cget -four +} -cleanup { killTables +} -returnCodes error -result {unknown option "-four"} +test config-1.9 {Tk_CreateOptionTable - chained tables} -constraints { + testobjconfig +} -body { testobjconfig chain1 .a testobjconfig chain2 .b - testobjconfig chain2 .c - deleteWindows + catch {.a cget -four} + list [.a cget -one] [.b cget -four] [.b cget -one] +} -cleanup { + killTables +} -result {one four one} + + +test config-2.1 {Tk_DeleteOptionTable - reference counts} -constraints { + testobjconfig +} -body { set x {} - testobjconfig delete chain2 + testobjconfig chain1 .a + testobjconfig chain2 .b + testobjconfig chain3 .c + deleteWindows + testobjconfig delete chain3 lappend x [testobjconfig info chain2] [testobjconfig info chain1] testobjconfig delete chain2 lappend x [testobjconfig info chain2] [testobjconfig info chain1] -} {{1 4 -three 2 2 -one} {2 2 -one} {} {1 2 -one}} +} -cleanup { + killTables +} -result {{3 4 -three 2 2 -one} {2 2 -one} {} {2 2 -one}} # No tests for DestroyOptionHashTable; couldn't figure out how to test. -test config-3.1 {Tk_InitOptions - priority of chained tables} testobjconfig { - deleteWindows +test config-3.1 {Tk_InitOptions - priority of chained tables} -constraints { + testobjconfig +} -body { testobjconfig chain1 .a testobjconfig chain2 .b list [.a cget -two] [.b cget -two] -} {two {two and a half}} -test config-3.2 {Tk_InitOptions - initialize from database} testobjconfig { - deleteWindows - option clear +} -cleanup { + killTables +} -result {two {two and a half}} +test config-3.2 {Tk_InitOptions - initialize from database} -constraints { + testobjconfig +} -body { option add *a.color blue testobjconfig alltypes .a list [.a cget -color] -} {blue} -test config-3.3 {Tk_InitOptions - initialize from database} testobjconfig { - deleteWindows +} -cleanup { + killTables option clear +} -result {blue} +test config-3.3 {Tk_InitOptions - initialize from database} -constraints { + testobjconfig +} -body { option add *a.justify bogus testobjconfig alltypes .a list [.a cget -justify] -} {left} -test config-3.4 {Tk_InitOptions - initialize from widget class} testobjconfig { - deleteWindows +} -cleanup { + killTables + option clear +} -result {left} +test config-3.4 {Tk_InitOptions - initialize from widget class} -constraints { + testobjconfig +} -body { testobjconfig alltypes .a list [.a cget -color] -} {red} -test config-3.5 {Tk_InitOptions - no initial value} testobjconfig { - deleteWindows +} -cleanup { + killTables +} -result {red} +test config-3.5 {Tk_InitOptions - no initial value} -constraints { + testobjconfig +} -body { testobjconfig alltypes .a .a cget -anchor -} {} -test config-3.6 {Tk_InitOptions - bad initial value} testobjconfig { - deleteWindows +} -cleanup { + killTables +} -result {} +test config-3.6 {Tk_InitOptions - bad initial value} -constraints { + testobjconfig +} -body { + option add *a.color non-existent + testobjconfig alltypes .a +} -cleanup { + killTables option clear +} -returnCodes error -result {unknown color name "non-existent"} +test config-3.7 {Tk_InitOptions - bad initial value} -constraints { + testobjconfig +} -body { option add *a.color non-existent - list [catch {testobjconfig alltypes .a} msg] $msg $errorInfo -} {1 {unknown color name "non-existent"} {unknown color name "non-existent" + catch {testobjconfig alltypes .a} + return $errorInfo +} -cleanup { + killTables + option clear +} -result {unknown color name "non-existent" (database entry for "-color" in widget ".a") invoked from within -"testobjconfig alltypes .a"}} -option clear -test config-3.7 {Tk_InitOptions - bad initial value} testobjconfig { - deleteWindows - list [catch {testobjconfig configerror} msg] $msg $errorInfo -} {1 {expected integer but got "bogus"} {expected integer but got "bogus" +"testobjconfig alltypes .a"} + +test config-3.8 {Tk_InitOptions - bad initial value} -constraints { + testobjconfig +} -body { + testobjconfig configerror +} -returnCodes error -result {expected integer but got "bogus"} +test config-3.9 {Tk_InitOptions - bad initial value} -constraints { + testobjconfig +} -body { + catch {testobjconfig configerror} + return $errorInfo +} -result {expected integer but got "bogus" (default value for "-int") invoked from within -"testobjconfig configerror"}} -option clear +"testobjconfig configerror"} -test config-4.1 {DoObjConfig - boolean} testobjconfig { +test config-4.1 {DoObjConfig - boolean} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -boolean 0 +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.2 {DoObjConfig - boolean} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -boolean 0 + .foo cget -boolean +} -cleanup { + killTables +} -returnCodes ok -result {0} +test config-4.3 {DoObjConfig - boolean} -constraints testobjconfig -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -boolean 0} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}] -} {0 .foo 0 0 0} -test config-4.2 {DoObjConfig - boolean} testobjconfig { +} -body { + testobjconfig alltypes .foo -boolean 0 + .foo cget -boolean + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok +test config-4.4 {DoObjConfig - boolean} -constraints testobjconfig -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -boolean 1} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}] -} {0 .foo 0 1 0} -test config-4.3 {DoObjConfig - invalid boolean} testobjconfig { +} -body { + testobjconfig alltypes .foo -boolean 1 +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.5 {DoObjConfig - boolean} -constraints testobjconfig -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -boolean {}} msg] $msg -} {1 {expected boolean value but got ""}} -test config-4.4 {DoObjConfig - boolean internal value} testobjconfig { +} -body { + testobjconfig alltypes .foo -boolean 1 + .foo cget -boolean +} -cleanup { + killTables +} -returnCodes ok -result {1} +test config-4.6 {DoObjConfig - boolean} -constraints testobjconfig -setup { catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -boolean 1 + .foo cget -boolean + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok +test config-4.7 {DoObjConfig - invalid boolean} -constraints { + testobjconfig +} -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -boolean {} +} -cleanup { + killTables +} -returnCodes error -result {expected boolean value but got ""} +test config-4.8 {DoObjConfig - boolean internal value} -constraints { + testobjconfig +} -setup { + catch {rename .foo {}} +} -body { testobjconfig internal .foo -boolean 0 .foo cget -boolean -} {0} -test config-4.5 {DoObjConfig - integer} testobjconfig { +} -cleanup { + killTables +} -result {0} + +test config-4.9 {DoObjConfig - integer} -constraints testobjconfig -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -integer 3} msg] $msg [catch {.foo cget -integer} result] $result [catch {rename .foo {}}] -} {0 .foo 0 3 0} -test config-4.6 {DoObjConfig - invalid integer} testobjconfig { +} -body { + testobjconfig alltypes .foo -integer 3 +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.10 {DoObjConfig - integer} -constraints testobjconfig -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -integer bar} msg] $msg -} {1 {expected integer but got "bar"}} -test config-4.7 {DoObjConfig - integer internal value} testobjconfig { +} -body { + testobjconfig alltypes .foo -integer 3 + .foo cget -integer +} -cleanup { + killTables +} -returnCodes ok -result {3} +test config-4.11 {DoObjConfig - integer} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -integer 3 + .foo cget -integer + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok +test config-4.12 {DoObjConfig - invalid integer} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -integer bar +} -cleanup { + killTables +} -cleanup { + killTables +} -returnCodes error -result {expected integer but got "bar"} +test config-4.13 {DoObjConfig - integer internal value} -constraints { + testobjconfig +} -setup { + catch {rename .foo {}} +} -body { testobjconfig internal .foo -integer 421 .foo cget -integer -} {421} -test config-4.8 {DoObjConfig - double} testobjconfig { +} -cleanup { + killTables +} -result {421} + +test config-4.14 {DoObjConfig - double} -constraints testobjconfig -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -double 3.14} msg] $msg [catch {.foo cget -double} result] $result [catch {rename .foo {}}] -} {0 .foo 0 3.14 0} -test config-4.9 {DoObjConfig - invalid double} testobjconfig { +} -body { + testobjconfig alltypes .foo -double 3.14 +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.15 {DoObjConfig - double} -constraints testobjconfig -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -double bar} msg] $msg -} {1 {expected floating-point number but got "bar"}} -test config-4.10 {DoObjConfig - double internal value} testobjconfig { +} -body { + testobjconfig alltypes .foo -double 3.14 + .foo cget -double +} -cleanup { + killTables +} -returnCodes ok -result {3.14} +test config-4.16 {DoObjConfig - double} -constraints testobjconfig -setup { catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -double 3.14 + .foo cget -double + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok +test config-4.17 {DoObjConfig - invalid double} -constraints { + testobjconfig +} -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -double bar +} -cleanup { + killTables +} -returnCodes error -result {expected floating-point number but got "bar"} +test config-4.18 {DoObjConfig - double internal value} -constraints { + testobjconfig +} -setup { + catch {rename .foo {}} +} -body { testobjconfig internal .foo -double 62.75 .foo cget -double -} {62.75} -test config-4.11 {DoObjConfig - string} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -string test} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo] -} {0 .foo 0 test {}} -test config-4.12 {DoObjConfig - null string} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -string {}} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo] -} {0 .foo 0 {} {}} -test config-4.13 {DoObjConfig - string internal value} testobjconfig { +} -cleanup { + killTables +} -result {62.75} + +test config-4.19 {DoObjConfig - string} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -string test +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.20 {DoObjConfig - string} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -string test + .foo cget -string +} -cleanup { + killTables +} -returnCodes ok -result {test} +test config-4.21 {DoObjConfig - string} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -string test + .foo cget -string + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok +test config-4.22 {DoObjConfig - null string} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -string {} +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.23 {DoObjConfig - null string} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -string {} + .foo cget -string +} -cleanup { + killTables +} -returnCodes ok -result {} +test config-4.24 {DoObjConfig - null string} -constraints testobjconfig -setup { catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -string {} + .foo cget -string + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok + +test config-4.25 {DoObjConfig - string internal value} -constraints { + testobjconfig +} -setup { + catch {rename .foo {}} +} -body { testobjconfig internal .foo -string "this is a test" .foo cget -string -} {this is a test} -test config-4.14 {DoObjConfig - string table} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -stringtable two} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo] -} {0 .foo 0 two {}} -test config-4.15 {DoObjConfig - invalid string table} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -stringtable foo} msg] $msg -} {1 {bad stringtable "foo": must be one, two, three, or four}} -test config-4.16 {DoObjConfig - new string table} testobjconfig { - catch {destroy .foo} +} -cleanup { + killTables +} -result {this is a test} + +test config-4.26 {DoObjConfig - string table} -constraints testobjconfig -body { + testobjconfig alltypes .foo -stringtable two +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.27 {DoObjConfig - string table} -constraints testobjconfig -body { + testobjconfig alltypes .foo -stringtable two + .foo cget -stringtable +} -cleanup { + killTables +} -returnCodes ok -result {two} +test config-4.28 {DoObjConfig - string table} -constraints testobjconfig -body { testobjconfig alltypes .foo -stringtable two - list [catch {.foo configure -stringtable three} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo] -} {0 16 0 three {}} -test config-4.17 {DoObjConfig - stringtable internal value} testobjconfig { + .foo cget -stringtable + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok +test config-4.29 {DoObjConfig - invalid string table} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -stringtable foo +} -cleanup { + killTables +} -returnCodes error -result {bad stringtable "foo": must be one, two, three, or four} + +test config-4.30 {DoObjConfig - new string table} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -stringtable two + .foo configure -stringtable three +} -cleanup { + killTables +} -returnCodes ok -result {16} +test config-4.31 {DoObjConfig - new string table} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -stringtable two + .foo configure -stringtable three + .foo cget -stringtable +} -cleanup { + killTables +} -returnCodes ok -result {three} +test config-4.32 {DoObjConfig - new string table} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -stringtable two + .foo configure -stringtable three + .foo cget -stringtable + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok +test config-4.33 {DoObjConfig - stringtable internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -stringtable "four" .foo cget -stringtable -} {four} -test config-4.18 {DoObjConfig - color} testobjconfig { - catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -color blue} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo] -} {0 .foo 0 blue {}} -test config-4.19 {DoObjConfig - invalid color} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -color xxx} msg] $msg -} {1 {unknown color name "xxx"}} -test config-4.20 {DoObjConfig - color internal value} testobjconfig { +} -cleanup { + killTables +} -result {four} + +test config-4.34 {DoObjConfig - color} -constraints testobjconfig -body { + testobjconfig alltypes .foo -color blue +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.35 {DoObjConfig - color} -constraints testobjconfig -body { + testobjconfig alltypes .foo -color blue + .foo cget -color +} -cleanup { + killTables +} -returnCodes ok -result {blue} +test config-4.36 {DoObjConfig - color} -constraints testobjconfig -body { + testobjconfig alltypes .foo -color blue + .foo cget -color + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok +test config-4.37 {DoObjConfig - invalid color} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -color xxx +} -cleanup { + killTables +} -returnCodes error -result {unknown color name "xxx"} +test config-4.38 {DoObjConfig - color internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -color purple .foo cget -color -} {purple} -test config-4.21 {DoObjConfig - null color} testobjconfig { - catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -color {}} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo] -} {0 .foo 0 {} {}} -test config-4.22 {DoObjConfig - getting rid of old color} testobjconfig { - catch {destroy .foo} +} -cleanup { + killTables +} -result {purple} + +test config-4.39 {DoObjConfig - null color} -constraints testobjconfig -body { + testobjconfig alltypes .foo -color {} +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.40 {DoObjConfig - null color} -constraints testobjconfig -body { + testobjconfig alltypes .foo -color {} + .foo cget -color +} -cleanup { + killTables +} -returnCodes ok -result {} +test config-4.41 {DoObjConfig - null color} -constraints testobjconfig -body { + testobjconfig alltypes .foo -color {} + .foo cget -color + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok +test config-4.42 {DoObjConfig - getting rid of old color} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo -color #333333 - list [catch {.foo configure -color #444444} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo] -} {0 32 0 #444444 {}} -test config-4.23 {DoObjConfig - font} testobjconfig { + .foo configure -color #444444 +} -cleanup { + killTables +} -returnCodes ok -result {32} +test config-4.43 {DoObjConfig - getting rid of old color} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -color #333333 + .foo configure -color #444444 + .foo cget -color +} -cleanup { + killTables +} -returnCodes ok -result {#444444} +test config-4.44 {DoObjConfig - getting rid of old color} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -color #333333 + .foo configure -color #444444 + .foo cget -color + rename .foo {} +} -cleanup { + killTables +} -returnCodes ok + +test config-4.45 {DoObjConfig - font} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -font {Helvetica 72} +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.46 {DoObjConfig - font} -constraints testobjconfig -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo] -} {0 .foo 0 {Helvetica 72} {}} -test config-4.24 {DoObjConfig - new font} testobjconfig { +} -body { + testobjconfig alltypes .foo -font {Helvetica 72} + .foo cget -font +} -cleanup { + killTables +} -returnCodes ok -result {Helvetica 72} +test config-4.47 {DoObjConfig - new font} -constraints testobjconfig -setup { catch {rename .foo {}} +} -body { testobjconfig alltypes .foo -font {Courier 12} - list [catch {.foo configure -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo] -} {0 64 0 {Helvetica 72} {}} -test config-4.25 {DoObjConfig - invalid font} testobjconfig { + .foo configure -font {Helvetica 72} +} -cleanup { + killTables +} -returnCodes ok -result {64} +test config-4.48 {DoObjConfig - new font} -constraints testobjconfig -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -font {Helvetica 12 foo}} msg] $msg -} {1 {unknown font style "foo"}} -test config-4.26 {DoObjConfig - null font} testobjconfig { +} -body { + testobjconfig alltypes .foo -font {Courier 12} + .foo configure -font {Helvetica 72} + .foo cget -font +} -cleanup { + killTables +} -returnCodes ok -result {Helvetica 72} +test config-4.49 {DoObjConfig - invalid font} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -font {}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo] -} {0 .foo 0 {} {}} -test config-4.27 {DoObjConfig - font internal value} testobjconfig { +} -body { + testobjconfig alltypes .foo -font {Helvetica 12 foo} +} -cleanup { + killTables +} -returnCodes error -result {unknown font style "foo"} +test config-4.50 {DoObjConfig - null font} -constraints testobjconfig -setup { catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -font {} +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.51 {DoObjConfig - null font} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -font {} + .foo cget -font +} -cleanup { + killTables +} -returnCodes ok -result {} +test config-4.52 {DoObjConfig - font internal value} -constraints { + testobjconfig +} -setup { + catch {rename .foo {}} +} -body { testobjconfig internal .foo -font {Times 16} .foo cget -font -} {Times 16} -test config-4.28 {DoObjConfig - bitmap} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -bitmap gray75} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo] -} {0 .foo 0 gray75 {}} -test config-4.29 {DoObjConfig - new bitmap} testobjconfig { - catch {destroy .foo} +} -cleanup { + killTables +} -result {Times 16} + +test config-4.53 {DoObjConfig - bitmap} -constraints testobjconfig -body { + testobjconfig alltypes .foo -bitmap gray75 +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.54 {DoObjConfig - bitmap} -constraints testobjconfig -body { testobjconfig alltypes .foo -bitmap gray75 - list [catch {.foo configure -bitmap gray50} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo] -} {0 128 0 gray50 {}} -test config-4.30 {DoObjConfig - invalid bitmap} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -bitmap foo} msg] $msg -} {1 {bitmap "foo" not defined}} -test config-4.31 {DoObjConfig - null bitmap} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -bitmap {}} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo] -} {0 .foo 0 {} {}} -test config-4.32 {DoObjConfig - bitmap internal value} testobjconfig { + .foo cget -bitmap +} -cleanup { + killTables +} -returnCodes ok -result {gray75} +test config-4.55 {DoObjConfig - new bitmap} -constraints testobjconfig -body { + testobjconfig alltypes .foo -bitmap gray75 + .foo configure -bitmap gray50 +} -cleanup { + killTables +} -returnCodes ok -result {128} +test config-4.56 {DoObjConfig - new bitmap} -constraints testobjconfig -body { + testobjconfig alltypes .foo -bitmap gray75 + .foo configure -bitmap gray50 + .foo cget -bitmap +} -cleanup { + killTables +} -returnCodes ok -result {gray50} +test config-4.57 {DoObjConfig - invalid bitmap} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -bitmap foo +} -cleanup { + killTables +} -returnCodes error -result {bitmap "foo" not defined} +test config-4.58 {DoObjConfig - null bitmap} -constraints testobjconfig -body { + testobjconfig alltypes .foo -bitmap {} +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.59 {DoObjConfig - null bitmap} -constraints testobjconfig -body { + testobjconfig alltypes .foo -bitmap {} + .foo cget -bitmap +} -cleanup { + killTables +} -returnCodes ok -result {} +test config-4.60 {DoObjConfig - bitmap internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -bitmap gray25 .foo cget -bitmap -} {gray25} -test config-4.33 {DoObjConfig - border} testobjconfig { - catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -border green} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo] -} {0 .foo 0 green {}} -test config-4.34 {DoObjConfig - invalid border} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -border xxx} msg] $msg -} {1 {unknown color name "xxx"}} -test config-4.35 {DoObjConfig - null border} testobjconfig { - catch {rename .foo {}} - list [catch {testobjconfig alltypes .foo -border {}} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo] -} {0 .foo 0 {} {}} -test config-4.36 {DoObjConfig - border internal value} testobjconfig { +} -cleanup { + killTables +} -result {gray25} + +test config-4.61 {DoObjConfig - border} -constraints testobjconfig -body { + testobjconfig alltypes .foo -border green +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.62 {DoObjConfig - border} -constraints testobjconfig -body { + testobjconfig alltypes .foo -border green + .foo cget -border +} -cleanup { + killTables +} -returnCodes ok -result {green} +test config-4.63 {DoObjConfig - invalid border} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -border xxx +} -cleanup { + killTables +} -returnCodes error -result {unknown color name "xxx"} +test config-4.64 {DoObjConfig - null border} -constraints testobjconfig -body { + testobjconfig alltypes .foo -border {} +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.65 {DoObjConfig - null border} -constraints testobjconfig -body { + testobjconfig alltypes .foo -border {} + .foo cget -border +} -cleanup { + killTables +} -returnCodes ok -result {} +test config-4.66 {DoObjConfig - border internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -border #123456 .foo cget -border -} {#123456} -test config-4.37 {DoObjConfig - getting rid of old border} testobjconfig { - catch {destroy .foo} +} -cleanup { + killTables +} -result {#123456} +test config-4.67 {DoObjConfig - getting rid of old border} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo -border #333333 - list [catch {.foo configure -border #444444} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo] -} {0 256 0 #444444 {}} -test config-4.38 {DoObjConfig - relief} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo] -} {0 .foo 0 flat {}} -test config-4.39 {DoObjConfig - invalid relief} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -relief foo} msg] $msg -} {1 {bad relief "foo": must be flat, groove, raised, ridge, solid, or sunken}} -test config-4.40 {DoObjConfig - new relief} testobjconfig { - catch {destroy .foo} - testobjconfig alltypes .foo -relief raised - list [catch {.foo configure -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo] -} {0 512 0 flat {}} -test config-4.41 {DoObjConfig - relief internal value} testobjconfig { + .foo configure -border #444444 +} -cleanup { + killTables +} -returnCodes ok -result {256} +test config-4.68 {DoObjConfig - getting rid of old border} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -border #333333 + .foo configure -border #444444 + .foo cget -border +} -cleanup { + killTables +} -returnCodes ok -result {#444444} + +test config-4.69 {DoObjConfig - relief} -constraints testobjconfig -body { + testobjconfig alltypes .foo -relief flat +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.70 {DoObjConfig - relief} -constraints testobjconfig -body { + testobjconfig alltypes .foo -relief flat + .foo cget -relief +} -cleanup { + killTables +} -returnCodes ok -result {flat} +test config-4.71 {DoObjConfig - invalid relief} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -relief foo +} -cleanup { + killTables +} -returnCodes error -result {bad relief "foo": must be flat, groove, raised, ridge, solid, or sunken} +test config-4.72 {DoObjConfig - relief internal value} -constraints testobjconfig -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -relief ridge .foo cget -relief -} {ridge} -test config-4.42 {DoObjConfig - cursor} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo] -} {0 .foo 0 arrow {}} -test config-4.43 {DoObjConfig - invalid cursor} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -cursor foo} msg] $msg -} {1 {bad cursor spec "foo"}} -test config-4.44 {DoObjConfig - null cursor} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -cursor {}} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo] -} {0 .foo 0 {} {}} -test config-4.45 {DoObjConfig - new cursor} testobjconfig { - catch {destroy .foo} +} -cleanup { + killTables +} -result {ridge} +test config-4.73 {DoObjConfig - new relief} -constraints testobjconfig -body { + testobjconfig alltypes .foo -relief raised + .foo configure -relief flat +} -cleanup { + killTables +} -returnCodes ok -result {512} +test config-4.74 {DoObjConfig - new relief} -constraints testobjconfig -body { + testobjconfig alltypes .foo -relief raised + .foo configure -relief flat + .foo cget -relief +} -cleanup { + killTables +} -returnCodes ok -result {flat} + +test config-4.75 {DoObjConfig - cursor} -constraints testobjconfig -body { + testobjconfig alltypes .foo -cursor arrow +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.76 {DoObjConfig - cursor} -constraints testobjconfig -body { + testobjconfig alltypes .foo -cursor arrow + .foo cget -cursor +} -cleanup { + killTables +} -returnCodes ok -result {arrow} +test config-4.77 {DoObjConfig - invalid cursor} -constraints testobjconfig -body { + testobjconfig alltypes .foo -cursor foo +} -cleanup { + killTables +} -returnCodes error -result {bad cursor spec "foo"} +test config-4.78 {DoObjConfig - null cursor} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -cursor {} +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.79 {DoObjConfig - null cursor} -constraints testobjconfig -setup { + catch {rename .foo {}} +} -body { + testobjconfig alltypes .foo -cursor {} + .foo cget -cursor +} -cleanup { + killTables +} -returnCodes ok -result {} +test config-4.80 {DoObjConfig - new cursor} -constraints testobjconfig -body { testobjconfig alltypes .foo -cursor xterm - list [catch {.foo configure -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo] -} {0 1024 0 arrow {}} -test config-4.46 {DoObjConfig - cursor internal value} testobjconfig { + .foo configure -cursor arrow +} -cleanup { + killTables +} -returnCodes ok -result {1024} +test config-4.81 {DoObjConfig - new cursor} -constraints testobjconfig -body { + testobjconfig alltypes .foo -cursor xterm + .foo configure -cursor arrow + .foo cget -cursor +} -cleanup { + killTables +} -returnCodes ok -result {arrow} +test config-4.82 {DoObjConfig - cursor internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -cursor watch .foo cget -cursor -} {watch} -test config-4.47 {DoObjConfig - justify} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -justify center} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo] -} {0 .foo 0 center {}} -test config-4.48 {DoObjConfig - invalid justify} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -justify foo} msg] $msg -} {1 {bad justification "foo": must be left, right, or center}} -test config-4.49 {DoObjConfig - new justify} testobjconfig { - catch {destroy .foo} +} -cleanup { + killTables +} -result {watch} + +test config-4.83 {DoObjConfig - justify} -constraints testobjconfig -body { + testobjconfig alltypes .foo -justify center +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.84 {DoObjConfig - justify} -constraints testobjconfig -body { + testobjconfig alltypes .foo -justify center + .foo cget -justify +} -cleanup { + killTables +} -returnCodes ok -result {center} +test config-4.85 {DoObjConfig - invalid justify} -constraints testobjconfig -body { + testobjconfig alltypes .foo -justify foo +} -cleanup { + killTables +} -returnCodes error -result {bad justification "foo": must be left, right, or center} +test config-4.86 {DoObjConfig - new justify} -constraints testobjconfig -body { testobjconfig alltypes .foo -justify left - list [catch {.foo configure -justify right} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo] -} {0 2048 0 right {}} -test config-4.50 {DoObjConfig - justify internal value} testobjconfig { + .foo configure -justify right +} -cleanup { + killTables +} -returnCodes ok -result {2048} +test config-4.87 {DoObjConfig - new justify} -constraints testobjconfig -body { + testobjconfig alltypes .foo -justify left + .foo configure -justify right + .foo cget -justify +} -cleanup { + killTables +} -returnCodes ok -result {right} +test config-4.88 {DoObjConfig - justify internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -justify center .foo cget -justify -} {center} -test config-4.51 {DoObjConfig - anchor} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -anchor center} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo] -} {0 .foo 0 center {}} -test config-4.52 {DoObjConfig - invalid anchor} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -anchor foo} msg] $msg -} {1 {bad anchor "foo": must be n, ne, e, se, s, sw, w, nw, or center}} -test config-4.53 {DoObjConfig - new anchor} testobjconfig { - catch {destroy .foo} +} -cleanup { + killTables +} -result {center} + +test config-4.89 {DoObjConfig - anchor} -constraints testobjconfig -body { + testobjconfig alltypes .foo -anchor center +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.90 {DoObjConfig - anchor} -constraints testobjconfig -body { + testobjconfig alltypes .foo -anchor center + .foo cget -anchor +} -cleanup { + killTables +} -returnCodes ok -result {center} +test config-4.91 {DoObjConfig - invalid anchor} -constraints testobjconfig -body { + testobjconfig alltypes .foo -anchor foo +} -cleanup { + killTables +} -returnCodes error -result {bad anchor "foo": must be n, ne, e, se, s, sw, w, nw, or center} +test config-4.92 {DoObjConfig - new anchor} -constraints testobjconfig -body { testobjconfig alltypes .foo -anchor e - list [catch {.foo configure -anchor n} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo] -} {0 4096 0 n {}} -test config-4.54 {DoObjConfig - anchor internal value} testobjconfig { + .foo configure -anchor n +} -cleanup { + killTables +} -returnCodes ok -result {4096} +test config-4.93 {DoObjConfig - new anchor} -constraints testobjconfig -body { + testobjconfig alltypes .foo -anchor e + .foo configure -anchor n + .foo cget -anchor +} -cleanup { + killTables +} -returnCodes ok -result {n} +test config-4.94 {DoObjConfig - anchor internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -anchor sw .foo cget -anchor -} {sw} -test config-4.55 {DoObjConfig - pixel} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -pixel 42} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo] -} {0 .foo 0 42 {}} -test config-4.56 {DoObjConfig - invalid pixel} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -pixel foo} msg] $msg -} {1 {bad screen distance "foo"}} -test config-4.57 {DoObjConfig - new pixel} testobjconfig { - catch {destroy .foo} +} -cleanup { + killTables +} -result {sw} +test config-4.95 {DoObjConfig - pixel} -constraints testobjconfig -body { + testobjconfig alltypes .foo -pixel 42 +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.96 {DoObjConfig - pixel} -constraints testobjconfig -body { + testobjconfig alltypes .foo -pixel 42 + .foo cget -pixel +} -cleanup { + killTables +} -returnCodes ok -result {42} +test config-4.97 {DoObjConfig - invalid pixel} -constraints testobjconfig -body { + testobjconfig alltypes .foo -pixel foo +} -cleanup { + killTables +} -returnCodes error -result {bad screen distance "foo"} +test config-4.98 {DoObjConfig - new pixel} -constraints testobjconfig -body { + testobjconfig alltypes .foo -pixel 42m + .foo configure -pixel 3c +} -cleanup { + killTables +} -returnCodes ok -result {8192} +test config-4.99 {DoObjConfig - new pixel} -constraints testobjconfig -body { testobjconfig alltypes .foo -pixel 42m - list [catch {.foo configure -pixel 3c} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo] -} {0 8192 0 3c {}} -test config-4.58 {DoObjConfig - pixel internal value} testobjconfig { + .foo configure -pixel 3c + .foo cget -pixel +} -cleanup { + killTables +} -returnCodes ok -result {3c} +test config-4.100 {DoObjConfig - pixel internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -pixel [winfo screenmmwidth .]m - .foo cget -pixel -} [winfo screenwidth .] -test config-4.59 {DoObjConfig - window} testobjconfig { - catch {destroy .foo} - catch {destroy .bar} + set screenW [winfo screenwidth .] + set result [.foo cget -pixel] + expr {$screenW eq $result} +} -cleanup { + killTables +} -result {1} + +test config-4.101 {DoObjConfig - window} -constraints testobjconfig -body { toplevel .bar - list [catch {testobjconfig twowindows .foo -window .bar} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar] -} {0 .foo 0 .bar {} {}} -test config-4.60 {DoObjConfig - invalid window} testobjconfig { - catch {destroy .foo} + testobjconfig twowindows .foo -window .bar +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.102 {DoObjConfig - window} -constraints testobjconfig -body { toplevel .bar - list [catch {testobjconfig twowindows .foo -window foo} msg] $msg [destroy .bar] -} {1 {bad window path name "foo"} {}} -test config-4.61 {DoObjConfig - null window} testobjconfig { - catch {destroy .foo} - catch {destroy .bar} + testobjconfig twowindows .foo -window .bar + .foo cget -window +} -cleanup { + killTables +} -returnCodes ok -result {.bar} +test config-4.103 {DoObjConfig - invalid window} -constraints testobjconfig -body { toplevel .bar - list [catch {testobjconfig twowindows .foo -window {}} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] -} {0 .foo 0 {} {}} -test config-4.62 {DoObjConfig - new window} testobjconfig { - catch {destroy .foo} - catch {destroy .bar} - catch {destroy .blamph} + testobjconfig twowindows .foo -window foo +} -cleanup { + killTables +} -returnCodes error -result {bad window path name "foo"} +test config-4.104 {DoObjConfig - null window} -constraints testobjconfig -body { + toplevel .bar + testobjconfig twowindows .foo -window {} +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.105 {DoObjConfig - null window} -constraints testobjconfig -body { + toplevel .bar + testobjconfig twowindows .foo -window {} + .foo cget -window +} -cleanup { + killTables +} -returnCodes ok -result {} +test config-4.106 {DoObjConfig - new window} -constraints testobjconfig -body { toplevel .bar toplevel .blamph testobjconfig twowindows .foo -window .bar - list [catch {.foo configure -window .blamph} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar] [destroy .blamph] -} {0 0 0 .blamph {} {} {}} -test config-4.63 {DoObjConfig - window internal value} testobjconfig { + .foo configure -window .blamph +} -cleanup { + killTables +} -returnCodes ok -result {0} +test config-4.107 {DoObjConfig - new window} -constraints testobjconfig -body { + toplevel .bar + toplevel .blamph + testobjconfig twowindows .foo -window .bar + .foo configure -window .blamph + .foo cget -window +} -cleanup { + killTables +} -returnCodes ok -result {.blamph} +test config-4.108 {DoObjConfig - window internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -window . .foo cget -window -} {.} -test config-4.64 {DoObjConfig - releasing old values} testobjconfig { +} -cleanup { + killTables +} -result {.} + +test config-4.109 {DoObjConfig - releasing old values} -constraints { + testobjconfig +} -setup { + catch {rename .foo {}} +} -body { # This test doesn't generate a useful value to check; if an # error occurs, it will be detected only by memory checking software # such as Purify or Tcl's built-in checker. - catch {rename .foo {}} testobjconfig alltypes .foo -string {Test string} -color yellow \ -font {Courier 18} -bitmap questhead -border green -cursor cross \ -custom foobar @@ -451,13 +1054,18 @@ test config-4.64 {DoObjConfig - releasing old values} testobjconfig { -font {Times 8} -bitmap gray75 -border pink -cursor watch \ -custom barbaz concat {} -} {} -test config-4.65 {DoObjConfig - releasing old values} testobjconfig { +} -cleanup { + killTables +} -result {} +test config-4.110 {DoObjConfig - releasing old values} -constraints { + testobjconfig +} -setup { + catch {rename .foo {}} +} -body { # This test doesn't generate a useful value to check; if an # error occurs, it will be detected only by memory checking software # such as Purify or Tcl's built-in checker. - catch {rename .foo {}} testobjconfig internal .foo -string {Test string} -color yellow \ -font {Courier 18} -bitmap questhead -border green -cursor cross \ -custom foobar @@ -465,421 +1073,844 @@ test config-4.65 {DoObjConfig - releasing old values} testobjconfig { -font {Times 8} -bitmap gray75 -border pink -cursor watch \ -custom barbaz concat {} -} {} -test config-4.66 {DoObjConfig - custom} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -custom test} msg] $msg [catch {.foo cget -custom} result] $result [destroy .foo] -} {0 .foo 0 TEST {}} -test config-4.67 {DoObjConfig - null custom} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -custom {}} msg] $msg [catch {.foo cget -custom} result] $result [destroy .foo] -} {0 .foo 0 {} {}} -test config-4.68 {DoObjConfig - custom internal value} testobjconfig { +} -cleanup { + killTables +} -result {} + +test config-4.111 {DoObjConfig - custom} -constraints testobjconfig -body { + testobjconfig alltypes .foo -custom test +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.112 {DoObjConfig - custom} -constraints testobjconfig -body { + testobjconfig alltypes .foo -custom test + .foo cget -custom +} -cleanup { + killTables +} -returnCodes ok -result {TEST} +test config-4.113 {DoObjConfig - null custom} -constraints testobjconfig -body { + testobjconfig alltypes .foo -custom {} +} -cleanup { + killTables +} -returnCodes ok -result {.foo} +test config-4.114 {DoObjConfig - null custom} -constraints testobjconfig -body { + testobjconfig alltypes .foo -custom {} + .foo cget -custom +} -cleanup { + killTables +} -returnCodes ok -result {} +test config-4.115 {DoObjConfig - custom internal value} -constraints { + testobjconfig +} -setup { catch {rename .foo {}} +} -body { testobjconfig internal .foo -custom "this is a test" .foo cget -custom -} {THIS IS A TEST} +} -cleanup { + killTables +} -result {THIS IS A TEST} -test config-5.1 {ObjectIsEmpty - object is already string} testobjconfig { - catch {destroy .foo} + +test config-5.1 {ObjectIsEmpty - object is already string} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo -color [format ""] .foo cget -color -} {} -test config-5.2 {ObjectIsEmpty - object is already string} testobjconfig { - catch {destroy .foo} - list [catch {testobjconfig alltypes .foo -color [format " "]} msg] $msg -} {1 {unknown color name " "}} -test config-5.3 {ObjectIsEmpty - must convert back to string} testobjconfig { - catch {destroy .foo} +} -cleanup { + killTables +} -result {} +test config-5.2 {ObjectIsEmpty - object is already string} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .foo -color [format " "] +} -cleanup { + killTables +} -returnCodes error -result {unknown color name " "} +test config-5.3 {ObjectIsEmpty - must convert back to string} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo -color [list] .foo cget -color -} {} +} -cleanup { + killTables +} -result {} -deleteWindows -if {[testConstraint testobjconfig]} { + +test config-6.1 {GetOptionFromObj - cached answer} -constraints { + testobjconfig +} -body { testobjconfig chain2 .a - testobjconfig alltypes .b -} -test config-6.1 {GetOptionFromObj - cached answer} testobjconfig { list [.a cget -three] [.a cget -three] -} {three three} -test config-6.2 {GetOptionFromObj - exact match} testobjconfig { +} -cleanup { + killTables +} -result {three three} +test config-6.2 {GetOptionFromObj - exact match} -constraints { + testobjconfig +} -body { + testobjconfig chain2 .a .a cget -one -} {one} -test config-6.3 {GetOptionFromObj - abbreviation} testobjconfig { +} -cleanup { + killTables +} -result {one} +test config-6.3 {GetOptionFromObj - abbreviation} -constraints { + testobjconfig +} -body { + testobjconfig chain2 .a .a cget -fo -} {four} -test config-6.4 {GetOptionFromObj - ambiguous abbreviation} testobjconfig { - list [catch {.a cget -on} msg] $msg -} {1 {unknown option "-on"}} -test config-6.5 {GetOptionFromObj - duplicate options in different tables} testobjconfig { +} -cleanup { + killTables +} -result {four} +test config-6.4 {GetOptionFromObj - ambiguous abbreviation} -constraints { + testobjconfig +} -body { + testobjconfig chain2 .a + .a cget -on +} -cleanup { + killTables +} -cleanup { + killTables +} -returnCodes error -result {unknown option "-on"} +test config-6.5 {GetOptionFromObj - duplicate options in different tables} -constraints { + testobjconfig +} -body { + testobjconfig chain2 .a .a cget -tw -} {two and a half} -test config-6.6 {GetOptionFromObj - synonym} testobjconfig { +} -cleanup { + killTables +} -result {two and a half} +test config-6.6 {GetOptionFromObj - synonym} -constraints testobjconfig -body { + testobjconfig alltypes .b .b cget -synonym -} {red} +} -cleanup { + killTables +} -result {red} + -deleteWindows if {[testConstraint testobjconfig]} { testobjconfig alltypes .a } -test config-7.1 {Tk_SetOptions - basics} testobjconfig { +test config-7.1 {Tk_SetOptions - basics} -constraints testobjconfig -body { .a configure -color green -rel sunken list [.a cget -color] [.a cget -relief] -} {green sunken} -test config-7.2 {Tk_SetOptions - bogus option name} testobjconfig { - list [catch {.a configure -bogus} msg] $msg -} {1 {unknown option "-bogus"}} -test config-7.3 {Tk_SetOptions - synonym} testobjconfig { +} -result {green sunken} +test config-7.2 {Tk_SetOptions - bogus option name} -constraints { + testobjconfig +} -body { + .a configure -bogus +} -returnCodes error -result {unknown option "-bogus"} +test config-7.3 {Tk_SetOptions - synonym} -constraints testobjconfig -body { .a configure -synonym blue .a cget -color -} {blue} -test config-7.4 {Tk_SetOptions - missing value} testobjconfig { - list [catch {.a configure -color green -relief} msg] $msg [.a cget -color] -} {1 {value for "-relief" missing} green} -test config-7.5 {Tk_SetOptions - saving old values} testobjconfig { +} -result {blue} +test config-7.4 {Tk_SetOptions - missing value} -constraints { + testobjconfig +} -body { + .a configure -color green -relief +} -returnCodes error -result {value for "-relief" missing} +test config-7.5 {Tk_SetOptions - missing value} -constraints { + testobjconfig +} -body { + catch {.a configure -color green -relief} + .a cget -color +} -result {green} +test config-7.6 {Tk_SetOptions - saving old values} -constraints { + testobjconfig +} -body { + .a configure -color red -int 7 -relief raised -double 3.14159 + .a csave -color green -int 432 -relief sunken -double 2.0 -color bogus +} -returnCodes error -result {unknown color name "bogus"} +test config-7.7 {Tk_SetOptions - saving old values} -constraints { + testobjconfig +} -body { .a configure -color red -int 7 -relief raised -double 3.14159 - list [catch {.a csave -color green -int 432 -relief sunken \ - -double 2.0 -color bogus} msg] $msg [.a cget -color] \ - [.a cget -int] [.a cget -relief] [.a cget -double] -} {1 {unknown color name "bogus"} red 7 raised 3.14159} -test config-7.6 {Tk_SetOptions - error in DoObjConfig call} testobjconfig { - list [catch {.a configure -color bogus} msg] $msg $errorInfo -} {1 {unknown color name "bogus"} {unknown color name "bogus" + catch {.a csave -color green -int 432 -relief sunken -double 2.0 -color bogus} + list [.a cget -color] [.a cget -int] [.a cget -relief] [.a cget -double] +} -result {red 7 raised 3.14159} + +test config-7.8 {Tk_SetOptions - error in DoObjConfig call} -constraints { + testobjconfig +} -body { + .a configure -color bogus +} -returnCodes error -result {unknown color name "bogus"} +test config-7.9 {Tk_SetOptions - error in DoObjConfig call} -constraints { + testobjconfig +} -body { + catch {.a configure -color bogus} + return $errorInfo +} -result {unknown color name "bogus" (processing "-color" option) invoked from within -".a configure -color bogus"}} -test config-7.7 {Tk_SetOptions - synonym name in error message} testobjconfig { - list [catch {.a configure -synonym bogus} msg] $msg $errorInfo -} {1 {unknown color name "bogus"} {unknown color name "bogus" +".a configure -color bogus"} + +test config-7.10 {Tk_SetOptions - synonym name in error message} -constraints { + testobjconfig +} -body { + .a configure -synonym bogus +} -returnCodes error -result {unknown color name "bogus"} +test config-7.11 {Tk_SetOptions - synonym name in error message} -constraints { + testobjconfig +} -body { + catch {.a configure -synonym bogus} + return $errorInfo +} -result {unknown color name "bogus" (processing "-synonym" option) invoked from within -".a configure -synonym bogus"}} -test config-7.8 {Tk_SetOptions - returning mask} testobjconfig { +".a configure -synonym bogus"} +test config-7.12 {Tk_SetOptions - returning mask} -constraints testobjconfig -body { format %x [.a configure -color red -int 7 -relief raised -double 3.14159] -} {226} -test config-7.9 {Tk_SetOptions - error in DoObjConfig with custom option} testobjconfig { - list [catch {.a configure -custom bad} msg] $msg $errorInfo -} {1 {expected good value, got "BAD"} {expected good value, got "BAD" +} -result {226} +test config-7.13 {Tk_SetOptions - error in DoObjConfig with custom option} -constraints { + testobjconfig +} -body { + .a configure -custom bad +} -returnCodes error -result {expected good value, got "BAD"} +test config-7.14 {Tk_SetOptions - error in DoObjConfig with custom option} -constraints { + testobjconfig +} -body { + catch {.a configure -custom bad} + return $errorInfo +} -result {expected good value, got "BAD" (processing "-custom" option) invoked from within -".a configure -custom bad"}} +".a configure -custom bad"} +if {[testConstraint testobjconfig]} { + killTables +} -test config-8.1 {Tk_RestoreSavedOptions - restore in proper order} testobjconfig { - deleteWindows + +test config-8.1 {Tk_RestoreSavedOptions - restore in proper order} -constraints { + testobjconfig +} -body { testobjconfig alltypes .a - list [catch {.a csave -color green -color black -color blue \ - -color #ffff00 -color #ff00ff -color bogus} msg] $msg \ - [.a cget -color] -} {1 {unknown color name "bogus"} red} -test config-8.2 {Tk_RestoreSavedOptions - freeing object memory} testobjconfig { - deleteWindows + .a csave -color green -color black -color blue \ + -color #ffff00 -color #ff00ff -color bogus \ +} -cleanup { + killTables +} -returnCodes error -result {unknown color name "bogus"} +test config-8.2 {Tk_RestoreSavedOptions - restore in proper order} -constraints { + testobjconfig +} -body { testobjconfig alltypes .a - .a csave -color green -color black -color blue -color #ffff00 \ - -color #ff00ff -} {32} -test config-8.3 {Tk_RestoreSavedOptions - boolean internal form} testobjconfig { - deleteWindows + catch {.a csave -color green -color black -color blue \ + -color #ffff00 -color #ff00ff -color bogus} + .a cget -color +} -cleanup { + killTables +} -result {red} +test config-8.3 {Tk_RestoreSavedOptions - freeing object memory} -constraints { + testobjconfig +} -body { + testobjconfig alltypes .a + .a csave -color green -color black -color blue -color #ffff00 -color #ff00ff +} -cleanup { + killTables +} -result {32} +test config-8.4 {Tk_RestoreSavedOptions - boolean internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -boolean 0 -color bogus}] [.a cget -boolean] -} {1 1} -test config-8.4 {Tk_RestoreSavedOptions - integer internal form} testobjconfig { - deleteWindows + .a csave -boolean 0 -color bogus +} -cleanup { + killTables +} -returnCodes error -match glob -result * +test config-8.5 {Tk_RestoreSavedOptions - boolean internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -integer 24 -color bogus}] [.a cget -integer] -} {1 148962237} -test config-8.5 {Tk_RestoreSavedOptions - double internal form} testobjconfig { - deleteWindows + catch {.a csave -boolean 0 -color bogus} + .a cget -boolean +} -cleanup { + killTables +} -result {1} +test config-8.6 {Tk_RestoreSavedOptions - integer internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -double 62.4 -color bogus}] [.a cget -double] -} {1 3.14159} -test config-8.6 {Tk_RestoreSavedOptions - string internal form} testobjconfig { - deleteWindows + .a csave -integer 24 -color bogus +} -cleanup { + killTables +} -returnCodes error -match glob -result * +test config-8.7 {Tk_RestoreSavedOptions - integer internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -string "A long string" -color bogus}] \ - [.a cget -string] -} {1 foo} -test config-8.7 {Tk_RestoreSavedOptions - string table internal form} testobjconfig { - deleteWindows + catch {.a csave -integer 24 -color bogus} + .a cget -integer +} -cleanup { + killTables +} -result {148962237} +test config-8.8 {Tk_RestoreSavedOptions - double internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -stringtable three -color bogus}] \ - [.a cget -stringtable] -} {1 one} -test config-8.8 {Tk_RestoreSavedOptions - color internal form} testobjconfig { - deleteWindows + catch {.a csave -double 62.4 -color bogus} + .a cget -double +} -cleanup { + killTables +} -result {3.14159} +test config-8.9 {Tk_RestoreSavedOptions - string internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -color green -color bogus}] [.a cget -color] -} {1 red} -test config-8.9 {Tk_RestoreSavedOptions - font internal form} {testobjconfig nonPortable} { - deleteWindows + catch {.a csave -string "A long string" -color bogus} + .a cget -string +} -cleanup { + killTables +} -result {foo} +test config-8.10 {Tk_RestoreSavedOptions - string table internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -font {Times 12} -color bogus}] [.a cget -font] -} {1 {Helvetica 12}} -test config-8.10 {Tk_RestoreSavedOptions - bitmap internal form} testobjconfig { - deleteWindows + catch {.a csave -stringtable three -color bogus} + .a cget -stringtable +} -cleanup { + killTables +} -result {one} +test config-8.11 {Tk_RestoreSavedOptions - color internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -bitmap questhead -color bogus}] [.a cget -bitmap] -} {1 gray50} -test config-8.11 {Tk_RestoreSavedOptions - border internal form} testobjconfig { - deleteWindows + catch {.a csave -color green -color bogus} + .a cget -color +} -cleanup { + killTables +} -result {red} +test config-8.12 {Tk_RestoreSavedOptions - font internal form} -constraints { + testobjconfig nonPortable +} -body { testobjconfig internal .a - list [catch {.a csave -border brown -color bogus}] [.a cget -border] -} {1 blue} -test config-8.12 {Tk_RestoreSavedOptions - relief internal form} testobjconfig { - deleteWindows + catch {.a csave -font {Times 12} -color bogus} + .a cget -font +} -cleanup { + killTables +} -result {Helvetica 12} +test config-8.13 {Tk_RestoreSavedOptions - bitmap internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -relief sunken -color bogus}] [.a cget -relief] -} {1 raised} -test config-8.13 {Tk_RestoreSavedOptions - cursor internal form} testobjconfig { - deleteWindows + catch {.a csave -bitmap questhead -color bogus} + .a cget -bitmap +} -cleanup { + killTables +} -result {gray50} +test config-8.14 {Tk_RestoreSavedOptions - border internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -cursor watch -color bogus}] [.a cget -cursor] -} {1 xterm} -test config-8.14 {Tk_RestoreSavedOptions - justify internal form} testobjconfig { - deleteWindows + catch {.a csave -border brown -color bogus} + .a cget -border +} -cleanup { + killTables +} -result {blue} +test config-8.15 {Tk_RestoreSavedOptions - relief internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -justify right -color bogus}] [.a cget -justify] -} {1 left} -test config-8.15 {Tk_RestoreSavedOptions - anchor internal form} testobjconfig { - deleteWindows + catch {.a csave -relief sunken -color bogus} + .a cget -relief +} -cleanup { + killTables +} -result {raised} +test config-8.16 {Tk_RestoreSavedOptions - cursor internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a - list [catch {.a csave -anchor center -color bogus}] [.a cget -anchor] -} {1 n} -test config-8.16 {Tk_RestoreSavedOptions - window internal form} testobjconfig { - deleteWindows + catch {.a csave -cursor watch -color bogus} + .a cget -cursor +} -cleanup { + killTables +} -result {xterm} +test config-8.17 {Tk_RestoreSavedOptions - justify internal form} -constraints { + testobjconfig +} -body { + testobjconfig internal .a + catch {.a csave -justify right -color bogus} + .a cget -justify +} -cleanup { + killTables +} -result {left} +test config-8.18 {Tk_RestoreSavedOptions - anchor internal form} -constraints { + testobjconfig +} -body { + testobjconfig internal .a + catch {.a csave -anchor center -color bogus} + .a cget -anchor +} -cleanup { + killTables +} -result {n} +test config-8.19 {Tk_RestoreSavedOptions - window internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a -window .a - list [catch {.a csave -window .a -color bogus}] [.a cget -window] -} {1 .a} -test config-8.17 {Tk_RestoreSavedOptions - custom internal form} testobjconfig { - deleteWindows + catch {.a csave -window .a -color bogus} + .a cget -window +} -cleanup { + killTables +} -result {.a} +test config-8.20 {Tk_RestoreSavedOptions - custom internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .a -custom "foobar" - list [catch {.a csave -custom "barbaz" -color bogus}] [.a cget -custom] -} {1 FOOBAR} + catch {.a csave -custom "barbaz" -color bogus} + .a cget -custom +} -cleanup { + killTables +} -result {FOOBAR} # Most of the tests below will cause memory leakage if there is a # problem. This may not be evident unless the tests are run in # conjunction with a memory usage analyzer such as Purify. -test config-9.1 {Tk_FreeConfigOptions/FreeResources - string internal form} testobjconfig { - catch {destroy .foo} +test config-9.1 {Tk_FreeConfigOptions/FreeResources - string internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .foo .foo configure -string "two words" destroy .foo -} {} -test config-9.2 {Tk_FreeConfigOptions/FreeResources - color internal form} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.2 {Tk_FreeConfigOptions/FreeResources - color internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .foo .foo configure -color yellow destroy .foo -} {} -test config-9.3 {Tk_FreeConfigOptions/FreeResources - color} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.3 {Tk_FreeConfigOptions/FreeResources - color} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo .foo configure -color [format blue] destroy .foo -} {} -test config-9.4 {Tk_FreeConfigOptions/FreeResources - font internal form} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.4 {Tk_FreeConfigOptions/FreeResources - font internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .foo .foo configure -font {Courier 20} destroy .foo -} {} -test config-9.5 {Tk_FreeConfigOptions/FreeResources - font} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.5 {Tk_FreeConfigOptions/FreeResources - font} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo .foo configure -font [format {Courier 24}] destroy .foo -} {} -test config-9.6 {Tk_FreeConfigOptions/FreeResources - bitmap internal form} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.6 {Tk_FreeConfigOptions/FreeResources - bitmap internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .foo .foo configure -bitmap gray75 destroy .foo -} {} -test config-9.7 {Tk_FreeConfigOptions/FreeResources - bitmap} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.7 {Tk_FreeConfigOptions/FreeResources - bitmap} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo .foo configure -bitmap [format gray75] destroy .foo -} {} -test config-9.8 {Tk_FreeConfigOptions/FreeResources - border internal form} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.8 {Tk_FreeConfigOptions/FreeResources - border internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .foo .foo configure -border orange destroy .foo -} {} -test config-9.9 {Tk_FreeConfigOptions/FreeResources - border} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.9 {Tk_FreeConfigOptions/FreeResources - border} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo .foo configure -border [format blue] destroy .foo -} {} -test config-9.10 {Tk_FreeConfigOptions/FreeResources - cursor internal form} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.10 {Tk_FreeConfigOptions/FreeResources - cursor internal form} -constraints { + testobjconfig +} -body { testobjconfig internal .foo .foo configure -cursor cross destroy .foo -} {} -test config-9.11 {Tk_FreeConfigOptions/FreeResources - cursor} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.11 {Tk_FreeConfigOptions/FreeResources - cursor} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo .foo configure -cursor [format watch] destroy .foo -} {} -test config-9.12 {Tk_FreeConfigOptions/FreeResources - not special} testobjconfig { - catch {destroy .foo} +} -result {} +test config-9.12 {Tk_FreeConfigOptions/FreeResources - not special} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo .foo configure -integer [format 27] destroy .foo -} {} -test config-9.13 {Tk_FreeConfigOptions/FreeResources - custom internal form} testobjconfig { +} -result {} +test config-9.13 {Tk_FreeConfigOptions/FreeResources - custom internal form} -constraints { + testobjconfig +} -body { catch {destroy .fpp} testobjconfig internal .foo .foo configure -custom "foobar" destroy .foo -} {} +} -result {} +if {[testConstraint testobjconfig]} { + killTables +} + -test config-10.1 {Tk_GetOptionInfo - one item} testobjconfig { - catch {destroy .foo} +test config-10.1 {Tk_GetOptionInfo - one item} -constraints testobjconfig -body { testobjconfig alltypes .foo .foo configure -relief groove .foo configure -relief -} {-relief relief Relief raised groove} -test config-10.2 {Tk_GetOptionInfo - one item, synonym} testobjconfig { - catch {destroy .foo} +} -cleanup { + destroy .foo +} -result {-relief relief Relief raised groove} +test config-10.2 {Tk_GetOptionInfo - one item, synonym} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo .foo configure -color black .foo configure -synonym -} {-color color Color red black} -test config-10.3 {Tk_GetOptionInfo - all items} testobjconfig { - catch {destroy .foo} +} -cleanup { + destroy .foo +} -result {-color color Color red black} +test config-10.3 {Tk_GetOptionInfo - all items} -constraints { + testobjconfig +} -body { testobjconfig alltypes .foo -font {Helvetica 18} -integer 13563 .foo configure -} {{-boolean boolean Boolean 1 1} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-pixel pixel Pixel 1 1} {-custom {} {} {} {}} {-synonym -color}} -test config-10.4 {Tk_GetOptionInfo - chaining through tables} testobjconfig { - catch {destroy .foo} +} -cleanup { + destroy .foo +} -result {{-boolean boolean Boolean 1 1} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-pixel pixel Pixel 1 1} {-custom {} {} {} {}} {-synonym -color}} +test config-10.4 {Tk_GetOptionInfo - chaining through tables} -constraints testobjconfig -body { testobjconfig chain2 .foo -one asdf -three xyzzy .foo configure -} {{-three three Three three xyzzy} {-four four Four four four} {-two two Two {two and a half} {two and a half}} {-oneAgain oneAgain OneAgain {one again} {one again}} {-one one One one asdf} {-two two Two two {two and a half}}} +} -cleanup { + destroy .foo +} -result {{-three three Three three xyzzy} {-four four Four four four} {-two two Two {two and a half} {two and a half}} {-oneAgain oneAgain OneAgain {one again} {one again}} {-one one One one asdf} {-two two Two two {two and a half}}} +if {[testConstraint testobjconfig]} { + killTables +} + -deleteWindows if {[testConstraint testobjconfig]} { testobjconfig alltypes .a } -test config-11.1 {GetConfigList - synonym} testobjconfig { +test config-11.1 {GetConfigList - synonym} -constraints testobjconfig -body { lindex [.a configure] end -} {-synonym -color} -test config-11.2 {GetConfigList - null database names} testobjconfig { +} -result {-synonym -color} +test config-11.2 {GetConfigList - null database names} -constraints { + testobjconfig +} -body { .a configure -justify -} {-justify {} {} left left} -test config-11.3 {GetConfigList - null default and current value} testobjconfig { +} -result {-justify {} {} left left} +test config-11.3 {GetConfigList - null default and current value} -constraints { + testobjconfig +} -body { .a configure -anchor -} {-anchor anchor Anchor {} {}} +} -result {-anchor anchor Anchor {} {}} +if {[testConstraint testobjconfig]} { + killTables +} + -deleteWindows if {[testConstraint testobjconfig]} { testobjconfig internal .a } -test config-12.1 {GetObjectForOption - boolean} testobjconfig { +test config-12.1 {GetObjectForOption - boolean} -constraints testobjconfig -body { .a configure -boolean 0 .a cget -boolean -} {0} -test config-12.2 {GetObjectForOption - integer} testobjconfig { +} -result {0} +test config-12.2 {GetObjectForOption - integer} -constraints testobjconfig -body { .a configure -integer 1247 .a cget -integer -} {1247} -test config-12.3 {GetObjectForOption - double} testobjconfig { +} -result {1247} +test config-12.3 {GetObjectForOption - double} -constraints testobjconfig -body { .a configure -double -88.82 .a cget -double -} {-88.82} -test config-12.4 {GetObjectForOption - string} testobjconfig { +} -result {-88.82} +test config-12.4 {GetObjectForOption - string} -constraints testobjconfig -body { .a configure -string "test value" .a cget -string -} {test value} -test config-12.5 {GetObjectForOption - stringTable} testobjconfig { +} -result {test value} +test config-12.5 {GetObjectForOption - stringTable} -constraints { + testobjconfig +} -body { .a configure -stringtable "two" .a cget -stringtable -} {two} -test config-12.6 {GetObjectForOption - color} testobjconfig { +} -result {two} +test config-12.6 {GetObjectForOption - color} -constraints testobjconfig -body { .a configure -color "green" .a cget -color -} {green} -test config-12.7 {GetObjectForOption - font} testobjconfig { +} -result {green} +test config-12.7 {GetObjectForOption - font} -constraints testobjconfig -body { .a configure -font {Times 36} .a cget -font -} {Times 36} -test config-12.8 {GetObjectForOption - bitmap} testobjconfig { +} -result {Times 36} +test config-12.8 {GetObjectForOption - bitmap} -constraints testobjconfig -body { .a configure -bitmap "questhead" .a cget -bitmap -} {questhead} -test config-12.9 {GetObjectForOption - border} testobjconfig { +} -result {questhead} +test config-12.9 {GetObjectForOption - border} -constraints testobjconfig -body { .a configure -border #33217c .a cget -border -} {#33217c} -test config-12.10 {GetObjectForOption - relief} testobjconfig { +} -result {#33217c} +test config-12.10 {GetObjectForOption - relief} -constraints { + testobjconfig +} -body { .a configure -relief groove .a cget -relief -} {groove} -test config-12.11 {GetObjectForOption - cursor} testobjconfig { +} -result {groove} +test config-12.11 {GetObjectForOption - cursor} -constraints { + testobjconfig +} -body { .a configure -cursor watch .a cget -cursor -} {watch} -test config-12.12 {GetObjectForOption - justify} testobjconfig { +} -result {watch} +test config-12.12 {GetObjectForOption - justify} -constraints { + testobjconfig +} -body { .a configure -justify right .a cget -justify -} {right} -test config-12.13 {GetObjectForOption - anchor} testobjconfig { +} -result {right} +test config-12.13 {GetObjectForOption - anchor} -constraints testobjconfig -body { .a configure -anchor e .a cget -anchor -} {e} -test config-12.14 {GetObjectForOption - pixels} testobjconfig { +} -result {e} +test config-12.14 {GetObjectForOption - pixels} -constraints testobjconfig -body { .a configure -pixel 193.2 .a cget -pixel -} {193} -test config-12.15 {GetObjectForOption - window} testobjconfig { +} -result {193} +test config-12.15 {GetObjectForOption - window} -constraints testobjconfig -body { .a configure -window .a .a cget -window -} {.a} -test config-12.16 {GetObjectForOption -custom} testobjconfig { +} -result {.a} +test config-12.16 {GetObjectForOption -custom} -constraints testobjconfig -body { .a configure -custom foobar .a cget -custom -} {FOOBAR} -test config-12.17 {GetObjectForOption - null values} testobjconfig { +} -result {FOOBAR} +test config-12.17 {GetObjectForOption - null values} -constraints { + testobjconfig +} -body { .a configure -string {} -color {} -font {} -bitmap {} -border {} \ -cursor {} -window {} -custom {} list [.a cget -string] [.a cget -color] [.a cget -font] \ [.a cget -bitmap] [.a cget -border] [.a cget -cursor] \ [.a cget -window] [.a cget -custom] -} {{} {} {} {} {} {} {} {}} - -test config-13.1 {proper cleanup of options with widget destroy} { - foreach type { - button canvas entry frame listbox menu menubutton message - scale scrollbar text radiobutton checkbutton - } { - destroy .w - $type .w -cursor crosshair - destroy .w - } -} {} +} -result {{} {} {} {} {} {} {} {}} +if {[testConstraint testobjconfig]} { + killTables +} -deleteWindows -test config-14.1 {Tk_CreateOptionTable - use with namespace import} { +test config-13.1 {proper cleanup of options with widget destroy} -body { + button .w -cursor crosshair + destroy .w +} -result {} +test config-13.2 {proper cleanup of options with widget destroy} -body { + canvas .w -cursor crosshair + destroy .w +} -result {} +test config-13.3 {proper cleanup of options with widget destroy} -body { + entry .w -cursor crosshair + destroy .w +} -result {} +test config-13.4 {proper cleanup of options with widget destroy} -body { + frame .w -cursor crosshair + destroy .w +} -result {} +test config-13.5 {proper cleanup of options with widget destroy} -body { + listbox .w -cursor crosshair + destroy .w +} -result {} +test config-13.6 {proper cleanup of options with widget destroy} -body { + menu .w -cursor crosshair + destroy .w +} -result {} +test config-13.7 {proper cleanup of options with widget destroy} -body { + menubutton .w -cursor crosshair + destroy .w +} -result {} +test config-13.8 {proper cleanup of options with widget destroy} -body { + message .w -cursor crosshair + destroy .w +} -result {} +test config-13.9 {proper cleanup of options with widget destroy} -body { + scale .w -cursor crosshair + destroy .w +} -result {} +test config-13.10 {proper cleanup of options with widget destroy} -body { + scrollbar .w -cursor crosshair + destroy .w +} -result {} +test config-13.11 {proper cleanup of options with widget destroy} -body { + text .w -cursor crosshair + destroy .w +} -result {} +test config-13.12 {proper cleanup of options with widget destroy} -body { + radiobutton .w -cursor crosshair + destroy .w +} -result {} +test config-13.13 {proper cleanup of options with widget destroy} -body { + checkbutton .w -cursor crosshair + destroy .w +} -result {} + +test config-14.1 {Tk_CreateOptionTable - use with namespace import} -setup { namespace export -clear * - foreach type { - button canvas entry frame listbox menu menubutton message - scale scrollbar spinbox text radiobutton checkbutton - } { - namespace eval ::foo [subst { - namespace import -force ::$type - ::foo::$type .a - ::foo::$type .b - } - ] - destroy .a .b - } -} {} +} -body { + namespace eval ::foo [subst { + namespace import -force ::button + ::foo::button .a + ::foo::button .b + } + ] + destroy .a .b +} -result {} +test config-14.2 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::canvas + ::foo::canvas .a + ::foo::canvas .b + } + ] + destroy .a .b +} -result {} +test config-14.3 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::entry + ::foo::entry .a + ::foo::entry .b + } + ] + destroy .a .b +} -result {} +test config-14.4 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::frame + ::foo::frame .a + ::foo::frame .b + } + ] + destroy .a .b +} -result {} +test config-14.5 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::listbox + ::foo::listbox .a + ::foo::listbox .b + } + ] + destroy .a .b +} -result {} +test config-14.6 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::menu + ::foo::menu .a + ::foo::menu .b + } + ] + destroy .a .b +} -result {} +test config-14.7 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::menubutton + ::foo::menubutton .a + ::foo::menubutton .b + } + ] + destroy .a .b +} -result {} +test config-14.8 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::message + ::foo::message .a + ::foo::message .b + } + ] + destroy .a .b +} -result {} +test config-14.9 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::scale + ::foo::scale .a + ::foo::scale .b + } + ] + destroy .a .b +} -result {} +test config-14.10 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::scrollbar + ::foo::scrollbar .a + ::foo::scrollbar .b + } + ] + destroy .a .b +} -result {} +test config-14.11 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::spinbox + ::foo::spinbox .a + ::foo::spinbox .b + } + ] + destroy .a .b +} -result {} +test config-14.12 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::text + ::foo::text .a + ::foo::text .b + } + ] + destroy .a .b +} -result {} +test config-14.13 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::radiobutton + ::foo::radiobutton .a + ::foo::radiobutton .b + } + ] + destroy .a .b +} -result {} +test config-14.14 {Tk_CreateOptionTable - use with namespace import} -setup { + namespace export -clear * +} -body { + namespace eval ::foo [subst { + namespace import -force ::checkbutton + ::foo::checkbutton .a + ::foo::checkbutton .b + } + ] + destroy .a .b +} -result {} + # cleanup deleteWindows @@ -888,3 +1919,11 @@ if {[testConstraint testobjconfig]} { } cleanupTests return + + + + + + + + diff --git a/tests/constraints.tcl b/tests/constraints.tcl index bc2c09b..6402753 100644 --- a/tests/constraints.tcl +++ b/tests/constraints.tcl @@ -38,7 +38,7 @@ namespace eval tk { } namespace eval bg { - # Manage a background process. + # Manage a background process. # Replace with slave interp or thread? namespace import ::tcltest::interpreter namespace import ::tk::test::loadTkCommand @@ -126,7 +126,7 @@ namespace eval tk { eval destroy [winfo children .] } - namespace export fixfocus + namespace export fixfocus proc fixfocus {} { catch {destroy .focus} toplevel .focus @@ -138,6 +138,42 @@ namespace eval tk { focus -force .focus.e destroy .focus } + + + namespace export imageInit imageFinish imageCleanup imageNames + variable ImageNames + proc imageInit {} { + variable ImageNames + if {![info exists ImageNames]} { + set ImageNames [lsort [image names]] + } + imageCleanup + if {[lsort [image names]] ne $ImageNames} { + return -code error "IMAGE NAMES mismatch: [image names] != $ImageNames" + } + } + proc imageFinish {} { + variable ImageNames + if {[lsort [image names]] ne $ImageNames} { + return -code error "images remaining: [image names] != $ImageNames" + } + imageCleanup + } + proc imageCleanup {} { + variable ImageNames + foreach img [image names] { + if {$img ni $ImageNames} {image delete $img} + } + } + proc imageNames {} { + variable ImageNames + set r {} + foreach img [image names] { + if {$img ni $ImageNames} {lappend r $img} + } + return $r + } + } } @@ -149,7 +185,7 @@ testConstraint aqua [expr {[tk windowingsystem] eq "aqua"}] testConstraint nonwin [expr {[tk windowingsystem] ne "win32"}] testConstraint userInteraction 0 testConstraint nonUnixUserInteraction [expr { - [testConstraint userInteraction] || + [testConstraint userInteraction] || ([testConstraint unix] && [testConstraint notAqua]) }] testConstraint haveDISPLAY [info exists env(DISPLAY)] @@ -171,7 +207,6 @@ testConstraint testembed [llength [info commands testembed]] testConstraint testfont [llength [info commands testfont]] testConstraint testmakeexist [llength [info commands testmakeexist]] testConstraint testmenubar [llength [info commands testmenubar]] -testConstraint testmenubar [llength [info commands testmenubar]] testConstraint testmetrics [llength [info commands testmetrics]] testConstraint testobjconfig [llength [info commands testobjconfig]] testConstraint testsend [llength [info commands testsend]] @@ -182,7 +217,7 @@ testConstraint testwrapper [llength [info commands testwrapper]] # constraint to see what sort of fonts are available testConstraint fonts 1 destroy .e -entry .e -width 0 -font {Helvetica -12} -bd 1 +entry .e -width 0 -font {Helvetica -12} -bd 1 -highlightthickness 1 .e insert end a.bcd if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} { testConstraint fonts 0 @@ -242,7 +277,6 @@ namespace import -force tcltest::removeDirectory namespace import -force tcltest::interpreter namespace import -force tcltest::testsDirectory namespace import -force tcltest::cleanupTests -namespace import -force tcltest::bytestring deleteWindows wm geometry . {} diff --git a/tests/cursor.test b/tests/cursor.test index 539e933..ab7949e 100644 --- a/tests/cursor.test +++ b/tests/cursor.test @@ -6,96 +6,133 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} {testcursor} { + +# Tests 2.3 and 2.4 need a helper file with a very specific name and +# controlled format. +proc setWincur {wincurName} { + upvar $wincurName wincur + set wincur(data_octal) { + 000 000 002 000 001 000 040 040 000 000 007 000 007 000 060 001 + 000 000 026 000 000 000 050 000 000 000 040 000 000 000 100 000 + 000 000 001 000 001 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 + 000 000 377 377 377 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 + 000 000 000 000 000 000 000 000 000 000 160 016 000 000 170 036 + 000 000 174 076 000 000 076 174 000 000 037 370 000 000 017 360 + 000 000 007 340 000 000 007 340 000 000 017 360 000 000 037 370 + 000 000 076 174 000 000 174 076 000 000 170 036 000 000 160 016 + 000 000 000 000 000 000 377 377 377 377 377 377 377 377 377 377 + 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 + 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 + 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 + 377 377 377 377 377 377 017 360 377 377 007 340 377 377 003 300 + 377 377 001 200 377 377 200 001 377 377 300 003 377 377 340 007 + 377 377 360 017 377 377 360 017 377 377 340 007 377 377 300 003 + 377 377 200 001 377 377 001 200 377 377 003 300 377 377 007 340 + 377 377 017 360 377 377 + } + set wincur(data_binary) {} + foreach wincur(num) $wincur(data_octal) { + append wincur(data_binary) [binary format c [scan $wincur(num) %o]] + } + set wincur(dir) [makeDirectory {dir with spaces}] + set wincur(file) [makeFile $wincur(data_binary) "test file.cur" $wincur(dir)] +} + + +test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} -constraints { + testcursor +} -body { set x watch lindex $x 0 - destroy .b1 - button .b1 -cursor $x + button .b -cursor $x lindex $x 0 testcursor watch -} {{1 0}} -test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} {testcursor} { +} -cleanup { + destroy .b +} -result {{1 0}} +test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} -constraints { + testcursor +} -body { set x watch - destroy .b1 .b2 + set result {} button .b1 -cursor $x destroy .b1 - set result {} lappend result [testcursor watch] button .b2 -cursor $x lappend result [testcursor watch] -} {{} {{1 1}}} -test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} {testcursor} { +} -cleanup { + destroy .b2 +} -result {{} {{1 1}}} +test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} -constraints { + testcursor +} -body { set x watch - destroy .b1 .b2 - button .b1 -cursor $x set result {} + button .b1 -cursor $x lappend result [testcursor watch] button .b2 -cursor $x pack .b1 .b2 -side top lappend result [testcursor watch] -} {{{1 1}} {{2 1}}} +} -cleanup { + destroy .b1 .b2 +} -result {{{1 1}} {{2 1}}} -test cursor-2.1 {Tk_GetCursor procedure} { - destroy .b1 - list [catch {button .b1 -cursor bad_name} msg] $msg -} {1 {bad cursor spec "bad_name"}} -test cursor-2.2 {Tk_GetCursor procedure} { - destroy .b1 - list [catch {button .b1 -cursor @xyzzy} msg] $msg -} {1 {bad cursor spec "@xyzzy"}} -# Next two tests need a helper file with a very specific name and -# controlled format. -set wincur(data_octal) { - 000 000 002 000 001 000 040 040 000 000 007 000 007 000 060 001 - 000 000 026 000 000 000 050 000 000 000 040 000 000 000 100 000 - 000 000 001 000 001 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 - 000 000 377 377 377 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 000 - 000 000 000 000 000 000 000 000 000 000 160 016 000 000 170 036 - 000 000 174 076 000 000 076 174 000 000 037 370 000 000 017 360 - 000 000 007 340 000 000 007 340 000 000 017 360 000 000 037 370 - 000 000 076 174 000 000 174 076 000 000 170 036 000 000 160 016 - 000 000 000 000 000 000 377 377 377 377 377 377 377 377 377 377 - 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 - 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 - 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 377 - 377 377 377 377 377 377 017 360 377 377 007 340 377 377 003 300 - 377 377 001 200 377 377 200 001 377 377 300 003 377 377 340 007 - 377 377 360 017 377 377 360 017 377 377 340 007 377 377 300 003 - 377 377 200 001 377 377 001 200 377 377 003 300 377 377 007 340 - 377 377 017 360 377 377 -} -set wincur(data_binary) {} -foreach wincur(num) $wincur(data_octal) { - append wincur(data_binary) [binary format c [scan $wincur(num) %o]] -} -set wincur(dir) [makeDirectory {dir with spaces}] -set wincur(file) [makeFile $wincur(data_binary) "test file.cur" $wincur(dir)] -test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} win { - destroy .b1 - button .b1 -cursor [list @$wincur(file)] -} {.b1} -test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} win { - destroy .b1 - button .b1 -cursor @[regsub -all {[][ \\{}""$#]} $wincur(file) {\\&}] -} {.b1} -removeDirectory $wincur(dir) -unset wincur +test cursor-2.1 {Tk_GetCursor procedure} -body { + button .b -cursor bad_name +} -cleanup { + destroy .b +} -returnCodes error -result {bad cursor spec "bad_name"} +test cursor-2.2 {Tk_GetCursor procedure} -body { + button .b -cursor @xyzzy +} -cleanup { + destroy .b +} -returnCodes error -result {bad cursor spec "@xyzzy"} -test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {testcursor} { +test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} -constraints { + win +} -setup { + unset -nocomplain wincur + set wincur(file) "" +} -body { + setWincur wincur + button .b -cursor [list @$wincur(file)] +} -cleanup { + destroy .b + removeDirectory $wincur(dir) + unset wincur +} -result {.b} +test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} -constraints { + win +} -setup { + unset -nocomplain wincur + set wincur(file) "" +} -body { + setWincur wincur + button .b -cursor @[regsub -all {[][ \\{}""$#]} $wincur(file) {\\&}] +} -cleanup { + destroy .b + removeDirectory $wincur(dir) + unset wincur +} -result {.b} + +test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} -constraints { + testcursor +} -setup { set x heart - destroy .b1 .b2 .b3 + set result {} +} -body { button .b1 -cursor $x button .b3 -cursor $x button .b2 -cursor $x - set result {} lappend result [testcursor heart] destroy .b1 lappend result [testcursor heart] @@ -103,15 +140,16 @@ test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {testcursor} { lappend result [testcursor heart] destroy .b3 lappend result [testcursor heart] -} {{{3 1}} {{2 1}} {{1 1}} {}} +} -result {{{3 1}} {{2 1}} {{1 1}} {}} -test cursor-4.1 {FreeCursorObjProc} {testcursor} { - destroy .b - set x [format heart] +test cursor-4.1 {FreeCursorObjProc} -constraints { + testcursor +} -body { + set x [join heart] button .b -cursor $x - set y [format heart] + set y [join heart] .b configure -cursor $y - set z [format heart] + set z [join heart] .b configure -cursor $z set result {} lappend result [testcursor heart] @@ -123,10 +161,11 @@ test cursor-4.1 {FreeCursorObjProc} {testcursor} { lappend result [testcursor heart] set y bogus set result -} {{{1 3}} {{1 2}} {{1 1}} {}} +} -cleanup { + destroy .b +} -result {{{1 3}} {{1 2}} {{1 1}} {}} # ------------------------------------------------------------------------- - test cursor-5.1 {assert consistent cursor configuration command} -setup { button .b } -body { @@ -137,101 +176,551 @@ test cursor-5.1 {assert consistent cursor configuration command} -setup { # ------------------------------------------------------------------------- # Check for the standard set of cursors. - -foreach {testName cursor} { - cursor-6.1 X_cursor - cursor-6.2 arrow - cursor-6.3 based_arrow_down - cursor-6.4 based_arrow_up - cursor-6.5 boat - cursor-6.6 bogosity - cursor-6.7 bottom_left_corner - cursor-6.8 bottom_right_corner - cursor-6.9 bottom_side - cursor-6.10 bottom_tee - cursor-6.11 box_spiral - cursor-6.12 center_ptr - cursor-6.13 circle - cursor-6.14 clock - cursor-6.15 coffee_mug - cursor-6.16 cross - cursor-6.17 cross_reverse - cursor-6.18 crosshair - cursor-6.19 diamond_cross - cursor-6.20 dot - cursor-6.21 dotbox - cursor-6.22 double_arrow - cursor-6.23 draft_large - cursor-6.24 draft_small - cursor-6.25 draped_box - cursor-6.26 exchange - cursor-6.27 fleur - cursor-6.28 gobbler - cursor-6.29 gumby - cursor-6.30 hand1 - cursor-6.31 hand2 - cursor-6.32 heart - cursor-6.33 icon - cursor-6.34 iron_cross - cursor-6.35 left_ptr - cursor-6.36 left_side - cursor-6.37 left_tee - cursor-6.38 leftbutton - cursor-6.39 ll_angle - cursor-6.40 lr_angle - cursor-6.41 man - cursor-6.42 middlebutton - cursor-6.43 mouse - cursor-6.44 pencil - cursor-6.45 pirate - cursor-6.46 plus - cursor-6.47 question_arrow - cursor-6.48 right_ptr - cursor-6.49 right_side - cursor-6.50 right_tee - cursor-6.51 rightbutton - cursor-6.52 rtl_logo - cursor-6.53 sailboat - cursor-6.54 sb_down_arrow - cursor-6.55 sb_h_double_arrow - cursor-6.56 sb_left_arrow - cursor-6.57 sb_right_arrow - cursor-6.58 sb_up_arrow - cursor-6.59 sb_v_double_arrow - cursor-6.60 shuttle - cursor-6.61 sizing - cursor-6.62 spider - cursor-6.63 spraycan - cursor-6.64 star - cursor-6.65 target - cursor-6.66 tcross - cursor-6.67 top_left_arrow - cursor-6.68 top_left_corner - cursor-6.69 top_right_corner - cursor-6.70 top_side - cursor-6.71 top_tee - cursor-6.72 trek - cursor-6.73 ul_angle - cursor-6.74 umbrella - cursor-6.75 ur_angle - cursor-6.76 watch - cursor-6.77 xterm -} { - test $testName "check cursor-font cursor $cursor" -setup { - button .b -text $cursor - } -body { - .b configure -cursor $cursor - } -cleanup { - destroy .b - } -result {} -} +test cursor-6.1 {check cursor-font cursor X_cursor} -setup { + button .b -text X_cursor +} -body { + .b configure -cursor X_cursor +} -cleanup { + destroy .b +} -result {} +test cursor-6.2 {check cursor-font cursor arrow} -setup { + button .b -text arrow +} -body { + .b configure -cursor arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.3 {check cursor-font cursor based_arrow_down} -setup { + button .b -text based_arrow_down +} -body { + .b configure -cursor based_arrow_down +} -cleanup { + destroy .b +} -result {} +test cursor-6.4 {check cursor-font cursor based_arrow_up} -setup { + button .b -text based_arrow_up +} -body { + .b configure -cursor based_arrow_up +} -cleanup { + destroy .b +} -result {} +test cursor-6.5 {check cursor-font cursor boat} -setup { + button .b -text boat +} -body { + .b configure -cursor boat +} -cleanup { + destroy .b +} -result {} +test cursor-6.6 {check cursor-font cursor bogosity} -setup { + button .b -text bogosity +} -body { + .b configure -cursor bogosity +} -cleanup { + destroy .b +} -result {} +test cursor-6.7 {check cursor-font cursor bottom_left_corner} -setup { + button .b -text bottom_left_corner +} -body { + .b configure -cursor bottom_left_corner +} -cleanup { + destroy .b +} -result {} +test cursor-6.8 {check cursor-font cursor bottom_right_corner} -setup { + button .b -text bottom_right_corner +} -body { + .b configure -cursor bottom_right_corner +} -cleanup { + destroy .b +} -result {} +test cursor-6.9 {check cursor-font cursor bottom_side} -setup { + button .b -text bottom_side +} -body { + .b configure -cursor bottom_side +} -cleanup { + destroy .b +} -result {} +test cursor-6.10 {check cursor-font cursor bottom_tee} -setup { + button .b -text bottom_tee +} -body { + .b configure -cursor bottom_tee +} -cleanup { + destroy .b +} -result {} +test cursor-6.11 {check cursor-font cursor box_spiral} -setup { + button .b -text box_spiral +} -body { + .b configure -cursor box_spiral +} -cleanup { + destroy .b +} -result {} +test cursor-6.12 {check cursor-font cursor center_ptr} -setup { + button .b -text center_ptr +} -body { + .b configure -cursor center_ptr +} -cleanup { + destroy .b +} -result {} +test cursor-6.13 {check cursor-font cursor circle} -setup { + button .b -text circle +} -body { + .b configure -cursor circle +} -cleanup { + destroy .b +} -result {} +test cursor-6.14 {check cursor-font cursor clock} -setup { + button .b -text clock +} -body { + .b configure -cursor clock +} -cleanup { + destroy .b +} -result {} +test cursor-6.15 {check cursor-font cursor coffee_mug} -setup { + button .b -text coffee_mug +} -body { + .b configure -cursor coffee_mug +} -cleanup { + destroy .b +} -result {} +test cursor-6.16 {check cursor-font cursor cross} -setup { + button .b -text cross +} -body { + .b configure -cursor cross +} -cleanup { + destroy .b +} -result {} +test cursor-6.17 {check cursor-font cursor cross_reverse} -setup { + button .b -text cross_reverse +} -body { + .b configure -cursor cross_reverse +} -cleanup { + destroy .b +} -result {} +test cursor-6.18 {check cursor-font cursor crosshair} -setup { + button .b -text crosshair +} -body { + .b configure -cursor crosshair +} -cleanup { + destroy .b +} -result {} +test cursor-6.19 {check cursor-font cursor diamond_cross} -setup { + button .b -text diamond_cross +} -body { + .b configure -cursor diamond_cross +} -cleanup { + destroy .b +} -result {} +test cursor-6.20 {check cursor-font cursor dot} -setup { + button .b -text dot +} -body { + .b configure -cursor dot +} -cleanup { + destroy .b +} -result {} +test cursor-6.21 {check cursor-font cursor dotbox} -setup { + button .b -text dotbox +} -body { + .b configure -cursor dotbox +} -cleanup { + destroy .b +} -result {} +test cursor-6.22 {check cursor-font cursor double_arrow} -setup { + button .b -text double_arrow +} -body { + .b configure -cursor double_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.23 {check cursor-font cursor draft_large} -setup { + button .b -text draft_large +} -body { + .b configure -cursor draft_large +} -cleanup { + destroy .b +} -result {} +test cursor-6.24 {check cursor-font cursor draft_small} -setup { + button .b -text draft_small +} -body { + .b configure -cursor draft_small +} -cleanup { + destroy .b +} -result {} +test cursor-6.25 {check cursor-font cursor draped_box} -setup { + button .b -text draped_box +} -body { + .b configure -cursor draped_box +} -cleanup { + destroy .b +} -result {} +test cursor-6.26 {check cursor-font cursor exchange} -setup { + button .b -text exchange +} -body { + .b configure -cursor exchange +} -cleanup { + destroy .b +} -result {} +test cursor-6.27 {check cursor-font cursor fleur} -setup { + button .b -text fleur +} -body { + .b configure -cursor fleur +} -cleanup { + destroy .b +} -result {} +test cursor-6.28 {check cursor-font cursor gobbler} -setup { + button .b -text gobbler +} -body { + .b configure -cursor gobbler +} -cleanup { + destroy .b +} -result {} +test cursor-6.29 {check cursor-font cursor gumby} -setup { + button .b -text gumby +} -body { + .b configure -cursor gumby +} -cleanup { + destroy .b +} -result {} +test cursor-6.30 {check cursor-font cursor hand1} -setup { + button .b -text hand1 +} -body { + .b configure -cursor hand1 +} -cleanup { + destroy .b +} -result {} +test cursor-6.31 {check cursor-font cursor hand2} -setup { + button .b -text hand2 +} -body { + .b configure -cursor hand2 +} -cleanup { + destroy .b +} -result {} +test cursor-6.32 {check cursor-font cursor heart} -setup { + button .b -text heart +} -body { + .b configure -cursor heart +} -cleanup { + destroy .b +} -result {} +test cursor-6.33 {check cursor-font cursor icon} -setup { + button .b -text icon +} -body { + .b configure -cursor icon +} -cleanup { + destroy .b +} -result {} +test cursor-6.34 {check cursor-font cursor iron_cross} -setup { + button .b -text iron_cross +} -body { + .b configure -cursor iron_cross +} -cleanup { + destroy .b +} -result {} +test cursor-6.35 {check cursor-font cursor left_ptr} -setup { + button .b -text left_ptr +} -body { + .b configure -cursor left_ptr +} -cleanup { + destroy .b +} -result {} +test cursor-6.36 {check cursor-font cursor left_side} -setup { + button .b -text left_side +} -body { + .b configure -cursor left_side +} -cleanup { + destroy .b +} -result {} +test cursor-6.37 {check cursor-font cursor left_tee} -setup { + button .b -text left_tee +} -body { + .b configure -cursor left_tee +} -cleanup { + destroy .b +} -result {} +test cursor-6.38 {check cursor-font cursor leftbutton} -setup { + button .b -text leftbutton +} -body { + .b configure -cursor leftbutton +} -cleanup { + destroy .b +} -result {} +test cursor-6.39 {check cursor-font cursor ll_angle} -setup { + button .b -text ll_angle +} -body { + .b configure -cursor ll_angle +} -cleanup { + destroy .b +} -result {} +test cursor-6.40 {check cursor-font cursor lr_angle} -setup { + button .b -text lr_angle +} -body { + .b configure -cursor lr_angle +} -cleanup { + destroy .b +} -result {} +test cursor-6.41 {check cursor-font cursor man} -setup { + button .b -text man +} -body { + .b configure -cursor man +} -cleanup { + destroy .b +} -result {} +test cursor-6.42 {check cursor-font cursor middlebutton} -setup { + button .b -text middlebutton +} -body { + .b configure -cursor middlebutton +} -cleanup { + destroy .b +} -result {} +test cursor-6.43 {check cursor-font cursor mouse} -setup { + button .b -text mouse +} -body { + .b configure -cursor mouse +} -cleanup { + destroy .b +} -result {} +test cursor-6.44 {check cursor-font cursor pencil} -setup { + button .b -text pencil +} -body { + .b configure -cursor pencil +} -cleanup { + destroy .b +} -result {} +test cursor-6.45 {check cursor-font cursor pirate} -setup { + button .b -text pirate +} -body { + .b configure -cursor pirate +} -cleanup { + destroy .b +} -result {} +test cursor-6.46 {check cursor-font cursor plus} -setup { + button .b -text plus +} -body { + .b configure -cursor plus +} -cleanup { + destroy .b +} -result {} +test cursor-6.47 {check cursor-font cursor question_arrow} -setup { + button .b -text question_arrow +} -body { + .b configure -cursor question_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.48 {check cursor-font cursor right_ptr} -setup { + button .b -text right_ptr +} -body { + .b configure -cursor right_ptr +} -cleanup { + destroy .b +} -result {} +test cursor-6.49 {check cursor-font cursor right_side} -setup { + button .b -text right_side +} -body { + .b configure -cursor right_side +} -cleanup { + destroy .b +} -result {} +test cursor-6.50 {check cursor-font cursor right_tee} -setup { + button .b -text right_tee +} -body { + .b configure -cursor right_tee +} -cleanup { + destroy .b +} -result {} +test cursor-6.51 {check cursor-font cursor rightbutton} -setup { + button .b -text rightbutton +} -body { + .b configure -cursor rightbutton +} -cleanup { + destroy .b +} -result {} +test cursor-6.52 {check cursor-font cursor rtl_logo} -setup { + button .b -text rtl_logo +} -body { + .b configure -cursor rtl_logo +} -cleanup { + destroy .b +} -result {} +test cursor-6.53 {check cursor-font cursor sailboat} -setup { + button .b -text sailboat +} -body { + .b configure -cursor sailboat +} -cleanup { + destroy .b +} -result {} +test cursor-6.54 {check cursor-font cursor sb_down_arrow} -setup { + button .b -text sb_down_arrow +} -body { + .b configure -cursor sb_down_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.55 {check cursor-font cursor sb_h_double_arrow} -setup { + button .b -text sb_h_double_arrow +} -body { + .b configure -cursor sb_h_double_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.56 {check cursor-font cursor sb_left_arrow} -setup { + button .b -text sb_left_arrow +} -body { + .b configure -cursor sb_left_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.57 {check cursor-font cursor sb_right_arrow} -setup { + button .b -text sb_right_arrow +} -body { + .b configure -cursor sb_right_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.58 {check cursor-font cursor sb_up_arrow} -setup { + button .b -text sb_up_arrow +} -body { + .b configure -cursor sb_up_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.59 {check cursor-font cursor sb_v_double_arrow} -setup { + button .b -text sb_v_double_arrow +} -body { + .b configure -cursor sb_v_double_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.60 {check cursor-font cursor shuttle} -setup { + button .b -text shuttle +} -body { + .b configure -cursor shuttle +} -cleanup { + destroy .b +} -result {} +test cursor-6.61 {check cursor-font cursor sizing} -setup { + button .b -text sizing +} -body { + .b configure -cursor sizing +} -cleanup { + destroy .b +} -result {} +test cursor-6.62 {check cursor-font cursor spider} -setup { + button .b -text spider +} -body { + .b configure -cursor spider +} -cleanup { + destroy .b +} -result {} +test cursor-6.63 {check cursor-font cursor spraycan} -setup { + button .b -text spraycan +} -body { + .b configure -cursor spraycan +} -cleanup { + destroy .b +} -result {} +test cursor-6.64 {check cursor-font cursor star} -setup { + button .b -text star +} -body { + .b configure -cursor star +} -cleanup { + destroy .b +} -result {} +test cursor-6.65 {check cursor-font cursor target} -setup { + button .b -text target +} -body { + .b configure -cursor target +} -cleanup { + destroy .b +} -result {} +test cursor-6.66 {check cursor-font cursor tcross} -setup { + button .b -text tcross +} -body { + .b configure -cursor tcross +} -cleanup { + destroy .b +} -result {} +test cursor-6.67 {check cursor-font cursor top_left_arrow} -setup { + button .b -text top_left_arrow +} -body { + .b configure -cursor top_left_arrow +} -cleanup { + destroy .b +} -result {} +test cursor-6.68 {check cursor-font cursor top_left_corner} -setup { + button .b -text top_left_corner +} -body { + .b configure -cursor top_left_corner +} -cleanup { + destroy .b +} -result {} +test cursor-6.69 {check cursor-font cursor top_right_corner} -setup { + button .b -text top_right_corner +} -body { + .b configure -cursor top_right_corner +} -cleanup { + destroy .b +} -result {} +test cursor-6.70 {check cursor-font cursor top_side} -setup { + button .b -text top_side +} -body { + .b configure -cursor top_side +} -cleanup { + destroy .b +} -result {} +test cursor-6.71 {check cursor-font cursor top_tee} -setup { + button .b -text top_tee +} -body { + .b configure -cursor top_tee +} -cleanup { + destroy .b +} -result {} +test cursor-6.72 {check cursor-font cursor trek} -setup { + button .b -text trek +} -body { + .b configure -cursor trek +} -cleanup { + destroy .b +} -result {} +test cursor-6.73 {check cursor-font cursor ul_angle} -setup { + button .b -text ul_angle +} -body { + .b configure -cursor ul_angle +} -cleanup { + destroy .b +} -result {} +test cursor-6.74 {check cursor-font cursor umbrella} -setup { + button .b -text umbrella +} -body { + .b configure -cursor umbrella +} -cleanup { + destroy .b +} -result {} +test cursor-6.75 {check cursor-font cursor ur_angle} -setup { + button .b -text ur_angle +} -body { + .b configure -cursor ur_angle +} -cleanup { + destroy .b +} -result {} +test cursor-6.76 {check cursor-font cursor watch} -setup { + button .b -text watch +} -body { + .b configure -cursor watch +} -cleanup { + destroy .b +} -result {} +test cursor-6.77 {check cursor-font cursor xterm} -setup { + button .b -text xterm +} -body { + .b configure -cursor xterm +} -cleanup { + destroy .b +} -result {} # Test cursor named "none", it is not defined in # the X cursor table. It is defined in a Tk specific # table of named cursors and should be available on # all platforms. - -test cursor-6.80 {} -setup { +test cursor-6.78 {test cursor named "none"} -setup { button .b -text CButton } -body { .b configure -cursor none @@ -240,7 +729,7 @@ test cursor-6.80 {} -setup { destroy .b } -result none -test cursor-6.81 {} -setup { +test cursor-6.79 {test cursor named "none"} -setup { button .b -text CButton } -body { .b configure -cursor none @@ -250,7 +739,7 @@ test cursor-6.81 {} -setup { destroy .b } -result {} -test cursor-6.82 {} -setup { +test cursor-6.80 {test cursor named "none"} -setup { button .b -text CButton } -body { .b configure -cursor none @@ -261,7 +750,7 @@ test cursor-6.82 {} -setup { destroy .b } -result none -test cursor-6.83 {} -setup { +test cursor-6.81 {test cursor named "none"} -setup { button .b -text CButton } -body { # Setting fg and bg does nothing for the none cursor @@ -283,31 +772,72 @@ test cursor-6.83 {} -setup { # ------------------------------------------------------------------------- # Check the Windows specific cursors - -foreach {testName cursor} { - cursor-7.1 no - cursor-7.2 starting - cursor-7.3 size - cursor-7.4 size_ne_sw - cursor-7.5 size_ns - cursor-7.6 size_nw_se - cursor-7.7 size_we - cursor-7.8 uparrow - cursor-7.9 wait -} { - test $testName "check Windows cursor $cursor" -constraints win -setup { - button .b -text $cursor - } -body { - .b configure -cursor $cursor - } -cleanup { - destroy .b - } -result {} -} +test cursor-7.1 {check Windows cursor no} -constraints win -setup { + button .b -text no +} -body { + .b configure -cursor no +} -cleanup { + destroy .b +} -result {} +test cursor-7.2 {check Windows cursor starting} -constraints win -setup { + button .b -text starting +} -body { + .b configure -cursor starting +} -cleanup { + destroy .b +} -result {} +test cursor-7.3 {check Windows cursor size} -constraints win -setup { + button .b -text size +} -body { + .b configure -cursor size +} -cleanup { + destroy .b +} -result {} +test cursor-7.4 {check Windows cursor size_ne_sw} -constraints win -setup { + button .b -text size_ne_sw +} -body { + .b configure -cursor size_ne_sw +} -cleanup { + destroy .b +} -result {} +test cursor-7.5 {check Windows cursor size_ns} -constraints win -setup { + button .b -text size_ns +} -body { + .b configure -cursor size_ns +} -cleanup { + destroy .b +} -result {} +test cursor-7.6 {check Windows cursor size_nw_se} -constraints win -setup { + button .b -text size_nw_se +} -body { + .b configure -cursor size_nw_se +} -cleanup { + destroy .b +} -result {} +test cursor-7.7 {check Windows cursor size_we} -constraints win -setup { + button .b -text size_we +} -body { + .b configure -cursor size_we +} -cleanup { + destroy .b +} -result {} +test cursor-7.8 {check Windows cursor uparrow} -constraints win -setup { + button .b -text uparrow +} -body { + .b configure -cursor uparrow +} -cleanup { + destroy .b +} -result {} +test cursor-7.9 {check Windows cursor wait} -constraints win -setup { + button .b -text wait +} -body { + .b configure -cursor wait +} -cleanup { + destroy .b +} -result {} # ------------------------------------------------------------------------- -destroy .t - # cleanup cleanupTests return diff --git a/tests/dialog.test b/tests/dialog.test index 538461b..78b6620 100644 --- a/tests/dialog.test +++ b/tests/dialog.test @@ -1,58 +1,67 @@ # This file is a Tcl script to test out Tk's "tk_dialog" command. # It is organized in the standard fashion for Tcl tests. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test test dialog-1.1 {tk_dialog command} -body { - list [catch {tk_dialog} msg] $msg -} -match glob -result {1 {wrong # args: should be "tk_dialog w title text bitmap default *"}} -test dialog-1.2 {tk_dialog command} { - list [catch {tk_dialog foo foo foo foo foo} msg] $msg -} {1 {bad window path name "foo"}} -test dialog-1.3 {tk_dialog command} { - set res [list [catch {tk_dialog .d foo foo fooBitmap foo} msg] $msg] + tk_dialog +} -match glob -returnCodes error -result {wrong # args: should be "tk_dialog w title text bitmap default *"} +test dialog-1.2 {tk_dialog command} -body { + tk_dialog foo foo foo foo foo +} -returnCodes error -result {bad window path name "foo"} +test dialog-1.3 {tk_dialog command} -body { + tk_dialog .d foo foo fooBitmap foo +} -cleanup { destroy .d - set res -} {1 {bitmap "fooBitmap" not defined}} +} -returnCodes error -result {bitmap "fooBitmap" not defined} -proc PressButton {btn} { - if {![winfo ismapped $btn]} { - update - } - event generate $btn <Enter> - event generate $btn <1> -x 5 -y 5 - event generate $btn <ButtonRelease-1> -x 5 -y 5 -} - -proc HitReturn {w} { - event generate $w <Enter> - focus -force $w - event generate $w <KeyPress> -keysym Return -} -test dialog-2.0 {tk_dialog operation} { +test dialog-2.1 {tk_dialog operation} -setup { + proc PressButton {btn} { + if {![winfo ismapped $btn]} { + update + } + event generate $btn <Enter> + event generate $btn <1> -x 5 -y 5 + event generate $btn <ButtonRelease-1> -x 5 -y 5 + } +} -body { set x [after 5000 [list set tk::Priv(button) "no response"]] after 100 PressButton .d.button0 set res [tk_dialog .d foo foo info 0 click] after cancel $x - set res -} {0} -test dialog-2.1 {tk_dialog operation} { + return $res +} -cleanup { + destroy .d +} -result {0} +test dialog-2.2 {tk_dialog operation} -setup { + proc HitReturn {w} { + event generate $w <Enter> + focus -force $w + event generate $w <KeyPress> -keysym Return + } +} -body { set x [after 5000 [list set tk::Priv(button) "no response"]] after 100 HitReturn .d set res [tk_dialog .d foo foo info 1 click default] after cancel $x - set res -} {1} -test dialog-2.2 {tk_dialog operation} { + return $res +} -cleanup { + destroy .d +} -result {1} +test dialog-2.3 {tk_dialog operation} -body { set x [after 5000 [list set tk::Priv(button) "no response"]] after 100 destroy .d set res [tk_dialog .d foo foo info 0 click] after cancel $x - set res -} {-1} + return $res +} -cleanup { + destroy .b +} -result {-1} cleanupTests return + diff --git a/tests/embed.test b/tests/embed.test index bac2675..1fe73ef 100644 --- a/tests/embed.test +++ b/tests/embed.test @@ -4,67 +4,85 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -global tcl_platform -test embed-1.1 {TkpUseWindow procedure, bad window identifier} { +test embed-1.1 {TkpUseWindow procedure, bad window identifier} -setup { deleteWindows - list [catch {toplevel .t -use xyz} msg] $msg -} {1 {expected integer but got "xyz"}} +} -body { + toplevel .t -use xyz +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "xyz"} -test embed-1.2 {CreateFrame procedure, bad window identifier} { +test embed-1.2 {CreateFrame procedure, bad window identifier} -setup { + deleteWindows +} -body { + toplevel .t -container xyz +} -cleanup { deleteWindows - list [catch {toplevel .t -container xyz} msg] $msg -} {1 {expected boolean value but got "xyz"}} +} -returnCodes error -result {expected boolean value but got "xyz"} -test embed-1.3 {CreateFrame procedure, both -use and - -container is invalid } { +test embed-1.3 {CreateFrame procedure, both -use and -container is invalid} -setup { deleteWindows +} -body { toplevel .container -container 1 - list [catch {toplevel .t -use [winfo id .container] \ - -container 1} msg] $msg -} {1 {A window cannot have both the -use and the -container option set.}} - -if {$tcl_platform(platform) == "windows"} { - -# testing window embedding for Windows platform + toplevel .t -use [winfo id .container] -container 1 +} -cleanup { + deleteWindows +} -returnCodes error -result {windows cannot have both the -use and the -container option set} -test embed-1.4.win {TkpUseWindow procedure, -container must be set} { +# testing window embedding for win platforms +test embed-1.4.win {TkpUseWindow procedure, -container must be set} -constraints { + win +} -setup { deleteWindows +} -body { toplevel .container - list [catch {toplevel .embd -use [winfo id .container]} err] $err -} {1 {the window to use is not a Tk container}} - -test embed-1.5.win {TkpUseWindow procedure, -container must be set} { + toplevel .embd -use [winfo id .container] +} -cleanup { deleteWindows +} -returnCodes error -result {the window to use is not a Tk container} +# testing window embedding for win platforms +test embed-1.5.win {TkpUseWindow procedure, -container must be set} -constraints { + win +} -setup { + deleteWindows +} -body { frame .container - list [catch {toplevel .embd -use [winfo id .container]} err] $err -} {1 {the window to use is not a Tk container}} - -} else { - -# testing window embedding for other platforms + toplevel .embd -use [winfo id .container] +} -cleanup { + deleteWindows +} -returnCodes error -result {the window to use is not a Tk container} -test embed-1.4.nonwin {TkpUseWindow procedure, -container must be set} { +# testing window embedding for other than win platforms +test embed-1.4.nonwin {TkpUseWindow procedure, -container must be set} -constraints { + nonwin +} -setup { deleteWindows +} -body { toplevel .container - list [catch {toplevel .embd -use [winfo id .container]} err] $err -} {1 {window ".container" doesn't have -container option set}} - -test embed-1.5.nonwin {TkpUseWindow procedure, -container must be set} { + toplevel .embd -use [winfo id .container] +} -cleanup { + deleteWindows +} -returnCodes error -result {window ".container" doesn't have -container option set} +# testing window embedding for other than win platforms +test embed-1.5.nonwin {TkpUseWindow procedure, -container must be set} -constraints { + nonwin +} -setup { deleteWindows +} -body { frame .container - list [catch {toplevel .embd -use [winfo id .container]} err] $err -} {1 {window ".container" doesn't have -container option set}} - -} + toplevel .embd -use [winfo id .container] +} -cleanup { + deleteWindows +} -returnCodes error -result {window ".container" doesn't have -container option set} -# FIXME: test cases common to unixEmbed.test and macEmbed.test should -# be moved here. cleanupTests return + diff --git a/tests/entry.test b/tests/entry.test index da3637d..9c30b00 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -6,221 +6,880 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +# For xscrollcommand proc scroll args { - global scrollInfo - set scrollInfo $args + global scrollInfo + set scrollInfo $args +} +# For trace variable +proc override args { + global x + set x 12345 } -# Create additional widget that's used to hold the selection at times. - -entry .sel -.sel insert end "This is some sample text" - -# Font names - -set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1 -set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1 - -# Create entries in the option database to be sure that geometry options -# like border width have predictable values. - -option add *Entry.borderWidth 2 -option add *Entry.highlightThickness 2 -option add *Entry.font {Helvetica -12} - -entry .e -bd 2 -relief sunken -pack .e -update - -set i 1 -foreach test { - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-disabledbackground green green non-existent - {unknown color name "non-existent"}} - {-disabledforeground blue blue non-existent - {unknown color name "non-existent"}} - {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} - {-fg #110022 #110022 bogus {unknown color name "bogus"}} - {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {} - {font "" doesn't exist}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"}} - {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} - {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} - {-highlightthickness -2 0 {} {}} - {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}} - {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} - {-insertontime 100 100 3.2 {expected integer but got "3.2"}} - {-invalidcommand "any string" "any string" {} {}} - {-invcmd "any string" "any string" {} {}} - {-justify right right bogus {bad justification "bogus": must be left, right, or center}} - {-readonlybackground green green non-existent - {unknown color name "non-existent"}} - {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} - {-show * * {} {}} - {-state n normal bogus - {bad state "bogus": must be disabled, normal, or readonly}} - {-takefocus "any string" "any string" {} {}} - {-textvariable i i {} {}} - {-width 402 402 3p {expected integer but got "3p"}} - {-xscrollcommand {Some command} {Some command} {} {}} -} { - lassign $test name goodValue goodResult badValue badResult - test entry-1.$i {configuration options} { - .e configure $name $goodValue - list [lindex [.e configure $name] 4] [.e cget $name] - } [list $goodResult $goodResult] - incr i - if {$badValue ne ""} { - test entry-1.$i {configuration options} -body { - .e configure $name $badValue - } -returnCodes error -result $badResult - } - .e configure $name [lindex [.e configure $name] 3] - incr i +# Procedures used in widget VALIDATION tests +proc doval {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 1 +} +proc doval2 {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + set ::e mydata + return 1 +} +proc doval3 {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 0 } -test entry-2.1 {Tk_EntryCmd procedure} { - list [catch {entry} msg] $msg -} {1 {wrong # args: should be "entry pathName ?options?"}} -test entry-2.2 {Tk_EntryCmd procedure} { - list [catch {entry gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test entry-2.3 {Tk_EntryCmd procedure} { - catch {destroy .e} +set cy [font metrics {Courier -12} -linespace] + + +test entry-1.1 {configuration option: "background" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -background #ff0000 + .e cget -background +} -cleanup { + destroy .e +} -result {#ff0000} +test entry-1.2 {configuration option: "background" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -background non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.3 {configuration option: "bd" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -bd 4 + .e cget -bd +} -cleanup { + destroy .e +} -result {4} +test entry-1.4 {configuration option: "bd" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -bd badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test entry-1.5 {configuration option: "bg" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -bg #ff0000 + .e cget -bg +} -cleanup { + destroy .e +} -result {#ff0000} +test entry-1.6 {configuration option: "bg" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -bg non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.7 {configuration option: "borderwidth" for entry} -setup { + entry .e -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -borderwidth 1.3 + .e cget -borderwidth +} -cleanup { + destroy .e +} -result {1} +test entry-1.8 {configuration option: "borderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -borderwidth badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test entry-1.9 {configuration option: "cursor" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -cursor arrow + .e cget -cursor +} -cleanup { + destroy .e +} -result {arrow} +test entry-1.10 {configuration option: "cursor" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -cursor badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test entry-1.11 {configuration option: "disabledbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -disabledbackground green + .e cget -disabledbackground +} -cleanup { + destroy .e +} -result {green} +test entry-1.12 {configuration option: "disabledbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -disabledbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.13 {configuration option: "disabledforeground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -disabledforeground blue + .e cget -disabledforeground +} -cleanup { + destroy .e +} -result {blue} +test entry-1.14 {configuration option: "disabledforeground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -disabledforeground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.15 {configuration option: "exportselection" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -exportselection yes + .e cget -exportselection +} -cleanup { + destroy .e +} -result {1} +test entry-1.16 {configuration option: "exportselection" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -exportselection xyzzy +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected boolean value but got "xyzzy"} + +test entry-1.17 {configuration option: "fg" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -fg #110022 + .e cget -fg +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.18 {configuration option: "fg" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -fg non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.19 {configuration option: "font" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e configure -font {Helvetica -12} + .e cget -font +} -cleanup { + destroy .e +} -result {Helvetica -12} +test entry-1.20 {configuration option: "font" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e configure -font {} +} -cleanup { + destroy .e +} -returnCodes {error} -result {font "" doesn't exist} + +test entry-1.21 {configuration option: "foreground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -foreground #110022 + .e cget -foreground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.22 {configuration option: "foreground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -foreground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.23 {configuration option: "highlightbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightbackground #110022 + .e cget -highlightbackground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.24 {configuration option: "highlightbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.25 {configuration option: "highlightcolor" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightcolor #110022 + .e cget -highlightcolor +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.26 {configuration option: "highlightcolor" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightcolor non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.27 {configuration option: "highlightthickness" for entry} -setup { + entry .e -borderwidth 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightthickness 6 + .e cget -highlightthickness +} -cleanup { + destroy .e +} -result {6} +test entry-1.28 {configuration option: "highlightthickness" for entry} -setup { + entry .e -borderwidth 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightthickness -2 + .e cget -highlightthickness +} -cleanup { + destroy .e +} -result {0} +test entry-1.29 {configuration option: "highlightthickness" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -highlightthickness badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test entry-1.30 {configuration option: "insertbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertbackground #110022 + .e cget -insertbackground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.31 {configuration option: "insertbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.32 {configuration option: "insertborderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertborderwidth 1.3 + .e cget -insertborderwidth +} -cleanup { + destroy .e +} -result {1} +test entry-1.33 {configuration option: "insertborderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertborderwidth 2.6x +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "2.6x"} + +test entry-1.34 {configuration option: "insertofftime" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertofftime 100 + .e cget -insertofftime +} -cleanup { + destroy .e +} -result {100} +test entry-1.35 {configuration option: "insertofftime" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertofftime 3.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3.2"} + +test entry-1.36 {configuration option: "insertontime" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertontime 100 + .e cget -insertontime +} -cleanup { + destroy .e +} -result {100} +test entry-1.37 {configuration option: "insertontime" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -insertontime 3.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3.2"} + +test entry-1.38 {configuration option: "invalidcommand" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -invalidcommand "any string" + .e cget -invalidcommand +} -cleanup { + destroy .e +} -result {any string} + +test entry-1.39 {configuration option: "invcmd" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -invcmd "any string" + .e cget -invcmd +} -cleanup { + destroy .e +} -result {any string} + +test entry-1.40 {configuration option: "justify" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -justify right + .e cget -justify +} -cleanup { + destroy .e +} -result {right} +test entry-1.41 {configuration option: "justify" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -justify bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} + +test entry-1.42 {configuration option: "readonlybackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -readonlybackground green + .e cget -readonlybackground +} -cleanup { + destroy .e +} -result {green} +test entry-1.43 {configuration option: "readonlybackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -readonlybackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.44 {configuration option: "relief" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -relief flat + .e cget -relief +} -cleanup { + destroy .e +} -result {flat} + +test entry-1.45 {configuration option: "selectbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectbackground #110022 + .e cget -selectbackground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.46 {configuration option: "selectbackground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.47 {configuration option: "selectborderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectborderwidth 1.3 + .e cget -selectborderwidth +} -cleanup { + destroy .e +} -result {1} +test entry-1.48 {configuration option: "selectborderwidth" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectborderwidth badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test entry-1.49 {configuration option: "selectforeground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectforeground #110022 + .e cget -selectforeground +} -cleanup { + destroy .e +} -result {#110022} +test entry-1.50 {configuration option: "selectforeground" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -selectforeground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test entry-1.51 {configuration option: "show" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -show * + .e cget -show +} -cleanup { + destroy .e +} -result {*} + +test entry-1.52 {configuration option: "state" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -state n + .e cget -state +} -cleanup { + destroy .e +} -result {normal} +test entry-1.53 {configuration option: "state" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -state bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad state "bogus": must be disabled, normal, or readonly} + +test entry-1.54 {configuration option: "takefocus" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -takefocus "any string" + .e cget -takefocus +} -cleanup { + destroy .e +} -result {any string} + +test entry-1.55 {configuration option: "textvariable" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -textvariable i + .e cget -textvariable +} -cleanup { + destroy .e +} -result {i} + +test entry-1.56 {configuration option: "width" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -width 402 + .e cget -width +} -cleanup { + destroy .e +} -result {402} +test entry-1.57 {configuration option: "width" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -width 3p +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3p"} + +test entry-1.58 {configuration option: "xscrollcommand" for entry} -setup { + entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .e + update +} -body { + .e configure -xscrollcommand {Some command} + .e cget -xscrollcommand +} -cleanup { + destroy .e +} -result {Some command} + + + +test entry-2.1 {Tk_EntryCmd procedure} -body { + entry +} -returnCodes error -result {wrong # args: should be "entry pathName ?-option value ...?"} +test entry-2.2 {Tk_EntryCmd procedure} -body { + entry gorp +} -returnCodes error -result {bad window path name "gorp"} +test entry-2.3 {Tk_EntryCmd procedure} -body { entry .e + pack .e + update list [winfo exists .e] [winfo class .e] [info commands .e] -} {1 Entry .e} -test entry-2.4 {Tk_EntryCmd procedure} { - catch {destroy .e} - list [catch {entry .e -gorp foo} msg] $msg [winfo exists .e] \ - [info commands .e] -} {1 {unknown option "-gorp"} 0 {}} -test entry-2.5 {Tk_EntryCmd procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {1 Entry .e} +test entry-2.4 {Tk_EntryCmd procedure} -body { + entry .e -gorp foo +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-gorp"} +test entry-2.4.1 {Tk_EntryCmd procedure} -body { + catch {entry .e -gorp foo} + list [winfo exists .e] [info commands .e] +} -cleanup { + destroy .e +} -result {0 {}} +test entry-2.5 {Tk_EntryCmd procedure} -body { entry .e -} {.e} - -catch {destroy .e} -entry .e -font $fixed -pack .e -update - -set cx [font measure $fixed a] -set cy [font metrics $fixed -linespace] -set ux [font measure $fixed \u4e4e] - -test entry-3.1 {EntryWidgetCmd procedure} { - list [catch {.e} msg] $msg -} {1 {wrong # args: should be ".e option ?arg arg ...?"}} -test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox} msg] $msg -} {1 {wrong # args: should be ".e bbox index"}} -test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox a b} msg] $msg -} {1 {wrong # args: should be ".e bbox index"}} -test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox bogus} msg] $msg -} {1 {bad entry index "bogus"}} -test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} { - .e delete 0 end - .e bbox 0 -} [list 5 5 0 $cy] -test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): no utf chars +} -cleanup { + destroy .e +} -result {.e} - .e delete 0 end + +test entry-3.1 {EntryWidgetCmd procedure} -setup { + entry .e + pack .e + update +} -body { + .e +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e option ?arg ...?"} +test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e bbox index"} +test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox a b +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e bbox index"} +test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e + pack .e + update +} -body { + .e bbox bogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "bogus"} +test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox 0 +} -cleanup { + destroy .e +} -result [list 5 5 0 $cy] + +# Previously the result was count using previousli counted font measurements +# and metrics. It was changed to less verbose solution - the result is the one +# that passes fonts constraint (this concerns tests 3.6, 3.7, 3.8, 3.10) +test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): no utf chars .e insert 0 "abc" list [.e bbox 3] [.e bbox end] -} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"] -test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): utf at end - .e delete 0 end +} -cleanup { + destroy .e +} -result {{19 5 7 13} {19 5 7 13}} +test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): utf at end .e insert 0 "ab\u4e4e" .e bbox end -} "[expr 5+2*$cx] 5 $ux $cy" -test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): utf before index - .e delete 0 end +} -cleanup { + destroy .e +} -result {19 5 12 13} +test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): utf before index .e insert 0 "ab\u4e4ec" .e bbox 3 -} "[expr 5+2*$cx+$ux] 5 $cx $cy" -test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): no chars - .e delete 0 end +} -cleanup { + destroy .e +} -result {31 5 7 13} +test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): no chars .e bbox end -} "5 5 0 $cy" -test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result "5 5 0 $cy" +test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { .e insert 0 "abcdefghij\u4e4eklmnop" list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end] -} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"] -test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget} msg] $msg -} {1 {wrong # args: should be ".e cget option"}} -test entry-3.12 {EntryWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget a b} msg] $msg -} {1 {wrong # args: should be ".e cget option"}} -test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} { +} -cleanup { + destroy .e +} -result {{5 5 7 13} {12 5 7 13} {75 5 12 13} {122 5 7 13}} +test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} -setup { + entry .e +} -body { + .e cget +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e cget option"} +test entry-3.12 {EntryWidgetCmd procedure, "cget" widget command} -setup { + entry .e +} -body { + .e cget a b +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e cget option"} +test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} -setup { + entry .e +} -body { + .e cget -gorp +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-gorp"} +test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} -setup { + entry .e +} -body { .e configure -bd 4 .e cget -bd -} {4} -test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} { +} -cleanup { + destroy .e +} -result {4} +test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} -setup { + entry .e + pack .e + update +} -body { llength [.e configure] -} {36} -test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} { - list [catch {.e configure -foo} msg] $msg -} {1 {unknown option "-foo"}} -test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} { +} -cleanup { + destroy .e +} -result {36} +test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} -setup { + entry .e +} -body { + .e configure -foo +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-foo"} +test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} -setup { + entry .e +} -body { .e configure -bd 4 .e configure -bg #ffffff lindex [.e configure -bd] 4 -} {4} -test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete} msg] $msg -} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} -test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete a b c} msg] $msg -} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} -test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete foo} msg] $msg -} {1 {bad entry index "foo"}} -test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete 0 bar} msg] $msg -} {1 {bad entry index "bar"}} -test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { + .e delete +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e delete firstIndex ?lastIndex?"} +test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { + .e delete a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e delete firstIndex ?lastIndex?"} +test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { + .e delete foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "foo"} +test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { + .e delete 0 bar +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "bar"} +test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e delete 2 4 .e get -} {014567890} -test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {014567890} +test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e +} -body { .e insert end "01234567890" .e delete 6 .e get -} {0123457890} -test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} { - # UTF +} -cleanup { + destroy .e +} -result {0123457890} +test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update set x {} - .e delete 0 end +} -body { +# UTF .e insert end "01234\u4e4e67890" .e delete 6 lappend x [.e get] @@ -232,311 +891,659 @@ test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} { .e insert end "0123456\u4e4e890" .e delete 6 lappend x [.e get] -} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] -test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] +test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e delete 6 5 .e get -} {01234567890} -test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state disabled .e delete 2 8 .e configure -state normal .e get -} {01234567890} -test entry-3.26a {EntryWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.26a {EntryWidgetCmd procedure, "delete" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state readonly .e delete 2 8 .e configure -state normal .e get -} {01234567890} -test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} { - list [catch {.e get foo} msg] $msg -} {1 {wrong # args: should be ".e get"}} -test entry-3.28 {EntryWidgetCmd procedure, "icursor" widget command} { - list [catch {.e icursor} msg] $msg -} {1 {wrong # args: should be ".e icursor pos"}} -test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} { - list [catch {.e icursor foo} msg] $msg -} {1 {bad entry index "foo"}} -test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} -setup { + entry .e +} -body { + .e get foo +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e get"} +test entry-3.28 {EntryWidgetCmd procedure, "icursor" widget command} -setup { + entry .e +} -body { + .e icursor +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e icursor pos"} +test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} -setup { + entry .e +} -body { + .e icursor foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "foo"} +test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} -setup { + entry .e +} -body { .e insert end "01234567890" .e icursor 4 .e index insert -} {4} -test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} { - list [catch {.e in} msg] $msg -} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}} -test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} { - list [catch {.e index} msg] $msg -} {1 {wrong # args: should be ".e index string"}} -test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} { - list [catch {.e index foo} msg] $msg -} {1 {bad entry index "foo"}} -test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} { - list [catch {.e index 0} msg] $msg -} {0 0} -test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} { - # UTF - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e +} -body { + .e in +} -cleanup { + destroy .e +} -returnCodes error -result {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview} +test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e +} -body { + .e index +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e index string"} +test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e +} -body { + .e index foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "foo"} +test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e + pack .e + update +} -body { + .e index 0 +} -cleanup { + destroy .e +} -returnCodes {ok} -match glob -result {*} +test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} -setup { + entry .e + pack .e + update +} -body { +# UTF .e insert 0 abc\u4e4e\u0153def list [.e index 3] [.e index 4] [.e index end] -} {3 4 8} -test entry-3.36 {EntryWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test entry-3.37 {EntryWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a b c} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert foo Text} msg] $msg -} {1 {bad entry index "foo"}} -test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 4 8} +test entry-3.36 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e +} -body { + .e insert a +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test entry-3.37 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e +} -body { + .e insert a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e +} -body { + .e insert foo Text +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "foo"} +test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e insert 3 xxx .e get -} {012xxx34567890} -test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {012xxx34567890} +test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state disabled .e insert 3 xxx .e configure -state normal .e get -} {01234567890} -test entry-3.40a {EntryWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.40a {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state readonly .e insert 3 xxx .e configure -state normal .e get -} {01234567890} -test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a b c} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan a} msg] $msg -} {1 {wrong # args: should be ".e scan mark|dragto x"}} -test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan a b c} msg] $msg -} {1 {wrong # args: should be ".e scan mark|dragto x"}} -test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan foobar 20} msg] $msg -} {1 {bad scan option "foobar": must be mark or dragto}} -test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan mark 20.1} msg] $msg -} {1 {expected integer but got "20.1"}} -# This test is non-portable because character sizes vary. +} -cleanup { + destroy .e +} -result {01234567890} +test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} -setup { + entry .e +} -body { + .e insert a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} -setup { + entry .e + pack .e + update +} -body { + .e scan a +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} +test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} -setup { + entry .e + pack .e + update +} -body { + .e scan a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} +test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} -setup { + entry .e + pack .e + update +} -body { + .e scan foobar 20 +} -cleanup { + destroy .e +} -returnCodes error -result {bad scan option "foobar": must be mark or dragto} +test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} -setup { + entry .e + pack .e + update +} -body { + .e scan mark 20.1 +} -cleanup { + destroy .e +} -returnCodes error -result {expected integer but got "20.1"} -test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} {fonts} { - .e delete 0 end +# This test is non-portable because character sizes vary. +test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} -constraints { + fonts +} -setup { + entry .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 + pack .e update +} -body { .e insert end "This is quite a long string, in fact a " .e insert end "very very long string" .e scan mark 30 .e scan dragto 28 .e index @0 -} {2} -test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} { - list [catch {.e select} msg] $msg -} {1 {wrong # args: should be ".e selection option ?index?"}} -test entry-3.48 {EntryWidgetCmd procedure, "select" widget command} { - list [catch {.e select foo} msg] $msg -} {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}} -test entry-3.49 {EntryWidgetCmd procedure, "select clear" widget command} { - list [catch {.e select clear gorp} msg] $msg -} {1 {wrong # args: should be ".e selection clear"}} -test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2} +test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} -setup { + entry .e +} -body { + .e select +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection option ?index?"} +test entry-3.48 {EntryWidgetCmd procedure, "select" widget command} -setup { + entry .e +} -body { + .e select foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad selection option "foo": must be adjust, clear, from, present, range, or to} + +test entry-3.49 {EntryWidgetCmd procedure, "select clear" widget command} -setup { + entry .e +} -body { + .e select clear gorp +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection clear"} +test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} -setup { + entry .e +} -body { .e insert end "0123456789" .e select from 1 .e select to 4 update .e select clear - list [catch {selection get} msg] $msg [selection own] -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e} -test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} { - list [catch {.e selection present foo} msg] $msg -} {1 {wrong # args: should be ".e selection present"}} -test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end + selection get +} -cleanup { + destroy .e +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test entry-3.50.1 {EntryWidgetCmd procedure, "select clear" widget command} -setup { + entry .e + pack .e + update +} -body { + .e insert end "0123456789" + .e select from 1 + .e select to 4 + update + .e select clear + catch {selection get} + selection own +} -cleanup { + destroy .e +} -result {.e} + +test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + entry .e +} -body { + .e selection present foo +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection present"} +test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e selection present -} {1} -test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e configure -exportselection false .e selection present -} {1} -.e configure -exportselection true -test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e delete 0 end .e selection present -} {0} -test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} { - list [catch {.e select adjust x} msg] $msg -} {1 {bad entry index "x"}} -test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} { - list [catch {.e select adjust 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection adjust index"}} -test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0} +test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + entry .e +} -body { + .e select adjust x +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "x"} +test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + entry .e +} -body { + .e select adjust 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection adjust index"} +test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 4 selection get -} {123} -test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {123} +test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 2 selection get -} {234} -test entry-3.59 {EntryWidgetCmd procedure, "selection from" widget command} { - list [catch {.e select from 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection from index"}} -test entry-3.60 {EntryWidgetCmd procedure, "selection range" widget command} { - list [catch {.e select range 2} msg] $msg -} {1 {wrong # args: should be ".e selection range start end"}} -test entry-3.61 {EntryWidgetCmd procedure, "selection range" widget command} { - list [catch {.e selection range 2 3 4} msg] $msg -} {1 {wrong # args: should be ".e selection range start end"}} -test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {234} +test entry-3.59 {EntryWidgetCmd procedure, "selection from" widget command} -setup { + entry .e +} -body { + .e select from 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection from index"} + +test entry-3.60 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + entry .e +} -body { + .e select range 2 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection range start end"} +test entry-3.61 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + entry .e +} -body { + .e selection range 2 3 4 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection range start end"} +test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + entry .e +} -body { .e insert end 0123456789 .e select from 1 .e select to 5 .e select range 4 4 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} { - .e delete 0 end + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 7 .e select range 2 9 list [.e index sel.first] [.e index sel.last] [.e index anchor] -} {2 9 3} -test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 3} +test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e selection range 0 end .e configure -state disabled .e selection range 2 4 .e configure -state normal list [.e index sel.first] [.e index sel.last] -} {0 10} -test entry-3.64a {EntryWidgetCmd procedure, "selection" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0 10} +test entry-3.64a {EntryWidgetCmd procedure, "selection" widget command} -setup { + entry .e + pack .e + update +} -body { .e insert end 0123456789 .e selection range 0 end .e configure -state readonly .e selection range 2 4 .e configure -state normal list [.e index sel.first] [.e index sel.last] -} {2 4} -.e delete 0 end -.e insert end "This is quite a long text string, so long that it " -.e insert end "runs off the end of the window quite a bit." -test entry-3.64b {EntryWidgetCmd procedure, "selection to" widget command} { - list [catch {.e select to 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection to index"}} -test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {2 4} +test entry-3.64b {EntryWidgetCmd procedure, "selection to" widget command} -setup { + entry .e + pack .e + update + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." +} -body { + .e select to 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection to index"} + +test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 5 format {%.7f %.7f} {*}[.e xview] -} {0.0537634 0.2688172} -test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview gorp} msg] $msg -} {1 {bad entry index "gorp"}} -test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.0537634 0.2688172} +test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview gorp +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "gorp"} +test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 0 .e icursor 10 .e xview insert format {%.6f %.6f} {*}[.e xview] -} {0.107527 0.322581} -test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview moveto foo bar} msg] $msg -} {1 {wrong # args: should be ".e xview moveto fraction"}} -test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview moveto foo} msg] $msg -} {1 {expected floating-point number but got "foo"}} -test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.107527 0.322581} +test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview moveto foo bar +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e xview moveto fraction"} +test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview moveto foo +} -cleanup { + destroy .e +} -returnCodes error -result {expected floating-point number but got "foo"} +test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview moveto 0.5 format {%.6f %.6f} {*}[.e xview] -} {0.505376 0.720430} -test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll 24} msg] $msg -} {1 {wrong # args: should be ".e xview scroll number units|pages"}} -test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll gorp units} msg] $msg -} {1 {expected integer but got "gorp"}} -test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.505376 0.720430} +test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + .e xview scroll 24 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e xview scroll number units|pages"} +test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview scroll gorp units +} -cleanup { + destroy .e +} -returnCodes error -result {expected integer but got "gorp"} +test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview moveto 0 .e xview scroll 1 pages format {%.6f %.6f} {*}[.e xview] -} {0.193548 0.408602} -test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.193548 0.408602} +test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview moveto .9 update .e xview scroll -2 p format {%.6f %.6f} {*}[.e xview] -} {0.397849 0.612903} -test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.397849 0.612903} +test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 30 update .e xview scroll 2 units .e index @0 -} {32} -test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {32} +test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 30 update .e xview scroll -1 units .e index @0 -} {29} -test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll 23 foobars} msg] $msg -} {1 {bad argument "foobars": must be units or pages}} -test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview eat 23 hamburgers} msg] $msg -} {1 {unknown option "eat": must be moveto or scroll}} -test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {29} +test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview scroll 23 foobars +} -cleanup { + destroy .e +} -returnCodes error -result {bad argument "foobars": must be units or pages} +test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview eat 23 hamburgers +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "eat": must be moveto or scroll} +test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 0 update .e xview -4 .e index @0 -} {0} -test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0} +test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 300 .e index @0 -} {73} -.e insert 10 \u4e4e -test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} { - # UTF - # If Tcl_NumUtfChars wasn't used, wrong answer would be: - # 0.106383 0.117021 0.117021 - +} -cleanup { + destroy .e +} -result {73} +test entry-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + .e insert 10 \u4e4e + update +# UTF +# If Tcl_NumUtfChars wasn't used, wrong answer would be: +# 0.106383 0.117021 0.117021 set x {} .e xview moveto .1 lappend x [format {%.6f} [lindex [.e xview] 0]] @@ -544,269 +1551,395 @@ test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} { lappend x [format {%.6f} [lindex [.e xview] 0]] .e xview moveto .12 lappend x [format {%.6f} [lindex [.e xview] 0]] -} {0.095745 0.106383 0.117021} -test entry-3.82 {EntryWidgetCmd procedure} { - list [catch {.e gorp} msg] $msg -} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}} +} -cleanup { + destroy .e +} -result {0.095745 0.106383 0.117021} + +test entry-3.82 {EntryWidgetCmd procedure} -setup { + entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e gorp +} -cleanup { + destroy .e +} -returnCodes error -result {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview} # The test below doesn't actually check anything directly, but if run # with Purify or some other memory-allocation-checking program it will # ensure that resources get properly freed. -test entry-4.1 {DestroyEntry procedure} { - catch {destroy .e} +test entry-4.1 {DestroyEntry procedure} -body { entry .e -textvariable x -show * pack .e .e insert end "Sample text" update destroy .e -} {} +} -result {} -frame .f -width 200 -height 50 -relief raised -bd 2 -pack .f -side right -test entry-5.1 {ConfigureEntry procedure, -textvariable} { - catch {destroy .e} +test entry-5.1 {ConfigureEntry procedure, -textvariable} -body { set x 12345 entry .e -textvariable x .e get -} {12345} -test entry-5.2 {ConfigureEntry procedure, -textvariable} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {12345} +test entry-5.2 {ConfigureEntry procedure, -textvariable} -body { set x 12345 entry .e -textvariable x set y abcde .e configure -textvariable y set x 54321 .e get -} {abcde} -test entry-5.3 {ConfigureEntry procedure, -textvariable} { - catch {destroy .e} - catch {unset x} +} -cleanup { + destroy .e +} -result {abcde} +test entry-5.3 {ConfigureEntry procedure, -textvariable} -setup { + unset -nocomplain x entry .e +} -body { .e insert 0 "Some text" .e configure -textvariable x - set x -} {Some text} -test entry-5.4 {ConfigureEntry procedure, -textvariable} { - proc override args { - global x - set x 12345 - } - catch {destroy .e} - catch {unset x} - trace variable x w override + return $x +} -cleanup { + destroy .e +} -result {Some text} +test entry-5.4 {ConfigureEntry procedure, -textvariable} -setup { + unset -nocomplain x entry .e +} -body { + trace variable x w override .e insert 0 "Some text" .e configure -textvariable x - set result [list $x [.e get]] - unset x; rename override {} - set result -} {12345 12345} -test entry-5.5 {ConfigureEntry procedure} { - catch {destroy .e} - entry .e -exportselection false - pack .e - .e insert end "0123456789" - .sel select from 0 - .sel select to 10 + list $x [.e get] +} -cleanup { + destroy .e + trace vdelete x w override + unset x; +} -result {12345 12345} + +test entry-5.5 {ConfigureEntry procedure} -setup { set x {} + entry .e1 + entry .e2 +} -body { + .e2 insert end "This is some sample text" + .e1 configure -exportselection false + .e1 insert end "0123456789" + pack .e1 .e2 + .e2 select from 0 + .e2 select to 10 lappend x [selection get] - .e select from 1 - .e select to 5 + .e1 select from 1 + .e1 select to 5 lappend x [selection get] - .e configure -exportselection 1 + .e1 configure -exportselection 1 lappend x [selection get] - set x -} {{This is so} {This is so} 1234} -test entry-5.6 {ConfigureEntry procedure} { - catch {destroy .e} + return $x +} -cleanup { + destroy .e1 .e2 +} -result {{This is so} {This is so} 1234} +test entry-5.6 {ConfigureEntry procedure} -setup { + entry .e + pack .e +} -body { + .e insert end "0123456789" + .e select from 1 + .e select to 5 + .e configure -exportselection 0 + selection get +} -cleanup { + destroy .e +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test entry-5.6.1 {ConfigureEntry procedure} -setup { entry .e pack .e +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 .e configure -exportselection 0 - list [catch {selection get} msg] $msg [.e index sel.first] \ - [.e index sel.last] -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5} -test entry-5.7 {ConfigureEntry procedure} { - catch {destroy .e} - entry .e -font $fixed -width 4 -xscrollcommand scroll + catch {selection get} + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {1 5} + +test entry-5.7 {ConfigureEntry procedure} -setup { + entry .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -width 4 -xscrollcommand scroll .e insert end "01234567890" update .e configure -width 5 format {%.6f %.6f} {*}$scrollInfo -} {0.000000 0.363636} -test entry-5.8 {ConfigureEntry procedure} {fonts} { - catch {destroy .e} - entry .e -width 0 +} -cleanup { + destroy .e +} -result {0.000000 0.363636} + + +test entry-5.8 {ConfigureEntry procedure} -constraints { + fonts +} -setup { + entry .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -width 0 -font {Helvetica -12} .e insert end "0123" update - .e configure -font $big + .e configure -font {Helvetica -24} update winfo geom .e -} {62x37+0+0} -test entry-5.9 {ConfigureEntry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised +} -cleanup { + destroy .e +} -result {62x37+0+0} +test entry-5.9 {ConfigureEntry procedure} -constraints { + fonts +} -setup { + entry .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] -} {0 0 1 1} -test entry-5.10 {ConfigureEntry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief flat +} -cleanup { + destroy .e +} -result {0 0 1 1} +test entry-5.10 {ConfigureEntry procedure} -constraints { + fonts +} -setup { + entry .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief flat .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] -} {0 0 1 1} -test entry-5.11 {ConfigureEntry procedure} { - # If "0" in selected font had 0 width, caused divide-by-zero error. - - catch {destroy .e} - pack [entry .e -font {{open look glyph}}] +} -cleanup { + destroy .e +} -result {0 0 1 1} +test entry-5.11 {ConfigureEntry procedure} -setup { + entry .e -borderwidth 2 -highlightthickness 2 + pack .e +} -body { +# If "0" in selected font had 0 width, caused divide-by-zero error. + .e configure -font {{open look glyph}} .e scan dragto 30 update -} {} +} -cleanup { + destroy .e +} -result {} # No tests for DisplayEntry. -test entry-6.1 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3 +test entry-6.1 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ + -highlightthickness 3 .e insert end 012\t45 update list [.e index @61] [.e index @62] -} {3 4} -test entry-6.2 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 20 -justify center \ - -highlightthickness 3 +} -cleanup { + destroy .e +} -result {3 4} +test entry-6.2 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ + -justify center -highlightthickness 3 .e insert end 012\t45 update list [.e index @96] [.e index @97] -} {3 4} -test entry-6.3 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 20 -justify right \ - -highlightthickness 3 +} -cleanup { + destroy .e +} -result {3 4} +test entry-6.3 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ + -justify right -highlightthickness 3 .e insert end 012\t45 update list [.e index @131] [.e index @132] -} {3 4} -test entry-6.4 {EntryComputeGeometry procedure} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {3 4} +test entry-6.4 {EntryComputeGeometry procedure} -setup { + entry .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 6 .e index @0 -} {6} -test entry-6.5 {EntryComputeGeometry procedure} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {6} +test entry-6.5 {EntryComputeGeometry procedure} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 7 .e index @0 -} {6} -test entry-6.6 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $fixed -bd 2 -relief raised -width 10 +} -cleanup { + destroy .e +} -result {6} +test entry-6.6 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 10 .e insert end "01234\t67890" update .e xview 3 list [.e index @39] [.e index @40] -} {5 6} -test entry-6.7 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $big -bd 3 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {5 6} +test entry-6.7 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 5 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] -} {77 39} -test entry-6.8 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $big -bd 3 -relief raised -width 0 +} -cleanup { + destroy .e +} -result {77 39} +test entry-6.8 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] -} {116 39} -test entry-6.9 {EntryComputeGeometry procedure} {fonts} { - catch {destroy .e} - entry .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2 +} -cleanup { + destroy .e +} -result {116 39} +test entry-6.9 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 update list [winfo reqwidth .e] [winfo reqheight .e] -} {25 39} -test entry-6.10 {EntryComputeGeometry procedure} {unix fonts} { - catch {destroy .e} - entry .e -bd 1 -relief raised -width 0 -show . - .e insert 0 12345 +} -cleanup { + destroy .e +} -result {25 39} +test entry-6.10 {EntryComputeGeometry procedure} -constraints { + unix fonts +} -setup { + entry .e -highlightthickness 2 -font {Helvetica -12} pack .e +} -body { + .e configure -bd 1 -relief raised -width 0 -show . + .e insert 0 12345 update set x [winfo reqwidth .e] .e configure -show X lappend x [winfo reqwidth .e] .e configure -show "" lappend x [winfo reqwidth .e] -} {23 53 43} -test entry-6.11 {EntryComputeGeometry procedure} win { - catch {destroy .e} - entry .e -bd 1 -relief raised -width 0 -show . -font {helvetica 12} - .e insert 0 12345 +} -cleanup { + destroy .e +} -result {23 53 43} +test entry-6.11 {EntryComputeGeometry procedure} -constraints { + win +} -setup { + entry .e -highlightthickness 2 pack .e +} -body { + .e configure -bd 1 -relief raised -width 0 -show . -font {helvetica 12} + .e insert 0 12345 update - set x [winfo reqwidth .e] + set x1 [winfo reqwidth .e] + set x2 [expr {8+5*[font measure {helvetica 12} .]}] + set x [expr {$x1 eq $x2}] .e configure -show X - lappend x [winfo reqwidth .e] + set x1 [winfo reqwidth .e] + set x2 [expr {8+5*[font measure {helvetica 12} X]}] + lappend x [expr {$x1 eq $x2}] .e configure -show "" - lappend x [winfo reqwidth .e] -} [list \ - [expr 8+5*[font measure {helvetica 12} .]] \ - [expr 8+5*[font measure {helvetica 12} X]] \ - [expr 8+[font measure {helvetica 12} 12345]]] -test entry-6.12 {EntryComputeGeometry procedure} {fonts} { + set x1 [winfo reqwidth .e] + set x2 [expr {8+[font measure {helvetica 12} 12345]}] + lappend x [expr {$x1 eq $x2}] +} -cleanup { + destroy .e +} -result {1 1 1} +test entry-6.12 {EntryComputeGeometry procedure} -constraints { + fonts +} -setup { catch {destroy .e} entry .e -font $fixed -bd 2 -relief raised -width 20 pack .e +} -body { .e insert end "012\t456\t" update list [.e index @81] [.e index @82] [.e index @116] [.e index @117] -} {6 7 7 8} +} -cleanup { + destroy .e +} -result {6 7 7 8} -catch {destroy .e} -entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll -pack .e -focus .e -test entry-7.1 {InsertChars procedure} { - .e delete 0 end + +test entry-7.1 {InsertChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e insert 2 XXX update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {abXXXcde abXXXcde {0.000000 1.000000}} -test entry-7.2 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abXXXcde abXXXcde {0.000000 1.000000}} + +test entry-7.2 {InsertChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e insert 500 XXX update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {abcdeXXX abcdeXXX {0.000000 1.000000}} -test entry-7.3 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abcdeXXX abcdeXXX {0.000000 1.000000}} +test entry-7.3 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -814,9 +1947,13 @@ test entry-7.3 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {5 9 5 8} -test entry-7.4 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {5 9 5 8} +test entry-7.4 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -824,9 +1961,13 @@ test entry-7.4 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {2 9 2 8} -test entry-7.5 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 2 8} +test entry-7.5 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -834,9 +1975,13 @@ test entry-7.5 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {2 9 2 8} -test entry-7.6 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 2 8} +test entry-7.6 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -844,70 +1989,118 @@ test entry-7.6 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {2 6 2 5} -test entry-7.7 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 6 2 5} +test entry-7.7 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -xscrollcommand scroll .e insert 0 0123456789 .e icursor 4 .e insert 4 XXX .e index insert -} {7} -test entry-7.8 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {7} +test entry-7.8 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e icursor 4 .e insert 5 XXX .e index insert -} {4} -test entry-7.9 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-7.9 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "This is a very long string" update .e xview 4 .e insert 3 XXX .e index @0 -} {7} -test entry-7.10 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {7} +test entry-7.10 {InsertChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "This is a very long string" update .e xview 4 .e insert 4 XXX .e index @0 -} {4} -.e configure -width 0 -test entry-7.11 {InsertChars procedure} {fonts} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} + +test entry-7.11 {InsertChars procedure} -constraints { + fonts +} -setup { + entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "xyzzy" update .e insert 2 00 winfo reqwidth .e -} {59} +} -cleanup { + destroy .e +} -result {59} -.e configure -width 10 -test entry-8.1 {DeleteChars procedure} { - .e delete 0 end +test entry-8.1 {DeleteChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete 2 4 update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {abe abe {0.000000 1.000000}} -test entry-8.2 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abe abe {0.000000 1.000000}} +test entry-8.2 {DeleteChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete -2 2 update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {cde cde {0.000000 1.000000}} -test entry-8.3 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {cde cde {0.000000 1.000000}} +test entry-8.3 {DeleteChars procedure} -setup { + unset -nocomplain contents + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete 3 1000 update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {abc abc {0.000000 1.000000}} -test entry-8.4 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abc abc {0.000000 1.000000}} +test entry-8.4 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -916,9 +2109,14 @@ test entry-8.4 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {1 6 1 5} -test entry-8.5 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 6 1 5} +test entry-8.5 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -927,9 +2125,14 @@ test entry-8.5 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] -} {1 5 1 4} -test entry-8.6 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 5 1 4} +test entry-8.6 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -938,17 +2141,28 @@ test entry-8.6 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {1 2 1 5} -test entry-8.7 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 2 1 5} +test entry-8.7 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 1 8 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-8.8 {DeleteChars procedure} { - .e delete 0 end + update + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test entry-8.8 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -957,17 +2171,27 @@ test entry-8.8 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {3 4 3 8} -test entry-8.9 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 4 3 8} +test entry-8.9 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 3 8 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-8.10 {DeleteChars procedure} { - .e delete 0 end + update + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test entry-8.10 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 8 .e select to 3 @@ -976,9 +2200,14 @@ test entry-8.10 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {3 5 5 8} -test entry-8.11 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 5 5 8} +test entry-8.11 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 8 .e select to 3 @@ -987,124 +2216,186 @@ test entry-8.11 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] -} {3 8 4 8} -test entry-8.12 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 8 4 8} +test entry-8.12 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 1 4 + update .e index insert -} {1} -test entry-8.13 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-8.13 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 1 5 + update .e index insert -} {1} -test entry-8.14 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-8.14 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 4 6 + update .e index insert -} {4} -test entry-8.15 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-8.15 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 1 4 + update .e index @0 -} {1} -test entry-8.16 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-8.16 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 1 5 + update .e index @0 -} {1} -test entry-8.17 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test entry-8.17 {DeleteChars procedure} -setup { + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 4 6 + update .e index @0 -} {4} -.e configure -width 0 -test entry-8.18 {DeleteChars procedure} {fonts} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test entry-8.18 {DeleteChars procedure} -setup { + entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "xyzzy" update .e delete 2 4 winfo reqwidth .e -} {31} +} -cleanup { + destroy .e +} -result {31} -test entry-9.1 {EntryValueChanged procedure} { - catch {destroy .e} - proc override args { - global x - set x 12345 - } - catch {unset x} +test entry-9.1 {EntryValueChanged procedure} -setup { + unset -nocomplain x +} -body { trace variable x w override - entry .e -textvariable x + entry .e -textvariable x -width 0 .e insert 0 foo - set result [list $x [.e get]] - unset x; rename override {} - set result -} {12345 12345} - -catch {destroy .e} -entry .e -pack .e -.e configure -width 0 -test entry-10.1 {EntrySetValue procedure} {fonts} { + list $x [.e get] +} -cleanup { + destroy .e + trace vdelete x w override + unset x +} -result {12345 12345} + + +test entry-10.1 {EntrySetValue procedure} -constraints fonts -body { set x abcde set y ab - .e configure -textvariable x - update + entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 -width 0 + pack .e + .e configure -textvariable x .e configure -textvariable y update list [.e get] [winfo reqwidth .e] -} {ab 24} -test entry-10.2 {EntrySetValue procedure, updating selection} { - catch {destroy .e} - entry .e -textvariable x +} -cleanup { + destroy .e +} -result {ab 24} +test entry-10.2 {EntrySetValue procedure, updating selection} -setup { + unset -nocomplain x + entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "a" - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-10.3 {EntrySetValue procedure, updating selection} { - catch {destroy .e} - entry .e -textvariable x + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test entry-10.3 {EntrySetValue procedure, updating selection} -setup { + unset -nocomplain x + entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefg" list [.e index sel.first] [.e index sel.last] -} {4 7} -test entry-10.4 {EntrySetValue procedure, updating selection} { - catch {destroy .e} - entry .e -textvariable x +} -cleanup { + destroy .e +} -result {4 7} +test entry-10.4 {EntrySetValue procedure, updating selection} -setup { + unset -nocomplain x + entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefghijklmn" list [.e index sel.first] [.e index sel.last] -} {4 10} -test entry-10.5 {EntrySetValue procedure, updating display position} { - catch {destroy .e} - entry .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {4 10} +test entry-10.5 {EntrySetValue procedure, updating display position} -setup { + unset -nocomplain x + entry .e -highlightthickness 2 -bd 2 pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 update set x "abcdefg" update .e index @0 -} {0} -test entry-10.6 {EntrySetValue procedure, updating display position} { - catch {destroy .e} - entry .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {0} +test entry-10.6 {EntrySetValue procedure, updating display position} -setup { + unset -nocomplain x + entry .e -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 @@ -1112,192 +2403,472 @@ test entry-10.6 {EntrySetValue procedure, updating display position} { set x "1234567890123456789012" update .e index @0 -} {10} -test entry-10.7 {EntrySetValue procedure, updating insertion cursor} { - catch {destroy .e} - entry .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {10} +test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { + unset -nocomplain x + entry .e -highlightthickness 2 -bd 2 + pack .e + update +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123" .e index insert -} {3} -test entry-10.8 {EntrySetValue procedure, updating insertion cursor} { - catch {destroy .e} - entry .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {3} +test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { + unset -nocomplain x + entry .e -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123456" .e index insert -} {5} +} -cleanup { + destroy .e +} -result {5} -test entry-11.1 {EntryEventProc procedure} { - catch {destroy .e} - entry .e +test entry-11.1 {EntryEventProc procedure} -setup { + entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} + pack .e +} -body { .e insert 0 abcdefg destroy .e update -} {} -test entry-11.2 {EntryEventProc procedure} { - deleteWindows +} -cleanup { + destroy .e +} -result {} +test entry-11.2 {EntryEventProc procedure} -setup { + set x {} +} -body { entry .e1 -fg #112233 rename .e1 .e2 - set x {} lappend x [winfo children .] lappend x [.e2 cget -fg] destroy .e1 lappend x [info command .e*] [winfo children .] -} {.e1 #112233 {} {}} - -test entry-12.1 {EntryCmdDeletedProc procedure} { - deleteWindows - button .e1 -text "xyz_123" - rename .e1 {} - list [info command .e*] [winfo children .] -} {{} {}} - -catch {destroy .e} -entry .e -font $fixed -width 5 -bd 2 -relief sunken -pack .e -.e insert 0 012345678901234567890 -.e xview 4 -update -test entry-13.1 {GetEntryIndex procedure} { +} -cleanup { + destroy .e1 +} -result {.e1 #112233 {} {}} + +test entry-12.1 {EntryCmdDeletedProc procedure} -body { + button .b -text "xyz_123" + rename .b {} + list [info command .b*] [winfo children .] +} -cleanup { + destroy .b +} -result {{} {}} + + +test entry-13.1 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e index end -} {21} -test entry-13.2 {GetEntryIndex procedure} { - list [catch {.e index abogus} msg] $msg -} {1 {bad entry index "abogus"}} -test entry-13.3 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {21} +test entry-13.2 {GetEntryIndex procedure} -body { + entry .e + .e index abogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "abogus"} +test entry-13.3 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 1 .e select to 6 .e index anchor -} {1} -test entry-13.4 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {1} +test entry-13.4 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 4 .e select to 1 .e index anchor -} {4} -test entry-13.5 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {4} +test entry-13.5 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 3 .e select to 15 .e select adjust 4 .e index anchor -} {15} -test entry-13.6 {GetEntryIndex procedure} { - list [catch {.e index ebogus} msg] $msg -} {1 {bad entry index "ebogus"}} -test entry-13.7 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {15} +test entry-13.6 {GetEntryIndex procedure} -setup { + entry .e +} -body { + .e index ebogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "ebogus"} +test entry-13.7 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e icursor 2 .e index insert -} {2} -test entry-13.8 {GetEntryIndex procedure} { - list [catch {.e index ibogus} msg] $msg -} {1 {bad entry index "ibogus"}} -test entry-13.9 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {2} +test entry-13.8 {GetEntryIndex procedure} -setup { + entry .e +} -body { + .e index ibogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "ibogus"} +test entry-13.9 {GetEntryIndex procedure} -setup { + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {1 6} + + + + + + +test entry-13.10 {GetEntryIndex procedure} -constraints unix -body { +# On unix, when selection is cleared, entry widget's internal +# selection range is reset. +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} + +test entry-13.11 {GetEntryIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, entry widget remembers +# last selected range. When selection ownership is restored to +# entry, the old range will be rehighlighted. +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + catch {selection get} + .e index sel.first +} -cleanup { + destroy .e +} -result {1} + +test entry-13.12 {GetEntryIndex procedure} -constraints unix -body { +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} + +# why when string in .e index changed to not beginning with s, +# it behaves differently? +test entry-13.12.1 {GetEntryIndex procedure} -constraints unix -body { +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index bogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "bogus"} + +test entry-13.13 {GetEntryIndex procedure} -constraints win -body { +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "sbogus"} + +test entry-13.14 {GetEntryIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, entry widget remembers +# last selected range. When selection ownership is restored to +# entry, the old range will be rehighlighted. +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 1 .e select to 6 list [.e index sel.first] [.e index sel.last] -} {1 6} -selection clear .e -test entry-13.10 {GetEntryIndex procedure} unix { - # On unix, when selection is cleared, entry widget's internal - # selection range is reset. - - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-13.11 {GetEntryIndex procedure} win { - # On mac and pc, when selection is cleared, entry widget remembers - # last selected range. When selection ownership is restored to - # entry, the old range will be rehighlighted. - - list [catch {selection get}] [.e index sel.first] -} {1 1} -test entry-13.12 {GetEntryIndex procedure} unix { - list [catch {.e index sbogus} msg] $msg -} {1 {selection isn't in widget .e}} -test entry-13.13 {GetEntryIndex procedure} win { - list [catch {.e index sbogus} msg] $msg -} {1 {bad entry index "sbogus"}} -test entry-13.14 {GetEntryIndex procedure} win { - list [catch {selection get}] [catch {.e index sbogus}] -} {1 1} -test entry-13.15 {GetEntryIndex procedure} { - list [catch {.e index @xyz} msg] $msg -} {1 {bad entry index "@xyz"}} -test entry-13.16 {GetEntryIndex procedure} {fonts} { +# Testing: + selection clear .e + selection get +} -cleanup { + destroy .e +} -returnCodes error -match glob -result {*} + +test entry-13.14.1 {GetEntryIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, entry widget remembers +# last selected range. When selection ownership is restored to +# entry, the old range will be rehighlighted. +# Previous settings: + entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + catch {selection get} + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -match glob -result {*} + +test entry-13.15 {GetEntryIndex procedure} -body { + entry .e + selection clear .e + .e index @xyz +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "@xyz"} + +test entry-13.16 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @4 -} {4} -test entry-13.17 {GetEntryIndex procedure} {fonts} { +} -cleanup { + destroy .e +} -result {4} +test entry-13.17 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @11 -} {4} -test entry-13.18 {GetEntryIndex procedure} {fonts} { +} -cleanup { + destroy .e +} -result {4} +test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @12 -} {5} -test entry-13.19 {GetEntryIndex procedure} {fonts} { - .e index @[expr [winfo width .e] - 6] -} {8} -test entry-13.20 {GetEntryIndex procedure} {fonts} { - .e index @[expr [winfo width .e] - 5] -} {9} -test entry-13.21 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {5} +test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e index @[expr {[winfo width .e] - 6}] +} -cleanup { + destroy .e +} -result {8} +test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e index @[expr {[winfo width .e] - 5}] +} -cleanup { + destroy .e +} -result {9} +test entry-13.21 {GetEntryIndex procedure} -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @1000 -} {9} -test entry-13.22 {GetEntryIndex procedure} { - list [catch {.e index 1xyz} msg] $msg -} {1 {bad entry index "1xyz"}} -test entry-13.23 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {9} +test entry-13.22 {GetEntryIndex procedure} -setup { + entry .e + pack .e + update +} -body { + .e index 1xyz +} -cleanup { + destroy .e +} -returnCodes error -result {bad entry index "1xyz"} +test entry-13.23 {GetEntryIndex procedure} -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index -10 -} {0} -test entry-13.24 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {0} +test entry-13.24 {GetEntryIndex procedure} -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index 12 -} {12} -test entry-13.25 {GetEntryIndex procedure} { +} -cleanup { + destroy .e +} -result {12} +test entry-13.25 {GetEntryIndex procedure} -body { + entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index 49 -} {21} -test entry-13.26 {GetEntryIndex procedure} {fonts} { - catch {destroy .e} - entry .e -show . +} -cleanup { + destroy .e +} -result {21} +test entry-13.26 {GetEntryIndex procedure} -constraints fonts -body { + entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} + selection clear .e + .e configure -show . .e insert 0 XXXYZZY pack .e update list [.e index @7] [.e index @8] -} {0 1} +} -cleanup { + destroy .e +} -result {0 1} # XXX Still need to write tests for EntryScanTo and EntrySelectTo. -set x {} -for {set i 1} {$i <= 500} {incr i} { - append x "This is line $i, out of 500\n" -} -test entry-14.1 {EntryFetchSelection procedure} { - catch {destroy .e} + +test entry-14.1 {EntryFetchSelection procedure} -body { entry .e .e insert end "This is a test string" .e select from 1 .e select to 18 selection get -} {his is a test str} -test entry-14.2 {EntryFetchSelection procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {his is a test str} +test entry-14.2 {EntryFetchSelection procedure} -body { entry .e -show * .e insert end "This is a test string" .e select from 1 .e select to 18 selection get -} {*****************} -test entry-14.3 {EntryFetchSelection procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {*****************} +test entry-14.3 {EntryFetchSelection procedure} -setup { + set x {} + for {set i 1} {$i <= 500} {incr i} { + append x "This is line $i, out of 500\n" +} +} -body { entry .e - .e insert end $x + .e insert end $x .e select from 0 .e select to end string compare [selection get] $x -} 0 +} -cleanup { + destroy .e +} -result {0} -test entry-15.1 {EntryLostSelection} { - catch {destroy .e} +test entry-15.1 {EntryLostSelection} -body { entry .e .e insert 0 "Text" .e select from 0 @@ -1307,353 +2878,641 @@ test entry-15.1 {EntryLostSelection} { .e select from 0 .e select to 4 lappend result [selection get] -} {Text Text} - -# No tests for EventuallyRedraw. - -catch {destroy .e} -entry .e -width 10 -xscrollcommand scroll -pack .e -update +} -cleanup { + destroy .e +} -result {Text Text} -test entry-16.1 {EntryVisibleRange procedure} {fonts} { - .e delete 0 end - .e insert 0 ............................. +# is scrollcommand needed here?? +test entry-16.1 {EntryVisibleRange procedure} -constraints fonts -body { + entry .e -width 10 -font {Helvetica -12} + pack .e + update + .e insert 0 "............................." format {%.6f %.6f} {*}[.e xview] -} {0.000000 0.827586} -test entry-16.2 {EntryVisibleRange procedure} {unix fonts} { - .e configure -show X - .e delete 0 end - .e insert 0 ............................. +} -cleanup { + destroy .e +} -result {0.000000 0.827586} +test entry-16.2 {EntryVisibleRange procedure} -constraints { + unix fonts +} -body { + entry .e -show X -width 10 -font {Helvetica -12} + pack .e + update + .e insert 0 "............................." format {%.6f %.6f} {*}[.e xview] -} {0.000000 0.275862} -test entry-16.3 {EntryVisibleRange procedure} win { - .e configure -show . - .e delete 0 end +} -cleanup { + destroy .e +} -result {0.000000 0.275862} +test entry-16.3 {EntryVisibleRange procedure} -constraints { + win +} -body { + entry .e -show . -width 10 -font {Helvetica -12} + pack .e + update .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX format {%.6f %.6f} {*}[.e xview] -} {0.000000 0.827586} -.e configure -show "" -test entry-16.4 {EntryVisibleRange procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0.000000 0.827586} +test entry-16.4 {EntryVisibleRange procedure} -body { + entry .e -show "" format {%.6f %.6f} {*}[.e xview] -} {0.000000 1.000000} +} -cleanup { + destroy .e +} -result {0.000000 1.000000} + -catch {destroy .e} -entry .e -width 10 -xscrollcommand scroll -font $fixed -pack .e -update -test entry-17.1 {EntryUpdateScrollbar procedure} { +test entry-17.1 {EntryUpdateScrollbar procedure} -body { + entry .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e delete 0 end .e insert 0 123 update format {%.6f %.6f} {*}$scrollInfo -} {0.000000 1.000000} -test entry-17.2 {EntryUpdateScrollbar procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0.000000 1.000000} +test entry-17.2 {EntryUpdateScrollbar procedure} -body { + entry .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e insert 0 0123456789abcdef .e xview 3 update format {%.6f %.6f} {*}$scrollInfo -} {0.187500 0.812500} -test entry-17.3 {EntryUpdateScrollbar procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0.187500 0.812500} +test entry-17.3 {EntryUpdateScrollbar procedure} -body { + entry .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e insert 0 abcdefghijklmnopqrs .e xview 6 update format {%.6f %.6f} {*}$scrollInfo -} {0.315789 0.842105} -test entry-17.4 {EntryUpdateScrollbar procedure} { +} -cleanup { destroy .e +} -result {0.315789 0.842105} +test entry-17.4 {EntryUpdateScrollbar procedure} -setup { proc bgerror msg { global x set x $msg - } +} +} -body { entry .e -width 5 -xscrollcommand thisisnotacommand pack .e update - rename bgerror {} list $x $errorInfo -} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" +} -cleanup { + destroy .e + rename bgerror {} +} -result {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" while executing "thisisnotacommand 0.0 1.0" (horizontal scrolling command executed by .e)}} -set l [interp hidden] -deleteWindows -test entry-18.1 {Entry widget vs hiding} { - destroy .e +test entry-18.1 {Entry widget vs hiding} -setup { entry .e +} -body { + set l [interp hidden] interp hide {} .e destroy .e - list [winfo children .] [interp hidden] -} [list {} $l] + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 == $res2} +} -result {1} ## ## Entry widget VALIDATION tests ## - -destroy .e -catch {unset ::e} -catch {unset ::vVals} -entry .e -validate all \ - -validatecommand [list doval %W %d %i %P %s %S %v %V] \ - -invalidcommand bell \ - -textvariable ::e \ - -background red -foreground white -pack .e -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 1 -} - # The validation tests build each one upon the previous, so cascading # failures aren't good # -test entry-19.1 {entry widget validation} { + +# 19.* test cases in previous version highly depended on the previous +# test cases. This was replaced by inserting recently set configurations +# that matters for the test case +test entry-19.1 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e .e insert 0 a - set ::vVals -} {.e 1 0 a {} a all key} -test entry-19.2 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 1 0 a {} a all key} + +test entry-19.2 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a ;# previous settings .e insert 1 b - set ::vVals -} {.e 1 1 ab a b all key} -test entry-19.3 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 1 1 ab a b all key} + +test entry-19.3 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 ab ;# previous settings .e insert end c - set ::vVals -} {.e 1 2 abc ab c all key} -test entry-19.4 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 1 2 abc ab c all key} + +test entry-19.4 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 abc ;# previous settings .e insert 1 123 list $::vVals $::e -} {{.e 1 1 a123bc abc 123 all key} a123bc} -test entry-19.5 {entry widget validation} { +} -cleanup { + destroy .e +} -result {{.e 1 1 a123bc abc 123 all key} a123bc} + +test entry-19.5 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a123bc ;# previous settings .e delete 2 - set ::vVals -} {.e 0 2 a13bc a123bc 2 all key} -test entry-19.6 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 0 2 a13bc a123bc 2 all key} + +test entry-19.6 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a13bc ;# previous settings .e configure -validate key .e delete 1 3 - set ::vVals -} {.e 0 1 abc a13bc 13 key key} -test entry-19.7 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e 0 1 abc a13bc 13 key key} + +test entry-19.7 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focus \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abc ;# previous settings set ::vVals {} - .e configure -validate focus .e insert end d - set ::vVals -} {} -test entry-19.8 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {} + +test entry-19.8 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e configure -validate focus ;# previous settings + .e insert end abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {.e -1 -1 abcd abcd {} focus focusin} -test entry-19.9 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focus focusin} + +test entry-19.9 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focus \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + focus -force .e ;# previous settings + update ;# previous settings +# update necessary to process FocusIn event focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {.e -1 -1 abcd abcd {} focus focusout} -.e configure -validate all -test entry-19.10 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focus focusout} + +test entry-19.10 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {.e -1 -1 abcd abcd {} all focusin} -test entry-19.11 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} all focusin} + +test entry-19.11 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {.e -1 -1 abcd abcd {} all focusout} -.e configure -validate focusin -test entry-19.12 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} all focusout} + +test entry-19.12 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focusin \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {.e -1 -1 abcd abcd {} focusin focusin} -test entry-19.13 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focusin focusin} + +test entry-19.13 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focusin \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings set ::vVals {} focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update - set ::vVals -} {} -.e configure -validate focuso -test entry-19.14 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {} + +test entry-19.14 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update - set ::vVals -} {} -test entry-19.15 {entry widget validation} { + return $::vVals +} -cleanup { + destroy .e +} -result {} + +test entry-19.15 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event + update + return $::vVals +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focusout focusout} + +# the same as 19.16 but added [.e validate] to returned list +test entry-19.16 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings + focus -force . +# update necessary to process FocusOut event update - set ::vVals -} {.e -1 -1 abcd abcd {} focusout focusout} -test entry-19.16 {entry widget validation} { list [.e validate] $::vVals -} {1 {.e -1 -1 abcd abcd {} all forced}} -test entry-19.17 {entry widget validation} { +} -cleanup { + destroy .e +} -result {1 {.e -1 -1 abcd abcd {} all forced}} + + +test entry-19.17 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings set ::e newdata list [.e cget -validate] $::vVals -} {focusout {.e -1 -1 newdata abcd {} focusout forced}} +} -cleanup { + destroy .e +} -result {focusout {.e -1 -1 newdata abcd {} focusout forced}} -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 0 -} -test entry-19.18 {entry widget validation} { +# proc doval changed - returns 0 +test entry-19.18 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval3 %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e newdata ;# previous settings .e configure -validate all set ::e nextdata list [.e cget -validate] $::vVals -} {none {.e -1 -1 nextdata newdata {} all forced}} - -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - set ::e mydata - return 1 -} +} -cleanup { + destroy .e +} -result {none {.e -1 -1 nextdata newdata {} all forced}} ## This sets validate to none because it shows that we prevent a possible ## loop condition in the validation, when the entry textvar is also set -test entry-19.19 {entry widget validation} { - .e configure -validate all +# proc doval2 used +test entry-19.19 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval3 %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e nextdata ;# previous settings + + .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] .e validate list [.e cget -validate] [.e get] $::vVals -} {none mydata {.e -1 -1 nextdata nextdata {} all forced}} +} -cleanup { + destroy .e +} -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}} ## This leaves validate alone because we trigger validation through the ## textvar (a write trace), and the write during validation triggers ## nothing (by definition of avoiding loops on var traces). This is ## one of those "dangerous" conditions where the user will have a ## different value in the entry widget shown as is in the textvar. -test entry-19.20 {entry widget validation} { +test entry-19.20 {entry widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + entry .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e nextdata ;# previous settings + .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] ;# prev + .e validate ;# previous settings + .e configure -validate all set ::e testdata list [.e cget -validate] [.e get] $::e $::vVals -} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} - -destroy .e -catch {unset ::e ::vVals} - +} -cleanup { + destroy .e +} -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} ## ## End validation tests ## -test entry-20.1 {widget deletion while active} { - destroy .e +test entry-20.1 {widget deletion while active} -body { entry .e -validate all \ -validatecommand { destroy %W ; return 1 } \ -invalidcommand bell update .e insert 0 abc winfo exists .e -} 0 -test entry-20.2 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.2 {widget deletion while active} -body { entry .e -validate all \ -validatecommand { return 0 } \ -invalidcommand { destroy %W } .e insert 0 abc winfo exists .e -} 0 -test entry-20.3 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.3 {widget deletion while active} -body { entry .e -validate all \ -validatecommand { rename .e {} ; return 1 } .e insert 0 abc winfo exists .e -} 0 -test entry-20.4 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.4 {widget deletion while active} -body { entry .e -validate all \ -validatecommand { return 0 } \ -invalidcommand { rename .e {} } .e insert 0 abc winfo exists .e -} 0 -test entry-20.5 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.5 {widget deletion while active} -body { entry .e -validatecommand { destroy .e ; return 0 } .e validate winfo exists .e -} 0 -test entry-20.6 {widget deletion while active} { +} -cleanup { destroy .e +} -result {0} + +test entry-20.6 {widget deletion while active} -body { pack [entry .e] update .e config -xscrollcommand { destroy .e } update idle winfo exists .e -} 0 -test entry-20.7 {widget deletion with textvariable active} { - # SF bugs 607390 and 617446 +} -cleanup { destroy .e +} -result {0} + +test entry-20.7 {widget deletion with textvariable active} -body { +# SF bugs 607390 and 617446 set FOO init entry .e -textvariable FOO -validate all \ -vcmd {%W configure -bg white; format 1} bind .e <Destroy> { set FOO hello } destroy .e winfo exists .e -} 0 - -test entry-21.1 {selection present while disabled, bug 637828} { +} -cleanup { destroy .e +} -result {0} + + +test entry-21.1 {selection present while disabled, bug 637828} -body { entry .e .e insert end 0123456789 .e select from 3 .e select to 6 set out [.e selection present] .e configure -state disabled - # still return 1 when disabled, because 'selection get' will work, - # but selection cannot be changed (new behavior since 8.4) +# still return 1 when disabled, because 'selection get' will work, +# but selection cannot be changed (new behavior since 8.4) .e select to 9 lappend out [.e selection present] [selection get] -} {1 1 345} +} -cleanup { + destroy .e +} -result {1 1 345} -test entry-22.1 {lost namespaced textvar} { +test entry-22.1 {lost namespaced textvar} -body { + namespace eval test { variable foo {a b} } + entry .e -textvariable ::test::foo + namespace delete test + set ::test::foo +} -cleanup { destroy .e +} -returnCodes error -result {can't read "::test::foo": no such variable} +test entry-22.2 {lost namespaced textvar} -body { namespace eval test { variable foo {a b} } entry .e -textvariable ::test::foo namespace delete test catch {.e insert end "more stuff"} result1 - catch {.e delete 5 end} result2 + catch {.e delete 5 end } result2 catch {set ::test::foo} result3 list [.e get] [.e cget -textvar] $result1 $result2 $result3 -} [list "a bmo" ::test::foo \ +} -cleanup { + destroy .e +} -result [list "a bmo" ::test::foo \ {can't set "::test::foo": parent namespace doesn't exist} \ {can't set "::test::foo": parent namespace doesn't exist} \ {can't read "::test::foo": no such variable}] -test entry-23.1 {error in trace proc attached to the textvariable} { +test entry-23.1 {error in trace proc attached to the textvariable} -setup { destroy .e +} -body { trace variable myvar w traceit proc traceit args {error "Intentional error here!"} entry .e -textvariable myvar catch {.e insert end mystring} result1 catch {.e delete 0} result2 list $result1 $result2 -} [list {can't set "myvar": Intentional error here!} \ +} -cleanup { + destroy .e +} -result [list {can't set "myvar": Intentional error here!} \ {can't set "myvar": Intentional error here!}] -test entry-24.1 {textvariable lives in a non-existing namespace} { +test entry-24.1 {textvariable lives in a non-existing namespace} -setup { destroy .e +} -body { catch {entry .e -textvariable thisnsdoesntexist::myvar} result1 set result1 -} {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist} - -destroy .e +} -cleanup { + destroy .e +} -result {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist} +# Gathered comments about lacks # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, # and EntryTextVarProc. +# No tests for DisplayEntry. +# XXX Still need to write tests for EntryScanTo and EntrySelectTo. +# No tests for EventuallyRedraw -option clear - +# option clear # cleanup cleanupTests return + + + diff --git a/tests/event.test b/tests/event.test index 95be5f4..756dbe5 100644 --- a/tests/event.test +++ b/tests/event.test @@ -6,9 +6,10 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test # XXX This test file is woefully incomplete. Right now it only tests # a few of the procedures in tkEvent.c. Please add more tests whenever @@ -183,37 +184,49 @@ proc _get_selection {widget} { # Begining of the actual tests -test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} { +test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} -setup { + deleteWindows + set x {} +} -body { button .b -text Test pack .b bindtags .b .b update bind .b <Destroy> { - lappend x destroy - event generate .b <1> - event generate .b <ButtonRelease-1> + lappend x destroy + event generate .b <1> + event generate .b <ButtonRelease-1> } bind .b <1> { - lappend x button + lappend x button } - set x {} + destroy .b - set x -} {destroy} -test event-1.2 {event generate <Alt-z>} { - catch {destroy .e} - catch {unset ::event12result} + return $x +} -cleanup { + deleteWindows +} -result {destroy} +test event-1.2 {event generate <Alt-z>} -setup { + deleteWindows + catch {unset ::event12result} +} -body { set ::event12result 0 pack [entry .e] update bind .e <Alt-z> {set ::event12result "1"} - focus -force .e ; event generate .e <Alt-z> + + focus -force .e + event generate .e <Alt-z> destroy .e set ::event12result -} 1 +} -cleanup { + deleteWindows +} -result 1 + -test event-2.1(keypress) {type into entry widget and hit Return} { - destroy .t +test event-2.1(keypress) {type into entry widget and hit Return} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [entry $t.e] pack $e @@ -222,9 +235,12 @@ test event-2.1(keypress) {type into entry widget and hit Return} { tkwait visibility $e _keypress_string $e HELLO\n list [$e get] $return_binding -} {HELLO 1} -test event-2.2(keypress) {type into entry widget and then delete some text} { - destroy .t +} -cleanup { + deleteWindows +} -result {HELLO 1} +test event-2.2(keypress) {type into entry widget and then delete some text} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [entry $t.e] pack $e @@ -233,10 +249,13 @@ test event-2.2(keypress) {type into entry widget and then delete some text} { _keypress $e BackSpace _keypress $e BackSpace $e get -} MEL -test event-2.3(keypress) {type into entry widget, triple click,\ - hit Delete key, and then type some more} { - destroy .t +} -cleanup { + deleteWindows +} -result {MEL} +test event-2.3(keypress) {type into entry widget, triple click, hit Delete key, + and then type some more} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [entry $t.e] pack $e @@ -256,9 +275,12 @@ test event-2.3(keypress) {type into entry widget, triple click,\ _keypress $e Delete _keypress_string $e UP lappend result [$e get] -} {JUMP UP} -test event-1.4(keypress) {type into text widget and hit Return} { - destroy .t +} -cleanup { + deleteWindows +} -result {JUMP UP} +test event-2.4(keypress) {type into text widget and hit Return} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [text $t.e] pack $e @@ -267,9 +289,12 @@ test event-1.4(keypress) {type into text widget and hit Return} { tkwait visibility $e _keypress_string $e HELLO\n list [$e get 1.0 end] $return_binding -} [list "HELLO\n\n" 1] -test event-2.5(keypress) {type into text widget and then delete some text} { - destroy .t +} -cleanup { + deleteWindows +} -result [list "HELLO\n\n" 1] +test event-2.5(keypress) {type into text widget and then delete some text} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [text $t.e] pack $e @@ -278,10 +303,13 @@ test event-2.5(keypress) {type into text widget and then delete some text} { _keypress $e BackSpace _keypress $e BackSpace $e get 1.0 1.end -} MEL -test event-2.6(keypress) {type into text widget, triple click,\ - hit Delete key, and then type some more} { - destroy .t +} -cleanup { + deleteWindows +} -result {MEL} +test event-2.6(keypress) {type into text widget, triple click, + hit Delete key, and then type some more} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [text $t.e] pack $e @@ -301,11 +329,14 @@ test event-2.6(keypress) {type into text widget, triple click,\ _keypress $e Delete _keypress_string $e UP lappend result [$e get 1.0 1.end] -} {JUMP UP} - -test event-3.1(click-drag) {click and drag in a text widget, this tests\ - tkTextSelectTo in text.tcl} { - destroy .t +} -cleanup { + deleteWindows +} -result {JUMP UP} + +test event-3.1(click-drag) {click and drag in a text widget, this tests + tkTextSelectTo in text.tcl} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [text $t.e] pack $e @@ -366,10 +397,13 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests\ # Save the highlighted text lappend result [_get_selection $e] -} {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}} -test event-3.2(click-drag) {click and drag in an entry widget, this\ - tests tkEntryMouseSelect in entry.tcl} { - destroy .t +} -cleanup { + deleteWindows +} -result {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}} + test event-3.2(click-drag) {click and drag in an entry widget, this + tests tkEntryMouseSelect in entry.tcl} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [entry $t.e] pack $e @@ -430,11 +464,15 @@ test event-3.2(click-drag) {click and drag in an entry widget, this\ # Save the highlighted text lappend result [_get_selection $e] -} {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}} +} -cleanup { + deleteWindows +} -result {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}} -test event-4.1(double-click-drag) {click down, click up, click down again,\ - then drag in a text widget} { - destroy .t + +test event-4.1(double-click-drag) {click down, click up, click down again, + then drag in a text widget} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [text $t.e] pack $e @@ -497,11 +535,14 @@ test event-4.1(double-click-drag) {click down, click up, click down again,\ # Insert cursor should be before the r in "Word" lappend result [$e index insert] - set result -} {select 1.5 1.7 select 1.4 { select} {Word select} 1.2} -test event-4.2(double-click-drag) {click down, click up, click down again,\ - then drag in an entry widget} { - destroy .t + return $result +} -cleanup { + deleteWindows +} -result {select 1.5 1.7 select 1.4 { select} {Word select} 1.2} +test event-4.2(double-click-drag) {click down, click up, click down again, + then drag in an entry widget} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [entry $t.e] pack $e @@ -564,12 +605,15 @@ test event-4.2(double-click-drag) {click down, click up, click down again,\ # Insert cursor should be before the r in "Word" lappend result [$e index insert] - set result -} {select 11 7 select 4 { select} {Word select} 2} + return $result +} -cleanup { + deleteWindows +} -result {select 11 7 select 4 { select} {Word select} 2} -test event-5.1(triple-click-drag) {Triple click and drag across lines in\ - a text widget, this should extend the selection to the new line} { - destroy .t +test event-5.1(triple-click-drag) {Triple click and drag across lines in a + text widget, this should extend the selection to the new line} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [text $t.e] pack $e @@ -620,16 +664,18 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in\ lappend result [_get_selection $e] - set result - -} [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \ + return $result +} -cleanup { + deleteWindows +} -result [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \ "LINE ONE\nLINE TWO\nLINE THREE\n"] -test event-6.1(button-state) {button press in a window that is then\ - destroyed, when the mouse is moved into another window it\ - should not generate a <B1-motion> event since the mouse\ - was not pressed down in that window} { - destroy .t +test event-6.1(button-state) {button press in a window that is then + destroyed, when the mouse is moved into another window it + should not generate a <B1-motion> event since the mouse + was not pressed down in that window} -setup { + deleteWindows +} -body { set t [toplevel .t] event generate $t <ButtonPress-1> @@ -638,12 +684,15 @@ test event-6.1(button-state) {button press in a window that is then\ set motion nomotion bind $t <B1-Motion> {set motion inmotion} event generate $t <Motion> - set motion -} nomotion + return $motion +} -cleanup { + deleteWindows +} -result {nomotion} test event-7.1(double-click) {A double click on a lone character - in a text widget should select that character} { - destroy .t + in a text widget should select that character} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [text $t.e] pack $e @@ -702,11 +751,14 @@ test event-7.1(double-click) {A double click on a lone character lappend result [$e index insert] lappend result [_get_selection $e] - set result -} {1.3 A 1.3 A} -test event-7.2(double-click) {A double click on a lone character\ - in an entry widget should select that character} { - destroy .t + return $result +} -cleanup { + deleteWindows +} -result {1.3 A 1.3 A} +test event-7.2(double-click) {A double click on a lone character + in an entry widget should select that character} -setup { + deleteWindows +} -body { set t [toplevel .t] set e [entry $t.e] pack $e @@ -765,13 +817,12 @@ test event-7.2(double-click) {A double click on a lone character\ lappend result [$e index insert] lappend result [_get_selection $e] - set result -} {4 A 4 A} + return $result +} -cleanup { + deleteWindows +} -result {4 A 4 A} # cleanup - -destroy .t - unset -nocomplain keypress_lookup rename _init_keypress_lookup {} rename _keypress_lookup {} @@ -782,3 +833,5 @@ rename _get_selection {} cleanupTests return + + diff --git a/tests/focus.test b/tests/focus.test index 5cc3abe..45cf73b 100644 --- a/tests/focus.test +++ b/tests/focus.test @@ -6,26 +6,24 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands - -button .b -text .b -relief raised -bd 2 -pack .b +namespace import -force tcltest::test proc focusSetup {} { - catch {destroy .t} + destroy .t toplevel .t wm geom .t +0+0 foreach i {b1 b2 b3 b4} { - button .t.$i -text .t.$i -relief raised -bd 2 - pack .t.$i + button .t.$i -text .t.$i -relief raised -bd 2 + pack .t.$i } tkwait visibility .t.b4 } proc focusSetupAlt {} { global env - catch {destroy .alt} + destroy .alt toplevel .alt -screen $env(TK_ALT_DISPLAY) foreach i {a b c d} { button .alt.$i -text .alt.$i -relief raised -bd 2 @@ -34,8 +32,6 @@ proc focusSetupAlt {} { tkwait visibility .alt.d } -# Make sure the window manager knows who has focus -catch {fixfocus} # The following procedure ensures that there is no input focus # in this application. It does it by arranging for another @@ -43,7 +39,6 @@ catch {fixfocus} # is needed to wait long enough for pending actions to get through # the X server and possibly also the window manager. -setupbg proc focusClear {} { global x; after 200 {set x 1} @@ -52,12 +47,17 @@ proc focusClear {} { update } -focusSetup -if {[testConstraint altDisplay]} { - focusSetupAlt -} -update +# Button used in some tests in the whole test file +button .b -text .b -relief raised -bd 2 +pack .b + +# Make sure the window manager knows who has focus +catch {fixfocus} + +# cleanupbg will be after 4.3 test +setupbg +update bind all <FocusIn> { append focusInfo "in %W %d\n" } @@ -67,36 +67,48 @@ bind all <FocusOut> { bind all <KeyPress> { append focusInfo "press %W %K" } +focusSetup +if {[testConstraint altDisplay]} { + focusSetupAlt +} -test focus-1.1 {Tk_FocusCmd procedure} unix { + +test focus-1.1 {Tk_FocusCmd procedure} -constraints unix -body { focusClear focus -} {} -test focus-1.2 {Tk_FocusCmd procedure} {unix altDisplay} { +} -result {} +test focus-1.2 {Tk_FocusCmd procedure} -constraints { + unix altDisplay +} -body { focus .alt.b focus -} {} -test focus-1.3 {Tk_FocusCmd procedure} unix { +} -result {} +test focus-1.3 {Tk_FocusCmd procedure} -constraints unix -body { focusClear focus .t.b3 focus -} {} -test focus-1.4 {Tk_FocusCmd procedure} unix { - list [catch {focus ""} msg] $msg -} {0 {}} -test focus-1.5 {Tk_FocusCmd procedure} unix { +} -result {} +test focus-1.4 {Tk_FocusCmd procedure} -constraints unix -body { + focus "" +} -returnCodes ok -result {} +test focus-1.5 {Tk_FocusCmd procedure} -constraints unix -body { focusClear focus -force .t focus .t.b3 focus -} {.t.b3} -test focus-1.6 {Tk_FocusCmd procedure} unix { - list [catch {focus .gorp} msg] $msg -} {1 {bad window path name ".gorp"}} -test focus-1.7 {Tk_FocusCmd procedure} unix { - list [catch {focus .gorp a} msg] $msg -} {1 {bad option ".gorp": must be -displayof, -force, or -lastfor}} -test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} unix { +} -result {.t.b3} +test focus-1.6 {Tk_FocusCmd procedure} -constraints unix -body { + focus .gorp +} -returnCodes error -result {bad window path name ".gorp"} +test focus-1.7 {Tk_FocusCmd procedure} -constraints unix -body { + focus .gorp a +} -returnCodes error -result {bad option ".gorp": must be -displayof, -force, or -lastfor} +test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} -constraints { + unix +} -setup { + destroy .t2 +} -body { + focusClear toplevel .t2 wm geom .t2 +10+10 frame .t2.f -width 200 -height 100 -bd 2 -relief raised @@ -113,109 +125,146 @@ test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} unix { destroy .t2.f lappend x [focus] destroy .t2 - set x -} {.t2.f2 .t2 .t2} -test focus-1.9 {Tk_FocusCmd procedure, -displayof option} unix { - list [catch {focus -displayof} msg] $msg -} {1 {wrong # args: should be "focus -displayof window"}} -test focus-1.10 {Tk_FocusCmd procedure, -displayof option} unix { - list [catch {focus -displayof a b} msg] $msg -} {1 {wrong # args: should be "focus -displayof window"}} -test focus-1.11 {Tk_FocusCmd procedure, -displayof option} unix { - list [catch {focus -displayof .lousy} msg] $msg -} {1 {bad window path name ".lousy"}} -test focus-1.12 {Tk_FocusCmd procedure, -displayof option} unix { + return $x +} -cleanup { + destroy .t2 +} -result {.t2.f2 .t2 .t2} +test focus-1.9 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focus -displayof +} -returnCodes error -result {wrong # args: should be "focus -displayof window"} +test focus-1.10 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focus -displayof a b +} -returnCodes error -result {wrong # args: should be "focus -displayof window"} +test focus-1.11 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focus -displayof .lousy +} -returnCodes error -result {bad window path name ".lousy"} +test focus-1.12 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { focusClear focus .t focus -displayof .t.b3 -} {} -test focus-1.13 {Tk_FocusCmd procedure, -displayof option} unix { +} -result {} +test focus-1.13 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { focusClear focus -force .t focus -displayof .t.b3 -} {.t} -test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unix altDisplay} { +} -result {.t} +test focus-1.14 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix altDisplay +} -body { + focusClear focus -force .alt.c focus -displayof .alt -} {.alt.c} -test focus-1.15 {Tk_FocusCmd procedure, -force option} unix { - list [catch {focus -force} msg] $msg -} {1 {wrong # args: should be "focus -force window"}} -test focus-1.16 {Tk_FocusCmd procedure, -force option} unix { - list [catch {focus -force a b} msg] $msg -} {1 {wrong # args: should be "focus -force window"}} -test focus-1.17 {Tk_FocusCmd procedure, -force option} unix { - list [catch {focus -force foo} msg] $msg -} {1 {bad window path name "foo"}} -test focus-1.18 {Tk_FocusCmd procedure, -force option} unix { - list [catch {focus -force ""} msg] $msg -} {0 {}} -test focus-1.19 {Tk_FocusCmd procedure, -force option} unix { +} -result {.alt.c} +test focus-1.15 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force +} -returnCodes error -result {wrong # args: should be "focus -force window"} +test focus-1.16 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force a b +} -returnCodes error -result {wrong # args: should be "focus -force window"} +test focus-1.17 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force foo +} -returnCodes error -result {bad window path name "foo"} +test focus-1.18 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force "" +} -returnCodes ok -result {} +test focus-1.19 {Tk_FocusCmd procedure, -force option} -constraints unix -body { focusClear focus .t.b1 set x [list [focus]] focus -force .t.b1 lappend x [focus] -} {{} .t.b1} -test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} unix { - list [catch {focus -lastfor} msg] $msg -} {1 {wrong # args: should be "focus -lastfor window"}} -test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} unix { - list [catch {focus -lastfor 1 2} msg] $msg -} {1 {wrong # args: should be "focus -lastfor window"}} -test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} unix { - list [catch {focus -lastfor who_knows?} msg] $msg -} {1 {bad window path name "who_knows?"}} -test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} unix { +} -result {{} .t.b1} +test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focus -lastfor +} -returnCodes error -result {wrong # args: should be "focus -lastfor window"} +test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focus -lastfor 1 2 +} -returnCodes error -result {wrong # args: should be "focus -lastfor window"} +test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focus -lastfor who_knows? +} -returnCodes error -result {bad window path name "who_knows?"} +test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focusClear + focusSetup focus .b focus .t.b1 list [focus -lastfor .] [focus -lastfor .t.b3] -} {.b .t.b1} -test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} unix { - destroy .t +} -result {.b .t.b1} +test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focusClear focusSetup update focus -lastfor .t.b2 -} {.t} -test focus-1.25 {Tk_FocusCmd procedure} unix { - list [catch {focus -unknown} msg] $msg -} {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}} +} -result {.t} +test focus-1.25 {Tk_FocusCmd procedure} -constraints unix -body { + focus -unknown +} -returnCodes error -result {bad option "-unknown": must be -displayof, -force, or -lastfor} + -test focus-2.1 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { +focusSetup +test focus-2.1 {TkFocusFilterEvent procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusClear focus -force .b - destroy .t focusSetup update set focusInfo {} event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor \ -sendevent 0x54217567 - list $focusInfo -} {{}} -test focus-2.2 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { + return $focusInfo +} -result {} +test focus-2.2 {TkFocusFilterEvent procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusClear focus -force .b - destroy .t focusSetup update set focusInfo {} event gen .t <FocusIn> -detail NotifyAncestor -sendevent 0x547321ac list $focusInfo [focus] -} {{in .t NotifyAncestor +} -result {{in .t NotifyAncestor } .b} -test focus-2.3 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { +test focus-2.3 {TkFocusFilterEvent procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusClear focus -force .b - destroy .t focusSetup update set focusInfo {} event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor update list $focusInfo [focus -lastfor .t] -} {{out .b NotifyNonlinear +} -result {{out .b NotifyNonlinear out . NotifyNonlinearVirtual in .t NotifyNonlinear } .t} -test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \ - {unix nonPortable testwrapper} { +test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} -constraints { + unix nonPortable testwrapper +} -body { + focusClear set result {} focus .t.b1 # Important to end with NotifyAncestor, which is an @@ -231,8 +280,8 @@ test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \ update lappend result $focusInfo } - set result -} {{out . NotifyNonlinear + return $result +} -result {{out . NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } {out . NotifyNonlinear @@ -245,19 +294,22 @@ in .t.b1 NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear }} -test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} \ - {unix nonPortable testwrapper} { +test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} -constraints { + unix nonPortable testwrapper +} -body { focusSetup focus .t.b1 update event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor list $focusInfo [focus] -} {{out . NotifyNonlinear +} -result {{out . NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } .t.b1} -test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \ - {unix testwrapper} { + +test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} -constraints { + unix testwrapper +} -body { focus .t.b1 focus . update @@ -266,117 +318,131 @@ test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \ set x [focus] event gen . <KeyPress-x> list $x $focusInfo -} {.t.b1 {press .t.b1 x}} -test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \ - {unix testwrapper} { +} -result {.t.b1 {press .t.b1 x}} +test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} -constraints { + unix testwrapper +} -body { set result {} foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot NotifyVirtual} { - focus -force .t.b1 - event gen [testwrapper .t] <FocusOut> -detail $detail - update - lappend result [focus] + focus -force .t.b1 + event gen [testwrapper .t] <FocusOut> -detail $detail + update + lappend result [focus] } - set result -} {{} .t.b1 {} {} .t.b1 .t.b1 {}} -test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} \ - {unix testwrapper} { + return $result +} -result {{} .t.b1 {} {} .t.b1 .t.b1 {}} +test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} -constraints { + unix testwrapper +} -body { focus -force .t.b1 event gen .t.b1 <FocusOut> -detail NotifyAncestor focus -} {.t.b1} -test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} \ - {unix testwrapper} { +} -result {.t.b1} +test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} -constraints { + unix testwrapper +} -body { focus .t.b1 event gen [testwrapper .] <FocusOut> -detail NotifyAncestor focus -} {} -test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \ - {unix testwrapper} { +} -result {} +test focus-2.10 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { set result {} focus .t.b1 focusClear foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear - NotifyNonlinearVirtual NotifyVirtual} { - event gen [testwrapper .t] <Enter> -detail $detail -focus 1 - update - lappend result [focus] - event gen [testwrapper .t] <Leave> -detail NotifyAncestor - update + NotifyNonlinearVirtual NotifyVirtual} { + event gen [testwrapper .t] <Enter> -detail $detail -focus 1 + update + lappend result [focus] + event gen [testwrapper .t] <Leave> -detail NotifyAncestor + update } - set result -} {.t.b1 {} .t.b1 .t.b1 .t.b1} -test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \ - {unix testwrapper} { + return $result +} -result {.t.b1 {} .t.b1 .t.b1 .t.b1} +test focus-2.11 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { focusClear set focusInfo {} event gen [testwrapper .t] <Enter> -detail NotifyAncestor update - set focusInfo -} {} -test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \ - {unix testwrapper} { + return $focusInfo +} -result {} +test focus-2.12 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { focus -force .b update set focusInfo {} event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 update - set focusInfo -} {} -test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \ - {unix testwrapper} { + return $focusInfo +} -result {} +test focus-2.13 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { focus .t.b1 focusClear event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 set focusInfo {} update - set focusInfo -} {in .t NotifyVirtual + return $focusInfo +} -result {in .t NotifyVirtual in .t.b1 NotifyAncestor } -test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unix testwrapper} { +test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} -constraints { + unix testwrapper +} -setup { + destroy .t2 + set focusInfo {} +} -body { focusClear - catch {destroy .t2} toplevel .t2 wm withdraw .t2 update - set focusInfo {} event gen [testwrapper .t2] <Enter> -detail NotifyAncestor -focus 1 update +} -cleanup { destroy .t2 -} {} -test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \ - {unix testwrapper} { +} -result {} +test focus-2.15 {TkFocusFilterEvent procedure, Leave events} -constraints { + unix testwrapper +} -body { set result {} focus .t.b1 foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear NotifyNonlinearVirtual NotifyVirtual} { - focusClear - event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 - update - event gen [testwrapper .t] <Leave> -detail $detail - update - lappend result [focus] + focusClear + event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 + update + event gen [testwrapper .t] <Leave> -detail $detail + update + lappend result [focus] } - set result -} {{} .t.b1 {} {} {}} -test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \ - {unix testwrapper} { - set result {} + return $result +} -result {{} .t.b1 {} {} {}} +test focus-2.16 {TkFocusFilterEvent procedure, Leave events} -constraints { + unix testwrapper +} -body { + focusClear focus .t.b1 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 update set focusInfo {} event gen [testwrapper .t] <Leave> -detail NotifyAncestor update - set focusInfo -} {out .t.b1 NotifyAncestor + return $focusInfo +} -result {out .t.b1 NotifyAncestor out .t NotifyVirtual } -test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \ - {unix testwrapper} { - set result {} +test focus-2.17 {TkFocusFilterEvent procedure, Leave events} -constraints { + unix testwrapper +} -body { + focusClear focus .t.b1 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 update @@ -385,41 +451,49 @@ test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \ event gen [testwrapper .] <Leave> -detail NotifyAncestor update list $focusInfo [focus] -} {{out .t.b1 NotifyAncestor +} -result {{out .t.b1 NotifyAncestor out .t NotifyVirtual } {}} -test focus-3.1 {SetFocus procedure, create record on focus} \ - {unix testwrapper} { + +test focus-3.1 {SetFocus procedure, create record on focus} -constraints { + unix testwrapper +} -body { toplevel .t2 -width 250 -height 100 wm geometry .t2 +0+0 update focus -force .t2 update focus -} {.t2} -catch {destroy .t2} +} -cleanup { + destroy .t2 +} -result {.t2} # This test produces no result, but it will generate a protocol # error if Tk forgets to make the window exist before focussing # on it. -test focus-3.2 {SetFocus procedure, making window exist} {unix testwrapper} { +test focus-3.2 {SetFocus procedure, making window exist} -constraints { + unix testwrapper +} -body { update button .b2 -text "Another button" focus .b2 update -} {} -catch {destroy .b2} -update +} -cleanup { + destroy .b2 + update +} -result {} # The following test doesn't produce a check-able result, but if # there are bugs it may generate an X protocol error. -test focus-3.3 {SetFocus procedure, delaying claim of X focus} \ - {unix testwrapper} { +test focus-3.3 {SetFocus procedure, delaying claim of X focus} -constraints { + unix testwrapper +} -body { focusSetup focus -force .t.b2 update -} {} -test focus-3.4 {SetFocus procedure, delaying claim of X focus} \ - {unix testwrapper} { +} -result {} +test focus-3.4 {SetFocus procedure, delaying claim of X focus} -constraints { + unix testwrapper +} -body { focusSetup wm withdraw .t focus -force .t.b2 @@ -430,52 +504,62 @@ test focus-3.4 {SetFocus procedure, delaying claim of X focus} \ update wm deiconify .t2 wm deiconify .t -} {} -catch {destroy .t2} -test focus-3.5 {SetFocus procedure, generating events} {unix testwrapper} { +} -cleanup { + destroy .t2 +} -result {} +test focus-3.5 {SetFocus procedure, generating events} -constraints { + unix testwrapper +} -body { focusSetup focusClear set focusInfo {} focus -force .t.b2 update - set focusInfo -} {in .t NotifyVirtual + return $focusInfo +} -result {in .t NotifyVirtual in .t.b2 NotifyAncestor } -test focus-3.6 {SetFocus procedure, generating events} {unix testwrapper} { +test focus-3.6 {SetFocus procedure, generating events} -constraints { + unix testwrapper +} -body { focusSetup focus -force .b update set focusInfo {} focus .t.b2 update - set focusInfo -} {out .b NotifyNonlinear + return $focusInfo +} -result {out .b NotifyNonlinear out . NotifyNonlinearVirtual in .t NotifyNonlinearVirtual in .t.b2 NotifyNonlinear } -test focus-3.7 {SetFocus procedure, generating events} \ - {unix nonPortable testwrapper} { +test focus-3.7 {SetFocus procedure, generating events} -constraints { +unix nonPortable testwrapper +} -body { # Non-portable because some platforms generate extra events. - focusSetup focusClear set focusInfo {} focus .t.b2 update - set focusInfo -} {} + return $focusInfo +} -result {} + -test focus-4.1 {TkFocusDeadWindow procedure} {unix testwrapper} { +test focus-4.1 {TkFocusDeadWindow procedure} -constraints { + unix testwrapper +} -body { focusSetup update focus -force .b update destroy .t focus -} {.b} -test focus-4.2 {TkFocusDeadWindow procedure} {unix testwrapper} { +} -result {.b} +test focus-4.2 {TkFocusDeadWindow procedure} -constraints { + unix testwrapper +} -body { focusSetup update focus -force .t.b2 @@ -484,12 +568,12 @@ test focus-4.2 {TkFocusDeadWindow procedure} {unix testwrapper} { destroy .t.b2 update focus -} {.b} - +} -result {.b} # Non-portable due to wm-specific redirection of input focus when # windows are deleted: - -test focus-4.3 {TkFocusDeadWindow procedure} {unix nonPortable testwrapper} { +test focus-4.3 {TkFocusDeadWindow procedure} -constraints { + unix nonPortable testwrapper +} -body { focusSetup update focus .t @@ -497,21 +581,27 @@ test focus-4.3 {TkFocusDeadWindow procedure} {unix nonPortable testwrapper} { destroy .t update focus -} {} -test focus-4.4 {TkFocusDeadWindow procedure} {unix testwrapper} { +} -result {} +test focus-4.4 {TkFocusDeadWindow procedure} -constraints { + unix testwrapper +} -body { focusSetup focus -force .t.b2 update destroy .t.b2 focus -} {.t} +} -result {.t} +cleanupbg + # I don't know how to test most of the remaining procedures of this file # explicitly; they've already been exercised by the preceding tests. -setupbg -test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \ - {unix testwrapper secureserver} { +# Test 5.1 fails (before and after update) +test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} -constraints { + unix testwrapper secureserver +} -body { + setupbg focusSetup focus -force .t update @@ -521,19 +611,21 @@ test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \ focus .t.b2 update lappend result [focus] -} {.t {} {}} - -catch {destroy .t} +} -cleanup { + cleanupbg +} -result {.t {} {}} +destroy .t bind all <FocusIn> {} bind all <FocusOut> {} bind all <KeyPress> {} -cleanupbg -fixfocus -test focus-6.1 {miscellaneous - embedded application in same process} \ - {unix testwrapper} { + +fixfocus +test focus-6.1 {miscellaneous - embedded application in same process} -constraints { + unix testwrapper +} -setup { eval interp delete [interp slaves] - catch {destroy .t} +} -body { toplevel .t wm geometry .t +0+0 frame .t.f1 -container 1 @@ -547,11 +639,11 @@ test focus-6.1 {miscellaneous - embedded application in same process} \ child eval "set argv {-use [winfo id .t.f1]}" load {} Tk child child eval { - entry .e1 -bg lightBlue - pack .e1 - bind all <FocusIn> {lappend x "focus in %W %d"} - bind all <FocusOut> {lappend x "focus out %W %d"} - set x {} + entry .e1 -bg lightBlue + pack .e1 + bind all <FocusIn> {lappend x "focus in %W %d"} + bind all <FocusOut> {lappend x "focus out %W %d"} + set x {} } # Claim the focus and wait long enough for it to really arrive. @@ -577,13 +669,17 @@ test focus-6.1 {miscellaneous - embedded application in same process} \ after 300 {set timer 1} vwait timer set result [list $x [child eval {set x}]] + return $result +} -cleanup { interp delete child - set result -} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} -test focus-6.2 {miscellaneous - embedded application in different process} \ - {unix testwrapper} { - eval interp delete [interp slaves] - catch {destroy .t} + destroy .t + bind all <FocusIn> {} + bind all <FocusOut> {} +} -result {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} + +test focus-6.2 {miscellaneous - embedded application in different process} -constraints { + unix testwrapper +} -body { setupbg toplevel .t wm geometry .t +0+0 @@ -596,11 +692,11 @@ test focus-6.2 {miscellaneous - embedded application in different process} \ bind all <FocusOut> {lappend x "focus out %W %d"} setupbg -use [winfo id .t.f1] dobg { - entry .e1 -bg lightBlue - pack .e1 - bind all <FocusIn> {lappend x "focus in %W %d"} - bind all <FocusOut> {lappend x "focus out %W %d"} - set x {} + entry .e1 -bg lightBlue + pack .e1 + bind all <FocusIn> {lappend x "focus in %W %d"} + bind all <FocusOut> {lappend x "focus out %W %d"} + set x {} } # Claim the focus and wait long enough for it to really arrive. @@ -626,13 +722,17 @@ test focus-6.2 {miscellaneous - embedded application in different process} \ after 300 {set timer 1} vwait timer set result [list $x [dobg {set x}]] + return $result +} -cleanup { + destroy .t cleanupbg - set result -} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} + bind all <FocusIn> {} + bind all <FocusOut> {} +} -result {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} + + deleteWindows -bind all <FocusIn> {} -bind all <FocusOut> {} # cleanup cleanupTests diff --git a/tests/focusTcl.test b/tests/focusTcl.test index 1f5eed5..ef848bb 100644 --- a/tests/focusTcl.test +++ b/tests/focusTcl.test @@ -7,131 +7,262 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test + +option add *takeFocus 1 +option add *highlightThickness 2 +. configure -takefocus 1 -highlightthickness 2 proc setup1 w { if {$w == "."} { - set w "" + set w "" } foreach i {a b c d} { - frame $w.$i -width 200 -height 50 -bd 2 -relief raised - pack $w.$i + destroy $w.$i + frame $w.$i -width 200 -height 50 -bd 2 -relief raised + pack $w.$i } .b configure -width 0 -height 0 foreach i {x y z} { - button $w.b.$i -text "Button $w.b.$i" - pack $w.b.$i -side left + destroy $w.b.$i + button $w.b.$i -text "Button $w.b.$i" + pack $w.b.$i -side left } if {![winfo ismapped $w.b.z]} { - tkwait visibility $w.b.z + tkwait visibility $w.b.z } } -option add *takeFocus 1 -option add *highlightThickness 2 -. configure -takefocus 1 -highlightthickness 2 -test focusTcl-1.1 {tk_focusNext procedure, no children} { +proc cleanup1 w { + if {$w == "."} { + set w "" + } + foreach i {a b c d} { + destroy $w.$i + } + foreach i {x y z} { + destroy $w.b.$i + } +} + + +test focusTcl-1.1 {tk_focusNext procedure, no children} -body { tk_focusNext . -} {.} -setup1 . -test focusTcl-1.2 {tk_focusNext procedure, basic tree traversal} { +} -result {.} + +test focusTcl-1.2 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . tk_focusNext . -} {.a} -test focusTcl-1.3 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.a} +test focusTcl-1.3 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . tk_focusNext .a -} {.b} -test focusTcl-1.4 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.b} +test focusTcl-1.4 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . tk_focusNext .b -} {.b.x} -test focusTcl-1.5 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.b.x} +test focusTcl-1.5 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . tk_focusNext .b.x -} {.b.y} -test focusTcl-1.6 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.b.y} +test focusTcl-1.6 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . tk_focusNext .b.y -} {.b.z} -test focusTcl-1.7 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.b.z} +test focusTcl-1.7 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . tk_focusNext .b.z -} {.c} -test focusTcl-1.8 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.c} +test focusTcl-1.8 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . tk_focusNext .c -} {.d} -test focusTcl-1.9 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.d} +test focusTcl-1.9 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . tk_focusNext .d -} {.} -foreach w {.b .b.x .b.y .c .d} { - $w configure -takefocus 0 -} -test focusTcl-1.10 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.} + +test focusTcl-1.10 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . + foreach w {.b .b.x .b.y .c .d} { + $w configure -takefocus 0 + } tk_focusNext .a -} {.b.z} -test focusTcl-1.11 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.b.z} +test focusTcl-1.11 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . + foreach w {.b .b.x .b.y .c .d} { + $w configure -takefocus 0 + } tk_focusNext .b.z -} {.} -test focusTcl-1.12 {tk_focusNext procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.} + +test focusTcl-1.12 {tk_focusNext procedure, basic tree traversal} -body { + setup1 . deleteWindows setup1 . update . configure -takefocus 0 tk_focusNext .d -} {.a} -. configure -takefocus 1 +} -cleanup { + . configure -takefocus 1 + cleanup1 . +} -result {.a} + + +test focusTcl-2.1 {tk_focusNext procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a -deleteWindows -setup1 . -toplevel .t -wm geom .t +0+0 -toplevel .t2 -wm geom .t2 -0+0 -raise .t .a -test focusTcl-2.1 {tk_focusNext procedure, toplevels} { tk_focusNext .a -} {.b} -test focusTcl-2.2 {tk_focusNext procedure, toplevels} { +} -cleanup { + deleteWindows +} -result {.b} +test focusTcl-2.2 {tk_focusNext procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a + tk_focusNext .d -} {.} -test focusTcl-2.3 {tk_focusNext procedure, toplevels} { +} -cleanup { + deleteWindows +} -result {.} +test focusTcl-2.3 {tk_focusNext procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a + tk_focusNext .t -} {.t} -setup1 .t -raise .t.b -test focusTcl-2.4 {tk_focusNext procedure, toplevels} { +} -cleanup { + deleteWindows +} -result {.t} +test focusTcl-2.4 {tk_focusNext procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a + setup1 .t + raise .t.b + tk_focusNext .t -} {.t.a} -test focusTcl-2.5 {tk_focusNext procedure, toplevels} { +} -cleanup { + deleteWindows +} -result {.t.a} +test focusTcl-2.5 {tk_focusNext procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a + setup1 .t + raise .t.b + tk_focusNext .t.b.z -} {.t} +} -cleanup { + deleteWindows +} -result {.t} -deleteWindows -test focusTcl-3.1 {tk_focusPrev procedure, no children} { + +test focusTcl-3.1 {tk_focusPrev procedure, no children} -body { tk_focusPrev . -} {.} -setup1 . -test focusTcl-3.2 {tk_focusPrev procedure, basic tree traversal} { +} -result {.} + +test focusTcl-3.2 {tk_focusPrev procedure, basic tree traversal} -body { + setup1 . tk_focusPrev . -} {.d} -test focusTcl-3.3 {tk_focusPrev procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.d} +test focusTcl-3.3 {tk_focusPrev procedure, basic tree traversal} -body { + setup1 . tk_focusPrev .d -} {.c} -test focusTcl-3.4 {tk_focusPrev procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.c} +test focusTcl-3.4 {tk_focusPrev procedure, basic tree traversal} -body { + setup1 . tk_focusPrev .c -} {.b.z} -test focusTcl-3.5 {tk_focusPrev procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.b.z} +test focusTcl-3.5 {tk_focusPrev procedure, basic tree traversal} -body { + setup1 . tk_focusPrev .b.z -} {.b.y} -test focusTcl-3.6 {tk_focusPrev procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.b.y} +test focusTcl-3.6 {tk_focusPrev procedure, basic tree traversal} -body { + setup1 . tk_focusPrev .b.y -} {.b.x} -test focusTcl-3.7 {tk_focusPrev procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.b.x} +test focusTcl-3.7 {tk_focusPrev procedure, basic tree traversal} -body { + setup1 . tk_focusPrev .b.x -} {.b} -test focusTcl-3.8 {tk_focusPrev procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.b} +test focusTcl-3.8 {tk_focusPrev procedure, basic tree traversal} -body { + setup1 . tk_focusPrev .b -} {.a} -test focusTcl-3.9 {tk_focusPrev procedure, basic tree traversal} { +} -cleanup { + cleanup1 . +} -result {.a} +test focusTcl-3.9 {tk_focusPrev procedure, basic tree traversal} -body { + setup1 . tk_focusPrev .a -} {.} +} -cleanup { + cleanup1 . +} -result {.} + deleteWindows setup1 . @@ -140,35 +271,95 @@ wm geom .t +0+0 toplevel .t2 wm geom .t2 -0+0 raise .t .a -test focusTcl-4.1 {tk_focusPrev procedure, toplevels} { +test focusTcl-4.1 {tk_focusPrev procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a + tk_focusPrev . -} {.d} -test focusTcl-4.2 {tk_focusPrev procedure, toplevels} { +} -cleanup { + deleteWindows +} -result {.d} +test focusTcl-4.2 {tk_focusPrev procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a + tk_focusPrev .b -} {.a} -test focusTcl-4.3 {tk_focusPrev procedure, toplevels} { +} -cleanup { + deleteWindows +} -result {.a} +test focusTcl-4.3 {tk_focusPrev procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a + tk_focusPrev .t -} {.t} -setup1 .t -update -.t configure -takefocus 0 -raise .t.b -test focusTcl-4.4 {tk_focusPrev procedure, toplevels} { +} -cleanup { + deleteWindows +} -result {.t} + +test focusTcl-4.4 {tk_focusPrev procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a + setup1 .t + update + .t configure -takefocus 0 + raise .t.b + tk_focusPrev .t -} {.t.b.z} -test focusTcl-4.5 {tk_focusPrev procedure, toplevels} { - tk_focusPrev .t.a -} {.t.b.z} +} -cleanup { + deleteWindows +} -result {.t.b.z} +test focusTcl-4.5 {tk_focusPrev procedure, toplevels} -setup { + deleteWindows +} -body { + setup1 . + toplevel .t + wm geom .t +0+0 + toplevel .t2 + wm geom .t2 -0+0 + raise .t .a + setup1 .t + update + .t configure -takefocus 0 + raise .t.b -deleteWindows -test focusTcl-5.1 {tkFocusOK procedure, -takefocus 0} { + tk_focusPrev .t.a +} -cleanup { deleteWindows +} -result {.t.b.z} + + +test focusTcl-5.1 {tkFocusOK procedure, -takefocus 0} -body { setup1 . .b.x configure -takefocus 0 tk_focusNext .b -} {.b.y} -test focusTcl-5.2 {tkFocusOK procedure, -takefocus 1} { - deleteWindows +} -cleanup { + cleanup1 . +} -result {.b.y} +test focusTcl-5.2 {tkFocusOK procedure, -takefocus 1} -body { setup1 . pack forget .b update @@ -176,103 +367,119 @@ test focusTcl-5.2 {tkFocusOK procedure, -takefocus 1} { .b.y configure -takefocus "" .b.z configure -takefocus "" list [tk_focusNext .a] [tk_focusNext .b.x] -} {.c .c} -test focusTcl-5.3 {tkFocusOK procedure, -takefocus procedure} { +} -cleanup { + cleanup1 . +} -result {.c .c} +test focusTcl-5.3 {tkFocusOK procedure, -takefocus procedure} -body { proc t w { - if {$w == ".b.x"} { - return 1 - } elseif {$w == ".b.y"} { - return "" - } - return 0 + if {$w == ".b.x"} { + return 1 + } elseif {$w == ".b.y"} { + return "" } - deleteWindows + return 0 + } + setup1 . pack forget .b.y update .b configure -takefocus "" foreach w {.b.x .b.y .b.z .c} { - $w configure -takefocus t + $w configure -takefocus t } list [tk_focusNext .a] [tk_focusNext .b.x] -} {.b.x .d} -test focusTcl-5.4 {tkFocusOK procedure, -takefocus ""} { - deleteWindows +} -cleanup { + cleanup1 . +} -result {.b.x .d} +test focusTcl-5.4 {tkFocusOK procedure, -takefocus ""} -body { setup1 . .b.x configure -takefocus "" update tk_focusNext .b -} {.b.x} -test focusTcl-5.5 {tkFocusOK procedure, -takefocus "", not mapped} { - deleteWindows +} -cleanup { + cleanup1 . +} -result {.b.x} +test focusTcl-5.5 {tkFocusOK procedure, -takefocus "", not mapped} -body { setup1 . .b.x configure -takefocus "" pack unpack .b.x update tk_focusNext .b -} {.b.y} -test focusTcl-5.6 {tkFocusOK procedure, -takefocus "", not mapped} { - deleteWindows +} -cleanup { + cleanup1 . +} -result {.b.y} +test focusTcl-5.6 {tkFocusOK procedure, -takefocus "", not mapped} -body { setup1 . foreach w {.b.x .b.y .b.z} { - $w configure -takefocus "" + $w configure -takefocus "" } pack unpack .b update tk_focusNext .b -} {.c} -test focusTcl-5.7 {tkFocusOK procedure, -takefocus "", not mapped} { - deleteWindows +} -cleanup { + cleanup1 . +} -result {.c} +test focusTcl-5.7 {tkFocusOK procedure, -takefocus "", not mapped} -body { setup1 . .b.y configure -takefocus 1 pack unpack .b.y update tk_focusNext .b.x -} {.b.z} -test focusTcl-5.8 {tkFocusOK procedure, -takefocus "", not mapped} { +} -cleanup { + cleanup1 . +} -result {.b.z} +test focusTcl-5.8 {tkFocusOK procedure, -takefocus "", not mapped} -body { proc always args {return 1} - deleteWindows setup1 . .b.y configure -takefocus always pack unpack .b.y update tk_focusNext .b.x -} {.b.y} -test focusTcl-5.9 {tkFocusOK procedure, -takefocus "", window disabled} { - deleteWindows +} -cleanup { + cleanup1 . +} -result {.b.y} +test focusTcl-5.9 {tkFocusOK procedure, -takefocus "", window disabled} -body { setup1 . foreach w {.b.x .b.y .b.z} { - $w configure -takefocus "" + $w configure -takefocus "" } update .b.x configure -state disabled tk_focusNext .b -} {.b.y} -test focusTcl-5.10 {tkFocusOK procedure, -takefocus "", check for bindings} { - deleteWindows +} -cleanup { + cleanup1 . +} -result {.b.y} +test focusTcl-5.10 {tkFocusOK procedure, -takefocus "", check for bindings} -body { setup1 . foreach w {.a .b .c .d} { - $w configure -takefocus "" + $w configure -takefocus "" } update bind .a <Key> {foo} list [tk_focusNext .] [tk_focusNext .a] -} {.a .b.x} -test focusTcl-5.11 {tkFocusOK procedure, -takefocus "", check for bindings} { - deleteWindows +} -cleanup { + cleanup1 . +} -result {.a .b.x} +test focusTcl-5.11 {tkFocusOK procedure, -takefocus "", check for bindings} -body { setup1 . foreach w {.a .b .c .d} { - $w configure -takefocus "" + $w configure -takefocus "" } update bind Frame <Key> {foo} list [tk_focusNext .] [tk_focusNext .a] -} {.a .b} +} -cleanup { + cleanup1 . + bind Frame <Key> {} +} -result {.a .b} + -bind Frame <Key> {} . configure -takefocus 0 -highlightthickness 0 option clear # cleanup cleanupTests return + + + diff --git a/tests/font.test b/tests/font.test index 9ed24dc..9e44a93 100644 --- a/tests/font.test +++ b/tests/font.test @@ -6,14 +6,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -catch {destroy .b} -toplevel .b -wm geom .b +0+0 -update idletasks set defaultfontlist [font names] @@ -34,36 +31,11 @@ proc clearnondefaultfonts {} { } } -proc setup {} { - catch {destroy .b.f} - clearnondefaultfonts - label .b.f - pack .b.f - update -} - -label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Courier -12" -pack .b.l -canvas .b.c -closeenough 0 -.b.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" -pack .b.c -update - -set ax [winfo reqwidth .b.l] -set ay [winfo reqheight .b.l] -proc getsize {} { - update - return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" -} - -proc csetup {{str ""}} { - focus -force .b.c - .b.c dchars text 0 end - .b.c insert text 0 $str - .b.c focus text -} - -setup +deleteWindows +# Toplevel used (in some tests) of the whole file +toplevel .t +wm geom .t +0+0 +update idletasks switch [tk windowingsystem] { x11 {set fixed "fixed"} @@ -72,195 +44,241 @@ switch [tk windowingsystem] { } -set times [font actual {times 0} -family] +# Procedure used in tests: 24.15, 26.*, 28.*, 30.*, 31.*, 32.1 +proc csetup {{str ""}} { + focus -force .t.c + .t.c dchars text 0 end + .t.c insert text 0 $str + .t.c focus text +} + -test font-1.1 {TkFontPkgInit} { +test font-1.1 {TkFontPkgInit} -setup { catch {interp delete foo} +} -body { interp create foo foo eval { - load {} Tk - wm geometry . +0+0 - update + load {} Tk + wm geometry . +0+0 + update } interp delete foo -} {} +} -result {} + -test font-2.1 {TkFontPkgFree} { +test font-2.1 {TkFontPkgFree} -setup { catch {interp delete foo} - interp create foo set x {} +} -body { + interp create foo # Makes sure that named font was visible only to child interp. - foo eval { - load {} Tk - wm geometry . +0+0 - button .b -font {times 16} -text "hi" - pack .b - font create wiggles -family courier -underline 1 - update + load {} Tk + wm geometry . +0+0 + button .b -font {times 16} -text "hi" + pack .b + font create wiggles -family courier -underline 1 + update } lappend x [catch {font configure wiggles} msg; set msg] # Tests cancelling the idle handler for TheWorldHasChanged, # because app goes away before idle serviced. - foo eval { - .b config -font wiggles - font config wiggles -size 24 - destroy . + .b config -font wiggles + font config wiggles -size 24 + destroy . } lappend x [foo eval {catch {font families} msg; set msg}] +} -cleanup { + interp delete foo +} -result {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}} - interp delete foo - set x -} {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}} +test font-3.1 {font command: general} -body { + font +} -returnCodes error -result {wrong # args: should be "font option ?arg?"} +test font-3.2 {font command: general} -body { + font xyz +} -returnCodes error -result {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names} -test font-3.1 {font command: general} { - list [catch {font} msg] $msg -} {1 {wrong # args: should be "font option ?arg?"}} -test font-3.2 {font command: general} { - list [catch {font xyz} msg] $msg -} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}} -test font-4.1 {font command: actual: arguments} { +test font-4.1 {font command: actual: arguments} -body { # (skip < 0) - list [catch {font actual xyz -displayof} msg] $msg -} {1 {value for "-displayof" missing}} -test font-4.2 {font command: actual: arguments} { + font actual xyz -displayof +} -returnCodes error -result {value for "-displayof" missing} +test font-4.2 {font command: actual: arguments} -body { # (objc < 3) - list [catch {font actual} msg] $msg -} {1 {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}} -test font-4.3 {font command: actual: arguments} { + font actual +} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"} +test font-4.3 {font command: actual: arguments} -body { # (objc - skip > 4) when skip == 0 - list [catch {font actual xyz abc def} msg] $msg -} {1 {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}} -test font-4.4 {font command: actual: displayof specified, so skip to next} { + font actual xyz abc def +} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"} +test font-4.4 {font command: actual: displayof specified, so skip to next} -body { catch {font actual xyz -displayof . -size} -} {0} -test font-4.5 {font command: actual: displayof specified, so skip to next} { +} -result {0} +test font-4.5 {font command: actual: displayof specified, so skip to next} -body { lindex [font actual xyz -displayof .] 0 -} {-family} -test font-4.6 {font command: actual: arguments} { +} -result {-family} +test font-4.6 {font command: actual: arguments} -body { # (objc - skip > 4) when skip == 2 - list [catch {font actual xyz -displayof . abc def} msg] $msg -} {1 {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}} -test font-4.7 {font command: actual: arguments} {noExceed} { + font actual xyz -displayof . abc def +} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"} +test font-4.7 {font command: actual: arguments} -constraints noExceed -body { # (tkfont == NULL) - list [catch {font actual "\{xyz"} msg] $msg -} [list 1 "font \"{xyz\" doesn't exist"] -test font-4.8 {font command: actual: all attributes} { + font actual "\{xyz" +} -returnCodes error -result "font \"{xyz\" doesn't exist" +test font-4.8 {font command: actual: all attributes} -body { # not (objc > 3) so objPtr = NULL lindex [font actual {-family times}] 0 -} {-family} -test font-4.9 {font command: actual} {unix noExceed} { +} -result {-family} +test font-4.9 {font command: actual} -constraints {unix noExceed} -body { # (objc > 3) so objPtr = objv[3 + skip] string tolower [font actual {-family times} -family] -} {times} -test font-4.10 {font command: actual} win { +} -result {times} +test font-4.10 {font command: actual} -constraints win -body { # (objc > 3) so objPtr = objv[3 + skip] font actual {-family times} -family -} {Times New Roman} -test font-4.11 {font command: bad option} { - list [catch {font actual xyz -style} msg] $msg -} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}} +} -result {Times New Roman} +test font-4.11 {font command: bad option} -body { + font actual xyz -style +} -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike} + -test font-5.1 {font command: configure} { +test font-5.1 {font command: configure} -body { # (objc < 3) - list [catch {font configure} msg] $msg -} {1 {wrong # args: should be "font configure fontname ?options?"}} -test font-5.2 {font command: configure: non-existent font} { + font configure +} -returnCodes error -result {wrong # args: should be "font configure fontname ?-option value ...?"} +test font-5.2 {font command: configure: non-existent font} -body { # (namedHashPtr == NULL) - list [catch {font configure xyz} msg] $msg -} {1 {named font "xyz" doesn't exist}} -test font-5.3 {font command: configure: "deleted" font} { + font configure xyz +} -returnCodes error -result {named font "xyz" doesn't exist} +test font-5.3 {font command: configure: "deleted" font} -setup { + destroy .t.f + catch {font delete xyz} + pack [label .t.f] + update +} -body { # (nfPtr->deletePending != 0) - setup font create xyz - .b.f configure -font xyz + .t.f configure -font xyz font delete xyz - list [catch {font configure xyz} msg] $msg -} {1 {named font "xyz" doesn't exist}} -test font-5.4 {font command: configure: get all options} { + font configure xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {named font "xyz" doesn't exist} +test font-5.4 {font command: configure: get all options} -setup { + catch {font delete xyz} +} -body { # (objc == 3) so objPtr = NULL - setup font create xyz -family xyz lindex [font configure xyz] 1 -} xyz -test font-5.5 {font command: configure: get one option} { +} -cleanup { + font delete xyz +} -result xyz +test font-5.5 {font command: configure: get one option} -setup { + clearnondefaultfonts +} -body { # (objc == 4) so objPtr = objv[3] - setup font create xyz -family xyz font configure xyz -family -} xyz -test font-5.6 {font command: configure: update existing font} { + getnondefaultfonts +} -cleanup { + font delete xyz +} -result xyz +test font-5.6 {font command: configure: update existing font} -setup { + catch {font delete xyz} +} -body { # else result = ConfigAttributesObj() - setup font create xyz font configure xyz -family xyz update font configure xyz -family -} xyz -test font-5.7 {font command: configure: bad option} { - setup +} -cleanup { + font delete xyz +} -result xyz +test font-5.7 {font command: configure: bad option} -setup { + catch {font delete xyz} +} -body { font create xyz - list [catch {font configure xyz -style} msg] $msg -} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}} + font configure xyz -style +} -cleanup { + font delete xyz +} -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike} + -test font-6.1 {font command: create: make up name} { +test font-6.1 {font command: create: make up name} -setup { + clearnondefaultfonts +} -body { # (objc < 3) so name = NULL - setup font create - expr {"font1" in [font names]} -} {1} -test font-6.2 {font command: create: name specified} { + getnondefaultfonts +} -cleanup { + font delete font1 +} -result {font1} +test font-6.2 {font command: create: name specified} -setup { + clearnondefaultfonts +} -body { # not (objc < 3) - setup font create xyz - expr {"xyz" in [font names]} -} {1} -test font-6.3 {font command: create: name not really specified} { + getnondefaultfonts +} -cleanup { + font delete xyz +} -result {xyz} +test font-6.3 {font command: create: name not really specified} -setup { + clearnondefaultfonts +} -body { # (name[0] == '-') so name = NULL - setup font create -family xyz - expr {"font1" in [font names]} -} {1} -test font-6.4 {font command: create: generate name} { + getnondefaultfonts +} -cleanup { + font delete font1 +} -result {font1} +test font-6.4 {font command: create: generate name} -setup { +} -body { # (name == NULL) - setup font create -family one font create -family two font create -family three font delete font2 font create -family four font configure font2 -family -} {four} -test font-6.5 {font command: create: bad option creating new font} { +} -cleanup { + font delete font1 font2 font3 +} -result {four} +test font-6.5 {font command: create: bad option creating new font} -setup { + catch {font delete xyz} +} -body { # name was specified so skip = 3 - setup - list [catch {font create xyz -xyz times} msg] $msg -} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}} -test font-6.6 {font command: create: bad option creating new font} { + font create xyz -xyz times +} -returnCodes error -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike} +test font-6.6 {font command: create: bad option creating new font} -setup { + clearnondefaultfonts +} -body { # name was not specified so skip = 2 - setup - list [catch {font create -xyz times} msg] $msg -} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}} -test font-6.7 {font command: create: already exists} { + font create -xyz times +} -returnCodes error -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike} +test font-6.7 {font command: create: already exists} -setup { + catch {font delete xyz} +} -body { # (CreateNamedFont() != TCL_OK) - setup font create xyz - list [catch {font create xyz} msg] $msg -} {1 {named font "xyz" already exists}} + font create xyz +} -cleanup { + font delete xyz +} -returnCodes error -result {named font "xyz" already exists} -test font-7.1 {font command: delete: arguments} { +test font-7.1 {font command: delete: arguments} -body { # (objc < 3) - list [catch {font delete} msg] $msg -} {1 {wrong # args: should be "font delete fontname ?fontname ...?"}} -test font-7.2 {font command: delete: loop test} { + font delete +} -returnCodes error -result {wrong # args: should be "font delete fontname ?fontname ...?"} +test font-7.2 {font command: delete: loop test} -setup { + clearnondefaultfonts + set x {} +} -body { # for (i = 2; i < objc; i++) - setup - set x {} font create a -underline 1 font create b -underline 1 font create c -underline 1 @@ -269,11 +287,14 @@ test font-7.2 {font command: delete: loop test} { lappend x [lsort [getnondefaultfonts]] font delete a e c b lappend x [lsort [getnondefaultfonts]] -} {{a b c d e} d} -test font-7.3 {font command: delete: loop test} { +} -cleanup { + getnondefaultfonts +} -result {{a b c d e} d} +test font-7.3 {font command: delete: loop test} -setup { + clearnondefaultfonts + set x {} +} -body { # (namedHashPtr == NULL) in middle of loop - setup - set x {} font create a -underline 1 font create b -underline 1 font create c -underline 1 @@ -282,299 +303,440 @@ test font-7.3 {font command: delete: loop test} { lappend x [lsort [getnondefaultfonts]] catch {font delete a d q c e b} lappend x [lsort [getnondefaultfonts]] -} {{a b c d e} {b c e}} -test font-7.4 {font command: delete: non-existent} { +} -cleanup { + clearnondefaultfonts +} -result {{a b c d e} {b c e}} +test font-7.4 {font command: delete: non-existent} -setup { + catch {font delete xyz} +} -body { # (namedHashPtr == NULL) - setup - list [catch {font delete xyz} msg] $msg -} {1 {named font "xyz" doesn't exist}} -test font-7.5 {font command: delete: mark for later deletion} { + font delete xyz +} -returnCodes error -result {named font "xyz" doesn't exist} +test font-7.5 {font command: delete: mark for later deletion} -setup { + destroy .t.f + catch {font delete xyz} + pack [label .t.f] + update +} -body { # (nfPtr->refCount != 0) - setup font create xyz - .b.f configure -font xyz + .t.f configure -font xyz font delete xyz font actual xyz - list [catch {font configure xyz} msg] $msg [.b.f cget -font] -} {1 {named font "xyz" doesn't exist} xyz} -test font-7.6 {font command: delete: actually delete} { + font configure xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {named font "xyz" doesn't exist} +test font-7.6 {font command: delete: mark for later deletion} -setup { + destroy .t.f + catch {font delete xyz} + pack [label .t.f] + update +} -body { + # (nfPtr->refCount != 0) + font create xyz + .t.f configure -font xyz + font delete xyz + font actual xyz + catch {font configure xyz} + .t.f cget -font +} -cleanup { + destroy .t.f +} -result xyz +test font-7.7 {font command: delete: actually delete} -setup { + catch {font delete xyz} +} -body { # not (nfPtr->refCount != 0) - setup font create xyz -underline 1 font delete xyz - catch {font config xyz} -} {1} -setup + font config xyz +} -returnCodes error -match glob -result {*} -test font-8.1 {font command: families: arguments} { + +test font-8.1 {font command: families: arguments} -body { # (skip < 0) - list [catch {font families -displayof} msg] $msg -} {1 {value for "-displayof" missing}} -test font-8.2 {font command: families: arguments} { + font families -displayof +} -returnCodes error -result {value for "-displayof" missing} +test font-8.2 {font command: families: arguments} -body { # (objc - skip != 2) when skip == 0 - list [catch {font families xyz} msg] $msg -} {1 {wrong # args: should be "font families ?-displayof window?"}} -test font-8.3 {font command: families: arguments} { + font families xyz +} -returnCodes error -result {wrong # args: should be "font families ?-displayof window?"} +test font-8.3 {font command: families: arguments} -body { # (objc - skip != 2) when skip == 2 - list [catch {font families -displayof . xyz} msg] $msg -} {1 {wrong # args: should be "font families ?-displayof window?"}} -test font-8.4 {font command: families} { + font families -displayof . xyz +} -returnCodes error -result {wrong # args: should be "font families ?-displayof window?"} +test font-8.4 {font command: families} -body { # TkpGetFontFamilies() regexp -nocase times [font families] -} {1} +} -result 1 + -test font-9.1 {font command: measure: arguments} { +test font-9.1 {font command: measure: arguments} -body { # (skip < 0) - list [catch {expr {[font measure xyz -displayof]>0}} msg] $msg -} {0 1} -test font-9.2 {font command: measure: arguments} { + expr {[font measure xyz -displayof] > 0} +} -returnCodes ok -result 1 +test font-9.2 {font command: measure: arguments} -body { # (objc - skip != 4) - list [catch {font measure} msg] $msg -} {1 {wrong # args: should be "font measure font ?-displayof window? text"}} -test font-9.3 {font command: measure: arguments} { + font measure +} -returnCodes error -result {wrong # args: should be "font measure font ?-displayof window? text"} +test font-9.3 {font command: measure: arguments} -body { # (objc - skip != 4) - list [catch {font measure xyz abc def} msg] $msg -} {1 {wrong # args: should be "font measure font ?-displayof window? text"}} -test font-9.4 {font command: measure: arguments} {noExceed} { + font measure xyz abc def +} -returnCodes error -result {wrong # args: should be "font measure font ?-displayof window? text"} +test font-9.4 {font command: measure: arguments} -constraints noExceed -body { # (tkfont == NULL) - list [catch {font measure "\{xyz" abc} msg] $msg -} [list 1 "font \"{xyz\" doesn't exist"] -test font-9.5 {font command: measure} { + font measure "\{xyz" abc +} -returnCodes error -result "font \"{xyz\" doesn't exist" +test font-9.5 {font command: measure} -body { # Tk_TextWidth() - expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7 -} {1} -test font-9.6 {font command: measure -d} { - list [catch {expr {[font measure $fixed -d] > 0}} msg] $msg -} {0 1} -test font-9.7 {font command: measure -d with -displayof} { - list [catch {expr {[font measure $fixed -displayof . -d] > 0}} msg] $msg -} {0 1} -test font-9.8 {font command: measure: arguments} { - list [catch {font measure $fixed -displayof .} msg] $msg -} {1 {wrong # args: should be "font measure font ?-displayof window? text"}} - -test font-10.1 {font command: metrics: arguments} { - list [catch {font metrics xyz -displayof} msg] $msg -} {1 {value for "-displayof" missing}} -test font-10.2 {font command: metrics: arguments} { + expr {[font measure $fixed "abcdefg"] == [font measure $fixed "a"]*7 } +} -result 1 +test font-9.6 {font command: measure -d} -body { + expr {[font measure $fixed -d] > 0} +} -returnCodes ok -result 1 +test font-9.7 {font command: measure -d with -displayof} -body { + expr {[font measure $fixed -displayof . -d] > 0} +} -returnCodes ok -result 1 +test font-9.8 {font command: measure: arguments} -body { + font measure $fixed -displayof . +} -returnCodes error -result {wrong # args: should be "font measure font ?-displayof window? text"} + + +test font-10.1 {font command: metrics: arguments} -body { + font metrics xyz -displayof +} -returnCodes error -result {value for "-displayof" missing} +test font-10.2 {font command: metrics: arguments} -body { # (skip < 0) - list [catch {font metrics xyz -displayof} msg] $msg -} {1 {value for "-displayof" missing}} -test font-10.3 {font command: metrics: arguments} { + font metrics xyz -displayof +} -returnCodes error -result {value for "-displayof" missing} +test font-10.3 {font command: metrics: arguments} -body { # (objc < 3) - list [catch {font metrics} msg] $msg -} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}} -test font-10.4 {font command: metrics: arguments} { + font metrics +} -returnCodes error -result {wrong # args: should be "font metrics font ?-displayof window? ?option?"} +test font-10.4 {font command: metrics: arguments} -body { # (objc - skip) > 4) when skip == 0 - list [catch {font metrics xyz abc def} msg] $msg -} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}} -test font-10.5 {font command: metrics: arguments} { + font metrics xyz abc def +} -returnCodes error -result {wrong # args: should be "font metrics font ?-displayof window? ?option?"} +test font-10.5 {font command: metrics: arguments} -body { # (objc - skip) > 4) when skip == 2 - list [catch {font metrics xyz -displayof . abc} msg] $msg -} {1 {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed}} -test font-10.6 {font command: metrics: bad font} {noExceed} { + font metrics xyz -displayof . abc +} -returnCodes error -result {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed} +test font-10.6 {font command: metrics: bad font} -constraints noExceed -body { # (tkfont == NULL) - list [catch {font metrics "\{xyz"} msg] $msg -} [list 1 "font \"{xyz\" doesn't exist"] -test font-10.7 {font command: metrics: get all metrics} { - # (objc == 3) + font metrics "\{xyz" +} -returnCodes error -result "font \"{xyz\" doesn't exist" +test font-10.7 {font command: metrics: get all metrics} -setup { catch {unset a} +} -body { + # (objc == 3) array set a [font metrics {-family xyz}] - set x [lsort [array names a]] + lsort [array names a] +} -cleanup { unset a - set x -} {-ascent -descent -fixed -linespace} -test font-10.8 {font command: metrics: bad metric} { +} -result {-ascent -descent -fixed -linespace} +test font-10.8 {font command: metrics: bad metric} -body { # (Tcl_GetIndexFromObj() != TCL_OK) - list [catch {font metrics $fixed -xyz} msg] $msg -} {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}} -test font-10.9 {font command: metrics: get individual metrics} { + font metrics $fixed -xyz +} -returnCodes error -result {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed} +test font-10.9 {font command: metrics: get individual metrics} -body { font metrics $fixed -ascent font metrics $fixed -descent font metrics $fixed -linespace font metrics $fixed -fixed -} {1} +} -result 1 + -test font-11.1 {font command: names: arguments} { +test font-11.1 {font command: names: arguments} -body { # (objc != 2) - list [catch {font names xyz} msg] $msg -} {1 {wrong # args: should be "font names"}} -test font-11.2 {font command: names: loop test: no passes} { - setup + font names xyz +} -returnCodes error -result {wrong # args: should be "font names"} +test font-11.2 {font command: names: loop test: no passes} -setup { + clearnondefaultfonts +} -body { getnondefaultfonts -} {} -test font-11.3 {font command: names: loop test: one pass} { - setup +} -result {} +test font-11.3 {font command: names: loop test: one pass} -setup { + clearnondefaultfonts +} -body { font create getnondefaultfonts -} {font1} -test font-11.4 {font command: names: loop test: multiple passes} { - setup +} -result {font1} +test font-11.4 {font command: names: loop test: multiple passes} -setup { + clearnondefaultfonts +} -body { font create xyz font create abc font create def lsort [getnondefaultfonts] -} {abc def xyz} -test font-11.5 {font command: names: skip deletePending fonts} { - # (nfPtr->deletePending == 0) - setup +} -cleanup { + clearnondefaultfonts +} -result {abc def xyz} +test font-11.5 {font command: names: skip deletePending fonts} -setup { + destroy .t.f + clearnondefaultfonts + pack [label .t.f] + update set x {} +} -body { + # (nfPtr->deletePending == 0) font create xyz font create abc lappend x [lsort [getnondefaultfonts]] - .b.f config -font xyz + .t.f config -font xyz font delete xyz lappend x [getnondefaultfonts] -} {{abc xyz} abc} +} -cleanup { + clearnondefaultfonts +} -result {{abc xyz} abc} + -test font-12.1 {UpdateDependantFonts procedure: no users} { +test font-12.1 {UpdateDependantFonts procedure: no users} -setup { + catch {font delete xyz} +} -body { # (nfPtr->refCount == 0) - setup font create xyz font configure xyz -family times -} {} -test font-12.2 {UpdateDependantFonts procedure: pings the widgets} { - setup +} -cleanup { + font delete xyz +} -result {} +test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { + destroy .t.f + catch {font delete xyz} + pack [label .t.f] + update +} -body { font create xyz -family times -size 20 - .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0 + .t.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0 set a1 [font measure xyz "abcd"] update - set b1 [winfo reqwidth .b.f] + set b1 [winfo reqwidth .t.f] font configure xyz -family helvetica -size 20 set a2 [font measure xyz "abcd"] update - set b2 [winfo reqwidth .b.f] + set b2 [winfo reqwidth .t.f] expr {$a1==$b1 && $a2==$b2} -} {1} +} -cleanup { + destroy .t.f + font delete xyz +} -result {1} + -test font-13.1 {CreateNamedFont: new named font} { +test font-13.1 {CreateNamedFont: new named font} -setup { + catch {font delete xyz} + set x {} +} -body { # not (new == 0) - setup - set x {} lappend x [getnondefaultfonts] font create xyz lappend x [getnondefaultfonts] -} {{} xyz} -test font-13.2 {CreateNamedFont: named font already exists} { +} -cleanup { + font delete xyz +} -result {{} xyz} +test font-13.2 {CreateNamedFont: named font already exists} -setup { + catch {font delete xyz} +} -body { # (new == 0) - setup font create xyz - list [catch {font create xyz} msg] $msg -} {1 {named font "xyz" already exists}} -test font-13.3 {CreateNamedFont: named font already exists} { + font create xyz +} -cleanup { + font delete xyz +} -returnCodes error -result {named font "xyz" already exists} +test font-13.3 {CreateNamedFont: named font already exists} -setup { + catch {font delete xyz} +} -body { # (nfPtr->deletePending == 0) - setup font create xyz - list [catch {font create xyz} msg] $msg -} {1 {named font "xyz" already exists}} -test font-13.4 {CreateNamedFont: recreate "deleted" font} { + font create xyz +} -cleanup { + font delete xyz +} -returnCodes error -result {named font "xyz" already exists} +test font-13.4 {CreateNamedFont: recreate "deleted" font} -setup { + destroy .t.f + catch {font delete xyz} + pack [label .t.f] + update +} -body { # not (nfPtr->deletePending == 0) - setup font create xyz -family times - .b.f configure -font xyz + .t.f configure -font xyz font delete xyz font create xyz -family courier font configure xyz -family -} {courier} +} -cleanup { + font delete xyz + destroy .t.f +} -result {courier} + + +test font-14.1 {Tk_GetFont procedure} -body { +} -result {} -test font-14.1 {Tk_GetFont procedure} { -} {} -test font-15.1 {Tk_AllocFontFromObj - converting internal reps} testfont { +test font-15.1 {Tk_AllocFontFromObj - converting internal reps} -constraints { + testfont +} -setup { + destroy .b1 .b2 +} -body { set x {Times 16} lindex $x 0 - destroy .b1 .b2 button .b1 -font $x lindex $x 0 testfont counts {Times 16} -} {{1 0}} -test font-15.2 {Tk_AllocFontFromObj - discard stale font} testfont { - set x {Times 16} +} -cleanup { + destroy .b1 .b2 +} -result {{1 0}} +test font-15.2 {Tk_AllocFontFromObj - discard stale font} -constraints { + testfont +} -setup { destroy .b1 .b2 + set result {} +} -body { + set x {Times 16} button .b1 -font $x destroy .b1 - set result {} lappend result [testfont counts {Times 16}] button .b2 -font $x lappend result [testfont counts {Times 16}] -} {{} {{1 1}}} -test font-15.3 {Tk_AllocFontFromObj - reuse existing font} testfont { - set x {Times 16} +} -cleanup { + destroy .b2 +} -result {{} {{1 1}}} +test font-15.3 {Tk_AllocFontFromObj - reuse existing font} -constraints { + testfont +} -setup { destroy .b1 .b2 - button .b1 -font $x set result {} +} -body { + set x {Times 16} + button .b1 -font $x lappend result [testfont counts {Times 16}] button .b2 -font $x pack .b1 .b2 -side top lappend result [testfont counts {Times 16}] -} {{{1 1}} {{2 1}}} -test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} { +} -cleanup { + destroy .b1 .b2 +} -result {{{1 1}} {{2 1}}} +test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { # (new == 0) - setup - .b.f config -font {-family fixed} + .t.f config -font {-family fixed} lindex [font actual {-family fixed}] 0 -} {-family} -test font-15.5 {Tk_AllocFontFromObj procedure: get named font} { +} -cleanup { + destroy .t.f +} -result {-family} +test font-15.5 {Tk_AllocFontFromObj procedure: get named font} -setup { + destroy .t.f + catch {font delete xyz} + pack [label .t.f] + update +} -body { # (namedHashPtr != NULL) - setup font create xyz - .b.f config -font xyz -} {} -test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} { + .t.f config -font xyz +} -cleanup { + destroy .t.f + font delete xyz +} -result {} +test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { # not (namedHashPtr != NULL) - setup - .b.f config -font {times 20} -} {} -test font-15.7 {Tk_AllocFontFromObj procedure: get native font} unix { + .t.f config -font {times 20} +} -cleanup { + destroy .t.f +} -result {-family} -result {} +test font-15.7 {Tk_AllocFontFromObj procedure: get native font} -constraints { + unix +} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { # not (fontPtr == NULL) - setup - .b.f config -font fixed -} {} -test font-15.8 {Tk_AllocFontFromObj procedure: get native font} win { + .t.f config -font fixed +} -result {} +test font-15.8 {Tk_AllocFontFromObj procedure: get native font} -constraints { + win +} -setup { + destroy .t.f + clearnondefaultfonts + pack [label .t.f] + update +} -body { # not (fontPtr == NULL) - setup - .b.f config -font oemfixed -} {} -test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} { + .t.f config -font oemfixed +} -cleanup { + destroy .t.f +} -result {} +test font-15.9 {Tk_AllocFontFromObj procedure: get attribute font} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { # (fontPtr == NULL) - list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg -} {1 {expected integer but got "yyy"}} -test font-15.11 {Tk_AllocFontFromObj procedure: no match} {noExceed} { + .t.f config -font {xxx yyy zzz} +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "yyy"} +test font-15.10 {Tk_AllocFontFromObj procedure: no match} -constraints noExceed -body { # (ParseFontNameObj() != TCL_OK) - list [catch {font actual "\{xyz"} msg] $msg -} [list 1 "font \"{xyz\" doesn't exist"] -test font-15.12 {Tk_AllocFontFromObj procedure: get attribute font} { + font actual "\{xyz" +} -returnCodes error -result "font \"{xyz\" doesn't exist" +test font-15.11 {Tk_AllocFontFromObj procedure: get attribute font} -body { # not (ParseFontNameObj() != TCL_OK) lindex [font actual {plan 9}] 0 -} {-family} -test font-15.13 {Tk_AllocFontFromObj procedure: setup tab width} { +} -result {-family} +test font-15.12 {Tk_AllocFontFromObj procedure: setup tab width} -setup { + destroy .l +} -body { # Tk_MeasureChars(fontPtr, "0", ...) label .l -bd 0 -padx 0 -highlightthickness 0 -font $fixed -text "a\tb" update - set x [winfo reqwidth .l] - destroy .l - set x -} [expr [font measure $fixed "0"]*9] -test font-15.14 {Tk_AllocFontFromObj procedure: underline position} { + set res1 [winfo reqwidth .l] + set res2 [expr [font measure $fixed "0"]*9] + expr {$res1 eq $res2} +} -cleanup { + destroy .l +} -result 1 +test font-15.13 {Tk_AllocFontFromObj procedure: underline position} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { # (fontPtr->underlineHeight == 0) because size was < 10 - setup - .b.f config -text "underline" -font "times -8 underline" + .t.f config -text "underline" -font "times -8 underline" update -} {} +} -cleanup { + destroy .t.f +} -result {} -test font-16.1 {Tk_NameOfFont procedure} { - setup - .b.f config -font -family\ fixed - .b.f cget -font -} {-family fixed} -test font-17.1 {Tk_FreeFontFromObj - reference counts} testfont { - set x {Courier 12} +test font-16.1 {Tk_NameOfFont procedure} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { + .t.f config -font -family\ fixed + .t.f cget -font +} -cleanup { + destroy .t.f +} -result {-family fixed} + + +test font-17.1 {Tk_FreeFontFromObj - reference counts} -constraints { + testfont +} -setup { destroy .b1 .b2 .b3 + set result {} +} -body { + set x {Courier 12} button .b1 -font $x button .b3 -font $x button .b2 -font $x - set result {} lappend result [testfont counts {Courier 12}] destroy .b1 lappend result [testfont counts {Courier 12}] @@ -582,61 +744,83 @@ test font-17.1 {Tk_FreeFontFromObj - reference counts} testfont { lappend result [testfont counts {Courier 12}] destroy .b3 lappend result [testfont counts {Courier 12}] -} {{{3 1}} {{2 1}} {{1 1}} {}} -test font-17.2 {Tk_FreeFont procedure: one ref} { +} -result {{{3 1}} {{2 1}} {{1 1}} {}} +test font-17.2 {Tk_FreeFont procedure: one ref} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { # (fontPtr->refCount == 0) - setup - .b.f config -font {-family fixed} - destroy .b.f -} {} -test font-17.3 {Tk_FreeFont procedure: multiple ref} { + .t.f config -font {-family fixed} + destroy .t.f +} -result {} +test font-17.3 {Tk_FreeFont procedure: multiple ref} -setup { + destroy .t.f .t.b + pack [label .t.f] + update +} -body { # not (fontPtr->refCount == 0) - setup - .b.f config -font {-family fixed} - button .b.b -font {-family fixed} - destroy .b.f - set x [.b.b cget -font] - destroy .b.b - set x -} {-family fixed} -test font-17.4 {Tk_FreeFont procedure: named font} { + .t.f config -font {-family fixed} + button .t.b -font {-family fixed} + destroy .t.f + .t.b cget -font +} -cleanup { + destroy .t.b +} -result {-family fixed} +test font-17.4 {Tk_FreeFont procedure: named font} -setup { + destroy .t.f + clearnondefaultfonts + pack [label .t.f] + update +} -body { # (fontPtr->namedHashPtr != NULL) - setup font create xyz - .b.f config -font xyz - destroy .b.f - expr {"xyz" in [font names]} -} {1} -test font-17.5 {Tk_FreeFont procedure: named font} { + .t.f config -font xyz + destroy .t.f + getnondefaultfonts +} -result {xyz} +test font-17.5 {Tk_FreeFont procedure: named font} -setup { + destroy .t.f + catch {font delete xyz} + pack [label .t.f] + update +} -body { # not (fontPtr->refCount == 0) - setup font create xyz -underline 1 - .b.f config -font xyz + .t.f config -font xyz font delete xyz set x [font actual xyz -underline] - destroy .b.f + destroy .t.f list [font actual xyz -underline] $x -} {0 1} -test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} { - setup +} -result {0 1} +test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} -setup { + destroy .t.f .t.b + catch {font delete xyz} + pack [label .t.f] + update +} -body { font create xyz - .b.f config -font xyz - button .b.b -font xyz + .t.f config -font xyz + button .t.b -font xyz font delete xyz set x [font actual xyz] - destroy .b.b + destroy .t.b list [lindex [font actual xyz] 0] [lindex $x 0] -} {-family -family} +} -cleanup { + destroy .t.f +} -result {-family -family} -test font-18.1 {FreeFontObjProc} testfont { + +test font-18.1 {FreeFontObjProc} -constraints testfont -setup { destroy .b1 - set x [format {Courier 12}] + set result {} +} -body { + set x [join {Courier 12} { }] button .b1 -font $x - set y [format {Courier 12}] + set y [join {Courier 12} { }] .b1 configure -font $y - set z [format {Courier 12}] + set z [join {Courier 12} { }] .b1 configure -font $z - set result {} lappend result [testfont counts {Courier 12}] set x red lappend result [testfont counts {Courier 12}] @@ -645,275 +829,864 @@ test font-18.1 {FreeFontObjProc} testfont { destroy .b1 lappend result [testfont counts {Courier 12}] set y bogus - set result -} {{{1 3}} {{1 2}} {{1 1}} {}} + return $result +} -result {{{1 3}} {{1 2}} {{1 1}} {}} + -test font-19.1 {Tk_FontId} { - .b.f config -font "times 20" +test font-19.1 {Tk_FontId} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { + .t.f config -font "times 20" update -} {} +} -cleanup { + destroy .t.f +} -result {} + -test font-20.1 {Tk_GetFontMetrics procedure} { - button .b.w1 -text abc - entry .b.w2 -text abcd +test font-20.1 {Tk_GetFontMetrics procedure} -setup { + destroy .t.w1 .t.w2 +} -body { + button .t.w1 -text abc + entry .t.w2 -text abcd update - destroy .b.w1 .b.w2 -} {} + destroy .t.w1 .t.w2 +} -result {} + +# Procedure used in 21.* tests proc psfontname {name} { - set a [.b.c itemcget text -font] - .b.c itemconfig text -text "We need text" -font $name - set post [.b.c postscript] - .b.c itemconfig text -font $a + destroy .t.c + canvas .t.c -closeenough 0 + .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" + pack .t.c + update + set a [.t.c itemcget text -font] + .t.c itemconfig text -text "We need text" -font $name + set post [.t.c postscript] + .t.c itemconfig text -font $a set end [string first "findfont" $post] incr end -2 set post [string range $post [expr $end-70] $end] set start [string first "gsave" $post] + destroy .t.c return [string range $post [expr $start+7] end] } -test font-21.1 {Tk_PostscriptFontName procedure: native} unix { +test font-21.1 {Tk_PostscriptFontName procedure: native} -constraints { + unix +} -body { set x [font actual {{itc avant garde} 10} -family] if {[string match *avant*garde $x]} { - psfontname "{itc avant garde} 10" + psfontname "{itc avant garde} 10" } else { - set x {AvantGarde-Book} + set x {AvantGarde-Book} } -} {AvantGarde-Book} -test font-21.2 {Tk_PostscriptFontName procedure: native} win { +} -result {AvantGarde-Book} +test font-21.2 {Tk_PostscriptFontName procedure: native} -constraints { + win +} -body { psfontname "arial 10" -} {Helvetica} -test font-21.3 {Tk_PostscriptFontName procedure: native} win { +} -result {Helvetica} +test font-21.3 {Tk_PostscriptFontName procedure: native} -constraints { + win +} -body { psfontname "{times new roman} 10" -} {Times-Roman} -test font-21.4 {Tk_PostscriptFontName procedure: native} win { +} -result {Times-Roman} +test font-21.4 {Tk_PostscriptFontName procedure: native} -constraints { + win +} -body { psfontname "{courier new} 10" -} {Courier} -test font-21.8 {Tk_PostscriptFontName procedure: spaces} unix { +} -result {Courier} +test font-21.5 {Tk_PostscriptFontName procedure: spaces} -constraints { + unix +} -body { set x [font actual {{lucida bright} 10} -family] if {[string match lucida*bright $x]} { - psfontname "{lucida bright} 10" + psfontname "{lucida bright} 10" } else { - set x {LucidaBright} + set x {LucidaBright} } -} {LucidaBright} -test font-21.9 {Tk_PostscriptFontName procedure: spaces} unix { +} -result {LucidaBright} +test font-21.6 {Tk_PostscriptFontName procedure: spaces} -constraints { + unix +} -body { psfontname "{new century schoolbook} 10" -} {NewCenturySchlbk-Roman} -set i 10 -foreach p { - {font-21.10 "avantgarde" - AvantGarde-Book AvantGarde-Demi - AvantGarde-BookOblique AvantGarde-DemiOblique} - {font-21.11 "bookman" - Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic} - {font-21.12 "courier" - Courier Courier-Bold Courier-Oblique Courier-BoldOblique} - {font-21.13 "helvetica" - Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique} - {font-21.14 "new century schoolbook" - NewCenturySchlbk-Roman NewCenturySchlbk-Bold - NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic} - {font-21.15 "palatino" - Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic} - {font-21.16 "symbol" - Symbol Symbol Symbol Symbol} - {font-21.17 "times" - Times-Roman Times-Bold Times-Italic Times-BoldItalic} - {font-21.18 "zapfchancery" - ZapfChancery-MediumItalic ZapfChancery-MediumItalic - ZapfChancery-MediumItalic ZapfChancery-MediumItalic} - {font-21.19 "zapfdingbats" - ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats} -} { - set values [lassign $p testName family] - test $testName {Tk_PostscriptFontName procedure: exhaustive} unix { - set x {} - set j 0 - foreach slant {roman italic} { - foreach weight {normal bold} { - set name [list $family 12 $slant $weight] - if {[font actual $name -family] == $family} { - lappend x [psfontname $name] - } else { - lappend x [lindex $values $j] - } - incr j - } - } - set x - } $values -} -foreach p { - {font-21.20 "arial" - Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique} - {font-21.21 "courier new" - Courier Courier-Bold Courier-Oblique Courier-BoldOblique} - {font-21.22 "helvetica" - Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique} - {font-21.23 "symbol" - Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic} - {font-21.24 "times new roman" - Times-Roman Times-Bold Times-Italic Times-BoldItalic} -} { - set values [lassign $p testName family] - test $testName {Tk_PostscriptFontName procedure: exhaustive} win { - set x {} - foreach slant {roman italic} { - foreach weight {normal bold} { - lappend x [psfontname [list $family 12 "$slant $weight"]] - } - } - set x - } $values -} +} -result {NewCenturySchlbk-Roman} + +test font-21.7 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {avantgarde 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x AvantGarde-Book + } +} -result {AvantGarde-Book} +test font-21.8 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {avantgarde 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x AvantGarde-Demi + } +} -result {AvantGarde-Demi} +test font-21.9 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {avantgarde 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x AvantGarde-BookOblique + } +} -result {AvantGarde-BookOblique} +test font-21.10 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {avantgarde 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x AvantGarde-DemiOblique + } +} -result {AvantGarde-DemiOblique} + +test font-21.11 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {bookman 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Bookman-Light + } +} -result {Bookman-Light} +test font-21.12 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {bookman 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Bookman-Demi + } +} -result {Bookman-Demi} +test font-21.13 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {bookman 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Bookman-LightItalic + } +} -result {Bookman-LightItalic} +test font-21.14 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {bookman 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Bookman-DemiItalic + } +} -result {Bookman-DemiItalic} + +test font-21.15 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {courier 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "courier"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Courier + } +} -result {Courier} +test font-21.16 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {courier 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "courier"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Courier-Bold + } +} -result {Courier-Bold} +test font-21.17 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {courier 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "courier"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Courier-Oblique + } +} -result {Courier-Oblique} +test font-21.18 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {courier 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "courier"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Courier-BoldOblique + } +} -result {Courier-BoldOblique} + +test font-21.19 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {helvetica 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Helvetica + } +} -result {Helvetica} +test font-21.20 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {helvetica 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Helvetica-Bold + } +} -result {Helvetica-Bold} +test font-21.21 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {helvetica 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Helvetica-Oblique + } +} -result {Helvetica-Oblique} +test font-21.22 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {helvetica 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Helvetica-BoldOblique + } +} -result {Helvetica-BoldOblique} + +test font-21.23 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {{new century schoolbook} 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x NewCenturySchlbk-Roman + } +} -result {NewCenturySchlbk-Roman} +test font-21.24 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {{new century schoolbook} 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x NewCenturySchlbk-Bold + } +} -result {NewCenturySchlbk-Bold} +test font-21.25 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {{new century schoolbook} 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x NewCenturySchlbk-Italic + } +} -result {NewCenturySchlbk-Italic} +test font-21.26 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {{new century schoolbook} 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x NewCenturySchlbk-BoldItalic + } +} -result {NewCenturySchlbk-BoldItalic} + +test font-21.27 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {palatino 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Palatino-Roman + } +} -result {Palatino-Roman} +test font-21.28 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {palatino 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Palatino-Bold + } +} -result {Palatino-Bold} +test font-21.29 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {palatino 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Palatino-Italic + } +} -result {Palatino-Italic} +test font-21.30 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {palatino 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Palatino-BoldItalic + } +} -result {Palatino-BoldItalic} + +test font-21.31 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {symbol 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Symbol + } +} -result {Symbol} +test font-21.32 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {symbol 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Symbol + } +} -result {Symbol} +test font-21.33 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {symbol 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Symbol + } +} -result {Symbol} +test font-21.34 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {symbol 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Symbol + } +} -result {Symbol} + +test font-21.35 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {times 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "times"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Times-Roman + } +} -result {Times-Roman} +test font-21.36 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {times 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "times"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Times-Bold + } +} -result {Times-Bold} +test font-21.37 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {times 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "times"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Times-Italic + } +} -result {Times-Italic} +test font-21.38 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {times 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "times"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x Times-BoldItalic + } +} -result {Times-BoldItalic} + +test font-21.39 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {zapfchancery 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x ZapfChancery-MediumItalic + } +} -result {ZapfChancery-MediumItalic} +test font-21.40 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {zapfchancery 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x ZapfChancery-MediumItalic + } +} -result {ZapfChancery-MediumItalic} +test font-21.41 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {zapfchancery 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x ZapfChancery-MediumItalic + } +} -result {ZapfChancery-MediumItalic} +test font-21.42 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {zapfchancery 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x ZapfChancery-MediumItalic + } +} -result {ZapfChancery-MediumItalic} + +test font-21.43 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {zapfdingbats 12 roman normal} + if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x ZapfDingbats + } +} -result {ZapfDingbats} +test font-21.44 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {zapfdingbats 12 roman bold} + if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x ZapfDingbats + } +} -result {ZapfDingbats} +test font-21.45 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {zapfdingbats 12 italic normal} + if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x ZapfDingbats + } +} -result {ZapfDingbats} +test font-21.46 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + unix +} -body { + set name {zapfdingbats 12 italic bold} + if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} { + set x [psfontname avantgarde 12 roman normal] + } else { + set x ZapfDingbats + } +} -result {ZapfDingbats} + +test font-21.47 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {arial 12 roman normal}] +} -result {Helvetica} +test font-21.48 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {arial 12 roman bold}] +} -result {Helvetica-Bold} +test font-21.49 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {arial 12 italic normal}] +} -result {Helvetica-Oblique} +test font-21.50 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {arial 12 italic bold}] +} -result {Helvetica-BoldOblique} + +test font-21.51 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {{courier new} 12 roman normal}] +} -result {Courier} +test font-21.52 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {{courier new} 12 roman bold}] +} -result {Courier-Bold} +test font-21.53 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {{courier new} 12 italic normal}] +} -result {Courier-Oblique} +test font-21.54 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {{courier new} 12 italic bold}] +} -result {Courier-BoldOblique} + +test font-21.55 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {helvetica 12 roman normal}] +} -result {Helvetica} +test font-21.56 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {helvetica 12 roman bold}] +} -result {Helvetica-Bold} +test font-21.57 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {helvetica 12 italic normal}] +} -result {Helvetica-Oblique} +test font-21.58 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {helvetica 12 italic bold}] +} -result {Helvetica-BoldOblique} + +test font-21.59 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {symbol 12 roman normal}] +} -result {Symbol} +test font-21.60 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {symbol 12 roman bold}] +} -result {Symbol-Bold} +test font-21.61 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {symbol 12 italic normal}] +} -result {Symbol-Italic} +test font-21.62 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {symbol 12 italic bold}] +} -result {Symbol-BoldItalic} + +test font-21.63 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {{times new roman} 12 roman normal}] +} -result {Times-Roman} +test font-21.64 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {{times new roman} 12 roman bold}] +} -result {Times-Bold} +test font-21.65 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {{times new roman} 12 italic normal}] +} -result {Times-Italic} +test font-21.66 {Tk_PostscriptFontName procedure: exhaustive} -constraints { + win +} -body { + set x [psfontname {{times new roman} 12 italic bold}] +} -result {Times-BoldItalic} + + +test font-22.1 {Tk_TextWidth procedure} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font "Courier -12" + pack .t.l + set ax [winfo reqwidth .t.l] + expr {[font measure [.t.l cget -font] "000"] eq $ax*3} +} -cleanup { + destroy .t.l +} -result 1 + + +test font-23.1 {Tk_UnderlineChars procedure} -setup { + destroy .t.t +} -body { + text .t.t + .t.t insert 1.0 abc\tdefg + .t.t tag config sel -underline 1 + .t.t tag add sel 1.0 end + update +} -cleanup { + destroy .t.t +} -result {} -test font-22.1 {Tk_TextWidth procedure} { - font measure [.b.l cget -font] "000" -} [expr $ax*3] -test font-23.1 {Tk_UnderlineChars procedure} { - text .b.t - .b.t insert 1.0 abc\tdefg - .b.t tag config sel -underline 1 - .b.t tag add sel 1.0 end - update -} {} - -setup -test font-24.1 {Tk_ComputeTextLayout: empty string} { - .b.l config -text "" -} {} -test font-24.2 {Tk_ComputeTextLayout: simple string} { - .b.l config -text "000" - getsize -} "[expr $ax*3] $ay" -test font-24.3 {Tk_ComputeTextLayout: find special chars} { - .b.l config -text "000\n000" - getsize -} "[expr $ax*3] [expr $ay*2]" -test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} { - .b.l config -text "000\n000" - getsize -} "[expr $ax*3] [expr $ay*2]" -test font-24.5 {Tk_ComputeTextLayout: break line} { - .b.l config -text "000\t00000" -wrap [expr 9*$ax] - set x [getsize] - .b.l config -wrap 0 - set x -} "[expr 8*$ax] [expr 2*$ay]" -test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} { - .b.l config -text "000\n000" -} {} -test font-24.7 {Tk_ComputeTextLayout: special char was \n} { - .b.l config -text "000\n0000" - getsize -} "[expr $ax*4] [expr $ay*2]" -test font-24.8 {Tk_ComputeTextLayout: special char was \t} { - .b.l config -text "000\t00" - getsize -} "[expr $ax*10] $ay" -test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} { +# Data used in 24.* tests +destroy .t.l +label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font "Courier -12" +pack .t.l +update +set ax [winfo reqwidth .t.l] +set ay [winfo reqheight .t.l] +test font-24.1 {Tk_ComputeTextLayout: empty string} -body { + .t.l config -text "" +} -result {} +test font-24.2 {Tk_ComputeTextLayout: simple string} -body { + .t.l config -text "000" + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ + [expr {[winfo reqheight .t.l] eq $ay}] +} -result {1 1} +test font-24.3 {Tk_ComputeTextLayout: find special chars} -body { + .t.l config -text "000\n000" + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] +} -result {1 1} +test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} -body { + .t.l config -text "000\n000" + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] +} -result {1 1} +test font-24.5 {Tk_ComputeTextLayout: break line} -body { + .t.l config -text "000\t00000" -wrap [expr 9 * $ax] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] +} -cleanup { + .t.l config -wrap 0 +} -result {1 1} +test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} -body { + .t.l config -text "000\n000" +} -result {} +test font-24.7 {Tk_ComputeTextLayout: special char was \n} -body { + .t.l config -text "000\n0000" + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] +} -result {1 1} +test font-24.8 {Tk_ComputeTextLayout: special char was \t} -body { + .t.l config -text "000\t00" + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] \ + [expr {[winfo reqheight .t.l] eq $ay}] +} -result {1 1} +test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} -body { set x {} - .b.l config -text "000\t000" - lappend x [getsize] - .b.l config -text "000\t000" -wrap [expr 100*$ax] - lappend x [getsize] - .b.l config -wrap 0 - set x -} "{[expr $ax*11] $ay} {[expr $ax*11] $ay}" -test font-24.10 {Tk_ComputeTextLayout: tab caused break} { + .t.l config -text "000\t000" + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 11}]}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] + .t.l config -text "000\t000" -wrap [expr 100 * $ax] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 11}]}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] + return $x +} -cleanup { + .t.l config -wrap 0 +} -result {1 1 1 1} +test font-24.10 {Tk_ComputeTextLayout: tab caused break} -body { set x {} - .b.l config -text "000\t" - lappend x [getsize] - .b.l config -text "000\t00" -wrap [expr $ax*6] - lappend x [getsize] - .b.l config -wrap 0 - set x -} "{[expr $ax*8] $ay} {[expr $ax*8] [expr $ay*2]}" -test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} { + .t.l config -text "000\t" + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] + .t.l config -text "000\t00" -wrap [expr $ax * 6] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + return $x +} -cleanup { + .t.l config -wrap 0 +} -result {1 1 1 1} +test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} -body { set x {} - .b.l config -text "000 000" -wrap [expr $ax*5] - lappend x [getsize] - .b.l config -text "000 " - lappend x [getsize] - .b.l config -wrap 0 - set x -} "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}" -test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} { + .t.l config -text "000 000" -wrap [expr {$ax * 5}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + .t.l config -text "000 " + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] + return $x +} -cleanup { + .t.l config -wrap 0 +} -result {1 1 1 1} +test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} -body { set x {} - .b.l config -text "000 0000" -wrap [expr $ax*5] - lappend x [getsize] - .b.l config -text "000\t00 0000" -wrap [expr $ax*12] - lappend x [getsize] - .b.l config -wrap 0 - set x -} "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}" -test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} { - .b.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" - getsize -} "1 [expr $ay*129]" -test font-24.14 {Tk_ComputeTextLayout: text ended with \n} { - list [.b.l config -text "0000"; getsize] [.b.l config -text "0000\n"; getsize] -} "{[expr $ax*4] $ay} {[expr $ax*4] [expr $ay*2]}" -test font-24.15 {Tk_ComputeTextLayout: justification} { - csetup "000\n00000" + .t.l config -text "000 0000" -wrap [expr {$ax * 5}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + .t.l config -text "000\t00 0000" -wrap [expr {$ax * 12}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + return $x +} -cleanup { + .t.l config -wrap 0 +} -result {1 1 1 1} +test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} -body { + .t.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" + update + list [expr {[winfo reqwidth .t.l] eq 1}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 129}]}] +} -result {1 1} +test font-24.14 {Tk_ComputeTextLayout: text ended with \n} -body { + set x {} + .t.l config -text "0000" + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] + .t.l config -text "0000\n" + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + return $x +} -result {1 1 1 1} +destroy .t.l + +test font-24.15 {Tk_ComputeTextLayout: justification} -setup { set x {} - .b.c itemconfig text -just left - lappend x [.b.c index text @[expr $ax*2],0] - .b.c itemconfig text -just center - lappend x [.b.c index text @[expr $ax*2],0] - .b.c itemconfig text -just right - lappend x [.b.c index text @[expr $ax*2],0] - .b.c itemconfig text -just left - set x -} {2 1 0} - -test font-25.1 {Tk_FreeTextLayout procedure} { - setup - .b.f config -text foo - .b.f config -text boo -} {} + destroy .t.c + canvas .t.c -closeenough 0 + .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" + pack .t.c + update +} -body { + csetup "000\n00000" + .t.c itemconfig text -just left + lappend x [.t.c index text @[expr $ax*2],0] + .t.c itemconfig text -just center + lappend x [.t.c index text @[expr $ax*2],0] + .t.c itemconfig text -just right + lappend x [.t.c index text @[expr $ax*2],0] + .t.c itemconfig text -just left + return $x +} -cleanup { + destroy .t.c +} -result {2 1 0} + + +test font-25.1 {Tk_FreeTextLayout procedure} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { + .t.f config -text foo + .t.f config -text boo +} -cleanup { + destroy .t.f +} -result {} -test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} { - .b.f config -text foo -} {} -test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} { + +# Canvas created for tests: 26.* +destroy .t.c +canvas .t.c -closeenough 0 +.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" +pack .t.c +update +test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { + .t.f config -text foo +} -cleanup { + destroy .t.f +} -result {} +test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} -body { csetup "000\t00\n000" -} {} -test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} { +} -result {} +test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} -body { csetup "000\t00" - .b.c select from text 3 - .b.c select to text 5 -} {} -test font-26.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} { - .b.c select from text 3 - .b.c select to text 5 -} {} -test font-26.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} { - .b.c select from text 2 - .b.c select to text 2 -} {} -test font-26.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} { - .b.c select from text 4 - .b.c select to text 4 -} {} - -test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} { - .b.f config -text "foo" -under -1 -} {} -test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} { - .b.f config -text "000 00000" -wrap [expr $ax*7] -under 10 -} {} -test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} { - .b.f config -text "000 00000" -wrap [expr $ax*7] -under 5 - .b.f config -wrap -1 -under -1 -} {} - -test font-28.1 {Tk_PointToChar procedure: above all lines} { + .t.c select from text 3 + .t.c select to text 5 +} -result {} +test font-26.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} -body { + csetup "000\t00" + .t.c select from text 3 + .t.c select to text 5 +} -result {} +test font-26.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} -body { + csetup "000\t00" + .t.c select from text 2 + .t.c select to text 2 +} -result {} +test font-26.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} -body { + csetup "000\t00" + .t.c select from text 4 + .t.c select to text 4 +} -result {} +destroy .t.c + +# Label used in 27.* tests +destroy .t.f +pack [label .t.f] +update +test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} -body { + .t.f config -text "foo" -under -1 +} -result {} +test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} -body { + .t.f config -text "000 00000" -wrap [expr $ax*7] -under 10 +} -result {} +test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} -body { + .t.f config -text "000 00000" -wrap [expr $ax*7] -under 5 + .t.f config -wrap -1 -under -1 +} -result {} +destroy .t.f + + + +# Canvas created for tests: 28.* +destroy .t.c +canvas .t.c -closeenough 0 +.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" +pack .t.c +update +test font-28.1 {Tk_PointToChar procedure: above all lines} -body { csetup "000" - .b.c index text @-1,0 -} {0} -test font-28.2 {Tk_PointToChar procedure: no chars} { + .t.c index text @-1,0 +} -result {0} +test font-28.2 {Tk_PointToChar procedure: no chars} -body { # After fixing the following bug: # # In canvas text item, it was impossible to click to position the @@ -923,206 +1696,277 @@ test font-28.2 {Tk_PointToChar procedure: no chars} { # index of 1 if TextLayout contained 0 characters. csetup "" - .b.c index text @100,100 -} {0} -test font-28.3 {Tk_PointToChar procedure: loop test} { + .t.c index text @100,100 +} -result {0} +test font-28.3 {Tk_PointToChar procedure: loop test} -body { csetup "000\n000\n000\n000" - .b.c index text @10000,0 -} {3} -test font-28.4 {Tk_PointToChar procedure: intersect line} { + .t.c index text @10000,0 +} -result {3} +test font-28.4 {Tk_PointToChar procedure: intersect line} -body { + csetup "000\n000\n000" + .t.c index text @0,$ay +} -result {4} +test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} -body { csetup "000\n000\n000" - .b.c index text @0,$ay -} {4} -test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} { - .b.c index text @-100,$ay -} {4} -test font-28.6 {Tk_PointToChar procedure: past any possible chunk} { - .b.c index text @100000,$ay -} {7} -test font-28.7 {Tk_PointToChar procedure: which chunk on this line} { + .t.c index text @-100,$ay +} -result {4} +test font-28.6 {Tk_PointToChar procedure: past any possible chunk} -body { + csetup "000\n000\n000" + .t.c index text @100000,$ay +} -result {7} +test font-28.7 {Tk_PointToChar procedure: which chunk on this line} -body { csetup "000\n000\t000\t000\n000" - .b.c index text @[expr $ax*2],$ay -} {6} -test font-28.8 {Tk_PointToChar procedure: which chunk on this line} { + .t.c index text @[expr $ax*2],$ay +} -result {6} +test font-28.8 {Tk_PointToChar procedure: which chunk on this line} -body { csetup "000\n000\t000\t000\n000" - .b.c index text @[expr $ax*10],$ay -} {10} -test font-28.9 {Tk_PointToChar procedure: in special chunk} { + .t.c index text @[expr $ax*10],$ay +} -result {10} +test font-28.9 {Tk_PointToChar procedure: in special chunk} -body { csetup "000\n000\t000\t000\n000" - .b.c index text @[expr $ax*6],$ay -} {7} -test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} { + .t.c index text @[expr $ax*6],$ay +} -result {7} +test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} -body { csetup "000 0000000" - .b.c itemconfig text -width [expr $ax*5] - set x [.b.c index text @[expr $ax*5],0] - .b.c itemconfig text -width 0 - set x -} {3} -test font-28.11 {Tk_PointToChar procedure: below all chunks} { + .t.c itemconfig text -width [expr $ax*5] + set x [.t.c index text @[expr $ax*5],0] + .t.c itemconfig text -width 0 + return $x +} -result {3} +test font-28.11 {Tk_PointToChar procedure: below all chunks} -body { csetup "000 0000000" - .b.c index text @0,1000000 -} {11} - -test font-29.1 {Tk_CharBBox procedure: index < 0} { - .b.f config -text "000" -underline -1 -} {} -test font-29.2 {Tk_CharBBox procedure: loop} { - .b.f config -text "000\t000\t000\t000" -underline 9 -} {} -test font-29.3 {Tk_CharBBox procedure: special char} { - .b.f config -text "000\t000\t000" -underline 7 -} {} -test font-29.4 {Tk_CharBBox procedure: normal char} { - .b.f config -text "000" -underline 1 -} {} -test font-29.5 {Tk_CharBBox procedure: right edge of bbox truncated} { - .b.f config -text "0 0000" -wrap [expr $ax*4] -under 2 - .b.f config -wrap 0 -} {} -test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} { - .b.f config -text "0 0000" -wrap [expr $ax*4] -under 3 - .b.f config -wrap 0 -} {} - -.b.c bind all <Enter> {lappend x [.b.c index current @%x,%y]} - -test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} { + .t.c index text @0,1000000 +} -result {11} +destroy .t.c + + +# Label used in 29.* tests +destroy .t.f +pack [label .t.f] +update +test font-29.1 {Tk_CharBBox procedure: index < 0} -body { + .t.f config -text "000" -underline -1 +} -result {} +test font-29.2 {Tk_CharBBox procedure: loop} -body { + .t.f config -text "000\t000\t000\t000" -underline 9 +} -result {} +test font-29.3 {Tk_CharBBox procedure: special char} -body { + .t.f config -text "000\t000\t000" -underline 7 +} -result {} +test font-29.4 {Tk_CharBBox procedure: normal char} -body { + .t.f config -text "000" -underline 1 +} -result {} +test font-29.5 {Tk_CharBBox procedure: right edge of bbox truncated} -body { + .t.f config -text "0 0000" -wrap [expr $ax*4] -under 2 + .t.f config -wrap 0 +} -result {} +test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} -body { + .t.f config -text "0 0000" -wrap [expr $ax*4] -under 3 + .t.f config -wrap 0 +} -result {} +destroy .t.f + + + +# Canvas created for tests: 30.* +destroy .t.c +canvas .t.c -closeenough 0 +.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" +pack .t.c +update +test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} -body { csetup "000\n000\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x 0 -y 0 - set x -} {0} -test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x 0 -y 0 + return $x +} -cleanup { + bind all <Enter> {} +} -result {0} +test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} -body { csetup "000\n000\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x $ax -y $ay - set x -} {5} -test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x $ax -y $ay + return $x +} -cleanup { + bind all <Enter> {} +} -result {5} +test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} -body { csetup "000\n0\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x [expr $ax*2] -y $ay - set x -} {} -test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x [expr $ax*2] -y $ay + return $x +} -cleanup { + bind all <Enter> {} +} -result {} +test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} -body { csetup "000\t000\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x [expr $ax*6] -y 0 - set x -} {3} -test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x [expr $ax*6] -y 0 + return $x +} -cleanup { + bind all <Enter> {} +} -result {3} +test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} -body { csetup "000\n0\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x [expr $ax*2] -y $ay - set x -} {} -test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x [expr $ax*2] -y $ay + return $x +} -cleanup { + bind all <Enter> {} +} -result {} +test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} -body { csetup "000\n000 000000000" - .b.c itemconfig text -width [expr $ax*10] + .t.c itemconfig text -width [expr $ax*10] + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x [expr $ax*5] -y $ay - .b.c itemconfig text -width 0 - set x -} {} -.b.c itemconfig text -justify center -test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x [expr $ax*5] -y $ay + .t.c itemconfig text -width 0 + return $x +} -cleanup { + bind all <Enter> {} +} -result {} +.t.c itemconfig text -justify center +test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} -body { csetup "0\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x 0 -y 0 - set x -} {} -test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x 0 -y 0 + return $x +} -cleanup { + bind all <Enter> {} +} -result {} +test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} -body { csetup "0\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x [expr $ax*2] -y 0 - set x -} {} -test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x [expr $ax*2] -y 0 + return $x +} -cleanup { + bind all <Enter> {} +} -result {} +test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} -body { csetup "0\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x $ax -y 0 - set x -} {0} -test font-30.10 {Tk_DistanceToTextLayout procedure: above line} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x $ax -y 0 + return $x +} -cleanup { + bind all <Enter> {} +} -result {0} +test font-30.10 {Tk_DistanceToTextLayout procedure: above line} -body { csetup "0\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x 0 -y 0 - set x -} {} -test font-30.11 {Tk_DistanceToTextLayout procedure: below line} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x 0 -y 0 + return $x +} -cleanup { + bind all <Enter> {} +} -result {} +test font-30.11 {Tk_DistanceToTextLayout procedure: below line} -body { csetup "000\n0" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x 0 -y $ay - set x -} {} -test font-30.12 {Tk_DistanceToTextLayout procedure: in line} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x 0 -y $ay + return $x +} -cleanup { + bind all <Enter> {} +} -result {} +test font-30.12 {Tk_DistanceToTextLayout procedure: in line} -body { csetup "0\n000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x $ax -y $ay - set x -} {3} -.b.c itemconfig text -justify left -test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x $ax -y $ay + return $x +} -cleanup { + bind all <Enter> {} +} -result {3} +.t.c itemconfig text -justify left +test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} -body { csetup "000" + .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]} set x {} - event generate .b.c <Leave> - event generate .b.c <Enter> -x $ax -y 0 - set x -} {1} - -test font-31.1 {Tk_IntersectTextLayout procedure: loop once} { + event generate .t.c <Leave> + event generate .t.c <Enter> -x $ax -y 0 + return $x +} -cleanup { + bind all <Enter> {} +} -result {1} +destroy .t.c + + +# Canvas created for tests 31.* +destroy .t.c +canvas .t.c -closeenough 0 +.t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" +pack .t.c +update +test font-31.1 {Tk_IntersectTextLayout procedure: loop once} -body { csetup "000\n000\n000" - .b.c find overlapping 0 0 0 0 -} [.b.c find withtag text] -test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} { + .t.c find overlapping 0 0 0 0 +} -result [.t.c find withtag text] +test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} -body { csetup "000\t000\t000" - .b.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0 -} [.b.c find withtag text] -test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} { + .t.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0 +} -result [.t.c find withtag text] +test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} -body { csetup "0\n000" - .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0 -} {} -test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} { + .t.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0 +} -result {} +test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} -body { csetup "000\t000" - .b.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0 -} [.b.c find withtag text] -test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} { + .t.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0 +} -result [.t.c find withtag text] +test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} -body { csetup "000\n0\n000" - .b.c find overlapping $ax $ay $ax $ay -} {} -test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} { + .t.c find overlapping $ax $ay $ax $ay +} -result {} +test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} -body { csetup "000\n000 000000000" - .b.c itemconfig text -width [expr $ax*10] - set x [.b.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay] - .b.c itemconfig text -width 0 - set x -} {} + .t.c itemconfig text -width [expr $ax*10] + set x [.t.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay] + .t.c itemconfig text -width 0 + return $x +} -result {} +destroy .t.c -test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} { + +test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} -setup { + destroy .t.c + canvas .t.c -closeenough 0 + .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" + pack .t.c + update +} -body { # If there were a whole bunch of returns or tabs in a row, then the # temporary buffer could overflow and write on the stack. - csetup "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n" - .b.c itemconfig text -width 800 - .b.c insert text end "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n" - .b.c insert text end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" - .b.c insert text end "end" - set x [.b.c postscript] + .t.c itemconfig text -width 800 + .t.c insert text end "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n" + .t.c insert text end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" + .t.c insert text end "end" + set x [.t.c postscript] set i [string first "(qwerty" $x] string range $x $i [expr {$i + 278}] -} {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)] +} -cleanup { + destroy .t.c +} -result {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)] [(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)] [()] [()] @@ -1157,247 +2001,366 @@ test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} { [(end)] } -test font-33.1 {Tk_TextWidth procedure} { -} {} -test font-34.1 {ConfigAttributesObj procedure: arguments} { +test font-33.1 {Tk_TextWidth procedure} -body { +} -result {} + + +test font-34.1 {ConfigAttributesObj procedure: arguments} -setup { + catch {font delete xyz} +} -body { # (Tcl_GetIndexFromObj() != TCL_OK) - setup - list [catch {font create xyz -xyz} msg] $msg -} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}} -test font-34.2 {ConfigAttributesObj procedure: arguments} { + font create xyz -xyz +} -returnCodes { + error +} -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike} +test font-34.2 {ConfigAttributesObj procedure: arguments} -setup { + catch {font delete xyz} +} -body { # (objc & 1) - setup - list [catch {font create xyz -family} msg] $msg -} {1 {value for "-family" option missing}} -foreach p { - {font-34.3 family xyz times} - {font-34.4 size 20 40} - {font-34.5 weight normal bold} - {font-34.6 slant roman italic} - {font-34.7 underline 0 1} - {font-34.8 overstrike 0 1} -} { - lassign $p testName opt val1 val2 - test $testName "ConfigAttributesObj procedure: $opt" { - setup - set x {} - font create xyz -$opt $val1 - lappend x [font config xyz -$opt] - font config xyz -$opt $val2 - lappend x [font config xyz -$opt] - } [list $val1 $val2] -} -foreach p { - {font-34.9 size xyz {expected integer but got "xyz"}} - {font-34.10 weight xyz {bad -weight value "xyz": must be normal, or bold}} - {font-34.11 slant xyz {bad -slant value "xyz": must be roman, or italic}} - {font-34.12 underline xyz {expected boolean value but got "xyz"}} - {font-34.13 overstrike xyz {expected boolean value but got "xyz"}} -} { - lassign $p testName opt val result - test $testName "ConfigAttributesObj procedure: $opt" -setup { - setup - } -body { - font create xyz -$opt $val - } -returnCodes error -result $result -} + font create xyz -family +} -returnCodes error -result {value for "-family" option missing} -test font-35.1 {GetAttributeInfoObj procedure: one attribute} { +test font-34.3 {ConfigAttributesObj procedure: family} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -family xyz + lappend x [font config xyz -family] + font config xyz -family times + lappend x [font config xyz -family] +} -cleanup { + font delete xyz +} -result {xyz times} +test font-34.4 {ConfigAttributesObj procedure: size} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -size 20 + lappend x [font config xyz -size] + font config xyz -size 40 + lappend x [font config xyz -size] +} -cleanup { + font delete xyz +} -result {20 40} +test font-34.5 {ConfigAttributesObj procedure: weight} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -weight normal + lappend x [font config xyz -weight] + font config xyz -weight bold + lappend x [font config xyz -weight] +} -cleanup { + font delete xyz +} -result {normal bold} +test font-34.6 {ConfigAttributesObj procedure: slant} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -slant roman + lappend x [font config xyz -slant] + font config xyz -slant italic + lappend x [font config xyz -slant] +} -cleanup { + font delete xyz +} -result {roman italic} +test font-34.7 {ConfigAttributesObj procedure: underline} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -underline 0 + lappend x [font config xyz -underline] + font config xyz -underline 1 + lappend x [font config xyz -underline] +} -cleanup { + font delete xyz +} -result {0 1} +test font-34.8 {ConfigAttributesObj procedure: overstrike} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -overstrike 0 + lappend x [font config xyz -overstrike] + font config xyz -overstrike 1 + lappend x [font config xyz -overstrike] +} -cleanup { + font delete xyz +} -result {0 1} + +test font-34.9 {ConfigAttributesObj procedure: size} -body { + font create xyz -size xyz +} -returnCodes error -result {expected integer but got "xyz"} +test font-34.10 {ConfigAttributesObj procedure: weight} -body { + font create xyz -weight xyz +} -returnCodes error -result {bad -weight value "xyz": must be normal, or bold} +test font-34.11 {ConfigAttributesObj procedure: slant} -body { + font create xyz -slant xyz +} -returnCodes error -result {bad -slant value "xyz": must be roman, or italic} +test font-34.12 {ConfigAttributesObj procedure: underline} -body { + font create xyz -underline xyz +} -returnCodes error -result {expected boolean value but got "xyz"} +test font-34.13 {ConfigAttributesObj procedure: overstrike} -body { + font create xyz -overstrike xyz +} -returnCodes error -result {expected boolean value but got "xyz"} + + +test font-35.1 {GetAttributeInfoObj procedure: one attribute} -setup { + catch {font delete xyz} +} -body { # (objPtr != NULL) - setup font create xyz -family xyz font config xyz -family -} {xyz} +} -cleanup { + font delete xyz +} -result {xyz} + -test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} { +test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} -setup { + catch {font delete xyz} +} -body { # (Tcl_GetIndexFromObj() != TCL_OK) - setup font create xyz - list [catch {font config xyz -xyz} msg] $msg -} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}} - -test font-37.1 {GetAttributeInfoObj procedure: all attributes} { - # not (objPtr != NULL) - setup + font config xyz -xyz +} -cleanup { + font delete xyz +} -returnCodes { + error +} -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike} + + +test font-37.1 {GetAttributeInfoObj procedure: all attributes} -setup { + catch {font delete xyz} +} -body { + # not (objPtr != NULL) font create xyz -family xyz font config xyz -} {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0} -set i 4 -foreach p { - {font-37.2 family xyz xyz} - {font-37.3 size 20 20} - {font-37.4 weight normal normal} - {font-37.5 slant italic italic} - {font-37.6 underline yes 1} - {font-37.7 overstrike false 0} -} { - lassign $p testName opt val expected - test $testName "GetAttributeInfo procedure: $opt" -setup { - setup - } -body { - font create xyz -$opt $val - font config xyz -$opt - } -result $expected -} +} -cleanup { + font delete xyz +} -result {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0} +test font-37.2 {GetAttributeInfo procedure: family} -setup { + catch {font delete xyz} +} -body { + font create xyz -family xyz + font config xyz -family +} -cleanup { + font delete xyz +} -result {xyz} +test font-37.3 {GetAttributeInfo procedure: size} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -size 20 + font config xyz -size +} -cleanup { + font delete xyz +} -result {20} +test font-37.4 {GetAttributeInfo procedure: weight} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -weight normal + font config xyz -weight +} -cleanup { + font delete xyz +} -result {normal} +test font-37.5 {GetAttributeInfo procedure: slant} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -slant italic + font config xyz -slant +} -cleanup { + font delete xyz +} -result {italic} +test font-37.6 {GetAttributeInfo procedure: underline} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -underline yes + font config xyz -underline +} -cleanup { + font delete xyz +} -result {1} +test font-37.7 {GetAttributeInfo procedure: overstrike} -setup { + catch {font delete xyz} + set x {} +} -body { + font create xyz -overstrike no + font config xyz -overstrike +} -cleanup { + font delete xyz +} -result {0} + # In tests below, one field is set to "xyz" so that font name doesn't # look like a native X font, so that ParseFontNameObj or TkParseXLFD will # be called. -setup - -test font-38.1 {ParseFontNameObj procedure: begins with -} { +test font-38.1 {ParseFontNameObj procedure: begins with -} -body { lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1 -} $times -test font-38.2 {ParseFontNameObj procedure: begins with -*} { +} -result [font actual {times 0} -family] +test font-38.2 {ParseFontNameObj procedure: begins with -*} -body { lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1 -} $times -test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} { +} -result [font actual {times 0} -family] +test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} -body { lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1 -} $times -test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} { +} -result [font actual {times 0} -family] +test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} -body { lindex [font actual {-family times}] 1 -} $times -test font-38.5 {ParseFontNameObj procedure: begins with *} { +} -result [font actual {times 0} -family] +test font-38.5 {ParseFontNameObj procedure: begins with *} -body { lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1 -} $times -test font-38.6 {ParseFontNameObj procedure: begins with *} { +} -result [font actual {times 0} -family] +test font-38.6 {ParseFontNameObj procedure: begins with *} -body { font actual *-times-xyz -family -} $times -test font-38.7 {ParseFontNameObj procedure: arguments} {noExceed} { - list [catch {font actual "\{xyz"} msg] $msg -} [list 1 "font \"{xyz\" doesn't exist"] -test font-38.8 {ParseFontNameObj procedure: arguments} {noExceed} { - list [catch {font actual ""} msg] $msg -} {1 {font "" doesn't exist}} -test font-38.9 {ParseFontNameObj procedure: arguments} { - list [catch {font actual {times 20 xyz xyz}} msg] $msg -} {1 {unknown font style "xyz"}} -test font-38.10 {ParseFontNameObj procedure: arguments} { - list [catch {font actual {times xyz xyz}} msg] $msg -} {1 {expected integer but got "xyz"}} -test font-38.12 {ParseFontNameObj procedure: stylelist loop} {unixOrPc} { +} -result [font actual {times 0} -family] +test font-38.7 {ParseFontNameObj procedure: arguments} -constraints noExceed -body { + font actual "\{xyz" +} -returnCodes error -result "font \"{xyz\" doesn't exist" +test font-38.8 {ParseFontNameObj procedure: arguments} -constraints noExceed -body { + font actual "" +} -returnCodes error -result {font "" doesn't exist} +test font-38.9 {ParseFontNameObj procedure: arguments} -body { + font actual {times 20 xyz xyz} +} -returnCodes error -result {unknown font style "xyz"} +test font-38.10 {ParseFontNameObj procedure: arguments} -body { + font actual {times xyz xyz} +} -returnCodes error -result {expected integer but got "xyz"} +test font-38.11 {ParseFontNameObj procedure: stylelist loop} -constraints { + unixOrPc +} -body { lrange [font actual {times 12 bold italic overstrike underline}] 4 end -} {-weight bold -slant italic -underline 1 -overstrike 1} -test font-38.13 {ParseFontNameObj procedure: stylelist error} { - list [catch {font actual {times 12 bold xyz}} msg] $msg -} {1 {unknown font style "xyz"}} -test font-38.14 "ParseFontNameObj: options with hyphenated family: bug #2791352" -body { +} -result {-weight bold -slant italic -underline 1 -overstrike 1} +test font-38.12 {ParseFontNameObj procedure: stylelist error} -body { + font actual {times 12 bold xyz} +} -returnCodes error -result {unknown font style "xyz"} +test font-38.13 "ParseFontNameObj: options with hyphenated family: bug #2791352" -body { font actual {-family sans-serif -size 12 -weight bold -slant roman -underline 0 -overstrike 0} } -returnCodes ok -result [font actual {sans-serif 12 bold}] -test font-38.15 "ParseFontNameObj: bug #2791352" -body { +test font-38.14 "ParseFontNameObj: bug #2791352" -body { font actual {-invalidfont 8 bold} } -returnCodes error -match glob -result {bad option "-invalidfont": *} -test font-39.1 {NewChunk procedure: test realloc} { - .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t" -} {} -test font-40.1 {TkFontParseXLFD procedure: initial dash} { +test font-39.1 {NewChunk procedure: test realloc} -setup { + destroy .t.f + pack [label .t.f] + update +} -body { + .t.f config -text "xxx\nxxx\txxx\nxxx\t\t\t" +} -cleanup { + destroy .t.f +} -result {} + + +test font-40.1 {TkFontParseXLFD procedure: initial dash} -body { font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family -} $times -test font-40.2 {TkFontParseXLFD procedure: no initial dash} { +} -result [font actual {times 0} -family] +test font-40.2 {TkFontParseXLFD procedure: no initial dash} -body { font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family -} $times -test font-40.3 {TkFontParseXLFD procedure: not enough fields} { +} -result [font actual {times 0} -family] +test font-40.3 {TkFontParseXLFD procedure: not enough fields} -body { font actual -xyz-times-*-*-* -family -} $times -test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} { +} -result [font actual {times 0} -family] +test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} -body { lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0 -} {-family} -test font-40.5 {TkFontParseXLFD procedure: all fields specified} { - lindex [font actual -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1 -} $times -test font-41.1 {TkParseXLFD procedure: arguments} { +} -result {-family} +test font-40.5 {TkFontParseXLFD procedure: all fields specified} -body { + lindex [font actual \ + -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1 +} -result [font actual {times 0} -family] + + +test font-41.1 {TkParseXLFD procedure: arguments} -body { # XLFD with bad pointsize: fallback to some system font. font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-* set x {} -} {} -test font-42.1 {TkFontParseXLFD procedure: arguments} { +} -result {} + + +test font-42.1 {TkFontParseXLFD procedure: arguments} -body { # XLFD with bad pixelsize: fallback to some system font. font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-* set x {} -} {} -test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} { +} -result {} +test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} -body { font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace set x {} -} {} -test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} { +} -result {} +test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} -body { font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace set x {} -} {} -test font-42.4 {TkFontParseXLFD procedure: pointsize specified} { +} -result {} +test font-42.4 {TkFontParseXLFD procedure: pointsize specified} -body { font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace set x {} -} {} -test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} { +} -result {} +test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} -body { font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace set x {} -} {} +} -result {} + -test font-43.1 {FieldSpecified procedure: specified vs. non-specified} { +test font-43.1 {FieldSpecified procedure: specified vs. non-specified} -body { font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-* font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-* font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-* lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1 -} $times +} -result [font actual {times 0} -family] + -set oldscale [tk scaling] -tk scaling 0.5 -test font-44.1 {TkFontGetPixels: size < 0} { +test font-44.1 {TkFontGetPixels: size < 0} -setup { + set oldscale [tk scaling] +} -body { + tk scaling 0.5 font actual {times -12} -size -} {24} -test font-44.2 {TkFontGetPoints: size >= 0} {noExceed} { +} -cleanup { + tk scaling $oldscale +} -result {24} +test font-44.2 {TkFontGetPoints: size >= 0} -constraints noExceed -setup { + set oldscale [tk scaling] +} -body { + tk scaling 0.5 font actual {times 12} -size -} {12} +} -cleanup { + tk scaling $oldscale +} -result {12} -tk scaling $oldscale -test font-45.1 {TkFontGetAliasList: no match} { +test font-45.1 {TkFontGetAliasList: no match} -body { font actual {snarky 10} -family -} [font actual {-size 10} -family] -test font-45.3 {TkFontGetAliasList: match} win { +} -result [font actual {-size 10} -family] +test font-45.2 {TkFontGetAliasList: match} -constraints win -body { font actual {times 10} -family -} {Times New Roman} -test font-45.4 {TkFontGetAliasList: match} {unix noExceed} { +} -result {Times New Roman} +test font-45.3 {TkFontGetAliasList: match} -constraints {unix noExceed} -body { # can fail on Unix systems that have a real "times new roman" font font actual {{times new roman} 10} -family -} [font actual {times 10} -family] +} -result [font actual {times 10} -family] -test font-46.1 {font actual, with character, no option, no --} \ - -body { + +test font-46.1 {font actual, with character, no option, no --} -body { font actual {times 10} a - } \ - -match glob \ - -result [list -family [font actual {times 10} -family] -size *\ +} -match glob -result [list -family [font actual {times 10} -family] -size *\ -slant roman -underline 0 -overstrike 0] -test font-46.2 {font actual, with character introduced by --} \ - -body { +test font-46.2 {font actual, with character introduced by --} -body { font actual {times 10} -- - - } \ - -match glob \ - -result [list -family [font actual {times 10} -family] -size *\ +} -match glob -result [list -family [font actual {times 10} -family] -size *\ -slant roman -underline 0 -overstrike 0] -test font-46.3 {font actual, with character and option} { +test font-46.3 {font actual, with character and option} -body { font actual {times 10} -family a -} [font actual {times 10} -family] +} -result [font actual {times 10} -family] -test font-46.4 {font actual, with character, option and --} { +test font-46.4 {font actual, with character, option and --} -body { font actual {times 10} -family -- - -} [font actual {times 10} -family] - -test font-46.5 {font actual, too many chars} { - list [catch { - font actual {times 10} 123456789012345678901234567890123456789012345678901 - } result] $result -} {1 {expected a single character but got "1234567890123456789012345678901234567..."}} +} -result [font actual {times 10} -family] -setup - -destroy .b +test font-46.5 {font actual, too many chars} -body { + font actual {times 10} 123456789012345678901234567890123456789012345678901 +} -returnCodes error -result {expected a single character but got "1234567890123456789012345678901234567..."} test font-47.1 {Bug f214b8ad5b} -body { interp create one @@ -1413,3 +2376,7 @@ test font-47.1 {Bug f214b8ad5b} -body { # cleanup cleanupTests return + + + + diff --git a/tests/fontchooser.test b/tests/fontchooser.test new file mode 100644 index 0000000..4dad5da --- /dev/null +++ b/tests/fontchooser.test @@ -0,0 +1,201 @@ +# Test the "tk::fontchooser" command +# +# Copyright (c) 2008 Pat Thoyts + +package require tcltest 2.1 +eval tcltest::configure $argv +tcltest::loadTestedCommands + +# the following helper functions are related to the functions used +# in winDialog.test where they are used to send messages to the win32 +# dialog (hence the wierdness). + +proc start {cmd} { + set ::tk_dialog {} + set ::iter_after 0 + after 1 $cmd +} +proc then {cmd} { + set ::command $cmd + set ::dialogresult {} + set ::testfont {} + afterbody + vwait ::dialogresult + return $::dialogresult +} +proc afterbody {} { + if {$::tk_dialog == {}} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting for tk_dialog" + return + } + after 150 {afterbody} + return + } + uplevel #0 {set dialogresult [eval $command]} +} +proc Click {button} { + switch -exact -- $button { + ok { $::tk_dialog.ok invoke } + cancel { $::tk_dialog.cancel invoke } + apply { $::tk_dialog.apply invoke } + default { return -code error "invalid button name \"$button\"" } + } +} +proc ApplyFont {font} { +# puts stderr "apply: $font" + set ::testfont $font +} + +# ------------------------------------------------------------------------- + +test fontchooser-1.1 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser -z +} -result {unknown or ambiguous subcommand "-z": must be configure, hide, or show} + +test fontchooser-1.2 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -z +} -match glob -result {bad option "-z":*} + +test fontchooser-1.3 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -parent . -font +} -result {value for "-font" missing} + +test fontchooser-1.4 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -parent . -title +} -result {value for "-title" missing} + +test fontchooser-1.5 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -parent . -command +} -result {value for "-command" missing} + +test fontchooser-1.6 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -title . -parent +} -result {value for "-parent" missing} + +test fontchooser-1.7 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -parent abc +} -result {bad window path name "abc"} + +test fontchooser-1.8 {tk fontchooser: usage} -returnCodes ok -body { + tk fontchooser configure -visible +} -result {0} + +test fontchooser-1.9 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -visible 1 +} -match glob -result {*} + +# ------------------------------------------------------------------------- +# +# The remaining tests in this file are only relevant for the script +# implementation. They can be tested by sourcing the script file but +# the Tk tests are run with -singleproc 1 and doing this affects the +# result of later attempts to test the native implementations. +# +testConstraint scriptImpl [llength [info proc ::tk::fontchooser::Configure]] + +test fontchooser-2.0 {fontchooser -title} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -title "Hello" + tk::fontchooser::Show + } + then { + set x [wm title $::tk_dialog] + Click cancel + } + set x +} -result {Hello} + +test fontchooser-2.1 {fontchooser -title (cyrillic)} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure \ + -title "\u041f\u0440\u0438\u0432\u0435\u0442" + tk::fontchooser::Show + } + then { + set x [wm title $::tk_dialog] + Click cancel + } + set x +} -result "\u041f\u0440\u0438\u0432\u0435\u0442" + +test fontchooser-3.0 {fontchooser -parent} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -parent . + tk::fontchooser::Show + } + then { + set x [winfo parent $::tk_dialog] + Click cancel + } + set x +} -result {.} + +test fontchooser-3.1 {fontchooser -parent (invalid)} -constraints scriptImpl -body { + tk::fontchooser::Configure -parent junk +} -returnCodes error -match glob -result {bad window path *} + +test fontchooser-4.0 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font courier + tk::fontchooser::Show + } + then { + Click cancel + } + set ::testfont +} -result {} + +test fontchooser-4.1 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font courier + tk::fontchooser::Show + } + then { + Click ok + } + expr {$::testfont ne {}} +} -result {1} + +test fontchooser-4.2 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font TkDefaultFont + tk::fontchooser::Show + } + then { + Click ok + } + expr {$::testfont ne {}} +} -result {1} + +test fontchooser-4.3 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font {times 14 bold} + tk::fontchooser::Show + } + then { + Click ok + } + expr {$::testfont ne {}} +} -result {1} + +test fontchooser-4.4 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font {times 14 bold} + tk::fontchooser::Show + } + then { + Click ok + } + lrange $::testfont 1 end +} -result {14 bold} + +# ------------------------------------------------------------------------- + +cleanupTests +return + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tests/frame.test b/tests/frame.test index affdac6..c7b0ed8 100644 --- a/tests/frame.test +++ b/tests/frame.test @@ -7,7 +7,8 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands @@ -51,40 +52,98 @@ proc colorsFree {w {red 31} {green 245} {blue 192}} { && ([lindex $vals 2]/256 == $blue) } -test frame-1.1 {frame configuration options} { + +test frame-1.1 {frame configuration options} -setup { + deleteWindows +} -body { + frame .f -class NewFrame + .f configure -class +} -cleanup { + deleteWindows +} -result {-class class Class Frame NewFrame} +test frame-1.2 {frame configuration options} -setup { + deleteWindows +} -body { frame .f -class NewFrame - list [.f configure -class] [catch {.f configure -class Different} msg] $msg -} {{-class class Class Frame NewFrame} 1 {can't modify -class option after widget is created}} -catch {destroy .f} -test frame-1.2 {frame configuration options} { + .f configure -class Different +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -class option after widget is created} + +test frame-1.3 {frame configuration options} -setup { + deleteWindows +} -body { frame .f -colormap new - list [.f configure -colormap] [catch {.f configure -colormap .} msg] $msg -} {{-colormap colormap Colormap {} new} 1 {can't modify -colormap option after widget is created}} -catch {destroy .f} -test frame-1.3 {frame configuration options} { + .f configure -colormap +} -cleanup { + deleteWindows +} -result {-colormap colormap Colormap {} new} +test frame-1.4 {frame configuration options} -setup { + deleteWindows +} -body { + frame .f -colormap new + .f configure -colormap . +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -colormap option after widget is created} + +test frame-1.5 {frame configuration options} -setup { + deleteWindows +} -body { frame .f -visual default - list [.f configure -visual] [catch {.f configure -visual best} msg] $msg -} {{-visual visual Visual {} default} 1 {can't modify -visual option after widget is created}} -catch {destroy .f} -test frame-1.4 {frame configuration options} { - list [catch {frame .f -screen bogus} msg] $msg -} {1 {unknown option "-screen"}} -test frame-1.5 {frame configuration options} { - set result [list [catch {frame .f -container true} msg] $msg \ - [.f configure -container]] - destroy .f - set result -} {0 .f {-container container Container 0 1}} -test frame-1.6 {frame configuration options} { - list [catch {frame .f -container bogus} msg] $msg -} {1 {expected boolean value but got "bogus"}} -test frame-1.7 {frame configuration options} { + .f configure -visual +} -cleanup { + deleteWindows +} -result {-visual visual Visual {} default} +test frame-1.6 {frame configuration options} -setup { + deleteWindows +} -body { + frame .f -visual default + .f configure -visual best +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -visual option after widget is created} + +test frame-1.7 {frame configuration options} -setup { + deleteWindows +} -body { + frame .f -screen bogus +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown option "-screen"} +test frame-1.8 {frame configuration options} -setup { + deleteWindows +} -body { + frame .f -container true +} -cleanup { + deleteWindows +} -result {.f} +test frame-1.9 {frame configuration options} -setup { + deleteWindows +} -body { + frame .f -container true + .f configure -container +} -cleanup { + deleteWindows +} -result {-container container Container 0 1} +test frame-1.10 {frame configuration options} -setup { + deleteWindows +} -body { + frame .f -container bogus +} -cleanup { + deleteWindows +} -returnCodes error -result {expected boolean value but got "bogus"} +test frame-1.11 {frame configuration options} -setup { + deleteWindows +} -body { frame .f - set result [list [catch {.f configure -container 1} msg] $msg] - destroy .f - set result -} {1 {can't modify -container option after widget is created}} -test frame-1.8 {frame configuration options} { + .f configure -container 1 +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -container option after widget is created} +test frame-1.12 {frame configuration options} -setup { + deleteWindows +} -body { # Make sure all options can be set to the default value frame .f set opts {} @@ -95,120 +154,327 @@ test frame-1.8 {frame configuration options} { } eval frame .g $opts destroy .f .g -} {} +} -cleanup { + deleteWindows +} -result {} +destroy .f frame .f -set i 9 -foreach test { - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #00ff00 #00ff00 non-existent - {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-height 100 100 not_a_number {bad screen distance "not_a_number"}} - {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 non-existent - {unknown color name "non-existent"}} - {-highlightthickness 6 6 badValue {bad screen distance "badValue"}} - {-padx 3 3 badValue {bad screen distance "badValue"}} - {-pady 4 4 badValue {bad screen distance "badValue"}} - {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} - {-takefocus "any string" "any string" {} {}} - {-width 32 32 badValue {bad screen distance "badValue"}} -} { - lassign $test opt goodValue goodResult badValue badResult - test frame-1.$i {frame configuration options} { - .f configure $opt $goodValue - lindex [.f configure $opt] 4 - } $goodResult - incr i - if {$badValue ne ""} { - test frame-1.$i {frame configuration options} -body { - .f configure $opt $badValue - } -returnCodes error -result $badResult - } - .f configure $opt [lindex [.f configure $opt] 3] - incr i -} +test frame-1.13 {frame configuration options} -body { + .f configure -background #ff0000 + lindex [.f configure -background] 4 +} -cleanup { + .f configure -background [lindex [.f configure -background] 3] +} -result {#ff0000} +test frame-1.14 {frame configuration options} -body { + .f configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-1.15 {frame configuration options} -body { + .f configure -bd 4 + lindex [.f configure -bd] 4 +} -cleanup { + .f configure -bd [lindex [.f configure -bd] 3] +} -result {4} +test frame-1.16 {frame configuration options} -body { + .f configure -bd badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-1.17 {frame configuration options} -body { + .f configure -bg #00ff00 + lindex [.f configure -bg] 4 +} -cleanup { + .f configure -bg [lindex [.f configure -bg] 3] +} -result {#00ff00} +test frame-1.18 {frame configuration options} -body { + .f configure -bg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-1.19 {frame configuration options} -body { + .f configure -borderwidth 1.3 + lindex [.f configure -borderwidth] 4 +} -cleanup { + .f configure -borderwidth [lindex [.f configure -borderwidth] 3] +} -result {1} +test frame-1.20 {frame configuration options} -body { + .f configure -borderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-1.21 {frame configuration options} -body { + .f configure -cursor arrow + lindex [.f configure -cursor] 4 +} -cleanup { + .f configure -cursor [lindex [.f configure -cursor] 3] +} -result {arrow} +test frame-1.22 {frame configuration options} -body { + .f configure -cursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} +test frame-1.23 {frame configuration options} -body { + .f configure -height 100 + lindex [.f configure -height] 4 +} -cleanup { + .f configure -height [lindex [.f configure -height] 3] +} -result {100} +test frame-1.24 {frame configuration options} -body { + .f configure -height not_a_number +} -returnCodes error -result {bad screen distance "not_a_number"} +test frame-1.25 {frame configuration options} -body { + .f configure -highlightbackground #112233 + lindex [.f configure -highlightbackground] 4 +} -cleanup { + .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3] +} -result {#112233} +test frame-1.26 {frame configuration options} -body { + .f configure -highlightbackground ugly +} -returnCodes error -result {unknown color name "ugly"} +test frame-1.27 {frame configuration options} -body { + .f configure -highlightcolor #123456 + lindex [.f configure -highlightcolor] 4 +} -cleanup { + .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3] +} -result {#123456} +test frame-1.28 {frame configuration options} -body { + .f configure -highlightcolor non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-1.29 {frame configuration options} -body { + .f configure -highlightthickness 6 + lindex [.f configure -highlightthickness] 4 +} -cleanup { + .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3] +} -result {6} +test frame-1.30 {frame configuration options} -body { + .f configure -highlightthickness badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-1.31 {frame configuration options} -body { + .f configure -padx 3 + lindex [.f configure -padx] 4 +} -cleanup { + .f configure -padx [lindex [.f configure -padx] 3] +} -result {3} +test frame-1.32 {frame configuration options} -body { + .f configure -padx badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-1.33 {frame configuration options} -body { + .f configure -pady 4 + lindex [.f configure -pady] 4 +} -cleanup { + .f configure -pady [lindex [.f configure -pady] 3] +} -result {4} +test frame-1.34 {frame configuration options} -body { + .f configure -pady badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-1.35 {frame configuration options} -body { + .f configure -relief ridge + lindex [.f configure -relief] 4 +} -cleanup { + .f configure -relief [lindex [.f configure -relief] 3] +} -result {ridge} +test frame-1.36 {frame configuration options} -body { + .f configure -relief badValue +} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} +test frame-1.37 {frame configuration options} -body { + .f configure -takefocus {any string} + lindex [.f configure -takefocus] 4 +} -cleanup { + .f configure -takefocus [lindex [.f configure -takefocus] 3] +} -result {any string} +test frame-1.38 {frame configuration options} -body { + .f configure -width 32 + lindex [.f configure -width] 4 +} -cleanup { + .f configure -width [lindex [.f configure -width] 3] +} -result {32} +test frame-1.39 {frame configuration options} -body { + .f configure -width badValue +} -returnCodes error -result {bad screen distance "badValue"} destroy .f -test frame-2.1 {toplevel configuration options} { - catch {destroy .t} + +test frame-2.1 {toplevel configuration options} -setup { + deleteWindows +} -body { toplevel .t -width 200 -height 100 -class NewClass wm geometry .t +0+0 - list [.t configure -class] [catch {.t configure -class Another} msg] $msg -} {{-class class Class Toplevel NewClass} 1 {can't modify -class option after widget is created}} -test frame-2.2 {toplevel configuration options} { - catch {destroy .t} + .t configure -class +} -cleanup { + deleteWindows +} -result {-class class Class Toplevel NewClass} +test frame-2.2 {toplevel configuration options} -setup { + deleteWindows +} -body { + toplevel .t -width 200 -height 100 -class NewClass + wm geometry .t +0+0 + .t configure -class Another +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -class option after widget is created} + +test frame-2.3 {toplevel configuration options} -setup { + deleteWindows +} -body { toplevel .t -width 200 -height 100 -colormap new wm geometry .t +0+0 - list [.t configure -colormap] [catch {.t configure -colormap .} msg] $msg -} {{-colormap colormap Colormap {} new} 1 {can't modify -colormap option after widget is created}} -test frame-2.3 {toplevel configuration options} { + .t configure -colormap +} -cleanup { + deleteWindows +} -result {-colormap colormap Colormap {} new} +test frame-2.4 {toplevel configuration options} -setup { + deleteWindows +} -body { + toplevel .t -width 200 -height 100 -colormap new + wm geometry .t +0+0 + .t configure -colormap . +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -colormap option after widget is created} + +test frame-2.5 {toplevel configuration options} -setup { + deleteWindows +} -body { + toplevel .t -width 200 -height 100 + wm geometry .t +0+0 + .t configure -container 1 +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -container option after widget is created} +test frame-2.6 {toplevel configuration options} -setup { + deleteWindows +} -body { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +0+0 - list [catch {.t configure -container 1} msg] $msg [.t configure -container] -} {1 {can't modify -container option after widget is created} {-container container Container 0 0}} -test frame-2.4 {toplevel configuration options} { + catch {.t configure -container 1} + .t configure -container +} -cleanup { + deleteWindows +} -result {-container container Container 0 0} + +test frame-2.7 {toplevel configuration options} -setup { + deleteWindows +} -body { + toplevel .t -width 200 -height 100 -colormap bogus +} -cleanup { + deleteWindows +} -returnCodes error -result {bad window path name "bogus"} + + +test frame-2.8 {toplevel configuration options} -constraints { + win +} -setup { + deleteWindows +} -body { catch {destroy .t} - list [catch {toplevel .t -width 200 -height 100 -colormap bogus} msg] $msg -} {1 {bad window path name "bogus"}} -set default "[winfo visual .] [winfo depth .]" -if {$tcl_platform(platform) == "windows"} { -test frame-2.5 {toplevel configuration options} { + toplevel .t -width 200 -height 100 + wm geometry .t +0+0 + .t configure -use 0x44022 +} -cleanup { + deleteWindows +} -returnCodes error -result {window "0x44022" doesn't exist} +test frame-2.9 {toplevel configuration options} -constraints { + win +} -setup { + deleteWindows +} -body { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +0+0 - list [catch {.t configure -use 0x44022} msg] $msg [.t configure -use] -} {1 {window "0x44022" doesn't exist} {-use use Use {} {}}} -} else { -test frame-2.5 {toplevel configuration options} { + catch {.t configure -use 0x44022} + .t configure -use +} -cleanup { + deleteWindows +} -result {-use use Use {} {}} + +test frame-2.10 {toplevel configuration options} -constraints { + nonwin +} -setup { + deleteWindows +} -body { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +0+0 - list [catch {.t configure -use 0x44022} msg] $msg [.t configure -use] -} {1 {can't modify -use option after widget is created} {-use use Use {} {}}} -} + .t configure -use 0x44022 +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -use option after widget is created} +test frame-2.11 {toplevel configuration options} -constraints { + nonwin +} -setup { + deleteWindows +} -body { + catch {destroy .t} + toplevel .t -width 200 -height 100 + wm geometry .t +0+0 + catch {.t configure -use 0x44022} + .t configure -use +} -cleanup { + deleteWindows +} -result {-use use Use {} {}} -test frame-2.6 {toplevel configuration options} { +test frame-2.12 {toplevel configuration options} -setup { + deleteWindows +} -body { catch {destroy .t} toplevel .t -width 200 -height 100 -visual default wm geometry .t +0+0 - list [.t configure -visual] [catch {.t configure -visual best} msg] $msg -} {{-visual visual Visual {} default} 1 {can't modify -visual option after widget is created}} -test frame-2.7 {toplevel configuration options} { - catch {destroy .t} - list [catch {toplevel .t -width 200 -height 100 -visual who_knows?} msg] $msg -} {1 {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}} -test frame-2.8 {toplevel configuration options} haveDISPLAY { + .t configure -visual +} -cleanup { + deleteWindows +} -result {-visual visual Visual {} default} +test frame-2.13 {toplevel configuration options} -setup { + deleteWindows +} -body { catch {destroy .t} + toplevel .t -width 200 -height 100 -visual default + wm geometry .t +0+0 + .t configure -visual best +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -visual option after widget is created} + +test frame-2.14 {toplevel configuration options} -setup { + deleteWindows +} -body { + toplevel .t -width 200 -height 100 -visual who_knows? +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default} +test frame-2.15 {toplevel configuration options} -constraints haveDISPLAY -setup { + deleteWindows +} -body { toplevel .t -width 200 -height 100 -screen $env(DISPLAY) wm geometry .t +0+0 - set cfg [string compare [.t configure -screen] \ - "-screen screen Screen {} $env(DISPLAY)"] - list $cfg [catch {.t configure -screen another} msg] $msg -} {0 1 {can't modify -screen option after widget is created}} -test frame-2.9 {toplevel configuration options} { - catch {destroy .t} - list [catch {toplevel .t -width 200 -height 100 -screen bogus} msg] $msg -} {1 {couldn't connect to display "bogus"}} -test frame-2.10 {toplevel configuration options} { - catch {destroy .t} - catch {destroy .x} + string compare [.t configure -screen] "-screen screen Screen {} $env(DISPLAY)" +} -cleanup { + deleteWindows +} -result {0} +test frame-2.16 {toplevel configuration options} -constraints haveDISPLAY -setup { + deleteWindows +} -body { + toplevel .t -width 200 -height 100 -screen $env(DISPLAY) + wm geometry .t +0+0 + .t configure -screen another +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -screen option after widget is created} + +test frame-2.17 {toplevel configuration options} -setup { + deleteWindows +} -body { + toplevel .t -width 200 -height 100 -screen bogus +} -cleanup { + deleteWindows +} -returnCodes error -result {couldn't connect to display "bogus"} +test frame-2.18 {toplevel configuration options} -setup { + deleteWindows +} -body { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 - set result [list \ - [catch {toplevel .x -container 1 -use [winfo id .t]} msg] $msg] - destroy .t .x - set result -} {1 {A window cannot have both the -use and the -container option set.}} -test frame-2.11 {toplevel configuration options} { + toplevel .x -container 1 -use [winfo id .t] +} -cleanup { + deleteWindows +} -returnCodes error -result {windows cannot have both the -use and the -container option set} +test frame-2.19 {toplevel configuration options} -setup { + deleteWindows + set opts {} +} -body { # Make sure all options can be set to the default value toplevel .f - set opts {} foreach opt [.f configure] { if {[llength $opt] == 5} { lappend opts [lindex $opt 0] [lindex $opt 4] @@ -216,112 +482,184 @@ test frame-2.11 {toplevel configuration options} { } eval toplevel .g $opts destroy .f .g -} {} +} -cleanup { + deleteWindows +} -result {} + -catch {destroy .t} +destroy .t toplevel .t -width 300 -height 150 wm geometry .t +0+0 update -set i 12 -foreach test { - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #00ff00 #00ff00 non-existent - {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-height 100 100 not_a_number {bad screen distance "not_a_number"}} - {-highlightcolor #123456 #123456 non-existent - {unknown color name "non-existent"}} - {-highlightthickness 3 3 badValue {bad screen distance "badValue"}} - {-padx 3 3 badValue {bad screen distance "badValue"}} - {-pady 4 4 badValue {bad screen distance "badValue"}} - {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} - {-width 32 32 badValue {bad screen distance "badValue"}} -} { - lassign $test opt goodValue goodResult badValue badResult - test frame-2.$i {toplevel configuration options} { - .t configure $opt $goodValue - lindex [.t configure $opt] 4 - } $goodResult - incr i - if {$badValue ne ""} { - test frame-2.$i {toplevel configuration options} -body { - .t configure $opt $badValue - } -returnCodes error -result $badResult - } - .t configure $opt [lindex [.t configure $opt] 3] - incr i -} +test frame-2.20 {toplevel configuration options} -body { + .t configure -background #ff0000 + lindex [.t configure -background] 4 +} -result {#ff0000} +test frame-2.21 {toplevel configuration options} -body { + .t configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-2.22 {toplevel configuration options} -body { + .t configure -bd 4 + lindex [.t configure -bd] 4 +} -result {4} +test frame-2.23 {toplevel configuration options} -body { + .t configure -bd badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-2.24 {toplevel configuration options} -body { + .t configure -bg #00ff00 + lindex [.t configure -bg] 4 +} -result {#00ff00} +test frame-2.25 {toplevel configuration options} -body { + .t configure -bg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-2.26 {toplevel configuration options} -body { + .t configure -borderwidth 1.3 + lindex [.t configure -borderwidth] 4 +} -result {1} +test frame-2.27 {toplevel configuration options} -body { + .t configure -borderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-2.28 {toplevel configuration options} -body { + .t configure -cursor arrow + lindex [.t configure -cursor] 4 +} -result {arrow} +test frame-2.29 {toplevel configuration options} -body { + .t configure -cursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} +test frame-2.30 {toplevel configuration options} -body { + .t configure -height 100 + lindex [.t configure -height] 4 +} -result {100} +test frame-2.31 {toplevel configuration options} -body { + .t configure -height not_a_number +} -returnCodes error -result {bad screen distance "not_a_number"} +test frame-2.32 {toplevel configuration options} -body { + .t configure -highlightcolor #123456 + lindex [.t configure -highlightcolor] 4 +} -result {#123456} +test frame-2.33 {toplevel configuration options} -body { + .t configure -highlightcolor non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-2.34 {toplevel configuration options} -body { + .t configure -highlightthickness 3 + lindex [.t configure -highlightthickness] 4 +} -result {3} +test frame-2.35 {toplevel configuration options} -body { + .t configure -highlightthickness badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-2.36 {toplevel configuration options} -body { + .t configure -padx 3 + lindex [.t configure -padx] 4 +} -result {3} +test frame-2.37 {toplevel configuration options} -body { + .t configure -padx badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-2.38 {toplevel configuration options} -body { + .t configure -pady 4 + lindex [.t configure -pady] 4 +} -result {4} +test frame-2.39 {toplevel configuration options} -body { + .t configure -pady badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-2.40 {toplevel configuration options} -body { + .t configure -relief ridge + lindex [.t configure -relief] 4 +} -result {ridge} +test frame-2.41 {toplevel configuration options} -body { + .t configure -relief badValue +} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} +test frame-2.42 {toplevel configuration options} -body { + .t configure -width 32 + lindex [.t configure -width] 4 +} -result {32} +test frame-2.43 {toplevel configuration options} -body { + .t configure -width badValue +} -returnCodes error -result {bad screen distance "badValue"} +destroy .t + test frame-3.1 {TkCreateFrame procedure} -body { frame -} -returnCodes error -result {wrong # args: should be "frame pathName ?options?"} +} -returnCodes error -result {wrong # args: should be "frame pathName ?-option value ...?"} test frame-3.2 {TkCreateFrame procedure} -setup { - catch {destroy .f} + deleteWindows frame .f } -body { .f configure -class } -cleanup { - destroy .f + deleteWindows } -result {-class class Class Frame Frame} test frame-3.3 {TkCreateFrame procedure} -setup { - catch {destroy .t} + deleteWindows toplevel .t wm geometry .t +0+0 } -body { .t configure -class } -cleanup { - destroy .t + deleteWindows } -result {-class class Class Toplevel Toplevel} -test frame-3.4 {TkCreateFrame procedure} { - catch {destroy .t} +test frame-3.4 {TkCreateFrame procedure} -setup { + deleteWindows +} -body { toplevel .t -width 350 -class NewClass -bg black -visual default -height 90 wm geometry .t +0+0 update list [lindex [.t configure -width] 4] \ [lindex [.t configure -background] 4] \ [lindex [.t configure -height] 4] -} {350 black 90} +} -cleanup { + deleteWindows +} -result {350 black 90} # Be sure that the -class, -colormap, and -visual options are processed # before configuring the widget. - -test frame-3.5 {TkCreateFrame procedure} { - catch {destroy .f} +test frame-3.5 {TkCreateFrame procedure} -setup { + deleteWindows +} -body { option add *NewFrame.background #123456 frame .f -class NewFrame - option clear lindex [.f configure -background] 4 -} {#123456} -test frame-3.6 {TkCreateFrame procedure} { - catch {destroy .f} +} -cleanup { + deleteWindows + option clear +} -result {#123456} +test frame-3.6 {TkCreateFrame procedure} -setup { + deleteWindows +} -body { option add *NewFrame.background #123456 frame .f -class NewFrame - option clear lindex [.f configure -background] 4 -} {#123456} -test frame-3.7 {TkCreateFrame procedure} { - catch {destroy .f} +} -cleanup { + deleteWindows + option clear +} -result {#123456} +test frame-3.7 {TkCreateFrame procedure} -setup { + deleteWindows +} -body { option add *NewFrame.background #332211 option add *f.class NewFrame frame .f - option clear list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4] -} {NewFrame #332211} -test frame-3.8 {TkCreateFrame procedure} { - catch {destroy .f} +} -cleanup { + deleteWindows + option clear +} -result {NewFrame #332211} +test frame-3.8 {TkCreateFrame procedure} -setup { + deleteWindows +} -body { option add *Silly.background #122334 option add *f.Class Silly frame .f - option clear list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4] -} {Silly #122334} -test frame-3.9 {TkCreateFrame procedure, -use option} -setup { - catch {destroy .t} - catch {destroy .x} -} -constraints unix -body { +} -cleanup { + deleteWindows + option clear +} -result {Silly #122334} +test frame-3.9 {TkCreateFrame procedure, -use option} -constraints { + unix +} -setup { + deleteWindows +} -body { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green @@ -330,12 +668,13 @@ test frame-3.9 {TkCreateFrame procedure, -use option} -setup { [expr {[winfo rooty .x] - [winfo rooty .t]}] \ [winfo width .t] [winfo height .t] } -cleanup { - destroy .t + deleteWindows } -result {0 0 140 300} -test frame-3.10 {TkCreateFrame procedure, -use option} -setup { - catch {destroy .t} - catch {destroy .x} -} -constraints unix -body { +test frame-3.10 {TkCreateFrame procedure, -use option} -constraints { + unix +} -setup { + deleteWindows +} -body { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 option add *x.use [winfo id .t] @@ -353,26 +692,38 @@ test frame-3.10 {TkCreateFrame procedure, -use option} -setup { # they are run on a pseudocolor display of depth 8). Even so, they # are non-portable: some machines don't seem to ever run out of # colors. - if {[testConstraint defaultPseudocolor8]} { eatColors .t1 } -test frame-3.11 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} { - catch {destroy .t} +test frame-3.11 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { toplevel .t -width 300 -height 200 -bg #475601 wm geometry .t +0+0 update colorsFree .t -} {0} -test frame-3.12 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} { - catch {destroy .t} +} -cleanup { + deleteWindows +} -result {0} +test frame-3.12 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { toplevel .t -width 300 -height 200 -bg #475601 -colormap new wm geometry .t +0+0 update colorsFree .t -} {1} -test frame-3.13 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} { - catch {destroy .t} +} -cleanup { + deleteWindows +} -result {1} +test frame-3.13 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { option add *t.class Toplevel2 option add *Toplevel2.colormap new toplevel .t -width 300 -height 200 -bg #475601 @@ -380,9 +731,14 @@ test frame-3.13 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} { update option clear colorsFree .t -} {1} -test frame-3.14 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} { - catch {destroy .t} +} -cleanup { + deleteWindows +} -result {1} +test frame-3.14 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { option add *t.class Toplevel3 option add *Toplevel3.Colormap new toplevel .t -width 300 -height 200 -bg #475601 -colormap new @@ -390,11 +746,14 @@ test frame-3.14 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} { update option clear colorsFree .t -} {1} -test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -setup { - catch {destroy .t} - catch {destroy .x} -} -constraints {defaultPseudocolor8 unix nonPortable} -body { +} -cleanup { + deleteWindows +} -result {1} +test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -constraints { + defaultPseudocolor8 unix nonPortable +} -setup { + deleteWindows +} -body { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new @@ -403,30 +762,48 @@ test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -setup { } -cleanup { destroy .t } -result {0 1} -test frame-3.16 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} { - catch {destroy .t} +test frame-3.16 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { toplevel .t -width 300 -height 200 -bg #475601 -visual default wm geometry .t +0+0 update colorsFree .t -} {0} -test frame-3.17 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} { - catch {destroy .t} +} -cleanup { + deleteWindows +} -result {0} +test frame-3.17 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { toplevel .t -width 300 -height 200 -bg #475601 -visual default \ -colormap new wm geometry .t +0+0 update colorsFree .t -} {1} -test frame-3.18 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 nonPortable} { - catch {destroy .t} +} -cleanup { + deleteWindows +} -result {1} +test frame-3.18 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 haveGrayscale8 nonPortable +} -setup { + deleteWindows +} -body { toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 wm geometry .t +0+0 update colorsFree .t 131 131 131 -} {1} -test frame-3.19 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 nonPortable} { - catch {destroy .t} +} -cleanup { + deleteWindows +} -result {1} +test frame-3.19 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 haveGrayscale8 nonPortable +} -setup { + deleteWindows +} -body { option add *t.class T4 option add *T4.visual {grayscale 8} toplevel .t -width 300 -height 200 -bg #434343 @@ -434,9 +811,14 @@ test frame-3.19 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 no update option clear list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4] -} {1 {grayscale 8}} -test frame-3.20 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 nonPortable} { - catch {destroy .t} +} -cleanup { + deleteWindows +} -result {1 {grayscale 8}} +test frame-3.20 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 haveGrayscale8 nonPortable +} -setup { + deleteWindows +} -body { set x ok option add *t.class T5 option add *T5.Visual {grayscale 8} @@ -445,20 +827,28 @@ test frame-3.20 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 no update option clear list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4] -} {1 {grayscale 8}} -test frame-3.21 {TkCreateFrame procedure} {defaultPseudocolor8 haveGrayscale8 nonPortable} { - catch {destroy .t} +} -cleanup { + deleteWindows +} -result {1 {grayscale 8}} +test frame-3.21 {TkCreateFrame procedure} -constraints { + defaultPseudocolor8 haveGrayscale8 nonPortable +} -setup { + deleteWindows +} -body { set x ok toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 wm geometry .t +0+0 update colorsFree .t 131 131 131 -} {1} +} -cleanup { + deleteWindows +} -result {1} if {[testConstraint defaultPseudocolor8]} { destroy .t1 } + test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup { - catch {destroy .t} + deleteWindows } -body { toplevel .t wm geometry .t +0+0 @@ -469,87 +859,103 @@ test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup { update lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f] } -cleanup { - destroy .t + deleteWindows } -result {200 200 1 1} test frame-3.23 {TkCreateFrame procedure} -setup { - catch {destroy .f} + deleteWindows } -body { frame .f -gorp glob } -returnCodes error -result {unknown option "-gorp"} test frame-3.24 {TkCreateFrame procedure} -setup { - catch {destroy .t} + deleteWindows } -body { toplevel .t -width 300 -height 200 -colormap new -bogus option wm geometry .t +0+0 } -returnCodes error -result {unknown option "-bogus"} -test frame-4.1 {TkCreateFrame procedure} { - catch {destroy .f} + +test frame-4.1 {TkCreateFrame procedure} -setup { + deleteWindows +} -body { catch {frame .f -gorp glob} winfo exists .f -} 0 -test frame-4.2 {TkCreateFrame procedure} { - catch {destroy .f} +} -result 0 +test frame-4.2 {TkCreateFrame procedure} -setup { + deleteWindows +} -body { list [frame .f -width 200 -height 100] [winfo exists .f] -} {.f 1} +} -cleanup { + deleteWindows +} -result {.f 1} + -catch {destroy .f} frame .f -highlightcolor black -test frame-5.1 {FrameWidgetCommand procedure} { - list [catch .f msg] $msg -} {1 {wrong # args: should be ".f option ?arg arg ...?"}} -test frame-5.2 {FrameWidgetCommand procedure, cget option} { - list [catch {.f cget} msg] $msg -} {1 {wrong # args: should be ".f cget option"}} -test frame-5.3 {FrameWidgetCommand procedure, cget option} { - list [catch {.f cget a b} msg] $msg -} {1 {wrong # args: should be ".f cget option"}} -test frame-5.4 {FrameWidgetCommand procedure, cget option} { - list [catch {.f cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test frame-5.5 {FrameWidgetCommand procedure, cget option} { +test frame-5.1 {FrameWidgetCommand procedure} -body { + .f +} -returnCodes error -result {wrong # args: should be ".f option ?arg ...?"} +test frame-5.2 {FrameWidgetCommand procedure, cget option} -body { + .f cget +} -returnCodes error -result {wrong # args: should be ".f cget option"} +test frame-5.3 {FrameWidgetCommand procedure, cget option} -body { + .f cget a b +} -returnCodes error -result {wrong # args: should be ".f cget option"} +test frame-5.4 {FrameWidgetCommand procedure, cget option} -body { + .f cget -gorp +} -returnCodes error -result {unknown option "-gorp"} +test frame-5.5 {FrameWidgetCommand procedure, cget option} -body { .f cget -highlightcolor -} {black} -test frame-5.6 {FrameWidgetCommand procedure, cget option} { - list [catch {.f cget -screen} msg] $msg -} {1 {unknown option "-screen"}} -test frame-5.7 {FrameWidgetCommand procedure, cget option} { - catch {destroy .t} +} -result {black} +test frame-5.6 {FrameWidgetCommand procedure, cget option} -body { + .f cget -screen +} -returnCodes error -result {unknown option "-screen"} +test frame-5.7 {FrameWidgetCommand procedure, cget option} -setup { + destroy .t +} -body { toplevel .t - catch {.t cget -screen} -} {0} -catch {destroy .t} -test frame-5.8 {FrameWidgetCommand procedure, configure option} { + .t cget -screen +} -cleanup { + destroy .t +} -returnCodes ok -match glob -result * + +test frame-5.8 {FrameWidgetCommand procedure, configure option} -body { llength [.f configure] -} {18} -test frame-5.9 {FrameWidgetCommand procedure, configure option} { - list [catch {.f configure -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test frame-5.10 {FrameWidgetCommand procedure, configure option} { - list [catch {.f configure -gorp bogus} msg] $msg -} {1 {unknown option "-gorp"}} -test frame-5.11 {FrameWidgetCommand procedure, configure option} { - list [catch {.f configure -width 200 -height} msg] $msg -} {1 {value for "-height" missing}} -test frame-5.12 {FrameWidgetCommand procedure} { - list [catch {.f swizzle} msg] $msg -} {1 {bad option "swizzle": must be cget or configure}} -test frame-5.13 {FrameWidgetCommand procedure, configure option} { +} -result {18} +test frame-5.9 {FrameWidgetCommand procedure, configure option} -body { + .f configure -gorp +} -returnCodes error -result {unknown option "-gorp"} +test frame-5.10 {FrameWidgetCommand procedure, configure option} -body { + .f configure -gorp bogus +} -returnCodes error -result {unknown option "-gorp"} +test frame-5.11 {FrameWidgetCommand procedure, configure option} -body { + .f configure -width 200 -height +} -returnCodes error -result {value for "-height" missing} +test frame-5.12 {FrameWidgetCommand procedure} -body { + .f swizzle +} -returnCodes error -result {bad option "swizzle": must be cget or configure} +test frame-5.13 {FrameWidgetCommand procedure, configure option} -body { llength [. configure] -} {21} +} -result {21} +destroy .f -test frame-6.1 {ConfigureFrame procedure} { - catch {destroy .f} +test frame-6.1 {ConfigureFrame procedure} -setup { + deleteWindows +} -body { frame .f -width 150 list [winfo reqwidth .f] [winfo reqheight .f] -} {150 1} -test frame-6.2 {ConfigureFrame procedure} { - catch {destroy .f} +} -cleanup { + deleteWindows +} -result {150 1} +test frame-6.2 {ConfigureFrame procedure} -setup { + deleteWindows +} -body { frame .f -height 97 list [winfo reqwidth .f] [winfo reqheight .f] -} {1 97} -test frame-6.3 {ConfigureFrame procedure} { - catch {destroy .f} +} -cleanup { + deleteWindows +} -result {1 97} +test frame-6.3 {ConfigureFrame procedure} -setup { + deleteWindows +} -body { frame .f set result {} lappend result [winfo reqwidth .f] [winfo reqheight .f] @@ -557,77 +963,98 @@ test frame-6.3 {ConfigureFrame procedure} { lappend result [winfo reqwidth .f] [winfo reqheight .f] .f configure -width 0 -height 0 lappend result [winfo reqwidth .f] [winfo reqheight .f] -} {1 1 100 180 100 180} +} -cleanup { + deleteWindows +} -result {1 1 100 180 100 180} -test frame-7.1 {FrameEventProc procedure} { +test frame-7.1 {FrameEventProc procedure} -setup { + deleteWindows +} -body { frame .frame2 set result [info commands .frame2] destroy .frame2 lappend result [info commands .frame2] -} {.frame2 {}} -test frame-7.2 {FrameEventProc procedure} { - deleteWindows +} -result {.frame2 {}} +test frame-7.2 {FrameEventProc procedure} -setup { + deleteWindows + set x {} +} -body { frame .f1 -bg #543210 rename .f1 .f2 - set x {} lappend x [winfo children .] lappend x [.f2 cget -bg] destroy .f1 lappend x [info command .f*] [winfo children .] -} {.f1 #543210 {} {}} - -test frame-8.1 {FrameCmdDeletedProc procedure} { +} -cleanup { deleteWindows +} -result {.f1 #543210 {} {}} + +test frame-8.1 {FrameCmdDeletedProc procedure} -setup { + deleteWindows +} -body { frame .f1 rename .f1 {} list [info command .f*] [winfo children .] -} {{} {}} -test frame-8.2 {FrameCmdDeletedProc procedure} { +} -cleanup { deleteWindows +} -result {{} {}} +test frame-8.2 {FrameCmdDeletedProc procedure} -setup { + deleteWindows +} -body { toplevel .f1 -menu .m wm geometry .f1 +0+0 update rename .f1 {} update list [info command .f*] [winfo children .] -} {{} {}} +} -cleanup { + deleteWindows +} -result {{} {}} # # This one fails with the dash-patch!!!! Still don't know why :-( # -#test frame-8.3 {FrameCmdDeletedProc procedure} { +#test frame-8.3 {FrameCmdDeletedProc procedure} -setup { # eval destroy [winfo children .] +# deleteWindows +#} -body { # toplevel .f1 -menu .m # wm geometry .f1 +0+0 # menu .m # update # rename .f1 {} # update -# set result [list [info command .f*] [winfo children .]] +# list [info command .f*] [winfo children .] +#} -cleanup { # eval destroy [winfo children .] -# set result -#} {{} .m} +# deleteWindows +#} -result {{} .m} -test frame-9.1 {MapFrame procedure} { - catch {destroy .t} +test frame-9.1 {MapFrame procedure} -setup { + deleteWindows +} -body { toplevel .t -width 100 -height 400 wm geometry .t +0+0 set result [winfo ismapped .t] update idletasks lappend result [winfo ismapped .t] -} {0 1} -test frame-9.2 {MapFrame procedure} { - catch {destroy .t} +} -cleanup { + deleteWindows +} -result {0 1} +test frame-9.2 {MapFrame procedure} -setup { + deleteWindows +} -body { toplevel .t -width 100 -height 400 wm geometry .t +0+0 destroy .t update winfo exists .t -} {0} -test frame-9.3 {MapFrame procedure, window deleted while mapping} { +} -result {0} +test frame-9.3 {MapFrame procedure, window deleted while mapping} -setup { + deleteWindows +} -body { toplevel .t2 -width 200 -height 200 wm geometry .t2 +0+0 tkwait visibility .t2 - catch {destroy .t} toplevel .t -width 100 -height 400 wm geometry .t +0+0 frame .t2.f -width 50 -height 50 @@ -635,53 +1062,66 @@ test frame-9.3 {MapFrame procedure, window deleted while mapping} { pack .t2.f -side top update idletasks winfo exists .t -} {0} +} -cleanup { + deleteWindows +} -result {0} -set l [interp hidden] -deleteWindows -test frame-10.1 {frame widget vs hidden commands} { - catch {destroy .t} +test frame-10.1 {frame widget vs hidden commands} -setup { + deleteWindows +} -body { + set l [interp hidden] frame .t interp hide {} .t destroy .t - list [winfo children .] [interp hidden] -} [list {} $l] + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 eq $res2} +} -result 1 -test frame-11.1 {TkInstallFrameMenu} { - catch {destroy .t} + +test frame-11.1 {TkInstallFrameMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -menu .m1.system menu .m1.system -tearoff 0 .m1.system add command -label foo - list [toplevel .t -menu .m1] [destroy .m1] [destroy .t] -} {.t {} {}} -test frame-11.2 {TkInstallFrameMenu - frame renamed} { - catch {destroy .t} + toplevel .t -menu .m1 +} -cleanup { + deleteWindows +} -result {.t} +test frame-11.2 {TkInstallFrameMenu - frame renamed} -setup { + deleteWindows +} -body { catch {rename foo {}} menu .m1 .m1 add cascade -menu .m1.system menu .m1.system -tearoff 0 .m1.system add command -label foo toplevel .t - list [rename .t foo] [destroy .t] [destroy foo] [destroy .m1] -} {{} {} {} {}} + rename .t foo +} -cleanup { + deleteWindows +} -result {} + -test frame-12.1 {FrameWorldChanged procedure} { +test frame-12.1 {FrameWorldChanged procedure} -setup { + deleteWindows +} -body { # Test -bd -padx and -pady - destroy .f frame .f -borderwidth 2 -padx 3 -pady 4 place .f -x 0 -y 0 -width 40 -height 40 pack [frame .f.f] -fill both -expand 1 update - set result [list [winfo x .f.f] [winfo y .f.f] \ - [winfo width .f.f] [winfo height .f.f]] - destroy .f - set result -} {5 6 30 28} -test frame-12.2 {FrameWorldChanged procedure} { + list [winfo x .f.f] [winfo y .f.f] [winfo width .f.f] [winfo height .f.f] +} -cleanup { + deleteWindows +} -result {5 6 30 28} +test frame-12.2 {FrameWorldChanged procedure} -setup { + deleteWindows +} -body { # Test all -labelanchor positions - destroy .f set font {helvetica 12} labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font \ -text "Mupp" @@ -710,12 +1150,14 @@ test frame-12.2 {FrameWorldChanged procedure} { [winfo x .f.f] == $expx && [winfo y .f.f] == $expy &&\ [winfo width .f.f] == $expw && [winfo height .f.f] == $exph}] } - destroy .f - set result -} {1 1 1 1 1 1 1 1 1 1 1 1} -test frame-12.3 {FrameWorldChanged procedure} { + return $result +} -cleanup { + deleteWindows +} -result {1 1 1 1 1 1 1 1 1 1 1 1} +test frame-12.3 {FrameWorldChanged procedure} -setup { + deleteWindows +} -body { # Check reaction on font change - destroy .f font create myfont -family courier -size 10 labelframe .f -font myfont -text Mupp place .f -x 0 -y 0 -width 40 -height 40 @@ -727,103 +1169,267 @@ test frame-12.3 {FrameWorldChanged procedure} { update set h2 [font metrics myfont -linespace] set y2 [winfo y .f.f] - destroy .f - font delete myfont expr {($h2 - $h1) - ($y2 - $y1)} -} {0} +} -cleanup { + deleteWindows + font delete myfont +} -result {0} + -test frame-13.1 {labelframe configuration options} { +test frame-13.1 {labelframe configuration options} -setup { + deleteWindows +} -body { labelframe .f -class NewFrame - list [.f configure -class] [catch {.f configure -class Different} msg] $msg -} {{-class class Class Labelframe NewFrame} 1 {can't modify -class option after widget is created}} -catch {destroy .f} -test frame-13.2 {labelframe configuration options} { - list [catch {labelframe .f -colormap new} msg] $msg -} {0 .f} -catch {destroy .f} -test frame-13.3 {labelframe configuration options} { - list [catch {labelframe .f -visual default} msg] $msg -} {0 .f} -catch {destroy .f} -test frame-13.4 {labelframe configuration options} { - list [catch {labelframe .f -screen bogus} msg] $msg -} {1 {unknown option "-screen"}} -test frame-13.5 {labelframe configuration options} { - set result [list [catch {labelframe .f -container true} msg] $msg \ - [.f configure -container]] - destroy .f - set result -} {0 .f {-container container Container 0 1}} -test frame-13.6 {labelframe configuration options} { - list [catch {labelframe .f -container bogus} msg] $msg -} {1 {expected boolean value but got "bogus"}} -test frame-13.7 {labelframe configuration options} { + .f configure -class +} -cleanup { + deleteWindows +} -result {-class class Class Labelframe NewFrame} +test frame-13.2 {labelframe configuration options} -setup { + deleteWindows +} -body { + labelframe .f -class NewFrame + .f configure -class Different +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -class option after widget is created} +test frame-13.3 {labelframe configuration options} -setup { + deleteWindows +} -body { + labelframe .f -colormap new +} -cleanup { + deleteWindows +} -result {.f} +test frame-13.4 {labelframe configuration options} -setup { + deleteWindows +} -body { + labelframe .f -visual default +} -cleanup { + deleteWindows +} -result {.f} +test frame-13.5 {labelframe configuration options} -setup { + deleteWindows +} -body { + labelframe .f -screen bogus +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown option "-screen"} +test frame-13.6 {labelframe configuration options} -setup { + deleteWindows +} -body { + labelframe .f -container true +} -cleanup { + deleteWindows +} -result {.f} +test frame-13.7 {labelframe configuration options} -setup { + deleteWindows +} -body { + labelframe .f -container true + .f configure -container +} -cleanup { + deleteWindows +} -result {-container container Container 0 1} +test frame-13.8 {labelframe configuration options} -setup { + deleteWindows +} -body { + labelframe .f -container bogus +} -cleanup { + deleteWindows +} -returnCodes error -result {expected boolean value but got "bogus"} +test frame-13.9 {labelframe configuration options} -setup { + deleteWindows +} -body { labelframe .f - set result [list [catch {.f configure -container 1} msg] $msg] - destroy .f - set result -} {1 {can't modify -container option after widget is created}} + .f configure -container 1 +} -cleanup { + deleteWindows +} -returnCodes error -result {can't modify -container option after widget is created} + +destroy .f labelframe .f -set i 8 -foreach test { - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #00ff00 #00ff00 non-existent - {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-fg #0000ff #0000ff non-existent - {unknown color name "non-existent"}} - {-font {courier 8} {courier 8} {} {}} - {-foreground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-height 100 100 not_a_number {bad screen distance "not_a_number"}} - {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 non-existent - {unknown color name "non-existent"}} - {-highlightthickness 6 6 badValue {bad screen distance "badValue"}} - {-labelanchor se se badValue {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}} - {-padx 3 3 badValue {bad screen distance "badValue"}} - {-pady 4 4 badValue {bad screen distance "badValue"}} - {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} - {-takefocus "any string" "any string" {} {}} - {-text "any string" "any string" {} {}} - {-width 32 32 badValue {bad screen distance "badValue"}} -} { - lassign $test name goodValue goodResult badValue badResult - test frame-13.$i {labelframe configuration options} { - .f configure $name $goodValue - lindex [.f configure $name] 4 - } $goodResult - incr i - if {$badValue ne ""} { - test frame-13.$i {labelframe configuration options} -body { - .f configure $name $badValue - } -returnCodes error -result $badResult - } - .f configure $name [lindex [.f configure $name] 3] - incr i -} +test frame-13.10 {labelframe configuration options} -body { + .f configure -background #ff0000 + lindex [.f configure -background] 4 +} -cleanup { + .f configure -background [lindex [.f configure -background] 3] +} -result {#ff0000} +test frame-13.11 {labelframe configuration options} -body { + .f configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-13.12 {labelframe configuration options} -body { + .f configure -bd 4 + lindex [.f configure -bd] 4 +} -cleanup { + .f configure -bd [lindex [.f configure -bd] 3] +} -result {4} +test frame-13.13 {labelframe configuration options} -body { + .f configure -bd badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-13.14 {labelframe configuration options} -body { + .f configure -bg #00ff00 + lindex [.f configure -bg] 4 +} -cleanup { + .f configure -bg [lindex [.f configure -bg] 3] +} -result {#00ff00} +test frame-13.15 {labelframe configuration options} -body { + .f configure -bg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-13.16 {labelframe configuration options} -body { + .f configure -borderwidth 1.3 + lindex [.f configure -borderwidth] 4 +} -cleanup { + .f configure -borderwidth [lindex [.f configure -borderwidth] 3] +} -result {1} +test frame-13.17 {labelframe configuration options} -body { + .f configure -borderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-13.18 {labelframe configuration options} -body { + .f configure -cursor arrow + lindex [.f configure -cursor] 4 +} -cleanup { + .f configure -cursor [lindex [.f configure -cursor] 3] +} -result {arrow} +test frame-13.19 {labelframe configuration options} -body { + .f configure -cursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} +test frame-13.20 {labelframe configuration options} -body { + .f configure -fg #0000ff + lindex [.f configure -fg] 4 +} -cleanup { + .f configure -fg [lindex [.f configure -fg] 3] +} -result {#0000ff} +test frame-13.21 {labelframe configuration options} -body { + .f configure -fg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-13.22 {labelframe configuration options} -body { + .f configure -font {courier 8} + lindex [.f configure -font] 4 +} -cleanup { + .f configure -font [lindex [.f configure -font] 3] +} -result {courier 8} +test frame-13.23 {labelframe configuration options} -body { + .f configure -foreground #ff0000 + lindex [.f configure -foreground] 4 +} -cleanup { + .f configure -foreground [lindex [.f configure -foreground] 3] +} -result {#ff0000} +test frame-13.24 {labelframe configuration options} -body { + .f configure -foreground non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-13.25 {labelframe configuration options} -body { + .f configure -height 100 + lindex [.f configure -height] 4 +} -cleanup { + .f configure -height [lindex [.f configure -height] 3] +} -result {100} +test frame-13.26 {labelframe configuration options} -body { + .f configure -height not_a_number +} -returnCodes error -result {bad screen distance "not_a_number"} +test frame-13.27 {labelframe configuration options} -body { + .f configure -highlightbackground #112233 + lindex [.f configure -highlightbackground] 4 +} -cleanup { + .f configure -highlightbackground [lindex [.f configure -highlightbackground] 3] +} -result {#112233} +test frame-13.28 {labelframe configuration options} -body { + .f configure -highlightbackground ugly +} -returnCodes error -result {unknown color name "ugly"} +test frame-13.29 {labelframe configuration options} -body { + .f configure -highlightcolor #123456 + lindex [.f configure -highlightcolor] 4 +} -cleanup { + .f configure -highlightcolor [lindex [.f configure -highlightcolor] 3] +} -result {#123456} +test frame-13.30 {labelframe configuration options} -body { + .f configure -highlightcolor non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test frame-13.31 {labelframe configuration options} -body { + .f configure -highlightthickness 6 + lindex [.f configure -highlightthickness] 4 +} -cleanup { + .f configure -highlightthickness [lindex [.f configure -highlightthickness] 3] +} -result {6} +test frame-13.32 {labelframe configuration options} -body { + .f configure -highlightthickness badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-13.33 {labelframe configuration options} -body { + .f configure -labelanchor se + lindex [.f configure -labelanchor] 4 +} -cleanup { + .f configure -labelanchor [lindex [.f configure -labelanchor] 3] +} -result {se} +test frame-13.34 {labelframe configuration options} -body { + .f configure -labelanchor badValue +} -returnCodes error -result {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws} +test frame-13.35 {labelframe configuration options} -body { + .f configure -padx 3 + lindex [.f configure -padx] 4 +} -cleanup { + .f configure -padx [lindex [.f configure -padx] 3] +} -result {3} +test frame-13.36 {labelframe configuration options} -body { + .f configure -padx badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-13.37 {labelframe configuration options} -body { + .f configure -pady 4 + lindex [.f configure -pady] 4 +} -cleanup { + .f configure -pady [lindex [.f configure -pady] 3] +} -result {4} +test frame-13.38 {labelframe configuration options} -body { + .f configure -pady badValue +} -returnCodes error -result {bad screen distance "badValue"} +test frame-13.39 {labelframe configuration options} -body { + .f configure -relief ridge + lindex [.f configure -relief] 4 +} -cleanup { + .f configure -relief [lindex [.f configure -relief] 3] +} -result {ridge} +test frame-13.40 {labelframe configuration options} -body { + .f configure -relief badValue +} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} +test frame-13.41 {labelframe configuration options} -body { + .f configure -takefocus {any string} + lindex [.f configure -takefocus] 4 +} -cleanup { + .f configure -takefocus [lindex [.f configure -takefocus] 3] +} -result {any string} +test frame-13.42 {labelframe configuration options} -body { + .f configure -text {any string} + lindex [.f configure -text] 4 +} -cleanup { + .f configure -text [lindex [.f configure -text] 3] +} -result {any string} +test frame-13.43 {labelframe configuration options} -body { + .f configure -width 32 + lindex [.f configure -width] 4 +} -cleanup { + .f configure -width [lindex [.f configure -width] 3] +} -result {32} +test frame-13.44 {labelframe configuration options} -body { + .f configure -width badValue +} -returnCodes error -result {bad screen distance "badValue"} destroy .f -test frame-14.1 {labelframe labelwidget option} { + +test frame-14.1 {labelframe labelwidget option} -setup { + deleteWindows +} -body { # Test that label is moved in stacking order - destroy .f .l label .l -text Mupp -font {helvetica 8} labelframe .f -labelwidget .l pack .f frame .f.f -width 50 -height 50 pack .f.f update - set res [list [winfo children .] [winfo width .f] \ - [expr {[winfo height .f] - [winfo height .l]}]] - destroy .f .l - set res -} {{.f .l} 54 52} -test frame-14.2 {labelframe labelwidget option} { + list [winfo children .] [winfo width .f] \ + [expr {[winfo height .f] - [winfo height .l]}] +} -cleanup { + deleteWindows +} -result {{.f .l} 54 52} +test frame-14.2 {labelframe labelwidget option} -setup { + deleteWindows +} -body { # Test the labelframe's reaction if the label is destroyed - destroy .f .l label .l -text Aratherlonglabel labelframe .f -labelwidget .l pack .f @@ -836,12 +1442,13 @@ test frame-14.2 {labelframe labelwidget option} { lappend res [.f cget -labelwidget] update lappend res [expr {[winfo width .f] - [winfo width .f.l]}] - destroy .f - set res -} {.l 12 {} 4} -test frame-14.3 {labelframe labelwidget option} { +} -cleanup { + deleteWindows +} -result {.l 12 {} 4} +test frame-14.3 {labelframe labelwidget option} -setup { + deleteWindows +} -body { # Test the labelframe's reaction if the label is stolen - destroy .f .l label .l -text Aratherlonglabel labelframe .f -labelwidget .l pack .f @@ -854,12 +1461,13 @@ test frame-14.3 {labelframe labelwidget option} { lappend res [.f cget -labelwidget] update lappend res [expr {[winfo width .f] - [winfo width .f.l]}] - destroy .f .l - set res -} {.l 12 {} 4} -test frame-14.4 {labelframe labelwidget option} { +} -cleanup { + deleteWindows +} -result {.l 12 {} 4} +test frame-14.4 {labelframe labelwidget option} -setup { + deleteWindows +} -body { # Test the label's reaction if the labelframe is destroyed - destroy .f .l label .l -text Mupp labelframe .f -labelwidget .l pack .f @@ -867,12 +1475,13 @@ test frame-14.4 {labelframe labelwidget option} { set res [list [winfo manager .l]] destroy .f lappend res [winfo manager .l] - destroy .l - set res -} {labelframe {}} -test frame-14.5 {labelframe labelwidget option} { +} -cleanup { + deleteWindows +} -result {labelframe {}} +test frame-14.5 {labelframe labelwidget option} -setup { + deleteWindows +} -body { # Test that the labelframe reacts on changes in label - destroy .f .l label .l -text Aratherlonglabel labelframe .f -labelwidget .l pack .f @@ -889,24 +1498,25 @@ test frame-14.5 {labelframe labelwidget option} { update lappend res [expr {[winfo width .f] - [winfo width .l]}] lappend res [expr {[winfo width .f] > $first}] - destroy .f .l - set res -} {12 12 1 12 1} -test frame-14.6 {labelframe labelwidget option} { +} -cleanup { + deleteWindows +} -result {12 12 1 12 1} +test frame-14.6 {labelframe labelwidget option} -setup { + deleteWindows +} -body { # Destroying a labelframe with a child label caused a crash # when not handling mapping of the label correctly. # This test does not test anything directly, it's just ment # to catch if the same mistake is made again. - destroy .f labelframe .f pack .f label .f.l -text Mupp .f configure -labelwidget .f.l update - destroy .f -} {} - -catch {destroy .f} +} -cleanup { + deleteWindows +} -result {} +deleteWindows rename eatColors {} rename colorsFree {} @@ -914,3 +1524,6 @@ rename colorsFree {} cleanupTests return + + + diff --git a/tests/geometry.test b/tests/geometry.test index 04ab578..13cc515 100644 --- a/tests/geometry.test +++ b/tests/geometry.test @@ -7,9 +7,16 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +proc getsize w { + regexp {(^[^+-]*)} [wm geometry $w] foo x + return $x +} + +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test + wm geometry . 300x300 raise . @@ -23,15 +30,20 @@ button .b2 -text .b2 button .b3 -text .b3 button .f.f.b4 -text .b4 -test geometry-1.1 {Tk_ManageGeometry procedure} { +test geometry-1.1 {Tk_ManageGeometry procedure} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w + } +} -body { place .b1 -x 120 -y 80 update list [winfo x .b1] [winfo y .b1] -} {120 80} -test geometry-1.2 {Tk_ManageGeometry procedure} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { - place forget $w +} -result {120 80} +test geometry-1.2 {Tk_ManageGeometry procedure} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { place .f -x 20 -y 30 -width 200 -height 200 place .b1 -in .f -x 40 -y 30 update @@ -39,28 +51,37 @@ test geometry-1.2 {Tk_ManageGeometry procedure} { place .f -x 30 -y 40 update list [winfo x .b1] [winfo y .b1] -} {0 0} +} -result {0 0} -test geometry-2.1 {Tk_GeometryRequest procedure} { + +test geometry-2.1 {Tk_GeometryRequest procedure} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w + } + destroy .f2 +} -body { frame .f2 set result [list [winfo reqwidth .f2] [winfo reqheight .f2]] .f2 configure -width 150 -height 300 update lappend result [winfo reqwidth .f2] [winfo reqheight .f2] \ - [winfo geom .f2] + [winfo geom .f2] place .f2 -x 10 -y 20 update lappend result [winfo geom .f2] .f2 configure -width 100 -height 80 update lappend result [winfo geom .f2] -} {1 1 150 300 1x1+0+0 150x300+10+20 100x80+10+20} -catch {destroy .f2} +} -cleanup { + destroy .f2 +} -result {1 1 150 300 1x1+0+0 150x300+10+20 100x80+10+20} + -test geometry-3.1 {Tk_SetInternalBorder procedure} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { - place forget $w +test geometry-3.1 {Tk_SetInternalBorder procedure} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { place .f -x 20 -y 30 -width 200 -height 200 place .b1 -in .f -x 50 -y 5 update @@ -68,24 +89,28 @@ test geometry-3.1 {Tk_SetInternalBorder procedure} { .f configure -bd 5 update lappend x [winfo x .b1] [winfo y .b1] -} {72 37 75 40} -.f configure -bd 2 +} -cleanup { + .f configure -bd 2 +} -result {72 37 75 40} -test geometry-4.1 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { - place forget $w + +test geometry-4.1 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 place .b1 -in .f.f.f -x 50 -y 5 update list [winfo x .b1] [winfo y .b1] -} {91 46} -test geometry-4.2 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { - place forget $w +} -result {91 46} +test geometry-4.2 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 @@ -96,12 +121,13 @@ test geometry-4.2 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { place .f -x 30 -y 25 update list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \ - [winfo x .b3] [winfo y .b3] -} {101 41 61 61 101 61} -test geometry-4.3 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { - place forget $w + [winfo x .b3] [winfo y .b3] +} -result {101 41 61 61 101 61} +test geometry-4.3 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 @@ -114,12 +140,13 @@ test geometry-4.3 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { place .f.f -x 10 -y 25 update list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \ - [winfo x .b3] [winfo y .b3] -} {0 0 46 86 86 86} -test geometry-4.4 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { - place forget $w + [winfo x .b3] [winfo y .b3] +} -result {0 0 46 86 86 86} +test geometry-4.4 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 @@ -132,12 +159,13 @@ test geometry-4.4 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { place .f.f.f -x 2 -y 3 update list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \ - [winfo x .b3] [winfo y .b3] -} {93 49 0 0 93 69} -test geometry-4.5 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { - place forget $w + [winfo x .b3] [winfo y .b3] +} -result {93 49 0 0 93 69} +test geometry-4.5 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 @@ -150,11 +178,15 @@ test geometry-4.5 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { place .f.f.f -x 2 -y 3 update list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \ - [winfo x .b3] [winfo y .b3] -} {93 49 53 69 0 0} -test geometry-4.6 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { + [winfo x .b3] [winfo y .b3] +} -result {93 49 53 69 0 0} +test geometry-4.6 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w + } +} -body { foreach w {.f .f.f .f.f.f .b1 .b2 .b3 .f.f.b4} { - place forget $w + place forget $w } place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 @@ -165,11 +197,12 @@ test geometry-4.6 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { place .f -x 25 -y 35 update list [winfo x .f.f.b4] [winfo y .f.f.b4] [winfo x .b2] [winfo y .b2] -} {54 9 56 71} -test geometry-4.7 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3 .f.f.b4} { - place forget $w +} -result {54 9 56 71} +test geometry-4.7 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { bind .b1 <Configure> {lappend x configure} place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 @@ -184,13 +217,15 @@ test geometry-4.7 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { place .f -x 30 -y 40 place .f.f -x 10 -y 0 update + return $x +} -cleanup { bind .b1 <Configure> {} - set x -} {init configure |} -test geometry-4.8 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { - place forget $w +} -result {init configure |} +test geometry-4.8 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 @@ -204,13 +239,14 @@ test geometry-4.8 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { place .f -x 30 -y 25 update list [winfo x .b1] [winfo y .b1] [winfo ismapped .b1] \ - [winfo x .b2] [winfo y .b2] [winfo ismapped .b2] \ - [winfo x .b3] [winfo y .b3] [winfo ismapped .b3] -} {91 46 0 51 66 0 91 66 0} -test geometry-4.9 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { - foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { - place forget $w + [winfo x .b2] [winfo y .b2] [winfo ismapped .b2] \ + [winfo x .b3] [winfo y .b3] [winfo ismapped .b3] +} -result {91 46 0 51 66 0 91 66 0} +test geometry-4.9 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w } +} -body { place .f -x 20 -y 30 -width 200 -height 200 place .f.f -x 15 -y 5 -width 150 -height 120 place .f.f.f -width 100 -height 80 @@ -223,14 +259,18 @@ test geometry-4.9 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { place .f.f -x 15 -y 5 -width 150 -height 120 update lappend result [winfo ismapped .b1] -} {1 0 1} -test geometry-4.10 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { +} -result {1 0 1} +test geometry-4.10 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { + foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { + place forget $w + } + destroy .t +} -body { toplevel .t wm geometry .t +0+0 tkwait visibility .t update - frame .t.f - pack .t.f + pack [frame .t.f] button .t.quit -text Quit -command exit pack .t.quit -in .t.f wm iconify .t @@ -240,10 +280,12 @@ test geometry-4.10 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} { wm deiconify .t update winfo ismapped .t.quit -} {1} +} -cleanup { + destroy .t +} -result {1} -catch {destroy .t} # cleanup cleanupTests return + diff --git a/tests/get.test b/tests/get.test index d3a4228..ea08c8c 100644 --- a/tests/get.test +++ b/tests/get.test @@ -6,73 +6,133 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test -button .b -test get-1.1 {Tk_GetAnchorFromObj} { +test get-1.1 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor n .b cget -anchor -} {n} -test get-1.2 {Tk_GetAnchorFromObj} { +} -cleanup { + destroy .b +} -result {n} +test get-1.2 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor ne .b cget -anchor -} {ne} -test get-1.3 {Tk_GetAnchorFromObj} { +} -cleanup { + destroy .b +} -result {ne} +test get-1.3 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor e .b cget -anchor -} {e} -test get-1.4 {Tk_GetAnchorFromObj} { +} -cleanup { + destroy .b +} -result {e} +test get-1.4 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor se .b cget -anchor -} {se} -test get-1.5 {Tk_GetAnchorFromObj} { +} -cleanup { + destroy .b +} -result {se} +test get-1.5 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor s .b cget -anchor -} {s} -test get-1.6 {Tk_GetAnchorFromObj} { +} -cleanup { + destroy .b +} -result {s} +test get-1.6 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor sw .b cget -anchor -} {sw} -test get-1.7 {Tk_GetAnchorFromObj} { +} -cleanup { + destroy .b +} -result {sw} +test get-1.7 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor w .b cget -anchor -} {w} -test get-1.8 {Tk_GetAnchorFromObj} { +} -cleanup { + destroy .b +} -result {w} +test get-1.8 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor nw .b cget -anchor -} {nw} -test get-1.9 {Tk_GetAnchorFromObj} { +} -cleanup { + destroy .b +} -result {nw} +test get-1.9 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor n .b cget -anchor -} {n} -test get-1.10 {Tk_GetAnchorFromObj} { +} -cleanup { + destroy .b +} -result {n} +test get-1.10 {Tk_GetAnchorFromObj} -setup { + button .b +} -body { .b configure -anchor center .b cget -anchor -} {center} -test get-1.11 {Tk_GetAnchorFromObj - error} { - list [catch {.b configure -anchor unknown} msg] $msg -} {1 {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center}} +} -cleanup { + destroy .b +} -result {center} +test get-1.11 {Tk_GetAnchorFromObj - error} -setup { + button .b +} -body { + .b configure -anchor unknown +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center} -catch {destroy .b} -button .b -test get-2.1 {Tk_GetJustifyFromObj} { + +test get-2.1 {Tk_GetJustifyFromObj} -setup { + button .b +} -body { .b configure -justify left .b cget -justify -} {left} -test get-2.2 {Tk_GetJustifyFromObj} { +} -cleanup { + destroy .b +} -result {left} +test get-2.2 {Tk_GetJustifyFromObj} -setup { + button .b +} -body { .b configure -justify right .b cget -justify -} {right} -test get-2.3 {Tk_GetJustifyFromObj} { +} -cleanup { + destroy .b +} -result {right} +test get-2.3 {Tk_GetJustifyFromObj} -setup { + button .b +} -body { .b configure -justify center .b cget -justify -} {center} -test get-2.4 {Tk_GetJustifyFromObj - error} { - list [catch {.b configure -justify stupid} msg] $msg -} {1 {bad justification "stupid": must be left, right, or center}} +} -cleanup { + destroy .b +} -result {center} +test get-2.4 {Tk_GetJustifyFromObj - error} -setup { + button .b +} -body { + .b configure -justify stupid +} -cleanup { + destroy .b +} -returnCodes {error} -result {bad justification "stupid": must be left, right, or center} # cleanup cleanupTests return + diff --git a/tests/grab.test b/tests/grab.test index 2f4f73b..33399cb 100644 --- a/tests/grab.test +++ b/tests/grab.test @@ -7,140 +7,145 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test # There's currently no way to test the actual grab effect, per se, # in an automated test. Therefore, this test suite only covers the # interface to the grab command (ie, error messages, etc.) -test grab-1.1 {Tk_GrabObjCmd} { - list [catch {grab} msg] $msg -} [list 1 "wrong # args: should be \"grab ?-global? window\" or \"grab option ?arg arg ...?\""] -test grab-1.2 {Tk_GrabObjCmd} { + +test grab-1.1 {Tk_GrabObjCmd} -body { + grab +} -returnCodes error -result {wrong # args: should be "grab ?-global? window" or "grab option ?arg ...?"} +test grab-1.2 {Tk_GrabObjCmd} -body { rename grab grabTest1.2 - set res [list [catch {grabTest1.2} msg] $msg] + grabTest1.2 +} -cleanup { rename grabTest1.2 grab - set res -} [list 1 "wrong # args: should be \"grabTest1.2 ?-global? window\" or \"grabTest1.2 option ?arg arg ...?\""] - -test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} { - list [catch {grab .foo bar baz} msg] $msg -} [list 1 "wrong # args: should be \"grab ?-global? window\""] -test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} { - catch {destroy .foo} - list [catch {grab .foo} msg] $msg -} [list 1 "bad window path name \".foo\""] -test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} { - list [catch {grab -foo bar} msg] $msg -} [list 1 "bad option \"-foo\": must be -global"] -test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} { - catch {destroy .foo} - list [catch {grab -global .foo} msg] $msg -} [list 1 "bad window path name \".foo\""] - -test grab-1.7 {Tk_GrabObjCmd} { - list [catch {grab foo} msg] $msg -} [list 1 "bad option \"foo\": must be current, release, set, or status"] - -test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} { - list [catch {grab current foo bar} msg] $msg -} [list 1 "wrong # args: should be \"grab current ?window?\""] -test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} { - catch {destroy .foo} - list [catch {grab current .foo} msg] $msg -} [list 1 "bad window path name \".foo\""] - -test grab-1.10 {Tk_GrabObjCmd, "grab release window"} { - list [catch {grab release} msg] $msg -} [list 1 "wrong # args: should be \"grab release window\""] -test grab-1.11 {Tk_GrabObjCmd, "grab release window"} { - catch {destroy .foo} - list [catch {grab release .foo} msg] $msg -} [list 0 ""] -test grab-1.12 {Tk_GrabObjCmd, "grab release window"} { - list [catch {grab release foo} msg] $msg -} [list 0 ""] - -test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} { - list [catch {grab set} msg] $msg -} [list 1 "wrong # args: should be \"grab set ?-global? window\""] -test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} { - list [catch {grab set foo bar baz} msg] $msg -} [list 1 "wrong # args: should be \"grab set ?-global? window\""] -test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} { - catch {destroy .foo} - list [catch {grab set .foo} msg] $msg -} [list 1 "bad window path name \".foo\""] -test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} { - list [catch {grab set -foo bar} msg] $msg -} [list 1 "bad option \"-foo\": must be -global"] -test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} { - catch {destroy .foo} - list [catch {grab set -global .foo} msg] $msg -} [list 1 "bad window path name \".foo\""] - -test grab-1.18 {Tk_GrabObjCmd, "grab status window"} { - list [catch {grab status} msg] $msg -} [list 1 "wrong # args: should be \"grab status window\""] -test grab-1.19 {Tk_GrabObjCmd, "grab status window"} { - list [catch {grab status foo bar} msg] $msg -} [list 1 "wrong # args: should be \"grab status window\""] -test grab-1.20 {Tk_GrabObjCmd, "grab status window"} { - catch {destroy .foo} - list [catch {grab status .foo} msg] $msg -} [list 1 "bad window path name \".foo\""] - -test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} { +} -returnCodes error -result {wrong # args: should be "grabTest1.2 ?-global? window" or "grabTest1.2 option ?arg ...?"} + +test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} -body { + grab .foo bar baz +} -returnCodes error -result {wrong # args: should be "grab ?-global? window"} +test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} -body { + destroy .foo + grab .foo +} -returnCodes error -result {bad window path name ".foo"} +test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} -body { + grab -foo bar +} -returnCodes error -result {bad option "-foo": must be -global} +test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} -body { + destroy .foo + grab -global .foo +} -returnCodes error -result {bad window path name ".foo"} + +test grab-1.7 {Tk_GrabObjCmd} -body { + grab foo +} -returnCodes error -result {bad option "foo": must be current, release, set, or status} + +test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} -body { + grab current foo bar +} -returnCodes error -result {wrong # args: should be "grab current ?window?"} +test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} -body { + destroy .foo + grab current .foo +} -returnCodes error -result {bad window path name ".foo"} + +test grab-1.10 {Tk_GrabObjCmd, "grab release window"} -body { + grab release +} -returnCodes error -result {wrong # args: should be "grab release window"} +test grab-1.11 {Tk_GrabObjCmd, "grab release window"} -body { + destroy .foo + grab release .foo +} -returnCodes ok -result {} +test grab-1.12 {Tk_GrabObjCmd, "grab release window"} -body { + grab release foo +} -returnCodes ok -result {} + +test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} -body { + grab set +} -returnCodes error -result {wrong # args: should be "grab set ?-global? window"} +test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} -body { + grab set foo bar baz +} -returnCodes error -result {wrong # args: should be "grab set ?-global? window"} +test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} -body { + destroy .foo + grab set .foo +} -returnCodes error -result {bad window path name ".foo"} +test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} -body { + grab set -foo bar +} -returnCodes error -result {bad option "-foo": must be -global} +test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} -body { + destroy .foo + grab set -global .foo +} -returnCodes error -result {bad window path name ".foo"} + +test grab-1.18 {Tk_GrabObjCmd, "grab status window"} -body { + grab status +} -returnCodes error -result {wrong # args: should be "grab status window"} +test grab-1.19 {Tk_GrabObjCmd, "grab status window"} -body { + grab status foo bar +} -returnCodes error -result {wrong # args: should be "grab status window"} +test grab-1.20 {Tk_GrabObjCmd, "grab status window"} -body { + destroy .foo + grab status .foo +} -returnCodes error -result {bad window path name ".foo"} + + +test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} -body { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } - set result [grab status .] + grab status . +} -cleanup { grab release . - set result -} "none" -test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} { +} -result {none} +test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} -body { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab . - set result [grab status .] + grab status . +} -cleanup { grab release . - set result -} "local" -test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} { +} -result {local} +test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} -body { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab -global . - set result [grab status .] + grab status . +} -cleanup { grab release . - set result -} "global" +} -result {global} + -test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} { +test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} -body { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } - set curr -} "" -test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} { + return $curr +} -result {} +test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} -body { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab . - set curr [grab current] + grab current +} -cleanup { grab release . - set curr -} "." +} -result {.} -test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} { + +test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} -body { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr @@ -153,28 +158,31 @@ test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} { lappend result [grab status .] grab release . lappend result [grab status .] -} [list "local" "none" "global" "none"] +} -result {local none global none} + -test grab-5.1 {Tk_GrabObjCmd, grab set} { +test grab-5.1 {Tk_GrabObjCmd, grab set} -body { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab set . - set result [list [grab current .] [grab status .]] + list [grab current .] [grab status .] +} -cleanup { grab release . - set result -} [list "." "local"] -test grab-5.2 {Tk_GrabObjCmd, grab set} { +} -result {. local} +test grab-5.2 {Tk_GrabObjCmd, grab set} -body { set curr [grab current .] if { [string length $curr] > 0 } { grab release $curr } grab set -global . - set result [list [grab current .] [grab status .]] + list [grab current .] [grab status .] +} -cleanup { grab release . - set result -} [list "." "global"] +} -result {. global} + cleanupTests return + diff --git a/tests/grid.test b/tests/grid.test index fee81b5..c1d9d06 100644 --- a/tests/grid.test +++ b/tests/grid.test @@ -1,22 +1,23 @@ -# This file is a Tcl script to test out the *NEW* "grid" command -# of Tk. It is (almost) organized in the standard fashion for Tcl tests. +# This file is a Tcl script to test out the *NEW* "grid" command of Tk. It is +# (almost) organized in the standard fashion for Tcl tests. # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test -# helper routine to return "." to a sane state after a test -# The variable GRID_VERBOSE can be used to "look" at the result -# of one or all of the tests +# helper routine to return "." to a sane state after a test. +# The variable GRID_VERBOSE can be used to "look" at the result of one or all +# of the tests proc grid_reset {{test ?} {top .}} { global GRID_VERBOSE if {[info exists GRID_VERBOSE]} { - if {$GRID_VERBOSE=="" || $GRID_VERBOSE==$test} { + if {$GRID_VERBOSE eq "" || $GRID_VERBOSE eq $test} { puts -nonewline "grid test $test: " flush stdout gets stdin @@ -26,10 +27,10 @@ proc grid_reset {{test ?} {top .}} { update foreach {cols rows} [grid size .] {} for {set i 0} {$i <= $cols} {incr i} { - grid columnconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" + grid columnconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" } for {set i 0} {$i <= $rows} {incr i} { - grid rowconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" + grid rowconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" } grid propagate . 1 grid anchor . nw @@ -38,88 +39,76 @@ proc grid_reset {{test ?} {top .}} { grid_reset 0.0 wm geometry . {} + +test grid-1.1 {basic argument checking} -body { + grid +} -returnCodes error -result {wrong # args: should be "grid option arg ?arg ...?"} +test grid-1.2 {basic argument checking} -body { + grid foo bar +} -returnCodes error -result {bad option "foo": must be anchor, bbox, columnconfigure, configure, forget, info, location, propagate, remove, rowconfigure, size, or slaves} +test grid-1.3 {basic argument checking} -body { + button .b + grid .b -row 0 -column +} -cleanup { + grid_reset 1.3 +} -returnCodes error -result {extra option or option with no value} +test grid-1.4 {basic argument checking} -body { + button .b + grid configure .b - foo +} -cleanup { + grid_reset 1.4 +} -returnCodes error -result {unexpected parameter "foo" in configure list: should be window name or option} +test grid-1.5 {basic argument checking} -body { + grid . +} -returnCodes error -result {can't manage ".": it's a top-level window} +test grid-1.6 {basic argument checking} -body { + grid x +} -returnCodes error -result {can't determine master window} +test grid-1.7 {basic argument checking} -body { + grid configure x +} -returnCodes error -result {can't determine master window} +test grid-1.8 {basic argument checking} -body { + button .b + grid x .b +} -cleanup { + grid_reset 1.8 +} -returnCodes ok -result {} +test grid-1.9 {basic argument checking} -body { + button .b + grid configure x .b +} -cleanup { + grid_reset 1.9 +} -returnCodes ok -result {} -test grid-1.1 {basic argument checking} { - list [catch grid msg] $msg -} {1 {wrong # args: should be "grid option arg ?arg ...?"}} - -test grid-1.2 {basic argument checking} { - list [catch {grid foo bar} msg] $msg -} {1 {bad option "foo": must be anchor, bbox, columnconfigure, configure, forget, info, location, propagate, remove, rowconfigure, size, or slaves}} - -test grid-1.3 {basic argument checking} { - button .b - list [catch {grid .b -row 0 -column} msg] $msg -} {1 {extra option or option with no value}} -grid_reset 1.3 - -test grid-1.4 {basic argument checking} { - button .b - list [catch {grid configure .b - foo} msg] $msg -} {1 {unexpected parameter, "foo", in configure list. Should be window name or option}} -grid_reset 1.4 - -test grid-1.5 {basic argument checking} { - list [catch {grid .} msg] $msg -} {1 {can't manage ".": it's a top-level window}} - -test grid-1.6 {basic argument checking} { - list [catch {grid x} msg] $msg -} {1 {can't determine master window}} - -test grid-1.7 {basic argument checking} { - list [catch {grid configure x} msg] $msg -} {1 {can't determine master window}} - -test grid-1.8 {basic argument checking} { - button .b - list [catch {grid x .b} msg] $msg -} {0 {}} -grid_reset 1.8 - -test grid-1.9 {basic argument checking} { - button .b - list [catch {grid configure x .b} msg] $msg -} {0 {}} -grid_reset 1.9 - -test grid-2.1 {bbox} { - list [catch {grid bbox .} msg] $msg -} {0 {0 0 0 0}} - -test grid-2.2 {bbox} { - button .b - grid .b - destroy .b - update - list [catch {grid bbox .} msg] $msg -} {0 {0 0 0 0}} - -test grid-2.3 {bbox: argument checking} { - list [catch {grid bbox . 0 0 5} msg] $msg -} {1 {wrong # args: should be "grid bbox master ?column row ?column row??"}} - -test grid-2.4 {bbox} { - list [catch {grid bbox .bad 0 0} msg] $msg -} {1 {bad window path name ".bad"}} - -test grid-2.5 {bbox} { - list [catch {grid bbox . x 0} msg] $msg -} {1 {expected integer but got "x"}} - -test grid-2.6 {bbox} { - list [catch {grid bbox . 0 x} msg] $msg -} {1 {expected integer but got "x"}} - -test grid-2.7 {bbox} { - list [catch {grid bbox . 0 0 x 0} msg] $msg -} {1 {expected integer but got "x"}} - -test grid-2.8 {bbox} { - list [catch {grid bbox . 0 0 0 x} msg] $msg -} {1 {expected integer but got "x"}} - -test grid-2.9 {bbox} { +test grid-2.1 {bbox} -body { + grid bbox . +} -result {0 0 0 0} +test grid-2.2 {bbox} -body { + button .b + grid .b + destroy .b + update + grid bbox . +} -result {0 0 0 0} +test grid-2.3 {bbox: argument checking} -body { + grid bbox . 0 0 5 +} -returnCodes error -result {wrong # args: should be "grid bbox master ?column row ?column row??"} +test grid-2.4 {bbox} -body { + grid bbox .bad 0 0 +} -returnCodes error -result {bad window path name ".bad"} +test grid-2.5 {bbox} -body { + grid bbox . x 0 +} -returnCodes error -result {expected integer but got "x"} +test grid-2.6 {bbox} -body { + grid bbox . 0 x +} -returnCodes error -result {expected integer but got "x"} +test grid-2.7 {bbox} -body { + grid bbox . 0 0 x 0 +} -returnCodes error -result {expected integer but got "x"} +test grid-2.8 {bbox} -body { + grid bbox . 0 0 0 x +} -returnCodes error -result {expected integer but got "x"} +test grid-2.9 {bbox} -body { frame .1 -width 75 -height 75 -bg red frame .2 -width 90 -height 90 -bg red grid .1 -row 0 -column 0 @@ -130,11 +119,11 @@ test grid-2.9 {bbox} { lappend a [grid bbox . 0 0] lappend a [grid bbox . 0 0 1 1] lappend a [grid bbox . 1 1] - set a -} {{0 0 165 165} {0 0 75 75} {0 0 165 165} {75 75 90 90}} -grid_reset 2.9 - -test grid-2.10 {bbox} { + return $a +} -cleanup { + grid_reset 2.9 +} -result {{0 0 165 165} {0 0 75 75} {0 0 165 165} {75 75 90 90}} +test grid-2.10 {bbox} -body { frame .1 -width 75 -height 75 -bg red frame .2 -width 90 -height 90 -bg red grid .1 -row 0 -column 0 @@ -144,98 +133,98 @@ test grid-2.10 {bbox} { lappend a [grid bbox . 10 10 0 0] lappend a [grid bbox . -2 -2 -1 -1] lappend a [grid bbox . 10 10 12 12] - set a -} {{0 0 165 165} {0 0 0 0} {165 165 0 0}} -grid_reset 2.10 - -test grid-3.1 {configure: basic argument checking} { - list [catch {grid configure foo} msg] $msg -} {1 {bad argument "foo": must be name of window}} - -test grid-3.2 {configure: basic argument checking} { + return $a +} -cleanup { + grid_reset 2.10 +} -result {{0 0 165 165} {0 0 0 0} {165 165 0 0}} + +test grid-3.1 {configure: basic argument checking} -body { + grid configure foo +} -returnCodes error -result {bad argument "foo": must be name of window} +test grid-3.2 {configure: basic argument checking} -body { button .b grid configure .b grid slaves . -} {.b} -grid_reset 3.2 - -test grid-3.3 {configure: basic argument checking} { +} -cleanup { + grid_reset 3.2 +} -result {.b} +test grid-3.3 {configure: basic argument checking} -body { button .b - list [catch {grid .b -row -1} msg] $msg -} {1 {bad row value "-1": must be a non-negative integer}} -grid_reset 3.3 - -test grid-3.4 {configure: basic argument checking} { + grid .b -row -1 +} -cleanup { + grid_reset 3.3 +} -returnCodes error -result {bad row value "-1": must be a non-negative integer} +test grid-3.4 {configure: basic argument checking} -body { button .b - list [catch {grid .b -column -1} msg] $msg -} {1 {bad column value "-1": must be a non-negative integer}} -grid_reset 3.4 - -test grid-3.5 {configure: basic argument checking} { + grid .b -column -1 +} -cleanup { + grid_reset 3.4 +} -returnCodes error -result {bad column value "-1": must be a non-negative integer} +test grid-3.5 {configure: basic argument checking} -body { button .b - list [catch {grid .b -rowspan 0} msg] $msg -} {1 {bad rowspan value "0": must be a positive integer}} -grid_reset 3.5 - -test grid-3.6 {configure: basic argument checking} { + grid .b -rowspan 0 +} -cleanup { + grid_reset 3.5 +} -returnCodes error -result {bad rowspan value "0": must be a positive integer} +test grid-3.6 {configure: basic argument checking} -body { button .b - list [catch {grid .b -columnspan 0} msg] $msg -} {1 {bad columnspan value "0": must be a positive integer}} -grid_reset 3.6 - -test grid-3.7 {configure: basic argument checking} { + grid .b -columnspan 0 +} -cleanup { + grid_reset 3.6 +} -returnCodes error -result {bad columnspan value "0": must be a positive integer} +test grid-3.7 {configure: basic argument checking} -body { frame .f button .f.b - list [catch {grid .f .f.b} msg] $msg -} {1 {can't put .f.b inside .}} -grid_reset 3.7 - -test grid-3.8 {configure: basic argument checking} { + grid .f .f.b +} -cleanup { + grid_reset 3.7 +} -returnCodes error -result {can't put .f.b inside .} +test grid-3.8 {configure: basic argument checking} -body { button .b grid configure x .b grid slaves . -} {.b} -grid_reset 3.8 - -test grid-3.9 {configure: basic argument checking} { +} -cleanup { + grid_reset 3.8 +} -result {.b} +test grid-3.9 {configure: basic argument checking} -body { button .b - list [catch {grid configure y .b} msg] $msg -} {1 {invalid window shortcut, "y" should be '-', 'x', or '^'}} -grid_reset 3.9 - -test grid-4.1 {forget: basic argument checking} { - list [catch {grid forget foo} msg] $msg -} {1 {bad window path name "foo"}} - -test grid-4.2 {forget} { + grid configure y .b +} -cleanup { + grid_reset 3.9 +} -returnCodes error -result {invalid window shortcut, "y" should be '-', 'x', or '^'} + +test grid-4.1 {forget: basic argument checking} -body { + grid forget foo +} -returnCodes error -result {bad window path name "foo"} +test grid-4.2 {forget} -body { button .c grid [button .b] set a [grid slaves .] grid forget .b .c lappend a [grid slaves .] - set a -} {.b {}} -grid_reset 4.2 - -test grid-4.3 {forget} { + return $a +} -cleanup { + grid_reset 4.2 +} -result {.b {}} +test grid-4.3 {forget} -body { button .c grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx 3 -pady 4 -sticky ns grid forget .c grid .c -row 0 -column 0 grid info .c -} {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} -grid_reset 4.3 - -test grid-4.3.1 {forget} { +} -cleanup { + grid_reset 4.3 +} -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} +test grid-4.4 {forget} -body { button .c grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx {3 5} -pady {4 7} -sticky ns grid forget .c grid .c -row 0 -column 0 grid info .c -} {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} -grid_reset 4.3.1 - -test grid-4.4 {forget, calling Tk_UnmaintainGeometry} { +} -cleanup { + grid_reset 4.3.1 +} -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} +test grid-4.5 {forget, calling Tk_UnmaintainGeometry} -body { frame .f -bd 2 -relief raised place .f -x 10 -y 20 -width 200 -height 100 frame .f2 -width 50 -height 30 -bg red @@ -246,59 +235,56 @@ test grid-4.4 {forget, calling Tk_UnmaintainGeometry} { place .f -x 30 update lappend x [winfo ismapped .f2] -} {1 0} -grid_reset 4.4 - -test grid-5.1 {info: basic argument checking} { - list [catch {grid info a b} msg] $msg -} {1 {wrong # args: should be "grid info window"}} - -test grid-5.2 {info} { +} -cleanup { + grid_reset 4.4 +} -result {1 0} + +test grid-5.1 {info: basic argument checking} -body { + grid info a b +} -returnCodes error -result {wrong # args: should be "grid info window"} +test grid-5.2 {info} -body { frame .1 -width 75 -height 75 -bg red grid .1 -row 0 -column 0 update - list [catch {grid info .x} msg] $msg -} {1 {bad window path name ".x"}} -grid_reset 5.2 - -test grid-5.3 {info} { + grid info .x +} -cleanup { + grid_reset 5.2 +} -returnCodes error -result {bad window path name ".x"} +test grid-5.3 {info} -body { frame .1 -width 75 -height 75 -bg red grid .1 -row 0 -column 0 update - list [catch {grid info .1} msg] $msg -} {0 {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}}} -grid_reset 5.3 - -test grid-5.4 {info} { + grid info .1 +} -cleanup { + grid_reset 5.3 +} -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} +test grid-5.4 {info} -body { frame .1 -width 75 -height 75 -bg red update - list [catch {grid info .1} msg] $msg -} {0 {}} -grid_reset 5.4 - -test grid-6.1 {location: basic argument checking} { - list [catch "grid location ." msg] $msg -} {1 {wrong # args: should be "grid location master x y"}} - -test grid-6.2 {location: basic argument checking} { - list [catch "grid location .bad 0 0" msg] $msg -} {1 {bad window path name ".bad"}} - -test grid-6.3 {location: basic argument checking} { - list [catch "grid location . x y" msg] $msg -} {1 {bad screen distance "x"}} - -test grid-6.4 {location: basic argument checking} { - list [catch "grid location . 1c y" msg] $msg -} {1 {bad screen distance "y"}} - -test grid-6.5 {location: basic argument checking} { - frame .f - grid location .f 10 10 -} {-1 -1} -grid_reset 6.5 - -test grid-6.6 {location (x)} { + grid info .1 +} -cleanup { + grid_reset 5.4 +} -returnCodes ok -result {} + +test grid-6.1 {location: basic argument checking} -body { + grid location . +} -returnCodes error -result {wrong # args: should be "grid location master x y"} +test grid-6.2 {location: basic argument checking} -body { + grid location .bad 0 0 +} -returnCodes error -result {bad window path name ".bad"} +test grid-6.3 {location: basic argument checking} -body { + grid location . x y +} -returnCodes error -result {bad screen distance "x"} +test grid-6.4 {location: basic argument checking} -body { + grid location . 1c y +} -returnCodes error -result {bad screen distance "y"} +test grid-6.5 {location: basic argument checking} -body { + frame .f + grid location .f 10 10 +} -cleanup { + grid_reset 6.5 +} -result {-1 -1} +test grid-6.6 {location (x)} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f update @@ -311,11 +297,11 @@ test grid-6.6 {location (x)} { set got $a } } - set result -} {{-10->-1 0} {0->0 0} {201->1 0}} -grid_reset 6.6 - -test grid-6.7 {location (y)} { + return $result +} -cleanup { + grid_reset 6.6 +} -result {{-10->-1 0} {0->0 0} {201->1 0}} +test grid-6.7 {location (y)} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f update @@ -328,11 +314,11 @@ test grid-6.7 {location (y)} { set got $a } } - set result -} {{-10->0 -1} {0->0 0} {101->0 1}} -grid_reset 6.7 - -test grid-6.8 {location (weights)} { + return $result +} -cleanup { + grid_reset 6.7 +} -result {{-10->0 -1} {0->0 0} {101->0 1}} +test grid-6.8 {location (weights)} -body { frame .f -width 300 -height 100 -highlightthickness 0 -bg red frame .a grid .a @@ -351,47 +337,50 @@ test grid-6.8 {location (weights)} { set got $a } } - set result -} {{-10->-1 -1} {0->0 0} {16->0 1} {201->1 1}} -grid_reset 6.8 - -test grid-6.9 {location: check updates pending} {nonPortable} { - set a "" - foreach i {0 1 2} { - frame .$i -width 120 -height 75 -bg red - lappend a [grid location . 150 90] - grid .$i -row $i -column $i - } - set a -} {{0 0} {1 1} {1 1}} -grid_reset 6.9 - -test grid-7.1 {propagate} { - list [catch {grid propagate . 1 xxx} msg] $msg -} {1 {wrong # args: should be "grid propagate window ?boolean?"}} -grid_reset 7.1 - -test grid-7.2 {propagate} { - list [catch {grid propagate .} msg] $msg -} {0 1} -grid_reset 7.2 - -test grid-7.3 {propagate} { - list [catch {grid propagate . 0;grid propagate .} msg] $msg -} {0 0} -grid_reset 7.3 - -test grid-7.4 {propagate} { - list [catch {grid propagate .x} msg] $msg -} {1 {bad window path name ".x"}} -grid_reset 7.4 - -test grid-7.5 {propagate} { - list [catch {grid propagate . x} msg] $msg -} {1 {expected boolean value but got "x"}} -grid_reset 7.5 - -test grid-7.6 {propagate} { + return $result +} -cleanup { + grid_reset 6.8 +} -result {{-10->-1 -1} {0->0 0} {16->0 1} {201->1 1}} +test grid-6.9 {location: check updates pending} -constraints { + nonPortable +} -body { + set a "" + foreach i {0 1 2} { + frame .$i -width 120 -height 75 -bg red + lappend a [grid location . 150 90] + grid .$i -row $i -column $i + } + return $a +} -cleanup { + grid_reset 6.9 +} -result {{0 0} {1 1} {1 1}} + +test grid-7.1 {propagate} -body { + grid propagate . 1 xxx +} -cleanup { + grid_reset 7.1 +} -returnCodes error -result {wrong # args: should be "grid propagate window ?boolean?"} +test grid-7.2 {propagate} -body { + grid propagate . +} -cleanup { + grid_reset 7.2 +} -result {1} +test grid-7.3 {propagate} -body { + grid propagate . 0;grid propagate . +} -cleanup { + grid_reset 7.3 +} -result {0} +test grid-7.4 {propagate} -body { + grid propagate .x +} -cleanup { + grid_reset 7.4 +} -returnCodes error -result {bad window path name ".x"} +test grid-7.5 {propagate} -body { + grid propagate . x +} -cleanup { + grid_reset 7.5 +} -returnCodes error -result {expected boolean value but got "x"} +test grid-7.6 {propagate} -body { frame .f -width 100 -height 100 -bg red grid .f -row 0 -column 0 update @@ -404,37 +393,39 @@ test grid-7.6 {propagate} { grid propagate .f 1 update lappend a [winfo width .f]x[winfo height .f] - set a -} {100x100 100x100 75x85} -grid_reset 7.6 -test grid-7.7 {propagate} { + return $a +} -cleanup { + grid_reset 7.6 +} -result {100x100 100x100 75x85} +test grid-7.7 {propagate} -body { grid propagate . 1 set res [list [grid propagate .]] grid propagate . 0 lappend res [grid propagate .] grid propagate . 0 lappend res [grid propagate .] - set res -} [list 1 0 0] -grid_reset 7.7 - -test grid-8.1 {size} { - list [catch {grid size . foo} msg] $msg -} {1 {wrong # args: should be "grid size window"}} -grid_reset 8.1 - -test grid-8.2 {size} { - list [catch {grid size .x} msg] $msg -} {1 {bad window path name ".x"}} -grid_reset 8.2 - -test grid-8.3 {size} { + return $res +} -cleanup { + grid_reset 7.7 +} -result [list 1 0 0] + +test grid-8.1 {size} -body { + grid size . foo +} -cleanup { + grid_reset 8.1 +} -returnCodes error -result {wrong # args: should be "grid size window"} +test grid-8.2 {size} -body { + grid size .x +} -cleanup { + grid_reset 8.2 +} -returnCodes error -result {bad window path name ".x"} +test grid-8.3 {size} -body { frame .f - list [catch {grid size .f} msg] $msg -} {0 {0 0}} -grid_reset 8.3 - -test grid-8.4 {size} { + grid size .f +} -cleanup { + grid_reset 8.3 +} -result {0 0} +test grid-8.4 {size} -body { catch {unset a} scale .f grid .f -row 0 -column 0 @@ -449,11 +440,11 @@ test grid-8.4 {size} { grid .f -row 0 -column 0 update lappend a [grid size .] - set a -} {{1 1} {6 5} {664 948} {1 1}} -grid_reset 8.4 - -test grid-8.5 {size} { + return $a +} -cleanup { + grid_reset 8.4 +} -result {{1 1} {6 5} {664 948} {1 1}} +test grid-8.5 {size} -body { catch {unset a} scale .f grid .f -row 0 -column 0 @@ -469,11 +460,11 @@ test grid-8.5 {size} { grid rowconfigure . 17 -weight 0 update lappend a [grid size .] - set a -} {{1 1} {1 18} {64 18} {1 1}} -grid_reset 8.5 - -test grid-8.6 {size} { + return $a +} -cleanup { + grid_reset 8.5 +} -result {{1 1} {1 18} {64 18} {1 1}} +test grid-8.6 {size} -body { catch {unset a} scale .f grid .f -row 10 -column 50 @@ -495,56 +486,48 @@ test grid-8.6 {size} { grid columnconfigure . 15 -weight 0 update lappend a [grid size .] - set a -} {{51 11} {51 11} {31 11} {21 11} {16 1} {1 1}} -grid_reset 8.6 - -test grid-9.1 {slaves} { - list [catch {grid slaves .} msg] $msg -} {0 {}} + return $a +} -cleanup { + grid_reset 8.6 +} -result {{51 11} {51 11} {31 11} {21 11} {16 1} {1 1}} -test grid-9.2 {slaves} { - list [catch {grid slaves .foo} msg] $msg -} {1 {bad window path name ".foo"}} - -test grid-9.3 {slaves} { - list [catch {grid slaves a b} msg] $msg -} {1 {wrong # args: should be "grid slaves window ?-option value...?"}} - -test grid-9.4 {slaves} { - list [catch {grid slaves . a b} msg] $msg -} {1 {bad option "a": must be -column or -row}} - -test grid-9.5 {slaves} { - list [catch {grid slaves . -column x} msg] $msg -} {1 {expected integer but got "x"}} - -test grid-9.6 {slaves} { - list [catch {grid slaves . -row -3} msg] $msg -} {1 {-row is an invalid value: should NOT be < 0}} - -test grid-9.7 {slaves} { - list [catch {grid slaves . -foo 3} msg] $msg -} {1 {bad option "-foo": must be -column or -row}} - -test grid-9.8 {slaves} { - list [catch {grid slaves .x -row 3} msg] $msg -} {1 {bad window path name ".x"}} - -test grid-9.9 {slaves} { - list [catch {grid slaves . -row 3} msg] $msg -} {0 {}} - -test grid-9.10 {slaves} { - foreach i {0 1 2} { - label .$i -text $i - grid .$i -row $i -column $i - } - list [catch {grid slaves .} msg] $msg -} {0 {.2 .1 .0}} -grid_reset 9.10 - -test grid-9.11 {slaves} { +test grid-9.1 {slaves} -body { + grid slaves . +} -returnCodes ok -result {} +test grid-9.2 {slaves} -body { + grid slaves .foo +} -returnCodes error -result {bad window path name ".foo"} +test grid-9.3 {slaves} -body { + grid slaves a b +} -returnCodes error -result {wrong # args: should be "grid slaves window ?-option value ...?"} +test grid-9.4 {slaves} -body { + grid slaves . a b +} -returnCodes error -result {bad option "a": must be -column or -row} +test grid-9.5 {slaves} -body { + grid slaves . -column x +} -returnCodes error -result {expected integer but got "x"} +test grid-9.6 {slaves} -body { + grid slaves . -row -3 +} -returnCodes error -result {-3 is an invalid value: should NOT be < 0} +test grid-9.7 {slaves} -body { + grid slaves . -foo 3 +} -returnCodes error -result {bad option "-foo": must be -column or -row} +test grid-9.8 {slaves} -body { + grid slaves .x -row 3 +} -returnCodes error -result {bad window path name ".x"} +test grid-9.9 {slaves} -body { + grid slaves . -row 3 +} -returnCodes ok -result {} +test grid-9.10 {slaves} -body { + foreach i {0 1 2} { + label .$i -text $i + grid .$i -row $i -column $i + } + grid slaves . +} -cleanup { + grid_reset 9.10 +} -result {.2 .1 .0} +test grid-9.11 {slaves} -body { catch {unset a} foreach i {0 1 2} { label .$i -text $i @@ -558,146 +541,146 @@ test grid-9.11 {slaves} { foreach col {0 1 2 3} { lappend a $col{[grid slaves . -column $col]} } - set a -} {{0{.0-x .0}} {1{.1-x .1}} {2{.2-x .2}} 3{} 0{.0} {1{.1 .0-x}} {2{.2 .1-x}} 3{.2-x}} -grid_reset 9.11 + return $a +} -cleanup { + grid_reset 9.11 +} -result {{0{.0-x .0}} {1{.1-x .1}} {2{.2-x .2}} 3{} 0{.0} {1{.1 .0-x}} {2{.2 .1-x}} 3{.2-x}} # column/row configure - -test grid-10.1 {column/row configure} { - list [catch {grid columnconfigure .} msg] $msg -} {1 {wrong # args: should be "grid columnconfigure master index ?-option value...?"}} -grid_reset 10.1 - -test grid-10.2 {column/row configure} { - list [catch {grid columnconfigure . 0 -weight 0 -pad} msg] $msg -} {1 {wrong # args: should be "grid columnconfigure master index ?-option value...?"}} -grid_reset 10.2 - -test grid-10.3 {column/row configure} { - list [catch {grid columnconfigure .f 0 -weight} msg] $msg -} {1 {bad window path name ".f"}} -grid_reset 10.3 - -test grid-10.4 {column/row configure} { - list [catch {grid columnconfigure . nine -weight} msg] $msg -} {1 {expected integer but got "nine" (when retreiving options only integer indices are allowed)}} -grid_reset 10.4 - -test grid-10.5 {column/row configure} { - list [catch {grid columnconfigure . 265 -weight} msg] $msg -} {0 0} -grid_reset 10.5 - -test grid-10.6 {column/row configure} { - list [catch {grid columnconfigure . 0} msg] $msg -} {0 {-minsize 0 -pad 0 -uniform {} -weight 0}} -grid_reset 10.6 - -test grid-10.7 {column/row configure} { - list [catch {grid columnconfigure . 0 -foo} msg] $msg -} {1 {bad option "-foo": must be -minsize, -pad, -uniform, or -weight}} -grid_reset 10.7 - -test grid-10.8 {column/row configure} { - list [catch {grid columnconfigure . 0 -minsize foo} msg] $msg -} {1 {bad screen distance "foo"}} -grid_reset 10.8 - -test grid-10.9 {column/row configure} { - list [catch {grid columnconfigure . 0 -minsize foo} msg] $msg -} {1 {bad screen distance "foo"}} -grid_reset 10.9 - -test grid-10.10 {column/row configure} { - grid columnconfigure . 0 -minsize 10 - grid columnconfigure . 0 -minsize -} {10} -grid_reset 10.10 - -test grid-10.11 {column/row configure} { - list [catch {grid columnconfigure . 0 -weight bad} msg] $msg -} {1 {expected integer but got "bad"}} -grid_reset 10.11 - -test grid-10.12 {column/row configure} { - list [catch {grid columnconfigure . 0 -weight -3} msg] $msg -} {1 {invalid arg "-weight": should be non-negative}} -grid_reset 10.12 - -test grid-10.13 {column/row configure} { - grid columnconfigure . 0 -weight 3 - grid columnconfigure . 0 -weight -} {3} -grid_reset 10.13 - -test grid-10.14 {column/row configure} { - list [catch {grid columnconfigure . 0 -pad foo} msg] $msg -} {1 {bad screen distance "foo"}} -grid_reset 10.14 - -test grid-10.15 {column/row configure} { - list [catch {grid columnconfigure . 0 -pad -3} msg] $msg -} {1 {invalid arg "-pad": should be non-negative}} -grid_reset 10.15 - -test grid-10.16 {column/row configure} { - grid columnconfigure . 0 -pad 3 - grid columnconfigure . 0 -pad -} {3} -grid_reset 10.16 - -test grid-10.17 {column/row configure} { - frame .f - set a "" - grid columnconfigure .f 0 -weight 0 - lappend a [grid columnconfigure .f 0 -weight] - grid columnconfigure .f 0 -weight 1 - lappend a [grid columnconfigure .f 0 -weight] - grid rowconfigure .f 0 -weight 0 - lappend a [grid rowconfigure .f 0 -weight] - grid rowconfigure .f 0 -weight 1 - lappend a [grid columnconfigure .f 0 -weight] - grid columnconfigure .f 0 -weight 0 - set a -} {0 1 0 1} -grid_reset 10.17 - -test grid-10.18 {column/row configure} { - frame .f - grid columnconfigure .f {0 2} -minsize 10 -weight 1 - list [grid columnconfigure .f 0 -minsize] \ - [grid columnconfigure .f 1 -minsize] \ - [grid columnconfigure .f 2 -minsize] \ - [grid columnconfigure .f 0 -weight] \ - [grid columnconfigure .f 1 -weight] \ - [grid columnconfigure .f 2 -weight] -} {10 0 10 1 0 1} -grid_reset 10.18 - -test grid-10.19 {column/row configure} { - list [catch {grid columnconfigure . {0 -1 2} -weight 1} msg] $msg -} {1 {grid columnconfigure: "-1" is out of range}} -grid_reset 10.19 - -test grid-10.20 {column/row configure} { - grid columnconfigure . 0 -uniform foo - grid columnconfigure . 0 -uniform -} {foo} -grid_reset 10.20 - -test grid-10.21 {column/row configure} { - list [catch {grid columnconfigure . .b -weight 1} msg] $msg -} {1 {grid columnconfigure: illegal index ".b"}} -grid_reset 10.21 - -test grid-10.22 {column/row configure} { +test grid-10.1 {column/row configure} -body { + grid columnconfigure . +} -cleanup { + grid_reset 10.1 +} -returnCodes error -result {wrong # args: should be "grid columnconfigure master index ?-option value ...?"} +test grid-10.2 {column/row configure} -body { + grid columnconfigure . 0 -weight 0 -pad +} -cleanup { + grid_reset 10.2 +} -returnCodes error -result {wrong # args: should be "grid columnconfigure master index ?-option value ...?"} +test grid-10.3 {column/row configure} -body { + grid columnconfigure .f 0 -weight +} -cleanup { + grid_reset 10.3 +} -returnCodes error -result {bad window path name ".f"} +test grid-10.4 {column/row configure} -body { + grid columnconfigure . nine -weight +} -cleanup { + grid_reset 10.4 +} -returnCodes error -result {expected integer but got "nine" (when retrieving options only integer indices are allowed)} +test grid-10.5 {column/row configure} -body { + grid columnconfigure . 265 -weight +} -cleanup { + grid_reset 10.5 +} -result {0} +test grid-10.6 {column/row configure} -body { + grid columnconfigure . 0 +} -cleanup { + grid_reset 10.6 +} -result {-minsize 0 -pad 0 -uniform {} -weight 0} +test grid-10.7 {column/row configure} -body { + grid columnconfigure . 0 -foo +} -cleanup { + grid_reset 10.7 +} -returnCodes error -result {bad option "-foo": must be -minsize, -pad, -uniform, or -weight} +test grid-10.8 {column/row configure} -body { + grid columnconfigure . 0 -minsize foo +} -cleanup { + grid_reset 10.8 +} -returnCodes error -result {bad screen distance "foo"} +test grid-10.9 {column/row configure} -body { + grid columnconfigure . 0 -minsize foo +} -cleanup { + grid_reset 10.9 +} -returnCodes error -result {bad screen distance "foo"} +test grid-10.10 {column/row configure} -body { + grid columnconfigure . 0 -minsize 10 + grid columnconfigure . 0 -minsize +} -cleanup { + grid_reset 10.10 +} -result {10} +test grid-10.11 {column/row configure} -body { + grid columnconfigure . 0 -weight bad +} -cleanup { + grid_reset 10.11 +} -returnCodes error -result {expected integer but got "bad"} +test grid-10.12 {column/row configure} -body { + grid columnconfigure . 0 -weight -3 +} -cleanup { + grid_reset 10.12 +} -returnCodes error -result {invalid arg "-weight": should be non-negative} +test grid-10.13 {column/row configure} -body { + grid columnconfigure . 0 -weight 3 + grid columnconfigure . 0 -weight +} -cleanup { + grid_reset 10.13 +} -result {3} +test grid-10.14 {column/row configure} -body { + grid columnconfigure . 0 -pad foo +} -cleanup { + grid_reset 10.14 +} -returnCodes error -result {bad screen distance "foo"} +test grid-10.15 {column/row configure} -body { + grid columnconfigure . 0 -pad -3 +} -cleanup { + grid_reset 10.15 +} -returnCodes error -result {invalid arg "-pad": should be non-negative} +test grid-10.16 {column/row configure} -body { + grid columnconfigure . 0 -pad 3 + grid columnconfigure . 0 -pad +} -cleanup { + grid_reset 10.16 +} -result {3} +test grid-10.17 {column/row configure} -body { + frame .f + set a "" + grid columnconfigure .f 0 -weight 0 + lappend a [grid columnconfigure .f 0 -weight] + grid columnconfigure .f 0 -weight 1 + lappend a [grid columnconfigure .f 0 -weight] + grid rowconfigure .f 0 -weight 0 + lappend a [grid rowconfigure .f 0 -weight] + grid rowconfigure .f 0 -weight 1 + lappend a [grid columnconfigure .f 0 -weight] + grid columnconfigure .f 0 -weight 0 + return $a +} -cleanup { + grid_reset 10.17 +} -result {0 1 0 1} +test grid-10.18 {column/row configure} -body { + frame .f + grid columnconfigure .f {0 2} -minsize 10 -weight 1 + list [grid columnconfigure .f 0 -minsize] \ + [grid columnconfigure .f 1 -minsize] \ + [grid columnconfigure .f 2 -minsize] \ + [grid columnconfigure .f 0 -weight] \ + [grid columnconfigure .f 1 -weight] \ + [grid columnconfigure .f 2 -weight] +} -cleanup { + grid_reset 10.18 +} -result {10 0 10 1 0 1} +test grid-10.19 {column/row configure} -body { + grid columnconfigure . {0 -1 2} -weight 1 +} -cleanup { + grid_reset 10.19 +} -returnCodes error -result {"-1" is out of range} +test grid-10.20 {column/row configure} -body { + grid columnconfigure . 0 -uniform foo + grid columnconfigure . 0 -uniform +} -cleanup { + grid_reset 10.20 +} -result {foo} +test grid-10.21 {column/row configure} -body { + grid columnconfigure . .b -weight 1 +} -cleanup { + grid_reset 10.21 +} -returnCodes error -result {illegal index ".b"} +test grid-10.22 {column/row configure} -body { button .b - list [catch {grid columnconfigure . .b -weight 1} msg] $msg -} {1 {grid columnconfigure: the window ".b" is not managed by "."}} -grid_reset 10.22 - -test grid-10.23 {column/row configure} { + grid columnconfigure . .b -weight 1 +} -cleanup { + grid_reset 10.22 +} -returnCodes error -result {the window ".b" is not managed by "."} +test grid-10.23 {column/row configure} -body { button .b grid .b -column 1 -columnspan 2 grid columnconfigure . .b -weight 1 @@ -705,11 +688,11 @@ test grid-10.23 {column/row configure} { foreach i {0 1 2 3} { lappend res [grid columnconfigure . $i -weight] } - set res -} {0 1 1 0} -grid_reset 10.23 - -test grid-10.24 {column/row configure} { + return $res +} -cleanup { + grid_reset 10.23 +} -result {0 1 1 0} +test grid-10.24 {column/row configure} -body { button .b button .c button .d @@ -722,11 +705,11 @@ test grid-10.24 {column/row configure} { foreach i {0 1 2 3 4 5 6} { lappend res [grid columnconfigure . $i -weight] } - set res -} {0 1 2 2 2 1 0} -grid_reset 10.24 - -test grid-10.25 {column/row configure} { + return $res +} -cleanup { + grid_reset 10.24 +} -result {0 1 2 2 2 1 0} +test grid-10.25 {column/row configure} -body { button .b button .c button .d @@ -739,47 +722,42 @@ test grid-10.25 {column/row configure} { foreach i {0 1 2 3 4 5 6 7} { lappend res [grid rowconfigure . $i -weight] } - set res -} {0 2 1 1 2 2 0 1} -grid_reset 10.25 - -test grid-10.26 {column/row configure} { + return $res +} -cleanup { + grid_reset 10.25 +} -result {0 2 1 1 2 2 0 1} +test grid-10.26 {column/row configure} -body { button .b grid columnconfigure .b 0 -} {-minsize 0 -pad 0 -uniform {} -weight 0} -grid_reset 10.26 - -test grid-10.30 {column/row configure - no indices} { +} -cleanup { + grid_reset 10.26 +} -result {-minsize 0 -pad 0 -uniform {} -weight 0} +test grid-10.27 {column/row configure - no indices} -body { # Bug 1422430 set t [toplevel .test] - set res [list [catch {grid columnconfigure $t "" -weight 1} msg] $msg] + grid columnconfigure $t "" -weight 1 +} -cleanup { destroy $t - set res -} {1 {no column indices specified}} - -test grid-10.31 {column/row configure - no indices} { +} -returnCodes error -result {no column indices specified} +test grid-10.28 {column/row configure - no indices} -body { set t [toplevel .test] - set res [list [catch {grid rowconfigure $t "" -weight 1} msg] $msg] + grid rowconfigure $t "" -weight 1 +} -cleanup { destroy $t - set res -} {1 {no row indices specified}} - -test grid-10.32 {column/row configure - invalid indices} { - list [catch {grid columnconfigure . {0 1 2} -weight} msg] $msg -} {1 {grid columnconfigure: must specify a single element on retrieval}} - -test grid-10.33 {column/row configure - invalid indices} { - list [catch {grid rowconfigure . {0 1 2} -weight} msg] $msg -} {1 {grid rowconfigure: must specify a single element on retrieval}} - -test grid-10.34 {column/row configure - empty 'all' configure} { +} -returnCodes error -result {no row indices specified} +test grid-10.29 {column/row configure - invalid indices} -body { + grid columnconfigure . {0 1 2} -weight +} -returnCodes error -result {must specify a single element on retrieval} +test grid-10.30 {column/row configure - invalid indices} -body { + grid rowconfigure . {0 1 2} -weight +} -returnCodes error -result {must specify a single element on retrieval} +test grid-10.31 {column/row configure - empty 'all' configure} -body { # Bug 1422430 set t [toplevel .test] grid rowconfigure $t all -weight 1 destroy $t -} {} - -test grid-10.35 {column/row configure} { +} -result {} +test grid-10.32 {column/row configure} -body { # Test that no lingering message is there frame .f set res [grid columnconfigure .f all -weight 1] @@ -790,21 +768,21 @@ test grid-10.35 {column/row configure} { append res [grid columnconfigure .f {.f.f 1} -weight 1] append res [grid columnconfigure .f {2 .f.f} -weight 1] destroy .f - set res -} {} -grid_reset 10.35 - -test grid-10.36 {column/row configure} { - list [catch {grid columnconfigure . all} msg] $msg -} {1 {expected integer but got "all" (when retreiving options only integer indices are allowed)}} -grid_reset 10.36 - -test grid-10.37 {column/row configure} { - list [catch {grid columnconfigure . 100000} msg] $msg -} {0 {-minsize 0 -pad 0 -uniform {} -weight 0}} -grid_reset 10.37 - -test grid-10.38 {column/row configure} -body { + return $res +} -cleanup { + grid_reset 10.35 +} -result {} +test grid-10.33 {column/row configure} -body { + grid columnconfigure . all +} -cleanup { + grid_reset 10.36 +} -returnCodes error -result {expected integer but got "all" (when retrieving options only integer indices are allowed)} +test grid-10.34 {column/row configure} -body { + grid columnconfigure . 100000 +} -cleanup { + grid_reset 10.37 +} -result {-minsize 0 -pad 0 -uniform {} -weight 0} +test grid-10.35 {column/row configure} -body { # This is a test for bug 1423666 where a column >= 10000 caused # a crash in layout. The update is needed to reach the layout stage. # Test different combinations of row/column overflow @@ -816,18 +794,17 @@ test grid-10.38 {column/row configure} -body { lappend res [catch {grid .f -rowspan 2 -row 9998} msg] $msg ; update lappend res [catch {grid .f -column 9998 -columnspan 2} msg] $msg ; update lappend res [catch {grid .f -row 9998 -rowspan 2} msg] $msg ; update - set res + return $res } -cleanup {destroy .f} -result [lrange { - 1 {Column out of bounds} - 1 {Row out of bounds} - 1 {Column out of bounds} - 1 {Row out of bounds} - 1 {Column out of bounds} - 1 {Row out of bounds} + 1 {column out of bounds} + 1 {row out of bounds} + 1 {column out of bounds} + 1 {row out of bounds} + 1 {column out of bounds} + 1 {row out of bounds} } 0 end] grid_reset 10.38 - -test grid-10.39 {column/row configure} -body { +test grid-10.36 {column/row configure} -body { # Additional tests for row/column overflow frame .f frame .g @@ -840,47 +817,46 @@ test grid-10.39 {column/row configure} -body { grid forget .f .g lappend res [catch {eval grid [string repeat " x " 9999] .f} msg] $msg update - set res + return $res } -cleanup {destroy .f .g} -result [lrange { - 1 {Row out of bounds} - 1 {Row out of bounds} - 1 {Column out of bounds} - 1 {Column out of bounds} + 1 {row out of bounds} + 1 {row out of bounds} + 1 {column out of bounds} + 1 {column out of bounds} } 0 end] grid_reset 10.39 # auto-placement tests - -test grid-11.1 {default widget placement} { - list [catch {grid ^} msg] $msg -} {1 {can't use '^', cant find master}} -grid_reset 11.1 - -test grid-11.2 {default widget placement} { - button .b - list [catch {grid .b ^} msg] $msg -} {1 {can't find slave to extend with "^".}} -grid_reset 11.2 - -test grid-11.3 {default widget placement} { - button .b - list [catch {grid .b - - .c} msg] $msg -} {1 {bad window path name ".c"}} -grid_reset 11.3 - -test grid-11.4 {default widget placement} { - button .b - list [catch {grid .b - - = -} msg] $msg -} {1 {invalid window shortcut, "=" should be '-', 'x', or '^'}} -grid_reset 11.4 - -test grid-11.5 {default widget placement} { - button .b - list [catch {grid .b - x -} msg] $msg -} {1 {Must specify window before shortcut '-'.}} -grid_reset 11.5 - -test grid-11.6 {default widget placement} { +test grid-11.1 {default widget placement} -body { + grid ^ +} -cleanup { + grid_reset 11.1 +} -returnCodes error -result {can't use '^', cant find master} +test grid-11.2 {default widget placement} -body { + button .b + grid .b ^ +} -cleanup { + grid_reset 11.2 +} -returnCodes error -result {can't find slave to extend with "^"} +test grid-11.3 {default widget placement} -body { + button .b + grid .b - - .c +} -cleanup { + grid_reset 11.3 +} -returnCodes error -result {bad window path name ".c"} +test grid-11.4 {default widget placement} -body { + button .b + grid .b - - = - +} -cleanup { + grid_reset 11.4 +} -returnCodes error -result {invalid window shortcut, "=" should be '-', 'x', or '^'} +test grid-11.5 {default widget placement} -body { + button .b + grid .b - x - +} -cleanup { + grid_reset 11.5 +} -returnCodes error -result {must specify window before shortcut '-'} +test grid-11.6 {default widget placement} -body { foreach i {1 2 3 4 5 6} { frame .f$i -width 50 -height 50 -highlightthickness 0 -bg red } @@ -892,34 +868,34 @@ test grid-11.6 {default widget placement} { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a -} {{0,50 100,50} {150,50 50,50}} -grid_reset 11.6 - -test grid-11.7 {default widget placement} { + return $a +} -cleanup { + grid_reset 11.6 +} -result {{0,50 100,50} {150,50 50,50}} +test grid-11.7 {default widget placement} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -row 5 -column 5 - list [catch "grid .f x -" msg] $msg -} {1 {Must specify window before shortcut '-'.}} -grid_reset 11.7 - -test grid-11.8 {default widget placement} { + grid .f x - +} -cleanup { + grid_reset 11.7 +} -returnCodes error -result {must specify window before shortcut '-'} +test grid-11.8 {default widget placement} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -row 5 -column 5 - list [catch "grid .f ^ -" msg] $msg -} {1 {Must specify window before shortcut '-'.}} -grid_reset 11.8 - -test grid-11.9 {default widget placement} { + grid .f ^ - +} -cleanup { + grid_reset 11.8 +} -returnCodes error -result {must specify window before shortcut '-'} +test grid-11.9 {default widget placement} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid .f -row 5 -column 5 - list [catch "grid .f x ^" msg] $msg -} {1 {can't find slave to extend with "^".}} -grid_reset 11.9 - -test grid-11.10 {default widget placement} { + grid .f x ^ +} -cleanup { + grid_reset 11.9 +} -returnCodes error -result {can't find slave to extend with "^"} +test grid-11.10 {default widget placement} -body { foreach i {1 2 3} { - frame .f$i -width 100 -height 50 -highlightthickness 0 -bg red + frame .f$i -width 100 -height 50 -highlightthickness 0 -bg red } grid .f1 .f2 -sticky nsew grid .f3 ^ -sticky nsew @@ -929,54 +905,54 @@ test grid-11.10 {default widget placement} { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a -} {{0,0 100,50} {100,0 100,100} {0,50 100,50}} -grid_reset 11.10 - -test grid-11.11 {default widget placement} { + return $a +} -cleanup { + grid_reset 11.10 +} -result {{0,0 100,50} {100,0 100,100} {0,50 100,50}} +test grid-11.11 {default widget placement} -body { foreach i {1 2 3 4 5 6 7 8 9 10 11 12} { - frame .f$i -width 50 -height 50 -highlightthickness 1 -highlightbackground black + frame .f$i -width 50 -height 50 -highlightthickness 1 -highlightbackground black } - grid .f1 .f2 .f3 .f4 -sticky nsew + grid .f1 .f2 .f3 .f4 -sticky nsew grid .f5 .f6 - .f7 -sticky nsew grid .f8 ^ ^ .f9 -sticky nsew - grid .f10 ^ ^ .f11 -sticky nsew - grid .f12 - - - -sticky nsew + grid .f10 ^ ^ .f11 -sticky nsew + grid .f12 - - - -sticky nsew update set a "" foreach i {5 6 7 8 9 10 11 12 } { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a -} {{0,50 50,50} {50,50 100,150} {150,50 50,50} {0,100 50,50} {150,100 50,50} {0,150 50,50} {150,150 50,50} {0,200 200,50}} -grid_reset 11.11 - -test grid-11.12 {default widget placement} { + return $a +} -cleanup { + grid_reset 11.11 +} -result {{0,50 50,50} {50,50 100,150} {150,50 50,50} {0,100 50,50} {150,100 50,50} {0,150 50,50} {150,150 50,50} {0,200 200,50}} +test grid-11.12 {default widget placement} -body { foreach i {1 2 3 4} { - frame .f$i -width 75 -height 50 -highlightthickness 1 -highlightbackground black + frame .f$i -width 75 -height 50 -highlightthickness 1 -highlightbackground black } grid .f1 .f2 .f3 -sticky nsew grid .f4 ^ -sticky nsew update set a "" foreach i {1 2 3 4} { - lappend a "[winfo x .f$i],[winfo y .f$i] \ - [winfo width .f$i],[winfo height .f$i]" + lappend a "[winfo x .f$i],[winfo y .f$i] \ + [winfo width .f$i],[winfo height .f$i]" } grid .f4 ^ -column 1 update foreach i {1 2 3 4} { - lappend a "[winfo x .f$i],[winfo y .f$i] \ - [winfo width .f$i],[winfo height .f$i]" - } - set a -} {{0,0 75,50} {75,0 75,100} {150,0 75,50} {0,50 75,50} {0,0 75,50} {75,0 75,100} {150,0 75,100} {75,50 75,50}} -grid_reset 11.12 - -test grid-11.13 {default widget placement} { + lappend a "[winfo x .f$i],[winfo y .f$i] \ + [winfo width .f$i],[winfo height .f$i]" + } + return $a +} -cleanup { + grid_reset 11.12 +} -result {{0,0 75,50} {75,0 75,100} {150,0 75,50} {0,50 75,50} {0,0 75,50} {75,0 75,100} {150,0 75,100} {75,50 75,50}} +test grid-11.13 {default widget placement} -body { foreach i {1 2 3 4 5 6 7} { - frame .f$i -width 40 -height 50 -highlightthickness 1 -highlightbackground black + frame .f$i -width 40 -height 50 -highlightthickness 1 -highlightbackground black } grid .f1 .f2 .f3 .f4 .f5 -sticky nsew grid .f6 - .f7 -sticky nsew -columnspan 2 @@ -986,11 +962,11 @@ test grid-11.13 {default widget placement} { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a -} {{0,50 120,50} {120,50 80,50}} -grid_reset 11.13 - -test grid-11.14 {default widget placement} { + return $a +} -cleanup { + grid_reset 11.13 +} -result {{0,50 120,50} {120,50 80,50}} +test grid-11.14 {default widget placement} -body { foreach i {1 2 3} { frame .f$i -width 60 -height 60 -highlightthickness 0 -bg red } @@ -1002,11 +978,11 @@ test grid-11.14 {default widget placement} { lappend a "[winfo x .f$i],[winfo y .f$i] \ [winfo width .f$i],[winfo height .f$i]" } - set a -} {{0,30 60,60} {60,0 60,60} {60,60 60,60}} -grid_reset 11.14 - -test grid-11.15 {^ ^ test with multiple windows} { + return $a +} -cleanup { + grid_reset 11.14 +} -result {{0,30 60,60} {60,0 60,60} {60,60 60,60}} +test grid-11.15 {^ ^ test with multiple windows} -body { foreach i {1 2 3 4} { frame .f$i -width 50 -height 50 -bd 1 -relief solid } @@ -1018,25 +994,25 @@ test grid-11.15 {^ ^ test with multiple windows} { lappend a "[winfo x .f$i],[winfo y .f$i]\ [winfo width .f$i],[winfo height .f$i]" } - set a -} {{0,0 50,50} {50,0 50,100} {100,0 50,100} {0,50 50,50}} -grid_reset 11.15 - -test grid-11.16 {default widget placement} { + return $a +} -cleanup { + grid_reset 11.15 +} -result {{0,0 50,50} {50,0 50,100} {100,0 50,100} {0,50 50,50}} +test grid-11.16 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 } - grid .a .b .c .d -sticky news + grid .a .b .c .d -sticky news grid x ^ x .e -sticky news update set res "" lappend res [winfo height .a] lappend res [winfo height .b] lappend res [winfo height .c] -} {50 100 50} -grid_reset 11.16 - -test grid-11.17 {default widget placement} { +} -cleanup { + grid_reset 11.16 +} -result {50 100 50} +test grid-11.17 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 } @@ -1047,10 +1023,10 @@ test grid-11.17 {default widget placement} { lappend res [winfo height .a] lappend res [winfo height .b] lappend res [winfo height .c] -} {100 50 100} -grid_reset 11.17 - -test grid-11.18 {default widget placement} { +} -cleanup { + grid_reset 11.17 +} -result {100 50 100} +test grid-11.18 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 } @@ -1063,10 +1039,10 @@ test grid-11.18 {default widget placement} { lappend res [winfo height .b] lappend res [winfo height .c] lappend res [winfo height .d] -} {100 100 100 50} -grid_reset 11.18 - -test grid-11.19 {default widget placement} { +} -cleanup { + grid_reset 11.18 +} -result {100 100 100 50} +test grid-11.19 {default widget placement} -body { foreach l {a b c d e} { frame .$l -width 50 -height 50 } @@ -1074,7 +1050,6 @@ test grid-11.19 {default widget placement} { grid .c .d -sticky news grid ^ -in . -row 2 grid x ^ -in . -row 1 - grid rowconfigure . {0 1 2} -uniform a update set res "" @@ -1082,10 +1057,11 @@ test grid-11.19 {default widget placement} { lappend res [winfo height .b] lappend res [winfo height .c] lappend res [winfo height .d] -} {50 100 100 50} -grid_reset 11.19 +} -cleanup { + grid_reset 11.19 +} -result {50 100 100 50} -test grid-12.1 {-sticky} { +test grid-12.1 {-sticky} -body { catch {unset data} frame .f -width 200 -height 100 -highlightthickness 0 -bg red set a "" @@ -1100,8 +1076,10 @@ test grid-12.1 {-sticky} { array set data [grid info .f] append a "($data(-sticky)) [winfo x .f] [winfo y .f] [winfo width .f] [winfo height .f]\n" } - set a -} {() 25 25 200 100 + return $a +} -cleanup { + grid_reset 12.1 +} -result {() 25 25 200 100 (n) 25 0 200 100 (s) 25 50 200 100 (e) 50 25 200 100 @@ -1118,63 +1096,62 @@ test grid-12.1 {-sticky} { (new) 0 0 250 100 (nesw) 0 0 250 150 } -grid_reset 12.1 - -test grid-12.2 {-sticky} { +test grid-12.2 {-sticky} -body { frame .f -bg red - list [catch "grid .f -sticky glue" msg] $msg -} {1 {bad stickyness value "glue": must be a string containing n, e, s, and/or w}} -grid_reset 12.2 - -test grid-12.3 {-sticky} { + grid .f -sticky glue +} -cleanup { + grid_reset 12.2 +} -returnCodes error -result {bad stickyness value "glue": must be a string containing n, e, s, and/or w} +test grid-12.3 {-sticky} -body { frame .f -bg red grid .f -sticky {n,s,e,w} array set A [grid info .f] set A(-sticky) -} {nesw} -grid_reset 12.3 +} -cleanup { + grid_reset 12.3 +} -result {nesw} -test grid-13.1 {-in} { +test grid-13.1 {-in} -body { frame .f -bg red - list [catch "grid .f -in .f" msg] $msg -} {1 {Window can't be managed in itself}} -grid_reset 13.1 - -test grid-13.1.1 {-in} { + grid .f -in .f +} -cleanup { + grid_reset 13.1 +} -returnCodes error -result {window can't be managed in itself} +test grid-13.2 {-in} -body { frame .f -bg red list [winfo manager .f] \ [catch {grid .f -in .f} err] $err \ [winfo manager .f] -} {{} 1 {Window can't be managed in itself} {}} -grid_reset 13.1.1 - -test grid-13.2 {-in} { +} -cleanup { + grid_reset 13.1.1 +} -result {{} 1 {window can't be managed in itself} {}} +test grid-13.3 {-in} -body { frame .f -bg red - list [catch "grid .f -in .bad" msg] $msg -} {1 {bad window path name ".bad"}} -grid_reset 13.2 - -test grid-13.3 {-in} { + grid .f -in .bad +} -cleanup { + grid_reset 13.2 +} -returnCodes error -result {bad window path name ".bad"} +test grid-13.4 {-in} -body { frame .f -bg red toplevel .top - list [catch "grid .f -in .top" msg] $msg -} {1 {can't put .f inside .top}} + grid .f -in .top +} -cleanup { + grid_reset 13.3 +} -returnCodes error -result {can't put .f inside .top} destroy .top -grid_reset 13.3 - -test grid-13.4 {-ipadx} { +test grid-13.5 {-ipadx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red - list [catch "grid .f -ipadx x" msg] $msg -} {1 {bad ipadx value "x": must be positive screen distance}} -grid_reset 13.4 - -test grid-13.4.1 {-ipadx} { + grid .f -ipadx x +} -cleanup { + grid_reset 13.4 +} -returnCodes error -result {bad ipadx value "x": must be positive screen distance} +test grid-13.6 {-ipadx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red - list [catch "grid .f -ipadx {5 5}" msg] $msg -} {1 {bad ipadx value "5 5": must be positive screen distance}} -grid_reset 13.4.1 - -test grid-13.5 {-ipadx} { + grid .f -ipadx {5 5} +} -cleanup { + grid_reset 13.4.1 +} -returnCodes error -result {bad ipadx value "5 5": must be positive screen distance} +test grid-13.7 {-ipadx} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f update @@ -1182,22 +1159,22 @@ test grid-13.5 {-ipadx} { grid .f -ipadx 1 update list $a [winfo width .f] -} {200 202} -grid_reset 13.5 - -test grid-13.6 {-ipady} { +} -cleanup { + grid_reset 13.5 +} -result {200 202} +test grid-13.8 {-ipady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red - list [catch "grid .f -ipady x" msg] $msg -} {1 {bad ipady value "x": must be positive screen distance}} -grid_reset 13.6 - -test grid-13.6.1 {-ipady} { + grid .f -ipady x +} -cleanup { + grid_reset 13.6 +} -returnCodes error -result {bad ipady value "x": must be positive screen distance} +test grid-13.9 {-ipady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red - list [catch "grid .f -ipady {5 5}" msg] $msg -} {1 {bad ipady value "5 5": must be positive screen distance}} -grid_reset 13.6.1 - -test grid-13.7 {-ipady} { + grid .f -ipady {5 5} +} -cleanup { + grid_reset 13.6.1 +} -returnCodes error -result {bad ipady value "5 5": must be positive screen distance} +test grid-13.10 {-ipady} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f update @@ -1205,22 +1182,22 @@ test grid-13.7 {-ipady} { grid .f -ipady 1 update list $a [winfo height .f] -} {100 102} -grid_reset 13.7 - -test grid-13.8 {-padx} { +} -cleanup { + grid_reset 13.7 +} -result {100 102} +test grid-13.11 {-padx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red - list [catch "grid .f -padx x" msg] $msg -} {1 {bad pad value "x": must be positive screen distance}} -grid_reset 13.8 - -test grid-13.8.1 {-padx} { + grid .f -padx x +} -cleanup { + grid_reset 13.8 +} -returnCodes error -result {bad pad value "x": must be positive screen distance} +test grid-13.12 {-padx} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red - list [catch "grid .f -padx {10 x}" msg] $msg -} {1 {bad 2nd pad value "x": must be positive screen distance}} -grid_reset 13.8.1 - -test grid-13.9 {-padx} { + grid .f -padx {10 x} +} -cleanup { + grid_reset 13.8.1 +} -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance} +test grid-13.13 {-padx} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f update @@ -1228,10 +1205,10 @@ test grid-13.9 {-padx} { grid .f -padx 1 update list $a "[winfo width .f] [winfo width .] [winfo x .f]" -} {{200 200} {200 202 1}} -grid_reset 13.9 - -test grid-13.9.1 {-padx} { +} -cleanup { + grid_reset 13.9 +} -result {{200 200} {200 202 1}} +test grid-13.14 {-padx} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f update @@ -1239,22 +1216,22 @@ test grid-13.9.1 {-padx} { grid .f -padx {10 5} update list $a "[winfo width .f] [winfo width .] [winfo x .f]" -} {{200 200} {200 215 10}} -grid_reset 13.9.1 - -test grid-13.10 {-pady} { +} -cleanup { + grid_reset 13.9.1 +} -result {{200 200} {200 215 10}} +test grid-13.15 {-pady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red - list [catch "grid .f -pady x" msg] $msg -} {1 {bad pad value "x": must be positive screen distance}} -grid_reset 13.10 - -test grid-13.10.1 {-pady} { + grid .f -pady x +} -cleanup { + grid_reset 13.10 +} -returnCodes error -result {bad pad value "x": must be positive screen distance} +test grid-13.16 {-pady} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red - list [catch "grid .f -pady {10 x}" msg] $msg -} {1 {bad 2nd pad value "x": must be positive screen distance}} -grid_reset 13.10.1 - -test grid-13.11 {-pady} { + grid .f -pady {10 x} +} -cleanup { + grid_reset 13.10.1 +} -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance} +test grid-13.17 {-pady} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f update @@ -1262,10 +1239,10 @@ test grid-13.11 {-pady} { grid .f -pady 1 update list $a "[winfo height .f] [winfo height .] [winfo y .f]" -} {{100 100} {100 102 1}} -grid_reset 13.11 - -test grid-13.11.1 {-pady} { +} -cleanup { + grid_reset 13.11 +} -result {{100 100} {100 102 1}} +test grid-13.18 {-pady} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red grid .f update @@ -1273,29 +1250,29 @@ test grid-13.11.1 {-pady} { grid .f -pady {4 16} update list $a "[winfo height .f] [winfo height .] [winfo y .f]" -} {{100 100} {100 120 4}} -grid_reset 13.11.1 - -test grid-13.12 {-ipad x and y} { +} -cleanup { + grid_reset 13.11.1 +} -result {{100 100} {100 120 4}} +test grid-13.19 {-ipad x and y} -body { frame .f -width 20 -height 20 -highlightthickness 0 -bg red grid columnconfigure . 0 -minsize 150 grid rowconfigure . 0 -minsize 100 set a "" foreach x {0 5} { - foreach y {0 5} { + foreach y {0 5} { grid .f -ipadx $x -ipady $y update append a " $x,$y:" foreach prop {x y width height} { - append a ,[winfo $prop .f] + append a ,[winfo $prop .f] } } } - set a -} { 0,0:,65,40,20,20 0,5:,65,35,20,30 5,0:,60,40,30,20 5,5:,60,35,30,30} -grid_reset 13.12 - -test grid-13.13 {reparenting} { + return $a +} -cleanup { + grid_reset 13.12 +} -result { 0,0:,65,40,20,20 0,5:,65,35,20,30 5,0:,60,40,30,20 5,5:,60,35,30,30} +test grid-13.20 {reparenting} -body { frame .1 frame .2 button .b @@ -1308,15 +1285,16 @@ test grid-13.13 {reparenting} { catch {unset info}; array set info [grid info .b] lappend a [grid slaves .1],[grid slaves .2],$info(-in) unset info - set a -} {.b,,.1 ,.b,.2} -grid_reset 13.13 + return $a +} -cleanup { + grid_reset 13.13 +} -result {.b,,.1 ,.b,.2} -test grid-14.1 {structure notify} { +test grid-14.1 {structure notify} -body { frame .f -width 200 -height 100 -highlightthickness 0 -bg red frame .g -width 200 -height 100 -highlightthickness 0 -bg red - grid .f - grid .g -in .f + grid .f + grid .g -in .f update set a "" lappend a "[winfo x .g],[winfo y .g] \ @@ -1325,14 +1303,14 @@ test grid-14.1 {structure notify} { update lappend a "[winfo x .g],[winfo y .g] \ [winfo width .g],[winfo height .g]" - set a -} {{0,0 200,100} {5,5 200,100}} -grid_reset 14.1 - -test grid-14.2 {structure notify} { - frame .f -width 200 -height 100 - frame .f.g -width 200 -height 100 - grid .f + return $a +} -cleanup { + grid_reset 14.1 +} -result {{0,0 200,100} {5,5 200,100}} +test grid-14.2 {structure notify} -body { + frame .f -width 200 -height 100 + frame .f.g -width 200 -height 100 + grid .f grid .f.g update set a "" @@ -1340,10 +1318,10 @@ test grid-14.2 {structure notify} { .f config -bd 20 update lappend a [grid bbox .],[grid bbox .f] -} {{0 0 200 100,0 0 200 100} {0 0 240 140,20 20 200 100}} -grid_reset 14.2 - -test grid-14.3 {map notify: bug 1648} {nonPortable} { +} -cleanup { + grid_reset 14.2 +} -result {{0 0 200 100,0 0 200 100} {0 0 240 140,20 20 200 100}} +test grid-14.3 {map notify: bug 1648} -constraints {nonPortable} -body { # This test is nonPortable because the number of times # A(.) will be incremented is unspecified--the behavior # is different accross window managers. @@ -1362,10 +1340,11 @@ test grid-14.3 {map notify: bug 1648} {nonPortable} { update bind . <Configure> {} array get A -} {.2 2 .0 1 . 2 .1 1} -grid_reset 14.3 +} -cleanup { + grid_reset 14.3 +} -result {.2 2 .0 1 . 2 .1 1} -test grid-15.1 {lost slave} { +test grid-15.1 {lost slave} -body { button .b grid .b set a [grid slaves .] @@ -1373,41 +1352,42 @@ test grid-15.1 {lost slave} { lappend a [grid slaves .] grid .b lappend a [grid slaves .] -} {.b {} .b} -grid_reset 15.1 - -test grid-15.2 {lost slave} { +} -cleanup { + grid_reset 15.1 +} -result {.b {} .b} +test grid-15.2 {lost slave} -body { frame .f grid .f button .b grid .b -in .f set a [grid slaves .f] - pack .b + pack .b -in .f lappend a [grid slaves .f] grid .b -in .f lappend a [grid slaves .f] -} {.b {} .b} -grid_reset 15.2 +} -cleanup { + grid_reset 15.2 +} -result {.b {} .b} -test grid-16.1 {layout centering} { +test grid-16.1 {layout centering} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 grid anchor . center . configure -width 300 -height 250 update grid bbox . -} {37 50 225 150} -grid_reset 16.1 - -test grid-16.2 {layout weights (expanding)} { +} -cleanup { + grid_reset 16.1 +} -result {37 50 225 150} +test grid-16.2 {layout weights (expanding)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] - grid columnconfigure . $i -weight [expr $i + 1] + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] + grid columnconfigure . $i -weight [expr $i + 1] } grid propagate . 0 . configure -width 500 -height 300 @@ -1416,16 +1396,16 @@ test grid-16.2 {layout weights (expanding)} { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a -} {120-75 167-100 213-125} -grid_reset 16.2 - -test grid-16.3 {layout weights (shrinking)} { + return $a +} -cleanup { + grid_reset 16.2 +} -result {120-75 167-100 213-125} +test grid-16.3 {layout weights (shrinking)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] - grid columnconfigure . $i -weight [expr $i + 1] + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] + grid columnconfigure . $i -weight [expr $i + 1] } grid propagate . 0 . configure -width 200 -height 150 @@ -1434,16 +1414,16 @@ test grid-16.3 {layout weights (shrinking)} { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a -} {84-63 66-50 50-37} -grid_reset 16.3 - -test grid-16.4 {layout weights (shrinking with minsize)} { + return $a +} -cleanup { + grid_reset 16.3 +} -result {84-63 66-50 50-37} +test grid-16.4 {layout weights (shrinking with minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] -minsize 45 - grid columnconfigure . $i -weight [expr $i + 1] -minsize 65 + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] -minsize 45 + grid columnconfigure . $i -weight [expr $i + 1] -minsize 65 } grid propagate . 0 . configure -width 200 -height 150 @@ -1452,16 +1432,16 @@ test grid-16.4 {layout weights (shrinking with minsize)} { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a -} {70-60 65-45 65-45} -grid_reset 16.4 - -test grid-16.5 {layout weights (shrinking at minsize)} { + return $a +} -cleanup { + grid_reset 16.4 +} -result {70-60 65-45 65-45} +test grid-16.5 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight 0 -minsize 70 - grid columnconfigure . $i -weight 0 -minsize 90 + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight 0 -minsize 70 + grid columnconfigure . $i -weight 0 -minsize 90 } grid propagate . 0 . configure -width 100 -height 75 @@ -1470,17 +1450,16 @@ test grid-16.5 {layout weights (shrinking at minsize)} { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a -} {100-75 100-75 100-75} -grid_reset 16.5 - - -test grid-16.6 {layout weights (shrinking at minsize)} { + return $a +} -cleanup { + grid_reset 16.5 +} -result {100-75 100-75 100-75} +test grid-16.6 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe - grid rowconfigure . $i -weight [expr $i + 1] -minsize 52 - grid columnconfigure . $i -weight [expr $i + 1] -minsize 69 + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe + grid rowconfigure . $i -weight [expr $i + 1] -minsize 52 + grid columnconfigure . $i -weight [expr $i + 1] -minsize 69 } grid propagate . 0 . configure -width 200 -height 150 @@ -1489,32 +1468,38 @@ test grid-16.6 {layout weights (shrinking at minsize)} { foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i] } - set a -} {69-52 69-52 69-52} -grid_reset 16.6 - -test grid-16.7 {layout weights (shrinking at minsize)} { + return $a +} -cleanup { + grid_reset 16.6 +} -result {69-52 69-52 69-52} +# test fails when run alone +# reason (I think): -minsize 0 causes both: +# [winfo ismapped .$i] => 0 and +# not responding for width ang height settings, so that +# [winfo width .$i] [winfo height .$i] take different values +# That doesn't happen if previous tests run +test grid-16.7 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 grid columnconfigure . 1 -weight 1 -minsize 0 grid rowconfigure . 1 -weight 1 -minsize 0 - . configure -width 100 -height 75 + . configure -width 100 -height 1 set a "" update foreach i {0 1 2} { lappend a [winfo width .$i]-[winfo height .$i]-[winfo ismapped .$i] } - set a -} {100-75-1 1-1-0 100-75-1} -grid_reset 16.7 - -test grid-16.8 {layout internal constraints} { + return $a +} -cleanup { + grid_reset 16.7 +} -result {100-75-1 1-1-0 100-75-1} +test grid-16.8 {layout internal constraints} -body { foreach i {0 1 2 3 4} { - frame .$i -bg gray -width 30 -height 25 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 30 -height 25 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } frame .f -bg red -width 250 -height 200 frame .g -bg green -width 200 -height 180 @@ -1525,32 +1510,32 @@ test grid-16.8 {layout internal constraints} { update set a "" foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } append a ", " grid remove .f update foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } append a ", " grid remove .g grid .f update foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } append a ", " grid remove .f update foreach i {0 1 2 3 4} { - append a "[winfo x .$i] " + append a "[winfo x .$i] " } - set a -} {0 30 130 230 280 , 0 30 130 230 260 , 0 30 113 196 280 , 0 30 60 90 120 } -grid_reset 16.8 - -test grid-16.9 {layout uniform} { + return $a +} -cleanup { + grid_reset 16.8 +} -result {0 30 130 230 280 , 0 30 130 230 260 , 0 30 113 196 280 , 0 30 60 90 120 } +test grid-16.9 {layout uniform} -body { frame .f1 -width 75 -height 50 frame .f2 -width 60 -height 25 frame .f3 -width 95 -height 75 @@ -1564,16 +1549,15 @@ test grid-16.9 {layout uniform} { update list [grid bbox . 0 0] [grid bbox . 0 1] [grid bbox . 0 2] \ [grid bbox . 0 3] [grid bbox . 0 4] -} {{0 0 135 75} {0 75 135 100} {0 175 135 75} {0 250 135 100} {0 350 135 40}} -grid_reset 16.9 - -test grid-16.10 {layout uniform} { +} -cleanup { + grid_reset 16.9 +} -result {{0 0 135 75} {0 75 135 100} {0 175 135 75} {0 250 135 100} {0 350 135 40}} +test grid-16.10 {layout uniform} -body { grid [frame .f1 -width 75 -height 50] -row 0 -column 0 grid [frame .f2 -width 60 -height 30] -row 1 -column 2 grid [frame .f3 -width 95 -height 90] -row 2 -column 1 grid [frame .f4 -width 60 -height 100] -row 3 -column 4 grid [frame .f5 -width 60 -height 40] -row 4 -column 3 - grid rowconfigure . {0 1} -uniform a grid rowconfigure . {2 4} -uniform b grid rowconfigure . {0 2} -weight 2 @@ -1585,10 +1569,10 @@ test grid-16.10 {layout uniform} { update list [grid bbox . 0 0] [grid bbox . 2 1] [grid bbox . 1 2] \ [grid bbox . 4 3] [grid bbox . 3 4] -} {{0 0 75 60} {170 60 150 30} {75 90 95 90} {390 180 140 100} {320 280 70 45}} -grid_reset 16.10 - -test grid-16.11 {layout uniform (shrink)} { +} -cleanup { + grid_reset 16.10 +} -result {{0 0 75 60} {170 60 150 30} {75 90 95 90} {390 180 140 100} {320 280 70 45}} +test grid-16.11 {layout uniform (shrink)} -body { frame .f1 -width 75 -height 50 frame .f2 -width 100 -height 95 grid .f1 .f2 -sticky news @@ -1601,10 +1585,10 @@ test grid-16.11 {layout uniform (shrink)} { . configure -width 150 -height 95 update lappend res [grid bbox . 0 0] [grid bbox . 1 0] -} {{0 0 100 95} {100 0 100 95} {0 0 50 95} {50 0 100 95}} -grid_reset 16.11 - -test grid-16.12 {layout uniform (grow)} { +} -cleanup { + grid_reset 16.11 +} -result {{0 0 100 95} {100 0 100 95} {0 0 50 95} {50 0 100 95}} +test grid-16.12 {layout uniform (grow)} -body { frame .f1 -width 40 -height 50 frame .f2 -width 50 -height 95 frame .f3 -width 60 -height 50 @@ -1619,24 +1603,21 @@ test grid-16.12 {layout uniform (grow)} { set res {} lappend res [grid bbox . 0 0] [grid bbox . 1 0] lappend res [grid bbox . 2 0] [grid bbox . 3 0] - grid propagate . 0 . configure -width 350 -height 95 update lappend res [grid bbox . 0 0] [grid bbox . 1 0] lappend res [grid bbox . 2 0] [grid bbox . 3 0] -} [list {0 0 50 95} {50 0 50 95} {100 0 100 95} {200 0 70 95} \ +} -cleanup { + grid_reset 16.12 +} -result [list {0 0 50 95} {50 0 50 95} {100 0 100 95} {200 0 70 95} \ {0 0 70 95} {70 0 50 95} {120 0 140 95} {260 0 90 95}] -grid_reset 16.12 - -test grid-16.13 {layout span} { +test grid-16.13 {layout span} -body { frame .f1 -width 24 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 - grid .f1 - - .f2 grid .f3 - - - - set res {} foreach w {{0 1 0 0} {0 0 1 0} {1 3 4 0} {1 2 1 2} {1 1 1 12}} { for {set c 0} {$c < 4} {incr c} { @@ -1649,21 +1630,19 @@ test grid-16.13 {layout span} { } lappend res $res2 } - set res + return $res # The last result below should ideally be 8 8 8 126 but the current # implementation is not exact enough. -} [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 14 42 56 38 0] \ +} -cleanup { + grid_reset 16.13 +} -result [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 14 42 56 38 0] \ [list 18 38 18 76 0] [list 7 8 9 126 0]] -grid_reset 16.13 - -test grid-16.14 {layout span} { +test grid-16.14 {layout span} -body { frame .f1 -width 110 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 - grid .f1 - - .f2 grid .f3 - - - - set res {} foreach w {{0 1 0 0} {0 0 1 0} {1 3 4 0} {1 2 1 3} {1 1 1 12}} { for {set c 0} {$c < 4} {incr c} { @@ -1676,19 +1655,17 @@ test grid-16.14 {layout span} { } lappend res $res2 } - set res -} [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 14 42 56 38 0] \ + return $res +} -cleanup { + grid_reset 16.14 +} -result [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 14 42 56 38 0] \ [list 27 55 28 40 0] [list 36 37 37 40 0]] -grid_reset 16.14 - -test grid-16.15 {layout span} { +test grid-16.15 {layout span} -body { frame .f1 -width 24 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 - grid .f1 - - .f2 grid x .f3 - - - set res {} foreach w {{0 1 0 0} {0 0 1 0} {1 0 1 0} {0 0 0 0} {1 0 0 6}} { for {set c 0} {$c < 4} {incr c} { @@ -1701,23 +1678,21 @@ test grid-16.15 {layout span} { } lappend res $res2 } - set res -} [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 0 0 112 38 0] \ + return $res +} -cleanup { + grid_reset 16.15 +} -result [list [list 0 112 0 38 0] [list 0 0 112 38 0] [list 0 0 112 38 0] \ [list 0 37 37 76 0] [list 0 12 12 126 0]] -grid_reset 16.15 - -test grid-16.16 {layout span} { +test grid-16.16 {layout span} -body { frame .f1 -width 64 -height 20 frame .f2 -width 38 -height 20 frame .f3 -width 150 -height 20 frame .f4 -width 15 -height 20 frame .f5 -width 18 -height 20 frame .f6 -width 20 -height 20 - grid .f1 - x .f2 grid .f3 - - - grid .f4 .f5 .f6 - set res {} foreach w {{1 1 5 1} {0 0 1 0} {1 3 4 0} {1 2 1 2} {1 1 1 12}} { for {set c 0} {$c < 4} {incr c} { @@ -1730,15 +1705,15 @@ test grid-16.16 {layout span} { } lappend res $res2 } - set res -} [list [list 30 34 43 43 0] [list 30 34 48 38 0] [list 22 42 48 38 0] \ + return $res +} -cleanup { + grid_reset 16.16 +} -result [list [list 30 34 43 43 0] [list 30 34 48 38 0] [list 22 42 48 38 0] \ [list 25 39 29 57 0] [list 30 34 22 64 0]] -grid_reset 16.16 - -test grid-16.17 {layout weights (shrinking at minsize)} { +test grid-16.17 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2 3} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 grid columnconfigure . {0 1} -weight 1 -minsize 0 @@ -1754,20 +1729,18 @@ test grid-16.17 {layout weights (shrinking at minsize)} { foreach i {0 1 2 3} { lappend a [winfo width .$i]-[winfo height .$i]-[winfo ismapped .$i] } - set a -} {25-25-1 25-25-1 100-75-1 100-75-1 25-25-0 25-25-0 100-75-1 100-75-1} -grid_reset 16.17 - -test grid-16.18 {layout span} { + return $a +} -cleanup { + grid_reset 16.17 +} -result {25-25-1 25-25-1 100-75-1 100-75-1 25-25-0 25-25-0 100-75-1 100-75-1} +test grid-16.18 {layout span} -body { frame .f1 -width 30 -height 20 frame .f2 -width 166 -height 20 frame .f3 -width 39 -height 20 frame .f4 -width 10 -height 20 - grid .f1 .f3 - grid .f2 - .f4 grid columnconfigure . 0 -weight 1 - set res {} foreach w {{1 0 0} {0 1 0} {0 0 1}} { for {set c 0} {$c < 3} {incr c} { @@ -1780,14 +1753,35 @@ test grid-16.18 {layout span} { } lappend res $res2 } - set res -} [list [list 137 29 10] [list 30 136 10] [list 98 68 10]] -grid_reset 16.18 + return $res +} -cleanup { + grid_reset 16.18 +} -result [list [list 137 29 10] [list 30 136 10] [list 98 68 10]] +test grid-16.19 {layout span} -constraints { knownBug } -body { + # This test shows the problem in Bug 2075285 + # Several overlapping multi-span widgets is a weak spot + # in the current implementation. + # Test present as a reminder in case a future algorithm update is made. + frame .f1 -width 100 -height 20 + frame .f2 -width 20 -height 20 + frame .f3 -width 10 -height 20 + frame .f4 -width 20 -height 20 + grid .f1 - - - - - -sticky we + grid .f2 - .f3 - .f4 - -sticky we + grid columnconfigure . {1 5} -weight 1 + set res {} + update + for {set c 0} {$c <= 5} {incr c} { + lappend res [lindex [grid bbox . $c 0] 2] + } + return $res +} -cleanup { + grid_reset 16.19 +} -result [list 0 45 5 5 0 45] -test grid-17.1 {forget and pending idle handlers} { +test grid-17.1 {forget and pending idle handlers} -body { # This test is intended to detect a crash caused by a failure to remove # pending idle handlers when grid forget is invoked. - toplevel .t wm geometry .t +0+0 frame .t.f @@ -1798,16 +1792,16 @@ test grid-17.1 {forget and pending idle handlers} { grid forget .t.f.l grid forget .t.f destroy .t - toplevel .t frame .t.f label .t.f.l -text foobar grid .t.f.l destroy .t set result ok -} ok +} -result ok -test grid-18.1 {test respect for internalborder} { + +test grid-18.1 {test respect for internalborder} -body { toplevel .pack wm geometry .pack 200x200 frame .pack.l -width 15 -height 10 @@ -1823,9 +1817,9 @@ test grid-18.1 {test respect for internalborder} { update lappend res [winfo geometry .pack.lf.f] destroy .pack - set res -} {196x188+2+10 177x186+5+7} -test grid-18.2 {test support for minreqsize} { + return $res +} -result {196x188+2+10 177x186+5+7} +test grid-18.2 {test support for minreqsize} -body { toplevel .pack wm geometry .pack {} frame .pack.l -width 150 -height 100 @@ -1839,10 +1833,10 @@ test grid-18.2 {test support for minreqsize} { update lappend res [winfo geometry .pack.lf] destroy .pack - set res -} {162x127+0+0 172x112+0+0} + return $res +} -result {162x127+0+0 172x112+0+0} -test grid-19.1 {uniform realloc} { +test grid-19.1 {uniform realloc} -body { # Use a lot of uniform groups to test the reallocation mechanism for {set t 0} {$t < 100} {incr t 2} { frame .fa$t -width 5 -height 20 @@ -1852,75 +1846,76 @@ test grid-19.1 {uniform realloc} { } update grid bbox . -} {0 0 600 20} -grid_reset 19.1 +} -cleanup { + grid_reset 19.1 +} -result {0 0 600 20} -test grid-20.1 {recalculate size after removal (destroy)} { +test grid-20.1 {recalculate size after removal (destroy)} -body { label .l1 -text l1 grid .l1 -row 2 -column 2 destroy .l1 label .l2 -text l2 grid .l2 grid size . -} {1 1} -grid_reset 20.1 - -test grid-20.2 {recalculate size after removal (forget)} { +} -cleanup { + grid_reset 20.1 +} -result {1 1} +test grid-20.2 {recalculate size after removal (forget)} -body { label .l1 -text l1 grid .l1 -row 2 -column 2 grid forget .l1 label .l2 -text l2 grid .l2 grid size . -} {1 1} -grid_reset 20.2 - -test grid-21.1 {anchor} { - list [catch {grid anchor . 1 xxx} msg] $msg -} {1 {wrong # args: should be "grid anchor window ?anchor?"}} -grid_reset 21.1 - -test grid-21.2 {anchor} { - list [catch {grid anchor .} msg] $msg -} {0 nw} -grid_reset 21.2 - -test grid-21.3 {anchor} { - list [catch {grid anchor . se;grid anchor .} msg] $msg -} {0 se} -grid_reset 21.3 - -test grid-21.4 {anchor} { - list [catch {grid anchor .x} msg] $msg -} {1 {bad window path name ".x"}} -grid_reset 21.4 - -test grid-21.5 {anchor} { - list [catch {grid anchor . x} msg] $msg -} {1 {bad anchor "x": must be n, ne, e, se, s, sw, w, nw, or center}} -grid_reset 21.5 - -test grid-21.6 {anchor} { +} -cleanup { + grid_reset 20.2 +} -result {1 1} + +test grid-21.1 {anchor} -body { + grid anchor . 1 xxx +} -cleanup { + grid_reset 21.1 +} -returnCodes error -result {wrong # args: should be "grid anchor window ?anchor?"} +test grid-21.2 {anchor} -body { + grid anchor . +} -cleanup { + grid_reset 21.2 +} -result {nw} +test grid-21.3 {anchor} -body { + grid anchor . se;grid anchor . +} -cleanup { + grid_reset 21.3 +} -result {se} +test grid-21.4 {anchor} -body { + grid anchor .x +} -cleanup { + grid_reset 21.4 +} -returnCodes error -result {bad window path name ".x"} +test grid-21.5 {anchor} -body { + grid anchor . x +} -cleanup { + grid_reset 21.5 +} -returnCodes error -result {bad anchor "x": must be n, ne, e, se, s, sw, w, nw, or center} +test grid-21.6 {anchor} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -row $i -column $i -sticky nswe + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 . configure -width 300 -height 250 - set res {} foreach a {n ne e se s sw w nw center} { grid anchor . $a update lappend res [grid bbox .] } - set res -} [list {37 0 225 150} {75 0 225 150} {75 50 225 150} {75 100 225 150} \ + return $res +} -cleanup { + grid_reset 21.6 +} -result [list {37 0 225 150} {75 0 225 150} {75 50 225 150} {75 100 225 150} \ {37 100 225 150} {0 100 225 150} {0 50 225 150} {0 0 225 150} \ {37 50 225 150}] -grid_reset 21.6 - -test grid-21.7 {anchor} { +test grid-21.7 {anchor} -body { # Test with a non-symmetric internal border. # This only tests vertically, there is currently no way to get # it assymetric horizontally. @@ -1928,15 +1923,13 @@ test grid-21.7 {anchor} { frame .f.x -width 20 -height 20 .f configure -labelwidget .f.x pack .f -fill both -expand 1 - foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge - grid .$i -in .f -row $i -column $i -sticky nswe + frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + grid .$i -in .f -row $i -column $i -sticky nswe } pack propagate . 0 grid propagate .f 0 . configure -width 300 -height 250 - set res {} foreach a {n ne e se s sw w nw center} { grid anchor .f $a @@ -1944,26 +1937,25 @@ test grid-21.7 {anchor} { lappend res [grid bbox .f] } pack propagate . 1 ; wm geometry . {} - set res -} [list {37 20 225 150} {75 20 225 150} {75 60 225 150} {75 100 225 150} \ + return $res +} -cleanup { + grid_reset 21.7 +} -result [list {37 20 225 150} {75 20 225 150} {75 60 225 150} {75 100 225 150} \ {37 100 225 150} {0 100 225 150} {0 60 225 150} {0 20 225 150} \ {37 60 225 150}] -grid_reset 21.7 test grid-22.1 {remove: basic argument checking} { list [catch {grid remove foo} msg] $msg } {1 {bad window path name "foo"}} - test grid-22.2 {remove} { button .c grid [button .b] set a [grid slaves .] grid remove .b .c lappend a [grid slaves .] - set a + return $a } {.b {}} grid_reset 22.2 - test grid-22.3 {remove} { button .c grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx 3 -pady 4 -sticky ns @@ -1972,7 +1964,6 @@ test grid-22.3 {remove} { grid info .c } {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx 3 -pady 4 -sticky ns} grid_reset 22.3 - test grid-22.3.1 {remove} { frame .a button .c @@ -1982,7 +1973,6 @@ test grid-22.3.1 {remove} { grid info .c } {-in .a -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns} grid_reset 22.3.1 - test grid-22.4 {remove, calling Tk_UnmaintainGeometry} { frame .f -bd 2 -relief raised place .f -x 10 -y 20 -width 200 -height 100 @@ -1996,7 +1986,6 @@ test grid-22.4 {remove, calling Tk_UnmaintainGeometry} { lappend x [winfo ismapped .f2] } {1 0} grid_reset 22.4 - test grid-22.5 {remove} { frame .a button .c @@ -2009,7 +1998,11 @@ test grid-22.5 {remove} { grid info .c } {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns} grid_reset 22.5 - + # cleanup cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/id.test b/tests/id.test deleted file mode 100644 index de0d965..0000000 --- a/tests/id.test +++ /dev/null @@ -1,91 +0,0 @@ -# This file is a Tcl script to test out the procedures in the file -# tkId.c, which recycle X resource identifiers. It is organized in -# the standard fashion for Tcl tests. -# -# Copyright (c) 1995 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# All rights reserved. - -package require tcltest 2.1 -eval tcltest::configure $argv -tcltest::loadTestedCommands - -test id-1.1 {WindowIdCleanup, delaying window release} {unix testwrapper} { - bind all <Destroy> {lappend x %W} - catch {unset map} - frame .f - set j 0 - foreach i {a b c d e f g h i j k l m n o p q} { - toplevel .f.$i -height 50 -width 100 - wm geometry .f.$i +$j+$j - incr j 10 - update - set map([winfo id .f.$i]) .f.$i - set map([testwrapper .f.$i]) wrapper.f.$i - } - set x {} - destroy .f - - # Destroy events should have occurred for all windows. - set result [list [lsort $x]] - - set x {} - update idletasks - set reused {} - foreach i {a b c d e} { - set w .${i}2 - frame $w -height 20 -width 100 -bd 2 -relief raised - pack $w - if [info exists map([winfo id $w])] { - lappend reused $map([winfo id $w]) - } - set map([winfo id $w]) $w - } - - # No window ids should have been reused: stale Destroy events still - # pending in queue. - lappend result [lsort $reused] - - # Wait a few seconds, then try again; ids should still not have - # been re-used. - - set y 0 - after 2000 {set y 1} - tkwait variable y - foreach i {a b c} { - set w .${i}3 - frame $w -height 20 -width 100 -bd 2 -relief raised - pack $w - if [info exists map([winfo id $w])] { - lappend reused $map([winfo id $w]) - } - set map([winfo id $w])] $w - } - - # Ids should not yet have been reused. - lappend result [lsort $reused] - - - # Wait a few more seconds, to give ids enough time to be recycled. - set y 0 - after 6000 {set y 1} - tkwait variable y - foreach i {a b c d e f} { - set w .${i}4 - frame $w -height 20 -width 100 -bd 2 -relief raised - pack $w - if [info exists map([winfo id $w])] { - lappend reused $map([winfo id $w]) - } - set map([winfo id $w])] $w - } - - # Ids should be reused now, due to time delay. Destroy events should - # have been discarded. - lappend result [lsort $reused] [lsort $x] -} {{.f .f.a .f.b .f.c .f.d .f.e .f.f .f.g .f.h .f.i .f.j .f.k .f.l .f.m .f.n .f.o .f.p .f.q} {} {} {.f.o .f.p .f.q wrapper.f.p wrapper.f.q} {}} -bind all <Destroy> {} - -# cleanup -cleanupTests -return diff --git a/tests/image.test b/tests/image.test index c6c4f8a..3134ee8 100644 --- a/tests/image.test +++ b/tests/image.test @@ -7,38 +7,56 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -namespace import -force ::tk::test::loadTkCommand -eval image delete [image names] +imageInit + +# Canvas used in some tests in the whole file canvas .c -highlightthickness 2 pack .c update -test image-1.1 {Tk_ImageCmd procedure, "create" option} { - list [catch image msg] $msg -} {1 {wrong # args: should be "image option ?args?"}} -test image-1.2 {Tk_ImageCmd procedure, "create" option} { - list [catch {image gorp} msg] $msg -} {1 {bad option "gorp": must be create, delete, height, inuse, names, type, types, or width}} -test image-1.3 {Tk_ImageCmd procedure, "create" option} { - list [catch {image create} msg] $msg -} {1 {wrong # args: should be "image create type ?name? ?options?"}} -test image-1.4 {Tk_ImageCmd procedure, "create" option} { - list [catch {image c bad_type} msg] $msg -} {1 {image type "bad_type" doesn't exist}} -test image-1.5 {Tk_ImageCmd procedure, "create" option} testImageType { - list [image create test myimage] [image names] -} {myimage myimage} -test image-1.6 {Tk_ImageCmd procedure, "create" option} testImageType { + + +test image-1.1 {Tk_ImageCmd procedure, "create" option} -body { + image +} -returnCodes error -result {wrong # args: should be "image option ?args?"} +test image-1.2 {Tk_ImageCmd procedure, "create" option} -body { + image gorp +} -returnCodes error -result {bad option "gorp": must be create, delete, height, inuse, names, type, types, or width} +test image-1.3 {Tk_ImageCmd procedure, "create" option} -body { + image create +} -returnCodes error -result {wrong # args: should be "image create type ?name? ?-option value ...?"} +test image-1.4 {Tk_ImageCmd procedure, "create" option} -body { + image c bad_type +} -returnCodes error -result {image type "bad_type" doesn't exist} +test image-1.5 {Tk_ImageCmd procedure, "create" option} -constraints { + testImageType +} -body { + list [image create test myimage] [imageNames] +} -cleanup { + imageCleanup +} -result {myimage myimage} +test image-1.6 {Tk_ImageCmd procedure, "create" option} -constraints { + testImageType +} -setup { + imageCleanup +} -body { scan [image create test] image%d first image create test myimage scan [image create test -variable x] image%d second expr $second-$first -} {1} -test image-1.7 {Tk_ImageCmd procedure, "create" option} testImageType { - image delete myimage +} -cleanup { + imageCleanup +} -result {1} + +test image-1.7 {Tk_ImageCmd procedure, "create" option} -constraints { + testImageType +} -setup { + imageCleanup +} -body { image create test myimage -variable x .c create image 100 50 -image myimage .c create image 100 150 -image myimage @@ -46,10 +64,16 @@ test image-1.7 {Tk_ImageCmd procedure, "create" option} testImageType { set x {} image create test myimage -variable x update - set x -} {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}} -test image-1.8 {Tk_ImageCmd procedure, "create" option} testImageType { + return $x +} -cleanup { + imageCleanup +} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}} +test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints { + testImageType +} -setup { .c delete all + imageCleanup +} -body { image create test myimage -variable x .c create image 100 50 -image myimage .c create image 100 150 -image myimage @@ -58,185 +82,289 @@ test image-1.8 {Tk_ImageCmd procedure, "create" option} testImageType { set x {} image create test myimage -variable x update - set x -} {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}} -test image-1.9 {Tk_ImageCmd procedure, "create" option} testImageType { + return $x +} -cleanup { .c delete all - eval image delete [image names] - list [catch {image create test -badName foo} msg] $msg [image names] -} {1 {bad option name "-badName"} {}} -test image-1.10 {Tk_ImageCmd procedure, "create" option with same name as main window} { + imageCleanup +} -result {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}} +test image-1.9 {Tk_ImageCmd procedure, "create" option} -constraints { + testImageType +} -body { + image create test -badName foo +} -returnCodes error -result {bad option name "-badName"} +test image-1.10 {Tk_ImageCmd procedure, "create" option} -constraints { + testImageType +} -body { + catch {image create test -badName foo} + imageNames +} -result {} +test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main window} -body { set code [loadTkCommand] append code { - update - puts [list [catch {image create photo .} msg] $msg] - exit + update + puts [list [catch {image create photo .} msg] $msg] + exit } set script [makeFile $code script] - set x [list [catch {exec [interpreter] <$script} msg] $msg] + exec [interpreter] <$script +} -cleanup { removeFile script - set x -} {0 {1 {images may not be named the same as the main window}}} -test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main window after renaming} { +} -result {1 {images may not be named the same as the main window}} +test image-1.12 {Tk_ImageCmd procedure, "create" option with same name as main window after renaming} -body { set code [loadTkCommand] append code { - update - puts [list [catch {rename . foo;image create photo foo} msg] $msg] - exit + update + puts [list [catch {rename . foo;image create photo foo} msg] $msg] + exit } set script [makeFile $code script] - set x [list [catch {exec [interpreter] <$script} msg] $msg] + exec [interpreter] <$script +} -cleanup { removeFile script - set x -} {0 {1 {images may not be named the same as the main window}}} -test image-1.12 {Tk_ImageCmd, "create" option: do not generated command name in use} -setup { +} -result {1 {images may not be named the same as the main window}} +test image-1.13 {Tk_ImageCmd, "create" option: do not generated command name in use} -setup { + .c delete all + imageCleanup +} -body { set i [image create bitmap] regexp {^image(\d+)$} $i -> serial incr serial proc image$serial {} {return works} set j [image create bitmap] -} -body { + image$serial } -cleanup { rename image$serial {} image delete $i $j } -result works -test image-2.1 {Tk_ImageCmd procedure, "delete" option} { - list [catch {image delete} msg] $msg -} {0 {}} -test image-2.2 {Tk_ImageCmd procedure, "delete" option} testImageType { - .c delete all - eval image delete [image names] +test image-2.1 {Tk_ImageCmd procedure, "delete" option} -body { + image delete +} -result {} +test image-2.2 {Tk_ImageCmd procedure, "delete" option} -constraints { + testImageType +} -setup { + imageCleanup + set result {} +} -body { image create test myimage image create test img2 - set result {} - lappend result [lsort [image names]] + lappend result [lsort [imageNames]] image d myimage img2 - lappend result [image names] -} {{img2 myimage} {}} -test image-2.3 {Tk_ImageCmd procedure, "delete" option} testImageType { - .c delete all - eval image delete [image names] + lappend result [imageNames] +} -cleanup { + imageCleanup +} -result {{img2 myimage} {}} +test image-2.3 {Tk_ImageCmd procedure, "delete" option} -constraints { + testImageType +} -setup { + imageCleanup +} -body { image create test myimage image create test img2 - list [catch {image delete myimage gorp img2} msg] $msg [image names] -} {1 {image "gorp" doesn't exist} img2} - -test image-3.1 {Tk_ImageCmd procedure, "height" option} { - list [catch {image height} msg] $msg -} {1 {wrong # args: should be "image height name"}} -test image-3.2 {Tk_ImageCmd procedure, "height" option} { - list [catch {image height a b} msg] $msg -} {1 {wrong # args: should be "image height name"}} -test image-3.3 {Tk_ImageCmd procedure, "height" option} { - list [catch {image height foo} msg] $msg -} {1 {image "foo" doesn't exist}} -test image-3.4 {Tk_ImageCmd procedure, "height" option} testImageType { + image delete myimage gorp img2 +} -cleanup { + imageCleanup +} -returnCodes error -result {image "gorp" doesn't exist} +test image-2.4 {Tk_ImageCmd procedure, "delete" option} -constraints { + testImageType +} -setup { + imageCleanup +} -body { + image create test myimage + image create test img2 + catch {image delete myimage gorp img2} + imageNames +} -cleanup { + imageCleanup +} -result {img2} + + +test image-3.1 {Tk_ImageCmd procedure, "height" option} -body { + image height +} -returnCodes error -result {wrong # args: should be "image height name"} +test image-3.2 {Tk_ImageCmd procedure, "height" option} -body { + image height a b +} -returnCodes error -result {wrong # args: should be "image height name"} +test image-3.3 {Tk_ImageCmd procedure, "height" option} -body { + image height foo +} -returnCodes error -result {image "foo" doesn't exist} +test image-3.4 {Tk_ImageCmd procedure, "height" option} -constraints { + testImageType +} -setup { + imageCleanup +} -body { image create test myimage set x [image h myimage] myimage changed 0 0 0 0 60 50 list $x [image height myimage] -} {15 50} +} -cleanup { + imageCleanup +} -result {15 50} -test image-4.1 {Tk_ImageCmd procedure, "names" option} { - list [catch {image names x} msg] $msg -} {1 {wrong # args: should be "image names"}} -test image-4.2 {Tk_ImageCmd procedure, "names" option} testImageType { - .c delete all - eval image delete [image names] - image create test myimage - image create test img2 - image create test 24613 - lsort [image names] -} {24613 img2 myimage} -test image-4.3 {Tk_ImageCmd procedure, "names" option} { - .c delete all - eval image delete [image names] - lsort [image names] -} {} - -test image-5.1 {Tk_ImageCmd procedure, "type" option} { - list [catch {image type} msg] $msg -} {1 {wrong # args: should be "image type name"}} -test image-5.2 {Tk_ImageCmd procedure, "type" option} { - list [catch {image type a b} msg] $msg -} {1 {wrong # args: should be "image type name"}} -test image-5.3 {Tk_ImageCmd procedure, "type" option} { - list [catch {image type foo} msg] $msg -} {1 {image "foo" doesn't exist}} -test image-5.4 {Tk_ImageCmd procedure, "type" option} testImageType { + +test image-4.1 {Tk_ImageCmd procedure, "names" option} -body { + image names x +} -returnCodes error -result {wrong # args: should be "image names"} +test image-4.2 {Tk_ImageCmd procedure, "names" option} -constraints { + testImageType +} -setup { + catch {interp delete testinterp} +} -body { + interp create testinterp + load {} Tk testinterp + interp eval testinterp { + image delete {*}[image names] + image create test myimage + image create test img2 + image create test 24613 + lsort [image names] + } +} -cleanup { + interp delete testinterp +} -result {24613 img2 myimage} +test image-4.3 {Tk_ImageCmd procedure, "names" option} -setup { + catch {interp delete testinterp} +} -body { + interp create testinterp + load {} Tk testinterp + interp eval testinterp { + image delete {*}[image names] + eval image delete [image names] [image names] + lsort [image names] + } +} -cleanup { + interp delete testinterp +} -result {} + + +test image-5.1 {Tk_ImageCmd procedure, "type" option} -body { + image type +} -returnCodes error -result {wrong # args: should be "image type name"} +test image-5.2 {Tk_ImageCmd procedure, "type" option} -body { + image type a b +} -returnCodes error -result {wrong # args: should be "image type name"} +test image-5.3 {Tk_ImageCmd procedure, "type" option} -body { + image type foo +} -returnCodes error -result {image "foo" doesn't exist} + +test image-5.4 {Tk_ImageCmd procedure, "type" option} -constraints { + testImageType +} -setup { + imageCleanup +} -body { image create test myimage image type myimage -} {test} -test image-5.5 {Tk_ImageCmd procedure, "type" option} testImageType { +} -cleanup { + imageCleanup +} -result {test} +test image-5.5 {Tk_ImageCmd procedure, "type" option} -constraints { + testImageType +} -setup { + imageCleanup +} -body { image create test myimage .c create image 50 50 -image myimage image delete myimage - list [catch {image type myimage} msg] $msg -} {1 {image "myimage" doesn't exist}} -test image-5.6 {Tk_ImageCmd procedure, "type" option} testOldImageType { + image type myimage +} -cleanup { + imageCleanup +} -returnCodes error -result {image "myimage" doesn't exist} +test image-5.6 {Tk_ImageCmd procedure, "type" option} -constraints { + testOldImageType +} -setup { + imageCleanup +} -body { image create oldtest myimage image type myimage -} {oldtest} -test image-5.7 {Tk_ImageCmd procedure, "type" option} testOldImageType { +} -cleanup { + imageCleanup +} -result {oldtest} +test image-5.7 {Tk_ImageCmd procedure, "type" option} -constraints { + testOldImageType +} -setup { + .c delete all + imageCleanup +} -body { image create oldtest myimage .c create image 50 50 -image myimage image delete myimage - list [catch {image type myimage} msg] $msg -} {1 {image "myimage" doesn't exist}} + image type myimage +} -cleanup { + .c delete all + imageCleanup +} -returnCodes error -result {image "myimage" doesn't exist} -test image-6.1 {Tk_ImageCmd procedure, "types" option} { - list [catch {image types x} msg] $msg -} {1 {wrong # args: should be "image types"}} -test image-6.2 {Tk_ImageCmd procedure, "types" option} testImageType { + +test image-6.1 {Tk_ImageCmd procedure, "types" option} -body { + image types x +} -returnCodes error -result {wrong # args: should be "image types"} +test image-6.2 {Tk_ImageCmd procedure, "types" option} -constraints { + testImageType +} -body { lsort [image types] -} {bitmap oldtest photo test} - -test image-7.1 {Tk_ImageCmd procedure, "width" option} { - list [catch {image width} msg] $msg -} {1 {wrong # args: should be "image width name"}} -test image-7.2 {Tk_ImageCmd procedure, "width" option} { - list [catch {image width a b} msg] $msg -} {1 {wrong # args: should be "image width name"}} -test image-7.3 {Tk_ImageCmd procedure, "width" option} { - list [catch {image width foo} msg] $msg -} {1 {image "foo" doesn't exist}} -test image-7.4 {Tk_ImageCmd procedure, "width" option} testImageType { +} -result {bitmap oldtest photo test} + + +test image-7.1 {Tk_ImageCmd procedure, "width" option} -body { + image width +} -returnCodes error -result {wrong # args: should be "image width name"} +test image-7.2 {Tk_ImageCmd procedure, "width" option} -body { + image width a b +} -returnCodes error -result {wrong # args: should be "image width name"} +test image-7.3 {Tk_ImageCmd procedure, "width" option} -body { + image width foo +} -returnCodes error -result {image "foo" doesn't exist} +test image-7.4 {Tk_ImageCmd procedure, "width" option} -constraints { + testImageType +} -setup { + imageCleanup +} -body { image create test myimage set x [image w myimage] myimage changed 0 0 0 0 60 50 list $x [image width myimage] -} {30 60} +} -cleanup { + imageCleanup +} -result {30 60} -test image-8.1 {Tk_ImageCmd procedure, "inuse" option} testImageType { - catch {image delete myimage2} - image create test myimage2 + +test image-8.1 {Tk_ImageCmd procedure, "inuse" option} -constraints { + testImageType +} -setup { + imageCleanup set res {} + destroy .b +} -body { + image create test myimage2 lappend res [image inuse myimage2] - catch {destroy .b} button .b -image myimage2 lappend res [image inuse myimage2] +} -cleanup { + imageCleanup catch {destroy .b} - image delete myimage2 - set res -} [list 0 1] +} -result [list 0 1] -test image-9.1 {Tk_ImageChanged procedure} testImageType { +test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup { .c delete all - eval image delete [image names] + imageCleanup +} -body { image create test foo -variable x .c create image 50 50 -image foo update set x {} foo changed 5 6 7 8 30 15 update - set x -} {{foo display 5 6 7 8 30 30}} -test image-9.2 {Tk_ImageChanged procedure} testImageType { + return $x +} -cleanup { + .c delete all + imageCleanup +} -result {{foo display 5 6 7 8 30 30}} +test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup { .c delete all - eval image delete [image names] + imageCleanup +} -body { image create test foo -variable x .c create image 50 50 -image foo .c create image 90 100 -image foo @@ -244,25 +372,38 @@ test image-9.2 {Tk_ImageChanged procedure} testImageType { set x {} foo changed 5 6 7 8 30 15 update - set x -} {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}} + return $x +} -cleanup { + .c delete all + imageCleanup +} -result {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}} + -test image-10.1 {Tk_GetImage procedure} { - list [catch {.c create image 100 10 -image bad_name} msg] $msg -} {1 {image "bad_name" doesn't exist}} -test image-10.2 {Tk_GetImage procedure} testImageType { +test image-10.1 {Tk_GetImage procedure} -setup { + imageCleanup +} -body { + .c create image 100 10 -image bad_name +} -cleanup { + imageCleanup +} -returnCodes error -result {image "bad_name" doesn't exist} +test image-10.2 {Tk_GetImage procedure} -constraints testImageType -setup { + destroy .l + imageCleanup +} -body { image create test mytest - catch {destroy .l} label .l -image mytest image delete mytest - set result [list [catch {label .l2 -image mytest} msg] $msg] + label .l2 -image mytest +} -cleanup { destroy .l - set result -} {1 {image "mytest" doesn't exist}} + imageCleanup +} -returnCodes error -result {image "mytest" doesn't exist} + -test image-11.1 {Tk_FreeImage procedure} testImageType { +test image-11.1 {Tk_FreeImage procedure} -constraints testImageType -setup { .c delete all - eval image delete [image names] + imageCleanup +} -body { image create test foo -variable x .c create image 50 50 -image foo -tags i1 .c create image 90 100 -image foo -tags i2 @@ -272,168 +413,214 @@ test image-11.1 {Tk_FreeImage procedure} testImageType { .c delete i1 pack .c update - list [image names] $x -} {foo {{foo free} {foo display 0 0 30 15 103 121}}} -test image-11.2 {Tk_FreeImage procedure} testImageType { + list [imageNames] $x +} -cleanup { .c delete all - eval image delete [image names] + imageCleanup +} -result {foo {{foo free} {foo display 0 0 30 15 103 121}}} +test image-11.2 {Tk_FreeImage procedure} -constraints testImageType -setup { + .c delete all + imageCleanup +} -body { image create test foo -variable x .c create image 50 50 -image foo -tags i1 - set names [image names] + set names [imageNames] image delete foo update - set names2 [image names] + set names2 [imageNames] set x {} .c delete i1 pack forget .c pack .c update - list $names $names2 [image names] $x -} {foo {} {} {}} + list $names $names2 [imageNames] $x +} -cleanup { + .c delete all + imageCleanup +} -result {foo {} {} {}} -# Non-portable, apparently due to differences in rounding: -test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} \ - {testImageType nonPortable} { - .c delete all - eval image delete [image names] +# Non-portable, apparently due to differences in rounding: +test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} -constraints { + testImageType nonPortable +} -setup { + imageCleanup +} -body { image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 30 40 55 65 -width 0 -fill black -outline {} set x {} update - set x -} {{foo display 0 0 5 5 50 50}} -test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} \ - {testImageType nonPortable} { - .c delete all - eval image delete [image names] + return $x +} -cleanup { + imageCleanup +} -result {{foo display 0 0 5 5 50 50}} +test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} -constraints { + testImageType nonPortable +} -setup { + imageCleanup +} -body { image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 60 40 100 65 -width 0 -fill black -outline {} set x {} update - set x -} {{foo display 10 0 20 5 30 50}} -test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} \ - {testImageType nonPortable} { - .c delete all - eval image delete [image names] + return $x +} -cleanup { + imageCleanup +} -result {{foo display 10 0 20 5 30 50}} +test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} -constraints { + testImageType nonPortable +} -setup { + imageCleanup +} -body { image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 60 70 100 200 -width 0 -fill black -outline {} set x {} update - set x -} {{foo display 10 10 20 5 30 30}} -test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} \ - {testImageType nonPortable} { - .c delete all - eval image delete [image names] + return $x +} -cleanup { + imageCleanup +} -result {{foo display 10 10 20 5 30 30}} +test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} -constraints { + testImageType nonPortable +} -setup { + imageCleanup +} -body { image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 30 70 55 200 -width 0 -fill black -outline {} set x {} update - set x -} {{foo display 0 10 5 5 50 30}} -test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} \ - {testImageType nonPortable} { - .c delete all - eval image delete [image names] + return $x +} -cleanup { + imageCleanup +} -result {{foo display 0 10 5 5 50 30}} +test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} -constraints { + testImageType nonPortable +} -setup { + imageCleanup +} -body { image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 10 20 120 130 -width 0 -fill black -outline {} set x {} update - set x -} {{foo display 0 0 30 15 70 70}} -test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} \ - {testImageType nonPortable} { - .c delete all - eval image delete [image names] + return $x +} -cleanup { + imageCleanup +} -result {{foo display 0 0 30 15 70 70}} +test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} -constraints { + testImageType nonPortable +} -setup { + imageCleanup +} -body { image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update .c create rectangle 55 65 75 70 -width 0 -fill black -outline {} set x {} update - set x -} {{foo display 5 5 20 5 30 30}} + return $x +} -cleanup { + imageCleanup +} -result {{foo display 5 5 20 5 30 30}} -test image-13.1 {Tk_SizeOfImage procedure} testImageType { - eval image delete [image names] + +test image-13.1 {Tk_SizeOfImage procedure} -constraints testImageType -setup { + imageCleanup +} -body { image create test foo -variable x set result [list [image width foo] [image height foo]] foo changed 0 0 0 0 85 60 lappend result [image width foo] [image height foo] -} {30 15 85 60} +} -cleanup { + imageCleanup +} -result {30 15 85 60} -test image-13.2 {DeleteImage procedure} testImageType { +test image-13.2 {DeleteImage procedure} -constraints testImageType -setup { .c delete all - eval image delete [image names] + imageCleanup +} -body { image create test foo -variable x .c create image 50 50 -image foo -tags i1 .c create image 90 100 -image foo -tags i2 set x {} image delete foo - lappend x | [image names] | [catch {image delete foo} msg] | $msg | [image names] | -} {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |} + lappend x | [imageNames] | [catch {image delete foo} msg] | $msg | [imageNames] | +} -cleanup { + imageCleanup +} -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |} -test image-13.3 {Tk_SizeOfImage procedure} testOldImageType { - eval image delete [image names] +test image-13.3 {Tk_SizeOfImage procedure} -constraints testOldImageType -setup { + imageCleanup +} -body { image create oldtest foo -variable x set result [list [image width foo] [image height foo]] foo changed 0 0 0 0 85 60 lappend result [image width foo] [image height foo] -} {30 15 85 60} +} -cleanup { + imageCleanup +} -result {30 15 85 60} -test image-13.4 {DeleteImage procedure} testOldImageType { +test image-13.4 {DeleteImage procedure} -constraints testOldImageType -setup { .c delete all - eval image delete [image names] + imageCleanup +} -body { image create oldtest foo -variable x .c create image 50 50 -image foo -tags i1 .c create image 90 100 -image foo -tags i2 set x {} image delete foo - lappend x | [image names] | [catch {image delete foo} msg] | $msg | [image names] | -} {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |} - - -catch {image delete hidden} -set l [image names] -set h [interp hidden] + lappend x | [imageNames] | [catch {image delete foo} msg] | $msg | [imageNames] | +} -cleanup { + .c delete all + imageCleanup +} -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |} -test image-14.1 {image command vs hidden commands} { +test image-14.1 {image command vs hidden commands} -body { catch {image delete hidden} + set l [imageNames] + set h [interp hidden] image create photo hidden interp hide {} hidden image delete hidden - list [image names] [interp hidden] -} [list $l $h] + set res1 [list [imageNames] [interp hidden]] + set res2 [list $l $h] + expr {$res1 eq $res2} +} -result 1 -eval image delete [image names] -test image-15.1 {deleting image does not make widgets forget about it} { +test image-15.1 {deleting image does not make widgets forget about it} -setup { .c delete all + imageCleanup +} -body { image create photo foo -width 10 -height 10 .c create image 10 10 -image foo -tags i1 -anchor nw update set x [.c bbox i1] - lappend x [image names] + lappend x [imageNames] image delete foo - lappend x [image names] + lappend x [imageNames] image create photo foo -width 20 -height 20 - lappend x [.c bbox i1] [image names] -} {10 10 20 20 foo {} {10 10 30 30} foo} + lappend x [.c bbox i1] [imageNames] +} -cleanup { + .c delete all + imageCleanup +} -result {10 10 20 20 foo {} {10 10 30 30} foo} destroy .c -eval image delete [image names] +imageFinish # cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/imgBmap.test b/tests/imgBmap.test index edbb8c3..5ffd7c4 100644 --- a/tests/imgBmap.test +++ b/tests/imgBmap.test @@ -7,9 +7,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +imageInit set data1 {#define foo_width 16 #define foo_height 16 @@ -31,123 +33,153 @@ set data2 { makeFile $data1 foo.bm makeFile $data2 foo2.bm -eval image delete [image names] -canvas .c -pack .c -update -image create bitmap i1 -.c create image 200 100 -image i1 +imageCleanup +#canvas .c +#pack .c +#update +#image create bitmap i1 +#.c create image 200 100 -image i1 update proc bgerror msg { global errMsg set errMsg $msg } -test imageBmap-1.1 {options for bitmap images} { + +test imageBmap-1.1 {options for bitmap images} -body { image create bitmap i1 -background #123456 lindex [i1 configure -background] 4 -} {#123456} -test imageBmap-1.2 {options for bitmap images} { +} -cleanup { + image delete i1 +} -result {#123456} +test imageBmap-1.2 {options for bitmap images} -setup { + destroy .c + pack [canvas .c] + update +} -body { set errMsg {} image create bitmap i1 -background lousy + .c create image 200 100 -image i1 update list $errMsg $errorInfo -} {{unknown color name "lousy"} {unknown color name "lousy" +} -cleanup { + image delete i1 + destroy .c +} -result {{unknown color name "lousy"} {unknown color name "lousy" (while configuring image "i1")}} -test imageBmap-1.3 {options for bitmap images} { +test imageBmap-1.3 {options for bitmap images} -body { image create bitmap i1 -data $data1 lindex [i1 configure -data] 4 -} $data1 -test imageBmap-1.4 {options for bitmap images} { - list [catch {image create bitmap i1 -data bogus} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-1.5 {options for bitmap images} { +} -result $data1 +test imageBmap-1.4 {options for bitmap images} -body { + image create bitmap i1 -data bogus +} -returnCodes error -result {format error in bitmap data} +test imageBmap-1.5 {options for bitmap images} -body { image create bitmap i1 -file foo.bm lindex [i1 configure -file] 4 -} foo.bm -test imageBmap-1.6 {options for bitmap images} { +} -result foo.bm +test imageBmap-1.6 {options for bitmap images} -body { list [catch {image create bitmap i1 -file bogus} msg] [string tolower $msg] -} {1 {couldn't read bitmap file "bogus": no such file or directory}} -test imageBmap-1.7 {options for bitmap images} { +} -result {1 {couldn't read bitmap file "bogus": no such file or directory}} +test imageBmap-1.7 {options for bitmap images} -body { image create bitmap i1 -foreground #00ff00 lindex [i1 configure -foreground] 4 -} {#00ff00} -test imageBmap-1.8 {options for bitmap images} { +} -cleanup { + image delete i1 +} -result {#00ff00} +test imageBmap-1.8 {options for bitmap images} -setup { + destroy .c + pack [canvas .c] + update +} -body { set errMsg {} image create bitmap i1 -foreground bad_color + .c create image 200 100 -image i1 update list $errMsg $errorInfo -} {{unknown color name "bad_color"} {unknown color name "bad_color" +} -cleanup { + destroy .c + image delete i1 +} -result {{unknown color name "bad_color"} {unknown color name "bad_color" (while configuring image "i1")}} -test imageBmap-1.9 {options for bitmap images} { +test imageBmap-1.9 {options for bitmap images} -body { image create bitmap i1 -data $data1 -maskdata $data2 lindex [i1 configure -maskdata] 4 -} $data2 -test imageBmap-1.10 {options for bitmap images} { - list [catch {image create bitmap i1 -data $data1 -maskdata bogus} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-1.11 {options for bitmap images} { +} -result $data2 +test imageBmap-1.10 {options for bitmap images} -body { + image create bitmap i1 -data $data1 -maskdata bogus +} -returnCodes error -result {format error in bitmap data} +test imageBmap-1.11 {options for bitmap images} -body { image create bitmap i1 -file foo.bm -maskfile foo2.bm lindex [i1 configure -maskfile] 4 -} foo2.bm -test imageBmap-1.12 {options for bitmap images} { +} -result foo2.bm +test imageBmap-1.12 {options for bitmap images} -body { list [catch {image create bitmap i1 -data $data1 -maskfile bogus} msg] \ [string tolower $msg] -} {1 {couldn't read bitmap file "bogus": no such file or directory}} +} -result {1 {couldn't read bitmap file "bogus": no such file or directory}} rename bgerror {} -test imageBmap-2.1 {ImgBmapCreate procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap -gorp dum} msg] $msg [image names] -} {1 {unknown option "-gorp"} {}} -test imageBmap-2.2 {ImgBmapCreate procedure} { - eval image delete [image names] - .c delete all + +test imageBmap-2.1 {ImgBmapCreate procedure} -setup { + imageCleanup +} -body { + list [catch {image create bitmap -gorp dum} msg] $msg [imageNames] +} -result {1 {unknown option "-gorp"} {}} +test imageBmap-2.2 {ImgBmapCreate procedure} -setup { + imageCleanup +} -body { image create bitmap image1 - list [info commands image1] [image names] \ + list [info commands image1] [imageNames] \ [image width image1] [image height image1] \ [lindex [image1 configure -foreground] 4] \ [lindex [image1 configure -background] 4] -} {image1 image1 0 0 #000000 {}} +} -cleanup { + image delete image1 +} -result {image1 image1 0 0 #000000 {}} -test imageBmap-3.1 {ImgBmapConfigureMaster procedure, memory de-allocation} { + +test imageBmap-3.1 {ImgBmapConfigureMaster procedure, memory de-allocation} -body { image create bitmap i1 -data $data1 i1 configure -data $data1 -} {} -test imageBmap-3.2 {ImgBmapConfigureMaster procedure} { +} -cleanup { + image delete i1 +} -result {} +test imageBmap-3.2 {ImgBmapConfigureMaster procedure} -body { image create bitmap i1 -data $data1 list [catch {i1 configure -data bogus} msg] $msg [image width i1] \ [image height i1] -} {1 {format error in bitmap data} 16 16} -test imageBmap-3.3 {ImgBmapConfigureMaster procedure, memory de-allocation} { +} -result {1 {format error in bitmap data} 16 16} +test imageBmap-3.3 {ImgBmapConfigureMaster procedure, memory de-allocation} -body { image create bitmap i1 -data $data1 -maskdata $data2 i1 configure -maskdata $data2 -} {} -test imageBmap-3.4 {ImgBmapConfigureMaster procedure} { +} -cleanup { + image delete i1 +} -result {} +test imageBmap-3.4 {ImgBmapConfigureMaster procedure} -body { image create bitmap i1 - list [catch {i1 configure -maskdata $data2} msg] $msg -} {1 {can't have mask without bitmap}} -test imageBmap-3.5 {ImgBmapConfigureMaster procedure} { - list [catch {image create bitmap i1 -data $data1 -maskdata { + i1 configure -maskdata $data2 +} -returnCodes error -result {can't have mask without bitmap} +test imageBmap-3.5 {ImgBmapConfigureMaster procedure} -body { + image create bitmap i1 -data $data1 -maskdata { #define foo_width 8 #define foo_height 16 static char foo_bits[] = { 0xff, 0xff, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0xff, 0xff, 0xff, 0xff, 0x81, 0x81}; } - } msg] $msg -} {1 {bitmap and mask have different sizes}} -test imageBmap-3.6 {ImgBmapConfigureMaster procedure} { - list [catch {image create bitmap i1 -data $data1 -maskdata { +} -returnCodes error -result {bitmap and mask have different sizes} +test imageBmap-3.6 {ImgBmapConfigureMaster procedure} -body { + image create bitmap i1 -data $data1 -maskdata { #define foo_width 16 #define foo_height 8 static char foo_bits[] = { 0xff, 0xff, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0xff, 0xff, 0xff, 0xff, 0x81, 0x81}; } - } msg] $msg -} {1 {bitmap and mask have different sizes}} -test imageBmap-3.7 {ImgBmapConfigureMaster procedure} { +} -returnCodes error -result {bitmap and mask have different sizes} +test imageBmap-3.7 {ImgBmapConfigureMaster procedure} -setup { + destroy .c + pack [canvas .c] +} -body { image create bitmap i1 -data $data1 .c create image 100 100 -image i1 -tags i1.1 -anchor nw .c create image 200 100 -image i1 -tags i1.2 -anchor nw @@ -163,63 +195,58 @@ test imageBmap-3.7 {ImgBmapConfigureMaster procedure} { } update list [image width i1] [image height i1] [.c bbox i1.1] [.c bbox i1.2] -} {15 14 {100 100 115 114} {200 100 215 114}} +} -cleanup { + image delete i1 + destroy .c +} -result {15 14 {100 100 115 114} {200 100 215 114}} -test imageBmap-4.1 {ImgBmapConfigureInstance procedure: check error handling} { + +test imageBmap-4.1 {ImgBmapConfigureInstance procedure: check error handling} -setup { + destroy .c + pack [canvas .c] + update +} -body { proc bgerror args {} - .c delete all image create bitmap i1 -file foo.bm .c create image 100 100 -image i1 update i1 configure -foreground bogus update -} {} +} -cleanup { + image delete i1 + destroy .c +} -result {} + -test imageBmap-5.1 {GetBitmapData procedure} { +test imageBmap-5.1 {GetBitmapData procedure} -body { list [catch {image create bitmap -file ~bad_user/a/b} msg] \ [string tolower $msg] -} {1 {user "bad_user" doesn't exist}} -test imageBmap-5.2 {GetBitmapData procedure} { +} -result {1 {user "bad_user" doesn't exist}} +test imageBmap-5.2 {GetBitmapData procedure} -body { list [catch {image create bitmap -file bad_name} msg] [string tolower $msg] -} {1 {couldn't read bitmap file "bad_name": no such file or directory}} -test imageBmap-5.3 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap -data { }} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.4 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap -data {#define foo2_width}} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.5 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap -data {#define foo2_width gorp}} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.6 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap -data {#define foo2_width 1.4}} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.7 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap -data {#define foo2_height}} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.8 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap -data {#define foo2_height gorp}} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.9 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap -data {#define foo2_height 1.4}} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.10 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all +} -result {1 {couldn't read bitmap file "bad_name": no such file or directory}} +test imageBmap-5.3 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap -data { } +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.4 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap -data "#define foo2_width" +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.5 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap -data "#define foo2_width gorp" +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.6 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap -data "#define foo2_width 1.4" +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.7 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap -data "#define foo2_height" +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.8 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap -data "#define foo2_height gorp" +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.9 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap -data "#define foo2_height 1.4" +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.10 {GetBitmapData procedure} -setup {imageCleanup} -body { image create bitmap i1 -data { #define foo2_height 14 #define foo2_width 15 xx _widtg 18 xwidth 18 _heighz 18 xheight 18 @@ -230,10 +257,10 @@ test imageBmap-5.10 {GetBitmapData procedure} { 0xff, 0xff}; } list [image width i1] [image height i1] -} {15 14} -test imageBmap-5.11 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all +} -cleanup { + image delete i1 +} -result {15 14} +test imageBmap-5.11 {GetBitmapData procedure} -setup {imageCleanup} -body { image create bitmap i1 -data { _height 14 _width 15 char { @@ -243,11 +270,11 @@ test imageBmap-5.11 {GetBitmapData procedure} { 0xff, 0xff} } list [image width i1] [image height i1] -} {15 14} -test imageBmap-5.12 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap i1 -data { +} -cleanup { + image delete i1 +} -result {15 14} +test imageBmap-5.12 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap i1 -data { #define foo2_height 14 #define foo2_width 15 static short foo2_bits[] = { @@ -255,12 +282,10 @@ test imageBmap-5.12 {GetBitmapData procedure} { 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0xff}; - }} msg] $msg -} {1 {format error in bitmap data; looks like it's an obsolete X10 bitmap file}} -test imageBmap-5.13 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap i1 -data { + } +} -returnCodes error -result {format error in bitmap data; looks like it's an obsolete X10 bitmap file} +test imageBmap-5.13 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap i1 -data { #define foo2_height 16 #define foo2_width 16 static char foo2_bits[] = @@ -268,28 +293,22 @@ test imageBmap-5.13 {GetBitmapData procedure} { 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0xff; - }} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.14 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap i1 -data { + } +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.14 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap i1 -data { #define foo2_width 16 static char foo2_bits[] = { - 0xff, 0xff, 0xff, }}} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.15 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap i1 -data { + 0xff, 0xff, 0xff, }} +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.15 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap i1 -data { #define foo2_height 16 static char foo2_bits[] = { - 0xff, 0xff, 0xff, }}} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.16 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap i1 -data { + 0xff, 0xff, 0xff, }} +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.16 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap i1 -data { #define foo2_height 16 #define foo2_width 16 static char foo2_bits[] = { @@ -297,12 +316,10 @@ test imageBmap-5.16 {GetBitmapData procedure} { 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, foo}; - }} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-5.17 {GetBitmapData procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap i1 -data " + } +} -returnCodes error -result {format error in bitmap data} +test imageBmap-5.17 {GetBitmapData procedure} -setup {imageCleanup} -body { + image create bitmap i1 -data " #define foo2_height 16 #define foo2_width 16 static char foo2_bits[] = \{ @@ -310,67 +327,66 @@ test imageBmap-5.17 {GetBitmapData procedure} { 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff - "} msg] $msg -} {1 {format error in bitmap data}} + " +} -returnCodes error -result {format error in bitmap data} -test imageBmap-6.1 {NextBitmapWord procedure} { - eval image delete [image names] - .c delete all - list [catch {image create bitmap i1 -data {1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890}} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-6.2 {NextBitmapWord procedure} { - eval image delete [image names] - .c delete all + +test imageBmap-6.1 {NextBitmapWord procedure} -setup {imageCleanup} -body { + image create bitmap i1 -data {1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890} +} -returnCodes error -result {format error in bitmap data} +test imageBmap-6.2 {NextBitmapWord procedure} -setup {imageCleanup} -body { makeFile {1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890} foo3.bm - list [catch {image create bitmap i1 -file foo3.bm} msg] $msg -} {1 {format error in bitmap data}} -test imageBmap-6.3 {NextBitmapWord procedure} { - eval image delete [image names] - .c delete all + image create bitmap i1 -file foo3.bm +} -returnCodes error -result {format error in bitmap data} +test imageBmap-6.3 {NextBitmapWord procedure} -setup {imageCleanup} -body { makeFile { } foo3.bm - list [catch {image create bitmap i1 -file foo3.bm} msg] $msg -} {1 {format error in bitmap data}} + image create bitmap i1 -file foo3.bm +} -returnCodes error -result {format error in bitmap data} removeFile foo3.bm -eval image delete [image names] -.c delete all + +imageCleanup +# Image used in 7.* tests image create bitmap i1 -test imageBmap-7.1 {ImgBmapCmd procedure} { - list [catch {i1} msg] $msg -} {1 {wrong # args: should be "i1 option ?arg arg ...?"}} -test imageBmap-7.2 {ImgBmapCmd procedure, "cget" option} { - list [catch {i1 cget} msg] $msg -} {1 {wrong # args: should be "i1 cget option"}} -test imageBmap-7.3 {ImgBmapCmd procedure, "cget" option} { - list [catch {i1 cget a b} msg] $msg -} {1 {wrong # args: should be "i1 cget option"}} -test imageBmap-7.4 {ImgBmapCmd procedure, "cget" option} { +test imageBmap-7.1 {ImgBmapCmd procedure} -body { + i1 +} -returnCodes error -result {wrong # args: should be "i1 option ?arg ...?"} +test imageBmap-7.2 {ImgBmapCmd procedure, "cget" option} -body { + i1 cget +} -returnCodes error -result {wrong # args: should be "i1 cget option"} +test imageBmap-7.3 {ImgBmapCmd procedure, "cget" option} -body { + i1 cget a b +} -returnCodes error -result {wrong # args: should be "i1 cget option"} +test imageBmap-7.4 {ImgBmapCmd procedure, "cget" option} -body { i1 co -foreground #123456 i1 cget -foreground -} {#123456} -test imageBmap-7.5 {ImgBmapCmd procedure, "cget" option} { - list [catch {i1 cget -stupid} msg] $msg -} {1 {unknown option "-stupid"}} -test imageBmap-7.6 {ImgBmapCmd procedure} { +} -result {#123456} +test imageBmap-7.5 {ImgBmapCmd procedure, "cget" option} -body { + i1 cget -stupid +} -returnCodes error -result {unknown option "-stupid"} +test imageBmap-7.6 {ImgBmapCmd procedure} -body { llength [i1 configure] -} {6} -test imageBmap-7.7 {ImgBmapCmd procedure} { +} -result {6} +test imageBmap-7.7 {ImgBmapCmd procedure} -body { i1 co -foreground #001122 i1 configure -foreground -} {-foreground {} {} #000000 #001122} -test imageBmap-7.8 {ImgBmapCmd procedure} { - list [catch {i1 configure -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test imageBmap-7.9 {ImgBmapCmd procedure} { - list [catch {i1 configure -foreground #221100 -background} msg] $msg -} {1 {value for "-background" missing}} -test imageBmap-7.10 {ImgBmapCmd procedure} { - list [catch {i1 gorp} msg] $msg -} {1 {bad option "gorp": must be cget or configure}} +} -result {-foreground {} {} #000000 #001122} +test imageBmap-7.8 {ImgBmapCmd procedure} -body { + i1 configure -gorp +} -returnCodes error -result {unknown option "-gorp"} +test imageBmap-7.9 {ImgBmapCmd procedure} -body { + i1 configure -foreground #221100 -background +} -returnCodes error -result {value for "-background" missing} +test imageBmap-7.10 {ImgBmapCmd procedure} -body { + i1 gorp +} -returnCodes error -result {bad option "gorp": must be cget or configure} -test imageBmap-8.1 {ImgBmapGet/Free procedures, shared instances} { - eval image delete [image names] - .c delete all + +test imageBmap-8.1 {ImgBmapGet/Free procedures, shared instances} -setup { + destroy .c + pack [canvas .c] + update +} -body { image create bitmap i1 -data $data1 .c create image 50 100 -image i1 -tags i1.1 .c create image 150 100 -image i1 -tags i1.2 @@ -386,43 +402,68 @@ test imageBmap-8.1 {ImgBmapGet/Free procedures, shared instances} { i1 configure -background black update image delete i1 -} {} +} -cleanup { + destroy .c +} -result {} + -test imageBmap-9.1 {ImgBmapDisplay procedure, nothing to display} { +test imageBmap-9.1 {ImgBmapDisplay procedure, nothing to display} -setup { + destroy .c + pack [canvas .c] + update +} -body { proc bgerror args {} - eval image delete [image names] - .c delete all + imageCleanup image create bitmap i1 -data $data1 .c create image 50 100 -image i1 -tags i1.1 i1 configure -data {} update -} {} -test imageBmap-9.2 {ImgBmapDisplay procedure, nothing to display} { +} -cleanup { + image delete i1 + destroy .c +} -result {} +test imageBmap-9.2 {ImgBmapDisplay procedure, nothing to display} -setup { + destroy .c + pack [canvas .c] + update +} -body { proc bgerror args {} - eval image delete [image names] + imageCleanup .c delete all image create bitmap i1 -data $data1 .c create image 50 100 -image i1 -tags i1.1 i1 configure -foreground bogus update -} {} +} -cleanup { + image delete i1 + destroy .c +} -result {} if {[info exists bgerror]} { rename bgerror {} } -test imageBmap-10.1 {ImgBmapFree procedure, resource freeing} { - eval image delete [image names] - .c delete all + +test imageBmap-10.1 {ImgBmapFree procedure, resource freeing} -setup { + destroy .c + pack [canvas .c] + update +} -body { + imageCleanup image create bitmap i1 -data $data1 -maskdata $data2 -foreground #112233 \ -background #445566 .c create image 100 100 -image i1 update .c delete all image delete i1 -} {} -test imageBmap-10.2 {ImgBmapFree procedures, unlinking} { - eval image delete [image names] - .c delete all +} -cleanup { + destroy .c +} -result {} +test imageBmap-10.2 {ImgBmapFree procedures, unlinking} -setup { + destroy .c + pack [canvas .c] + update +} -body { + imageCleanup image create bitmap i1 -data $data1 -maskdata $data2 -foreground #112233 \ -background #445566 .c create image 100 100 -image i1 @@ -438,32 +479,41 @@ test imageBmap-10.2 {ImgBmapFree procedures, unlinking} { destroy .b1 update .c delete all -} {} +} -cleanup { + image delete i1 + deleteWindows +} -result {} -test imageBmap-11.1 {ImgBmapDelete procedure} { + +test imageBmap-11.1 {ImgBmapDelete procedure} -body { image create bitmap i2 -file foo.bm -maskfile foo2.bm image delete i2 info command i2 -} {} -test imageBmap-11.2 {ImgBmapDelete procedure} { +} -result {} +test imageBmap-11.2 {ImgBmapDelete procedure} -body { image create bitmap i2 -file foo.bm -maskfile foo2.bm rename i2 newi2 set x [list [info command i2] [info command new*] [newi2 cget -file]] image delete i2 lappend x [info command new*] -} {{} newi2 foo.bm {}} +} -result {{} newi2 foo.bm {}} + -test imageBmap-12.1 {ImgBmapCmdDeletedProc procedure} { +test imageBmap-12.1 {ImgBmapCmdDeletedProc procedure} -body { image create bitmap i2 -file foo.bm -maskfile foo2.bm rename i2 {} - list [lsearch -exact [image names] i2] [catch {i2 foo} msg] $msg -} {-1 1 {invalid command name "i2"}} + list [lsearch -exact [imageNames] i2] [catch {i2 foo} msg] $msg +} -result {-1 1 {invalid command name "i2"}} removeFile foo.bm removeFile foo2.bm -destroy .c -eval image delete [image names] +imageFinish # cleanup cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/imgPNG.test b/tests/imgPNG.test new file mode 100644 index 0000000..0757411 --- /dev/null +++ b/tests/imgPNG.test @@ -0,0 +1,1116 @@ +# This file is a Tcl script to test out the code in tkImgFmtPNG.c, which reads +# and write PNG-format image files for photo widgets. The files is organized +# in the standard fashion for Tcl tests. +# +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 1998 Willem van Schaik (images only) +# Copyright (c) 2008 Donal K. Fellows +# All rights reserved. + +package require tcltest 2.2 +namespace import ::tcltest::* +eval tcltest::configure $argv +tcltest::loadTestedCommands +imageInit + +namespace eval png { + variable encoded + # Key names are from the names of the source images, which come from + # http://www.schaik.com/pngsuite/pngsuite.html + # The exception is "BadX", which is used to test handling badly compressed + # images. + array set encoded { + basn0g08 "iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAAAAABWESUoAAAABGdBTUEAAYag +MeiWXwAAAEFJREFUeJxjZGAkABQIyLMMBQWMDwgp+PcfP2B5MBwUMMoRkGdkonlcDAYFjI/wyv7/z/ +iH5nExGBQwyuCVZWQEAFDl/nE14thZAAAAAElFTkSuQmCC" + basn2c08 "iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAIAAAD8GO2jAAAABGdBTUEAAYag +MeiWXwAAAEhJREFUeJzt1cEJADAMAkCF7JH9t3ITO0Qr9KH4zuErtA0EO4AKFPgcoO3kfUx4QIECD0 +qHH8KEBxQo8KB0OCOpQIG7cHejwAGCsfleD0DPSwAAAABJRU5ErkJggg==" + basn3p08 "iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAMAAABEpIrGAAAABGdBTUEAAYag +MeiWXwAAAwBQTFRFIkQA9f/td/93y///EQoAOncAIiL//xH/EQAAIiIA/6xVZv9m/2Zm/wH/IhIA3P +//zP+ZRET/AFVVIgAAy8v/REQAVf9Vy8sAMxoA/+zc7f//5P/L/9zcRP9EZmb/MwAARCIA7e3/ZmYA +/6RE//+q7e0AAMvL/v///f/+//8BM/8zVSoAAQH/iIj/AKqqAQEARAAAiIgA/+TLulsAIv8iZjIA// ++Zqqr/VQAAqqoAy2MAEf8R1P+qdzoA/0RE3GsAZgAAAf8BiEIA7P/ca9wA/9y6ADMzAO0A7XMA//+I +mUoAEf//dwAA/4MB/7q6/nsA//7/AMsA/5mZIv//iAAA//93AIiI/9z/GjMAAACqM///AJkAmQAAAA +ABMmYA/7r/RP///6r/AHcAAP7+qgAASpkA//9m/yIiAACZi/8RVf///wEB/4j/AFUAABER///+//3+ +pP9EZv///2b/ADMA//9V/3d3AACI/0T/ABEAd///AGZm///tAAEA//XtERH///9E/yL//+3tEREAiP +//AAB3k/8iANzcMzP//gD+urr/mf//MzMAY8sAuroArP9V///c//8ze/4A7QDtVVX/qv//3Nz/VVUA +AABm3NwA3ADcg/8Bd3f//v7////L/1VVd3cA/v4AywDLAAD+AQIAAQAAEiIA//8iAEREm/8z/9SqAA +BVmZn/mZkAugC6KlUA/8vLtP9m/5sz//+6qgCqQogAU6oA/6qqAADtALq6//8RAP4AAABEAJmZmQCZ +/8yZugAAiACIANwA/5MiAADc/v/+qlMAdwB3AgEAywAAAAAz/+3/ALoA/zMz7f/t/8SIvP93AKoAZg +BmACIi3AAA/8v/3P/c/4sRAADLAAEBVQBVAIgAAAAiAf//y//L7QAA/4iIRABEW7oA/7x3/5n/AGYA +uv+6AHd3c+0A/gAAMwAzAAC6/3f/AEQAqv+q//7+AAARIgAixP+IAO3tmf+Z/1X/ACIA/7RmEQARCh +EA/xER3P+6uv//iP+IAQAB/zP/uY7TYgAAAbFJREFUeJwNwQcACAQQAMBHqIxIZCs7Mwlla1hlZ+8V +itCw9yoqNGiYDatsyt6jjIadlVkysve+u5jC9xTmV/qyl6bcJR7kAQZzg568xXmuE2lIyUNM5So7OM +AFIhvp+YgGvEtFNnOKeJonSEvwP9NZzhHiOfLzBXPoxKP8yD6iPMXITjP+oTdfsp14lTJMJjGtOMFQ +fiFe4wWK8BP7qUd31hBNqMos2tKYFbRnJdGGjTzPz2yjEA1ZSKymKCM5ylaWcJrZxCZK8jgfU4vc/M +W3xE7K8RUvsZb3Wc/XxCEqk4v/qMQlFvMZcZIafMOnLKM13zGceJNqPMU4KnCQAqQgbrKHpXSgFK/Q +n6REO9YxjWE8Sx2SMJD4jfl8wgzy0YgPuEeUJQcD6EoWWpCaHsQkHuY9RpGON/icK0RyrvE680jG22 +TlHaIbx6jLnySkF+M5QxzmD6pwkTsMoSAdidqsojipuMyHzOQ4sYgfyElpzjKGErQkqvMyC7jFv9xm +BM2JuTzDRDLxN4l4jF1EZjIwmhfZzSOMpT4xiH70IQG/k5En2UKcowudycsG8jCBmtwHgRv+EIeWyO +AAAAAASUVORK5CYII=" + basn6a08 "iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAAYag +MeiWXwAAAG9JREFUeJzt1jEKgDAMRuEnZGhPofc/VQSPIcTdxUV4HVLoUCj8H00o2YoBMF57fpz/uj +ODHXUFRwPKBqj5DVigB041HiJ9gFyCVOMbsEIPXNwuAHkgiJL/4qABNqB7QAeUPBAE2QAZUDZAfwEb +8ABSIBqcFg+4TAAAAABJRU5ErkJggg==" + + BadX "iVBORw0KGgoAAAANSUhEUgAAAAUAAAAFCAYAAACNbyblAAAABHNCSVQICAgIfAhk +iAAAABN0RVh0U29mdHdhcmUAVGsgOC42YjEuMcrtT1oAAAAcSURBVHicYmBgYPjPgAr+ozP+o0uj68 +BUiWEmAAAA//8SozfjAAAAAElFTkSuQmCC" + MultiIDAT "iVBORw0KGgoAAAANSUhEUgAAAN8AAADUCAYAAAAcPvbvAAAAAXNSR0IArs4 +c6QAAAAZiS0dEAP8A/wD/oL2nkwAAAAlwSFlzAAALEwAACxMBAJqcGAAAAAd0SU1FB9oEGQQKMpLRO +uoAACAASURBVHja7L158GbZWd/3ec45977bb+2e7p7pnu7ZNzFaRhJCwggjsHqUCgUhiWMSJymwUoV +UlkumJChCHFWBywQQNqhYpFDB2Ljs2EWqiAmphMQVO2ATQMJCQsuMZrp7lt5++7ve9957lid/3Ptbu +tWjGRAgZvo9XW//3vXe973nfM/zPN9nE1VlMf58RwHkgFMgJhDAQg0EAJQ+FuYekgVrCBope5YK6F3 +8Vw9UCdbvOnuBwbH2aDnBKy7rtkcA357PYHC0B0/t2xfjaz7M4hJ8jS+6fPnriqKqxLqG1IDTGINpP +9vtds8bY85j5ABoYBAxX3ly5dbnW4wF+G7PoTcDpvnnYyDEeACYJOlgsozN3xMS71Fx7RQaFIOIbY6 +n5iaMpQX4/gIOt7gEf/7jyzFgQMFIAxODQSShmYXcgICmRr5F9dlwPH3XaFJw3LgMjFcsgiDtcZAG1 +HIEsArIAnwLybcA30urnQcPjSHr5GBNK7kSgpLq6h0XLz63fP36xjKYd4AlYUgYdF/t1MPJlVtJv8V +YgO92vujmFmJQblAUFbWmfXPCZQaH4mezJ5/+wtM8//yLBJ+ePFQ7pQGdtjhTGkl49LiSFuBbgG8h+ +V5OJU0CAQVJJBQxIBqY7uw8+fyFS2xcvkooqycPxBzSqJU3MjcHE5yOAnAxFjbf7bzjyVG06Y07YWy +ghEps3AUaMJpB7U8Ue8MnptvbpKSkyj9BTCewbMm+TccR6WdvBLoutM6F5FtIvpvuHFE7DaAaMRiCJ +hKxnSUlFMW7r1+8ZIrNberhmPHWhsHIu20r16K2yE2HgL55khd+3QX4FuMWNh8KouDUoijG2saWA9B +EPR6f37t8Fb+zTbW1wdVnn0GHu+eJFYaAMa0uc8MxzWKiF2rnYtys/+nNkjA1Dw4kIAaIiCYAmW3vv +Pv6xUuc7uY4Z5ltXENC9W6siKKaNEEAK6ZVZxVEDjRbARC7uP4LybcY6WYNsbXVGuDpwStiFIJ//Wh +r+/Tw6nXcdEI2m7B96Vn8aPc0qX49VIjEBls36pmAaX2A5gZ1dDEW4LvtheCNd1ppqPsATc39afHke +GsLijlrKXDMKDoZUY92INZPQiASUEmo6OEBAJI2t1ucZzEW4Lttgbcv/W54UsEeqIsREWE2Gp7fvbZ +BR4S7Bl1ODnosWaXY2wZfnBcCSiRoA8B9cuWQYJEF8BbgW4yviMZDbbMJsEYRUm+8s/fOzWtX6RmHK +Ut0NiVMp1x5/iJpMn4n0LMI1jQ2nR7x56nqIfAWbr4F+BbjKxuDgrR2HwDvms7GnclwhBXDXXcc5/j +qEsu9LnVRoMF3IL1LSXitSC3CVF5Kx12MBfhu0xGlSa2LBKDCUIH4AxdBSFABdcrpsgTT4jxXL3C3v +8bXZZsMj09YX4k8sLfLGy9sYj//AuxMzqc4oxTLmEQtYKRJMxIR1OjNwZ6LsQDf7TteCge29QZYAxC +Z7e6cH+/tYpLSzRyDwQDnGi9RWZawuwfz+Xln7a1z+F7JSRdjAb7b5aLv+/LM/hTI4ZNiGxUxA/D1u +d3rVx/b29zAxJqBc2TWISJ0Oh2cs1DMoJw/ZpKegxpzk355g/q5AN8CfLe7xDMcDURpH7VPqECMYAH +q8vxo8zrz4R5dha4xTQRM5ED61eMRTKcQ03nRwIGr70gcm+4ffzEW4Luth+4D0HBDzvlB1nozMY5Em +k+fjJMxnbqmbw0dlH7Ww4khxkgxn7K7s0Xc3QEfnlyRDHcTpalH/y4AuADf7Q6+fQA2twaKKg0Zo4C +zQArWj4bfJtMZfWDZGnoiZGJxJsN1crLMYjWRiikUs2+DZDNNByFl+ypnkhuBuBgL8C2YliM1WBJNU +kIEnCSopm8rtjfXw2iPzNd0ETpJMcmRuR5Z3qXb79HJLTIvYTRap6ze5lLCHg1wOfJ34eZbgG8x4KD +Y0X7mwWEiekSIUM7P+71dwniErSqcD1iUvhuQGUeISlGW1MWMajyC8QSinicq0sIs3ax7LsYCfLf3a +GWQ3giK/SBrQUE9Ops+GcZj0nRGR5WOs0iM+DJRFDVBlYQS64o4HsHuLoTwZBNMLU1qX2qSbJsSobr +A4AJ8t7vamb7M/jsqnCwKKa2HWfE2PxqSh0DXGHKxZFlGbvt08iUkyxFrsMYQZwVxcwf2Rm+j9uu0M +Z37Np+9UQ4uxgJ8ty/f8mUA5KbEdu+/rdjdttPtHZxP9GyGMYYsy8ntgKwzQIxDrSOzllTMKba3YDS +yhPBtaGyO1TKn5sDODIsJWIDv9h3xqPK3z3weAaABKOsnp7tDyuEIGyNWDClBQDBqMZIRsCQBay3UN +Wk8g2IOSZ9EBYNytGqEFV0Yfwvw3e7gS4dB00cyGQ4iXxRiMTtfjsdQB3JjceIa+w4BzYjJUadETBB +jRLwnFQVMphDj+abOpxwCW0FIB0TMYizAd9uqnfHmJ/SGx4/NJ9Nz1bRo7Lw2nAzjSEZAHT4mklpqj +YS6JtWeOJ/D1jaU1TlCfOzgcAnQ2E72AnwL8N3Wki+2ki/emMPXOt6T9+dHe0PqYk4mBougqhjnMFm +OkYwUmyBQwRBCgBShDky3d2E6AV+dv6FIRVKU2HoTF2MBvttY8qVbsjDN8N6fn02mVPOySQdKiZRS0 +6nIZs3bVZvHzrb2nGBIzGeTxu6r6/OKNhKzJXgWZQP/Yo1F9bI/T9C1iz/Spw9NQz4FejAlUlOzCp1 +sd/td/UtXcFtzenPBxBx1UKSaEC1djWQmI9VgnWsKdkahmxx6bQR/+Hm489S7TLXbKaypCrcK5Aw0x +4XFrC8k3+180aWtLn1TcmvTaUjfWRVFz1c1GiOookkQNc0tQUqJGCMpNLcYAr6uqeYlVTEnDIcwnvS +I+k5n7H7vzS8vJ78YC/DdbkP21U5p9M0YIwI4BI3x/GS3sfdSiKR0o7qoKRFCQFOCmNCgaB1IPhCqm +nI+Z+vaBmzvQEznu8YtBN0CfIuxPxKHlfxAG3uulU5pXj052xsR5h4TFQJoBFFBkqBBCSkRQ0JTQkL +CREGiIjGhdWCyNyRt7UDpn2wmObah24uxAN9C8jXgsxyEnhgEB6fDdP76+d4YrTwOi2jjXNckEA2xB +u89IQRSSGhImKRYFSQKEiCVNeONbZjOX0/ktNOI1bb+52LGF+C77S/6fkiLE0S0aXEZw7vr4Uj8aIq +UHptAVIkxIckiScAnfB3RoCSfSJUn1REJNFLRe0IZ2L56Hba2BR/f7ZKQyyKTfQG+xbhRBLZ/LKDz6 +vx8e0iazJEqYqOgEVLQJjtBHRrb/D9tX/OJWEeiT3gfqavAbDrl6vMvMrx6HWbz88S238OiR9hfqLG +wxb9GmFONIK5pfpkClszovH63H02xRY2tIyYKISopAmohKkYdYiwiilElJYtGJSbFR8XHyHQ2Z4Qy2 +tpjbVa+m17f4DQhsWFOv+peKYs9eyH5/oKOl3Jmi0jr9G4c5sH7ZhIUqMMTroontp+/Qr03oRMgzit +iHRFxzOcVVeUbuy8m6ipSzCrms5JyXlNUNUVVMatqyhjx3vO5T3+GsL17gpSeIDVBnokvZ1CPfu/91 +24sNX8TYXTkPTd/fuHIX0i+vzDgk1s41ywGS8LmFjRhswxierIajTCzCqkjztOQJ6ntdxkVrRMEJXR +NWwLekKIwrz0xRqqYmMbAqC7Y8yXF5hbj3T2ORX0STX+AGoy1reRtgHZ0U9i/LQC0kHyvOsAd3fmP/ +r35BhFNjQM91XWDsKp6cu/aJmkypxPABcUkwbSFADUJMYKvE7WPhAAhQFlFJvOaYVGyPZuyM59RG2F +rOOTChQtcfPYCeP8kIpRlgVd/ADhjDMaYryitF0BcSL5XpYr50he9bWiibYSnmGVieke5N6YTIasTJ +iQ0RKIoUSAmg8QGp943sZ6+qqnnJfO6Yh49Y18zToFpmdiaTCh9xYULl3jrpHgHa6vLeZ5PklhU9Yb +vt39/X53cB+TR3yiL8JiF5HtVECrtQr1ZnTskXJSjmeaQ3uWHw2y0tUU1miCVR+cBX3qqsmZeeXxM+ +AAxKAlH8IlyXjOrAkVITENi5Gt25gWX93YpgqesPBcuXOC5S5cy6vpdMTbnjDEeqJxHpbOINIm5Cwm +4AN+rSeodVStvBtuXfS4F9jl/cRnU/j17W9vMRmPK0QSqQKw9ofZ4HwkpNfl7SQkRYoI6wLyqmc5Lp +mXFuCzZLefszAtmGilCYFRMufDsRa5duwZJ35PlOYmm0vVR6bYfK3qzyvxSqvViLMD3qrL/jt72e+g +RA8TIfDw+v7O13YSKKahP0AZNp5RIsZFWPgbqumY2K5jNCiazOZNpwd5kyt5sxrAoGFZzJlXF3mzGX +jHl0vPP8cUvfpFrl198/7ycU6Wasizx3h+omfsbxa1s1sVY2HyvKgl4VPW81YKeT6agynhv7wlV/Ya +969f/zQvPPTfU0fj1/WKe+yph6pqQwoHNl2IilR5becblDF/VFMWcopgz9XOmEijUU2lgHEpCo9zyw +niHX//1X+daXXDPGx+v1s/c9Uf3nzr7h4PB4FMrKyu/NxgMPu2cwzl3S9fBwtb7MzRPbscdzlPSRFO +aI38P1QCNbRl3A02nythkipvGZhqSYxBsW+jdtoX5AjAPje/cojjGOPbohhKmNWyPHg07o/Ofuv573 +7o3nn7zZ75waf36iyNOd0/zsDvDyT3D8V3F7pXEqqSQinIgTLPIuJ4xns+oqhK7u0WZAsN6zrYv2CO +wZwK7WrMdPMMI0UEQRx2UGJU867O+ssbS0hIPn+rz0GOPcuaBezlx7vTeg48/9ltn7z/3/ywtLf1fn +az7FFHJbQeNhgiI7Ta/jcbtkamSidzQ7OWw6xJH7NkbukQcGenI1ZYjStjLKWLpNaWw3Zbgq6jbhXM +IQMNhuOWhbdZEoohpc89Nk3M3ItEhawsSgfcRUUfHWaxAVU2QuEcoNvCTjbcVm1e/a+u5y99++UuXH +r/+4iYvzq+zNRrzhWcuU0yFJ+59gneefTPn/CprY5CdKZoC01QwEc/c1BSpYjgaMRmPSeWYOkUmqWY +nzNlNnqEJ7BLYS0oBeAvBCDEJITaL3ZGRGYtJBYOOpb/SY+3EKg8/+iCPPPoADz14P/efPfu5+++5/ +zeOrR3/Nddf+X1sBlmHGou3FiHD4m6AzAHAUkA14lrSRm6IZTsKmHgL4L0cqNJrzlq6TcHnj8i8tk+ +QHpnQtp7KfqMRNTe2NDcpYo0AHsE3z6YAsznMZ8StF+4bbVz861svPvXXtq9deny4vcHu9h67uyOKW +c0w9bi6tculywUuc7zjsb/EW8+9kfWxhetTBkGwBiZhxrCcUlASY2Syt8vuzg4TG6lJzJJnV0tGePb +wTEiMUGY0SfLxoAeZgaStImpY7TqCr0kR+haODWCtC2dO9Xjg7N08cP+9PPzIYzz2xjd97tT9D/4LT +p75p7jOJRBULOgpVJu+7yL7x20u3H5VNmk3twOJdnSZSbgFkF6p1HvtgO82tfluVnnayT2KMGsQOSx +BFI/clpNAqoESZAr1FN3dZHb58neEjSt/Y/vZz3+n33qR6d5lUjFC5gXMSsxc6aqBaYbfKuiUcO7Yn +Zxbu4s128ekmipFJnUAo5QamMaaedWoodW0REjsGcUnmAFjDEOUCcIMocYQ24bT+z9HJGEyg2gTvbJ +X1ViFdQd3rcCprjBQZX06x12/wAubz+CvfJ7RC59+/OzDjz1+92Ov+7vH7773X9r1E/9Qlld+nbSMq +B5tMAjGHdm72n6AB1scN25scjOAbk/ez92e0DMI6aVblB9ZC0nbGs/7QFTAz0Dn4PeIwxcZXr34vtE +LF95fXn3hDW64Q9q6gp2PWKkndDVA9IwrD7PGRTAZlexsNsdblyVWgiXtzWAcyZNlWhZ4qSnwFMkzr +ucUkwmhKhCUXQNVikzVM6RmTGRKokLwCMFkHJZpSqhCjG0omQHpOGyK9HJhJXesW+VkFjnWSwxSYm0 +1o6NTphvPcLHeZDp6jjvP3fudJ+8+951rJ05+llP242SdT5D3GgMXA9GRxCKmAxgS9gB+B3gT/hj23 +QJ8r02W6dDK+/IXbnYZxIATwVjXqqEK0yvocIPR1qXvn2xc+v5y44WzYesyDHeQ2YQVEwlaMI0zijI +yKyF4MGLIxDH2iQgcy7ucXT/NcVlC9mrCzpxU1oToKaiYSs1Ua4ahZuQLEjUWx9B6ilgzoaYgMkWpM +FTtlhL2u6NYB/ijafONHZsCSZuKZxmGnhGOLy9xetWRuznS9ayudxkc72P74OIOxcacYbmB7Ky/QWL +28cHy2g/btVM/TW/tp2EA0sPQBTVoS0Dtb1iHXXJTWyb/FstO+YpzcWuyZgG+V92wuh9QbA/L+N2kg +RpRNNU49U2ty5iI8wnFeEJ1+ffft7dx5YcmVy/eY4Zb9OsJy7MZqS4Ifs60mlJrzRSYOYPv9pDkSHN +lOvW8MJxQAnf2V1npr9IjR7ynqiLldM48VhQ2sMuMnThjr55RSMCTSMzZTCVlrCgIrdUp1AgRQY1tf +1DznTGmTZtoMtnFgBihK8rqYIn15S494zHGoM4QMsfa8SX6x3p0VnJsR+h3PaudwHo+Z9V1uT7890h +YP7vM3f+AcOcH6Zz4cczxT+COgeSI2ltgK+z3TfryZfeytEO6hd23AN+rlGVKLdjsQUNKPaIeGQOWi +EgNWkAsYLrH9Nrz37Fx5fJH0uan36LFBDcZ0asn5NMZZlpAVWI1kfX6zNVQzBOjOlImQ6kZ89ozmwa +qXh8NJaY/oPbKbFzSKZt4zTIFtmdjZnlgK824Vo8Yqyc4YZ4ikzhjO84plZbqab51gAZ8GhBnm7DRl +A515f3OtAoaFTHQdZa15WVWTc3yQFm/Y0BvOTK4w+JWLLan5B1YXepyrJuz5BLEGb1sE9KUqpjjdHy +Pqacfl+78v4Hwo7j06yI9mgbW2WsSNAvwfTUjNRJBUZLIAQD3BWAiYuIMW4+h3Ibh1fuKjed/bHbtu +e/WvW1s8RzG13RTSV8rnHiSDXgjRHGUoaJMileDOiEGZV6VVHVNSoGRF3LJGKwdww6W2B3P6UWBHK7 +MR2zHgpRnjHxkbGGKMEmBUgIlllFqgCcCLoOyVoxNaFSyrI+v64boNwZSQjGINmqvoOSZspxZus7Qz +ZTVnqWbFVhJrK320Kyg03EsrfUYDPr084yutdi8C3kXK2NyF8nzHIwlxkis5m+xMvuXRsb/XNz6Dwv +LlwyDFoCNA1/bPhN64Ae0yH4ZRb1xeg6y/EURMUfUzbQA36tb9DWz29DkcgMJZ1BsKrA6g2obf/2pD +46e//xPVpvP5VIOOUbAxjEpVKR6TvB1E6isieQcRjIk1oSipJ6XWGdY63aRgbC7MWW4B0Nfs2oyKjX +43DHLEluTMbP5jE07Z8fOSNFyfb7HOFbQ7zGtE8NQNYm1rcljLYS2sW2336GqPDE0Va7RdGDrNUlJr +i1HL9RVhSeBRnKTWOrC8Z5yYiVyx3LN8vGM0A3YvMJZQ+YsttODTg42I3OGzAIyBzGIqREzJ8kUTXv +fLXr8P0bWf1BY/5hhHRgg0kWTQxRS62o4dMLfWF9GzCthqhfge5WCzzZkgAZUTLs0E4aIY474PardF +x6eXnnqY9X1Z99jhpfpVtvkYYyJFbaqqOuKOpTU0RNRojT0ukk16gPLWYbVxMx7dveG7OzCuICQQd9 +06Ls+UWCzmOKLis3xFrNQE9YMS3ece6q/tvTUkvpn8l7/uc7S8uU/evrpjd/77L//3Vrrg3CSKBAjd +JY6fPO3fMuJc2fuXo0+3THaG5+ajEZ3b23u3Luzs/fQbDZ7tKrqR0MIxBhxNgOBmBI2h7X1LneuCHc +szRnIlCUyEgmkQ6fTpbvSxXT6YHLAkuUDxLomKkHmiKkwpkB1SEo7aNjJxdzxM87e+R4IHwT5EmRNf +bZWrVf0IKVK1dyU4vSKmJcF+F6dvgaDpoSmiDEBZxJCDWEGfkSx+dx7Z9ee/bnx5ae7rthg3VYsDyJ +pVlHNh2SlI0aPpAhWiQplnYihRjxIEqRWxCsSG4d5tMokwmYJ8+Dp9hMboxEu2904duyO3zr3yFt+5 +/RD937y9EP3ffrYqfXi+PHjdJ2lm/eoysg//p//GV+4fIW92QzyDnjfBGarcseps3zHd/4n2+e/9V3 +bBrkgQDGZsru9x+bmNpevXOPixUv9C89eemJjY+Prr2xe+cZquPHNV7bGpy5kJWeWTnLfqRWOHV9ib +bkGU2CyRNYdQLcPuYPctO1tFekstd6CACYh1mNsRZI56BzROaqepOY9Iu4zQvYBcL/UuCVsa52apn/ +EgU1oX0aqvbZUztsWfIojSUBMwJg2arHcJY2u4UdXPjG6/PT32XKXVbYxZoKppsx9Ab5ADaTUVBNTb +cu4ix7s1knbiM9sQDIdirJmo665XldMctDj8ODxR/+/1z382P/+5te98TcffvCxT9197330T6xjVwf +kq31cblnpdluvvqEeTukeW8esLLF+Yp2uXaGazyhGOzAe0ukf5/S5+7nn3gcwGknRI0mRRwUxOSkoe ++NJsbmx9e92h6N/90dPf+5nXrzwFNe++Om3msnVJ6cu/YdX5913dAtLbTJO33kS20vQyyBzIBaVCHl +AugZxDjWpkX42gDGISVgCQoVSoalAdEiQvCti/ycj+vXG1O9D+kB2xIbTWwDLvOZVztsWfHPAiWlqW +VJBtQd7zz1aXnv6l8vtS2/PptfpMselOeiUyk/xddXszXkHnxlCisRQQ1JcVLrR4MURbM64ipTGsVV +HLk2Va2VOOvXIH77hG5/453edffh/eewvv/PCmROnOLZ8nMzmuF4fBpZKGrwFLfExkAXAC5Um8rVV7 +nrsIY7dcxab7mVvZ4MvffGP2KmewWTLiPRIgPeBbu7Q1BRRIkXE5Kyur7C8tsq5mPj6b3or0/GI7Su +XPrV3+eKnys0X/l7Yu/rAeLr1nxbl9nfX4+xNK0lZ7hq6YsAl6CSkGyBXou01G45regY2RWEExGI0A ++2ACEkr0DFJLMmF77OM3yh0vxfufWq/M4U0RRPZDwpQFUQSt4MT/jUJvpeLV40iCIaUPKYcwfDFb68 +2nv0Vv/XsOpMXWLMVUo9JZUEIjVoaOzlRwUdIVommsfFcFKQ22EqoS6FMQpUN2IqWra4je+TRf/ime +9/8j85+3Tf/9j0Pv50Tp45R5nss5V26ptfEkDZNhvCAp6YvOU4S2MYeTbZElvpkp44zOHsX9698E9e +vPM/m9RE717fodI/h8iUUyPIOPswRgayTN61XmpK8GCBzlmExpjvocu9jb+Khx95ELArKve0L843LP +1EPr/3E6NqX3jk1o++Jcfw3+n5GT2qyvIasBOMJrkNmsobxwYI6iFlbCrELKQOTY6xBxZNkiEpFJH8 +7uN+RdOa/NuJ+A5Ebgq8PokTV3kB/vlbTmm5Lybcfr+m9J4333ldtXft42r2GLXcZaImLM0hzjFYkj +fgEPik+WRKCTwmDkIklw2A1EatELAJTn9A7jg3veuihn/26173548cee+u1/pk3YPp3NKU3gdwsE1E +CYAViVDxNFGSHHEtTidq6DggY5+gsD+jfsU7v5B1kaRmbL4Prg+nT7awgJqMO4AQ6rnPg0E5AUI/Sq +I8isNJfImGoGrlP3u/T651j6fg5mIw48+Djv11vf+m397Y/83cm1XPvD8Xsbw365VreqxDjUeNJhiY +bXg0kBykH6YDpgGaNamkMxiTU1CQ8ikGRdav6vyXC+61kn3jpzVNf08B79YJvvwqD9e3yAchQ7SAJJ +ArYCLZsJzEj0iGmhqdYtQEtrzLa/cxH6tFnf8RMn6ZXX6cfZ0gSfJ0obZ9pp0dpA9YnlufC2qhGxhU +lV1HXpzJ9rqaMzbpDOThJ/4GHx71TD/3kfW96x0/nayeLwYk7sUsDkgMvTZKgQ8lxbZ/0ANpMglODi +rRqZ02n1yrIyeJiYnloeHh4kjPXTrF5WgkZdPo5xIKODUg9o2MgaSK0PWj3SQyR5p7d5w6DHDpXjq7 +tDDi2SvI9smOnOH7u8WvzyfWPlNPNH9+bTr4/K/wPZo6V3ul/g8O0Lc48SAVmBq4HdkCswMgAMdrcp +ImmbTx9guN3ENP9OKyfhGM/CisoPSIdVBwqTXaEIbZpW9I0isEiWJLsZ078yYApC/B9te6C/f/slxv +j+2GbakEjSZp+JAo4Azq9wGx67aeqyZUP6XwHG0qESJSEswnNlTpUpKT0nMUqkDxBlV43Y7V3jp3xn +J1xzYQeq2fu4aGH3vrROx/9hh+zZx4eki9DtgydHvsmTRZBTERECAJW0k0exsNhxZJISPIYDMEp3kQ +K8RR4MitkxmBMw8tHX0NsAsWN2T9iOrg2+6CT/dOZfXLDHqRN7Wt5AuAskvdxA8Pyas7yfLmoJtt/b +z7d+fl5Wfywq9Z+IDlwRKyNDetJajYTX2Ftv81yaG8KaERN2w5bPRoFMdMfQbIVcB9uokw7RBXMfgG +q1haUtsOuIK8gFG0h+f5sh6V1lBug0+oqDXOmZr9ymG1CqVTa8KoKp03C53Dvkz/rp1sfCNMX6NSbd +MIEazyaRbxJBOtxNtANHkJC50qswbgOMe+wOYRa+3ROrnLs9P3/6/GH3vjfZw++/nOcvB/cEtAjkLX +2C809kWaVByXkiUQi22dJ9cbNoyEhEl4jmc0JTihsZCaeWRbpSEKMtv3VI1U9b8kfMPaw6bS0f00b4 +bKPdTWpfbW5hnqTOBDTgN9gIetBZuj0u8jy8tCWxQ/aNPsVpfi73k/+o8gYxwxjQTUQqXFm0Pye1Ep +eEsZEwKMSkDRHqUjJIzZ9SIx0IP9bhlZl1X1Hu6EtGdyUtDiQ1LIA39eMUJF547DVjJuFh0pE2x0ds +RhjMeIhjonVNn4+J3sJbgAAIABJREFU/NlUfOYDzIfk5R7dMKUrFUYitVWCicTocSZh1aNlRNWQXId +5EPZmJTtylpN3n9u4/9HHf0Duf/SfcOpuyFaBjEnlMZ0ugYjRSKd16DdxlglEiSQEPSKb2kWv+w5m0 +6Y9WRQhWqU2kXmm1B2l20qPFGvQSDkbU/s5KQasNBn3rtmBjli5h6RiPKD19QCeHKE4BAiqaFSMCJn +t4lxOvrKCWwmYSfY50vi76nj9vwrp6keTyCljSqwJGDJiDIh4DB6MYIySSFiNDfDjtJG2Mm/iZ0U/A +A6kBWBsxbc1bXpuBGl8s41/cAG+ryFh0qhjIhxGRQtgpM1gO3zKCkANYZs4e+an5uPLH3DheVwqcDq +lpw1IkiYSihdFxaC+Iq+bWibRdBipY6w5dZ5z7Bu+/Z8eP3P2b8vZe7dZPtYSDTlITt/mBG1URyMGQ +0JpJFUjftJB5rfZ93UdyaK3R1RqJ225Bm0kurTEIqmGUKOxAgJlNaepyZluTS+puQXlZI58hxslbyO +Vs0b9pAsonsi+NdntPAQ6Jo8r/4TY+z986v5MiLt/3eoca1oVX6vGpEw1ooLR/VqlCU1jjLUtW1pBi +IB8ANOpMJ0Po71Gapo2/pNmbjD7W9YipehrNmK7Z7tDjvpAcqiYg8zzxtyKiB+ixYsf8ZMvfShNnqe +fxmgscVpiUmx6HqREVEXFNZ2AEjgMErvsjj1b04yVux/jode9+f2Tx5/8RKe/3BAMCKlOmJSD67R9G +A4MLwJKTSTRqJj7nq3GDjOHdSqO/pbUSC2TBJzgIvRsRs/aRnUOnhjqJspGhBBC6+iX/RZINyauSqu +WS2Pv2S9LZk1HFDnTxp3LQV5e0ERKbeNq0za1dl3IeuSpv23Cyn9Zh+v/Noatj4c4otcFk+qmxIaax +vYODqKgSUhujN23CdVCjCQVjMs+hMgYWf1RzKBlgATIDtzxr6Vws1en2vlSmdCt8RKOTJEPu6TJc+9 +jfPFHtHge569hIxAFm1rbMQWSCjZZjOSot5jYJ3rLtHSUrsvKubOfPfvGd75Xvu6tn6q7ZxDyFkSCZ +IlcHfhIrCtsp7VDTaNm7meTpta+6rYK5Q3kkd78O2zj/EuJgeQcz/usZl160RKDPyiqiyg+xTYKxbS +M4iGQ9i1D3Y/AwbTf/Oj5jtRY0YTRhtiQNpLHqGCMO/CnRwtGOohkYLs4WQGz/gnPyqdSuvpLyvANa +iqgQJI2dnnqQuo0THQ+B8kgGdCMpAG0CfcTnf8I9uQm3PEJdBW0ByYjteqnvobaW79K2c7OgdUkN/U +VkNausQYsM2J9/dt98cLHmT6HrTfpM8FUHVJSotQEqcFEUhKcZOTapyoFX+UMx0rJEicefOJXV5/4l +u/hjvsKasF0+wcY8YBR25wvd1h3ZGGL4MQcQC0QGtuHnMOaMY1E0v2sb23ivg90Z4XMZKznfdZsn34 +URi3wQghoagKkkzSbUkwRZ83BJpUOKIvDQ+b70360sp+mG8GvjQFqjuLUt691laAGSQ5DjrErOFlG6 +HwqRvuOmMI/Smb2V50qIv5Q8pomtlNMTdKExPyAmVWzAzIlMsTK9ONodRmV34CcGDKikYbDIZG/1sB +3tLDrrRybL9f26o/jEH25CJSXjVAxDqsJlYi0/jNSE6lvAavg8IhuPTqdXviVevw0Hb9BHqeIn4NfJ +USP63ZJpmY+HZNj6CRHmM4JswHDMcSl05x93dv+fufhN3+YpbtAl6HfZ0X3yZ1WmphmXdZteUHVgJN +G/TSAbdVKpzn4gHZa8kAEpKmNWbU5bM6AltB1NDaRb36fVpHZ7hBnB9SDQdNUM0aoSmK0iHUETZgYM +GIx4g7jTTks/qRAaIkd00pc2S9Sqgl8aM7bBLG2z9/o4gkkjEgjuBKkYBBdRWwgz1JRFJP/zMTqp3y +qPiQpkhEwWjUbjQkELTHSO5BgST2aiqaqmdlkVmzR78VfEbvyjcSVp6CLNU1MbqBC94k2ubWvT1/OH +6GvbH3eqpnMV7O+bz6GO/rCX5QKxS/3HSQJxtiWSq9bQ1zaSAvIUkLDFuX04i+H0TPrprqG9buYUKK +1hyAkLFNfoXlJNrD0Uo5MHTY5ikli9eR9LD/wlh/iwdf/BMfOkOwSUfqoQB4OzSkVmqrSbU55Aqy4w +2jFqNgUW58jkFwjicy+2zkREWJLFhmg26XJWKjnzTMB6nJO9IGUEpkzDLo9+v1uQzKlRF2XWIROp9t +8NsXGxhJFbNt3r2mNSSA/IPGlrYZtDDhjkI5raf023We/h98NpE2jQps2takJSHGIDIBj9HoPkEL3w +7HubqFbP56kwEhoik6RwDbBAJKkFbgBbIExU8SCsVO8H6xnaf2Xxa6+w2oPHzKS9dibuiztO+5fMfD ++hOvvZuHzUs1Fb/X5l1rP7uY3vZI6ni91kldaA/Tl3vdy4LOpZTFl/2InEgHBYlSwcUQ5fv4Txe4X3 +h6nF+nGLWycoqEE39gW2IBPJZo8Wcfii0Q9KYhTh1s+zfI9r/ubPPaGX2DtLtT0KVu/nblpBxVpiB9 +7YJHs49K2722/6JEAfm0dx1E9QSMYiyUjxzblKzSBLyDMweYwnzOa7jGtZlCMkXyV2XREVZUQPcZ28 +VWJL+d0yKGqGollLc4KzjTpO40rXKlCxDmLaVVdrNnfxg4k+kFFQLtPc8QDTtSQHS73NhNdm8A5lFV +EcqzrIaH/E1H6E5Gdn4ddMGPQEpXG79g0+GxYUCMek0rU1DjxBH8FwvG3590Tn8D03mdjF0mCtY2mc +HQN3gy4l11fXyVpc6v2AEcfH+1S9cey+f44nUn/pJLyZSXby33pVhtCLJGGZDBGMaaCWMP88nvj+NL +3yeh5OmGbrpnhYgU+NiUK4ghjPZkoSS2pFHb2avykS69zgpNf943fx+lHf5GlY2Ac03bh2YazBBdvs +o9AVHF6hI61rSonN15lVZAUcAYy0UNLLHn8tKAeTxDvcbEexNnsLWUVX//czviR55979r4gHula+ks +ZOzs1KZTgIDeJK5cuvPj7//Zfby0hV06vrV9a6fafXhks/RHdzh/QdTP6GS6zoIG8dxxIhNRE/9AWk +lKagsLuyBc2R5z1+56drC2QpHJoUR4GrPWBHmgXMX2s7f4C2gkq+j8iHpGIamgiXlqXkW0rCxAbkid +Tj4YRKV0hsf59puM+aczJXzLSBbIb1sefhbZ2Kwy8Ekwc7U71Sr7TV0243OrH/1mrrkY4Qih0G3cCC +Sgg7T48Hz3zc2lygbzaoisVOYEUEj427B1phI1CRyHFLlUtlJMe3eX7OXnfN/5NHnvHL5Ktg+lRqCB +isEdyA8qWUbStH1H22Yx4pPx5MgcZ59q+FFoZ3Q+xKfHgmwrXlCVhOGTvyvUnh1evvHu6ufmXs1S/d +Xt7m0sbm3zu2i6f3Z4RTtxD7+RJlk2grqfU9RSKERvPX+VX/9k/vvu3fi2/u1f5J+4/eSf3nDjJfWf +Ocufpuzh5+tSn7rr37v83O3Pq/2Z58JvIDKzBSeuwbsPUQsuGtl3jOdobQY644yW2Es82AFL2k2JzI +jkSwNJBshyxFoL+Yki1A//zog7STlPZU2qMaTYEUgahf3DBslBR+WuUlaU/kJ9jIL+NnPwSVUI63a9 +q836lNt8fR7rdvCG8kk3B/XFVwj9NCfgn35oOJU5DrxsSFXUcYYvnPlbsPdXNi8t0w5CcAgioT8QQC +Ah9U0MEVxl8mROrHl13huN3v/2HePibfoHeGdTk1NZisY2/jyYoWtQQJR7MYcQ0sfpiGpZyH22tmpm +SIpaDpiqIgaKCvR2Kay8yvX71yXo0/Gv17u53za5vrs23tqEsMAaK7Q02r1zhwuVNNjTn1PG7yHOwL +tEfZJw8tcbOtSXqnRFXLj7DKFQci5Bdu4ZdP4k+/yKbS0ssrQzeevyuE289fueJD/VW+sO1Bx75tWM +nT/2L7Mzp32RlDYwF63DG4Iw9KPLHkQYy0jrkD2NEE6i2Vb1N6wDIGvZVW/85A8juAJ0hqfgFH+Ny0 +v6PO7fX2HmprasdXbMz+W5zXwIiAak3CbGkVNPtuqWPkS//B8T8K649Qf5U7L6vBg+vlKR0f5onOto +W66vZmV7281oB3QM1LkkTMjWfbnwwbT/7nlC8QF5vYutJo4a2XiJVIRIQmWNqgxQd/NjQc6dYvvdtf +597/tJP0HuAQrt4m2GBjERGQmJqYxWhk9mWRVQSBm8EPbKhxnbBWtXGPk2KpECal1RlSe+ZC4ONF59 +//+aFp98737j6qJsWZPM5bjpjuZiT+Rok0h9uszyZ0pmUKCVaFxSzEWa0RVVPIFWkOMeIkpnIshVWj +GBnE2zWxboMZjPme5a94TbF1Rewzq25Zy587513n/3eex58+KnVc/f8EsdPfJyllRm9JXAGZ8CKaWy +/g4Brc0TNrg9tWFw7n47U0r/Slg5tNJQMslWsnqIO+hPR908489SHNNaEUGJjxHiL+D7UDfhSmhFkQ +qljqrhLVUbUr7ynt3L8g3TXPnYrhv6l7L8/TcB9JSLmK61ZERE9fENPmgMVr9jV8Oe1W7yikWqQHFV +DbON3vff3TabDn6z3rrAUx0icIqGEOrZrRA4CSUJdYKocKTNc1aEzOP2rnH3zh1l/CFgi5IelBM1Bn +ficI+Kuec3YFvjtxn1EUcuATJqQMMqaajRmtLGxMtkd/kD1yT/44Gjj6nKxcY1+PWcZGJQVrvBk85o +uiUkxwQ3HdMuKbmqOlwOZgLWCMeB9RZgMkQRdJ3TEYuaBPIMlY1jPM1Z6A/KOJe900JiIoaS4fp1r4 +zGTzZ1Hj794+aMnH3jkI8fuf/BjnHAfpefGGHNY0u9A05BDt4Np07hkP5nWNoqpHrg3CandfCwgPch +Wcd7ja/fhFPRcivVfTfUEao+pM1xtMFUO0VCUFTUTStnCG4iaKKcnOBUe/Mn8xH2/Dlz6arrkyks3C +UhH1m9HRPbz1dZEZNZO8TERWQMuA7mqPqSqQVU3gHuBu4wxW+3xHgeSqu4A94vIOeAZ4F8BTzXcfDB +9iaIk5tLk3giaFCeNgh9KxMQmUxPYMeGgO52haRuV7cdNaLsDxcP5kXaBHmiLDcF3JLjpkF1LNz2+l +bY5dT2WrCEHuuUYW41h5+kf8xc/mevms6juMPVzbL/LbDRkdWUZrSMSPC4lOuEBtvdKtuou6w9+w2f +v/Pr3fA8n7yfhCVlFB0enVaYEiEZucHd5tP3VYFKiiyG0wcwekKgsKZi6hs3r8NyzuMvPfdhcufTfh +Ssvrg2KbU7UEHYnyLiiqxmxKvGxxvU6bO/uIcYy3J1TxUYF7HYGhAxkxeHSEK3HGFUGa2cotrcYT3M +GuaUT5tRqCHUkD4HV6OnOazq1xznX9Fxfyumh2Osj4m5BcfH6sr3/0t9ZfeSRD3Dv6b/HXad+in6Xm +TFEDF3pNo5t38xKMA3pYWj7zRMRIN/v856aKAfV1IRtsgRmmdQ9g5qa8rnf+p6Ujj8ymY3fsLm9waD +XJTeGrRcvMBCHqQJhpiR/Apd3yQZLXJt+hs215/O3nH/+x6aD7/7PnTEYYzoGU7VOmxzVgaruNQSuv +SdBGVLYxshZhzsJbHpiqsget41M34B4nyBnLGwJ0aZUvz4zRGLcc3C/GLmLFDeoqi4hfh1QlfnWrkl +6j/PhjPH+ReY+ow4PoBIxnU0/nJ6oxA0KsbO57SRZXV9eO3MWZOkLFenasShBRHBN3TbuxfJXCOmhe +lK8kCRdNJbjucNA/Bz4RMedoI7XmIyfO35icAqs06TPpCC1VXc3JgzB7aImQ+yAyLDhoLUDVC7UjY5 +oxGCzdFCcsa15KSJou9Ua85Uj153N0JiQELC2C+Od77hy4ep3b17axPmKoIlMG1KyLjsMQ6AsC7Lco +GJIwTMsEv0Td3HnPQ+/l8FagVpM1m0Dec0BvX60n9GhVLOkFKk1YK29octcjtK1ApMZYeM64y899eT +u5z/7P8Rrl5/ozEbEYooNNeoTqYqkOpJiatVnS/IROl08Qr6ySpzMmAOTqqCbIikFOp2MTsciLhHFo +5LwyVPWkb4Gsu4ynW63KSPhGqlknSXLWqYwyxCbgRFCiISiwF/bZmazNR2OPnpHFf+L/K6T/+1gde0 +3yZoolBgb+87YW/Wbb6+SafuqmUZsitjW4dIGutqmH3zgdPH5L372vdvb258cj4eUxRT1gfloSCoq4 +rTCNoQoSQXJOkyqimMnT5Fl93z3I39lXnT6/UhmniPEjKRvwNqalPaoyvuAu3HuslFyF/zjpDTHmG1 +SOi11fVdP9Wq79k7XdUUK9V4KfjWG2sTgVVVDDHUmMYCGqD5YXzZpW6rKXrhOMZ3h56WapMdS5ZmOZ +0wmU3zg3sIntouSwuSDux5+HW/8xm8ql1ZO/EZ/dfmjFvf7+6qTCz7hjA0YlqpUfevGePN1v//7v0t +ZTCYrvdycOrYyyJOfGV9tHVvqn7xjbd3ygr9gjPFG3FkVc0Vs53nT6R0jH3Sw7vMELcGcwtprOHcRY +9ZRtaj+ESIRl5/AmCtgLqHplAHBuc+Jyw1GTjIbb2Lci1hzByJdMM+3qFzHmFnecTVFaBLs5tPq4qe +++JHf/de/zXTzixwbVOQyoyORfidnHxp1rDl2bA0xifFsgnTXeOz0o+/n3td/iv7xJv7QdJA2/lKOE +A2N3RMPOtCikLB4E4kHCZ+JTBM2CTocM3rxMnuXLv703jNP/e3Js1+iu7vNegwMFOaxRH0T+WJtjg8 +BtRlJEsO6IACzsmQkym5o+ujWAqbTZHGrlKjU+FDgfYlYxWWCNYY86xCtEl3TOdCnSMdYTJaTd7qIQ +rSdRiUxGc5ajOsgAdJuga+Umek/Yefyf7q77c+wsvL90usgInjTBGwfePn0JjNlP33qSHaFtBRNg8n +/n7k3DbYsLet8f++whj2decw5a8ya54GiKCiGy9iIeJ3AFrBDxBuBjY3YHd1BBNGhtqKCVyIE2w4pR +em4tnJF7QtGKyiFRQ1Q85BT5XTy5Dl55n32tNZ6p/thrX3yZIFfbDvo+lJVmZVZO9dez/s+z//5D4p +IBhozr6L/7c1vP/rYsZ89eeLYZ7vbbYIpML1A5EtuQVTtc60tDdSsg5HxjKz7LMI98lOjo6M00hrOF +igPSRQHEZzI+wNsnoVYRzcqITCmwBlLCOGg9x7rClpZb48QAZzH2BxnzLjzecnxtVZ4m0WuyEtjZGe +UNwVFUewUHyLHGUev1xVb3R6Z92Qe1rt9lre7FHHKzOGr2XfkCq49fM3Rq/dd+btj6dgfEcQagK+el +w5BeCfCcSnFr5iIv3Gp/Nhm1n7Hdx5/uLVw7CVaEiYT3WgF0ZhIE8YbDeZ1uD5NU5K0HmSkJ5SObkr +qDRrNEeKkdkdpAy6dkpGK45hIxUYIpaWUQkrpXXOiLaUcr76iC0Jp4ijdoyK9JIS6gFRTUquaUPHzC +FUg2AfqPEqdRspxW1OxQj0rVN30Fxd/+cRjL7H4/CL9rS3W2Mb0V1EyoIQkjlOEVOhYMz4lsd7QTR2 +33HnrH4/uv+VzNOdBjoBPL6PsDmPExM4iePi2lTsDGZdyl4KCgCfBorICujnrz710++rpU7+7dX7hT +tobNK2hiaRlPEme47XG5AZvJcZKusbjRSAjsNrLaI6NsrzdZ90Flo0hB0KiQQaMzUvwxQ/Iiw4u2wQ +PA2vZdgHhAgfmZhG1BNFMkTouS0BHFD7graMWSlqAlBod19H1BrLWRKkU52LUagfHKmrgPiJm8/vZM +/MzshU/GYSgAJLqEBqCGyUN9PIkJMTuG7JESX0IZVczdgOHr8swf/vS55567rH77aB4r3BQBKhzyfJ +iSJ9vRnV0UOQXJC88sQorf8xIs0WjlqKlItWKZpwKFTy+yBlrNEWqVZmQaw3B2WpPWyJIPlsr52YR8 +N4SfKmDFMKhgkW6HOEtwReltX1wRK40HPbekm4VZM5AYbBFRmYsfR8wSpEkCQeuvY4H3/mDxc33Pfj +fmZz+JLXRRxEaslDupnQ5muko0riKmyhT/fjo7MTPvvEdb/qHgwenf+bbf//1I8ce/Rar58+i4xpFr +cb68hL1rI1vtQjNhpC63ABlSYxptEjqtdLXMihFkEgZoYSOyn9WKBVJ35gcF1WYYgjsCUIhVQTIeR/ +EvPG+5CYq/XqPJARCQN4ohEBKGfKJpnCFfzdW011rs/jyacIGuC3F+nqXZnMECBTGImSMFQERSc4ub +ZKZnMl7r7w4de29H5EHbgBXA1GHSFO4EiIXQ3uTcGmlcRmI5i79u8WW2y1vsReX6J84+xObzx/7/GB +xUdPeoOYtaZ6T5gW6nyH7A/JIk2cOKSKciihSTRFFdDCsqR5nN7dYaW/TMZaztmANGODoFQOCy8t5W +wyItNsR8jdHWjQD0O5ybnOdVDgSKSjqDaaSOjJOGEnqJErRiJt4qRAiBhUjiBBOIgpB7ANprFBtgwv +bBC/u1JF+DDX+AVHXf6SE+se2r5ev0XaSoAShCuUU1crGOMWBa2/njle/iaeePfGR488//0YT8lkP9 +BDEOi5vcRWhnYS4UTF3HFknsH5umbZcpZ7GjNabjKQ1CiVJpCAm0FFtrJLESiC9QwZf3fCqnHllmyB +FSQn0BQSLV6VjOcGQ5Z2y6ERFIJCOEALO5BhnmcwU/U4Hgiet1ZAqkDlDfW6ewzfczL1vffvTh2+/9 +z8zOfeHWNHbATiUqDSK5cGkh7YYttJXp1FtTc9M/tb0/a969PqDe3/xxcMH3/7M178ed86dI/WBuk6 +p56vUQ04jSKQD7y2R0NRUThISIh1jfSB4RRAaQlxaqcsYJSP6WwOElAhRra2FREiN9RLrPEJEOCHxT +uACWI+wLuB9IIQgtluaYhDAxQiriLswJiap1SStmREGRRfjyodWBEXfFJjc0+5vMT41w76bH/jYnhv +uW6M1j80kUuoStQwVMUVUKGfYDfVcGl3QQ1JvICIQY2Frg/bJY/9+7Ylnf9ktrZBsbJEUBZG3+O42R +a9P6ktl+GDgsSjQMSaKWA+WC9ttzm6us7i5wUp/q1Qf1Jv0k5ioFtMaqaG1pNlImRyt0WsnjDajSnY +OQQaS5gjWONCKdec5enGJJRkxGafsG5/k4Px+picmGScpleEyAZXiZYStDhgZFErFEJVkNz8wmI22R +okvqMnWgbhV/5VhV7mDGsrvxRCRVcBJRT8rY5OQUtLXnlpS574HH+Dc2dNri+fOfuziRv6HzTSlk2U +MQo4WEc0oKm+ioo8WnoZQ1KVkc6MDwVFPUtyIxSR9YgENJWhEGpWm5Q2HRxGIZCjzFSMNkSSvuTIqM +Bh8MCjp0TgEFu8zorreIS2GapfssFgFRW5YMV36iWfLedZsh2xsgsNHjnDo3vv8/I23f3nP7Xd+kqj +5eGa99zoi0RWKUIVjiZ22cxch1VftQUyKSMKje/bu/5fzb3nLT16/7+AHTzzx+K3nXzjG5vIyjZkx4 +jghisseXgtNLZLUIkkiA/3+JsILPBohI7xISmsHYUBHNAa2/IKkqiDsCCk11guMBYSlsJA7CM6DlwQ +fsMZgrGN7JUfJFFdEmEJS5I5+v0fhCmScsr3ZpT3IcTomE9DJAoVw5D7mrlvv//M7HnzbFxpzh0HW8 +VEJBLwyoy9Q5thdgl7lkMS4o/FUeOI8I1tdYvvYS7+x+fSzHzWnz9Bs99HdjMg5grPkvT7O5uRa4YU +k0zUGzrHZ67JuLBezgjOdLdbyHJOm7D1yN5PTU4xOTy7oVv3RIo2evlh0jy52239W1xJfdAi2TxpBs +yYIkeZNb3nzHW978I2H6qgj3cWlW+3m5r356tr+fGWVfL3NxSzHdtps6YjECXRaI1UpkYiRKiFEETK +pIdMaQSlEpCFKStex3BM6GUrrXxYqniDSv7CL6LlzKA278/LlEpdZQ4UQSo1HKMkIBsPcgTne+JY38 +OzTT3zhq1/563fnPnuXoVxTBGtAeyIHkbUEGYhI0DbDGEUaJ8Q6KWdY5xFSILRESolUIIJDCI+S1d5 +SuYqSKPBBE4IjeIFElmEwFXBmiSgGHZywWG+w3uBF6bmTmYIsy7gQOXwck8cJjE9w4IabueaBB5/Yd +8sdnxNTc1+0spkNkLgoIqZW6ksDeOOJlKRSfJVLdgUkaCy2rHBvSaVG1kZ6RPXf3Xfn2FN7Zvf94qk +Dz/7A0Wefl/n5fyh9J4MnDo7WUOLvLN4UNKMIHASh8SrCCYVBlR9CBlpxWXTOhfKGDKakJTuBM5X63 +AaC8eAFIiiEC4TC4KwhjQ1xlLDZ6dJez0DEOAKdXkbP9vCJpp05Qk2QIdiyYLSkMT7FHQ++/uNX3XQ +bVicQJHJXhJz6Hq1UEENx6qXK7HiIBSTBItvbrL700m8vPvrYh83p00z0C2r9gribo205RQovGKiIL +RzbRYctH7Pe73FqbZWVIseNjhIfPsid1x7h2ltufvi6W27+8+nZ2a/Wm/UX09E6XTPgO0ef5Utf+Qt +st0NzrlHKdFxB0S/9XGZnZ5981WsffHJ+fIoUgW1vUWy2r+8sr7xl8cTJd507euI13fUt+kJy5uVNa +i3DRJrScqArNb0TEqEjBiIQi4ASAa80SqqSydC3EHofZWY0RvBzO7jK7uy/nZtuF/F6SLnaxQ91BJI +o5qZbb+Ud73gnR1889vGjZ868S2jQGrIccuOIiEijmKaskRZAL0fZhGYSM5Y0SQTEzpNqTUPHpBKiA +FEoV0WR8MRaVvYWrvxgeUzwgeBceSPHlO+B92ALalGK9wWFFxgv8KqMW5PaoKKE9cMNNvoDRuf2cc+ +b3uyveNVr/oqpuU8SNx51suUMcUVEjMpLLQhSASKSVcb4TvGVT0xVaJSvAPbSc8OXfg210Uflodp7r +mpNvmf6yE0fWnwqvuvCmTNsLS8zJkEnMSFclcyBAAAgAElEQVTLsL0+0gZM3qdZaxAlKbkXFMZhRAC +VlL22KZBSo2QJa1hX0rAioYgSTadr0FJTjyIy68kLj7UWUxQUucGYrDQosim1KKaXOTJbYELACMHFr +XVcFBO0ZBA8F/0WI40Jbnngnl+/6f67nk/qjYoU5odr9J3TCMA6uyNIdVTzZygTgbQqldwaT1jZYOm +xp39j8fFHP+wvnGckK9D9Ab3VDUaiJqGXM8hy9GiTrrCc7G3S1YEzFxZZbm/QlZLpI1dz0wMPdG589 +X2fO3Dt9Q+Nzcy8mDSaCCUr4qgh8QkTUxOM1uvEiUb7jEYsqxcFigzStE69OUrcGsEai05T9NTsi/X +DV744e/Mtn7pldeP6pbML71+/uPKhTfdY69zSRZYvXmB/HDEmFKmIUPWy+SJK6HqHDh4pBdp54qKag +YKhaHc/HCdJQRL9wk7xKS6pJLh0Iw6LUEu98wNWSFLKApDUec39b+Q7jz/3/KmHfv/XpdIfa2d9lNB +oH1OTCZFPCIUiISEmpk5M2veksWeknqJxJLmgJgOJD0R4arEm1WXBae/RIpRWi9ZTeEG9lmC9RcvAe +KOOsz16nQFRBKY3KLkDwWOtY+B9+d4KSQgxq/UJrr/nJnfLPa9+bOzKI7/D2NQfE9eBhKIIECuScgt +caktDxf99hSxGD+OCGQYoBlWuz+UwRSZCqABRPSOp/0FzbOrYdRNv+8XaiePvOP/iC9KtrjHIcoTto +5IYKS2pLpEll5fCTSUjUp1gpMQNeUcyVK0u2ODYmenKFMeKKlQJVqUoX0atEM4TnMd7S5Zn9AeBTmY +ZeEPH9en6LlEzpe8K2v1NehI26XBw39Xb9735Nb8yd/Veimo1IIYeyhVdYJiYIxW74qKjHacFKirbw +HeJs4L+saP/fvU7T39UnlqikXXR+QDyjGa9xvb6Nk2RktZHOLvd4RR9ToQBR5dXaK+nXHPzDbz29a/ +tXH//q351/w03/Nb4/n19kTbKT1Be+JW7Q0A4i9aaWEMqBc2aJlGgnEFVB0KsYhCKzCt0VHYZKqpSe +NM6amz8xX1zc7840+l+ws7v/8j5k6f/3eLL51rrW336W1tMeolIGihlGBlPCHGMiyK8kGUQSoCosJB +bQipBqI8SRRvAr+y0nvry9WwQl9Y1lxGaK2ArVgJRi9k7fwWvuvd1PPf8sV958fixnwkuHXHWoq1Ai +5iEGk2Z0hApTRXTKhyicCR9y0gtRgqHNAVaOVIRkXhB7MqbO9YSrQRxJAjBYYVHxR6hS82jMTndgUE +Fg0wEUZqgRESn36FvHCaKsUAePGmzxfjEOG94948yv2fvX7b2H/oUrfFHEUnJPxIJtUgRnLwkLduxC +AmXuHpVBZZYZZCXhh5BOShXg6YVpf+WlgJU5Ega/yDGrv+Bw+N73zsxc/j/Wj1+9J7OyVOqXywhVEQ +kIA5lgQgf0D6UPpBClR6a3uOjMo65TPvxGFdasgt0RU0yeCkonMdYT+HBBI/Fl6RmKTAOCmPoG0dmD +T1XMGDAIOTkHtqmz4Yt8HGM1hFH7rz+k69+06u3ZCuqhuuww2AZvhFDAEEisZVbyHC5LocKoQCxGTB +YvPATq8+98MvF8ZcZ2dqm5gryojwxe6aMZu52MgwFy8Hz3OYqz9otsskmDzzwDu5+8LWfufuNr/1E4 +9D+DZIYh8IBxcCSpro8lHxVfKJ0ftaA8oY4glhZlLQlCQmIVUmKhhKy95XaQgZBrASRkjA+Rjw21o8 +nx3/lmmsOf6750sufWHz22Ic3Tl+gv7aKCZJ9I1dgjcdpXybOWtBG4rWqZjGHGOR4IZFS/TJJdA4p/ +qiyGi0d1v4xMnz1fOtyV0F6UKnmjjvu4DUvPbC1cPb8J8n5JYGn5iUTKmUkJNRDTCOuMZo2GJEGYww +1nVKPEmSwWGfBC5SQKCkJwVZc3kp1HwTOB4x1GJmjQ4SKSx1oVhSlhSGObOBRaUxPeXpBkEkwKqI+O +cGBI9ebuWuPPMLdD36GevPPiNLKHEpWORWVT6m8dPiEnUWx37WOkbuI1eEVJ1P1tg2Nd1xlShQA7z1 +NX0eON/5ktDZ1brQ18282GnPv2mqeIDt/ns2NDQpnGU01dR2TBo8xhtxYNIFIKbyUeAc2WGwozWFLj +01QWmMHBdYV5CaQm0BmPcYHcmvJTY7XksJb+tYxcJ5BMGTSkGMx0tHOe3R8To7DC8HeK/Zv3XbvHZ+ +ePTDPoOgRx+muE9nvMqy87Ecr0VKl7fKgREA4T7yxdvu5p57+fOelo0xkBeNFwPZ6ZH6ASWNWum1at +Ql6ec7KZo9zZsDLuSW96mrueevrn/uJd/yrj8wd2v81OTeBVYGezdE6IUJSS0rGX6hWil6UWsWyQzE +IFzDBIGTJ4dSq7AZV8ERCElVroyFGVCUPwrC1doGiIUnSqY35RuPnJmZm//z8M8d/6+UnX7hpNeszZ +sqViNIS6SKcDdjc4JQijkvGjM4KnChRarz9PLX4RSL95BB0eSU3MFQD4fDdU0LgnccF0EJAJLjimkO +85jWv4qknHv30M99+8hdSGY2NpTXGRY16EVC5QQZLFElCocsxKYkujVBKIOME4qgiwEqc9DtKe+Md3 +nu8EMTelI4GMiBDgfWDkoMqAwNTYHNLoSOyWDHQmtbefVx9y+3M3H7HV9i3/zdpzT2KrjaRjtImvAo +cDVXtuF2+POEVUpx0p+3cbQ8gLqFWvvryA1wW4iSlwPo6cZCGuPYwe656eGJ05ocm9h/68Mpzz9538 +djRqNfZIgSPEYLUlbptCUhX0sh6Rcn7FxXxWHqFcyWB1psCpUTZngaH8wYfwHmHcxbvCzo5dAcF2wN +HpwgMgicXhlwYCixWOTwO6z3G5Ry58chnbr3j1r4Qcif55zIj2WFfOUQLRDXzivJze2dLNXjw2H6X9 +lPP/u7y49/WyZkF6gMHm1vYvAuxYLXYpi0lq2bAQAleLnqc2t5m9u7beN37fvT3rnvg3g/tmbnekyq +8khg8Wqc7i+UhP3Z403qhEGiiSBGpsrgKv4mMLGlNksSQZUCRI60lGn53cpe6YvjHLOcKnIzJVSCdi +EibI1+7amru1nR0/HOnXzrx0+fbm4zIQCPWNBp1IhlhAtjcErxAxxGJc5Dn5cEgUk2sfxe4i8qx0Iv +wXQqPIRpTjoeGgEUqXa48coeoaw4d3suRa6/qXzh+4jNy4D5ed566dCS+XIYZk5ObjCIzJEmEEYHtr +I93BbVU04g1XitCVD5bpQJBeIpQgHMopVBRTNPn5PkAby2I8rvVWuJLoxiKADaqU5uYYHb/oezALbd +8s3HT7Z9hcuovEIJyviv/TEHLnRHJDf1x5OWrYf/dLQBDPchug/+y7dTDX+SrGVGidnk7ep1UDzUgE +glx9Jek6epUEn1Uz068c+3kSQbrF+lurJMUBU0FKaXnii0yrBXlg5AKrUuU1BmPMRneFyRpnWA9prJ +EF2HYJjokju2BKYsv92ROYISgCI6cghzDwGYYAkJJWqOj3HXXPZ+94vA1BASxqjGM4RBhF0S3CzuXF +YtfVYZMerg07ndZO3f605uPP3WnWrhA2uliO33c5lZF/VJs9npsNxssZT1eOr/CSi/nyL2v5p0/9VM +fvfOtb/hUfXYajMKJco4IojSgsN6g8gJFBDJCiPJWs0N9mhRILdBSIBOPrgmiNBApyAVIb5DOgC1n2 +FAFyVo8zjtE5Q0hdqhzGqtduejdO+73xbd90I42j144cfY3V7e7DLoKF2laYhQda6zz+OBA6PImDhY +bAkoIVKTvJIk/jeTnv+vWC+VkP+w6Q/XeREpirUXqmCIYkiCZ37uH++66h1Pffv6z3cW1j7utLkJ4E +hUTSY1UEVYIamlCVIsRkabwFm8NkRdVEI5ByUCkS/K7FKG8jV35AZRSYCTClN6sURwhYkXhDZ1+Tl8 +qXKNOc89B9t12O5O33/kVDh7+NPXWY2UvL3Gu7IZKFUcJxiBFNaeHXQYiofIdF99TKqB34Jfhzwu/Q ++AIuMrc1SJDQFYWc0bWKuMgURJ0nStULf6GPLD3GxNzY++Mplof3j5z6v7Nl0+lZn2VojBl22AcPli +ULjmXIZSkYudc6RcpBFIFgrcI5/G2wJoM5xzBBbyxOFvQyx29PGdgAhaFkYo8WAahoOf69MkpkFgvO +TS/9/evufrIktYxphgGOsqSElWZ+Ow8mF1tJ/7SjFdadDnaS4tvfv7bT3xk/OQZJnJHnBe47S6xD7j +CsJF36eE4s7nBmcJyMu9z+PbbeOfPfvC9973pLV9U9WY5I8iKSSOGiKsnFpIo1mDkzm5ReHDK4LF4X +4as6DiiPpqwvd0F4fABIgX1pARhcIY4jncZB5cvRrTL8kIZj44CQSr60oIP1OZazEZHPhWNjy6fee7 +4H2edPpsbW4ggaDabJejlAKGxwZQng1dY4VDKk+jwERq1r5LovxY7raffMQpmt++JVwgpKUwfqSTIF +GOAEDE9MUci60uW2u8bb3+qplISUUNpiJKUen2M0bT8vSOp0FLiCKV8y/kK8fEEawlWoqPSXMuZQLA +WZ6AXwAuNI+CERuuY7QIGkSKZnmLq6qsHk9de+3D9jrs+zd4DXyVOGSDpywiJZrxCAkP16vjd7bW4t +JiSiFewpORlKlp9mUF/lZFty3sDWUZIVhbml2aj4a55KP9RKsYjiLVEJOKrrRuObDYb8c8nmh/Mzml +YWydstQkGIjTaxWUmXV5QFAZrLCpExHFEpFO2tvsUhSUfZBRZjnEe4z3WOIwpyEwgN5aCgKXcFRYYM +nIysp2Tp4+lXm9+IU1rdLa2GZ+eKjV41aPyQZWOmsN2c7cL1hCccq5k95qMtQsX/tNLzz3Nvett6kp +hsgxX5CRpwtLWOgtbK/SmRljudTi+bZm/7Tp++EM//UN3v/ENX9Kt0UtpQOHybCKNJBaU7GF3yftly +C0NovTlFFoRx5q4FiNUILcDnC/3YrUkRkVx5e1XHjKqaj3V8H/sPThPolKwDqcVSmuGQWvxbJ1xsfe +Lzvhs7eTCn/UurjPo9kikRkW63I0pRW4zdBpXyU4KIwIukiSR+k8qkn8t1NB24pK4tZQeVc/WCIgkU +qQYK9nu9Dl/6hwLR0/x2Fe+Nr292fs//cD/VEKdWNXASaxzyDQhrY8SD3rkgz4+BKJ6Sk3rcp8nNQ2 +tkMGhnCSSksiXgiMTFCE3YApMM8F5QzfLwDkSrTA6pjU3w6HbbqTxqvu/wp49n2Zs8nFURBtJLmsMg +AwYt0NEvjrMhC9HJkLl0you8cu9vDT4+Uuo8PB7v2ypLIBkSBj8R+h7tpLaaGS5wwiyMrJN8LJZWGE +f5oqZh5uzN75FLV38+Y1jJ1+zeezlmlvZQFnLjc+9TKgn9Gopg7SgW7Nli+kFsTF4Z1CFoDaIKPrQR +9KNIja0YxtHMThJYQu8gjxWbHjDVihoY2hbT88DkSLoJt88efJvLvzHT37lvte+5aH7X/PGvzp0+Kp +8vtVlz8wkcSoIhUV4Vy5dhMLLCEO1yxMgXcn9C+dO/cLZR/72ttb6ecZWF2jUWyxsroGucS5zbMcTL +DTrHF/vcizXTF5zAz/y0z/33vvf8q4vqZExXCX2UwGyaGvHvzoiQdIsB/WozJgsDXAtEo0mRRpPLUh +qaZ+QrNLoDEh7OSNyjCLvEEdj9PQMfRGTJgEhsqExYKW6jKpTNxqGV5QAVxWmOYTDPZBMpMzcePWXO +iq8d00Uf2ysw8cFdRlKoKJf0GKblhwtV0kOokaDYiNHNPPbOHzgF5D8hiJAQ4Hw9Is+cT3FESjI6Xe +atDsZy+sXWVg8x8mTJ/Y8//RTP3r06ed+cv302VvrxnPt9F4iI8m2+sQqoqU0jWCo5X0W4i5JBKMom +jhaARpB0rSCNJLk3hBisMrhKBDOoPBEKhBLyfb2RWwcYeoRvVYTuX+e5jVX9mq33Pz3+vqbPuXHx/7 +WqKhSbSpqQtCoDhGFKPMy2C06lyXK+r3qRf4vMFDa6VLFrnt3F7qjdETUbH0t3au641H68716892Lz +x9j6cwZzMwoubAYEZAioHND0R1grCcScRkSqSV5bOnnnn5e0CsyBtaSFzmFMRgcJihyZxmYnH7IyHA +4IIkkPevwto/JnHrumWfesd3z71i+uMGhw1f9j/Hx+KGD++a+fOXB/b0D81PMTo6iRelPGyqvWudKe +RpIWNsYefnFF//D+sJ5+hubbNqCXtZjzfTxhSFHs4Vkqb3Kqhuga01e++YHP3rXfXd+sTGSoqLyFho +iH4KkojL4Sox8qW+RogJMqmyHshFO0aqGVnW0Aik3gT4+DEpARTmCLzA2J/aq8k8Rl+CWoC/np6piV +2P03byeNIWrrrrqiyNxMrf88unf3G63CTpCpTUIhl6vQKkC4wP9Isd3+6XaIW+xZ6z5Hxhp/Gdq8fa +QvSDjBlvdAaub6ywuLXHieMHyysWD5y8svGd9a/0nep3t6zeWl1lv9+j0DY2ojgoRtaRGXIuoW0Ejx +DRkgio0iS/1mlJ6nHRkyNLzpdreogQhlLxMjUTrGOkNWEtuDIyM0LcFPQSN6Wmuvvte5m6/9a+Yn/t +tRka/7aXaSdQQQlUd4P+85eA/S/Hp6mOo4QS9y/lYiHLnEfB4pQtZq32TvfPfbDQbbzicpv9GjzZfe +/7JbzUGnQF+UFCTklrQKKvKwBEV2BoMMGi60tKWBd1gyK2HrJwdCxlwXhC0xIlAESwZbgd2zm354IW +U6KRGXKvTrNeQItDe2HjT8RX1piePr1DXz39j79TIQ1cfPvClwwfm2wcO7GPPngamKjypyiX70umzH +3vsG98cW3jpGHZ7i0VnYFDQVeC8xUURG3nBBdel0Jrr7rrx9970L/6PTx268RqsKOU2oZp7yvarhqx +sisSQWLor7EUKv0OGEL7S/YUU6RsoL4hTQ5wURFFGnEJaEyhtCcEipdgxtRVVyAjD2WPn5MyGE8nO6 +R6ErhJgS5g8GZHM7pn+lOm1j6yY/k9ngwzXGyB8YIYWg1xQGMtmv8fWoMfmYJuQRiy018bueu39H5M +y+fjK6hZbvYyVrU1OnllgYWn56jPnzr63Z/a+N7f5VYiI2vh+0pEcHxLWVzp4sYV1EYVVJHGd0Vqdt +O9peEVLJtSKiHEUUkoSytnRKUmmAjJSeFmyFIQrXQucKhOelCj3N0EIVqRk7MBBZg7u783fcN3fNW6 +/7dfZv/fv0XGJhleO38Ojr5Ix7hAIwvez+Ia2eWJ3XJO4JMUJDHeDpd1eIj2Mth6OrrtmcMWe2c7Ku +P/RlTMLbJ04i11t0xhYdAaiACMKullOHjm2hWdbFPQpysAOa4itwWqBEVCIQIEnrzxUdtmrVCOcwAw +GeBIatYTZiQlGxiZoNG8g67Zpry0/cGqh88D62qnfP3ps6bHx8RN/MDU9/t8OHZhbG2ulzI/UaYZB4 +4knX/jX33z8SczqBZQ15L5yP9MxwQvyvMfi5hbLwJ6r9j/31h/7oQ9dcdMRgixDtSQO43IiNEpopCj +DkeXueLBdaLMSnhBM1S4ObQk1wkUEG5PGhiQ2aF2QJFCvS5IIlHAVxStUFILSRPiyutu13S7/G7cjB +g4IvBDoWIGFuBWz79DeDwlv7l04fuamTq9PGicsbbYRGx16eY/17gar3XWWtlbp+Iz0+Cgn2yv/ujU +986tnL6z22n17w3Zm/+X6eu/HVVI/UJgR6hP7acjS38X5jPXVRVa3umxs9xg4S4ak188IqaKW1onzD +JV7oqDRSjMWRdX2WiGjCBJJUIJcljtQiox6JEmiMhOjbzJcsIhIoiKNP7CHvXfewewdd36Z/Xs/Q6v +xHYQEF7BSlmLNIeGimv3F7iFdfB+Lb+hfuds0dvcH8jtlGRG0xOOQRVFQTx4hnXlk5g33f7Z2auFjS +XP0dZtPH20Mzq2QVC+OwxOkJJeBgXP0Q0HXZaXhrTHYYMgU9KyhXxT0RCDDVlkJ5YLZhdLuQMcxuSm +t17c3N9jaWKeWJAzyjEbSojVVQ9oBSgac7d+ztNS559z51d959PGnnhodrf3heE3/Pw1RvPelxx9tP +XdqCd3v4vMes2mEzQtGR0fBCzpZn5XMMLVnmrvf9taPvPrtb/PJ1Dg9a9C6thPWqVS0wzIqCfbye/T +yHsiro6sA4urULW/NcoYboJRBi6LM5o1A6aFr9CvM/sTlXqdlJTZ3LZJ8dXQNvU9D5b8dEFFEPFb3j +dGxj3gd/e1WzyB7jni9YHvQYWVzhdXeKhuDLdYGm3RdhktiXri42Jrad7C72S2WonR8fmRkDp1OMju +zD9Bs2IQ8H9DpbLK5scy5c8c5f+YUnc4WUsB2aLM90BRhCpHUEap0IsidIE4EDSJcGHrrSNAR6IBxh +pAbkgBaxeg4wYaCbihwUUx9coT65Hj30Nvf8HezV13xa+w/8E3SuFy1VWwuVBXeMgyX8t+DhKK+j8W +3U/yvFJuKS21pDpgqe7VAIGOBkIZISKxoPdI4fMUv7Ze1drM2+p6t5gn6Z5cYrKzR6/UYCInxUBSGL +DfkpsA7h8XgsPSFpBMK+nj6oQwo2Z3EQ+U5Yge9yrouZmnxHNZ4Zmb2MDmT4MfGaTVToliSpglWxRi +ZYAK0B93b2oPt207b/qdD1qHbCfjpq+i2N+isr9KxA7quoNUuVzCZtwShefX9D37mwR/8sa+N7jlAo +cvtaJlcDtFw82ov6QEvfWK96/AqsccgKsRZlsigji1RYlGJQyJIdFQaIklLEmuSeOguuptZcinJ1Q+ +PAOHB65KzuSNZlEBR2dh7HA6PR3uHiGvM7N/7tX7PfGZpZfPDLzz7EubiKpvtTTb7m+TC4FIQTU1ja +hLVbFAfn6Q2MY5qRfON5gyNxgzOxOSZZ21thbX2NlvtDdbWl9jcWmZtbQGzdgGybXyw1HTM+HyT+nR +CcI4iLlCRwQoFqSh9aaTYSRKVPiBdifIGF0jjlBAEnTxnIC22VWfk4BwHbr6G+cMH/zS+587foTXyF +FqXaySlsKoE2iSXi6hF+F+XCPhPKr5hVK8YBi76sLN/kG4YKlruV4oqxDIiQmpVtYdNI0cbj6ZXjz4 +6Pzb72dG5/f924cnnX7f6zPPNjYXzmFDuzYrc43JbriUEmEgw8NDH0cfRw5GhyAjlMlqU/J7Z+Wmmp +ma+luXm9ReX1xlkjvbmKu2NDc6efpnxkQ5jI03Gx8eZnZ1lZn6OWrNBiGNarRbpSJPcW/J8QNZtMzq +1h/1X3sz6hUV67S3WF49iLq6w5gy2yHFopqenOodvv+8TM1deR89FeClLVkxF89A7ySRcXmhi11ch2 +GmgQ3XzhaEZr+4TdB90j0jFNGp10jhBS0sUlfYFWqvv8V0NjW5LHqPE4UPzslM0EHHJe82WDasOl1y +jmoL6RPSJQnXff271ROv0C89TeEfaqtGaHqMxOUJrZoKxuRnikRGCroFISVyMtbC+tkKv41ld2uT8+ +UWK7jprG6usbyxBvlUC+DXB7IEx5qcmeM2tt27ftO+K/3cklw8tPXPi79r99rJ2zA7jybJQtsZKCax +z+J5BKkEsA4oIGSS5s7hEE81NM3vtoe78bdd+ffbGa36N+Zl/IB2BuHzeXmg8ijx4nCvpj1oMxyouy +6T436L4dkaUncK7/Ea0hSOOy+bUIHDBVQi3onCGhqpRmAKlJGrf3kfrU1P/cWZsdK072nx/fOocRx9 +7EhEGBDK8E1gvKKSgB/S1p+ctfSwZkOPISk/qHSLrvgP7/9t7fuzHf+Tw4StrR186+S+OHT/9/nNnl +968cH5ZdvsZ7c4ZNhdzTp+D1tg4k1Oz1OojpCPjjE5PMTY9h0wSarUacdKildRIhMDbGlNTMHNoP4s +LZ9lYW6O3vYG1GeP7Z3916vDVGzZOMdUtF1fPKSkRd0zXEzVk1eyZCnSRpXJiZzCLKwv24T7SIvFYB +tjQQdJDSkkUxWitKUUHsiS+7xC69I7RbbjMkLFSk1f/qRue7jvDYIwkJs8z4qj0R+22l1i6cI7jx17 +ceHnp8V/rydO/NH/jDHEtZXJ2htHpKYyUFEJAHJMHgR0UbHc7FLlgdWmT5cU18oFje6PL+vomorOMk +I6JkRozh+bZe2CaK686sH7zLdf92ZGrDj90xdz8tw7vu4LNl07z1e1ttpeWvyGK8MMiSKy0ZMZQRxA +FhcsNIc9K4XMSQSzpmRw/EtPYO83+O2+0h+679b9G1x3+HKO1p0vLCE0QEuMcQVc5vUIi9K6iC7u44 +GL3QfXPh7jof2rTGYZxwzJclmwqBNQjtQN+yF18NUnZi3vjUaqBkx6LtKKePDF2+60fODI7/18G55b ++7WbhH1x8+oVmZ6tLxwuM1Kxsr+EixcBZOi6jR2VgFMr1glQRloAQnkMHr3jkne/6ASbGJgevfeDBP ++l2sz85dux0dPr0ubedOHnq/U8ce+btx4+fiBbPLrHR6bDRuQjGQ22E1vgUoxMztFqjjI9PMDM1C3G +d7cJS03UipQlxwTWTY1xcvoB3BUoYrMkOfv2Rb9x2eunUUzfeeB1HrrmKvXvmqKsEbwzBOKJmCs4Tc +JgwQAWPFgkylETzAMgoYmAlKI0SUVkMpoOQEuMKmmkEQmHMAKUkWkOcSGr1qPRWHapFUHgPWpdB1LJ +KRaJ66XYsDytrA1kRkK0JBOdpdzdZWDzOiy8+rk+eePat65vn3+9s/917r4EknmNkbIxac4yB8XQ6A +wqnybqWzfYaKxc3ubC4ysZam/Zmu7QkGBSopIbLB0zXNVdecxW33HLD8m133vQnt9554x8evmr/d5o +jdSIt0dUYOj45xp5985xLjj4SJ+6H6yHFDzxWBApnsXlGZD31OCGSgqCgiBWmmbLntmt7+++8/m/nb +7vuVzly+FtEYIUlyARdcUu0luyW2Yldxk2XuSMKf8lWAtBCfz+LT0OZsBwAACAASURBVO4C6OR3X8k +Vy0eLS9KKy0pXVU7TSPLq98tljJyb+VYtTj/xwI//yPIL84984JmH/0Ff+PZ36Pc6yKRGUJCZHoUKZ +Uiq8NhwSQ3lQ+nVUavVnoiiiFotIY5rjI6NMT42YW699dYvb21tf/l1qyfEyydPv/npp154/wsvHH3 +nyRPnaqvLq9Bfp2N7dJZPQdqg0RhhrDVGo9ZgtD7C9OQMzVqTYiynNdJgZn6MRiPFu5yLFxc+uLm98 +sH8+MbaqZef+dMn5qb/4ODeuUdvue56rjl8iInREZAZOEvh4lICJFRJYneXoGxvIdEjFH6AcwKtU6Q +MxFGLOB1FiII0rSNVjoo0JbuvVHsMD0Yty1iXIcteCHBWY51ExhBH2U6RImUVVhLobm+y3d7g1Omj6 +cLiyXecWzj2gazYeHNaD+rA5BhC1ksdpWtQmIIts06/71la22Zpqc3S8hbrGz02ltfRSQOfG+j10El +C1AwcuXqe+bm5hfvvvvu/XnPN1V+45rorn5+fn2Z0cgQdicpzRV6SBkQNmvVxmvHIE9guFBKdg0sCk +VQI4bG2oGMLRCTQtQQ50eSmN93P3juv+0Lj0PxnmRp5lnjIolQ77BO5SyrmX7ETF2E3HdrvYMPhu0j +S36dVw3fZSO/OFReXO36JV0C0QVyea7BjixIlPp6dfrIxOf3B21utz4/tm/93anz0nc889i3a5xdLG +7gKXDGVM/LQor1UYghirZnfu+epVqtFHMc7XLE4UdSbMSOjNSbm6uGuG2/56psfeP1XT718nmeff+n +BZ5958f3PPPfsu86cOTOy3RlAb5teb4neWrn3iZMmzeYIWseM7m0wOTnJ2HiLOJqjXo+ZnEgBSz2RU +4TiQ93txQ+9uH6qvXr++S+9MD350L75mW9cd/XVzMzMYNIDpPX6DkkhVEz44QtgHChZYyj+Fq5OsC0 +a0Tyx6BPEFkJb0toE9foqOkqRsgyNNDsuARWNbXgQStCilL04u47SCikdLu+ytrXC8vK55vnFUz+wt +r70gU5n6w29bItaU7N/dpLmSIPBYMDqxjqD7ja9osfLp86yeH6N7e2C9dWM9Y2MPJMEp6BnsEWAIie +txdx5+w0vH7n6ii/ed++df3TjTTccn5o7zOzMVBnuWSVeWG8qdU5StpBCQZQwPbqXqdbsU73gifqO2 +GhMVAJDSil8GmGFIY8CphbwNcc9Nx2mcfdNn2a0dtxgCaJE5/WuOOxKo11BguzkMu20mrtjsnc17+H +7XXy73S3DK6/of6QAd/9V+HKBLQQkHpy85MNTAF4GWlfs/9at81Mfj0brt6/3t/adv7hE3s/QaBxmJ ++bYV6o77yAIQZrUj05MTPWVkJVdXUnKds6XangEYyKFNGJyb4srpvdy1/W3fX3xgaWvv/jSS5w8ffy ++xx9/5H3PvPD0BxeXzmNMBh4Ku83G5jIIRS+vsbVcZ2SsxfbqNKNjLWq1mPGJBs36CM36CIn2mKw76 +oreB86eu/CBhQXbu7D0/F/MTE19ft+1b/ofY2MjjLeaxLpGpMZRjO1wu6X3BEcVTVbmkrh+naLXoL2 ++jXAdlhZ7LC4atrZAKEGeS3xQpFGCD+Hy5z/EzN2AYDJULZB1lllcOjW2sPDSD62tnXp/P1u93/suQ +lqmZmtMyZg4aaCUZqvdZXFxk6XlLfqDghdefpGzZ5dYXytv6iIHBiXpWuk6KkkYa7U4dPB6Xv/gA2u +ve/C+qw7u38P8/DSjo02sGi3hpgB5btBaInVSuh8gLr2UacTY2Axjo9N9o7eOCt87EoVSHeO9x0ooE +uhJWHV9VrbX6YQVbgldZurymiA5bquSqg13qu5SjyleEYR2ufHoP3bdhO/zzRfkZWyl3Q57Qrxi9fA +9UCJZ/fIYiHfxTi1gfcmxyhWkrfTZycP7fj2ZGvm/iygwoKBGhA/msotWUjLbhZDU6/WjY2Nj5e0aP +EKVLIgkKsvbq5I9P0w3kQHGR2PGxw9y7aGD9Af3PnL3rdc883v/5Xc++HebC2wYhxXVHR2AOCZb79B +fg/5GnfbKMkktpjnaYHZ6nK2pcQ7sn2ZyrEE9UaSNFm5E0h+0G2tbF378/PLJH3/66GI+PTP+36++8 +tDnrzx09Vdnpw5aFfcp7QgCWmsICmvqmFxRdGFrpWD9fM75hSWeV4ssnF3h9Ol1Tp2FsdU2Dz/83Pv +m5q//g9vvugPnHPVGRc4OWVV8A5xbY9Dbmt5eXfvhxYVT7zt16vm7tzrnSZOc0TFNrS6QKqI/6OGCo +b9tWN/YZPFCxulTm7x8ZoWVi1t0Bz0626Wdu1YQm7KbSVSCkopmrcnYSJMH7r2Hn/5X75u64urDDXz +RQ4nyMCuFHThf2l8oLXa+/1C9R7p6O3WrTjrSgISjVtojTnu8lmTK03OG9aLNUrbF6d4qS7ZLv6l5V +96lr/wVEo+uIt7kUB1+WZHJaq96qcFUwxMwfPeF879F23k5ZeLy61hcsur/7gV89fdoqKOrwiSrC6k +0862gOOMNuXf0XX5gc7DNZtEruZvSs5u5WAbUKowrJTfNZvPE3Mxs+QIPBY/Bl0bTrtzkxPjSrirVl +z6jgyiF0doYN191xR2TiSYtchpF1Rqb8uVI8AgfkWOwnQFbnRyLI04jVhcuMjZWZ3VxhumpJiMjmun +JJhNTNUbHRhmbaJQyKhuSbLD87hPHTr373KlH3MTI7Ffn5654aP+Bq/5ydn5PHpxCqEl0JBlsxZw7u +f6+Yy+8+InzL69z8WKPMxcdFy4Etjuj+HyEtYuCL/3pNx5aXOp+4i1vPfWJt7ztwT+opSCUJ7BJ0W3 +vLfLVH93YPPuT2+2Lt1y4eA5vc0bHDXv2TVNLFcFl9Lpdup0+vU5gfX2b4ycv8sKLy5xbyNnahn4Gh +amCeT3UY0FCSpABrWLiuNRopxq6G+t0NjcIzmOy4o4gwzdiFaMjTSgMMopKBLwM5qms7cMO8dsIqEV +gmwI/IrBNfyKvDcBAB4P1sFJsc3Z7hVOdiyzQZgDEssF6dxN8OCC8Q8uojKCuXjkpL38fPfKy1zl8r +/ui2qSpf+aNwz+t+Pylt19cdiL4S9zd6id38+GGp4by5pJLkKgwJlFZaAuB84ZUlgLefNDbu97eoJA +Op6BT6XEqDyakkAQpwXmEkNRqjTPNZhMlSoUxIlSaMkmky3jHPvmO7AjKYEYtS8UB3rG6sHDT4OI6z +aK0LweQKiV3noYcxU02Wd/cQKYpmTVsFz18rtjM+mytdVk4tcT4WDkH7t0/xtyeUabnxzh81X4mJkd +I9AqtCVcJiQfKmrNvP39h6e0Xlr4DSv3Nddff9tDE+OEvx/qK7qmj+W8//a1zH37hmaOcO32WfrfN4 +oVxCFOMt2qMjyiMz1nfXOSr/9/Dh86eO/VQWnd33HTT4U/t2TPynnyw8hPd7YXrev8/e28eZFl213d ++zna3t+XLvaqylt6rW71Uq1d1awGEBwxjjywghmHMIDuMgcByGBs8eBx2yGMTMTM2HhxjkOzANjMsM +RgBZgsQGgNSIwn13tXd1VXVtee+v/fyrffec878ce/LzKpuCUd4PN0KkREvKpeot9x7fuf8lu8yWKL +bXWTQ32VqtpSKFwEuy2ltt1hd3GJ9tUOv63j55cv0hpJW27K5k7HdglEOKjBMNCocCef+OE3T9wdGE +5mALB0yGgwZjQaMRiPae216bsTlSxdZW17h6InjD0Rx5fPjMsHIHGx+SD2ghCOoAmMzAtCOWEhs3eG +aYCfsteFOn7yfsdTrs5cPWOu3WU53WKdLD8g1BFqxurQMg/SYiRQm8IxGGSqMsLqENLiDscHbnWbqM +IjkluRTinfLyecPg+VvPr4p0RWHc+rxB1V5IYJUtENLJUc7jqjCghmpIE3Za7fmBqM+1WaNkRG0W32 +w5aknCx0RJwrOthCCIAiWwjBESllAj3A4Z0u2uEdqTZe05FJ5BJ5QF0aYWPC7exgv7mlGFU5OzpLuD +Rn2U4QvEBAVl7CRS7Q3NKqTv6LC8H8cefs9Toq/vNtpnR72O0hl6e7t0dpJ2d7pcOkaRBU4crxOc6r +BfSeGLCxMc+zoJNVKiJYBAkGajuin+TdfvvLcN19XN8gHF7l6znLp9T1uXFpjdWmJne01dtNTzM0cp +RrXccozOVNlPj3O5evPcf3aDf7X/+1/+fif+3OPfvz9T72HxoRDqxZJPGB6VhKGEwzyFbrtAZubfTZ +X+yxe3uXSG1tcuQQ7m5Bn0NqDYQZBBWanZ5icnfuPR46f+Ln5o0f+wx3Jfd2rVy//++Wlxe/a3d6i3 +RthhynSe2Kj6Q9HVGSITUfs7e1hrb/HAcMyTd0PPJsVR5E0Bal2DJaAEhdbKPlTBVdjKYtysnzE6uo +2W3mbFbbZJScTGieL589bHXa3ttGOuUiWGFDn9/VUUqB2iAT7pzZRbmkminca24l565Por0JcuhV3M +QhLzRLvUGMjEqVASJwQ5ELhbYFXbLf3pqYDhYwcw05BXbniCkJ4Xzr6mcPbLg0KNbOqyNddGLBrYoL +CewiZF7o6Vhe7amwDjBKFjK/N8dLhhGIoc3zg2N1Zv23OpcwkhnDQxgQZg1GfAZJBugdpyAX6zB+7/ +eX7v+cjVzdC9RO91P7E6sVrxzbPX/3u/vrm965vrD60trfJVs+BNYgduL6UEqs2F051OHHMc9eddU4 +en2J2JmKmCRNVmG5W6bfg9bNXWFpc5Nqi4/zlHa5vbrLSWgfbh6CBVnWkrDNXn6GuYDKZZP7Ox9ncW +eXcyy/xu5tfpOL2+IvfcTuzM22E7ZD3HNuX21zdqXJ9cYerVzdYXGlzY7HP4ir0BmCMIXOG6YVj9vT +xE585fnzh3915x22/ffr03cOTp47RbNQRnYw/+n3xssr4rqgXY7KQCd8kiCzejNgx2+QRjPp7LC/dQ +OX5bcpBRQBZjg+H44ofV64cAcTOEXtLb9CnUp0oHKNVHTVznFbl3PpVUtY3r/J74TJeAVagbIzwAmE +1FZmBcOSjIRutralKs1kIZgRh4RBcME6h9AlRXw2mKfgvhyv7z0W4/Jf8kqJUf7IZWTZq2jxFSAhDi +KpwNC8pJLlHSchGB7iOahRsBao4PeW+QdXhwtnhyjRHlSh+xFjavGjOxHF8LI5jdLVGDU9NaJwvZpF +D59lZ7rGXRzx05sHz3/YX/iL5/DRDB7tLG8ujle2fXH7z0k8u3bg2e+76he+6tr32fVt7rcd2d3fp7 +XQYDoe8eQHWl7a4cWWL4wvTHJmvcmQu4MTRCeanpxB5he3tISsrPa5dGbC81KY9SBE+xlRrNJLbmGr +OUw/qxIkhCD2GiDCcxVrDyaOW9uASb15a49q1GsNhl531RVavbLJ6o8XrK0O2tmBzq7CH9wLmZivMz +N2ZTs+e/J0773rg380fOf67p06dyo8cOcL0VJPGRIUg0IUO6F7GiRM3zu8ud8jbHruXkfY1Uo8YCk8 +tqjKSRbMryzKstccO0ypECTR/W6apEERRVBiT5IIgKBoyu7vbW6urS+x0NshVCcn0viQdKxwZ1lncC +IbDIaPRqOkK0We8EwcqUuLds87fkeC7iYh7uC1++O+iFN+xeRWbE0iBiTVS5xjdoO8yonzA0FqGXRj +0YOSgEYh2oosdTpSOemNFMC0sFouUJVMAhRB2H4blhS/k8Kyb0UJidOEJUNUhQmkyGTD04NqSyiCnF +iXXZiencI0ZUiRHGzNU7xb4xx5je3tz4/rm4k8v7Wz+9Hprq7m6vPodS1evf9/26ub7r1z9Mq1Wi5X +ljNXlLaJgi4k6LByBhSMzVKMpdtYkmxsxi4tDNlspQyRBOMVko0mzcpJGtU4sFFoWAsJOCjRVjA6p1 +yTrO2u8dnaNuN6iVt1me7XD5jK0N2AYFUSA6emIqdnj/WPH7/7NE6fu/3cnTp7+7NTMgp87cpx6Y4p +ms0kYjMm++T5KRmQB1Wr1mkDhnCP1tpDmS0f0bI8hPfbsCD/ssbi4yNbuzkxSqyKDoEAU7LfLvkKmp +DXWOryXBKEmy4esbyy31zaW8GRUwyJzFbYAxAkh8V6TYbES8mxEno2qztqbrMtK3fp3TQC+K08+50G +4IiMXzsZ4i5aeJNAEypJoqEpNQkiGI69Z0m7Ods9T07ZXlQ5TMun0GB3si7mOOkS88RSuQXCzB7tWq +hFHAZVanQmhqMqCIJypEO0gPtKg09ZMJNU17Rx9NySXIYFUBRXMx8wmC0ydmOdeMoY22+22Oz+7sbz ++s1sra9XV1T//keXl5b9y9erVb1peucH29iK9vRXevJJz9compJuQV9BygV43AKoYAiJVoxbNUw2bR +CpAuCHWZmQ+I88dLhe0O46dHY+zk+zs7PLFL95ASks1grn6BCdOzTBzx5H23Nz8rx+/7c6fO3Hizs/ +NHb2N5vQxKtVJtEkwYbzfKMvzDOsytCzk1kubNpKkumbxpM4zSlMyl+N8TppldO2AvWwAuWZzc5PRa +NQQquzOGQ0+Rwh1kx/iPhrDg3dF098EApdBng4Y9Ns9QUoFqGpIbSFhIRghUUhVQOl8AMpbJC4uOuk +HXvE36df/WfB9hZOxBB3afEQ2Ghg7GqCcxUhPJBXOD4gDRSg8TkJQiRANw+pOj4nAp5HICEgLFAxmn +04gfCFbsd8A8qWr7FjcxxX/uiyPA22oV6rUECSZxXmJMSFGSAZ9x0Slxky10ZImIpGmWAAcKBQLrVB +SFKYdQcRE0uDo1FHS2/vd0YBf6PeHv7C1sx2tr6/+hc3tpb+ysvbmt1y99LpcWrzGm69fZXsrx7k9Y +JaECXTSIKomJGqSSmSItMDnpYU2MEhH9PYGbG0N2On0cDJmonqS6ckppudy7r3rju37Tz/66bmpkz8 +3vTD9J41Gg8bENFG1igkSZBABhsz5cfe/uHraoPCF0psohG+F0CSVWguhyF2hJGfTEdYPGdi0ICS5o +tHVardJ0zQ+cK+9qZ94SxOvtChwbv9zCeGJEkVzKkk7kyF6NKIZF6OIXIIvx1VeOLwez3EzvHVGlCO +C/fGC//+4Xfk1nXaOZxH+rQ0ai8NmKaNhT9pRH+1yYiWIPQhbOBNpmeEE1KOAOIiQ1jKZKBeSgstQt +wJgvS3HDmX24YoxhBcl87vEYgkhVKACwiBA9wdQWn0hLFIWEnXGC5T1Q/ojbGSQiS4oVN4ThuqQXY/ +EOYdRGm0UQSOgWoEpBcdPzg/7w/f8Sub6v9If7OqVlWvftnzj+sf++A+/8Jd+97c+z5Vr24QIavUqj +eYcYaVKGCdEwQCtDHme461gaHP2eh3ae3tsd9qMrMd7S6N5nA9+8CGeeOruR267febFo3OzNBuTiKC ++Lw6MAGc9zolCeFkKsnLxj2FXGlkqr/nSqVUQBNEwy3L6o5R2v0uWDnB2jx5tEClDn0FqabVaDNORy +qxHK4/NHVp/FWUhIZFS7KujC5EzMVHlxPFZN1iu0VkfMV0R+FDhrMbnisw6BvmQkacAROQp3qbS2xz +MAbZYiP8fuihfC8H31nDztzRdCtGhUEoXBkbFpjBc0i4nMuBkhpQeHUqaMWjl6RpHM1JSZanFu0ODf +nnAxBjvu4eEcguq3QEQdao5aZuNCV3Pc+JhirICm4MzEVZqajM1er1dEl1IjRlbbCR5eYNH1hXS8hQ +2yNJLcMVJJXJ3MGKRECYQqYTqRJLPzE3/5ul73/ObSdxMX33tqlld3aOWxDRqMfVaQlSto1WEFKsIn +2BTT5p5+r09dtsb9Ifb9OwODk1gakxOz/PQg9+Yvu+pR16caAKqg9AO0gLQ7csY8FIU7lilvfOYh+i +xBZy4hFspoUrfdUUQhIVIrfeFdLzR5EIXU4Ryqi100XARQlhT8ueULtJODgHy3a1dx3JDdi5HkhMGj +lpDy0bDwBBy5fHCgpQ4KRiMUpwvMhohi9peFrnrLeNpf8tI/es47RRv94PwJfzOEQQBSSXKGpVE6Sz +ADPv4HMIIrPAYA9XEUEs0djQicBmR8oH0+WAfn7evfFtKoXAg8SZ8aYBZOhX5EvVtgnCgg7AmS/dcJ +TU6NIggJpUa1/fY1EKaR1j6lIZjY0NItY9qtkUjXch97wSMBF22GIVCCkXmLLm1COmI4oTmdHM5jM2 +pSlUzORkTKAkiQ3pXdGj9XuE/kEuGfUervUer0yL1O+Rsk+NoVCJmZhs0J2dX4rhgdWXCIRgVkhPuQ +CO4PKCLsYsYa74ckspDgvM4Uaa5qSfPXNQbjhilOTkCYwKE0Phc7s/UpPeMRiPSNB1kuUUbhfPuEMD +hoATz4mBDtNYihCqV8SxZ3sfZXhAmOdNTAm8F3ilsLsjSgiAsFEQKbChLIxmZqbdTzxbvnrNPviOv6 +r9CoScL9rtzrqjHrCXQauBdTiUMMEpST1Thg+EhCQXKpTRCzWQlYrZZZbZRqwibg1TkWRmA5UnjRKH +FaG0ZeGIs++1w3iGEAiXxUrTjSo3cK4TUmDCiWmugg4ikUsO6Yh6mvZqgnxap5bDQUyn454VXRKG/6 +Q+5Ro5Bghn4FOdHeDKkLNgYRhZ2zWEcvrBwfBbr+vT7WzQahuZETCVJUELjc0E6yun19mh1dukN+gz +SId2sS8aQZjPg+Kk6tYZAB/aFKC5eV8kAhy9ItJKbFJcFoJVEF0rB+9A959x+MEipca6QpVhdXptIR +zn9NGOYpfSyEb10yJCUgS2A74M0p1avoLVuj2u+fIxsGm9+4hbWi/cHgectUnlq1Yjp6WplomEwxpM +YT6QzarEj0hnVGOamJBM1qFc0jVqMkG5QKKEfBLgUEv8uOvnekeAT4qvnoUoqhJLk3uGc6zqXY7O8u +BkelBKEBiItCRWE0hIrT6QELssaNktvfmI/dlySeGThOckBYxlf/L7gBSp0EG4KrZEmIEhqqCBBhTG +mUiv+jWOQimFvME+vD6lHe3lI23Gs1ywOlK+4BeNa8ujEWOChtEpz1nH82MJvve99j3Dq1CzIPrnbw ++YDbJrS2W2TD0N63ZxWe5et1jrbvQ32GGBRGJmwsHCM6ZmYkycjji8Ev4UowCSisI3cP/GKE2osoJT +DIaMAX/oXCiEK3Ut54P6Rjzzd7mA+yyzWwcg6Bnla2qod2EEbCXEYoaXaPLj3f4r+ni/YKO6QlqLSj +iD0jSSBWg2qMVQDSEJHNYZaFep1zUTD0GzEVBJDGOiuKY++cfA53l1f8p16UfW2AG2/D/cRJTYzDMP +dMAyRCoxUKAmqtKsKjcEoMMITKQiFJe3vTbs0KyDzohjmukMXP983Az1UCYiCjmRlaQRpgmVfmANgk +mrhU65DVJQgggpBtYpUIb3e4BS7e+Vr6QMW9L7dZqnjViLn3RhLno/tV1RZcxaSgqE0GKWpJcH/ee/ +dJzdPnprC21263XWs7xIYTxgG5KMq3U5Gp9ein25jGaAJiMUkE/UjTDdnmJk0LCxI5uaHn1a6j6eHw +CCo4USGF7cGXAHBE5Spsh+feGJfmGlcRWWDjN3N3VODQeGjMXIZgzzDygJDK8vucagVlUoFpdTy+Jo +L+dWXnBfjgU+JzZWFGUwSi+l6TVFvQC1RVCqCJIZKpQi+Rl1Tr2uqNUO9GpGEwS5S3hTo/yWEb7/ma +j75dk0XX8jcHZ63KW2o1+vbExMTyLRFYAO0A2MkJlZEgUD5jFB6QiGpGEVn1J8bDfrgCgHew3g8dQg +Tvs9WFjdnw1ZIZBhfVXEFGUUYHRU6MmhMWMU5j6poVNJilNnTg96AOBf7SF0v3Fvhup6SWSHJAenDf +VrW2BNCjmXbsUg/JFDDmePHEs4GHW4svki7NWSyYVFimtZOznZnk/ZgkwEtCvnYKlLH1KoRlcQwN6u +Jky36o3O/VPXZfxMGM0AFn0uUtrfsfGOe9sGpJYXCy4PAs9bjfdFAGg1Strd3Tw/6I1Jryy1mHLqFC +JHNc5RS1Ks1IhNcVWpcFY8Vlt9uEbj9X+43wZ1FSEtg/FycSORIk0rDaMg+CdkpUJEjt4VLUBQbtJH +bX7nB92cNl6+Yerr9FghESWU9jivk0qB1EXxRpIliQxBZAm+JjSIS0EhC+riFbNgDm6O0vAkbWwR9X +uIK2S84itpMlsEHYaV6oT45SbaxjcwsKgebK4hibOrQCVQbEzgdnEmHGXG5Y4jcj12kkftLeXy6Kmz +J5RSl37uzkDtbaIcIifcjhN2j01784V73Oo8+ukCrfTv/z2fPs9u6QKeTUq0cZ9CpszfcwIkO3u/hh +CUOKkw2a9x9ep57Toc8+LChUt1kdfmLfzGJ/Q9X6+ankRW0CN8m4yvO6XF+JoS6CUDsfclHkID09Dt +ddrZ2zwwGRcNFK03qJNZ7LA4jZUGUDgImJyYIw/DCzXxU9zaoSsdbUlPAW4u1GUK6hTAQiAgSYVDag +RdI47ACZCTJRoU6tQkEQrA+Fsa5yar6Jjfir9dRg//KfZiiVyhL8Vu1LJXC+nL2JFTR7NASLSyhURj +h0DhiExBJfyrr7UE+hKBseZdiHbJEuAh/06xhv9O5byITRq82ZmZoL63A3gAVV3ApOB2Q+2JxRY0GA +62fHHQHNEYpuAqoAmCe75/fHJLS8GV9JQ/SYO8Q5GglEMKSDzqMeivvWbzx4r+0bpWHH54jTB5mY2u +RZ7/co9O6xGDUJc+n6bOOEF10YDEG4kgRVTOakzkPnJnjsccrpOkNdttX2N1q/kujJv4oTOLXURM33 +XaBKsEGB8FXSLvIg8ATrrB7do4sT1ldWWdna/vJ4XDIcDhEmgDlMvK8tx+xWkOtVmN+fp5qUnl17Mx +0kx/0ftXjbi4DxaHupLd4lyOlO6WNgFAgrcUgC689U5zbBIqRKHC7URSitVweP2nJLHtXdTrfseArU +i3PLcXXWy6Ml4IwjG/EcYVMBwQ+LAwy1Njt1JWdT1v40qmAQKq7RoMejEYQpQU73BYkTbGv+RCpogA +AIABJREFU/hK+5UX3hfUEiEC/0JiaZhAn5L0RYRiRCY9TpkB6KEUQJ3T6g+M7Ozv3zXd655hrFt1ac +3PDYjzu8OVRMtab8SWKR2kQwuLzPq2dRbbXz//aXmeRRn3EKN/C+WV00MPEcM/CJLXkGJ5prq/sEVY +TGtOTTE+eJB8GrCxe5Prys7T27sIyT3MqLwSG2ssI3vy12SPVe4KKw7s5xs7AeHGoDzROMQ+QEM45l +CpSRetS2u1drl+7dt/29u7x4TBlMBghRPG5rHcYrXEuIwoDZianOHbkKNVq9YXieR1Cy1tOO/n262O +M7XUO7x1KiruiUOHSAG0NJvDoIECnKZn3OK0JpcUTUK0mhJG5wf4Gwj64gq/3Od9N2Na3QZqPZTaMC +qhUKleq1SppFKFlisodWhYSgUIUkgtKgHSeQCtCqU7naVrkdM4f+Ao6QLmipym+yuRDgNRhL6rXnw+ +TyqNCddHaEErIlEFLCp86IRmMhrR2O9867HbPRbkFLYq/SV92zcvk2XNw/OKRWpT1ngORF/qYnW1WV +678qxtXz949N2epVjwvvPIlXnn1DVp7cPwkfN//8N/z4P0f/kJ/aI699Orzp5zM0mMn71g5ceL+F1Y +Xt5779P/9s5+4ce13o2dfuMLxk6d575nbqdciNtZ2SNOlu6v1o/8qCNUPeDFfSNU73gJq520RWMUFT +NMh7c4ua2tr39rf65JlGWmaQiD3RzZKKWzmMCakXq8zOTn5fBRFPcqxhWYs3aBuOvXcIQsC5zjolZT +mMkqp08YYfKiJCREl+yFNDakrRJVH5HgfkFQiVBheKe2a3irJ8vUcfKmEEIHIS2076UDZ8g0plJcYw +Mkqo2T6YrBwEn/tZaqjPpNpiwSL0Ak2jOk5zcgIKgkEPqeRbZ+WS+cSrl3o89BxkJJeVNzqyIXoVJI +GpVmjUCgUykOMA+eRzuJ9yiBUn8vvvv3RvSCm1e5SywRhmhMNU/biGdAJQS8jbw8/Mrix/s+j40dgr +o7MLanyBCpkLP0yppBpVfyYihYBFYYDB5kkSTTLN85+54U3f/Ov1yfbRJMxV9Y2WVp3PP88rC/Ct// +5v8wHHv/vvvO2k6d/tc0WJ2d2aeo+jfn3kMk72V44TRwOL/3Sp65/evH5F3lhokYQTnDi9pijJx071 +5/jytk/+OsPnTn9Wdn8xKeFq+NJCjsyDY52KT9skNSQGLJ8SKwt3o4QvkKNGV54eYXnFrsf2RIJ7Wy +dIMgZDrdIyKkJR3fURaEZpJ6w2WTmtuOfs5FEkBMYRZ5l5Kbg8GknitvuKOaruksuhgyVIaSB0TGZ6 +5LLi0kwsXTa9S2IBayyRMZhzAjLHmGWY1QNX2nSiG9n5ugDZLJ20UvPINujYirlri7Ah++aTod8R1/ +9K7i+jAtkqSCO44tJkqSBidBBSBAnJElCHFcITIRSCi1VaREsMEqj8A+TDcCm+8+/70ki8v3BrvSH+ +y5iv9gXUUJSq362UqsT1yqEcYWwkhAkFUyc4AVESUJjahpp9Ad2O+376PZBCLQxhaTdeLrrfIkNdfv +i3hLFKBuRJAFR4nn5xT8+8ual135+cqrB1NQM7c6Iy5fXef7ZC7R34cyZB3niqff965m56V81kSSKE +oIgwhgDQYCJQyYmAm677bZffeyxx/51pVrn1Vff4E++9CJr67vgAyq1CWwOZ18/9/OrK+ePONoInY1 +RbuRekDmNJN6vWMc6OEIZEJLdrS6rq6v39fv9D0hZYFaF89TCGpGJEEJRD+pUq1WOHDnGfQ/cz9Tsz +GeVUiVOU2CMKQcxvrgnkkNqYqqUOlL7521u+1g3elhIhwkNcRLSbNap1RIqlZg4DjGRIUkSqtUqQRy +RJElqguCiQh1o+Yxr2ndR0feOBZ/jLXPwA4/NQ2lCEIVUqrVXTRjhhUIYgw6KoBOiMLwX3hagaTxae +mzafcx2d2DUBj/c/5CeFFRhcy39W4f9Qgi8KNOhKP5MUq+2giRBVyJ0kmAqFVQU44xBVRLiRg2nNOu +t3Y+12i2wviB5HkbtKwFGFWMUMYZshXib41yX5ZVzvHnl2U9nbjtqTlZxVvDa2at88ZlzPPvl4mmef +vrDFx5/4skfaE7VIQSlo2KGOV5MqtCDWji5wJPve/oHzjz02IX19TbPPPM6L750nrX1PaK4Sa0xQ6c +zjG6sPvfpwfAysE2WtwslOVFH+zoQo7wpEC9l17nQuRHcuHGDxcXrHxsNh8Um5cRYtIogCBBCUKvVm +Zqa4vjx4zz00EOtWq32GUqWw1tXQH4YZV8uR40UukTXFGBt5wePKe2JYk1cjWlMVAoScawxYWFZHcY +RSbWCMYYkSV6lvI/ysBOUeFeVfO9M8N0ceG9VvPbe77cegyCgVmu8bOK4sPnwpoRIFfWcQqBK5TMlP +Eo6+r3WU53tVRhsAz0UQwrPpBy0f1uUjUCUQ93SGlZJdBT/uqlUEHGCqMSISgyVCFOt4sMQmSTIJKa +f5z+42+kkfjjEubHmalnMloiCYi0U8zSbeeIoZHn5As8997v/aGSXn5qaMXT6O1y6tMTzz17m7MtF2 +frwmQ/x8KNPf3Rmdr5QeZJ5oaGBwjqKBexSnC/QJHfeeTcf+sZv/eip2+5nawv+5EvneOXlK/R7gnp +9nonJOTZ3XnlqY+eVf+TcDYKgC+RID4E05MMD52gAlwtwmvZOl4sXriQrKys/2Nvr0u928d4ThiFKG +YwJqVarVKtVpqdnOXZ8gRMnTvy6EALrCnn6/Xu7P4axRckhDy9Hg9536+1j/R6IwVPaeII4IIwNYQQ +q8CgDKpSoQKEDgwkiTBChTfgy3iORCHeIuCvkn518b2lyeFl66ZTpjjroCUsTUWtOPp/UpsDEZMJgy ++6hlJIwMEShIdKa2BQP8vSDw84WpB2QA7QYIkixpAdpJrdsuuUfhBB4KcAE6Erll4N6nbBeR1Sq5FG +MjRNUNUHEAUGzQW1uFhGEtZ1252+1W3vFmWdBOFHIse/DyYoOqMcirKPf3eHNN1/4wOLyy/9QBy1U0 +GNp6Qavnr3E66/32NmG0/few3/1rf/t37jzngfPCRPgpMOKHHyAkmGxoFVhDZX7YkzeaE7zwAOPnXv +6qW/5G82JSV5/zfLl5y5y5foO3b6nUptFBzssLj/3D7d2X/uAEB1gSDYqHKZiU7x/l5fluAjJB5LrV +ze4dOnq39rYWq912x12t3cQOOIwwmY5xhimp6ep1Ko0mhOcPHWKI0eP/vL4RCyCz92y6HJgdJDqeIM +kLIW3MqANooNUow8GgSQIFTpQxXglcJgAwlgT1xJ0FKLCgEq9ThTFz+M91tt9rua7iEP7zgbfPp31r +av/pmGrLzg6VOuNL9eaU4i4RiZD8nIZSykwRhEbXULNCumHJFRz2ajzKKM2uAGSERJHZn3hYeD9/g7 +8dpvCPus6jD4TNOrng2YDl0TkUUAWB+QSRBQS1+tUpyZRccz2TufH11bWJ7NuVliiydIkJs/BFZpcu +lQv8S7jueeeSc6ff/bTQdwnqmQMRi02N7d5440lrl8FEygeevCDv3H/g0/+9ERzFq80QhgKGSANsrB +GLi0A8SIvvA6ihOn5Uzz88Ad++s47HvmNzh68/tomr7x8haXVLlo3WVios7NzmVdf/6NPt/YuJLCHG +kvLl5msliCFRiDZ3cp58+LS5OrK5o93u12ydIjEkUQxUVRIvhtjqNSqxHFMc2qKe++99/zMzNxntCl +QB7mzZd13q0qmLaJ9vAK8RHpVBKVrg2s/qtVoLggVJtQIDVKN0JFHBA4dG6JqBWE0XhkmpqaJK7UvI +03RUBPyJnzn133a+Xap55hrJzgAY1pbcLaS2sRLjekju2FtChdWEabAiokyzSx8yMtdVUISB+SjvW+ +huwODNti0kJPwGntoxufLhkgxEjiMrhmXH5qgVvs3wUQDWa2QxyGuEiNCg4wCbKBQcUhUrZJntra5s +vGJ9cVV6HPgxVeqtY7TrOFoj6tXXuONc8//Yq+3OTs9WwGRce3aNS5evMHFiyOUgofPfGjz8ce/4Xs +mp+bxSkPpI2cxxYkkA2wxiKOQTSzx+kJD0uT2Ox/iqff/199zzz13bW5uwzN//BovvXiRlfU9tNREs +WJx+cLsl5/9zC9urJ9D6UHB6csOBtM2g34bLl1c49xr1z/RaQ9qaZqSjQbUKgnVOMYoQRzHRElIFEU +0mk3uu+8+Hjjz8L8xUVgO7YtxwbjuEzd12Q7VfmPLMgfCD7D5Ls63v0UqSxBoTBCgAomOHHFFokKJD +DVhNcHpAK80UzNHdnUUv8T+ehIH91r82cnHzR6yb9cFLY02ZdEKM9UGyeTM58PGNCJpIEODCCTSlLo +issAcClU8jFHkw+632+4O9DowZjl4c0id/wBgLTw3nYSWwkfAKtBJ9ElTq+7JaoKoJahGlbhWxSQRO +YJcSiq1Okkck/WGH99d2vimvNWHgTsUyQ68Jx3s0dnZ5oWXPv9Dw3T3IzOzdRqNGp12j5devsBzz2+ +wtAS33XYX3/hNf/67Hnn8ff1qfaJkXGhSK7EEKHWAQMHbW8FZ4AOmpk/w1NPf3H//+7/1u5QMeOlsh +z959jyvnL3G8mKHuenjJJHm3Lkvf+SNi1/4oe7wGkL00QE4nwMw7Fk2VoZcPr/yTdcurX2830uxmaO +7t0tgJFp5nLNUa0lhKprEzMzNct/979m7/c47PmmdY5QVxFkp5KG6j30FMz+OOH+wLIQHXA/vWnjX/ +XZBgROVRiINhJEkSgwmlOhQEyQJ6BBhYmoTU58vLOkk3vp9ZgnvQqDnO0MpOvzC/nCna7/KL3oVRpB +lKeiA6WMLf2CDCn1ZqES7EuSL8OR5yjAbknkHWhHGAaGR7+vsrN5B3gPlwHqiMCoZE2IfMT+eOxzGE +7r9YTv4QPaIzL8QSYiqxqhaQrVeK+pCDSYJCMOQSlQhRpHu7v3UztKqREjIIB/2S3MKz/rKMl/8/Of +ufePCCz8TRpDUYhZvrPPqq1d5/rk2F87D9DQ8+eQ3/JMPfeM3f26i2SB3GbKkOykV4q0iyyDP80Ntd +I8qxRIRAUiwTrKwcBdPvf/Pfe7+B5/6J87C+Yu7nDu3xPK1nL2OZmZqgUo14MrVl37mued/+17LKsg +Web4L5HR2u3zhj5+XL714/qc67QFbGzsMBiNmmg2UsHibEoWKOA6IooBGo8bc3Bx3n77nX3T7/Z5Si +sAEN3WTnbVFiedFybIo9eUOS5/LDG9b2HzrDmz3fbIo/pFaIQOBI8X6DBMaknoDKw1htc7CiTuJk8Y +foCvgBEoeCMwqJf4s+N6263KLpEPhY1VeKKVBKWRS//1gYhIbVBAmAG0QsgBDS63QUYCMIrxRqEgSV +iTCD7+TwW6B8xS+8PF0tyJa3P57uHXsaAFXQG3+qYyClkxCZBygAo2OA3QcoLRGh5o4jEh0RGDFA6O +d7qdYb0N/hNYG8pyl61d57ewrvPHqq79WaWh0JOgPc65e3eDF56/z5oVC2Pf++x//0mNPPP0Pji4cJ +apEqNLk0LuS/+1LnIy3SO9KnNqYpHUw4tABRLHh9jvv4f0f/PA/uOPOO7/UasHZ167z+tltttYE2kw +yPTtL7tpcX37p164uPotnkzB27O3ucOHCm1y6cOVTm2ubDzgHRsfkuaNRj1HeEgaSiWYVoyXWpcwem +eV973+qNTM/908r1fgQUcnvk1jlTbo64/csbzbWsT2gA77znUKMSsU0jdAKYWyBYAkUXhU247nXoBJ +0Uiepzfz+fiGMRPh3K6fhHePz/SnIcun30ymhdLGz1Zvna3MLr/mkjgwiVBQhTFCkmkajkwqqGkOs0 +RVFpaaQYu+7/d4qpK2igD9kqeS/ygU5LHbliu5DR8fBT+g4QEQGHQiCikHFBh9IlNbEcUxiQoyF1ur +G9y++eflvd9c3QSm6ey1efuVFXn311U922runZ+Ynsc5z7doGL7x0lddfg0EfTp48Mnr0sQ98x4NnH +qZar+83J6z3+6lTAQworKIPZmf6kAit3BdFcQLmjy7wwQ99M08++Q3fYQI9unChxzOfv8jLL6+ytWG +pV2eQWrKxdeX0y6/+wSevL72C911efP5P+OIzf/y311dXvr/X77KztclgMKCeNAi0Q4gUE0AlCanWI +hYWjnLmzIM89sSjP1Ft1jtSqQPTSSkPLCmFKIx0PHg/DpJb2s++hXdbCL/73YIRSsgi+JRHBUX9V3R +6NUIF5GicCgmixmsyqZ+HALzaDzzBuzPtfMf4fPJPAb0c7g1nAoKkxsT8wm+b+uX7ZRZjjEGZUiZAC +YgMMg6KeVokiBLBQHXPDPpLH0hGG89QP47wk6W68a2v7/Z3X/E2aBupwXn5z8jU9/hMPGyVRUqFQjN +yOVaUilxKYr2g096jPWz/5MZgd22O7i9d2bjGl5977qOt9vYPHpmfQZic1s6AS1fWuXhhh70unDjV5 +Mmnv/l7n3j6g6szc3NF3WVBaUNui8G92Mc95nhXdka8Lh7i0NUt5N+K/6cEx0+c4IPf8OHVa9evfu/ +nv/Af//2Fiy2a05cR2vHex26jWm/S6fW4eOmVHxwO/GePza3/2u//zsvfc/7szk9qMcug7+n2d4gCS +Rw16HevUatG1OtVlPYEQch977mbBx564KXaRP2fjSea42iSZeA55woVcSnK2ytKROchfp8c4fMtvF/ +/AOye0SItwO5SgnI4leJQCKUJdIC3MQxDEBVUUPttZAzW7F+Tgs3gDwLcf90HnzvYCQ/ZiN1cB/r97 +NMKDWFEdXb+16szR35ctCvFridTvHPksjBK1IFChEULWiYjlMhwdvNjjJafwd4GagLBxAHO+u0CkJu +tgsfq2VICyv69nPT3clkYbQohsSOPlQ4lix3e+eJ02lhbZ+X6+V9Mz4nhSnvtC0sbN35hfnaS2kSNl +fWrLC1tc+3qDsvLYLTg/vuf+Nmnn/7GX3nve99LY6IGvrRrLv3UnbcF+MoP8aR4nxUB6kUxHxuTT8d +plixqJ0dGGIa899En2Frf/pWlleWfffHl83/tjfNLCO2ZnJnixG1NZmccmxtv8MrZF3/hmY3X/87rr ++z8zMZSTmymiaMmlaROEifYzBJHiulmjVq9wmg0oN6scccdt3P02OzfQwq8z3He4w+deAV9aoxuyIr +T2hUzVS98ybP04NpYv4n3Gx9DtNAqwypTsBtUjpBDRFZHSYEyMcNhSOYVQVAljCd+vWCsqFv6CYeyn +a93ASXBf8LMRcp93SGLxCpDZWLq2cmjx18L4yZSRXhvEDpEGEOuFM4IZKSQiUVGGWEyQunWX/Xp+hH +SNRAdlBx+hUH/oS5soXhcEoCKh5QSpdRnlFI/JQLwRuCMKCSzAl0Ag73H5ZZBv8/a2hpfevbL/Mbv/ +PavvvDaK2smjuLmzDTdQZ8r19c4+8plzr5+jdEA5o/c/uYjj7zv++99z/3UGtUy6Iqgwkmw43nViCj +KQWSF6rPzZVEqbybll4tOiXKIo+DI/DEeefR9PPDg49/fmKq8ub414I0Lq7z6yhKbGylRNMH0zDxRF +MXtdvtnOp0W2zsr7LYXcW4bE6YERhBFCadOHCWKNVk2YGp6gvc+8hAPnLnvp6qTE58Bh5ASIcUBRQl +3wBmEcrCe3fSGiw2lB+zg/fYRz+5fFbKLNjkmKDCaQlukHqCUwUtF7iTD1JJmAh1WX4uixrNj256b7 +AfehQP2d0/D5dZUvBSv9YfYlQ6BrtaZXVj45Xp9FmUqeGHQQUgUVwiSCEKFiCUyBEyKruTESY7NNn+ +I4SbQRtD9yrZQb2dj7UuJBekJAk0chz8iQ/W8U55cOVSgMUmA1II0T+mXgXf1+jWuL96gN+hTnWgwe +3QeGRqW1ld5881lzl24wd421KameOKJb/joo48/xbFjx0owcY7NC61Qm5VBpASFwdUAIR2erKz5xP4 +xvX+9nAPlcQwRWKTWIDVHjhzjQx/8Jt772JmPBqFme6vPSy9f5uyr19jc6DLRmOXY0ROcOnU78/OzR +LECOcCLHsPhDtZlNJtT1KoxlSRkemqCM2ce5EMf+sDzx+6640fQemxyeGiCVwSeFKrIHjzF5xjX9GW +e4clx9HC2g/OtH/K+hZJDjPFEJsAYhTYCFTqkVGXjRuK9wgQJjebML1eqjXK8I99md3V/Fnz7L/q2i +IPy7Vi7/6fxWNYKCWFAY2LyF2vVCQITI5TGmJAwqRBEETowyFAVKhHaQiggBuv7H8+yTgIpvrBe/E8 +6mcddxfEJKLQkigOklj/gsLnDg1GYMEBoRZ7n9Ed9NjY3WV1dZZRlHDtxnDvuup24UmG31WJlbY2rV +xdp7WYkzRoPn3n8bz7yyKOvnbztFLWJGqExCFnyFFWZQI0vSz7A00f68UlyCA10eOPQ5QjGF3WhFgp +vLbVqg8cff5InnnjstZmZmb+ZpnDt2hoX3rjO1Wsr5JknjitEUcSxo0eZmm4wGLbYba2R2wFaKwIT0 +e12mJyc4MyZMzz5xGP5kbvu+AGUgnRQvE9nb5LoU0Lt19JZNhZtyt8y+3UuxbpBYl3/454hQuZIJRB +aFcoFZtz8Vihl0CYkiGJqjQmmpqZ/ERUVPixfI1/qE5/4xDuQduoC5CoPuuPyUMXlpS5nb4XTQuA90 +oH1El9rtLZH6cMrvn+6l+wQz3YIKm0ikyN1FVwdTANbNaSVjGGlRx7lkVJyoG34jMCg9GzZeJGkXpB +7gSu9rCUjsCOEzRAOpC9kY610DEXOUFl80lzt7PWupp32R6elRLRbdLdX6Yz2eG31Gp+/dI4L3T1qd +9zO9Kk7IaySecHiyhoXr13jxpUbuB4cq8a/9ReefupHvvPDH+au+QUCpxEmJs0FmOKiCJ3jRQoix0t +FZg2hW6fd2qNPjXpzChFmBPQKx1eZk7kBSkuMC9DESKsQowxlJBWl2DbrrG6tPLu4eP2R9ra/Z9AVB +O4YWh0jrEwhKgqf9GgPltnY6uJHQ+aqUxxJJqjkOcGs476HTnPmqYeZvfv49+m6+kyqLGkg8TIAYVB +eoZ1AO4l0IJwtJPyVpS/fRIoIKWr4AchUI6REuXOMss/9XSfOfptUu8W19xLPEKfaePZw3tExQ4gT+ +nmT1c0a1fojvzF37MlPWVtD6hCUR0hbnsLyJnFQ946ne++WtPMrAlzEWx5Syv3H5MyxfzsxPUcQVwr +Le60h1BAqqBgINcqE6CBG6QStQqSUfxc/mMB3y/QtO9DUPFyUe1EQCUU5fxKy+N6LciAMLrdMTEz8w +sTExN/PnCN3FhMVttHLa+vsDQYktTozs/M0mlMArK2s8vqrr3Pu7OtkHYgjmGpO/3AtblANq8ioCio +Gq9AEaK8LZWerkFYjvEEREagqvp/hcomRIUJHjI0mfQb5yGF0AtbQ7aQwUoABk7C33eP8+Wu88OzrY +KPJk8fv3IwjydraLq+ff50bS4t0ukOcVTQnj3LqztPMHq2jQkOGQ8aa6lSFhRPHufPuuzh1x51/v9J +o/ELRryxgem8RpZVvxfAq6ngMzrGvbk2+TZ7vTuR28HeldwXGE4UUAVKZQk1NGBwKoysIDN4rJhpTN +Kdm/q2RIYEOb6YQvTuX9zt78v3nBqMR8oJm8NE03ZzTskMlFqhIgTLFqo4kVBQyUUijQcUoUQ2lTBR +CfhZ9tAQQKpwvRg/7IwZfCsp7WcwYhCpP6bHaceFHVAkDDOKZYbdba+/uPbW10+Liles8/+p51vf6J +JNTzJ08gYlDOu1dFm9c5eqlC4xaXZAw15ylYap/TaUIMRIvuH6WiVxQSaoIr/alHIQXYBXeSlzuyXM +QvR3a7T54TTWZQOoaiBghE6SICi09IRAuJEsFO+tdXn3pDZ555sv84R9+IXnu7Cs/trXa/rTI1ZN5m +jPo9un1e2QuJfOWI8ePU7AeY/AR/Z6j2xkw0ZzkPQ/czwc//BR3v+fen4wnm/8A4XDC7WuPeu9Ronj +/N/mSiLINLMFhEFQQXpeSiW2su0JuL//PgpVv8r6FwqK9QYgAUHjvcCWk3ooGo1FIrxdTb9x5dnb23 +h9RqsnhTqfYZ1DfjGzx76KQ1HwNfe3DwsIJqs1jnxz0Fj7p+tuIpA1iVHQnTApRDMaAUgXx1Osy4Wj +/GM7/X7jd1xBJ2RGsFqcGY1V3PRauvAl5IUqiiwfCkh6jtSZM6j+aq1ZweWX94y9fvMz6Xp/a7BHmb +jtFc2aenc4Gq6trXLt8lc5aIdwchwmJqiBSVdtd3v2JN8+++eNpK//U4tG1n5u/vn7u2G0niWt16hN +VVFLcJSEEikKvBlUnlD2814g0hjwqNh4LaR9GGYxGltWVTa5cucaVNy+zdGPxvs3N7Y+1d1s/uL2b1 +ZYXt9DKksRVJpsjttsdLl++gTWS6YWTBGGM1k3mF+6hvSPYFpvUjk1zxyN3c/qhB/6PaKLxo2BJh0N +UGCDL2b4U/q2LWx40zYpB02SR0guHND3IlshGV+53buXHtOrhshzhBF4U4xyEQhAgVYQS4PM6o1STp +wGN2vwnA9Mgtx6txjYo4mtiPb/rg2+ffHl4+q0TRHX2U3Fz4X8aitXjqbJIYZHGISoCtCsq81JEUwi +P9znQBj/6x7iNv4SsI0QB+C1GvxonwIlCAkK+jXWZRJUSCK50ZlRUGhNMHsn/pqhcS9u5+DtUatTmj +lCbmQcTsrXTYWV5g531bcigUokIZUx/tw/ZgMnpGLuX1Vqr2z+2ubz7YxfPXXmmeXT+P1QnGr83N3/ +03Mz8DPWJBiaJkIFGakWc5vQ7HqSjZVJUp0V/aNnZ7bG2vsva+g6t3S5raxv3ra5sfGu/O/iItfYDo +/6QdCRQgwq+a+i7AcoqlNAIB8M+7HWGfP7zz3Pv/Q9x2x13E9QSmscGzBw5zqMffD/3v/+xn5RR8qO +FOJEniCtFs6QMd7CqAAAgAElEQVT0u9CH8JRe3Nxn3G8PZeWGpgfAOrm7zCi7+I+lWyIQe0hhSxn/g +yGrUBpJBWSAyCdRKKJodrFanfkUhDhfKoB/FTiZe5dVffprIfBu/V4YAbJO1Fz43zO3+s/T0RCpIY4 +sVIKCkqSLG+d8wU4vArCPEIOP2HztexWjn8cUO6uiqCVUKS447m8qcauf+7g+yYqftEIoxeTRY8zfd +vePNo4u/p1+PMHUseP4MGJ1c5tLl6+ydGOZdJgRmJiZyWm6OwMG3S7Ga/J+ytbKGoOtPVLg/2XvzYM +sO8/zvt+3nO3uvffsCzBYBhgsFCASkLGQEjeTFBHGiu3EkURWYkk2VYq1REuKTiKpXLTlhFoiS1YiW ++WyltiyRFKiJHCTCHMndhDAYJkZzNbTMz293P2c823545zuGVByySXHBinNnbrV042pRve95z3f973 +v8/weF8X3TZ95/j6VZv9HZ6Z3dmZu9ovNbufJuJkdj7P0FZmo1eWW27q0vj5xNsg066SlpTeZ2uWtr +enBi2sbN507t3pHWbg3gNxX5AYtNFprBlsDptMpURQxm87Sn1jGgy2SDLrtBluTCSvn15AbE5Jsns7 +MXmZ68yzsqkBX7aVlOruWflhuGza8QEiPFLLaKPgrssFw1QV/BaZYX3Rqu8E2AVZx/vR/L7j4kKSP8 +EUdRSbrrX+lqQv1GdyHiCJvAykzvf0f0tFcvT2OK+XL1WUe5NdMtfy14vtPXf2CAiETos6uD2X2uh+ +YDooDIk6hOQU5BeEIqkqt3RbXCukRopo8uXLlZ6Qo/1Co+DIyQ5IhRIwjqofC1cnB1rvPP/MILytOe +WFgamDoecg1mix05+nML7K2scbZlQucOnWa8aW1ykyrNG5cko/6NEXMnrklds3OYCcTNjYGmCAoBBi +lMcFz/rTcp5N4n4j0d6AlPlIIrZhpSfpbA0IQSBEzzQ0hVFuz8WgKKLyDWCcMBiNcaWikGd57GkmCx +JPOzZConPPDdaTTzPYWyM0lJtMpTnhefvkkcaPLHXfeRdbusbm5yUtnVnny+dMPfdP1Bz4cAc5W/Jx +GGgESuS0sCY6A2g4jqoFMcieQWwXwGIpiFWdPzXu3+jNajomEqYxG23lhMlRUOwHeawoH1mnGw4Qon +T09M3PoQ9DBWomSMcFXvk4h/qNGy9eK7887421zG69+FHi0AJ3NELcPfDA3o1/yOiFEmxTlCmlTVTz +MbV2fkFdScBEEf3lJePWz+O7fIXRBtBCigZJRxVgh4HZSCq5u2lUYCGQEQWI8DKaWC2uDxRdOr/z6W +n/MwZsOcfbSKufPn+XUmdOMt7YAaDdbRD6nmOZEGpT3aGVxJmc8yMF40Amj6RSnFWNjKI3DSwVSUOB +rcK8gEpWlKEubaB2Rj0sEEbGOsaWrAE5Bolst4nKCFIJunAKBNAXSQJY1SPUMG8Nz2NLhSkEr66Cyj +OFoxHj9MmdOnWRufoHdew8jVINzF4d86jOP/fpc1ji0b8/CpUaiUehKsxlsdWiWsgZRXcl+qGmcr7r +wbbHKZHIGY87/rJYbS42oQAtZAY6pi06Fyg6GxlhBWWqKUpOXTZJ07oNRuhto4J0mSqLqfy/kFV7rn +yEx+3oqv6/Lbmf4c4AbRpZ18EmE1OmjaZK+y+F2lz5HJ2BFUTUplKgCSepmCaGCEikC+bi4zU3ERa1 +7jxKaVbdQRBWhWSqMLypVxrYaNzicKVBSQtCsbw7IWglnV4d87ON/8gfnLm1e3+jNMzGWV06fYXNzn +ZdefJawtorINDONBF/kuKIktzlHDu5ld28OP5lUX3cGhKc922a9vw44bDBM7IjcjfHeErBYlzPOc7z +b1t55nLEU5ZRQGlIliUWgGUlS5YiFYbYV02vFaEoSLO2ZQJYpApY4iplOCzbHA5IkIWs2MKHEllPG0 +yFSRczP72J+bi/exaxeHEb5ZOP1+w8d+bVWo3pNtRA7xlXqcE3na4Mz4JwlOEusJBqJMGucPPFlTp7 +83Pe68vyPtzJLIivDsVRRta2PAFnibI4NEqE7GNNiNIJO65sfW1q6/u+qaL4qvpAglaop15W5+lWzj +Z0cm6qw5Z/KibhWfP/RDyfyajtJjBQx3olV5/3f9qIkqBIV+4rytb1qCV2lpgaJM6AxiKA598rGO9c +v5B+bbe9dIZ0Fux1b7BDyivBabHfxts+AUqOShAtrOZ/74pMfeOHUue9WSRsRJWwNBpw9d5pnn3kce ++Yk2fIc33TbUdtOI9nfWGcyHTE/n9HOUqLgiQOkUYSOFIUv2Bz3afRa5C6nKKdsB1XmTMj9GOdLkqi +B1hIlBTIE8JZYSBqRohEpEulItKedSNIIOg1Nu6HIYs9MNyHuGZqtGB1r4jSj2emxuGs3Nx69ietvO +Ex/sG63xluSvGBaGoKP6XV30WwuMR0HJsXmgUbW8nt3Lz4SKXAF6EhW81E8Qmp88FgfUEgiJdFSIox +lstnnpec/xdNPfuau0yce/4iSQ+a6GY0kRoc6FDMClIHIIWOFlwl5nlGaLkrN02nf9X1pY/4FZLc67 +4loZ6tZZQp+jVbpWvH9pw3Zr34GDJXaP0ZUw9cXvAg3BWFuFcqitEfWtDDhq+G4EJVI2TtJsGO21ic +88aWXeeIrJ97gpum/2t3ba0TcrIp621ERLNZbvLeIUHVARQgMC804hy89/vS9X3r8q/96aqDZnmVSl +pw6eYKXXniO0Ssvg4b77nv9//Tud7z1HbfdcuO4mSXfLIJPk5ai02wy0+yQKMV0PGaSjzHCY5Vnfdx +naqdYTIXFl67GJAaUqpQ+Eg++xJkC6Q1ppGjEmkQHOs2UZqrptBMamaLR0MSJR2lPp9tAtRxRlpC1O +xy64Sbe8Nfu58E3fxv3v/GBrdtfd9sHSjd5+3S0tbU53HqbMR7nI+Zm97Br6RBx1GaYb1JMyzcePHj +9J+ba8iwVQOCqpJtKFKGlxDuLrPscfqvPKy+8zMN/9KuNrz7xxY9evnRqababsHd5gWYjQ2mFiBRog +w85QTpElFCWGYN+incLNLN9v9Xu3fGPEC0QGT7E1d6kHtaHYOsZ6X9o5bti2b525vsLyXIqUuw2Nkm +qFBV3fyKI+fcQJrHzplav1RSsUP2qQkiUCkhpuLxyjrMnz/Lo5y/fduY4v9ZSB/+bW9+0F+JK76bwe +BxKVYRlXEBIBd6RO3j+5dPJ408d/+3cwszcEkFKRlt9Lq2cZ/2VExAJjt127GPvfPubf+6d3/YAzST +6p3fedvRXXjx+/Eeee/GJH1h75Vx7cuEyRV7ghEc2EqSWmGLK+tYWnd4MqUyZDIYUZVHhGAIUdoqSA +i0jtIyQIhCrmHYW0UpjYqVpJDFCBJKGJo4laTOrViY8ndku01jSm1mks7CPIze/joM3HRv2FhZ/Lmr +onxnn/UHhBpTl9OcGg8mbz13aesfWxTVeeO5Z0nSR/ftvoNVa4OzKOo899uxvzzdvP7TQoSCAMwEVS +4wx6KgC72LrzIyi5OWnnuWPH/44f/LHn/g164e37dqb4aaKcipxVkMSqrx6ESomqVA4FzMtUkrbJos +Wy2Z64CdQHfAK79VOvLX31Cd1f1VfWn7Nue9qs9i1le8vtjIikFXYV71SgpB+S2CHAfc2ZwtUrUQRo +U7iqVqkVe76tODZJ0/x9KNnefaxDS6c7t+CbbTnm72Pzy0uV99QB7xzaFXh87yv1Ca2tKyMNI898dX +feunUudfPzC7SaHTZ2NjizOnTvPT8V5leXmHPgeWNd7/9Tfc99M63lTceOUirmTE7P1McveXoH1935 +Iafn59b3Gynrf1JnM4TJE5KchxDU2IiiU4TvLcYW6KVJGtkJEmMEoJOK6bTSul1mvQ6LWY6LeZmOsz +MdOl1OzTbDeI0Jm6lxM2UxmyP9uwMrbkec3t2ceOtxzj2uru4/a7XH7/u1lv+cWt+5m/5KDwsElXIS +NCd6SCC5MLKpd9bObf2PfmwyDaGEzyC2blZ4laP6WjC2oUL7WbauGl5cf7fxqpi7jgPKlIUhSE4R6R +jmOacf/Y4n/jwR3n4dz/yT0+eOPc/SA+znSZzcx3mF7p0ZxrEDY9jjNAWYomQKca1MMU8kTpAu3njD +8XNw3+EnK1VPDF10FI1NxShHg/5GsKlrr5oroqgE9eK7y9cfF7twFB97firXvDwJUJ4g7f+ei1kxUe +q5f47CDnvGaxu8exTZ3j2sbNcPOMRZZP1C5N7NzfG+fWHDn+uPdeBJAZnCVIS0AQnUFoyHOT8yWMv/ +I8vvHz6R41TdGcWGY7GvPD8cZ7/6jNcfOEZFvct8+1vf9M7/+uH/voLNx05iFQBFwxxEpM1Wswu7jb +79x38/NEjR3/xhsM3fXH3nr2mMz97KJuZSRuzPbxWjPKc4XCIVppGo0kkI6RUxHGCllNUcCgZSGNNF +kfEUYXWi2JN0qhy41szM7QXF9h16BCHbr6R/TffxI233bZ1y7G7fnPfkaM/3ty96x/IVvZ5EmFKYdG +xRmhBGmV0O3OMx2W5cn7t0fXB6Lt8XlBiSVsR3ZnraDWb9Dc2sNPp0dlOb2V2pv14hasJKF0Bg+M4g +iBYefY4n/zwR/nCw5/80ZUTr/zD3OWkKqKRxbTbCfMLDRZ2tUg6npIBIrYEpTAhw5gekj000hv+KEu +PfD9yHnyCJ6pOeK/yYzsk9kqP9c8svvB1U3zfkNvOba9RtbW0eCrrjJQRUrZ/QEbmKRVkiqvORUI6I +MeZkqKYMuyXDDZzcDGzrSbCzDHZnPL0V57+4L//5CPDBzL5z5aOXYeKr6S4Si0opoETJ07f8NjTz/6 +KKT3d3jxFYTh75jwvPPcC506cJGq1efMD933wPe/665++55vuJFBgyylp1qjGym6KoEmWdWktN9i9s +P/hY6+/9+Giv/m+l8+cfOvZyxfe/PzLxx84f/b0XZdXVis3gvWMB0OKyRiAVKxTFAYhFN1Wh05nhjR +pk6VtskabKGvR7PaY372bzuwMy/v3Prr7wL7PNDrtTyS95sMMgAjKvCAIi0gEKha42ubjPCwu7eVb7 +n0jq6uDT5fuTz74/MmXfmwwuMjLLz1Bb/Eu9u9aYKY3z4WVSzz62FO/MtPJPnPocO9FpMCG6tyej8e +ce/5lPv3hj/L5P3z47108dfqDDaGxYonEB9xUMt6y9LdGDEd9MqMgNRgc1gS8VcjQIUl25ane9QPIO +fAdvKjyZUO4oneoqIRVAKl6tZ7mz9K6XSu+v/DjStRdNVCnCkmRaFDJizK034/J/x/vYvBxlbKDwTl +DXkxYX+tz/txqDTXTjLYmQMxwY8inPv6pX/QN7IMN9SvzB5YQjQxEpZU8dfI0n/j4p36nYI5ms03Wb +HBxdYPV1UusrKyAdbzh3ru/8sYH7//xG66/niSW+KCI45SAoMAQqRjrIUoqPguj6ndJZma4qXPs4Rv +S2x++c+tuRqNBc7y+8U3Tzf6xyVb/xvFm/9B0NN5jjFmQ5enu1tYgCxY1N7vk5ueWpllzpt9sdNbSV +u981uye6iwsvdBdXnoGpR8ji8ckUJZVYam0eudjmeA0WAwWg0Lhg0AnCTFw7NY7GQxKVi9v/vjFzbV +v3ZwO7u4PLnH+/AVSpTiw3GNtbYXjx1/g+kPLv9Pp3njrzHxGaT0mzzn5wnE+9ZGP8bnf+4O/u3Hy9 +C/qSQEURCyjvEf6QLCKySRnc3OdxkJMM6vSi0zhCQ6ypEWazL4f2XsRm4KrzdL1TaJC2m/3VARfX6a +hv4zFJ0bVNkLIeqOR1JniIEMKpL8aVHK3S7LvkaKLzc8TucvErsRcXOHlF5usXZhhOikwE0/iI5Zb8 +1Bq5DNDzpon//nZUUfPPfC6f6aP7IL5FpMLF/jov/k3v/DyK6dvKW+9hyiTXMo3OXHhZV448RQmv8x +dd99sHnrr/e9554P3MtOJoazU/iDxEjQRpQOlxgQdY4QjtASxjiAofFlFac3Oz9Ob6405eOARoXjEe +EthSnywBCEo8xGXXvwEXbPKof134GdvZ121CZGj6R0ZTbxImUYOKUs0AeUTdARWGMp4vLMB2+4Iylq +LEomKFk2ISBPLHcf2c/ny/WxtbL7nsSefP7l2fjN6KvwuStxOt3eMqBd46ZUT/Pbv9W9RvOsX3nDbs +e/X0zGnnnycL37sY3z1Tz7196YnT/xi25cktcjMxCfZ1ztIK8yRXkxxl2bIxwm5yZnBIwcSVRzCJm/ +ANe//51ty/69qoCk8Qk3xIdk566fR1czVqH7+6UWuDnO6Vnz/f/Q7r3yUyLoBI+p5uJARQqXfi0tvl +7LxBmwDSQM73mI0sozWJ/jcEYqA8pJIJyQ6whlBpCRnT53kjz9R/uI4jNoPdL/1H/vJkM9+5o+//dH +Pfun9QUnSvSMKr1lf2+DFp5/m0tlX6M51ef29d3/Xt77tW8/F7aSyOGl21BZSSKLtzreOqlVGCoLzO +BcIrto/JVFc/3oxzlUgolgpoiitxyyeqUrIG7O0TYlo9FBZl4Zsg7JkOFQZoUQMosJNyKB3On4BUGT +sRFTvkFJ9/WoGnDEQKZJGytLuDnfeeTtrG8NzIoq+6/Nf+Mpv9C+scKbVJA2eTMesnjvN+ePHyYx9f ++hvfSIui49+/pMf50uf+tSPDi6ufDDTEcoEQjBodJ0EBT4vmQ4dww3NsO+ZjGA4gaZuEiVddNr9otH +x95Y7IyjJTpz1X4LHN+jKF+3YfMTVbs0aQ159KUHSfC/Sfl5GvRlnpvTHigsXc0aXxqhSk3gIWtOKu +rSSjNJ5GklK2omY9vs8+9gTH7TCLAxE8cEvPv3Ub5z76suoJKHVeJlps8XJs6c5/eyzdLtt3vaWB3/ +tzW97428evGkJHWp5FGabXQciQYTqvuy8IkhR+d9UHaCJwgePs5YQqlQfESofm0ShZKXOMaUh012ya +JaUAnQXaBELTUBXYMQ6CksLWXnnRI1FrM9ikUuuOA7E10roQEVxzaUQKA37D+zlgQfvpQzmN8+tnHn +Ls8+Nvnv99Gm+cu4MmY5x+ZTpeJPpygrTc+d/Iwv+4MvPPPljq2dO/VALiVQagiAmodfuUGpDR7dIZ +ULw4EeeyaZnMs7IywbNZAGd7tkkW3zvdljnzqolrhXfa92kfdXsZpvTXNlQxI4RNsjsuCB8J6r4vdK +N2dySnD43ZXpxSlREZE6hgqalYxJAK0UrTVAV0ZXBpTVOPPPcDxWKH2rbmEPtBS5cvszpR75M3My4s +HGZFMf933bnyb/x7ne879gdN1OGgFIei6nmTsLXQ34JIULUANyrcyIAgvD0tza4cOEi7XabLK2CHoM +QqCih2UxRCiIZ4S3gEqRPwMYVp7L+1V8FDwrU7oCvmZK6qzg1r0qJuvLF4KocBqEVOpbs27/Esdtu4 +Olnrnvf5NLW/aurq4eLcoLF0yBmVqTYwYBnvvTlpsyna9pZZuMusbco70hURitNyOKUTtaiFzVpxU1 +E6hFFYHw5MB61COyBdA+kB74TZo9LYpQHvQPUlfxleXyDrnxy5/r62rs2VIGOMo7wZCjk7yPt9wUx/ +aXxtM36uqLlW4g0Im8HjNQkokumWuiGot1uU9qcsSkxhSMpPbGOSOM2Ytf17Ern+czzLzHsXyai4Na +bb+ftf+1b3nPn0RvDbLcy4loqSJDHVnFhQtacegNOoCK90zlyziK8wzvHhdWzfOGLX0CrmE6nQ7vdJ +Y4atDodFheWmZmZQydxNXP0dcu8XsLUTvHVPQexXX+vWjcq09TXXsDh1WqsKtG6ztRTgiTWCN3ghiM +HuP++u8Pqky+9Z+PMqScTAomMEd4x32jTUAqz2SdyjkgrkiDQVpDphJlmk1QrvHXMp7M0UHRlglaCQ +T6h7GtCuYyKb0Rle74Pln8fOgQv0dsKmlf9kNeK77WctO98CFff6eutlUfVsyCJlPyy0uWiihb/d8Q +CXZWTxJY886BipE9IZEYjaRDHMT4ouiJha9yHYcm0HJN2uhxsL7A7mydTXY6fOsFYGL719ff84Dvuv +fepvQtNxgZkHHA4rgAL6qP+dgC5EoRtbJ64kk+nooDUHmMnDEcbKO1pdxo0WpJWOyFOBEp7Yg2TwoE +oa/ZlCcHipa6htG5nZ1A56AxBOISMaqW/qVwZf87rWsWu1ZOx4Ei14sCeZe6755tZf+LEU2unT/zg5 +tbW/9lSEutLVDFBCIW0JR3dQJgSgSMloqVTmjKhnTRIOhFLrR6xDbRUhYDXskXa2suu2WP0Zm79X6H +3y5YGmgbCS6KrwMqvis29VnyvzZwvAG4HzhxePUmtJUc2VJKyBEGSLPxkp7n79m5733ui/BTTcYnMK +6ye8IJYC9JEYcsxG/1N5udnaSmNDBJJRDMkxCEmNyWvO3iYxUaDsTR/eMvu3R9ajBOkhcQanA/oVNU +6iiqa2AeB8PXXZKU/tNZWmQNa4pxFKsmufcvcfuctXLp0iV5vlsXFRXrdWZKkiVACE6Z4U+JlIOgcX +F75F+WEIDv1lKtEygiEJghHwBBQtc3H4TEEPb6y5d3Zpm7fKGqynAJjApSOEDyCgHKOXpZx683Xs2/ +3wofsePTmRIW3K2IyKQhFTlckNGoXSUZEJ0lpRzGZjOkmDWa7PTpJRKI9LSkJ2jM7O8Oe6+5iz4G7f +0cke34yJ8LVISq6ErOC8wQpEDWc+FX3i2/QM+A3ZPEFcTUtwFWev+Drs15FHAtU71nFAtEI1RLtZO5 +f9hqL72kkW1glsDqQZS2CV7SyKk+837fMdJtEKuBLQyNtEmuBH+fkY0PwgtKVHF5cxGbqY/RHnH3qW +Q6Lo8TLXdARFGFHyOsFuCBqvkmVXamErnDqtdbCuoBQ0OvOcOOtRzlUXo+UVRc2jpNKEhckcZwQ6Yh +BvglRgVAlaAPaEESoBOfCsY14qP6I6qMItY87YITZwdTInSK8khZkCk+UVt1VLXSF5Chyhpc3WD1zl +ueee5rxpI/S7mPCh7drBJQez4RW3CYLklglZAjaMmY2bdJptGjoGDEpkcGTKEVa13u32WXv7uugd/h +fYmJhIxHc9tAgVO8xwRIQVQMpfOMX3jds8W3T4bab5UpsJ5xUhx3rDEFERLIWljkBpQvjtdF9o7URc +piTyJgkk0Rao6Um+JxBf4qSEik8ZZHTzFKEs0QiRiqFdxJPIDjLeLCJ9sn/Nb44/bZnPjv+wOba2lc +PH7uR3vICemm+0iZGgjpMh6CrwBdb7wyTONqZtUVxmxAMFk+vt4y1ZRUGKarsh8pQrBBIXAjotCJDu ++BrIphgW1Zs8CQIgqiARdXaK/FB44WtBwox4NAEfI2d10rWoSugoqiiZVtPaQxmPOLC2Vf4yhc/xxO +PPcpnPvGpW6ej6U+5snio+u4RGsGs7NKQkqj0zGUtmlLRkBEdFdMUikxKmlkDbQsaqSSRgSiOcJMJ0 +7MXyUb+PmLx+9ujuh3mSrAgPEJUcncp1Dd84X3jrnxXSV3kqyJN62y6SGO2GzEehHG49a3rB6tr7wt +bY9IoxkkHSLSWFRHC1Yk6UkKIdy54WW8XvQuVodU5nHdgJGZsKHMesoP+Q3Yy/ZnR2uY/StrtrSPHb +mHx4AHY16pWwClMhIeGpAafVabPegWvBOLxVSL8KgY6IPChXtmvijcugsUEgduGPHmJU3WAJhkhVNH +RQUe1jSZCBoEXMRJwxDsCoUhYnC/xtqJIl8ZjvUZJjbWei+fP8/gXv8BnP/0Jnnr0i72L58/9hED9S +JHnSOdRIiVSglQqUimJgYaSNISgFcV0opi5dptGHKGEJMYTR5JECaR0SFXtWszWiGxt8300s/9bxbz +s1JVgk+09chAe93Xjxvur3HB5FRPr6r9fsZN4AgkCjBXDldV3bL5yRoitMVmkCVrVYKUauSPrTHexH +aioELV41ztwweOExdeQCWs9zkFuDZMyZ7i++SPr5y59T9DRP1k7c+lDh4/eOLnujqM0980jZmKaXYm +ThpySlGZdSPUY8KqObZAgRXTVKEDtQLy2bzzexRBiJA0QKXiNldRhKhLh69m+Ay8rUbivx3/oajIa3 +DbIWVdzSVmxPtMQGE1Lnnn2eZ588mmee/opnnv8scbLzz71D6bjwf+cSTrBKwSeGE0qNZmKaHhFS0U +0hGK+3aCrU5pS0U5juo2YRpSAt4gAWaxJYk3AoyKJloJicwPOrwj27H5H4vj5oHZSxF41D/Ffh5kLf +7W2nfV2Tb5Kx+d3znq2fpOEr+VdRZ5MVi8dzVcvzjXKnFhHV2BMoQqZ9FTbGikCvj4/BukrQhcgpEN +XzVPiSID1eGvxJsdOppSTknJcdpyQP315de2HL54/9wunz7z4S/NHli4s3bjM0k2LpPMpUhYgFisWp +VTgVXUnD7U/zV81+5NXwk/U1f0kkSCICV6D11VE2HbM2tUJRRK8kCh5BWQSqDSTwdSNqpBDKMGVbKx +f5vS5C3zuK4/z5S8/xZcfe3zX5qXL3xem0+/35bCXAJGsUjcTUlpRSlvFZF7SEJqGUnRUxHK3R0trY +g+JEMQyEElLEB4pBFF9RPBSEJREKUE56JOfOz2X3nLkqGx3kxhyBzUfpj4s/+VpdH5jr3zbBXhltZM +7e7lqmxYqu633MBzvyS9ffC/9LbrOEym/U3zOORSeIEQNSAoVk0RUhelCteohAjKqCq8IlaNdElAhE +EyVCe8nE4yHcZH3htOND5xefe4D/jHzL3oHm7929J4b/v3tf+0W9hxeBj0EkVRPFVORliNkqLDvOJB +U2IsrAKkq09o7V3M2RW1UrVYCvTPkNGBrXikGIad1vrUGaYlCDqEHlOBGUPTxeZ+Lqys88vkv8IlHP +sfnvvzMfZc2p989GJj3SXQ1La1faWsDs8S0dZNO0iAJksh5WlIzGzeYSVI6cUwnTolw6BCq11tWabp +KKZSXlQFWK7yO8ALMaMBk5SzppfPvZfVX5S0AACAASURBVD79J5rohKcSpm+Ha1a3QXut+L4uDn3bs +7N6K1J196qEHomsLsjphMml1b8/vnhZJnlBSnUnrjieAYUlyFDL1KphuNQRPkisr7EE3mNDdecOQlC +OC6zJcQRwDucsRTGltFB6S+Es07UNpusD8qj/vt4wel/aPf/k0u6t3+o0Dv52b37hhFApRA3QTRAdK +hZJC0hROgF0JZUL/qo9p0Xi0DTRuDpQ0lVFJRICFilzoGLcICZIOa32mEFCKMBPYHqeUAwxky3K8Tr +DrTXOnDt93cvPf+5vPPf0U39r/TJ3GF9BsIO1FMESI4lJaTUa9CaBjmrQlQ0iD7H29OKUhaxFL0nRP +pAoyOKYWAh0tN0cE2gNDdmgjAQiq3I1pIqQZU6xcQnOn5YcmP37JO0flFETJwTCKZTabqdpvr4AgH8 +Vi09ckU1eLV/3XOVUDuBG40OXzq0cmmxcVqmHjhB44eviq3LhJKCkrs93onZMCEQQeCGxwhCCw3tbU +a2LHFeWWOkw1lGaCYU1dTRcQATLJN+iVH26PTiwO2PPLHckdvWO8aXJB2Xc/IJSyce0bj0sVPdRrWc +QqodQMwjZAtWugjG3CcxCbOeVIbCEoIEcRQF+CmZYEfdUDnZcubxxYIe4coswzTHTkrwckTMkv3SKf +NzHTvt3+aL/1vGo/4619fV7YnmB66+DzSms9WFaVq9xJGNSH6NkhHGKGRLaMqMlEiIZaOqI+VaTuax +BpgQ6OGIpiIVAKo/Scmf11rEgFilWemSaISKNlBBLiZsMyVdOq3Sw/xANechHyakg9I5hlr80ZfcN3 +3DhyqD4yj70VYEYhEAxmswMNta/vRhPmBGCTCsmZVHTAB34ahsXCQg+YEPAW0+okxyFEFWR1zh0hyO +SgpJtZF9OnueUxiB0hNAKpav7s04li4sN9u+aYdd8g3bmScSU8Xj1HimSe1Ctn5aic1HquUe0mvm8i +kZfEar3hNbjSSAl7HBnFLrWVzlvMDatVl5bQD6EsMFA5IgoJ7Mjys0xzhsmfoNxvkq+tcVoa9jYGq/ +fOXabd6v+iXvLyfD+RNqlRuSZjIas90cEH9i9nHBwVGDPwKSoFsxEJ8QhQRMTxwkdH9PUGamISJWgE +yf0Gm2acYz2hkxFaFnZo4K3SKXQuiKNy0jhS4/1vsL1I7CuMsD6PGe0uUY6Hny7K9o/RSucEuJKNPd +2k+pa8b2WD2MhhlxAiSRBkriKk6sFFDEYB9p6wvrgR5PVTblsPc0ENtYuEssmWmucUlgnyEuPk55UR +TSFrhiYoUCEymbqlKWILQOfM7QFZXtEbidELsKNHfHQ0kTTV5Zhq+RyvIndPWXXkZT2zU26Bxxzu9Z +ZSjZoTQ39eBcwwoUBQqwsRVH0HVEUfUd1BvXoqHHcWY5L3XhJiuQV79S5INKLSiWXcaHvB+fHifXl0 +AY/GH1J+qDivAzNydR0TennN/qjJVO6vcPh6GC/3z9SFMVNwYubiqJgmo/Joo3qeAzEcYVfdLaN8Io +ZmbBPXCSJA3MKhjlIMySLNFmakkQtjgymRJHEZBLbUESdmBCD9o45H9EKAu0VIY4pYgiRIsQRSipcg +LxxHh81KLUHnyBKyYzz9LKI0eo67sQpqeaXflSF6G8aD6qeiygzpKEMQcxcK77XtNvCq+Bwr/pvzlX +HQZfndxeDwUEzyVGlwTpLrOrcu51/X1mhvajOdYSAweFDRafWWqJCwBcG70oiAsPcMp1YnI8QcUzUi +7DBYooBuR/S7Dhm9qUcuq7H4f0ddi/HtNsgoup7OlvNGEIAX+stfbB477HGMw7jm6zhJoGGEFOWjuC +r2V1ZWkajAQ5BPrVMpiXWVVrWae4Zj3JWL22wtTmkMJY0TQHJeDzGW0eSJIzqOWMcQ9Z0RFFlYxJUO +InDN+xjbsHS7m5x4sSEyxvgzSaNVoP2TBc/SBCNhFYzQzdisigmEwKpJGQJ1lXAXKkFiZIgBUorZL1 +6i5rPKWsBgQ+WMjiEFZTGs7W2Rm9r66BaMHdLGX0l1PmWqKhq54ZrK9/XQfFJoquHrpIqn0FV/UMzG +e8era/f7qdTlDV4Z4iTiNhHBARlcHhV6S1FqMYT1nmCtjjrcd7jrcfZkmI6xJqCoATFBMpc4ZViag0 +jM2HoBozEJqprmNsVceONPY7c2GJpOWJ5JiNVAes8LkqQchvs6ncQGN56rDUYY3AuYMqqILyT5FNDW +XrKwjKZTOn3DVJqxtOCrf6I0ggCMaNxyfrmiNGwaoQ6BwRTZaFTfe5cTltXwTFxQxFEio4CzhXo2NG +KI8ZmSNJusetgB6dBvTJhPIRCXGZrWjBs7SdppzSaTVpRRCoVWgaiSCFaGYUtEUJUNi0CWqmK4amp9 +JkuqmRrQlb6XAU2VDkapZNML14kvXz59uae6W7VjCq7owAhNdvJD9eK77V6SMnVbZbt4gsCrNzWK3r +Ga2vvH11YTcR0irKWYC1KS2IUxjmUr9DikoAXlb3HBl9hA4PHuJK8NBRFgTAObT2+CBRT8CLFxgljY +DM4xqEgNAzz+yUHDkfcfH3MgWXIspxWFCFFggkxZdxGUNQz7QpDDwEfSgiO4F1lgK8s+bh6oBKswZc +Wm+dMxwVSakzpqsDM0lGWnn5/ytZmrYuWCuccZbkdoSBxzpPngGojhKclIqJEIWyOcY4YRxSmBG1wj +NDtlKX9TYglK+dG9DcLxqOCc/EScUMz18wq8bSUxInGKY8RDhFJSjzaByIX0Hhk3Sl2ArRUFXYfWcn +5tMNLsKq6IRX9LdzaesJo8H6yzkeErAYMob5ko2vF91oWXz1Irgkp29sQLyungwSKwdZbBmfP3TK5e +JFWnhN7hzMlLoC3Ed5XWQhBhtoB4XGumptZ65BCYrAVOdp5lKhyH2w+wQuNShOKNKYfpgy0gqzJzFL +MwZuaXHdQcGBPi4UOCGmJtcNLQSk0RZRAUSJE7XBAgHdVBzPESF8NlqsbvAYX8IXDFxG28LhSoVSEt +R7vQcoq3dWUpsL2SXBOsN535CWkicB5wXBY/ftmU7I5lOhI4aQgRCCUxQCZAl1OSJoZ1njiSNOamSF +qesqwihF9ihzU3mWypT0ksgFbOcIJsjjCYZmUOTpRKAJBVnoUrxxSGVCKEBzGVTcUhScoj1cOpz1BB +YT2MBliL12Ctcu30J17i4iyj1tZye5CrTu6Vnyv1aRBVFtOEXgVIc7tGEhtOllfv3WyeqEnhgNSZ0m +EYFpN5gjegncIb1GiTo5zFu9KvAfrHUIoSu8oXMnIGArrGRclk7xk0jQcOXojSzfeyKqZcrp/ga18l +UZzzNLhBnv2CbodTxoVKFmidEKpIpxUjDE0VMWl9EIQgq9XvmpvJYQmeA9BE7zEm4ApDDb3uFwRygQ +tHCY4TOkoC8d0ahlPLc4qojhi0i8wFoyB0gacDeR5LcQTgThUWQrSQBgZgi4Rqlp5/DgQ+5LgFRkSF +ac0eg2uu3mJG25t0m7NcfD6N7EUZYiVTTaffpH+2haRV7SkJpEVLkNIUUXZK4+PFD4WICwieGyo9sA +imGq1jwKFMkhliBBEpac4fw7OnO6xuHgrWfQISufVHkFdm/O9ps1OKruJuMpAi9zmkVjsdGDGF1beV +Vy6mMXjEYmzRK6swA6hEuiGYBCyyj8IziBsXkMgQSrJJC8YWcM4OPrOMDIGkaRksz0OHJnhW97xxsk +db/q278yj+HOvbF566OS5F7/v8qWXblvulizMlmi9hVADhJrgJXilKo+csChtkdIjQhX15Zyt/RkOL +yobUjXeU/hgcU5Q2kDwleazdKN6wCmZ5lNGY0NegHGK0kBpBSqJUXjGI0Npqu/lPAzHjpmWw0mYWMN +0nCMiT5JVxyk3EcwkPdKsTaO9RNZeZKa7l11L13Po0M3sWt77dJku/ZK24cNbJ05/i86ifzV9/nTDr +o+QhaMrU7A5XkjKSOAij0tBaon0DmUcQcfEVV5R1eiSDhdZgvJELhA5z3T1PMPTJ7L2dYfexVzn54h +afM299lrxvRaPbSm1ugqZcKUX4zGDzXdN1y48aC9fJJ0OEYXHljnOF7gAxutKoBscwllwJaLIq3OVB +BGnjMsJW4WhUBGjVDDUETNLiywfPOhe99++8SuHj97yAXbPfVIZx/7lI7+864YDv9zfuPXb26p433T +txLspL2DDBugRjhFOGnTi8cEQ3CZeiKq7KSpIbPCh0piGgPMB7yUEh/GO0o4xzuKEx0vHNDfEUYpQC +usm5CVYLymtYDg1GK/Y2CrIS4h0jBewNSgJARpZwsiMUV4QyhInAkkKMslIRAOIcWGG5d1HufnoHRz +YfxOLi/uZm939ER01/4WzfHRU096iRvzvombW35yb/anp0y/dXZ5dV8F6lFdIGXBK4aJAiCTIil0jh +SdKmkTeowk4GbDaU+pQB9EGdDBM+jl27SIM1h+kXH6XSOIPOxlfK77/7MXl/Z/yal39udv+wbczh23 +FENIK8umgM127+NbJ+TMlW+txIxhi4Sl8jjMFhfGUItDMGrjSMO5vIQXV3Cp4ptOS8WTM0AXGArZ8o +C8FjX3L4egD94l7H3zwl9qvO/BvUfoRpEM1YiBCRglLy9lHpTUfbSZzh0Sx+d+Z6crfzPOVW0t3Cee +28GWO0A4nN6rsOi2Q0gIFNpSE4BBS4pxBSMl0lNMfjzAYVKYwefWzTUswLlCUgdJLSge5CYwLz7QUD +IYGJyRBCoa5pcirZoeOIoSOOb82ZHYWOp123cJXJI1FDh26gT37DnDkhps5fPgGDhy87qtJ1v5/Bfr +XpUpPVYm3ZdXtl4K402bh6HWfnJ+fLYu9e75j89Hn3r/51RdDpr3oNloEkTOcrIN3NLpNhHcMR2NCL +NFxghSC3E4oMZBUZ2CbF6iyYCZJmVw8y8zKqZIbD75Vm/jTOokHAXb0rl8bnPq1CcbXiu8vMkm46sX +7s15I97V7fr3dALWosmiXq6u3i/WNWE2GaGdrf41B14JqG0kmZogtSlQsEc4zHo6Y2BLZyOgPpqxbw +0peUrRbHLrrbr7lrW+/fMvd3/yb6cLCj+WZnlb709rxgK0HHhFCxUSd5ins4k/r9u6fju3lb7blxf/ +KuovvdHbjVhcmmNIRXKi9gdX80IWC0hUE6yjtlOA8uXFMnaAMIIJj6g3TYEE1MUimzpIbzdQqcgOlU +1VSQaRwhaCwlkkRKG31OqooRWVtFnfB0tIudu/bz8L8IosLuzl4+DqOXH8TS7t2fzVOG7/f6XR/N0r +TLztjKL0jkqC0IErjClAYAiZU57l4ef4RncRf8Yn2arH9t7eef3khH/TRBXQ7c2hpCEWOd45Ob4ZBE +XDBUtbjBaVcpTgyHm8sOIsUloQcu7Ea67WV23XWaqdJGJTXAEr/5YrvP7Tx9Nt8zu0ZkKja8W5z64H +R2bP3hI3LJOUE6as32ocqzVZLjUsCRZlTmAmp0EgpmDpDfzrFhkCZJAwJpHtmueWee7jrLW99/PDtd +/zrZHb2Q15IjEpqnb1DBoMMtqZXVF4KG4A4RsRzaGa+rMPClzG7fhy7eRNu/Ja83P+msizvN/l0xro +cR4FngrADSj/ChkphU4YRRmQ4keOFxzCmRGNCRlFaBhPHuFAUJmFqAqXXBBVTmDGGCJU16LZikrhJs +91hbnaeTqfD/v372bVrD9ddd4R9ew9uzs8tP9Jo9T4dR8nHkRwX+so8VWpFJKqcQE+ODx5NE+XrAbm +WeB3Bwuw0a2U/oPctvJLPZH9n8sKJ15VnV2g4T+ShsAU2SFSqifEEW2IpEJFHa4mzFudKpK0FByEnQ +tNfOcns6b33iKXdD0Rp5zeCSq4V32s7Y6+REWGHJ1HZf6bTrt3YfK9ZuRBUf1MkZoqUUDrD1JYEL5B +SMTUeGwwGgzUlUZRgIs1QwMZ4wpZWqKVFbn/g/vL+h959eu7WY9/thTw59o4ky7gSOqyQ+OoZLEJIA +oqpZ8cAK4UkYRYRZaDnjhPM8TSLfj4tS0w2udPZ/PXel3dZM76jyIfHymIYb/XX8G6KFwOCGGBtXmk +kozFejTBmgKEgzkpmdKA1oymdJIgUqRtMCk+StunNLDC/uMzi4i4WFhdZXFwue73eM1naezKJs0ezr +PklrdUT28YQ52uHUllvFlQgikVt0rVVkIpwkBvQGi0jcIGJspRC4rIGan/yK91UfjLpZP9uqMSB0em +V2E4CUZIi0Iy9JYlDZd4KHhUJNI6yLBHWIp3Ay4DHosgZXTpLdPZE6By9/b005j6m0H2uQXP/M44S/ +hz1rKzV1J4qLRZVZeeRT47ZjY0lsdkXyXhMUuecG0oKnyO8QlrJ0E8AsKLK5ekXlo1pzrq3jLOEeHk +Xtz744Pib3vqWj8xdf+Qn0dELQick242eq54aXSMAq+6PoJKwuat6QdZDFDIIWW0RkhBBpHgigicQt +bvV5YRQ3LAHe0Pw+eGiGO83xWRPwC3h3VxR5jOTyag13VrN+qNhVBovG62ez7KuCSqdKpWNdNrcTNL +2ulDxxTjJzsdp64zW+qRQ6kWl1Itaa7RIdzbuvg4bCaFizWyT+XwA5331XoiaXk1U0cLVtsui9lK6q +mliqsnrOF5cfKYR1Lua6H84TpJ3mwurzbKYYF1OYXJ0UeCFwUmLEJ5gHaK0RF4QaQW+pJQGrKeclBQ +XVwRba0v0lo8pGX/W6/ha8b1WRRiEZ8chtsOr9NjJ9Nbi0tqxeDIls5YYg5DVaEHEAll6hAsYW2K9x +3tBieLyeMK5rQF0Z5m74fpwz7veLQ7dfdf/0rvxpj9A6pdyG0h0VWy28MSJrIfE9bKLfBV4Vl1lbJJ +chZp0QJB4VceX7+ji6k+iFAEvgnlReE+aGFJntznv4BxlWSCWVlhfX6c0gdm5RVqzC4AiyASRNCgmO +UHUPjmtqpHFdhNLSiZTi1KKKBJXDOLbXBl5lY5BVr9QCBCCQso6pTdy9TIZQEbEWte58WAJKDTp7Ow +L7dtv+d+6s70vb7z0ws9eevnFMNkohUPTnBY4THV6dwZlHdo6tIjRIqKQghJHMFOkMZSXV+Hs2WMsH +rqVrPPZa9vO/8Jnv6sL0WOri03Usz0BFKY92uz/8PrZ8zSKksj8f+2deYxd1X3HP2e5975t/Gb1jMf +GO/bYYBswBgMBgp0GXBkqIG2DQqqoahU1SEGqUrXqH5XaP6q2qVSlCKqqTdp/0gZFbYIapS1UJUogU +kRD2Yyx8Ybt8Xj29S13O6d/nPvevJkxhQQCM9Yc6cqekWd83znnt/9+32+MTGJSz84PwgImTklkndh +YapGhZgSJ79G1dRO9u/ey5cAtr+07dPffic7OJ/F9Ujw8PV9TzCkJhNlLqayZVC+IR62JkVI4DvcmY +G72zyxYlSzoUBTY+c9nRJYJVWAD0C1zUp5rhsZKgqogIcTPd0LQ4cQlAWxAUMjPW7amwnLT4xII8u5 +9LWBMTGpcptXzPCwQRTFaa5T0nRIxztLYJKMY81OHxy1sw4ijwHFfpILUZvRnnWve9kr6a+1tKgkL8 +rft6bP76hOT+PUJIhJiU8fGMaQpOTQa6cotys2HRVGITRLmRi8z+tYxejbv+grl7m+igtlV4fsIhW5 +BBrTBrdMAP7IQ1asPzExOBBMjo+TDkDSsY6IakTDURUoUG2RdYKshdS/CCkW1HjOXWDo2bmH7gdsZu +OuefyvdcMM36Oz6Ll6+OStO6p55sORaNhnugfUXwq1LiZQqQ45OsTbJujL8ZqiSMtNA03Q8Dg0uBwR +WuQkFgUQK6XA3WzCirAVlNWEkqdddQd3HA6EyRGpJmmRVmAzHxS4a/4jTEGtTlJIZv7uLow11LBLfl +xm7qyWNXWyttNtuN1GegM4m7RHExuLHGUW3BWkERkIoDcLXBFvWP7mxlBssFwu/OXLi9P2FmWGkgSS +qYxLXbKCFRBhBkiSInHQOfBohjaEyOUH4zjk6J8YD1V95gKDtm6vC9zHFfIIqxiT4op0kAc8z0s4Mb +UtffX7D9qkTeLODzMkKM4FApAG52EfUq4zXp5iws4xX11CVkqjcSXnnLq755Kemtn7i0E9yG7Z8oWb +9GV/7CJM5gxJQCVbFJKSkJAS0z88zyXfbVk1DP4iFL49P5/v7/FkW12Hm2qb0TSd5/MIMXbWTlAIP0 +k5Cr43UM+i0ii8KrglLgSFGk1lo6XgkAtkSM1lwOJ4tDerWzusT1cgutwiwyTewrZu/xHhLUaQ94/j +yrChgutq+J29a+8O2nTf+0+Dz6taRc+fak0vQqTyCoIZOK/jxKH5SpTZdJwk8ZizUdY6a9fCGh1Gv/ +M8GOjq2xR1dErRJjCEQHtpCGjokNGwK2pJgSRzKJxqBb7XzDBIgvzzu+YqkfHFWwfUnWgG1arU0Nnj +5sdr0LPVqhSiqY5IQEYdYE1ELq0xVK1TSBOvnifwcaZCjf9sODh05OnT7PYef6OhZ+6hBTPg5fyFCj +23dKpFhiHzMhyZla0dCE0RJNHBHPwTP44M81s670Y0/lVJJEAQTxWLx0YFbDj5xzcDAUKFvHUmxjbo +fEHoBsQyIYoGnAmQsCKx0j4QorDJ86RwMX3jM1GslZWOkSR2AgQDlzHdDW2S6US694GLV8n2gFeAhh +EeMa96tTc598fLp8+3x+BRerYaKaigiZAqVeoQ1PmngMx3GDE1OEXetY+CmG5NbPv3p6rqDt32Btf0 +/RQfjAq/ZKqpFa8CkmxZMLoMGJyll85Jn2ZCs/CGQQr4v4fpFhw3N92tZvu+jlBpTW7Z9bYPnvVDqK +H979u2ThcqpN3U4WmeN9WkL1hDOzhDVq2jPR4kITynCNGb48hl6x8+167D+RR0EX5VCZDGBahj2pqK +UGV43GTTW/++prArfksvxbu6nNpBKSSwEnqG3Mjq2Y+r0ed+bmCap10jSCGvqCCMRVlJJYMJqZoMct +tDHtbffw8HDh/+j97bb/oZi8dkkjLG6gEETpZacEu5MRUvWQmoH374MhG9JHCzEPFvTMjm/xVaw0Qo +mpSQWwXhu/aZn17d3PDLb3f07Fz19dFoopseGSecU2sbYNCGnPMKw5mYfpWVq5B3Mhbd8Oz2xg2KhV +0o1bI0AqZro1q4yIskqUFhMJn6mOQe6Knzv8xCvKICRhJxwEVi1LiuDg/dHg4MEk9OYKKQe1wmjKsY +oIlFiNIwYlYKe3ddx860HuO7wI38ddHb9I6X2/8XTGN8B8hlALaagaiQbLRngj1w2wpeZwWbiyeKGg +OVH+f+/h3JoIoIb0yx3xCrASMi1dX2/uNUf2uDlzhS7er48/uorXDp2jK5iBzmr3VlUa5i4jhIxszM +Vzrz+El0HL9zvl9f8EcUSQlhSFFa62qpqfHgrUYKFkxCrlu9D0PjksjpaQmVy+PHqhbO9ufExctU5S +GNmowiLZC5MmQgrRJ39XHvzAa47/KlTG/fs+T7X7H7cUfBIUqFIgSjLSTZZbiVLEQvs8ooZhGhkZJZ +Xx4fJYlApZdNFbgihEC5HaqxPJA1+oeOV0rbc46q4hkh6v1yzcvvEmTN4oaEeVYmNwCQGKRL8esLYq +bcRZ071dmza8Dj5/B841kxL3CJbooXPT0iZEQeAEGa+7LMqfD9v0OOBNQjCHZVLZ/fXzr1JYXoEXZk +iVhEzRpJIn1Brgu51XHvbXey5/+gbwXW7/xIveLoeC3KlwKYCIqCWuKJzE6buXYJzK+Y7XJZNzLc44 +fIRXK73ihmVUk0BXPwzUkpUAkJlfbBgY51H9m74/e4b9culrt6vXPjJj6+ffPMNpi6eI+fn8UyIjiN +yQhGNRpw79jrbdu/aT3f3Dqw+CZDYFIxECYHXCvJpnABaTKZLzUIArVXh+xldTwtxGAnSuZ760Ok90 +cUTFGaHiecmmckZ5vw8w3Mp5a713HToaGX3ffedYWDnQ5QK5xFEAUFz6l0CBa3nU78mRUm1VPjE/AT +Tsst2tuyPWAamWQhHKf2uMXt2hm6YClKh8b1SvdS/+Z/b2jtfzLWX//WY1lsvRNViPCVR4zGqWiOXK +irTKZffeoupSxf2tG/a2EObfBuVs1JohMqSKylLqK6Xy9ktOMeV4mouiCEM5PzAzgy+87lLb7zUy9Q +lVDzNXHWKyPcZsz7d19/KgQd/I9195OGvs3Pv5ymWT1nhRQjXFS9tk7C5WZVTGHzZ4ANwnHDuaSXj/ +OgSFo3Pv3gPkiSZF0AhIFMey43BZ/Fo2Pw7O/g/bSGXPa6fW0dJvu2U6lv/+X33/8rXdx05mkbrrmG +yWGaqUGYoEkwJOHP6NC+//HIvlcrn0J6N0ihrS1hZa0W6nWkMyk/3MjV+pHb5ohUz4yKVMWkhYDQRd +F9/k73urqN25x33fpn+Dc8QyMFQOrg8kaR4mWFTC7SjWagfRUOFZow6SOyyKDRcBUulWYlEo6xAGde +iZiSkeBTKPa+qtra/2HHnPSeKa8pPHP/Bf4sTP/qBmJyN0RGcPHuR7teP213nLx5Zt37z3kAHr0WZE +xBHDt7zSmGDWBW+D8EaarSZntk/cup0KRyfFCKOGDEp+S3buHbnXrYfeuCF7t23Pk3/5qfwJLMYlHB +IZ0lcw5OLTqS1f2vJKdmMvNK0JMs+Xh0rRFbBWqGjNREpSkiUSDPUJgfJr1KXrTRKE1s1mF/b/9TWg +0Xht5V/XZTa73zthR9x/q0TyHrIifPnxevHT5a6du/b73cV3tQ40g0dLHI5pSs3yOa3VhMuH8xX9kk +qg6N3D588212drCBybei+NWy865fYfNd9/86Om/8UEbyQ2pSahVTLZiIl7+Xnhcs2BI+MlTIbArpCV +lM2I4flcXgrmRK50UKkGi5oY8+zM5GAEAFWJMi2zievueHAq6We/j9Myj1HzsbfQQ5e5NTQCC+/ebx +74M7xu9eXu//BWOnQBNRSwTPNLKhcViZwRbaXhcns/qnR4UdmHKb3TAAAAyxJREFUhsZJ04Dyjr1sP +/qZoc1HP/MMu29+GL/0IkqDD1obRwNm4/lTb8Zyi6ydzWjCMuoxmz1iwbMqeB/80mVN5I0bqLJG2gy +PlTh1uKbCB+ljc20vdm4deHjPoXuf+cSvPTpU3riJmvQ5fXGIS8Njj2D1fl8pTBS30PwaUtyzINGyj +OKGlWj5vJnK2IOnjx+L49nQ37nrAAOH75xuv/XmP6Nv078YE9RkaEGnSBUCKRqBFj5e1o1ksxMQjYK +elQuEsLUwK2m1kpmlVB+/8K1kAQxaNtBmjeMOl8LtcRzV8WQuG6FQGIQVWtbW79zz2L19Gx/uL5f+J +P+fz5YHR8Z56aevxNt37n2wu7fnNd/TsfNaXBiRZiGDwKDRLbB3q8L3867y+MTlXdMTo8WBbbvi/Qf +vGOLAvt+qrl37w3EIcxLag4x11laIRAWPAI8Ot/ExpH6jWC8yF2devkyLrInFgmeWh7OwRPBWGG+Wi +F0jppWWRJBNHxikcD21XjFwUpk6AkatJEkC1orBclf73x564IHjhb7+v3/uv55fNz45VRy+fHlXd09 +PmSgZc0hPNhvYAruYN27V8n2gtXV8fOShnq5O9t+492kG9n2LQv65KWAaWAMUDPhEaG0oIFyOMgkhy +YOaz2HKRVHc4lqQbf3LMisUrWjrl9XhhBCkwnWnNLiFDVCParR5BeeRJE47aungOASE1gueu+OTh76 +0dt3Gzx47dvzRUnHNQ8Cf2yQZE7mg+XtslqVWi5XocjlDu7K0pgS+dfbs2V8tFotPlUqlr+ZyuXNO+ +duFtaSrZF3pfCpiGjN2imToJJ39m6BjG1XZRwrkAI8YUKSZWlEZQDAIrNArHnyvpXtmM/B7wJeAbwO +fBcxKuQMrzfLdBoz29fX9led5v6u1XnBJW7vnr/YlrXEoNo22LRYOYlxZ1S6rkOfDcLvPAY/hGmWC7 +H68uFI+x0oSPg2MAN/L5/M/vtqSED/T5cMu9J4Wf7HMGsB/4TEv/DFwe3Y/NPN57VXh+5BWApwFLlh +r661tV1eju/ne8YJrkWtES0tmRe2VOviv2j2aBp5nHihiRaz/A4oCnsAsje/+AAAAAElFTkSuQmCC" + } + +# $encoded(basn0g08), $encoded(basn2c08), $encoded(basn3p08), $encoded(basn6a08) +test imgPNG-1.1 {reading basic images; grayscale} -setup { + catch {rename foo ""} +} -body { + image create photo foo -data $encoded(basn0g08) + list [image width foo] [image height foo] +} -cleanup { + rename foo "" +} -result {32 32} +test imgPNG-1.2 {reading basic images; color} -setup { + catch {rename foo ""} +} -body { + image create photo foo -data $encoded(basn2c08) + list [image width foo] [image height foo] +} -cleanup { + rename foo "" +} -result {32 32} +test imgPNG-1.3 {reading basic images; color with palette} -setup { + catch {rename foo ""} +} -body { + image create photo foo -data $encoded(basn3p08) + list [image width foo] [image height foo] +} -cleanup { + rename foo "" +} -result {32 32} +test imgPNG-1.4 {reading basic images; alpha} -setup { + catch {rename foo ""} +} -body { + image create photo foo -data $encoded(basn6a08) + list [image width foo] [image height foo] +} -cleanup { + rename foo "" +} -result {32 32} + +test imgPNG-2.1 {reading a bad image} -body { + image create photo -data $encoded(BadX) +} -returnCodes error -result {unfinalized data stream in PNG data} +test imgPNG-2.2 {reading a good image with multiple IDATs} -setup { + set i [image create photo] +} -body { + $i put $encoded(MultiIDAT) + return [image width $i]x[image height $i] +} -cleanup { + image delete $i +} -result 223x212 + +} +namespace delete png +imageFinish +cleanupTests +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/imgPPM.test b/tests/imgPPM.test index 8dec8c2..e3a738a 100644 --- a/tests/imgPPM.test +++ b/tests/imgPPM.test @@ -6,11 +6,12 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -eval image delete [image names] +imageInit # Note that we do not use [tcltest::makeFile] because it is # only suitable for text files @@ -21,141 +22,145 @@ proc put {file data} { close $f } -test imgPPM-1.1 {FileReadPPM procedure} { +test imgPPM-1.1 {FileReadPPM procedure} -body { put test.ppm "P6\n0 256\n255\nabcdef" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {PPM image file "test.ppm" has dimension(s) <= 0}} -test imgPPM-1.2 {FileReadPPM procedure} { + image create photo p1 -file test.ppm +} -returnCodes error -result {PPM image file "test.ppm" has dimension(s) <= 0} +test imgPPM-1.2 {FileReadPPM procedure} -body { put test.ppm "P6\n-2 256\n255\nabcdef" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {PPM image file "test.ppm" has dimension(s) <= 0}} -test imgPPM-1.3 {FileReadPPM procedure} { + image create photo p1 -file test.ppm +} -returnCodes error -result {PPM image file "test.ppm" has dimension(s) <= 0} +test imgPPM-1.3 {FileReadPPM procedure} -body { put test.ppm "P6\n10 0\n255\nabcdef" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {PPM image file "test.ppm" has dimension(s) <= 0}} -test imgPPM-1.4 {FileReadPPM procedure} { + image create photo p1 -file test.ppm +} -returnCodes error -result {PPM image file "test.ppm" has dimension(s) <= 0} +test imgPPM-1.4 {FileReadPPM procedure} -body { put test.ppm "P6\n10 -2\n255\nabcdef" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {PPM image file "test.ppm" has dimension(s) <= 0}} -test imgPPM-1.5 {FileReadPPM procedure} { + image create photo p1 -file test.ppm +} -returnCodes error -result {PPM image file "test.ppm" has dimension(s) <= 0} +test imgPPM-1.5 {FileReadPPM procedure} -body { put test.ppm "P6\n10 20\n100000\nabcdef" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {PPM image file "test.ppm" has bad maximum intensity value 100000}} -test imgPPM-1.6 {FileReadPPM procedure} { + image create photo p1 -file test.ppm +} -returnCodes error -result {PPM image file "test.ppm" has bad maximum intensity value 100000} +test imgPPM-1.6 {FileReadPPM procedure} -body { put test.ppm "P6\n10 20\n0\nabcdef" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {PPM image file "test.ppm" has bad maximum intensity value 0}} -test imgPPM-1.7 {FileReadPPM procedure} { + image create photo p1 -file test.ppm +} -returnCodes error -result {PPM image file "test.ppm" has bad maximum intensity value 0} +test imgPPM-1.7 {FileReadPPM procedure} -body { put test.ppm "P6\n10 10\n255\nabcdef" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {error reading PPM image file "test.ppm": not enough data}} -test imgPPM-1.8 {FileReadPPM procedure} { + image create photo p1 -file test.ppm +} -returnCodes error -result {error reading PPM image file "test.ppm": not enough data} +test imgPPM-1.8 {FileReadPPM procedure} -body { put test.ppm "P6\n5 4\n255\n01234567890123456789012345678901234567890123456789012345678" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {error reading PPM image file "test.ppm": not enough data}} -test imgPPM-1.9 {FileReadPPM procedure} { + image create photo p1 -file test.ppm +} -returnCodes error -result {error reading PPM image file "test.ppm": not enough data} +test imgPPM-1.9 {FileReadPPM procedure} -body { put test.ppm "P6\n5 4\n150\n012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg \ - [image width p1] [image height p1] -} {0 p1 5 4} + list [image create photo p1 -file test.ppm] \ + [image width p1] [image height p1] +} -returnCodes ok -result {p1 5 4} -catch {image delete p1} -put test.ppm "P6\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" -image create photo p1 -file test.ppm -test imgPPM-2.1 {FileWritePPM procedure} { + +test imgPPM-2.1 {FileWritePPM procedure} -setup { + catch {image delete p1} +} -body { + put test.ppm "P6\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" + image create photo p1 -file test.ppm list [catch {p1 write not_a_dir/bar/baz/gorp} msg] [string tolower $msg] \ - [string tolower $errorCode] -} {1 {couldn't open "not_a_dir/bar/baz/gorp": no such file or directory} {posix enoent {no such file or directory}}} -test imgPPM-2.2 {FileWritePPM procedure} { + [string tolower $errorCode] +} -cleanup { + image delete p1 +} -result {1 {couldn't open "not_a_dir/bar/baz/gorp": no such file or directory} {posix enoent {no such file or directory}}} + +test imgPPM-2.2 {FileWritePPM procedure} -setup { + catch {image delete p1} catch {unset data} +} -body { + put test.ppm "P6\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" + image create photo p1 -file test.ppm p1 write -format ppm test.ppm set fd [open test.ppm] set data [read $fd] close $fd set data -} {P6 +} -cleanup { + image delete p1 +} -result {P6 5 4 255 012345678901234567890123456789012345678901234567890123456789} -test imgPPM-3.1 {ReadPPMFileHeader procedure} { - catch {image delete p1} + +test imgPPM-3.1 {ReadPPMFileHeader procedure} -body { put test.ppm "# \n#\n#\nP6\n#\n##\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {0 p1} -test imgPPM-3.2 {ReadPPMFileHeader procedure} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -cleanup { + image delete p1 +} -returnCodes ok -result p1 +test imgPPM-3.2 {ReadPPMFileHeader procedure} -body { put test.ppm "P6\n5\n 4 255\n012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {0 p1} -test imgPPM-3.3 {ReadPPMFileHeader procedure} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -cleanup { + image delete p1 +} -returnCodes ok -result p1 +test imgPPM-3.3 {ReadPPMFileHeader procedure} -body { put test.ppm "P6\n# asdfasdf\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {0 p1} -test imgPPM-3.4 {ReadPPMFileHeader procedure} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -cleanup { + image delete p1 +} -returnCodes ok -result p1 +test imgPPM-3.4 {ReadPPMFileHeader procedure} -body { put test.ppm "P6 \n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {0 p1} -test imgPPM-3.5 {ReadPPMFileHeader procedure} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -cleanup { + image delete p1 +} -returnCodes ok -result p1 +test imgPPM-3.5 {ReadPPMFileHeader procedure} -body { put test.ppm "P5\n5 4\n255\n01234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {0 p1} -test imgPPM-3.6 {ReadPPMFileHeader procedure} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -cleanup { + image delete p1 +} -returnCodes ok -result p1 +test imgPPM-3.6 {ReadPPMFileHeader procedure} -body { put test.ppm "P3\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {couldn't recognize data in image file "test.ppm"}} -test imgPPM-3.7 {ReadPPMFileHeader procedure} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -returnCodes error -result {couldn't recognize data in image file "test.ppm"} +test imgPPM-3.7 {ReadPPMFileHeader procedure} -body { put test.ppm "P6x\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {couldn't recognize data in image file "test.ppm"}} -test imgPPM-3.8 {ReadPPMFileHeader procedure} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -returnCodes error -result {couldn't recognize data in image file "test.ppm"} +test imgPPM-3.8 {ReadPPMFileHeader procedure} -body { put test.ppm "P6\nxy5 4\n255\n012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {couldn't recognize data in image file "test.ppm"}} -test imgPPM-3.9 {ReadPPMFileHeader procedure} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -returnCodes error -result {couldn't recognize data in image file "test.ppm"} +test imgPPM-3.9 {ReadPPMFileHeader procedure} -body { put test.ppm "P6\n5\n255\n!012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {couldn't recognize data in image file "test.ppm"}} -test imgPPM-3.10 {ReadPPMFileHeader procedure} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -returnCodes error -result {couldn't recognize data in image file "test.ppm"} +test imgPPM-3.10 {ReadPPMFileHeader procedure} -body { put test.ppm "P6\n5 4\nzz255\n012345678901234567890123456789012345678901234567890123456789" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {couldn't recognize data in image file "test.ppm"}} -test imgPPM-3.11 {ReadPPMFileHeader procedure, empty file} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -returnCodes error -result {couldn't recognize data in image file "test.ppm"} +test imgPPM-3.11 {ReadPPMFileHeader procedure, empty file} -body { put test.ppm " " - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {couldn't recognize data in image file "test.ppm"}} -test imgPPM-3.12 {ReadPPMFileHeader procedure, file ends too soon} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -returnCodes error -result {couldn't recognize data in image file "test.ppm"} +test imgPPM-3.12 {ReadPPMFileHeader procedure, file ends too soon} -body { put test.ppm "P6\n566" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {couldn't recognize data in image file "test.ppm"}} -test imgPPM-3.13 {ReadPPMFileHeader procedure, file ends too soon} { - catch {image delete p1} + image create photo p1 -file test.ppm +} -returnCodes error -result {couldn't recognize data in image file "test.ppm"} +test imgPPM-3.13 {ReadPPMFileHeader procedure, file ends too soon} -body { put test.ppm "P6\n566\n#asdf" - list [catch {image create photo p1 -file test.ppm} msg] $msg -} {1 {couldn't recognize data in image file "test.ppm"}} + image create photo p1 -file test.ppm +} -returnCodes error -result {couldn't recognize data in image file "test.ppm"} + -test imgPPM-4.1 {StringReadPPM procedure, data too short [Bug 1822391]} \ - -setup { - image create photo I -width 1103 -height 997 - } \ - -cleanup { - image delete I - } \ - -body { - I put "P5\n1103 997\n255\n" - } \ - -returnCodes error \ - -result {truncated PPM data} +test imgPPM-4.1 {StringReadPPM procedure, data too short [Bug 1822391]} -body { + image create photo I -width 1103 -height 997 + I put "P5\n1103 997\n255\n" +} -cleanup { + image delete I +} -returnCodes error -result {truncated PPM data} test imgPPM-5.1 {StringReadPPM procedure} -setup { image create photo ppm @@ -222,7 +227,7 @@ test imgPPM-5.9 {StringReadPPM procedure} -setup { image delete ppm } -result {5 4} -eval image delete [image names] +imageFinish # cleanup catch {file delete test.ppm} diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test index d4118b0..e85f512 100644 --- a/tests/imgPhoto.test +++ b/tests/imgPhoto.test @@ -1,486 +1,867 @@ -# This file is a Tcl script to test out the "photo" image type and the -# other procedures in the file tkImgPhoto.c. It is organized in the -# standard fashion for Tcl tests. +# This file is a Tcl script to test out the "photo" image type and the other +# procedures in the file tkImgPhoto.c. It is organized in the standard fashion +# for Tcl tests. # # Copyright (c) 1994 The Australian National University # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2002-2008 Donal K. Fellows # All rights reserved. # # Author: Paul Mackerras (paulus@cs.anu.edu.au) -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands -eval image delete [image names] - -canvas .c -pack .c -update +# Used for 4.65 - 4.73 tests +# Now for some heftier testing, checking that setting and resetting of pixels' +# transparency status doesn't "leak" with any one-off errors. +proc foreachPixel {img xVar yVar script} { + upvar 1 $xVar x $yVar y + set width [image width $img] + set height [image height $img] + for {set x 0} {$x<$width} {incr x} { + for {set y 0} {$y<$height} {incr y} { + uplevel 1 $script + } + } +} +proc checkImgTrans {img} { + set result {} + foreachPixel $img x y { + if {[$img transparency get $x $y]} { + lappend result $x,$y + } + } + return $result +} +proc checkImgTransLoop {img script1 script2} { + set result {} + foreachPixel $img x y { + eval $script1 + lappend result {*}[checkImgTrans $img] + append result : + eval $script2 + lappend result {*}[checkImgTrans $img] + append result . + } + return $result +} +imageInit set README [makeFile { -README -- Tk test suite design document. + README -- Tk test suite design document. } README-imgPhoto] # find the teapot.ppm file for use in these tests set teapotPhotoFile [file join [file dirname [info script]] teapot.ppm] testConstraint hasTeapotPhoto [file exists $teapotPhotoFile] -test imgPhoto-1.1 {options for photo images} { - image create photo p1 -width 79 -height 83 - list [lindex [p1 configure -width] 4] [lindex [p1 configure -height] 4] \ - [image width p1] [image height p1] -} {79 83 79 83} -test imgPhoto-1.2 {options for photo images} { - list [catch {image create photo p1 -file no.such.file} err] \ +# ---------------------------------------------------------------------- + +test imgPhoto-1.1 {options for photo images} -body { + image create photo photo1 -width 79 -height 83 + list [photo1 cget -width] [photo1 cget -height] \ + [image width photo1] [image height photo1] +} -cleanup { + image delete photo1 +} -result {79 83 79 83} +test imgPhoto-1.2 {options for photo images} -body { + list [catch {image create photo photo1 -file no.such.file} err] \ [string tolower $err] -} {1 {couldn't open "no.such.file": no such file or directory}} -test imgPhoto-1.3 {options for photo images} hasTeapotPhoto { - list [catch {image create photo p1 -file $teapotPhotoFile \ - -format no.such.format} err] $err -} {1 {image file format "no.such.format" is not supported}} -test imgPhoto-1.4 {options for photo images} hasTeapotPhoto { - image create photo p1 -file $teapotPhotoFile - list [image width p1] [image height p1] -} {256 256} -test imgPhoto-1.5 {options for photo images} hasTeapotPhoto { - image create photo p1 -file $teapotPhotoFile \ - -format ppm -width 79 -height 83 - list [image width p1] [image height p1] \ - [lindex [p1 configure -file] 4] [lindex [p1 configure -format] 4] -} [list 79 83 $teapotPhotoFile ppm] -test imgPhoto-1.6 {options for photo images} { - image create photo p1 -palette 2/2/2 -gamma 2.2 - list [format %.1f [lindex [p1 configure -gamma] 4]] \ - [lindex [p1 configure -palette] 4] -} {2.2 2/2/2} -test imgPhoto-1.7 {options for photo images} { - list [catch {image create photo p1 -file $README} err] $err -} [subst {1 {couldn't recognize data in image file "$README"}}] -test imgPhoto-1.8 {options for photo images} { - list [catch {image create photo -blah blah} err] $err -} {1 {unknown option "-blah"}} -test imgPhoto-1.9 {options for photo images - error case} { - list [catch {image create photo -format} err] $err -} {1 {value for "-format" missing}} -test imgPhoto-1.10 {options for photo images - error case} { - list [catch {image create photo -data} err] $err -} {1 {value for "-data" missing}} -test imgPhoto-1.11 {options for photo images - error case} { - list [catch {image create photo p1 -format} err] $err -} {1 {value for "-format" missing}} +} -result {1 {couldn't open "no.such.file": no such file or directory}} +test imgPhoto-1.3 {options for photo images} -constraints hasTeapotPhoto -body { + image create photo photo1 -file $teapotPhotoFile -format no.such.format +} -returnCodes error -result {image file format "no.such.format" is not supported} +test imgPhoto-1.4 {options for photo images} -constraints hasTeapotPhoto -body { + image create photo photo1 -file $teapotPhotoFile + list [image width photo1] [image height photo1] +} -cleanup { + image delete photo1 +} -result {256 256} +test imgPhoto-1.5 {options for photo images} -constraints hasTeapotPhoto -body { + image create photo photo1 -file $teapotPhotoFile \ + -format ppm -width 79 -height 83 + list [image width photo1] [image height photo1] [photo1 cget -file] [photo1 cget -format] +} -cleanup { + image delete photo1 +} -result [list 79 83 $teapotPhotoFile ppm] +test imgPhoto-1.6 {options for photo images} -body { + image create photo photo1 -palette 2/2/2 -gamma 2.2 + list [format %.1f [photo1 cget -gamma]] [photo1 cget -palette] +} -cleanup { + image delete photo1 +} -result {2.2 2/2/2} +test imgPhoto-1.7 {options for photo images} -returnCodes error -body { + image create photo photo1 -file $README +} -result [subst {couldn't recognize data in image file "$README"}] +test imgPhoto-1.8 {options for photo images} -body { + image create photo -blah blah +} -returnCodes error -result {unknown option "-blah"} +test imgPhoto-1.9 {options for photo images - error case} -body { + image create photo -format +} -returnCodes error -result {value for "-format" missing} +test imgPhoto-1.10 {options for photo images - error case} -body { + image create photo -data +} -returnCodes error -result {value for "-data" missing} +test imgPhoto-1.11 {options for photo images - error case} -body { + image create photo photo1 -format +} -returnCodes error -result {value for "-format" missing} -test imgPhoto-2.1 {ImgPhotoCreate procedure} { - eval image delete [image names] +test imgPhoto-2.1 {ImgPhotoCreate procedure} -setup { + imageCleanup +} -body { catch {image create photo -blah blah} - image names -} {} -test imgPhoto-2.2 {ImgPhotoCreate procedure} { - eval image delete [image names] + imageNames +} -result {} +test imgPhoto-2.2 {ImgPhotoCreate procedure} -setup { + imageCleanup +} -body { image create photo image1 - list [info commands image1] [image names] \ - [image width image1] [image height image1] -} {image1 image1 0 0} + list [info commands image1] [imageNames] \ + [image width image1] [image height image1] +} -cleanup { + image delete image1 +} -result {image1 image1 0 0} # test imgPhoto-2.3 {ImgPhotoCreate procedure: creation failure} { -# image create photo p1 -# image create photo p2 -width 10 -height 10 -# catch {image create photo p2 -file bogus.img} msg -# p1 copy p2 +# image create photo photo1 +# image create photo photo2 -width 10 -height 10 +# catch {image create photo photo2 -file bogus.img} msg +# photo1 copy photo2 # set msg # } {couldn't open "bogus.img": no such file or directory} -test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} hasTeapotPhoto { - image create photo p1 -file $teapotPhotoFile - p1 configure -file $teapotPhotoFile -} {} -test imgPhoto-3.2 {ImgPhotoConfigureMaster procedure} hasTeapotPhoto { - image create photo p1 -file $teapotPhotoFile - list [catch {p1 configure -file bogus} err] [string tolower $err] \ - [image width p1] [image height p1] -} {1 {couldn't open "bogus": no such file or directory} 256 256} -test imgPhoto-3.3 {ImgPhotoConfigureMaster procedure} hasTeapotPhoto { - image create photo p1 - .c create image 10 10 -image p1 -tags p1.1 -anchor nw - .c create image 300 10 -image p1 -tags p1.2 -anchor nw +test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} -constraints { + hasTeapotPhoto +} -body { + image create photo photo1 -file $teapotPhotoFile + photo1 configure -file $teapotPhotoFile +} -cleanup { + image delete photo1 +} -result {} +test imgPhoto-3.2 {ImgPhotoConfigureMaster procedure} -constraints { + hasTeapotPhoto +} -body { + image create photo photo1 -file $teapotPhotoFile + list [catch {photo1 configure -file bogus} err] [string tolower $err] \ + [image width photo1] [image height photo1] +} -cleanup { + image delete photo1 +} -result {1 {couldn't open "bogus": no such file or directory} 256 256} +test imgPhoto-3.3 {ImgPhotoConfigureMaster procedure} -constraints { + hasTeapotPhoto +} -setup { + destroy .c + pack [canvas .c] update - p1 configure -file $teapotPhotoFile +} -body { + image create photo photo1 + .c create image 10 10 -image photo1 -tags photo1.1 -anchor nw + .c create image 300 10 -image photo1 -tags photo1.2 -anchor nw update - list [image width p1] [image height p1] [.c bbox p1.1] [.c bbox p1.2] -} {256 256 {10 10 266 266} {300 10 556 266}} - -eval image delete [image names] -image create photo p1 -.c create image 10 10 -image p1 -update + photo1 configure -file $teapotPhotoFile + update + list [image width photo1] [image height photo1] [.c bbox photo1.1] [.c bbox photo1.2] +} -cleanup { + destroy .c + image delete photo1 +} -result {256 256 {10 10 266 266} {300 10 556 266}} -test imgPhoto-4.1 {ImgPhotoCmd procedure} { - list [catch {p1} err] $err -} {1 {wrong # args: should be "p1 option ?arg arg ...?"}} -test imgPhoto-4.2 {ImgPhotoCmd procedure} { - list [catch {p1 blah} err] $err -} {1 {bad option "blah": must be blank, cget, configure, copy, data, get, put, read, redither, transparency, or write}} -test imgPhoto-4.3 {ImgPhotoCmd procedure: blank option} { - p1 blank - list [catch {p1 blank x} err] $err -} {1 {wrong # args: should be "p1 blank"}} -test imgPhoto-4.4 {ImgPhotoCmd procedure: cget option} { - list [catch {p1 cget} msg] $msg -} {1 {wrong # args: should be "p1 cget option"}} -test imgPhoto-4.5 {ImgPhotoCmd procedure: cget option} { - image create photo p2 -width 25 -height 30 - list [p2 cget -width] [p2 cget -height] -} {25 30} -test imgPhoto-4.6 {ImgPhotoCmd procedure: configure option} { - llength [p1 configure] -} {7} -test imgPhoto-4.7 {ImgPhotoCmd procedure: configure option} { - p1 conf -palette 3/4/2 - p1 configure -palette -} {-palette {} {} {} 3/4/2} -test imgPhoto-4.8 {ImgPhotoCmd procedure: configure option} { - list [catch {p1 configure -blah} msg] $msg -} {1 {unknown option "-blah"}} -test imgPhoto-4.9 {ImgPhotoCmd procedure: configure option} { - list [catch {p1 configure -palette {} -gamma} msg] $msg -} {1 {value for "-gamma" missing}} -test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} hasTeapotPhoto { - image create photo p2 -file $teapotPhotoFile - p1 configure -width 0 -height 0 -palette {} -gamma 1 - p1 copy p2 - list [image width p1] [image height p1] [p1 get 100 100] -} {256 256 {169 117 90}} -test imgPhoto-4.11 {ImgPhotoCmd procedure: copy option} { - list [catch {p1 copy} msg] $msg -} {1 {wrong # args: should be "p1 copy source-image ?-compositingrule rule? ?-from x1 y1 x2 y2? ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?"}} -test imgPhoto-4.12 {ImgPhotoCmd procedure: copy option} { - list [catch {p1 copy blah} msg] $msg -} {1 {image "blah" doesn't exist or is not a photo image}} -test imgPhoto-4.13 {ImgPhotoCmd procedure: copy option} { - list [catch {p1 copy p2 -blah} msg] $msg -} {1 {unrecognized option "-blah": must be -compositingrule, -from, -shrink, -subsample, -to, or -zoom}} -test imgPhoto-4.14 {ImgPhotoCmd procedure: copy option} { - list [catch {p1 copy p2 -from -to} msg] $msg -} {1 {the "-from" option requires one to four integer values}} -test imgPhoto-4.15 {ImgPhotoCmd procedure: copy option} { - p1 copy p2 - p1 copy p2 -from 0 70 60 120 -shrink - list [image width p1] [image height p1] [p1 get 20 10] -} {60 50 {215 154 120}} -test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} { - p1 copy p2 -from 60 120 0 70 -to 20 50 - list [image width p1] [image height p1] [p1 get 40 80] -} {80 100 {19 92 192}} -test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} { - p1 copy p2 -from 0 120 60 70 -to 0 0 100 100 - list [image width p1] [image height p1] [p1 get 80 60] -} {100 100 {215 154 120}} -test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} { - p1 copy p2 -from 60 70 0 120 -zoom 2 - list [image width p1] [image height p1] [p1 get 100 50] -} {120 100 {169 99 47}} -test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} { - p1 copy p2 -from 0 70 60 120 - list [image width p1] [image height p1] [p1 get 100 50] -} {120 100 {169 99 47}} -test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} { - p1 copy p2 -from 20 20 200 180 -subsample 2 -shrink - list [image width p1] [image height p1] [p1 get 50 30] -} {90 80 {207 146 112}} -test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} { - p1 copy p2 - set result [list [image width p1] [image height p1]] - p1 conf -width 49 -height 51 - lappend result [image width p1] [image height p1] - p1 copy p2 - lappend result [image width p1] [image height p1] - p1 copy p2 -from 0 0 10 10 -shrink - lappend result [image width p1] [image height p1] - p1 conf -width 0 - p1 copy p2 -from 0 0 10 10 -shrink - lappend result [image width p1] [image height p1] - p1 conf -height 0 - p1 copy p2 -from 0 0 10 10 -shrink - lappend result [image width p1] [image height p1] -} {256 256 49 51 49 51 49 51 10 51 10 10} -test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} hasTeapotPhoto { - p1 read $teapotPhotoFile - list [p1 get 100 100] [p1 get 150 100] [p1 get 100 150] -} {{169 117 90} {172 115 84} {35 35 35}} -test imgPhoto-4.23 {ImgPhotoCmd procedure: get option} { - list [catch {p1 get 256 0} err] $err -} {1 {p1 get: coordinates out of range}} -test imgPhoto-4.24 {ImgPhotoCmd procedure: get option} { - list [catch {p1 get 0 -1} err] $err -} {1 {p1 get: coordinates out of range}} -test imgPhoto-4.25 {ImgPhotoCmd procedure: get option} { - list [catch {p1 get} err] $err -} {1 {wrong # args: should be "p1 get x y"}} -test imgPhoto-4.26 {ImgPhotoCmd procedure: put option} { - list [catch {p1 put} err] $err -} {1 {wrong # args: should be "p1 put data ?options?"}} -test imgPhoto-4.27 {ImgPhotoCmd procedure: put option} { - list [catch {p1 put {{white} {white white}}} err] $err -} {1 {all elements of color list must have the same number of elements}} -test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} { - list [catch {p1 put {{blahgle}}} err] $err -} {1 {can't parse color "blahgle"}} -test imgPhoto-4.29 {ImgPhotoCmd procedure: put option} { - p1 put -to 10 10 20 20 {{white}} - p1 get 19 19 -} {255 255 255} -test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} { - list [catch {p1 read} err] $err -} {1 {wrong # args: should be "p1 read fileName ?options?"}} -test imgPhoto-4.31 {ImgPhotoCmd procedure: read option} hasTeapotPhoto { - list [catch {p1 read $teapotPhotoFile -zoom 2} err] $err -} {1 {unrecognized option "-zoom": must be -format, -from, -shrink, or -to}} -test imgPhoto-4.32 {ImgPhotoCmd procedure: read option} { - list [catch {p1 read bogus} err] [string tolower $err] -} {1 {couldn't open "bogus": no such file or directory}} -test imgPhoto-4.33 {ImgPhotoCmd procedure: read option} hasTeapotPhoto { - list [catch {p1 read $teapotPhotoFile -format bogus} err] $err -} {1 {image file format "bogus" is not supported}} -test imgPhoto-4.34 {ImgPhotoCmd procedure: read option} { - list [catch {p1 read $README} err] $err -} [subst {1 {couldn't recognize data in image file "$README"}}] -test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} hasTeapotPhoto { - p1 read $teapotPhotoFile - list [image width p1] [image height p1] [p1 get 120 120] -} {256 256 {161 109 82}} -test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} hasTeapotPhoto { - p1 read $teapotPhotoFile -from 0 70 60 120 -to 10 10 -shrink - list [image width p1] [image height p1] [p1 get 29 19] -} {70 60 {244 180 144}} -test imgPhoto-4.37 {ImgPhotoCmd procedure: redither option} { - p1 redither - list [catch {p1 redither x} err] $err -} {1 {wrong # args: should be "p1 redither"}} -test imgPhoto-4.38 {ImgPhotoCmd procedure: write option} { - list [catch {p1 write} err] $err -} {1 {wrong # args: should be "p1 write fileName ?options?"}} -test imgPhoto-4.39 {ImgPhotoCmd procedure: write option} { - list [catch {p1 write teapot.tmp -format bogus} err] $err -} {1 {image file format "bogus" is unknown}} -eval image delete [image names] -image create photo p1 -test imgPhoto-4.40 {ImgPhotoCmd procedure: transparency option} { - list [catch {p1 transparency} err] $err -} {1 {wrong # args: should be "p1 transparency option ?arg arg ...?"}} -test imgPhoto-4.41 {ImgPhotoCmd procedure: transparency get option} { - list [catch {p1 transparency get} err] $err -} {1 {wrong # args: should be "p1 transparency get x y"}} -test imgPhoto-4.42 {ImgPhotoCmd procedure: transparency get option} { - list [catch {p1 transparency get 0} err] $err -} {1 {wrong # args: should be "p1 transparency get x y"}} -test imgPhoto-4.43 {ImgPhotoCmd procedure: transparency get option} { - list [catch {p1 transparency get 0 0 0} err] $err -} {1 {wrong # args: should be "p1 transparency get x y"}} -test imgPhoto-4.44 {ImgPhotoCmd procedure: transparency get option} { - list [catch {p1 transparency get bogus 0} err] $err -} {1 {expected integer but got "bogus"}} -test imgPhoto-4.45 {ImgPhotoCmd procedure: transparency get option} { - list [catch {p1 transparency get 0 bogus} err] $err -} {1 {expected integer but got "bogus"}} -test imgPhoto-4.46 {ImgPhotoCmd procedure: transparency get option} { - p1 put white - p1 transparency get 0 0 -} 0 -test imgPhoto-4.47 {ImgPhotoCmd procedure: transparency get option} { - list [catch {p1 transparency get 1 0} err] $err -} {1 {p1 transparency get: coordinates out of range}} -test imgPhoto-4.48 {ImgPhotoCmd procedure: transparency get option} { - list [catch {p1 transparency get -1 0} err] $err -} {1 {p1 transparency get: coordinates out of range}} -test imgPhoto-4.49 {ImgPhotoCmd procedure: transparency get option} { - list [catch {p1 transparency get 0 1} err] $err -} {1 {p1 transparency get: coordinates out of range}} -test imgPhoto-4.50 {ImgPhotoCmd procedure: transparency get option} { - list [catch {p1 transparency get 0 -1} err] $err -} {1 {p1 transparency get: coordinates out of range}} -test imgPhoto-4.51 {ImgPhotoCmd procedure: transparency get option} { - p1 blank - p1 transparency get 0 0 -} 1 -test imgPhoto-4.52 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set} err] $err -} {1 {wrong # args: should be "p1 transparency set x y boolean"}} -test imgPhoto-4.53 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set 0} err] $err -} {1 {wrong # args: should be "p1 transparency set x y boolean"}} -test imgPhoto-4.54 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set 0 0} err] $err -} {1 {wrong # args: should be "p1 transparency set x y boolean"}} -test imgPhoto-4.55 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set 0 0 0 0} err] $err -} {1 {wrong # args: should be "p1 transparency set x y boolean"}} -test imgPhoto-4.56 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set bogus 0 0} err] $err -} {1 {expected integer but got "bogus"}} -test imgPhoto-4.57 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set 0 bogus 0} err] $err -} {1 {expected integer but got "bogus"}} -test imgPhoto-4.58 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set 0 0 bogus} err] $err -} {1 {expected boolean value but got "bogus"}} -test imgPhoto-4.59 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set 1 0 0} err] $err -} {1 {p1 transparency set: coordinates out of range}} -test imgPhoto-4.60 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set -1 0 0} err] $err -} {1 {p1 transparency set: coordinates out of range}} -test imgPhoto-4.61 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set 0 1 0} err] $err -} {1 {p1 transparency set: coordinates out of range}} -test imgPhoto-4.62 {ImgPhotoCmd procedure: transparency set option} { - list [catch {p1 transparency set 0 -1 0} err] $err -} {1 {p1 transparency set: coordinates out of range}} -test imgPhoto-4.63 {ImgPhotoCmd procedure: transparency set option} { - p1 transparency set 0 0 false - p1 transparency get 0 0 -} 0 -test imgPhoto-4.64 {ImgPhotoCmd procedure: transparency set option} { - p1 transparency set 0 0 true - p1 transparency get 0 0 -} 1 -# Now for some heftier testing, checking that setting and resetting of -# pixels' transparency status doesn't "leak" with any one-off errors. -proc checkImgTrans {img width height} { - set result {} - for {set x 0} {$x<$width} {incr x} { - for {set y 0} {$y<$height} {incr y} { - if {[$img transparency get $x $y]} { - lappend result $x $y - } - } - } - return $result -} -test imgPhoto-4.65 {ImgPhotoCmd procedure: transparency get option} { - p1 put white -to 0 0 3 3 - checkImgTrans p1 3 3 -} {} -test imgPhoto-4.66 {ImgPhotoCmd procedure: transparency get option} { - p1 blank - checkImgTrans p1 3 3 -} {0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2} -proc checkImgTransLoopSetReset {img width height} { - set result {} - for {set x 0} {$x<$width} {incr x} { - for {set y 0} {$y<$height} {incr y} { - $img put white -to 0 0 3 3 - $img transparency set $x $y 1 - set result [concat $result [checkImgTrans $img $width $height]] - lappend result , - $img transparency set $x $y 0 - set result [concat $result [checkImgTrans $img $width $height]] - lappend result . - } +test imgPhoto-4.1 {ImgPhotoCmd procedure} -setup { + image create photo photo1 +} -body { + photo1 +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 option ?arg ...?"} +test imgPhoto-4.2 {ImgPhotoCmd procedure} -setup { + image create photo photo1 +} -body { + photo1 blah +} -returnCodes error -cleanup { + image delete photo1 +} -match glob -result {bad option "blah": must be *} +test imgPhoto-4.3 {ImgPhotoCmd procedure: blank option} -setup { + image create photo photo1 +} -body { + photo1 blank + photo1 blank x +} -cleanup { + image delete photo1 +} -returnCodes error -result {wrong # args: should be "photo1 blank"} +test imgPhoto-4.4 {ImgPhotoCmd procedure: cget option} -setup { + image create photo photo1 +} -body { + photo1 cget +} -cleanup { + image delete photo1 +} -returnCodes error -result {wrong # args: should be "photo1 cget option"} +test imgPhoto-4.5 {ImgPhotoCmd procedure: cget option} -setup { + image create photo photo2 -width 25 -height 30 +} -body { + list [photo2 cget -width] [photo2 cget -height] +} -cleanup { + image delete photo2 +} -result {25 30} +test imgPhoto-4.6 {ImgPhotoCmd procedure: configure option} -setup { + image create photo photo1 +} -body { + llength [photo1 configure] +} -cleanup { + image delete photo1 +} -result 7 +test imgPhoto-4.7 {ImgPhotoCmd procedure: configure option} -setup { + image create photo photo1 +} -body { + photo1 conf -palette 3/4/2 + photo1 configure -palette +} -cleanup { + image delete photo1 +} -result {-palette {} {} {} 3/4/2} +test imgPhoto-4.8 {ImgPhotoCmd procedure: configure option} -setup { + image create photo photo1 +} -body { + photo1 configure -blah +} -cleanup { + image delete photo1 +} -returnCodes error -result {unknown option "-blah"} +test imgPhoto-4.9 {ImgPhotoCmd procedure: configure option} -setup { + image create photo photo1 +} -body { + photo1 configure -palette {} -gamma +} -cleanup { + image delete photo1 +} -returnCodes error -result {value for "-gamma" missing} +test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 + image create photo photo2 -width 25 -height 30 +} -body { + image create photo photo2 -file $teapotPhotoFile + photo1 configure -width 0 -height 0 -palette {} -gamma 1 + photo1 copy photo2 + list [image width photo1] [image height photo1] [photo1 get 100 100] +} -cleanup { + image delete photo1 photo2 +} -result {256 256 {169 117 90}} +test imgPhoto-4.11 {ImgPhotoCmd procedure: copy option} -setup { + image create photo photo1 +} -body { + photo1 copy +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 copy source-image ?-compositingrule rule? ?-from x1 y1 x2 y2? ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?"} +test imgPhoto-4.12 {ImgPhotoCmd procedure: copy option} -setup { + image create photo photo1 +} -body { + photo1 copy blah +} -returnCodes error -cleanup { + image delete photo1 +} -result {image "blah" doesn't exist or is not a photo image} +test imgPhoto-4.13 {ImgPhotoCmd procedure: copy option} -setup { + image create photo photo1 + image create photo photo2 +} -body { + photo1 copy photo2 -blah +} -returnCodes error -cleanup { + image delete photo1 photo2 +} -result {unrecognized option "-blah": must be -compositingrule, -from, -shrink, -subsample, -to, or -zoom} +test imgPhoto-4.14 {ImgPhotoCmd procedure: copy option} -setup { + image create photo photo1 + image create photo photo2 +} -body { + photo1 copy photo2 -from -to +} -returnCodes error -cleanup { + image delete photo1 photo2 +} -result {the "-from" option requires one to four integer values} +test imgPhoto-4.15 {ImgPhotoCmd procedure: copy option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 + image create photo photo2 -file $teapotPhotoFile +} -body { + photo1 copy photo2 + photo1 copy photo2 -from 0 70 60 120 -shrink + list [image width photo1] [image height photo1] [photo1 get 20 10] +} -cleanup { + image delete photo1 photo2 +} -result {60 50 {215 154 120}} +test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 + image create photo photo2 -file $teapotPhotoFile +} -body { + photo1 copy photo2 -from 60 120 0 70 -to 20 50 + list [image width photo1] [image height photo1] [photo1 get 40 80] +} -cleanup { + image delete photo1 photo2 +} -result {80 100 {19 92 192}} +test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 + image create photo photo2 -file $teapotPhotoFile +} -body { + photo1 copy photo2 -from 0 120 60 70 -to 0 0 100 100 + list [image width photo1] [image height photo1] [photo1 get 80 60] +} -cleanup { + image delete photo1 photo2 +} -result {100 100 {215 154 120}} +test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 + image create photo photo2 -file $teapotPhotoFile +} -body { + photo1 copy photo2 -from 60 70 0 120 -zoom 2 + list [image width photo1] [image height photo1] [photo1 get 100 50] +} -cleanup { + image delete photo1 photo2 +} -result {120 100 {169 99 47}} +test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 + image create photo photo2 -file $teapotPhotoFile +} -body { + photo1 copy photo2 -from 0 70 60 120 -zoom 2 + list [image width photo1] [image height photo1] [photo1 get 100 50] +} -cleanup { + image delete photo1 photo2 +} -result {120 100 {169 99 47}} +test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 + image create photo photo2 -file $teapotPhotoFile +} -body { + photo1 copy photo2 -from 20 20 200 180 -subsample 2 -shrink + list [image width photo1] [image height photo1] [photo1 get 50 30] +} -cleanup { + image delete photo1 photo2 +} -result {90 80 {207 146 112}} +test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 + image create photo photo2 -file $teapotPhotoFile +} -body { + photo1 copy photo2 + set result [list [image width photo1] [image height photo1]] + photo1 conf -width 49 -height 51 + lappend result [image width photo1] [image height photo1] + photo1 copy photo2 + lappend result [image width photo1] [image height photo1] + photo1 copy photo2 -from 0 0 10 10 -shrink + lappend result [image width photo1] [image height photo1] + photo1 conf -width 0 + photo1 copy photo2 -from 0 0 10 10 -shrink + lappend result [image width photo1] [image height photo1] + photo1 conf -height 0 + photo1 copy photo2 -from 0 0 10 10 -shrink + lappend result [image width photo1] [image height photo1] +} -cleanup { + image delete photo1 photo2 +} -result {256 256 49 51 49 51 49 51 10 51 10 10} +test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 +} -body { + photo1 read $teapotPhotoFile + list [photo1 get 100 100] [photo1 get 150 100] [photo1 get 100 150] +} -cleanup { + image delete photo1 +} -result {{169 117 90} {172 115 84} {35 35 35}} +test imgPhoto-4.23 {ImgPhotoCmd procedure: get option} -setup { + image create photo photo1 +} -body { + photo1 get 256 0 +} -cleanup { + image delete photo1 +} -returnCodes error -result {photo1 get: coordinates out of range} +test imgPhoto-4.24 {ImgPhotoCmd procedure: get option} -setup { + image create photo photo1 +} -body { + photo1 get 0 -1 +} -cleanup { + image delete photo1 +} -returnCodes error -result {photo1 get: coordinates out of range} +test imgPhoto-4.25 {ImgPhotoCmd procedure: get option} -setup { + image create photo photo1 +} -body { + photo1 get +} -cleanup { + image delete photo1 +} -returnCodes error -result {wrong # args: should be "photo1 get x y"} +test imgPhoto-4.26 {ImgPhotoCmd procedure: put option} -setup { + image create photo photo1 +} -body { + photo1 put +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 put data ?-option value ...?"} +test imgPhoto-4.27 {ImgPhotoCmd procedure: put option} -setup { + image create photo photo1 +} -body { + photo1 put {{white} {white white}} +} -returnCodes error -cleanup { + image delete photo1 +} -result {all elements of color list must have the same number of elements} +test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} -setup { + image create photo photo1 +} -body { + photo1 put {{blahgle}} +} -cleanup { + image delete photo1 +} -returnCodes error -result {can't parse color "blahgle"} +test imgPhoto-4.29 {ImgPhotoCmd procedure: put option} -setup { + image create photo photo1 +} -body { + photo1 put -to 10 10 20 20 {{white}} + photo1 get 19 19 +} -cleanup { + image delete photo1 +} -result {255 255 255} +test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} -setup { + image create photo photo1 +} -body { + photo1 read +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 read fileName ?-option value ...?"} +test imgPhoto-4.31 {ImgPhotoCmd procedure: read option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 +} -body { + photo1 read $teapotPhotoFile -zoom 2 +} -returnCodes error -cleanup { + image delete photo1 +} -result {unrecognized option "-zoom": must be -format, -from, -shrink, or -to} +test imgPhoto-4.32 {ImgPhotoCmd procedure: read option} -setup { + image create photo photo1 +} -body { + list [catch {photo1 read bogus} err] [string tolower $err] +} -cleanup { + image delete photo1 +} -result {1 {couldn't open "bogus": no such file or directory}} +test imgPhoto-4.33 {ImgPhotoCmd procedure: read option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 +} -body { + photo1 read $teapotPhotoFile -format bogus +} -cleanup { + image delete photo1 +} -returnCodes error -result {image file format "bogus" is not supported} +test imgPhoto-4.34 {ImgPhotoCmd procedure: read option} -setup { + image create photo photo1 +} -body { + photo1 read $README +} -returnCodes error -cleanup { + image delete photo1 +} -result [subst {couldn't recognize data in image file "$README"}] +test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 +} -body { + photo1 read $teapotPhotoFile + list [image width photo1] [image height photo1] [photo1 get 120 120] +} -cleanup { + image delete photo1 +} -result {256 256 {161 109 82}} +test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} -constraints { + hasTeapotPhoto +} -setup { + image create photo photo1 +} -body { + photo1 read $teapotPhotoFile -from 0 70 60 120 -to 10 10 -shrink + list [image width photo1] [image height photo1] [photo1 get 29 19] +} -cleanup { + image delete photo1 +} -result {70 60 {244 180 144}} +test imgPhoto-4.37 {ImgPhotoCmd procedure: redither option} -setup { + image create photo photo1 +} -body { + photo1 redither + photo1 redither x +} -cleanup { + image delete photo1 +} -returnCodes error -result {wrong # args: should be "photo1 redither"} +test imgPhoto-4.38 {ImgPhotoCmd procedure: write option} -setup { + image create photo photo1 +} -body { + photo1 write +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 write fileName ?-option value ...?"} +test imgPhoto-4.39 {ImgPhotoCmd procedure: write option} -setup { + image create photo photo1 +} -body { + photo1 write teapot.tmp -format bogus +} -cleanup { + image delete photo1 +} -returnCodes error -result {image file format "bogus" is unknown} +test imgPhoto-4.40 {ImgPhotoCmd procedure: transparency option} -setup { + image create photo photo1 +} -body { + photo1 transparency +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 transparency option ?arg ...?"} +test imgPhoto-4.41 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 transparency get +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 transparency get x y"} +test imgPhoto-4.42 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 transparency get 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 transparency get x y"} +test imgPhoto-4.43 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 transparency get 0 0 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 transparency get x y"} +test imgPhoto-4.44 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 transparency get bogus 0 +} -cleanup { + image delete photo1 +} -returnCodes error -result {expected integer but got "bogus"} +test imgPhoto-4.45 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 transparency get 0 bogus +} -cleanup { + image delete photo1 +} -returnCodes error -result {expected integer but got "bogus"} +test imgPhoto-4.46 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 put white + photo1 transparency get 0 0 +} -cleanup { + image delete photo1 +} -result 0 +test imgPhoto-4.47 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 transparency get 1 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {photo1 transparency get: coordinates out of range} +test imgPhoto-4.48 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 transparency get -1 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {photo1 transparency get: coordinates out of range} +test imgPhoto-4.49 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 transparency get 0 1 +} -returnCodes error -cleanup { + image delete photo1 +} -result {photo1 transparency get: coordinates out of range} +test imgPhoto-4.50 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 transparency get 0 -1 +} -returnCodes error -cleanup { + image delete photo1 +} -result {photo1 transparency get: coordinates out of range} +test imgPhoto-4.51 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 put white + photo1 blank + photo1 transparency get 0 0 +} -cleanup { + image delete photo1 +} -result 1 +test imgPhoto-4.52 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 transparency set x y boolean"} +test imgPhoto-4.53 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 transparency set x y boolean"} +test imgPhoto-4.54 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set 0 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 transparency set x y boolean"} +test imgPhoto-4.55 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set 0 0 0 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {wrong # args: should be "photo1 transparency set x y boolean"} +test imgPhoto-4.56 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set bogus 0 0 +} -cleanup { + image delete photo1 +} -returnCodes error -result {expected integer but got "bogus"} +test imgPhoto-4.57 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set 0 bogus 0 +} -cleanup { + image delete photo1 +} -returnCodes error -result {expected integer but got "bogus"} +test imgPhoto-4.58 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set 0 0 bogus +} -cleanup { + image delete photo1 +} -returnCodes error -result {expected boolean value but got "bogus"} +test imgPhoto-4.59 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set 1 0 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {photo1 transparency set: coordinates out of range} +test imgPhoto-4.60 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set -1 0 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {photo1 transparency set: coordinates out of range} +test imgPhoto-4.61 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set 0 1 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {photo1 transparency set: coordinates out of range} +test imgPhoto-4.62 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 transparency set 0 -1 0 +} -returnCodes error -cleanup { + image delete photo1 +} -result {photo1 transparency set: coordinates out of range} +test imgPhoto-4.63 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 put white + photo1 transparency set 0 0 false + photo1 transparency get 0 0 +} -cleanup { + image delete photo1 +} -result 0 +test imgPhoto-4.64 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 put white + photo1 transparency set 0 0 true + photo1 transparency get 0 0 +} -cleanup { + image delete photo1 +} -result 1 +# Now for some heftier testing, checking that setting and resetting of pixels' +# transparency status doesn't "leak" with any one-off errors. +test imgPhoto-4.65 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 put white -to 0 0 3 3 + checkImgTrans photo1 +} -cleanup { + image delete photo1 +} -result {} +test imgPhoto-4.66 {ImgPhotoCmd procedure: transparency get option} -setup { + image create photo photo1 +} -body { + photo1 put white -to 0 0 3 3 + photo1 blank + checkImgTrans photo1 +} -result {0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2} +test imgPhoto-4.67 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 put white -to 0 0 3 3 + checkImgTransLoop photo1 { + photo1 put white -to 0 0 3 3 + photo1 transparency set $x $y 1 + } { + photo1 transparency set $x $y 0 } - return $result -} -test imgPhoto-4.67 {ImgPhotoCmd procedure: transparency set option} { - checkImgTransLoopSetReset p1 3 3 -} {0 0 , . 0 1 , . 0 2 , . 1 0 , . 1 1 , . 1 2 , . 2 0 , . 2 1 , . 2 2 , .} -proc checkImgTransLoopResetSet {img width height} { - set result {} - for {set x 0} {$x<$width} {incr x} { - for {set y 0} {$y<$height} {incr y} { - $img blank - $img transparency set $x $y 0 - set result [concat $result [checkImgTrans $img $width $height]] - lappend result , - $img transparency set $x $y 1 - set result [concat $result [checkImgTrans $img $width $height]] - lappend result . - } +} -cleanup { + image delete photo1 +} -result {0,0:. 0,1:. 0,2:. 1,0:. 1,1:. 1,2:. 2,0:. 2,1:. 2,2:.} +test imgPhoto-4.68 {ImgPhotoCmd procedure: transparency set option} -setup { + image create photo photo1 +} -body { + photo1 put white -to 0 0 3 3 + checkImgTransLoop photo1 { + photo1 blank + photo1 transparency set $x $y 0 + } { + photo1 transparency set $x $y 1 } - return $result -} -test imgPhoto-4.67a {ImgPhotoCmd procedure: transparency set option} { - checkImgTransLoopResetSet p1 3 3 -} {0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 2 1 0 1 1 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 1 0 1 1 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 1 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 2 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 1 2 0 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 1 1 2 2 1 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 2 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 . 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 , 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2 .} -catch {rename checkImgTransLoopSetReset {}} -catch {rename checkImgTransLoopResetSet {}} -# Test the compositing rules for copying images -image create photo p1 -width 3 -height 3 -image create photo p2 -width 2 -height 2 -test imgPhoto-4.68 {ImgPhotoCmd procedure: copy with -compositingrule} { - list [catch {p1 copy p2 -to 1 1 -compositingrule} msg] $msg -} {1 {the "-compositingrule" option requires a value}} -test imgPhoto-4.69 {ImgPhotoCmd procedure: copy with -compositingrule} { - list [catch {p1 copy p2 -to 1 1 -compositingrule BAD} msg] $msg -} {1 {bad compositing rule "BAD": must be overlay or set}} -test imgPhoto-4.70 {ImgPhotoCmd procedure: copy with -compositingrule} { +} -cleanup { + image delete photo1 +} -result {0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,2 1,0 1,1 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 1,0 1,1 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,1 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,1 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,1 1,2 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2.} +test imgPhoto-4.69 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { + # Test the compositing rules for copying images + image create photo photo1 -width 3 -height 3 + image create photo photo2 -width 2 -height 2 +} -body { + photo1 copy photo2 -to 1 1 -compositingrule +} -cleanup { + image delete photo1 photo2 +} -returnCodes error -result {the "-compositingrule" option requires a value} +test imgPhoto-4.70 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { + # Test the compositing rules for copying images + image create photo photo1 -width 3 -height 3 + image create photo photo2 -width 2 -height 2 +} -body { + photo1 copy photo2 -to 1 1 -compositingrule BAD +} -returnCodes error -cleanup { + image delete photo1 photo2 +} -result {bad compositing rule "BAD": must be overlay or set} +test imgPhoto-4.71 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { + # Test the compositing rules for copying images + image create photo photo1 -width 3 -height 3 + image create photo photo2 -width 2 -height 2 +} -body { # Tests default compositing rule - p1 blank - p2 blank - p1 put white -to 0 0 2 2 - p2 put white -to 0 0 2 2 - p2 transparency set 0 0 true - p1 copy p2 -to 1 1 - checkImgTrans p1 3 3 -} {0 2 2 0} -test imgPhoto-4.71 {ImgPhotoCmd procedure: copy with -compositingrule} { - p1 blank - p2 blank - p1 put white -to 0 0 2 2 - p2 put white -to 0 0 2 2 - p2 transparency set 0 0 true - p1 copy p2 -to 1 1 -compositingrule overlay - checkImgTrans p1 3 3 -} {0 2 2 0} -test imgPhoto-4.72 {ImgPhotoCmd procedure: copy with -compositingrule} { - p1 blank - p2 blank - p1 put white -to 0 0 2 2 - p2 put white -to 0 0 2 2 - p2 transparency set 0 0 true - p1 copy p2 -to 1 1 -compositingrule set - checkImgTrans p1 3 3 -} {0 2 1 1 2 0} -catch {rename checkImgTrans {}} + photo1 blank + photo2 blank + photo1 put white -to 0 0 2 2 + photo2 put white -to 0 0 2 2 + photo2 transparency set 0 0 true + photo1 copy photo2 -to 1 1 + checkImgTrans photo1 +} -cleanup { + image delete photo1 photo2 +} -result {0,2 2,0} +test imgPhoto-4.72 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { + # Test the compositing rules for copying images + image create photo photo1 -width 3 -height 3 + image create photo photo2 -width 2 -height 2 +} -body { + photo1 blank + photo2 blank + photo1 put white -to 0 0 2 2 + photo2 put white -to 0 0 2 2 + photo2 transparency set 0 0 true + photo1 copy photo2 -to 1 1 -compositingrule overlay + checkImgTrans photo1 +} -cleanup { + image delete photo1 photo2 +} -result {0,2 2,0} +test imgPhoto-4.73 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { + # Test the compositing rules for copying images + image create photo photo1 -width 3 -height 3 + image create photo photo2 -width 2 -height 2 +} -body { + photo1 blank + photo2 blank + photo1 put white -to 0 0 2 2 + photo2 put white -to 0 0 2 2 + photo2 transparency set 0 0 true + photo1 copy photo2 -to 1 1 -compositingrule set + checkImgTrans photo1 +} -cleanup { + image delete photo1 photo2 +} -result {0,2 1,1 2,0} -test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} hasTeapotPhoto { - eval image delete [image names] - .c delete all - image create photo p1 -file $teapotPhotoFile - .c create image 0 0 -image p1 -tags p1.1 - .c create image 256 0 -image p1 -tags p1.2 - .c create image 0 256 -image p1 -tags p1.3 +test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints { + hasTeapotPhoto +} -setup { + destroy .c + pack [canvas .c] + imageCleanup +} -body { + image create photo photo1 -file $teapotPhotoFile + .c create image 0 0 -image photo1 -tags photo1.1 + .c create image 256 0 -image photo1 -tags photo1.2 + .c create image 0 256 -image photo1 -tags photo1.3 update .c delete i1.1 - p1 configure -width 1 + photo1 configure -width 1 update .c delete i1.2 - p1 configure -height 1 + photo1 configure -height 1 update - image delete p1 -} {} + image delete photo1 +} -cleanup { + destroy .c +} -result {} -test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} { - .c delete all - image create photo p1 -width 10 -height 10 - p1 blank - .c create image 10 10 -image p1 +test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} -setup { + destroy .c + pack [canvas .c] + imageCleanup +} -body { + image create photo photo1 -width 10 -height 10 + photo1 blank + .c create image 10 10 -image photo1 update -} {} +} -cleanup { + destroy .c + image delete photo1 +} -result {} -test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} hasTeapotPhoto { - eval image delete [image names] - .c delete all - image create photo p1 -file $teapotPhotoFile - .c create image 0 0 -image p1 -anchor nw +test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} -constraints { + hasTeapotPhoto +} -setup { + destroy .c + pack [canvas .c] + imageCleanup +} -body { + image create photo photo1 -file $teapotPhotoFile + .c create image 0 0 -image photo1 -anchor nw update .c delete all - image delete p1 -} {} -test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} hasTeapotPhoto { - image create photo p1 -file $teapotPhotoFile - .c create image 10 10 -image p1 -anchor nw - button .b1 -image p1 - button .b2 -image p1 - button .b3 -image p1 + image delete photo1 +} -cleanup { + destroy .c +} -result {} +test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} -constraints { + hasTeapotPhoto +} -setup { + deleteWindows + imageCleanup +} -body { + image create photo photo1 -file $teapotPhotoFile + pack [canvas .c] + .c create image 10 10 -image photo1 -anchor nw + button .b1 -image photo1 + button .b2 -image photo1 + button .b3 -image photo1 pack .b1 .b2 .b3 update destroy .b2 @@ -490,12 +871,20 @@ test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} hasTeapotPhoto { destroy .b1 update .c delete all -} {} -test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} hasTeapotPhoto { - image create photo p1 -file $teapotPhotoFile - button .b1 -image p1 +} -cleanup { + destroy .c + image delete photo1 +} -result {} +test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} -constraints { + hasTeapotPhoto +} -setup { + deleteWindows + imageCleanup +} -body { + image create photo photo1 -file $teapotPhotoFile + button .b1 -image photo1 frame .f -visual best - button .f.b2 -image p1 + button .f.b2 -image photo1 pack .f.b2 pack .b1 .f update @@ -504,59 +893,71 @@ test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} hasTeapotPhoto { .f.b2 configure -image {} update destroy .f - image delete p1 -} {} + image delete photo1 +} -result {} -test imgPhoto-8.1 {ImgPhotoDelete procedure} hasTeapotPhoto { - image create photo p2 -file $teapotPhotoFile - image delete p2 -} {} -test imagePhoto-8.2 {ImgPhotoDelete procedure} hasTeapotPhoto { - image create photo p2 -file $teapotPhotoFile - rename p2 newp2 - set x [list [info command p2] [info command new*] [newp2 cget -file]] - image delete p2 - append x [info command new*] -} [list {} newp2 $teapotPhotoFile] -test imagePhoto-8.3 {ImgPhotoDelete procedure, name cleanup} { - image create photo p1 - image create photo p2 -width 10 -height 10 - image delete p2 - list [catch {p1 copy p2} msg] $msg -} {1 {image "p2" doesn't exist or is not a photo image}} +test imgPhoto-8.1 {ImgPhotoDelete procedure} -constraints hasTeapotPhoto -body { + image create photo photo2 -file $teapotPhotoFile + image delete photo2 +} -result {} +test imgPhoto-8.2 {ImgPhotoDelete procedure} -constraints { + hasTeapotPhoto +} -setup { + set x {} +} -body { + image create photo photo2 -file $teapotPhotoFile + rename photo2 newphoto2 + lappend x [info command photo2] [info command new*] [newphoto2 cget -file] + image delete photo2 + lappend x [info command new*] +} -result [list {} newphoto2 $teapotPhotoFile {}] +test imgPhoto-8.3 {ImgPhotoDelete procedure, name cleanup} -body { + image create photo photo1 + image create photo photo2 -width 10 -height 10 + image delete photo2 + photo1 copy photo2 +} -returnCodes error -cleanup { + imageCleanup +} -result {image "photo2" doesn't exist or is not a photo image} -test imagePhoto-9.1 {ImgPhotoCmdDeletedProc procedure} hasTeapotPhoto { - image create photo p2 -file $teapotPhotoFile - rename p2 {} - list [lsearch -exact [image names] p2] [catch {p2 foo} msg] $msg -} {-1 1 {invalid command name "p2"}} +test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -constraints { + hasTeapotPhoto +} -body { + image create photo photo2 -file $teapotPhotoFile + rename photo2 {} + list [lsearch -exact [imageNames] photo2] [catch {photo2 foo} msg] $msg +} -result {-1 1 {invalid command name "photo2"}} -test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} { - eval image delete [image names] - image create photo p1 - p1 put {{#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000}} -to 0 0 - p1 put {{#00ff00 #00ff00}} -to 2 0 - list [p1 get 2 0] [p1 get 3 0] [p1 get 4 0] -} {{0 255 0} {0 255 0} {255 0 0}} +test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup { + imageCleanup +} -body { + image create photo photo1 + photo1 put "{#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000}" -to 0 0 + photo1 put "{#00ff00 #00ff00}" -to 2 0 + list [photo1 get 2 0] [photo1 get 3 0] [photo1 get 4 0] +} -result {{0 255 0} {0 255 0} {255 0 0}} -test imgPhoto-11.1 {Tk_FindPhoto} { - eval image delete [image names] +test imgPhoto-11.1 {Tk_FindPhoto} -setup { + imageCleanup +} -body { image create bitmap i1 - image create photo p1 - list [catch {p1 copy i1} msg] $msg -} {1 {image "i1" doesn't exist or is not a photo image}} + image create photo photo1 + photo1 copy i1 +} -cleanup { + imageCleanup +} -returnCodes error -result {image "i1" doesn't exist or is not a photo image} -test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} hasTeapotPhoto { +test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body { image create photo p3 -file $teapotPhotoFile set result [list [p3 get 50 50] [p3 get 100 100]] p3 copy p3 -zoom 2 lappend result [image width p3] [image height p3] [p3 get 100 100] +} -cleanup { image delete p3 - set result -} {{19 92 192} {169 117 90} 512 512 {19 92 192}} +} -result {{19 92 192} {169 117 90} 512 512 {19 92 192}} -test imgPhoto-13.1 {check separation of images in different interpreters} { - image delete {*}[image names] +test imgPhoto-13.1 {check separation of images in different interpreters} -setup { + imageCleanup set data { R0lGODlhQgBkAPUAANbWxs7Wxs7OxsbOxsbGxsbGvb3Gvca9vcDAwL21vbW1vbW1tbWtta2t ta2ltaWltaWlraWctaWcrZycrZyUrZSUrZSMrZSMpYyMrYyMpYyEpYSEpYR7pYR7nHp7pYRz @@ -592,82 +993,79 @@ test imgPhoto-13.1 {check separation of images in different interpreters} { interp create x2 x1 eval {load {} Tk} x2 eval {load {} Tk} +} -body { x1 eval [list image create photo T1_data -data $data] x2 eval [list image create photo T1_data -data $data] - unset data +} -cleanup { interp delete x1 interp delete x2 -} {} +} -result T1_data -test imgPhoto-14.1 {GIF writes work correctly} { - set data "R0lGODlhYwA5APcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgAysnGy8hKzM -hASs3MTcjAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMDAwP8AAAD/ -AP//AAAA//8A/wD//////ywAAAAAYwA5AAAI/wAZCBxIsKDBgwgTKlzIsKHD -hxAjSpxIsaLFixgzatzIsaPHjyBDihxJsqTJkyhTqlzJsqXLlzBjypxJs6bN -mzhz6tzJs6fPn0CDCh1KtKhRiwoSKEXAtGlTpUqPGkyagOmCq1edNsWalWkC -BUSXIuDqFepBqFWtZv3KU+zYrkrBSqT6dgECtjOTbu16NwFHvV3lshRLti/J -qlgRCE6ZuO9ik4Dt+k0ZVyZiyVIvXr77ODPEy5g9T4zMWfTEzXdNz1VbWvXn -uqldP1TAOrbshqBb314Y2W7n3Qdpv7UNPCHpycUVbv6dnODy5sqzQldIe8H0 -hciva9/Ovbv37+BzBgEEADs= -" - set photo [image create photo -data $data] - set filename [makeFile {} imgPhoto-14.1.gif] - removeFile imgPhoto-14.1.gif - $photo write $filename -format gif - set photo2 [image create photo -file $filename] - set result [string equal [$photo data] [$photo2 data]] - image delete $photo $photo2 - catch {file delete -force $filename} - set result -} 1 -test imgPhoto-14.2 {GIF -index handler buffer sizing} -setup { - set i [image create photo] +test imgPhoto-14.1 {GIF writes work correctly} -setup { + set data { + R0lGODlhYwA5APcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgAysnGy8hKzM + hASs3MTcjAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMDAwP8AAAD/ + AP//AAAA//8A/wD//////ywAAAAAYwA5AAAI/wAZCBxIsKDBgwgTKlzIsKHD + hxAjSpxIsaLFixgzatzIsaPHjyBDihxJsqTJkyhTqlzJsqXLlzBjypxJs6bN + mzhz6tzJs6fPn0CDCh1KtKhRiwoSKEXAtGlTpUqPGkyagOmCq1edNsWalWkC + BUSXIuDqFepBqFWtZv3KU+zYrkrBSqT6dgECtjOTbu16NwFHvV3lshRLti/J + qlgRCE6ZuO9ik4Dt+k0ZVyZiyVIvXr77ODPEy5g9T4zMWfTEzXdNz1VbWvXn + uqldP1TAOrbshqBb314Y2W7n3Qdpv7UNPCHpycUVbv6dnODy5sqzQldIe8H0 + hciva9/Ovbv37+BzBgEEADs= + } + set tmpfilename [makeFile {} imgPhoto-14.1.gif] + removeFile $tmpfilename } -body { - # Bug 1458234 makes this crash when trying to access buffers of the - # wrong size, caused when the initial frame is not the largest frame. + image create photo photo1 -data $data + photo1 write $tmpfilename -format gif + image create photo photo2 -file $tmpfilename + string equal [photo1 data] [photo2 data] +} -cleanup { + catch {image delete photo1 photo2} + catch {file delete -force $tmpfilename} +} -result 1 +test imgPhoto-14.2 {GIF -index handler buffer sizing} -setup { set data { R0lGODlhIAAgAKEAAPkOSQsi7////////yH/C05FVFNDQVBFMi4wAwEAAAAh +QQJMgAAACwGAAYAFAAUAAACEYyPqcvtD6OctNqLs968+68VACH5BAkyAAEA LAMAAwAaABoAAAI0jH+gq+gfmFzQzUsr3gBybn1gIm5kaUaoubbuC8fyTNel Ohv1CSO533u8KrgbUfc5Ci/EAgA7 } +} -body { + # Bug 1458234 makes this crash when trying to access buffers of the wrong + # size, caused when the initial frame is not the largest frame. + set i [image create photo] $i configure -data $data -format {gif -index 2} } -cleanup { image delete $i } -returnCodes error -result {no image data for this index} - -test imgPhoto-14.3 {GIF -index interleaving and small frames} -setup { +test imgPhoto-14.3 {GIF -index interleaving and small frames} -body { + # Interleaved GIFs used to crash us when a smaller subsequent frame was + # accessed. set i [image create photo] -} -body { - # Interleaved GIFs used to crash us when a smaller subsequent frame - # was accessed. $i configure -format {GIF -index 1} -data { R0lGODdhAQAFAPAAAP8AAAAAACwAAAAAAQAFAEACAoRdACwAAAAAAQAEAEACAoRRADs= } } -cleanup { image delete $i } - test imgPhoto-14.4 {GIF buffer overflow} -setup { - set i [image create photo] -} -body { - # This crashes Tk up to 8.4.17 and 8.5.0 - $i configure -data { + set data { R0lGODlhCgAKAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgMDAwP8AAAD/ AP//AAAA//8A/wD//////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA @@ -687,30 +1085,85 @@ test imgPhoto-14.4 {GIF buffer overflow} -setup { mf9mzP9m//+ZAP+ZM/+ZZv+Zmf+ZzP+Z///MAP/MM//MZv/Mmf/MzP/M//// AP//M///Zv//mf//zP///yH5BAEAABAALAAAAAAKAAoAABUSAAD/HEiwoMGD CBMqXMiwYcKAADs= - } + } +} -body { + # This crashes Tk up to 8.4.17 and 8.5.0 + set i [image create photo] + $i configure -data $data } -cleanup { image delete $i } -returnCodes error -result {malformed image} -test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} \ - {nonPortable} { - # This is not portable to very large machines with more around - # 3GB of free memory available... - list [catch {image create photo -width 32000 -height 32000} msg] $msg -} {1 {not enough free memory for image buffer}} +test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} -constraints { + nonPortable +} -body { + # This is not portable to very large machines with more than around 3GB of + # free memory available... + image create photo -width 32000 -height 32000 +} -returnCodes error -result {not enough free memory for image buffer} -test imgPhoto-16.1 {copying to self doesn't access freed memory} { - # Bug 877950 makes this crash when trying to copy out of a deallocated area +test imgPhoto-16.1 {copying to self doesn't access freed memory} -setup { set i [image create photo] +} -body { + # Bug 877950 makes this crash when trying to copy out of a deallocated + # area. $i put red -to 0 0 1000 1000 $i copy $i -from 0 0 1000 1000 -to 500 0 +} -cleanup { + image delete $i +} -result {} + +# Check that we can guess our supported output formats [Bug 2983824] +test imgPhoto-17.1 {photo write: format guessing from filename} -setup { + set i [image create photo -width 3 -height 3] +} -body { + set f [makeFile {} test.png] + $i write $f + set fd [open $f] + seek $fd 1 + read $fd 3 +} -cleanup { + catch {close $fd} + image delete $i + catch {removeFile $f} +} -result PNG +test imgPhoto-17.2 {photo write: format guessing from filename} -setup { + set i [image create photo -width 3 -height 3] +} -body { + set f [makeFile {} test.gif] + $i write $f + set fd [open $f] + read $fd 3 +} -cleanup { + catch {close $fd} + image delete $i + catch {removeFile $f} +} -result GIF +test imgPhoto-17.3 {photo write: format guessing from filename} -setup { + set i [image create photo -width 3 -height 3] +} -body { + set f [makeFile {} test.ppm] + $i write $f + set fd [open $f] + read $fd 3 +} -cleanup { + catch {close $fd} image delete $i -} {} + catch {removeFile $f} +} -result "P6\n" -destroy .c -eval image delete [image names] +# ---------------------------------------------------------------------- + +catch {rename foreachPixel {}} +catch {rename checkImgTrans {}} +catch {rename checkImgTransLoop {}} +imageFinish # cleanup removeFile README-imgPhoto cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/listbox.test b/tests/listbox.test index b4046b6..f50267e 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -6,9 +6,10 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test set fixed {Courier -12} @@ -39,7 +40,7 @@ proc resetGridInfo {} { # to partially visible lines. proc mkPartial {{w .partial}} { - catch {destroy $w} + destroy $w toplevel $w wm geometry $w +0+0 listbox $w.l -width 30 -height 5 @@ -59,128 +60,332 @@ option add *Listbox.borderWidth 2 option add *Listbox.highlightThickness 2 option add *Listbox.font {Helvetica -12 bold} +# Listbox used in 3.* configuration options tests listbox .l pack .l update resetGridInfo -set i 1 - -foreach test { - {-activestyle under underline foo {bad activestyle "foo": must be dotbox, none, or underline}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}} - {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} - {-fg #110022 #110022 bogus {unknown color name "bogus"}} - {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"}} - {-height 30 30 20p {expected integer but got "20p"}} - {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} - {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} - {-highlightthickness -2 0 {} {}} - {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} - {-selectmode string string {} {}} - {-setgrid false 0 lousy {expected boolean value but got "lousy"}} - {-state disabled disabled foo {bad state "foo": must be disabled or normal}} - {-takefocus "any string" "any string" {} {}} - {-width 45 45 3p {expected integer but got "3p"}} - {-xscrollcommand {Some command} {Some command} {} {}} - {-yscrollcommand {Another command} {Another command} {} {}} - {-listvar testVariable testVariable {} {}} -} { - set name [lindex $test 0] - test listbox-1.$i {configuration options} { - .l configure $name [lindex $test 1] - list [lindex [.l configure $name] 4] [.l cget $name] - } [list [lindex $test 2] [lindex $test 2]] - incr i - if {[lindex $test 3] != ""} { - test listbox-1.$i {configuration options} { - list [catch {.l configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - .l configure $name [lindex [.l configure $name] 3] - incr i -} +test listbox-1.1 {configuration options} -body { + .l configure -activestyle under + list [lindex [.l configure -activestyle] 4] [.l cget -activestyle] +} -cleanup { + .l configure -activestyle [lindex [.l configure -activestyle] 3] +} -result {underline underline} +test listbox-1.2 {configuration options} -body { + .l configure -activestyle foo +} -returnCodes error -result {bad activestyle "foo": must be dotbox, none, or underline} +test listbox-1.3 {configuration options} -body { + .l configure -background #ff0000 + list [lindex [.l configure -background] 4] [.l cget -background] +} -cleanup { + .l configure -background [lindex [.l configure -background] 3] +} -result {{#ff0000} #ff0000} +test listbox-1.4 {configuration options} -body { + .l configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test listbox-1.5 {configuration options} -body { + .l configure -bd 4 + list [lindex [.l configure -bd] 4] [.l cget -bd] +} -cleanup { + .l configure -bd [lindex [.l configure -bd] 3] +} -result {4 4} +test listbox-1.6 {configuration options} -body { + .l configure -bd badValue +} -returnCodes error -result {bad screen distance "badValue"} +test listbox-1.7 {configuration options} -body { + .l configure -bg #ff0000 + list [lindex [.l configure -bg] 4] [.l cget -bg] +} -cleanup { + .l configure -bg [lindex [.l configure -bg] 3] +} -result {{#ff0000} #ff0000} +test listbox-1.8 {configuration options} -body { + .l configure -bg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test listbox-1.9 {configuration options} -body { + .l configure -borderwidth 1.3 + list [lindex [.l configure -borderwidth] 4] [.l cget -borderwidth] +} -cleanup { + .l configure -borderwidth [lindex [.l configure -borderwidth] 3] +} -result {1 1} +test listbox-1.10 {configuration options} -body { + .l configure -borderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test listbox-1.11 {configuration options} -body { + .l configure -cursor arrow + list [lindex [.l configure -cursor] 4] [.l cget -cursor] +} -cleanup { + .l configure -cursor [lindex [.l configure -cursor] 3] +} -result {arrow arrow} +test listbox-1.12 {configuration options} -body { + .l configure -cursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} +test listbox-1.13 {configuration options} -body { + .l configure -disabledforeground #110022 + list [lindex [.l configure -disabledforeground] 4] [.l cget -disabledforeground] +} -cleanup { + .l configure -disabledforeground [lindex [.l configure -disabledforeground] 3] +} -result {{#110022} #110022} +test listbox-1.14 {configuration options} -body { + .l configure -disabledforeground bogus +} -returnCodes error -result {unknown color name "bogus"} +test listbox-1.15 {configuration options} -body { + .l configure -exportselection yes + list [lindex [.l configure -exportselection] 4] [.l cget -exportselection] +} -cleanup { + .l configure -exportselection [lindex [.l configure -exportselection] 3] +} -result {1 1} +test listbox-1.16 {configuration options} -body { + .l configure -exportselection xyzzy +} -returnCodes error -result {expected boolean value but got "xyzzy"} +test listbox-1.17 {configuration options} -body { + .l configure -fg #110022 + list [lindex [.l configure -fg] 4] [.l cget -fg] +} -cleanup { + .l configure -fg [lindex [.l configure -fg] 3] +} -result {{#110022} #110022} +test listbox-1.18 {configuration options} -body { + .l configure -fg bogus +} -returnCodes error -result {unknown color name "bogus"} +test listbox-1.19 {configuration options} -body { + .l configure -font {Helvetica 12} + list [lindex [.l configure -font] 4] [.l cget -font] +} -cleanup { + .l configure -font [lindex [.l configure -font] 3] +} -result {{Helvetica 12} {Helvetica 12}} +test listbox-1.21 {configuration options} -body { + .l configure -foreground #110022 + list [lindex [.l configure -foreground] 4] [.l cget -foreground] +} -cleanup { + .l configure -foreground [lindex [.l configure -foreground] 3] +} -result {{#110022} #110022} +test listbox-1.22 {configuration options} -body { + .l configure -foreground bogus +} -returnCodes error -result {unknown color name "bogus"} +test listbox-1.23 {configuration options} -body { + .l configure -height 30 + list [lindex [.l configure -height] 4] [.l cget -height] +} -cleanup { + .l configure -height [lindex [.l configure -height] 3] +} -result {30 30} +test listbox-1.24 {configuration options} -body { + .l configure -height 20p +} -returnCodes error -result {expected integer but got "20p"} +test listbox-1.25 {configuration options} -body { + .l configure -highlightbackground #112233 + list [lindex [.l configure -highlightbackground] 4] [.l cget -highlightbackground] +} -cleanup { + .l configure -highlightbackground [lindex [.l configure -highlightbackground] 3] +} -result {{#112233} #112233} +test listbox-1.26 {configuration options} -body { + .l configure -highlightbackground ugly +} -returnCodes error -result {unknown color name "ugly"} +test listbox-1.27 {configuration options} -body { + .l configure -highlightcolor #123456 + list [lindex [.l configure -highlightcolor] 4] [.l cget -highlightcolor] +} -cleanup { + .l configure -highlightcolor [lindex [.l configure -highlightcolor] 3] +} -result {{#123456} #123456} +test listbox-1.28 {configuration options} -body { + .l configure -highlightcolor bogus +} -returnCodes error -result {unknown color name "bogus"} +test listbox-1.29 {configuration options} -body { + .l configure -highlightthickness 6 + list [lindex [.l configure -highlightthickness] 4] [.l cget -highlightthickness] +} -cleanup { + .l configure -highlightthickness [lindex [.l configure -highlightthickness] 3] +} -result {6 6} +test listbox-1.30 {configuration options} -body { + .l configure -highlightthickness bogus +} -returnCodes error -result {bad screen distance "bogus"} +test listbox-1.31 {configuration options} -body { + .l configure -highlightthickness -2 + list [lindex [.l configure -highlightthickness] 4] [.l cget -highlightthickness] +} -cleanup { + .l configure -highlightthickness [lindex [.l configure -highlightthickness] 3] +} -result {0 0} +test listbox-1.33 {configuration options} -body { + .l configure -relief groove + list [lindex [.l configure -relief] 4] [.l cget -relief] +} -cleanup { + .l configure -relief [lindex [.l configure -relief] 3] +} -result {groove groove} +test listbox-1.34 {configuration options} -body { + .l configure -relief 1.5 +} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test listbox-1.35 {configuration options} -body { + .l configure -selectbackground #110022 + list [lindex [.l configure -selectbackground] 4] [.l cget -selectbackground] +} -cleanup { + .l configure -selectbackground [lindex [.l configure -selectbackground] 3] +} -result {{#110022} #110022} +test listbox-1.36 {configuration options} -body { + .l configure -selectbackground bogus +} -returnCodes error -result {unknown color name "bogus"} +test listbox-1.37 {configuration options} -body { + .l configure -selectborderwidth 1.3 + list [lindex [.l configure -selectborderwidth] 4] [.l cget -selectborderwidth] +} -cleanup { + .l configure -selectborderwidth [lindex [.l configure -selectborderwidth] 3] +} -result {1 1} +test listbox-1.38 {configuration options} -body { + .l configure -selectborderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test listbox-1.39 {configuration options} -body { + .l configure -selectforeground #654321 + list [lindex [.l configure -selectforeground] 4] [.l cget -selectforeground] +} -cleanup { + .l configure -selectforeground [lindex [.l configure -selectforeground] 3] +} -result {{#654321} #654321} +test listbox-1.40 {configuration options} -body { + .l configure -selectforeground bogus +} -returnCodes error -result {unknown color name "bogus"} +test listbox-1.41 {configuration options} -body { + .l configure -selectmode string + list [lindex [.l configure -selectmode] 4] [.l cget -selectmode] +} -cleanup { + .l configure -selectmode [lindex [.l configure -selectmode] 3] +} -result {string string} +test listbox-1.43 {configuration options} -body { + .l configure -setgrid false + list [lindex [.l configure -setgrid] 4] [.l cget -setgrid] +} -cleanup { + .l configure -setgrid [lindex [.l configure -setgrid] 3] +} -result {0 0} +test listbox-1.44 {configuration options} -body { + .l configure -setgrid lousy +} -returnCodes error -result {expected boolean value but got "lousy"} +test listbox-1.45 {configuration options} -body { + .l configure -state disabled + list [lindex [.l configure -state] 4] [.l cget -state] +} -cleanup { + .l configure -state [lindex [.l configure -state] 3] +} -result {disabled disabled} +test listbox-1.46 {configuration options} -body { + .l configure -state foo +} -returnCodes error -result {bad state "foo": must be disabled or normal} +test listbox-1.47 {configuration options} -body { + .l configure -takefocus {any string} + list [lindex [.l configure -takefocus] 4] [.l cget -takefocus] +} -cleanup { + .l configure -takefocus [lindex [.l configure -takefocus] 3] +} -result {{any string} {any string}} +test listbox-1.49 {configuration options} -body { + .l configure -width 45 + list [lindex [.l configure -width] 4] [.l cget -width] +} -cleanup { + .l configure -width [lindex [.l configure -width] 3] +} -result {45 45} +test listbox-1.50 {configuration options} -body { + .l configure -width 3p +} -returnCodes error -result {expected integer but got "3p"} +test listbox-1.51 {configuration options} -body { + .l configure -xscrollcommand {Some command} + list [lindex [.l configure -xscrollcommand] 4] [.l cget -xscrollcommand] +} -cleanup { + .l configure -xscrollcommand [lindex [.l configure -xscrollcommand] 3] +} -result {{Some command} {Some command}} +test listbox-1.53 {configuration options} -body { + .l configure -yscrollcommand {Another command} + list [lindex [.l configure -yscrollcommand] 4] [.l cget -yscrollcommand] +} -cleanup { + .l configure -yscrollcommand [lindex [.l configure -yscrollcommand] 3] +} -result {{Another command} {Another command}} +test listbox-1.55 {configuration options} -body { + .l configure -listvar testVariable + list [lindex [.l configure -listvar] 4] [.l cget -listvar] +} -cleanup { + .l configure -listvar [lindex [.l configure -listvar] 3] +} -result {testVariable testVariable} + -test listbox-2.1 {Tk_ListboxCmd procedure} { - list [catch {listbox} msg] $msg -} {1 {wrong # args: should be "listbox pathName ?options?"}} -test listbox-2.2 {Tk_ListboxCmd procedure} { - list [catch {listbox gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test listbox-2.3 {Tk_ListboxCmd procedure} { - catch {destroy .l} +test listbox-2.1 {Tk_ListboxCmd procedure} -body { + listbox +} -returnCodes error -result {wrong # args: should be "listbox pathName ?-option value ...?"} +test listbox-2.2 {Tk_ListboxCmd procedure} -body { + listbox gorp +} -returnCodes error -result {bad window path name "gorp"} +test listbox-2.3 {Tk_ListboxCmd procedure} -setup { + destroy .l +} -body { listbox .l list [winfo exists .l] [winfo class .l] [info commands .l] -} {1 Listbox .l} -test listbox-2.4 {Tk_ListboxCmd procedure} { - catch {destroy .l} - list [catch {listbox .l -gorp foo} msg] $msg [winfo exists .l] \ - [info commands .l] -} {1 {unknown option "-gorp"} 0 {}} -test listbox-2.5 {Tk_ListboxCmd procedure} { - catch {destroy .l} +} -result {1 Listbox .l} +test listbox-2.4 {Tk_ListboxCmd procedure} -setup { + destroy .l +} -body { + listbox .l -gorp foo +} -cleanup { + destroy .l +} -returnCodes error -result {unknown option "-gorp"} +test listbox-2.4.1 {Tk_ListboxCmd procedure} -setup { + destroy .l +} -body { + catch {listbox .l -gorp foo} + list [winfo exists .l] [info commands .l] +} -cleanup { + destroy .l +} -result {0 {}} +test listbox-2.5 {Tk_ListboxCmd procedure} -setup { + destroy .l +} -body { listbox .l -} {.l} +} -cleanup { + destroy .l +} -result {.l} + -catch {destroy .l} +# Listbox used in 3.1 -3.115 tests +destroy .l listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2 pack .l .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \ el15 el16 el17 update -test listbox-3.1 {ListboxWidgetCmd procedure} { - list [catch .l msg] $msg -} {1 {wrong # args: should be ".l option ?arg arg ...?"}} -test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} { - list [catch {.l activate} msg] $msg -} {1 {wrong # args: should be ".l activate index"}} -test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} { - list [catch {.l activate a b} msg] $msg -} {1 {wrong # args: should be ".l activate index"}} -test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} { - list [catch {.l activate fooey} msg] $msg -} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}} -test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} { +test listbox-3.1 {ListboxWidgetCmd procedure} -body { + .l +} -returnCodes error -result {wrong # args: should be ".l option ?arg ...?"} +test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} -body { + .l activate +} -returnCodes error -result {wrong # args: should be ".l activate index"} +test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} -body { + .l activate a b +} -returnCodes error -result {wrong # args: should be ".l activate index"} +test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} -body { + .l activate fooey +} -returnCodes error -result {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number} +test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} -body { .l activate 3 .l index active -} 3 -test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} { +} -result 3 +test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} -body { .l activate -1 .l index active -} {0} -test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} { +} -result {0} +test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} -body { .l activate 30 .l index active -} {17} -test listbox-3.8 {ListboxWidgetCmd procedure, "activate" option} { +} -result {17} +test listbox-3.8 {ListboxWidgetCmd procedure, "activate" option} -body { .l activate end .l index active -} {17} -test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} { - list [catch {.l bbox} msg] $msg -} {1 {wrong # args: should be ".l bbox index"}} -test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} { - list [catch {.l bbox a b} msg] $msg -} {1 {wrong # args: should be ".l bbox index"}} -test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} { - list [catch {.l bbox fooey} msg] $msg -} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}} -test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option} { +} -result {17} +test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} -body { + .l bbox +} -returnCodes error -result {wrong # args: should be ".l bbox index"} +test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} -body { + .l bbox a b +} -returnCodes error -result {wrong # args: should be ".l bbox index"} +test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} -body { + .l bbox fooey +} -returnCodes error -result {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number} +test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option} -body { .l yview 3 update list [.l bbox 2] [.l bbox 8] -} {{} {}} -test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} { +} -result {{} {}} +test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} -cleanup { + destroy .l2 +} -body { # Used to generate a core dump before a bug was fixed (the last # element would be on-screen if it existed, but it doesn't exist). @@ -190,24 +395,35 @@ test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} { set x [.l2 bbox 0] destroy .l2 set x -} {} -test listbox-3.14 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { +} -cleanup { + destroy .l2 +} -result {} +test listbox-3.14 {ListboxWidgetCmd procedure, "bbox" option} -constraints { + fonts +} -body { .l yview 3 update list [.l bbox 3] [.l bbox 4] -} {{7 7 17 14} {7 26 17 14}} -test listbox-3.15 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { +} -result {{7 7 17 14} {7 26 17 14}} +test listbox-3.15 {ListboxWidgetCmd procedure, "bbox" option} -constraints { + fonts +} -body { .l yview 0 update list [.l bbox -1] [.l bbox 0] -} {{} {7 7 17 14}} -test listbox-3.16 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { +} -result {{} {7 7 17 14}} +test listbox-3.16 {ListboxWidgetCmd procedure, "bbox" option} -constraints { + fonts +} -body { .l yview end update list [.l bbox 17] [.l bbox end] [.l bbox 18] -} {{7 83 24 14} {7 83 24 14} {}} -test listbox-3.17 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { - catch {destroy .t} +} -result {{7 83 24 14} {7 83 24 14} {}} +test listbox-3.17 {ListboxWidgetCmd procedure, "bbox" option} -constraints { + fonts +} -setup { + destroy .t +} -body { toplevel .t wm geom .t +0+0 listbox .t.l -width 10 -height 5 @@ -216,255 +432,307 @@ test listbox-3.17 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { update .t.l xview moveto .2 .t.l bbox 2 -} {-72 39 393 14} -test listbox-3.18 {ListboxWidgetCmd procedure, "bbox" option, partial last line} {fonts} { +} -cleanup { + destroy .t +} -result {-72 39 393 14} +test listbox-3.18 {ListboxWidgetCmd procedure, "bbox" option, partial last line} -constraints { + fonts +} -body { mkPartial list [.partial.l bbox 3] [.partial.l bbox 4] -} {{5 56 24 14} {5 73 23 14}} -test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} { - list [catch {.l cget} msg] $msg -} {1 {wrong # args: should be ".l cget option"}} -test listbox-3.20 {ListboxWidgetCmd procedure, "cget" option} { - list [catch {.l cget a b} msg] $msg -} {1 {wrong # args: should be ".l cget option"}} -test listbox-3.21 {ListboxWidgetCmd procedure, "cget" option} { - list [catch {.l cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} { +} -result {{5 56 24 14} {5 73 23 14}} +test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} -body { + .l cget +} -returnCodes error -result {wrong # args: should be ".l cget option"} +test listbox-3.20 {ListboxWidgetCmd procedure, "cget" option} -body { + .l cget a b +} -returnCodes error -result {wrong # args: should be ".l cget option"} +test listbox-3.21 {ListboxWidgetCmd procedure, "cget" option} -body { + .l cget -gorp +} -returnCodes error -result {unknown option "-gorp"} +test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} -body { .l cget -setgrid -} {0} -test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} { +} -result {0} +test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} -body { llength [.l configure] -} {27} -test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} { - list [catch {.l configure -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test listbox-3.25 {ListboxWidgetCmd procedure, "configure" option} { +} -result {27} +test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} -body { + .l configure -gorp +} -returnCodes error -result {unknown option "-gorp"} +test listbox-3.25 {ListboxWidgetCmd procedure, "configure" option} -body { .l configure -setgrid -} {-setgrid setGrid SetGrid 0 0} -test listbox-3.26 {ListboxWidgetCmd procedure, "configure" option} { - list [catch {.l configure -gorp is_messy} msg] $msg -} {1 {unknown option "-gorp"}} -test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} { +} -result {-setgrid setGrid SetGrid 0 0} +test listbox-3.26 {ListboxWidgetCmd procedure, "configure" option} -body { + .l configure -gorp is_messy +} -returnCodes error -result {unknown option "-gorp"} +test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} -body { set oldbd [.l cget -bd] set oldht [.l cget -highlightthickness] .l configure -bd 3 -highlightthickness 0 set x "[.l cget -bd] [.l cget -highlightthickness]" .l configure -bd $oldbd -highlightthickness $oldht set x -} {3 0} -test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} { - list [catch {.l curselection a} msg] $msg -} {1 {wrong # args: should be ".l curselection"}} -test listbox-3.29 {ListboxWidgetCmd procedure, "curselection" option} { +} -result {3 0} +test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} -body { + .l curselection a +} -returnCodes error -result {wrong # args: should be ".l curselection"} +test listbox-3.29 {ListboxWidgetCmd procedure, "curselection" option} -body { .l selection clear 0 end .l selection set 3 6 .l selection set 9 .l curselection -} {3 4 5 6 9} -test listbox-3.30 {ListboxWidgetCmd procedure, "delete" option} { - list [catch {.l delete} msg] $msg -} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}} -test listbox-3.31 {ListboxWidgetCmd procedure, "delete" option} { - list [catch {.l delete a b c} msg] $msg -} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}} -test listbox-3.32 {ListboxWidgetCmd procedure, "delete" option} { - list [catch {.l delete badIndex} msg] $msg -} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}} -test listbox-3.33 {ListboxWidgetCmd procedure, "delete" option} { - list [catch {.l delete 2 123ab} msg] $msg -} {1 {bad listbox index "123ab": must be active, anchor, end, @x,y, or a number}} -test listbox-3.34 {ListboxWidgetCmd procedure, "delete" option} { - catch {destroy .l2} +} -result {3 4 5 6 9} +test listbox-3.30 {ListboxWidgetCmd procedure, "delete" option} -body { + .l delete +} -returnCodes error -result {wrong # args: should be ".l delete firstIndex ?lastIndex?"} +test listbox-3.31 {ListboxWidgetCmd procedure, "delete" option} -body { + .l delete a b c +} -returnCodes error -result {wrong # args: should be ".l delete firstIndex ?lastIndex?"} +test listbox-3.32 {ListboxWidgetCmd procedure, "delete" option} -body { + .l delete badIndex +} -returnCodes error -result {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number} +test listbox-3.33 {ListboxWidgetCmd procedure, "delete" option} -body { + .l delete 2 123ab +} -returnCodes error -result {bad listbox index "123ab": must be active, anchor, end, @x,y, or a number} +test listbox-3.34 {ListboxWidgetCmd procedure, "delete" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 3 list [.l2 get 2] [.l2 get 3] [.l2 index end] -} {el2 el4 7} -test listbox-3.35 {ListboxWidgetCmd procedure, "delete" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {el2 el4 7} +test listbox-3.35 {ListboxWidgetCmd procedure, "delete" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 2 4 list [.l2 get 1] [.l2 get 2] [.l2 index end] -} {el1 el5 5} -test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {el1 el5 5} +test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete -3 2 .l2 get 0 end -} {el3 el4 el5 el6 el7} -test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {el3 el4 el5 el6 el7} +test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete -3 -1 .l2 get 0 end -} {el0 el1 el2 el3 el4 el5 el6 el7} -test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {el0 el1 el2 el3 el4 el5 el6 el7} +test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 2 end .l2 get 0 end -} {el0 el1} -test listbox-3.39 {ListboxWidgetCmd procedure, "delete" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {el0 el1} +test listbox-3.39 {ListboxWidgetCmd procedure, "delete" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 5 20 .l2 get 0 end -} {el0 el1 el2 el3 el4} -test listbox-3.40 {ListboxWidgetCmd procedure, "delete" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {el0 el1 el2 el3 el4} +test listbox-3.40 {ListboxWidgetCmd procedure, "delete" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete end 20 .l2 get 0 end -} {el0 el1 el2 el3 el4 el5 el6} -test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {el0 el1 el2 el3 el4 el5 el6} +test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 .l2 delete 8 20 .l2 get 0 end -} {el0 el1 el2 el3 el4 el5 el6 el7} -test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} { - list [catch {.l get} msg] $msg -} {1 {wrong # args: should be ".l get firstIndex ?lastIndex?"}} -test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} { - list [catch {.l get a b c} msg] $msg -} {1 {wrong # args: should be ".l get firstIndex ?lastIndex?"}} -test listbox-3.44 {ListboxWidgetCmd procedure, "get" option} { - list [catch {.l get 2.4} msg] $msg -} {1 {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number}} -test listbox-3.45 {ListboxWidgetCmd procedure, "get" option} { - list [catch {.l get end bogus} msg] $msg -} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}} -test listbox-3.46 {ListboxWidgetCmd procedure, "get" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {el0 el1 el2 el3 el4 el5 el6 el7} +test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} -body { + .l get +} -returnCodes error -result {wrong # args: should be ".l get firstIndex ?lastIndex?"} +test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} -body { + .l get a b c +} -returnCodes error -result {wrong # args: should be ".l get firstIndex ?lastIndex?"} +test listbox-3.44 {ListboxWidgetCmd procedure, "get" option} -body { + .l get 2.4 +} -returnCodes error -result {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number} +test listbox-3.45 {ListboxWidgetCmd procedure, "get" option} -body { + .l get end bogus +} -returnCodes error -result {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number} +test listbox-3.46 {ListboxWidgetCmd procedure, "get" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 list [.l2 get 0] [.l2 get 3] [.l2 get end] -} {el0 el3 el7} -test listbox-3.47 {ListboxWidgetCmd procedure, "get" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {el0 el3 el7} +test listbox-3.47 {ListboxWidgetCmd procedure, "get" option} -setup { + destroy .l2 +} -body { listbox .l2 list [.l2 get 0] [.l2 get end] -} {{} {}} -test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {{} {}} +test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 el0 el1 el2 "two words" el4 el5 el6 el7 .l2 get 3 end -} {{two words} el4 el5 el6 el7} -test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .l2 +} -result {{two words} el4 el5 el6 el7} +test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} -body { .l get -1 -} {} -test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} { +} -result {} +test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} -body { .l get -2 -1 -} {} -test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} { +} -result {} +test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} -body { .l get -2 3 -} {el0 el1 el2 el3} -test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} { +} -result {el0 el1 el2 el3} +test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} -body { .l get 12 end -} {el12 el13 el14 el15 el16 el17} -test listbox-3.53 {ListboxWidgetCmd procedure, "get" option} { +} -result {el12 el13 el14 el15 el16 el17} +test listbox-3.53 {ListboxWidgetCmd procedure, "get" option} -body { .l get 12 20 -} {el12 el13 el14 el15 el16 el17} -test listbox-3.54 {ListboxWidgetCmd procedure, "get" option} { +} -result {el12 el13 el14 el15 el16 el17} +test listbox-3.54 {ListboxWidgetCmd procedure, "get" option} -body { .l get end -} {el17} -test listbox-3.55 {ListboxWidgetCmd procedure, "get" option} { +} -result {el17} +test listbox-3.55 {ListboxWidgetCmd procedure, "get" option} -body { .l get 30 -} {} -test listbox-3.56 {ListboxWidgetCmd procedure, "get" option} { +} -result {} +test listbox-3.56 {ListboxWidgetCmd procedure, "get" option} -body { .l get 30 35 -} {} -test listbox-3.57 {ListboxWidgetCmd procedure, "index" option} { - list [catch {.l index} msg] $msg -} {1 {wrong # args: should be ".l index index"}} -test listbox-3.58 {ListboxWidgetCmd procedure, "index" option} { - list [catch {.l index a b} msg] $msg -} {1 {wrong # args: should be ".l index index"}} -test listbox-3.59 {ListboxWidgetCmd procedure, "index" option} { - list [catch {.l index @} msg] $msg -} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}} -test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} { +} -result {} +test listbox-3.57 {ListboxWidgetCmd procedure, "index" option} -body { + .l index +} -returnCodes error -result {wrong # args: should be ".l index index"} +test listbox-3.58 {ListboxWidgetCmd procedure, "index" option} -body { + .l index a b +} -returnCodes error -result {wrong # args: should be ".l index index"} +test listbox-3.59 {ListboxWidgetCmd procedure, "index" option} -body { + .l index @ +} -returnCodes error -result {bad listbox index "@": must be active, anchor, end, @x,y, or a number} +test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} -body { .l index 2 -} 2 -test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} { +} -result 2 +test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} -body { .l index -1 -} -1 -test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} { +} -result {-1} +test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} -body { .l index end -} 18 -test listbox-3.63 {ListboxWidgetCmd procedure, "index" option} { +} -result 18 +test listbox-3.63 {ListboxWidgetCmd procedure, "index" option} -body { .l index 34 -} 34 -test listbox-3.64 {ListboxWidgetCmd procedure, "insert" option} { - list [catch {.l insert} msg] $msg -} {1 {wrong # args: should be ".l insert index ?element element ...?"}} -test listbox-3.65 {ListboxWidgetCmd procedure, "insert" option} { - list [catch {.l insert badIndex} msg] $msg -} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}} -test listbox-3.66 {ListboxWidgetCmd procedure, "insert" option} { - catch {destroy .l2} +} -result 34 +test listbox-3.64 {ListboxWidgetCmd procedure, "insert" option} -body { + .l insert +} -returnCodes error -result {wrong # args: should be ".l insert index ?element ...?"} +test listbox-3.65 {ListboxWidgetCmd procedure, "insert" option} -body { + .l insert badIndex +} -returnCodes error -result {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number} +test listbox-3.66 {ListboxWidgetCmd procedure, "insert" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert end a b c d e .l2 insert 3 x y z .l2 get 0 end -} {a b c x y z d e} -test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {a b c x y z d e} +test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert end a b c .l2 insert -1 x .l2 get 0 end -} {x a b c} -test listbox-3.68 {ListboxWidgetCmd procedure, "insert" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {x a b c} +test listbox-3.68 {ListboxWidgetCmd procedure, "insert" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert end a b c .l2 insert end x .l2 get 0 end -} {a b c x} -test listbox-3.69 {ListboxWidgetCmd procedure, "insert" option} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {a b c x} +test listbox-3.69 {ListboxWidgetCmd procedure, "insert" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert end a b c .l2 insert 43 x .l2 get 0 end -} {a b c x} -test listbox-3.70 {ListboxWidgetCmd procedure, "nearest" option} { - list [catch {.l nearest} msg] $msg -} {1 {wrong # args: should be ".l nearest y"}} -test listbox-3.71 {ListboxWidgetCmd procedure, "nearest" option} { - list [catch {.l nearest a b} msg] $msg -} {1 {wrong # args: should be ".l nearest y"}} -test listbox-3.72 {ListboxWidgetCmd procedure, "nearest" option} { - list [catch {.l nearest 20p} msg] $msg -} {1 {expected integer but got "20p"}} -test listbox-3.73 {ListboxWidgetCmd procedure, "nearest" option} { +} -cleanup { + destroy .l2 +} -result {a b c x} +test listbox-3.70 {ListboxWidgetCmd procedure, "nearest" option} -body { + .l nearest +} -returnCodes error -result {wrong # args: should be ".l nearest y"} +test listbox-3.71 {ListboxWidgetCmd procedure, "nearest" option} -body { + .l nearest a b +} -returnCodes error -result {wrong # args: should be ".l nearest y"} +test listbox-3.72 {ListboxWidgetCmd procedure, "nearest" option} -body { + .l nearest 20p +} -returnCodes error -result {expected integer but got "20p"} +test listbox-3.73 {ListboxWidgetCmd procedure, "nearest" option} -body { .l yview 3 .l nearest 1000 -} {7} -test listbox-3.74 {ListboxWidgetCmd procedure, "scan" option} { - list [catch {.l scan a b} msg] $msg -} {1 {wrong # args: should be ".l scan mark|dragto x y"}} -test listbox-3.75 {ListboxWidgetCmd procedure, "scan" option} { - list [catch {.l scan a b c d} msg] $msg -} {1 {wrong # args: should be ".l scan mark|dragto x y"}} -test listbox-3.76 {ListboxWidgetCmd procedure, "scan" option} { - list [catch {.l scan foo bogus 2} msg] $msg -} {1 {expected integer but got "bogus"}} -test listbox-3.77 {ListboxWidgetCmd procedure, "scan" option} { - list [catch {.l scan foo 2 2.3} msg] $msg -} {1 {expected integer but got "2.3"}} -test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} {fonts} { - catch {destroy .t} +} -result {7} +test listbox-3.74 {ListboxWidgetCmd procedure, "scan" option} -body { + .l scan a b +} -returnCodes error -result {wrong # args: should be ".l scan mark|dragto x y"} +test listbox-3.75 {ListboxWidgetCmd procedure, "scan" option} -body { + .l scan a b c d +} -returnCodes error -result {wrong # args: should be ".l scan mark|dragto x y"} +test listbox-3.76 {ListboxWidgetCmd procedure, "scan" option} -body { + .l scan foo bogus 2 +} -returnCodes error -result {expected integer but got "bogus"} +test listbox-3.77 {ListboxWidgetCmd procedure, "scan" option} -body { + .l scan foo 2 2.3 +} -returnCodes error -result {expected integer but got "2.3"} +test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} -constraints { + fonts +} -setup { + destroy .t +} -body { toplevel .t wm geom .t +0+0 listbox .t.l -width 10 -height 5 @@ -475,312 +743,461 @@ test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} {fonts} { .t.l scan dragto 90 137 update list [format {%.6g %.6g} {*}[.t.l xview]] [format {%.6g %.6g} {*}[.t.l yview]] -} {{0.249364 0.427481} {0.0714286 0.428571}} -test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} { - list [catch {.l scan foo 2 4} msg] $msg -} {1 {bad option "foo": must be mark or dragto}} -test listbox-3.80 {ListboxWidgetCmd procedure, "see" option} { - list [catch {.l see} msg] $msg -} {1 {wrong # args: should be ".l see index"}} -test listbox-3.81 {ListboxWidgetCmd procedure, "see" option} { - list [catch {.l see a b} msg] $msg -} {1 {wrong # args: should be ".l see index"}} -test listbox-3.82 {ListboxWidgetCmd procedure, "see" option} { - list [catch {.l see gorp} msg] $msg -} {1 {bad listbox index "gorp": must be active, anchor, end, @x,y, or a number}} -test listbox-3.83 {ListboxWidgetCmd procedure, "see" option} { +} -cleanup { + destroy .t +} -result {{0.249364 0.427481} {0.0714286 0.428571}} +test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} -body { + .l scan foo 2 4 +} -returnCodes error -result {bad option "foo": must be mark or dragto} +test listbox-3.80 {ListboxWidgetCmd procedure, "see" option} -body { + .l see +} -returnCodes error -result {wrong # args: should be ".l see index"} +test listbox-3.81 {ListboxWidgetCmd procedure, "see" option} -body { + .l see a b +} -returnCodes error -result {wrong # args: should be ".l see index"} +test listbox-3.82 {ListboxWidgetCmd procedure, "see" option} -body { + .l see gorp +} -returnCodes error -result {bad listbox index "gorp": must be active, anchor, end, @x,y, or a number} +test listbox-3.83 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 7 .l index @0,0 -} {7} -test listbox-3.84 {ListboxWidgetCmd procedure, "see" option} { +} -result {7} +test listbox-3.84 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 11 .l index @0,0 -} {7} -test listbox-3.85 {ListboxWidgetCmd procedure, "see" option} { +} -result {7} +test listbox-3.85 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 6 .l index @0,0 -} {6} -test listbox-3.86 {ListboxWidgetCmd procedure, "see" option} { +} -result {6} +test listbox-3.86 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 5 .l index @0,0 -} {3} -test listbox-3.87 {ListboxWidgetCmd procedure, "see" option} { +} -result {3} +test listbox-3.87 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 12 .l index @0,0 -} {8} -test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} { +} -result {8} +test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 13 .l index @0,0 -} {11} -test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} { +} -result {11} +test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see -1 .l index @0,0 -} {0} -test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} { +} -result {0} +test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see end .l index @0,0 -} {13} -test listbox-3.91 {ListboxWidgetCmd procedure, "see" option} { +} -result {13} +test listbox-3.91 {ListboxWidgetCmd procedure, "see" option} -body { .l yview 7 .l see 322 .l index @0,0 -} {13} -test listbox-3.92 {ListboxWidgetCmd procedure, "see" option, partial last line} { +} -result {13} +test listbox-3.92 {ListboxWidgetCmd procedure, "see" option, partial last line} -body { mkPartial .partial.l see 4 .partial.l index @0,0 -} {1} -test listbox-3.93 {ListboxWidgetCmd procedure, "selection" option} { - list [catch {.l select a} msg] $msg -} {1 {wrong # args: should be ".l selection option index ?index?"}} -test listbox-3.94 {ListboxWidgetCmd procedure, "selection" option} { - list [catch {.l select a b c d} msg] $msg -} {1 {wrong # args: should be ".l selection option index ?index?"}} -test listbox-3.95 {ListboxWidgetCmd procedure, "selection" option} { - list [catch {.l selection a bogus} msg] $msg -} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}} -test listbox-3.96 {ListboxWidgetCmd procedure, "selection" option} { - list [catch {.l selection a 0 lousy} msg] $msg -} {1 {bad listbox index "lousy": must be active, anchor, end, @x,y, or a number}} -test listbox-3.97 {ListboxWidgetCmd procedure, "selection" option} { - list [catch {.l selection anchor 0 0} msg] $msg -} {1 {wrong # args: should be ".l selection anchor index"}} -test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} { +} -result {1} +test listbox-3.93 {ListboxWidgetCmd procedure, "selection" option} -body { + .l select a +} -returnCodes error -result {wrong # args: should be ".l selection option index ?index?"} +test listbox-3.94 {ListboxWidgetCmd procedure, "selection" option} -body { + .l select a b c d +} -returnCodes error -result {wrong # args: should be ".l selection option index ?index?"} +test listbox-3.95 {ListboxWidgetCmd procedure, "selection" option} -body { + .l selection a bogus +} -returnCodes error -result {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number} +test listbox-3.96 {ListboxWidgetCmd procedure, "selection" option} -body { + .l selection a 0 lousy +} -returnCodes error -result {bad listbox index "lousy": must be active, anchor, end, @x,y, or a number} +test listbox-3.97 {ListboxWidgetCmd procedure, "selection" option} -body { + .l selection anchor 0 0 +} -returnCodes error -result {wrong # args: should be ".l selection anchor index"} +test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} -body { list [.l selection anchor 5; .l index anchor] \ [.l selection anchor 0; .l index anchor] -} {5 0} -test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} { +} -result {5 0} +test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection anchor -1 .l index anchor -} {0} -test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} { +} -result {0} +test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection anchor end .l index anchor -} {17} -test listbox-3.101 {ListboxWidgetCmd procedure, "selection" option} { +} -result {17} +test listbox-3.101 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection anchor 44 .l index anchor -} {17} -test listbox-3.102 {ListboxWidgetCmd procedure, "selection" option} { +} -result {17} +test listbox-3.102 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection clear 0 end .l selection set 2 8 .l selection clear 3 4 .l curselection -} {2 5 6 7 8} -test listbox-3.103 {ListboxWidgetCmd procedure, "selection" option} { - list [catch {.l selection includes 0 0} msg] $msg -} {1 {wrong # args: should be ".l selection includes index"}} -test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} { +} -result {2 5 6 7 8} +test listbox-3.103 {ListboxWidgetCmd procedure, "selection" option} -body { + .l selection includes 0 0 +} -returnCodes error -result {wrong # args: should be ".l selection includes index"} +test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection clear 0 end .l selection set 2 8 .l selection clear 4 list [.l selection includes 3] [.l selection includes 4] \ [.l selection includes 5] -} {1 0 1} -test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} { +} -result {1 0 1} +test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection set 0 end .l selection includes -1 -} {0} -test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} { +} -result {0} +test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection clear 0 end .l selection set end .l selection includes end -} {1} -test listbox-3.107 {ListboxWidgetCmd procedure, "selection" option} { +} -result {1} +test listbox-3.107 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection set 0 end .l selection includes 44 -} {0} -test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} { - catch {destroy .l2} +} -result {0} +test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} -setup { + destroy .l2 +} -body { listbox .l2 .l2 selection includes 0 -} {0} -test listbox-3.109 {ListboxWidgetCmd procedure, "selection" option} { +} -cleanup { + destroy .l2 +} -result {0} +test listbox-3.109 {ListboxWidgetCmd procedure, "selection" option} -body { .l selection clear 0 end .l selection set 2 .l selection set 5 7 .l curselection -} {2 5 6 7} -test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} { +} -result {2 5 6 7} +test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} -body { + .l selection clear 0 end + .l selection set 2 + .l selection set 5 7 .l selection set 5 7 .l curselection -} {2 5 6 7} -test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} { - list [catch {.l selection badOption 0 0} msg] $msg -} {1 {bad option "badOption": must be anchor, clear, includes, or set}} -test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} { - list [catch {.l size a} msg] $msg -} {1 {wrong # args: should be ".l size"}} -test listbox-3.113 {ListboxWidgetCmd procedure, "size" option} { +} -result {2 5 6 7} +test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} -body { + .l selection badOption 0 0 +} -returnCodes error -result {bad option "badOption": must be anchor, clear, includes, or set} +test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} -body { + .l size a +} -returnCodes error -result {wrong # args: should be ".l size"} +test listbox-3.113 {ListboxWidgetCmd procedure, "size" option} -body { .l size -} {18} -test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} { - catch {destroy .l2} +} -result {18} +test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} -setup { + destroy .l2 +} -body { listbox .l2 update format {%.6g %.6g} {*}[.l2 xview] -} {0 1} -test listbox-3.115 {ListboxWidgetCmd procedure, "xview" option} { - catch {destroy .l} +} -cleanup { + destroy .l2 +} -result {0 1} +test listbox-3.115 {ListboxWidgetCmd procedure, "xview" option} -setup { + destroy .l2 +} -body { + listbox .l2 -width 10 -height 5 -font $fixed + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + pack .l2 + update + format {%.6g %.6g} {*}[.l2 xview] +} -cleanup { + destroy .l2 +} -result {0 1} + +test listbox-3.116 {ListboxWidgetCmd procedure, "xview" option} -constraints { + fonts +} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 + update +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789" + .l2 xview 4 + format {%.6g %.6g} {*}[.l2 xview] +} -cleanup { + destroy .l2 +} -result {0.08 0.28} +test listbox-3.117 {ListboxWidgetCmd procedure, "xview" option} -body { + .l xview foo +} -returnCodes error -result {expected integer but got "foo"} +test listbox-3.118 {ListboxWidgetCmd procedure, "xview" option} -body { + .l xview zoom a b +} -returnCodes error -result {unknown option "zoom": must be moveto or scroll} +test listbox-3.119 {ListboxWidgetCmd procedure, "xview" option} -constraints { + fonts +} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 + update +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789" + .l xview 0 + .l2 xview moveto .4 + update + format {%.6g %.6g} {*}[.l2 xview] +} -cleanup { + destroy .l2 +} -result {0.4 0.6} +test listbox-3.120 {ListboxWidgetCmd procedure, "xview" option} -constraints { + fonts +} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 + update +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789" + .l2 xview 0 + .l2 xview scroll 2 units + update + format {%.6g %.6g} {*}[.l2 xview] +} -cleanup { + destroy .l2 +} -result {0.04 0.24} +test listbox-3.121 {ListboxWidgetCmd procedure, "xview" option} -constraints { + fonts +} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 + update +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789" + .l2 xview 30 + .l2 xview scroll -1 pages + update + format {%.6g %.6g} {*}[.l2 xview] +} -cleanup { + destroy .l2 +} -result {0.44 0.64} +test listbox-3.122 {ListboxWidgetCmd procedure, "xview" option} -constraints { + fonts +} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 + update +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789" + .l2 configure -width 1 + update + .l2 xview 30 + .l2 xview scroll -4 pages + update + format {%.6g %.6g} {*}[.l2 xview] +} -cleanup { + destroy .l2 +} -result {0.52 0.54} +test listbox-3.123 {ListboxWidgetCmd procedure, "yview" option} -setup { + destroy .l2 +} -body { + listbox .l2 + pack .l2 + update + format {%.6g %.6g} {*}[.l2 yview] +} -cleanup { + destroy .l2 +} -result {0 1} +test listbox-3.124 {ListboxWidgetCmd procedure, "yview" option} -setup { + destroy .l2 +} -body { + listbox .l2 + .l2 insert 0 el1 + pack .l2 + update + format {%.6g %.6g} {*}[.l2 yview] +} -cleanup { + destroy .l2 +} -result {0 1} + +test listbox-3.125 {ListboxWidgetCmd procedure, "yview" option} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 + update +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 yview 4 + update + format {%.6g %.6g} {*}[.l2 yview] +} -cleanup { + destroy .l2 +} -result {0.2 0.45} +test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last line} -setup { + destroy .l listbox .l -width 10 -height 5 -font $fixed - .l insert 0 a b c d e f g h i j k l m n o p q r s t pack .l update - format {%.6g %.6g} {*}[.l xview] -} {0 1} -catch {destroy .l} -listbox .l -width 10 -height 5 -font $fixed -.l insert 0 a b c d e f g h i j k l m n o p q r s t -.l insert 1 "0123456789a123456789b123456789c123456789d123456789" +} -body { + .l insert 0 a b c d e f g h i j k l m n o p q r s t + mkPartial + format {%.6g %.6g} {*}[.partial.l yview] +} -cleanup { + destroy .l +} -result {0 0.266667} + +# Listbox used in 3.127 -3.137 tests +destroy .l +listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2 pack .l +.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \ + el15 el16 el17 update -test listbox-3.116 {ListboxWidgetCmd procedure, "xview" option} {fonts} { - .l xview 4 - format {%.6g %.6g} {*}[.l xview] -} {0.08 0.28} -test listbox-3.117 {ListboxWidgetCmd procedure, "xview" option} { - list [catch {.l xview foo} msg] $msg -} {1 {expected integer but got "foo"}} -test listbox-3.118 {ListboxWidgetCmd procedure, "xview" option} { - list [catch {.l xview zoom a b} msg] $msg -} {1 {unknown option "zoom": must be moveto or scroll}} -test listbox-3.119 {ListboxWidgetCmd procedure, "xview" option} {fonts} { - .l xview 0 - .l xview moveto .4 +test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} -body { + .l yview foo +} -returnCodes error -result {bad listbox index "foo": must be active, anchor, end, @x,y, or a number} +test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} -body { + .l yview foo a b +} -returnCodes error -result {unknown option "foo": must be moveto or scroll} +test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 update - format {%.6g %.6g} {*}[.l xview] -} {0.4 0.6} -test listbox-3.120 {ListboxWidgetCmd procedure, "xview" option} {fonts} { - .l xview 0 - .l xview scroll 2 units - update - format {%.6g %.6g} {*}[.l xview] -} {0.04 0.24} -test listbox-3.121 {ListboxWidgetCmd procedure, "xview" option} {fonts} { - .l xview 30 - .l xview scroll -1 pages - update - format {%.6g %.6g} {*}[.l xview] -} {0.44 0.64} -test listbox-3.122 {ListboxWidgetCmd procedure, "xview" option} {fonts} { - .l configure -width 1 - update - .l xview 30 - .l xview scroll -4 pages - update - format {%.6g %.6g} {*}[.l xview] -} {0.52 0.54} -test listbox-3.123 {ListboxWidgetCmd procedure, "yview" option} { - catch {destroy .l} - listbox .l - pack .l +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 yview 0 + .l2 yview moveto .31 + format {%.6g %.6g} {*}[.l2 yview] +} -cleanup { + destroy .l2 +} -result {0.3 0.55} +test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 update - format {%.6g %.6g} {*}[.l yview] -} {0 1} -test listbox-3.124 {ListboxWidgetCmd procedure, "yview" option} { - catch {destroy .l} - listbox .l - .l insert 0 el1 - pack .l +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 yview 2 + .l2 yview scroll 2 pages + format {%.6g %.6g} {*}[.l2 yview] +} -cleanup { + destroy .l2 +} -result {0.4 0.65} +test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 update - format {%.6g %.6g} {*}[.l yview] -} {0 1} -catch {destroy .l} -listbox .l -width 10 -height 5 -font $fixed -.l insert 0 a b c d e f g h i j k l m n o p q r s t -pack .l -update -test listbox-3.125 {ListboxWidgetCmd procedure, "yview" option} { - .l yview 4 +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 yview 10 + .l2 yview scroll -3 units + format {%.6g %.6g} {*}[.l2 yview] +} -cleanup { + destroy .l2 +} -result {0.35 0.6} +test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} -setup { + destroy .l2 + listbox .l2 -width 10 -height 5 -font $fixed + pack .l2 update - format {%.6g %.6g} {*}[.l yview] -} {0.2 0.45} -test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last line} { - mkPartial - format {%.6g %.6g} {*}[.partial.l yview] -} {0 0.266667} -test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} { - list [catch {.l yview foo} msg] $msg -} {1 {bad listbox index "foo": must be active, anchor, end, @x,y, or a number}} -test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} { - list [catch {.l yview foo a b} msg] $msg -} {1 {unknown option "foo": must be moveto or scroll}} -test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} { - .l yview 0 - .l yview moveto .31 - format {%.6g %.6g} {*}[.l yview] -} {0.3 0.55} -test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} { - .l yview 2 - .l yview scroll 2 pages - format {%.6g %.6g} {*}[.l yview] -} {0.4 0.65} -test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} { - .l yview 10 - .l yview scroll -3 units - format {%.6g %.6g} {*}[.l yview] -} {0.35 0.6} -test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} { - .l configure -height 2 - update - .l yview 15 - .l yview scroll -4 pages - format {%.6g %.6g} {*}[.l yview] -} {0.55 0.65} -test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} { - list [catch {.l whoknows} msg] $msg -} {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} -test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} { - list [catch {.l c} msg] $msg -} {1 {ambiguous option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} -test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} { - list [catch {.l in} msg] $msg -} {1 {ambiguous option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} -test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} { - list [catch {.l s} msg] $msg -} {1 {ambiguous option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} -test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} { - list [catch {.l se} msg] $msg -} {1 {ambiguous option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} +} -body { + .l2 insert 0 a b c d e f g h i j k l m n o p q r s t + .l2 configure -height 2 + update + .l2 yview 15 + .l2 yview scroll -4 pages + format {%.6g %.6g} {*}[.l2 yview] +} -cleanup { + destroy .l2 +} -result {0.55 0.65} +test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} -body { + .l whoknows +} -returnCodes error -result {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} +test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} -body { + .l c +} -returnCodes error -result {ambiguous option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} +test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} -body { + .l in +} -returnCodes error -result {ambiguous option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} +test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} -body { + .l s +} -returnCodes error -result {ambiguous option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} +test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} -body { + .l se +} -returnCodes error -result {ambiguous option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview} # No tests for DestroyListbox: I can't come up with anything to test # in this procedure. -test listbox-4.1 {ConfigureListbox procedure} {fonts} { - catch {destroy .l} + +test listbox-4.1 {ConfigureListbox procedure} -constraints { + fonts +} -setup { + deleteWindows + destroy .l listbox .l -setgrid 1 -width 25 -height 15 pack .l update +} -body { set x [getsize .] .l configure -setgrid 0 update list $x [getsize .] -} {25x15 185x263} +} -cleanup { + deleteWindows +} -result {25x15 185x263} resetGridInfo -test listbox-4.2 {ConfigureListbox procedure} { +test listbox-4.2 {ConfigureListbox procedure} -setup { + deleteWindows + destroy .l + listbox .l -setgrid 1 -width 25 -height 15 + pack .l + update +} -body { .l configure -highlightthickness -3 .l cget -highlightthickness -} {0} -test listbox-4.3 {ConfigureListbox procedure} { +} -cleanup { + deleteWindows +} -result {0} +test listbox-4.3 {ConfigureListbox procedure} -setup { + deleteWindows + destroy .l + listbox .l -setgrid 1 -width 25 -height 15 + pack .l + update +} -body { .l configure -exportselection 0 .l delete 0 end .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 .l selection set 3 5 .l configure -exportselection 1 selection get -} {el3 +} -cleanup { + deleteWindows +} -result {el3 el4 el5} -test listbox-4.4 {ConfigureListbox procedure} { - catch {destroy .e} +test listbox-4.4 {ConfigureListbox procedure} -setup { + deleteWindows + listbox .l -setgrid 1 -width 25 -height 15 + pack .l + update +} -body { entry .e .e insert 0 abc .e select from 0 @@ -792,8 +1209,15 @@ test listbox-4.4 {ConfigureListbox procedure} { .l selection clear 3 5 .l configure -exportselection 1 list [selection own] [selection get] -} {.e ab} -test listbox-4.5 {-exportselection option} { +} -cleanup { + deleteWindows +} -result {.e ab} +test listbox-4.5 {-exportselection option} -setup { + deleteWindows + listbox .l -setgrid 1 -width 25 -height 15 + pack .l + update +} -body { selection clear . .l configure -exportselection 1 .l delete 0 end @@ -809,11 +1233,16 @@ test listbox-4.5 {-exportselection option} { lappend x [catch {selection get} msg] $msg [.l curselection] .l config -exportselection 1 lappend x [catch {selection get} msg] $msg [.l curselection] -} {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1 +} -cleanup { + deleteWindows +} -result {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1 el2 el3} {1 2 3}} -test listbox-4.6 {ConfigureListbox procedure} {fonts} { - catch {destroy .l} +test listbox-4.6 {ConfigureListbox procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { # The following code (reset geometry, withdraw, etc.) is necessary # to reset the state of some window managers like olvwm under @@ -823,246 +1252,307 @@ test listbox-4.6 {ConfigureListbox procedure} {fonts} { update wm geom . {} wm withdraw . - listbox .l -font $fixed -width 15 -height 20 - pack .l + listbox .l2 -font $fixed -width 15 -height 20 + pack .l2 update wm deiconify . set x [getsize .] - .l configure -setgrid 1 + .l2 configure -setgrid 1 update list $x [getsize .] -} {115x328 15x20} -test listbox-4.7 {ConfigureListbox procedure} { - catch {destroy .l} +} -cleanup { + deleteWindows +} -result {115x328 15x20} +test listbox-4.7 {ConfigureListbox procedure} -setup { + deleteWindows +} -body { wm withdraw . - listbox .l -font $fixed -width 30 -height 20 -setgrid 1 + listbox .l2 -font $fixed -width 30 -height 20 -setgrid 1 wm geom . +25+25 - pack .l + pack .l2 update wm deiconify . set result [getsize .] wm geom . 26x15 update lappend result [getsize .] - .l configure -setgrid 1 + .l2 configure -setgrid 1 update lappend result [getsize .] -} {30x20 26x15 26x15} -wm geom . {} -catch {destroy .l} +} -cleanup { + deleteWindows + wm geom . {} +} -result {30x20 26x15 26x15} + resetGridInfo -test listbox-4.8 {ConfigureListbox procedure} { - catch {destroy .l} - listbox .l -width 15 -height 20 -xscrollcommand "record x" \ +test listbox-4.8 {ConfigureListbox procedure} -setup { + destroy .l2 +} -body { + listbox .l2 -width 15 -height 20 -xscrollcommand "record x" \ -yscrollcommand "record y" - pack .l + pack .l2 update - .l configure -fg black + .l2 configure -fg black set log {} update set log -} {{y 0 1} {x 0 1}} -test listbox-4.9 {ConfigureListbox procedure, -listvar} { - catch {destroy .l} +} -cleanup { + destroy .l2 +} -result {{y 0 1} {x 0 1}} +test listbox-4.9 {ConfigureListbox procedure, -listvar} -setup { + destroy .l2 +} -body { set x [list a b c d] - listbox .l -listvar x - .l get 0 end -} [list a b c d] -test listbox-4.10 {ConfigureListbox, no listvar -> existing listvar} { - catch {destroy .l} + listbox .l2 -listvar x + .l2 get 0 end +} -cleanup { + destroy .l2 +} -result [list a b c d] +test listbox-4.10 {ConfigureListbox, no listvar -> existing listvar} -setup { + destroy .l2 +} -body { set x [list a b c d] - listbox .l - .l insert end 1 2 3 4 - .l configure -listvar x - .l get 0 end -} [list a b c d] -test listbox-4.11 {ConfigureListbox procedure, listvar -> no listvar} { - catch {destroy .l} + listbox .l2 + .l2 insert end 1 2 3 4 + .l2 configure -listvar x + .l2 get 0 end +} -cleanup { + destroy .l2 +} -result [list a b c d] +test listbox-4.11 {ConfigureListbox procedure, listvar -> no listvar} -setup { + destroy .l2 +} -body { set x [list a b c d] - listbox .l -listvar x - .l configure -listvar {} - .l insert end 1 2 3 4 - list $x [.l get 0 end] -} [list [list a b c d] [list a b c d 1 2 3 4]] -test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} { - catch {destroy .l} + listbox .l2 -listvar x + .l2 configure -listvar {} + .l2 insert end 1 2 3 4 + list $x [.l2 get 0 end] +} -cleanup { + destroy .l2 +} -result [list [list a b c d] [list a b c d 1 2 3 4]] +test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} -setup { + destroy .l2 +} -body { set x [list a b c d] set y [list 1 2 3 4] - listbox .l - .l configure -listvar x - .l configure -listvar y - .l insert end 5 6 7 8 + listbox .l2 + .l2 configure -listvar x + .l2 configure -listvar y + .l2 insert end 5 6 7 8 list $x $y -} [list [list a b c d] [list 1 2 3 4 5 6 7 8]] -test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} { - catch {destroy .l} +} -cleanup { + destroy .l2 +} -result [list [list a b c d] [list 1 2 3 4 5 6 7 8]] +test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} -setup { + destroy .l2 +} -body { catch {unset x} - listbox .l - .l insert end a b c d - .l configure -listvar x + listbox .l2 + .l2 insert end a b c d + .l2 configure -listvar x set x -} [list a b c d] -test listbox-4.14 {ConfigureListbox, non-existant listvar} { - catch {destroy .l} +} -cleanup { + destroy .l2 +} -result [list a b c d] +test listbox-4.14 {ConfigureListbox, non-existant listvar} -setup { + destroy .l2 +} -body { catch {unset x} - listbox .l -listvar x + listbox .l2 -listvar x list [info exists x] $x -} [list 1 {}] -test listbox-4.15 {ConfigureListbox, listvar -> non-existant listvar} { - catch {destroy .l} +} -cleanup { + destroy .l2 +} -result [list 1 {}] +test listbox-4.15 {ConfigureListbox, listvar -> non-existant listvar} -setup { + destroy .l2 +} -body { catch {unset y} set x [list a b c d] - listbox .l -listvar x - .l configure -listvar y + listbox .l2 -listvar x + .l2 configure -listvar y list [info exists y] $y -} [list 1 [list a b c d]] -test listbox-4.16 {ConfigureListbox, listvar -> same listvar} { - catch {destroy .l} +} -cleanup { + destroy .l2 +} -result [list 1 [list a b c d]] +test listbox-4.16 {ConfigureListbox, listvar -> same listvar} -setup { + destroy .l2 +} -body { set x [list a b c d] - listbox .l -listvar x - .l configure -listvar x + listbox .l2 -listvar x + .l2 configure -listvar x set x -} [list a b c d] -test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} { - catch {destroy .l} - listbox .l - .l insert end a b c d - .l configure -listvar {} - .l get 0 end -} [list a b c d] -test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} { - catch {destroy .l} - listbox .l - .l insert end a b c d +} -cleanup { + destroy .l2 +} -result [list a b c d] +test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} -setup { + destroy .l2 +} -body { + listbox .l2 + .l2 insert end a b c d + .l2 configure -listvar {} + .l2 get 0 end +} -cleanup { + destroy .l2 +} -result [list a b c d] +test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} -setup { + destroy .l2 +} -body { + listbox .l2 + .l2 insert end a b c d set x "this is a \" bad list" - catch {.l configure -listvar x} result - list [.l get 0 end] [.l cget -listvar] $result -} [list [list a b c d] {} \ + catch {.l2 configure -listvar x} result + list [.l2 get 0 end] [.l2 cget -listvar] $result +} -cleanup { + destroy .l2 +} -result [list [list a b c d] {} \ "unmatched open quote in list: invalid -listvariable value"] -test listbox-4.19 {ConfigureListbox, no listvar -> bad non-existent listvar} { - catch {destroy .l} +test listbox-4.19 {ConfigureListbox, no listvar -> bad non-existent listvar} -setup { + destroy .l2 +} -body { unset -nocomplain ::foo - listbox .l -listvar foo - .l insert end a b c d - catch {.l configure -listvar ::zoo::bar::foo} result - list [.l get 0 end] [.l cget -listvar] $foo $result -} [list [list a b c d] foo [list a b c d] \ + listbox .l2 -listvar foo + .l2 insert end a b c d + catch {.l2 configure -listvar ::zoo::bar::foo} result + list [.l2 get 0 end] [.l2 cget -listvar] $foo $result +} -cleanup { + destroy .l2 +} -result [list [list a b c d] foo [list a b c d] \ {can't set "::zoo::bar::foo": parent namespace doesn't exist}] + # No tests for DisplayListbox: I don't know how to test this procedure. -test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} { - catch {destroy .l} +test listbox-5.1 {ListboxComputeGeometry procedure} -constraints { + fonts +} -setup { + destroy .l +} -body { listbox .l -font $fixed -width 15 -height 20 pack .l list [winfo reqwidth .l] [winfo reqheight .l] -} {115 328} -test listbox-5.2 {ListboxComputeGeometry procedure} {fonts} { - catch {destroy .l} +} -result {115 328} +test listbox-5.2 {ListboxComputeGeometry procedure} -constraints { + fonts +} -setup { + destroy .l +} -body { listbox .l -font $fixed -width 0 -height 10 pack .l update list [winfo reqwidth .l] [winfo reqheight .l] -} {17 168} -test listbox-5.3 {ListboxComputeGeometry procedure} {fonts} { - catch {destroy .l} +} -result {17 168} +test listbox-5.3 {ListboxComputeGeometry procedure} -constraints { + fonts +} -setup { + destroy .l +} -body { listbox .l -font $fixed -width 0 -height 10 -bd 3 .l insert 0 Short "Really much longer" Longer pack .l update list [winfo reqwidth .l] [winfo reqheight .l] -} {138 170} -test listbox-5.4 {ListboxComputeGeometry procedure} {fonts} { - catch {destroy .l} +} -result {138 170} +test listbox-5.4 {ListboxComputeGeometry procedure} -constraints { + fonts +} -setup { + destroy .l +} -body { listbox .l -font $fixed -width 10 -height 0 pack .l update list [winfo reqwidth .l] [winfo reqheight .l] -} {80 24} -test listbox-5.5 {ListboxComputeGeometry procedure} {fonts} { - catch {destroy .l} +} -result {80 24} +test listbox-5.5 {ListboxComputeGeometry procedure} -constraints { + fonts +} -setup { + destroy .l +} -body { listbox .l -font $fixed -width 10 -height 0 -highlightthickness 0 .l insert 0 Short "Really much longer" Longer pack .l update list [winfo reqwidth .l] [winfo reqheight .l] -} {76 52} -test listbox-5.6 {ListboxComputeGeometry procedure} { +} -result {76 52} +test listbox-5.6 {ListboxComputeGeometry procedure} -setup { + destroy .l +} -body { # If "0" in selected font had 0 width, caused divide-by-zero error. - catch {destroy .l} pack [listbox .l -font {{open look glyph}}] update -} {} +} -cleanup { + destroy .l +} -result {} -catch {destroy .l} +# Listbox used in 6.*, 7.* tests +destroy .l listbox .l -height 2 -xscrollcommand "record x" -yscrollcommand "record y" pack .l update -test listbox-6.1 {InsertEls procedure} { +test listbox-6.1 {InsertEls procedure} -body { .l delete 0 end .l insert end a b c d .l insert 5 x y z .l insert 2 A .l insert 0 q r s .l get 0 end -} {q r s a b A c d x y z} -test listbox-6.2 {InsertEls procedure} { +} -result {q r s a b A c d x y z} +test listbox-6.2 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l insert 2 A B .l index anchor -} {4} -test listbox-6.3 {InsertEls procedure} { +} -result {4} +test listbox-6.3 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l insert 3 A B .l index anchor -} {2} -test listbox-6.4 {InsertEls procedure} { +} -result {2} +test listbox-6.4 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l insert 2 A B .l index @0,0 -} {5} -test listbox-6.5 {InsertEls procedure} { +} -result {5} +test listbox-6.5 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l insert 3 A B .l index @0,0 -} {3} -test listbox-6.6 {InsertEls procedure} { +} -result {3} +test listbox-6.6 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 5 .l insert 5 A B .l index active -} {7} -test listbox-6.7 {InsertEls procedure} { +} -result {7} +test listbox-6.7 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 5 .l insert 6 A B .l index active -} {5} -test listbox-6.8 {InsertEls procedure} { +} -result {5} +test listbox-6.8 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b c .l index active -} {2} -test listbox-6.9 {InsertEls procedure} { +} -result {2} +test listbox-6.9 {InsertEls procedure} -body { .l delete 0 end .l insert 0 .l index active -} {0} -test listbox-6.10 {InsertEls procedure} { +} -result {0} +test listbox-6.10 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b "two words" c d e f g h i j update @@ -1070,8 +1560,8 @@ test listbox-6.10 {InsertEls procedure} { .l insert 0 word update set log -} {{y 0 0.166667}} -test listbox-6.11 {InsertEls procedure} { +} -result {{y 0 0.166667}} +test listbox-6.11 {InsertEls procedure} -body { .l delete 0 end .l insert 0 a b "two words" c d e f g h i j update @@ -1079,9 +1569,12 @@ test listbox-6.11 {InsertEls procedure} { .l insert 0 "much longer entry" update set log -} {{y 0 0.166667} {x 0 1}} -test listbox-6.12 {InsertEls procedure} {fonts} { - catch {destroy .l2} +} -result {{y 0 0.166667} {x 0 1}} +test listbox-6.12 {InsertEls procedure} -constraints { + fonts +} -setup { + destroy .l2 +} -body { listbox .l2 -width 0 -height 0 pack .l2 -side top .l2 insert 0 a b "two words" c d @@ -1089,23 +1582,31 @@ test listbox-6.12 {InsertEls procedure} {fonts} { lappend x [winfo reqwidth .l2] [winfo reqheight .l2] .l2 insert 0 "much longer entry" lappend x [winfo reqwidth .l2] [winfo reqheight .l2] -} {80 93 122 110} -test listbox-6.13 {InsertEls procedure, check -listvar update} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result {80 93 122 110} +test listbox-6.13 {InsertEls procedure, check -listvar update} -setup { + destroy .l2 +} -body { set x [list a b c d] listbox .l2 -listvar x .l2 insert 0 1 2 3 4 set x -} [list 1 2 3 4 a b c d] -test listbox-6.14 {InsertEls procedure, check selection update} { - catch {destroy .l2} +} -cleanup { + destroy .l2 +} -result [list 1 2 3 4 a b c d] +test listbox-6.14 {InsertEls procedure, check selection update} -setup { + destroy .l2 +} -body { listbox .l2 .l2 insert 0 0 1 2 3 4 .l2 selection set 2 4 .l2 insert 0 a .l2 curselection -} [list 3 4 5] -test listbox-6.15 {InsertEls procedure, lost namespaced listvar} { +} -cleanup { + destroy .l2 +} -result [list 3 4 5] +test listbox-6.15 {InsertEls procedure, lost namespaced listvar} -body { destroy .l2 namespace eval test { variable foo {a b} } listbox .l2 -listvar ::test::foo @@ -1115,137 +1616,139 @@ test listbox-6.15 {InsertEls procedure, lost namespaced listvar} { .l2 insert end e f catch {set ::test::foo} result list [.l2 get 0 end] [.l2 cget -listvar] $result -} [list [list a b c e f] ::test::foo \ +} -cleanup { + destroy .l2 +} -result [list [list a b c e f] ::test::foo \ {can't read "::test::foo": no such variable}] -test listbox-7.1 {DeleteEls procedure} { +test listbox-7.1 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection set 1 6 .l delete 4 3 list [.l size] [selection get] -} {10 {b +} -result {10 {b c d e f g}} -test listbox-7.2 {DeleteEls procedure} { +test listbox-7.2 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection set 3 6 .l delete 4 4 list [.l size] [.l get 4] [.l curselection] -} {9 f {3 4 5}} -test listbox-7.3 {DeleteEls procedure} { +} -result {9 f {3 4 5}} +test listbox-7.3 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l delete 0 3 list [.l size] [.l get 0] [.l get 1] -} {6 e f} -test listbox-7.4 {DeleteEls procedure} { +} -result {6 e f} +test listbox-7.4 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l delete 8 1000 list [.l size] [.l get 7] -} {8 h} -test listbox-7.5 {DeleteEls procedure} { +} -result {8 h} +test listbox-7.5 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l delete 0 1 .l index anchor -} {0} -test listbox-7.6 {DeleteEls procedure} { +} -result {0} +test listbox-7.6 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 2 .l delete 2 .l index anchor -} {2} -test listbox-7.7 {DeleteEls procedure} { +} -result {2} +test listbox-7.7 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 4 .l delete 2 5 .l index anchor -} {2} -test listbox-7.8 {DeleteEls procedure} { +} -result {2} +test listbox-7.8 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l selection anchor 3 .l delete 4 5 .l index anchor -} {3} -test listbox-7.9 {DeleteEls procedure} { +} -result {3} +test listbox-7.9 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l delete 1 2 .l index @0,0 -} {1} -test listbox-7.10 {DeleteEls procedure} { +} -result {1} +test listbox-7.10 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l delete 3 4 .l index @0,0 -} {3} -test listbox-7.11 {DeleteEls procedure} { +} -result {3} +test listbox-7.11 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l delete 4 6 .l index @0,0 -} {3} -test listbox-7.12 {DeleteEls procedure} { +} -result {3} +test listbox-7.12 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l yview 3 update .l delete 3 end .l index @0,0 -} {1} -test listbox-7.13 {DeleteEls procedure, updating view with partial last line} { +} -result {1} +test listbox-7.13 {DeleteEls procedure, updating view with partial last line} -body { mkPartial .partial.l yview 8 update .partial.l delete 10 13 .partial.l index @0,0 -} {7} -test listbox-7.14 {DeleteEls procedure} { +} -result {7} +test listbox-7.14 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 3 4 .l index active -} {4} -test listbox-7.15 {DeleteEls procedure} { +} -result {4} +test listbox-7.15 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 5 7 .l index active -} {5} -test listbox-7.16 {DeleteEls procedure} { +} -result {5} +test listbox-7.16 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 5 end .l index active -} {4} -test listbox-7.17 {DeleteEls procedure} { +} -result {4} +test listbox-7.17 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j .l activate 6 .l delete 0 end .l index active -} {0} -test listbox-7.18 {DeleteEls procedure} { +} -result {0} +test listbox-7.18 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c "two words" d e f g h i j update @@ -1253,8 +1756,8 @@ test listbox-7.18 {DeleteEls procedure} { .l delete 4 6 update set log -} {{y 0 0.25}} -test listbox-7.19 {DeleteEls procedure} { +} -result {{y 0 0.25}} +test listbox-7.19 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c "two words" d e f g h i j update @@ -1262,9 +1765,12 @@ test listbox-7.19 {DeleteEls procedure} { .l delete 3 update set log -} {{y 0 0.2} {x 0 1}} -test listbox-7.20 {DeleteEls procedure} {fonts} { - catch {destroy .l2} +} -result {{y 0 0.2} {x 0 1}} +test listbox-7.20 {DeleteEls procedure} -constraints { + fonts +} -setup { + destroy .l2 +} -body { listbox .l2 -width 0 -height 0 pack .l2 -side top .l2 insert 0 a b "two words" c d e f g @@ -1272,28 +1778,37 @@ test listbox-7.20 {DeleteEls procedure} {fonts} { lappend x [winfo reqwidth .l2] [winfo reqheight .l2] .l2 delete 2 4 lappend x [winfo reqwidth .l2] [winfo reqheight .l2] -} {80 144 17 93} -catch {destroy .l2} -test listbox-7.21 {DeleteEls procedure, check -listvar update} { - catch {destroy .l2} +} -result {80 144 17 93} +test listbox-7.21 {DeleteEls procedure, check -listvar update} -setup { + destroy .l2 +} -body { set x [list a b c d] listbox .l2 -listvar x .l2 delete 0 1 set x -} [list c d] +} -result [list c d] + -test listbox-8.1 {ListboxEventProc procedure} {fonts} { - catch {destroy .l} +test listbox-8.1 {ListboxEventProc procedure} -constraints { + fonts +} -setup { + destroy .l +} -body { listbox .l -setgrid 1 pack .l update set x [getsize .] destroy .l list $x [getsize .] [winfo exists .l] [info command .l] -} {20x10 150x178 0 {}} +} -cleanup { + destroy .l +} -result {20x10 150x178 0 {}} resetGridInfo -test listbox-8.2 {ListboxEventProc procedure} {fonts} { - catch {destroy .l} +test listbox-8.2 {ListboxEventProc procedure} -constraints { + fonts +} -setup { + destroy .l +} -body { listbox .l -height 5 -width 10 .l insert 0 a b c "A string that is very very long" d e f g h i j k pack .l @@ -1301,9 +1816,12 @@ test listbox-8.2 {ListboxEventProc procedure} {fonts} { place .l -width 50 -height 80 update list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] -} {{0 0.222222} {0 0.333333}} -test listbox-8.3 {ListboxEventProc procedure} { +} -cleanup { + destroy .l +} -result {{0 0.222222} {0 0.333333}} +test listbox-8.3 {ListboxEventProc procedure} -setup { deleteWindows +} -body { listbox .l1 -bg #543210 rename .l1 .l2 set x {} @@ -1311,107 +1829,257 @@ test listbox-8.3 {ListboxEventProc procedure} { lappend x [.l2 cget -bg] destroy .l1 lappend x [info command .l*] [winfo children .] -} {.l1 #543210 {} {}} +} -cleanup { + deleteWindows +} -result {.l1 #543210 {} {}} + -test listbox-9.1 {ListboxCmdDeletedProc procedure} { +test listbox-9.1 {ListboxCmdDeletedProc procedure} -setup { deleteWindows +} -body { listbox .l1 rename .l1 {} list [info command .l*] [winfo children .] -} {{} {}} -test listbox-9.2 {ListboxCmdDeletedProc procedure, disabling -setgrid} fonts { - catch {destroy .top} +} -cleanup { + deleteWindows +} -result {{} {}} +test listbox-9.2 {ListboxCmdDeletedProc procedure, disabling -setgrid} -constraints { + fonts +} -setup { + destroy .top +} -body { toplevel .top wm geom .top +0+0 listbox .top.l -setgrid 1 -width 20 -height 10 pack .top.l update - set x [wm geometry .top] + set x [getsize .top] rename .top.l {} update - lappend x [wm geometry .top] + lappend x [getsize .top] +} -cleanup { destroy .top - set x -} {20x10+0+0 150x178+0+0} +} -result {20x10 150x178} -catch {destroy .l} -listbox .l -pack .l -.l delete 0 end -.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 -test listbox-10.1 {GetListboxIndex procedure} { + +# Listbox used in 10.* tests +destroy .l +test listbox-10.1 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 .l activate 3 + update list [.l activate 3; .l index active] [.l activate 6; .l index active] -} {3 6} -test listbox-10.2 {GetListboxIndex procedure} { +} -cleanup { + destroy .l +} -result {3 6} +test listbox-10.2 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 .l selection anchor 2 + update .l index anchor -} 2 -test listbox-10.3 {GetListboxIndex procedure} { +} -cleanup { + destroy .l +} -result 2 +test listbox-10.3 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 .l insert end A B C D E .l selection anchor end + update .l delete 12 end list [.l index anchor] [.l index end] -} {12 12} -test listbox-10.4 {GetListboxIndex procedure} { - list [catch {.l index a} msg] $msg -} {1 {bad listbox index "a": must be active, anchor, end, @x,y, or a number}} -test listbox-10.5 {GetListboxIndex procedure} { +} -cleanup { + destroy .l +} -result {12 12} +test listbox-10.4 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update + .l index a +} -cleanup { + destroy .l +} -returnCodes error -result {bad listbox index "a": must be active, anchor, end, @x,y, or a number} +test listbox-10.5 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update .l index end -} {12} -test listbox-10.6 {GetListboxIndex procedure} { +} -cleanup { + destroy .l +} -result {12} +test listbox-10.6 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update .l get end -} {el11} -test listbox-10.7 {GetListboxIndex procedure} { +} -cleanup { + destroy .l +} -result {el11} +test listbox-10.7 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 .l delete 0 end + update .l index end -} 0 -.l delete 0 end -.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 -update -test listbox-10.8 {GetListboxIndex procedure} { - list [catch {.l index @} msg] $msg -} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}} -test listbox-10.9 {GetListboxIndex procedure} { - list [catch {.l index @foo} msg] $msg -} {1 {bad listbox index "@foo": must be active, anchor, end, @x,y, or a number}} -test listbox-10.10 {GetListboxIndex procedure} { - list [catch {.l index @1x3} msg] $msg -} {1 {bad listbox index "@1x3": must be active, anchor, end, @x,y, or a number}} -test listbox-10.11 {GetListboxIndex procedure} { - list [catch {.l index @1,} msg] $msg -} {1 {bad listbox index "@1,": must be active, anchor, end, @x,y, or a number}} -test listbox-10.12 {GetListboxIndex procedure} { - list [catch {.l index @1,foo} msg] $msg -} {1 {bad listbox index "@1,foo": must be active, anchor, end, @x,y, or a number}} -test listbox-10.13 {GetListboxIndex procedure} { - list [catch {.l index @1,2x} msg] $msg -} {1 {bad listbox index "@1,2x": must be active, anchor, end, @x,y, or a number}} -test listbox-10.14 {GetListboxIndex procedure} {fonts} { +} -cleanup { + destroy .l +} -result 0 +test listbox-10.8 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update + .l index @ +} -cleanup { + destroy .l +} -returnCodes error -result {bad listbox index "@": must be active, anchor, end, @x,y, or a number} +test listbox-10.9 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update + .l index @foo +} -cleanup { + destroy .l +} -returnCodes error -result {bad listbox index "@foo": must be active, anchor, end, @x,y, or a number} +test listbox-10.10 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update + .l index @1x3 +} -cleanup { + destroy .l +} -returnCodes error -result {bad listbox index "@1x3": must be active, anchor, end, @x,y, or a number} +test listbox-10.11 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update + .l index @1, +} -cleanup { + destroy .l +} -returnCodes error -result {bad listbox index "@1,": must be active, anchor, end, @x,y, or a number} +test listbox-10.12 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update + .l index @1,foo +} -cleanup { + destroy .l +} -returnCodes error -result {bad listbox index "@1,foo": must be active, anchor, end, @x,y, or a number} +test listbox-10.13 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update + .l index @1,2x +} -cleanup { + destroy .l +} -returnCodes error -result {bad listbox index "@1,2x": must be active, anchor, end, @x,y, or a number} +test listbox-10.14 {GetListboxIndex procedure} -constraints { + fonts +} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update list [.l index @5,57] [.l index @5,58] -} {3 3} -test listbox-10.15 {GetListboxIndex procedure} { - list [catch {.l index 1xy} msg] $msg -} {1 {bad listbox index "1xy": must be active, anchor, end, @x,y, or a number}} -test listbox-10.16 {GetListboxIndex procedure} { +} -cleanup { + .l delete 0 end +} -cleanup { + destroy .l +} -result {3 3} +test listbox-10.15 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update + .l index 1xy +} -cleanup { + destroy .l +} -returnCodes error -result {bad listbox index "1xy": must be active, anchor, end, @x,y, or a number} +test listbox-10.16 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update .l index 3 -} {3} -test listbox-10.17 {GetListboxIndex procedure} { +} -cleanup { + destroy .l +} -result {3} +test listbox-10.17 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update .l index 20 -} {20} -test listbox-10.18 {GetListboxIndex procedure} { +} -cleanup { + destroy .l +} -result {20} +test listbox-10.18 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update .l get 20 -} {} -test listbox-10.19 {GetListboxIndex procedure} { +} -cleanup { + destroy .l +} -result {} +test listbox-10.19 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 + update .l index -2 -} -2 -test listbox-10.20 {GetListboxIndex procedure} { +} -cleanup { + destroy .l +} -result -2 +test listbox-10.20 {GetListboxIndex procedure} -setup { + destroy .l +} -body { + pack [listbox .l] + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 .l delete 0 end + update .l index 1 -} 1 +} -cleanup { + destroy .l +} -result 1 + -test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} { - catch {destroy .l} +test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} -setup { + destroy .l +} -body { listbox .l -height 5 pack .l .l insert 0 a b c d e f g h i j @@ -1421,9 +2089,12 @@ test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} { .l yview -1 update lappend x [.l index @0,0] -} {3 0} -test listbox-11.2 {ChangeListboxView procedure, boundary conditions for index} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {3 0} +test listbox-11.2 {ChangeListboxView procedure, boundary conditions for index} -setup { + destroy .l +} -body { listbox .l -height 5 pack .l .l insert 0 a b c d e f g h i j @@ -1433,9 +2104,12 @@ test listbox-11.2 {ChangeListboxView procedure, boundary conditions for index} { .l yview 20 update lappend x [.l index @0,0] -} {3 5} -test listbox-11.3 {ChangeListboxView procedure} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {3 5} +test listbox-11.3 {ChangeListboxView procedure} -setup { + destroy .l +} -body { listbox .l -height 5 -yscrollcommand "record y" pack .l .l insert 0 a b c d e f g h i j @@ -1444,9 +2118,12 @@ test listbox-11.3 {ChangeListboxView procedure} { .l yview 2 update list [format {%.6g %.6g} {*}[.l yview]] $log -} {{0.2 0.7} {{y 0.2 0.7}}} -test listbox-11.4 {ChangeListboxView procedure} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {{0.2 0.7} {{y 0.2 0.7}}} +test listbox-11.4 {ChangeListboxView procedure} -setup { + destroy .l +} -body { listbox .l -height 5 -yscrollcommand "record y" pack .l .l insert 0 a b c d e f g h i j @@ -1455,9 +2132,12 @@ test listbox-11.4 {ChangeListboxView procedure} { .l yview 8 update list [format {%.6g %.6g} {*}[.l yview]] $log -} {{0.5 1} {{y 0.5 1}}} -test listbox-11.5 {ChangeListboxView procedure} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {{0.5 1} {{y 0.5 1}}} +test listbox-11.5 {ChangeListboxView procedure} -setup { + destroy .l +} -body { listbox .l -height 5 -yscrollcommand "record y" pack .l .l insert 0 a b c d e f g h i j @@ -1467,40 +2147,55 @@ test listbox-11.5 {ChangeListboxView procedure} { .l yview 3 update list [format {%.6g %.6g} {*}[.l yview]] $log -} {{0.3 0.8} {}} -test listbox-11.6 {ChangeListboxView procedure, partial last line} { +} -cleanup { + destroy .l +} -result {{0.3 0.8} {}} +test listbox-11.6 {ChangeListboxView procedure, partial last line} -body { mkPartial .partial.l yview 13 .partial.l index @0,0 -} {11} +} -cleanup { + destroy .l +} -result {11} -catch {destroy .l} + +# Listbox used in 12.* tests +destroy .l listbox .l -font $fixed -xscrollcommand "record x" -width 10 .l insert 0 0123456789a123456789b123456789c123456789d123456789e123456789f123456789g123456789h123456789i123456789 pack .l update -test listbox-12.1 {ChangeListboxOffset procedure} {fonts} { +test listbox-12.1 {ChangeListboxOffset procedure} -constraints { + fonts +} -body { set log {} .l xview 99 update list [format {%.6g %.6g} {*}[.l xview]] $log -} {{0.9 1} {{x 0.9 1}}} -test listbox-12.2 {ChangeListboxOffset procedure} {fonts} { +} -result {{0.9 1} {{x 0.9 1}}} +test listbox-12.2 {ChangeListboxOffset procedure} -constraints { + fonts +} -body { set log {} + .l xview 99 .l xview moveto -.25 update list [format {%.6g %.6g} {*}[.l xview]] $log -} {{0 0.1} {{x 0 0.1}}} -test listbox-12.3 {ChangeListboxOffset procedure} {fonts} { +} -result {{0 0.1} {{x 0 0.1}}} +test listbox-12.3 {ChangeListboxOffset procedure} -constraints { + fonts +} -body { .l xview 10 update set log {} .l xview 10 update list [format {%.6g %.6g} {*}[.l xview]] $log -} {{0.1 0.2} {}} +} -result {{0.1 0.2} {}} + -catch {destroy .l} +# Listbox used in 13.* tests +destroy .l listbox .l -font $fixed -width 10 -height 5 pack .l .l insert 0 a bb c d e f g h i j k l m n o p q r s @@ -1508,15 +2203,19 @@ pack .l update set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]] set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]] -test listbox-13.1 {ListboxScanTo procedure} {fonts} { +test listbox-13.1 {ListboxScanTo procedure} -constraints { + fonts +} -body { .l yview 0 .l xview 0 .l scan mark 10 20 .l scan dragto [expr 10-$width] [expr 20-$height] update list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] -} {{0.2 0.4} {0.5 0.75}} -test listbox-13.2 {ListboxScanTo procedure} {fonts} { +} -result {{0.2 0.4} {0.5 0.75}} +test listbox-13.2 {ListboxScanTo procedure} -constraints { + fonts +} -body { .l yview 5 .l xview 10 .l scan mark 10 20 @@ -1526,8 +2225,10 @@ test listbox-13.2 {ListboxScanTo procedure} {fonts} { .l scan dragto [expr 20-$width] [expr 40-$height] update lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] -} {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}} -test listbox-13.3 {ListboxScanTo procedure} {fonts} { +} -result {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}} +test listbox-13.3 {ListboxScanTo procedure} -constraints { + fonts +} -body { .l yview moveto 1.0 .l xview moveto 1.0 .l scan mark 10 20 @@ -1537,40 +2238,55 @@ test listbox-13.3 {ListboxScanTo procedure} {fonts} { .l scan dragto [expr 5+$width] [expr 10+$height] update lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] -} {{0.8 1} {0.75 1} {0.64 0.84} {0.25 0.5}} +} -result {{0.8 1} {0.75 1} {0.64 0.84} {0.25 0.5}} -test listbox-14.1 {NearestListboxElement procedure, partial last line} { + +test listbox-14.1 {NearestListboxElement procedure, partial last line} -body { mkPartial .partial.l nearest [winfo height .partial.l] -} {4} -catch {destroy .l} +} -result {4} +# Listbox used in 14.* tests +destroy .l listbox .l -font $fixed -width 20 -height 10 .l insert 0 a b c d e f g h i j k l m n o p q r s t .l yview 4 pack .l update -test listbox-14.2 {NearestListboxElement procedure} {fonts} { +test listbox-14.2 {NearestListboxElement procedure} -constraints { + fonts +} -body { .l index @50,0 -} {4} -test listbox-14.3 {NearestListboxElement procedure} {fonts} { +} -result {4} +test listbox-14.3 {NearestListboxElement procedure} -constraints { + fonts +} -body { list [.l index @50,35] [.l index @50,36] -} {5 6} -test listbox-14.4 {NearestListboxElement procedure} {fonts} { +} -result {5 6} +test listbox-14.4 {NearestListboxElement procedure} -constraints { + fonts +} -body { .l index @50,200 -} {13} +} -result {13} + -test listbox-15.1 {ListboxSelect procedure} { +# Listbox used in 15.* 16.* and 17.* tests +destroy .l +listbox .l -font $fixed -width 20 -height 10 +pack .l +update +test listbox-15.1 {ListboxSelect procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j k l m n o p .l select set 2 4 .l select set 7 12 .l select clear 4 7 .l curselection -} {2 3 8 9 10 11 12} -test listbox-15.2 {ListboxSelect procedure} { +} -result {2 3 8 9 10 11 12} +test listbox-15.2 {ListboxSelect procedure} -setup { + destroy .e +} -body { .l delete 0 end .l insert 0 a b c d e f g h i j k l m n o p - catch {destroy .e} entry .e .e insert 0 "This is some text" .e select from 0 @@ -1579,78 +2295,81 @@ test listbox-15.2 {ListboxSelect procedure} { set x [selection own] .l selection set 3 list $x [selection own] [selection get] -} {.e .l d} -test listbox-15.3 {ListboxSelect procedure} { +} -cleanup { + destroy .e +} -result {.e .l d} +test listbox-15.3 {ListboxSelect procedure} -body { .l delete 0 end .l selection clear 0 end .l select set 0 end .l curselection -} {} -test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} { +} -result {} +test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set -2 -1 .l curselection -} {} -test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} { +} -result {} +test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set -1 3 .l curselection -} {0 1 2 3} -test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} { +} -result {0 1 2 3} +test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set 2 4 .l curselection -} {2 3 4} -test listbox-15.7 {ListboxSelect procedure, boundary conditions for indices} { +} -result {2 3 4} +test listbox-15.7 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set 4 end .l curselection -} {4 5} -test listbox-15.8 {ListboxSelect procedure, boundary conditions for indices} { +} -result {4 5} +test listbox-15.8 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set 4 30 .l curselection -} {4 5} -test listbox-15.9 {ListboxSelect procedure, boundary conditions for indices} { +} -result {4 5} +test listbox-15.9 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set end 30 .l curselection -} {5} -test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} { +} -result {5} +test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} -body { .l delete 0 end .l insert 0 a b c d e f .l select clear 0 end .l select set 20 25 .l curselection -} {} +} -result {} + -test listbox-16.1 {ListboxFetchSelection procedure} { +test listbox-16.1 {ListboxFetchSelection procedure} -body { .l delete 0 end .l insert 0 a b c "two words" e f g h i \\ k l m n o p .l selection set 2 4 .l selection set 9 .l selection set 11 12 selection get -} "c\ntwo words\ne\n\\\nl\nm" -test listbox-16.2 {ListboxFetchSelection procedure} { +} -result "c\ntwo words\ne\n\\\nl\nm" +test listbox-16.2 {ListboxFetchSelection procedure} -body { .l delete 0 end .l insert 0 a b c "two words" e f g h i \\ k l m n o p .l selection set 3 selection get -} "two words" -test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} { +} -result "two words" +test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} -body { set long "This is quite a long string\n" append long $long $long $long $long append long $long $long $long $long @@ -1660,38 +2379,48 @@ test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} { .l selection set 0 end set sel [selection get] string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel -} {0} -catch {unset long sel} +} -cleanup { + catch {unset long sel} +} -result {0} -test listbox-17.1 {ListboxLostSelection procedure} { + +test listbox-17.1 {ListboxLostSelection procedure} -setup { + destroy .e +} -body { .l delete 0 end .l insert 0 a b c d e .l select set 0 end - catch {destroy .e} entry .e .e insert 0 "This is some text" .e select from 0 .e select to 5 .l curselection -} {} -test listbox-17.2 {ListboxLostSelection procedure} { +} -cleanup { + destroy .e +} -result {} +test listbox-17.2 {ListboxLostSelection procedure} -setup { + destroy .e +} -body { .l delete 0 end .l insert 0 a b c d e .l select set 0 end .l configure -exportselection 0 - catch {destroy .e} entry .e .e insert 0 "This is some text" .e select from 0 .e select to 5 .l curselection -} {0 1 2 3 4} +} -cleanup { + destroy .e +} -result {0 1 2 3 4} + -catch {destroy .l} +# Listbox used in 18.* tests +destroy .l listbox .l -font $fixed -width 10 -height 5 pack .l update -test listbox-18.1 {ListboxUpdateVScrollbar procedure} { +test listbox-18.1 {ListboxUpdateVScrollbar procedure} -body { .l configure -yscrollcommand "record y" set log {} .l insert 0 a b c @@ -1701,37 +2430,40 @@ test listbox-18.1 {ListboxUpdateVScrollbar procedure} { .l delete 0 end update set log -} {{y 0 1} {y 0 0.625} {y 0 1}} -test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} { +} -result {{y 0 1} {y 0 0.625} {y 0 1}} +test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} -body { mkPartial .partial.l configure -yscrollcommand "record y" set log {} .partial.l yview 3 update set log -} {{y 0.2 0.466667}} -test listbox-18.3 {ListboxUpdateVScrollbar procedure} { +} -result {{y 0.2 0.466667}} +test listbox-18.3 {ListboxUpdateVScrollbar procedure} -body { proc bgerror args { - global x errorInfo - set x [list $args $errorInfo] + global x errorInfo + set x [list $args $errorInfo] } .l configure -yscrollcommand gorp .l insert 0 foo update set x -} {{{invalid command name "gorp"}} {invalid command name "gorp" +} -cleanup { + rename bgerror {} +} -result {{{invalid command name "gorp"}} {invalid command name "gorp" while executing "gorp 0.0 1.0" (vertical scrolling command executed by listbox)}} -if {[info exists bgerror]} { - rename bgerror {} -} -catch {destroy .l} + +# Listbox used in 19.* tests +destroy .l listbox .l -font $fixed -width 10 -height 5 pack .l update -test listbox-19.1 {ListboxUpdateVScrollbar procedure} {fonts} { +test listbox-19.1 {ListboxUpdateVScrollbar procedure} -constraints { + fonts +} -body { .l configure -xscrollcommand "record x" set log {} .l insert 0 abc @@ -1741,97 +2473,125 @@ test listbox-19.1 {ListboxUpdateVScrollbar procedure} {fonts} { .l delete 0 end update set log -} {{x 0 1} {x 0 0.322581} {x 0 1}} -test listbox-19.2 {ListboxUpdateVScrollbar procedure} { +} -result {{x 0 1} {x 0 0.322581} {x 0 1}} +test listbox-19.2 {ListboxUpdateVScrollbar procedure} -body { proc bgerror args { - global x errorInfo - set x [list $args $errorInfo] + global x errorInfo + set x [list $args $errorInfo] } .l configure -xscrollcommand bogus .l insert 0 foo update set x -} {{{invalid command name "bogus"}} {invalid command name "bogus" +} -result {{{invalid command name "bogus"}} {invalid command name "bogus" while executing "bogus 0.0 1.0" (horizontal scrolling command executed by listbox)}} -set l [interp hidden] -deleteWindows -test listbox-20.1 {listbox vs hidden commands} { - catch {destroy .l} +test listbox-20.1 {listbox vs hidden commands} -setup { + deleteWindows +} -body { + set l [interp hidden] listbox .l interp hide {} .l destroy .l - list [winfo children .] [interp hidden] -} [list {} $l] + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 eq $res2} +} -result 1 + # tests for ListboxListVarProc -test listbox-21.1 {ListboxListVarProc} { - catch {destroy .l} +test listbox-21.1 {ListboxListVarProc} -setup { + destroy .l +} -body { catch {unset x} listbox .l -listvar x set x [list a b c d] .l get 0 end -} [list a b c d] -test listbox-21.2 {ListboxListVarProc} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result [list a b c d] +test listbox-21.2 {ListboxListVarProc} -setup { + destroy .l +} -body { set x [list a b c d] listbox .l -listvar x unset x set x -} [list a b c d] -test listbox-21.3 {ListboxListVarProc} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result [list a b c d] +test listbox-21.3 {ListboxListVarProc} -setup { + destroy .l +} -body { set x [list a b c d] listbox .l -listvar x .l configure -listvar {} unset x info exists x -} 0 -test listbox-21.4 {ListboxListVarProc} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result 0 +test listbox-21.4 {ListboxListVarProc} -setup { + destroy .l +} -body { set x [list a b c d] listbox .l -listvar x lappend x e f g .l size -} 7 -test listbox-21.5 {ListboxListVarProc, test selection after listvar mod} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result 7 +test listbox-21.5 {ListboxListVarProc, test selection after listvar mod} -setup { + destroy .l +} -body { set x [list a b c d e f g] listbox .l -listvar x .l selection set end set x [list a b c d] set x [list 0 1 2 3 4 5 6] .l curselection -} {} -test listbox-21.6 {ListboxListVarProc, test selection after listvar mod} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {} +test listbox-21.6 {ListboxListVarProc, test selection after listvar mod} -setup { + destroy .l +} -body { set x [list a b c d] listbox .l -listvar x .l selection set 3 lappend x e f g .l curselection -} 3 -test listbox-21.7 {ListboxListVarProc, test selection after listvar mod} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result 3 +test listbox-21.7 {ListboxListVarProc, test selection after listvar mod} -setup { + destroy .l +} -body { set x [list a b c d] listbox .l -listvar x .l selection set 0 set x [linsert $x 0 1 2 3 4] .l curselection -} 0 -test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result 0 +test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} -setup { + destroy .l +} -body { set x [list a b c d] listbox .l -listvar x .l selection set 2 set x [list a b c] .l curselection -} 2 -test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result 2 +test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} -setup { + destroy .l +} -body { catch {unset x} set log {} listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x @@ -1842,9 +2602,12 @@ test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} { lappend x "00000000000000000000" update set log -} [list {x 0 1} {x 0 1} {x 0 0.5}] -test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result [list {x 0 1} {x 0 1} {x 0 0.5}] +test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} -setup { + destroy .l +} -body { catch {unset x} set log {} listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x @@ -1857,53 +2620,71 @@ test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} { set x [list "0000000000"] update set log -} [list {x 0 1} {x 0 1} {x 0 0.5} {x 0 1}] -test listbox-21.11 {ListboxListVarProc, bad list} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result [list {x 0 1} {x 0 1} {x 0 0.5} {x 0 1}] +test listbox-21.11 {ListboxListVarProc, bad list} -setup { + destroy .l +} -body { catch {unset x} listbox .l -listvar x set x [list a b c d] catch {set x "this is a \" bad list"} result set result -} {can't set "x": invalid listvar value} -test listbox-21.12 {ListboxListVarProc, cleanup item attributes} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {can't set "x": invalid listvar value} +test listbox-21.12 {ListboxListVarProc, cleanup item attributes} -setup { + destroy .l +} -body { set x [list a b c d e f g] listbox .l -listvar x .l itemconfigure end -fg red set x [list a b c d] set x [list 0 1 2 3 4 5 6] .l itemcget end -fg -} {} -test listbox-21.12a {ListboxListVarProc, cleanup item attributes} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {} +test listbox-21.12a {ListboxListVarProc, cleanup item attributes} -setup { + destroy .l +} -body { set x [list a b c d e f g] listbox .l -listvar x .l itemconfigure end -fg red set x [list a b c d] set x [list 0 1 2 3 4 5 6] .l itemcget end -fg -} {} -test listbox-21.13 {listbox item configurations and listvar based deletions} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {} +test listbox-21.13 {listbox item configurations and listvar based deletions} -setup { + destroy .l +} -body { catch {unset x} listbox .l -listvar x .l insert end a b c .l itemconfigure 1 -fg red set x [list b c] .l itemcget 1 -fg -} red -test listbox-21.14 {listbox item configurations and listvar based inserts} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result red +test listbox-21.14 {listbox item configurations and listvar based inserts} -setup { + destroy .l +} -body { catch {unset x} listbox .l -listvar x .l insert end a b c .l itemconfigure 0 -fg red set x [list 1 2 3 4 a b c] .l itemcget 0 -fg -} red -test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result red +test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} -setup { + destroy .l +} -body { catch {unset x} set log {} listbox .l -listvar x -yscrollcommand "record y" -font fixed -height 3 @@ -1912,9 +2693,12 @@ test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} { lappend x a b c d e f update set log -} [list {y 0 1} {y 0 0.5}] -test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result [list {y 0 1} {y 0 0.5}] +test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} -setup { + destroy .l +} -body { catch {unset x} listbox .l -listvar x -height 3 pack .l @@ -1930,11 +2714,15 @@ test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} { update lappend result [format {%.6g %.6g} {*}[.l yview]] set result -} [list {0.5 1} {0 1}] +} -cleanup { + destroy .l +} -result [list {0.5 1} {0 1}] + # UpdateHScrollbar -test listbox-22.1 {UpdateHScrollbar} { - catch {destroy .l} +test listbox-22.1 {UpdateHScrollbar} -setup { + destroy .l +} -body { set log {} listbox .l -font $fixed -width 10 -xscrollcommand "record x" pack .l @@ -1944,41 +2732,57 @@ test listbox-22.1 {UpdateHScrollbar} { .l insert end "00000000000000000000" update set log -} [list {x 0 1} {x 0 1} {x 0 0.5}] +} -cleanup { + destroy .l +} -result [list {x 0 1} {x 0 1} {x 0 0.5}] + # ConfigureListboxItem -test listbox-23.1 {ConfigureListboxItem} { - catch {destroy .l} +test listbox-23.1 {ConfigureListboxItem} -setup { + destroy .l +} -body { listbox .l catch {.l itemconfigure 0} result set result -} {item number "0" out of range} -test listbox-23.2 {ConfigureListboxItem} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {item number "0" out of range} +test listbox-23.2 {ConfigureListboxItem} -setup { + destroy .l +} -body { listbox .l .l insert end a b c d .l itemconfigure 0 -} [list {-background background Background {} {}} \ +} -cleanup { + destroy .l +} -result [list {-background background Background {} {}} \ {-bg -background} \ {-fg -foreground} \ {-foreground foreground Foreground {} {}} \ {-selectbackground selectBackground Foreground {} {}} \ {-selectforeground selectForeground Background {} {}}] -test listbox-23.3 {ConfigureListboxItem, itemco shortcut} { - catch {destroy .l} +test listbox-23.3 {ConfigureListboxItem, itemco shortcut} -setup { + destroy .l +} -body { listbox .l .l insert end a b c d .l itemco 0 -background -} {-background background Background {} {}} -test listbox-23.4 {ConfigureListboxItem, wrong num args} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {-background background Background {} {}} +test listbox-23.4 {ConfigureListboxItem, wrong num args} -setup { + destroy .l +} -body { listbox .l .l insert end a catch {.l itemco} result set result -} {wrong # args: should be ".l itemconfigure index ?option? ?value? ?option value ...?"} -test listbox-23.5 {ConfigureListboxItem, multiple calls} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {wrong # args: should be ".l itemconfigure index ?-option? ?value? ?-option value ...?"} +test listbox-23.5 {ConfigureListboxItem, multiple calls} -setup { + destroy .l +} -body { listbox .l set i 0 foreach color {red orange yellow green blue white violet} { @@ -1991,102 +2795,164 @@ test listbox-23.5 {ConfigureListboxItem, multiple calls} { list [.l itemcget 0 -bg] [.l itemcget 1 -bg] [.l itemcget 2 -bg] \ [.l itemcget 3 -bg] [.l itemcget 4 -bg] [.l itemcget 5 -bg] \ [.l itemcget 6 -bg] -} {red orange yellow green blue white violet} -catch {destroy .l} +} -cleanup { + destroy .l +} -result {red orange yellow green blue white violet} + +# Listbox used in 23.6 -23.17 tests +destroy .l listbox .l .l insert end a b c d -set i 6 -foreach test { - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-fg #110022 #110022 bogus {unknown color name "bogus"}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"}} - {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} -} { - set name [lindex $test 0] - test listbox-23.$i {configuration options} { - .l itemconfigure 0 $name [lindex $test 1] - list [lindex [.l itemconfigure 0 $name] 4] [.l itemcget 0 $name] - } [list [lindex $test 2] [lindex $test 2]] - incr i - if {[lindex $test 3] != ""} { - test listbox-23.$i {configuration options} { - list [catch {.l configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - .l configure $name [lindex [.l configure $name] 3] - incr i -} +test listbox-23.6 {configuration options} -body { + .l itemconfigure 0 -background #ff0000 + list [lindex [.l itemconfigure 0 -background] 4] [.l itemcget 0 -background] +} -cleanup { + .l configure -background #ffffff +} -result {{#ff0000} #ff0000} +test listbox-23.7 {configuration options} -body { + .l configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test listbox-23.8 {configuration options} -body { + .l itemconfigure 0 -bg #ff0000 + list [lindex [.l itemconfigure 0 -bg] 4] [.l itemcget 0 -bg] +} -cleanup { + .l configure -bg #ffffff +} -result {{#ff0000} #ff0000} +test listbox-23.9 {configuration options} -body { + .l configure -bg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test listbox-23.10 {configuration options} -body { + .l itemconfigure 0 -fg #110022 + list [lindex [.l itemconfigure 0 -fg] 4] [.l itemcget 0 -fg] +} -cleanup { + .l configure -fg #000000 +} -result {{#110022} #110022} +test listbox-23.11 {configuration options} -body { + .l configure -fg bogus +} -returnCodes error -result {unknown color name "bogus"} +test listbox-23.12 {configuration options} -body { + .l itemconfigure 0 -foreground #110022 + list [lindex [.l itemconfigure 0 -foreground] 4] [.l itemcget 0 -foreground] +} -cleanup { + .l configure -foreground #000000 +} -result {{#110022} #110022} +test listbox-23.13 {configuration options} -body { + .l configure -foreground bogus +} -returnCodes error -result {unknown color name "bogus"} +test listbox-23.14 {configuration options} -body { + .l itemconfigure 0 -selectbackground #110022 + list [lindex [.l itemconfigure 0 -selectbackground] 4] [.l itemcget 0 -selectbackground] +} -cleanup { + .l configure -selectbackground #c3c3c3 +} -result {{#110022} #110022} +test listbox-23.15 {configuration options} -body { + .l configure -selectbackground bogus +} -returnCodes error -result {unknown color name "bogus"} +test listbox-23.16 {configuration options} -body { + .l itemconfigure 0 -selectforeground #654321 + list [lindex [.l itemconfigure 0 -selectforeground] 4] [.l itemcget 0 -selectforeground] +} -cleanup { + .l configure -selectforeground #000000 +} -result {{#654321} #654321} +test listbox-23.17 {configuration options} -body { + .l configure -selectforeground bogus +} -returnCodes error -result {unknown color name "bogus"} + # ListboxWidgetObjCmd, itemcget -test listbox-24.1 {itemcget} { - catch {destroy .l} +test listbox-24.1 {itemcget} -setup { + destroy .l +} -body { listbox .l .l insert end a b c d .l itemcget 0 -fg -} {} -test listbox-24.2 {itemcget} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {} +test listbox-24.2 {itemcget} -setup { + destroy .l +} -body { listbox .l .l insert end a b c d .l itemconfigure 0 -fg red .l itemcget 0 -fg -} red -test listbox-24.3 {itemcget} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result red +test listbox-24.3 {itemcget} -setup { + destroy .l +} -body { listbox .l .l insert end a b c d catch {.l itemcget 0} result set result -} {wrong # args: should be ".l itemcget index option"} -test listbox-24.4 {itemcget, itemcg shortcut} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {wrong # args: should be ".l itemcget index option"} +test listbox-24.4 {itemcget, itemcg shortcut} -setup { + destroy .l +} -body { listbox .l .l insert end a b c d catch {.l itemcg 0} result set result -} {wrong # args: should be ".l itemcget index option"} +} -cleanup { + destroy .l +} -result {wrong # args: should be ".l itemcget index option"} + # General item configuration issues -test listbox-25.1 {listbox item configurations and widget based deletions} { - catch {destroy .l} +test listbox-25.1 {listbox item configurations and widget based deletions} -setup { + destroy .l +} -body { listbox .l .l insert end a .l itemconfigure 0 -fg red .l delete 0 end .l insert end a .l itemcget 0 -fg -} {} -test listbox-25.2 {listbox item configurations and widget based inserts} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result {} +test listbox-25.2 {listbox item configurations and widget based inserts} -setup { + destroy .l +} -body { listbox .l .l insert end a b c .l itemconfigure 0 -fg red .l insert 0 1 2 3 4 list [.l itemcget 0 -fg] [.l itemcget 4 -fg] -} [list {} red] +} -cleanup { + destroy .l +} -result {{} red} + # state issues -test listbox-26.1 {listbox disabled state disallows inserts} { - catch {destroy .l} +test listbox-26.1 {listbox disabled state disallows inserts} -setup { + destroy .l +} -body { listbox .l .l insert end a b c .l configure -state disabled .l insert end d e f .l get 0 end -} [list a b c] -test listbox-26.2 {listbox disabled state disallows deletions} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result [list a b c] +test listbox-26.2 {listbox disabled state disallows deletions} -setup { + destroy .l +} -body { listbox .l .l insert end a b c .l configure -state disabled .l delete 0 end .l get 0 end -} [list a b c] -test listbox-26.3 {listbox disabled state disallows selection modification} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result [list a b c] +test listbox-26.3 {listbox disabled state disallows selection modification} -setup { + destroy .l +} -body { listbox .l .l insert end a b c .l selection set 0 @@ -2095,58 +2961,89 @@ test listbox-26.3 {listbox disabled state disallows selection modification} { .l selection clear 0 end .l selection set 1 .l curselection -} [list 0 2] -test listbox-26.4 {listbox disabled state disallows anchor modification} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result [list 0 2] +test listbox-26.4 {listbox disabled state disallows anchor modification} -setup { + destroy .l +} -body { listbox .l .l insert end a b c .l selection anchor 0 .l configure -state disabled .l selection anchor 2 .l index anchor -} 0 -test listbox-26.5 {listbox disabled state disallows active modification} { - catch {destroy .l} +} -cleanup { + destroy .l +} -result 0 +test listbox-26.5 {listbox disabled state disallows active modification} -setup { + destroy .l +} -body { listbox .l .l insert end a b c .l activate 0 .l configure -state disabled .l activate 2 .l index active -} 0 +} -cleanup { + destroy .l +} -result 0 + -test listbox-27.1 {widget deletion while active} { +test listbox-27.1 {widget deletion while active} -setup { destroy .l +} -body { pack [listbox .l] update .l configure -cursor xterm -xscrollcommand { destroy .l } update idle winfo exists .l -} 0 +} -cleanup { + destroy .l +} -result 0 + -test listbox-28.1 {listbox -activestyle} { +test listbox-28.1 {listbox -activestyle} -setup { destroy .l +} -body { listbox .l -activ non .l cget -activestyle -} none -test listbox-28.2-nonwin {listbox -activestyle} {nonwin} { +} -cleanup { + destroy .l +} -result none +test listbox-28.2 {listbox -activestyle} -constraints { + nonwin +} -setup { destroy .l +} -body { listbox .l .l cget -activestyle -} dotbox -test listbox-28.2-win {listbox -activestyle} {win} { +} -cleanup { + destroy .l +} -result dotbox +test listbox-28.3 {listbox -activestyle} -constraints { + win +} -setup { destroy .l +} -body { listbox .l .l cget -activestyle -} underline -test listbox-28.3 {listbox -activestyle} { +} -cleanup { + destroy .l +} -result underline +test listbox-28.4 {listbox -activestyle} -setup { destroy .l +} -body { listbox .l -activestyle und .l cget -activestyle -} underline +} -cleanup { + destroy .l +} -result underline -test listbox-29.1 {listbox selection behavior, -state disabled} { + +test listbox-29.1 {listbox selection behavior, -state disabled} -setup { destroy .l +} -body { listbox .l .l insert end 1 2 3 .l selection set 2 @@ -2156,7 +3053,9 @@ test listbox-29.1 {listbox selection behavior, -state disabled} { # but selection cannot be changed (new behavior since 8.4) .l selection set 3 lappend out [.l selection includes 2] [.l curselection] -} {1 1 2} +} -cleanup { + destroy .l +} -result {1 1 2} test listbox-30.1 {Bug 3607326} -setup { destroy .l @@ -2169,6 +3068,45 @@ test listbox-30.1 {Bug 3607326} -setup { unset -nocomplain a } -result * -match glob -returnCodes error +test listbox-31.1 {<<ListboxSelect>> event} -setup { + destroy .l + unset -nocomplain res +} -body { + pack [listbox .l -state normal] + update + bind .l <<ListboxSelect>> {lappend res [%W curselection]} + .l insert end a b c + focus -force .l + event generate .l <1> -x 5 -y 5 ; # <<ListboxSelect>> fires + .l configure -state disabled + focus -force .l + event generate .l <Control-Home> ; # <<ListboxSelect>> does NOT fire + .l configure -state normal + focus -force .l + event generate .l <Control-End> ; # <<ListboxSelect>> fires + .l selection clear 0 end ; # <<ListboxSelect>> does NOT fire + .l selection set 1 1 ; # <<ListboxSelect>> does NOT fire + lappend res [.l curselection] +} -cleanup { + destroy .l + unset -nocomplain res +} -result {0 2 1} + +test listbox-31.2 {<<ListboxSelect>> event on lost selection} -setup { + destroy .l +} -body { + pack [listbox .l -exportselection true] + update + bind .l <<ListboxSelect>> {lappend res [list [selection own] [%W curselection]]} + .l insert end a b c + focus -force .l + event generate .l <1> -x 5 -y 5 ; # <<ListboxSelect>> fires + selection clear ; # <<ListboxSelect>> fires again + set res +} -cleanup { + destroy .l +} -result {{.l 0} {{} {}}} + resetGridInfo deleteWindows option clear @@ -2176,3 +3114,8 @@ option clear # cleanup cleanupTests return + + + + + diff --git a/tests/main.test b/tests/main.test index 1d33fbb..7ab624f 100644 --- a/tests/main.test +++ b/tests/main.test @@ -8,59 +8,55 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands test main-1.1 {StdinProc} -constraints stdio -setup { - set script [makeFile { - close stdin; exit - } script] + set script [makeFile {close stdin; exit} script] } -body { - list [catch {exec [interpreter] <$script} msg] $msg + exec [interpreter] <$script } -cleanup { removeFile script -} -result {0 {}} +} -returnCodes ok -test main-2.1 {Tk_MainEx: -encoding option} -constraints { - stdio - } -setup { - set script [makeFile {} script] - file delete $script - set f [open $script w] - fconfigure $f -encoding utf-8 - puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]; exit" - close $f - catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} - } -body { - read $f - } -cleanup { - close $f - removeFile script - } -result [list script {} 0]\n1\n +test main-2.1 {Tk_MainEx: -encoding option} -constraints stdio -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]; exit" + close $f + catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} +} -body { + read $f +} -cleanup { + close $f + removeFile script +} -result "script {} 0\n1\n" -test main-2.2 {Tk_MainEx: -encoding option} -constraints { - stdio - } -setup { - set script [makeFile {} script] - file delete $script - set f [open $script w] - fconfigure $f -encoding utf-8 - puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]; exit" - close $f - catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} - } -body { - read $f - } -cleanup { - close $f - removeFile script - } -result [list script {} 0]\n0\n +test main-2.2 {Tk_MainEx: -encoding option} -constraints stdio -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]; exit" + close $f + catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} +} -body { + read $f +} -cleanup { + close $f + removeFile script +} -result "script {} 0\n0\n" - # Procedure to simulate interactive typing of commands, line by line + # Procedure to simulate interactive typing of commands, line by line, + # for test 2.3 proc type {chan script} { foreach line [split $script \n] { if {[catch { @@ -74,52 +70,50 @@ test main-2.2 {Tk_MainEx: -encoding option} -constraints { } } -test main-2.3 {Tk_MainEx: -encoding option} -constraints { - stdio - } -setup { - set script [makeFile {} script] - file delete $script - set f [open $script w] - fconfigure $f -encoding utf-8 - puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]" - close $f - catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} - } -body { - type $f { - puts $argv - exit - } - list [catch {gets $f} line] $line - } -cleanup { - close $f - removeFile script - } -result {0 {-enc utf-8 script}} +test main-2.3 {Tk_MainEx: -encoding option} -constraints stdio -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]" + close $f + catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} +} -body { + type $f { + puts $argv + exit + } + gets $f +} -cleanup { + close $f + removeFile script +} -returnCodes ok -result {-enc utf-8 script} test main-3.1 {Tk_ParseArgv: -help option} -constraints unix -body { # Run only on unix as Win32 pops up native dialog - list [catch {exec [interpreter] -help} msg] $msg -} -match glob -result {1 {% Application initialization failed: Command-specific options:*}} + exec [interpreter] -help +} -returnCodes error -match glob -result {% application-specific initialization failed: Command-specific options:*} test main-3.2 {Tk_ParseArgv: -help option} -setup { set maininterp [interp create] } -body { $maininterp eval { set argc 1 ; set argv -help } - list [catch {load {} Tk $maininterp} msg] $msg + load {} Tk $maininterp } -cleanup { interp delete $maininterp -} -match glob -result {1 {Command-specific options:*}} +} -returnCodes error -match glob -result {Command-specific options:*} test main-3.3 {Tk_ParseArgv: -help option} -setup { set maininterp [interp create] } -body { # Repeat of 3.2 to catch cleanup, eg Bug 1927135 $maininterp eval { set argc 1 ; set argv -help } - list [catch {load {} Tk $maininterp} msg] $msg + load {} Tk $maininterp } -cleanup { interp delete $maininterp -} -match glob -result {1 {Command-specific options:*}} +} -returnCodes error -match glob -result {Command-specific options:*} # cleanup cleanupTests diff --git a/tests/menu.test b/tests/menu.test index c797281..aaadc86 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -5,95 +5,103 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +imageInit -# find the earth.gif file for use in these tests +# find the earth.gif file for use in these tests (tests 2.*) set earthPhotoFile [file join [file dirname [info script]] earth.gif] testConstraint hasEarthPhoto [file exists $earthPhotoFile] -test menu-1.1 {Tk_MenuCmd procedure} { - list [catch menu msg] $msg -} {1 {wrong # args: should be "menu pathName ?options?"}} -test menu-1.2 {Tk_MenuCmd procedure} { - list [catch "menu bogus" msg] $msg -} {1 {bad window path name "bogus"}} -test menu-1.3 {Tk_MenuCmd procedure} { - list [catch "menu .m1 foo" msg] $msg -} {1 {unknown option "foo"}} -test menu-1.4 {Tk_MenuCmd procedure} { - catch {destroy .m1} - list [catch {menu .m1} msg] $msg [destroy .m1] -} {0 .m1 {}} -test menu-1.5 {Tk_MenuCmd - creating menubar} { - catch {destroy .m1} +test menu-1.1 {Tk_MenuCmd procedure} -body { + menu +} -returnCodes error -result {wrong # args: should be "menu pathName ?-option value ...?"} +test menu-1.2 {Tk_MenuCmd procedure} -body { + menu bogus +} -returnCodes error -result {bad window path name "bogus"} +test menu-1.3 {Tk_MenuCmd procedure} -body { + destroy .m1 + menu .m1 foo +} -returnCodes error -result {unknown option "foo"} +test menu-1.4 {Tk_MenuCmd procedure} -body { + destroy .m1 + menu .m1 +} -cleanup { + deleteWindows +} -result {.m1} +test menu-1.5 {Tk_MenuCmd - creating menubar} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label Test -menu "" - list [. configure -menu .m1] [. configure -menu ""] [destroy .m1] -} {{} {} {}} -test menu-1.6 {Tk_MenuCmd procedure menu ref no cascade} { - catch {destroy .t2} - catch {destroy .m1} + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-1.6 {Tk_MenuCmd procedure menu ref no cascade} -setup { + deleteWindows +} -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 - list [catch {menu .m1} msg] $msg [destroy .m1 .t2] -} {0 .m1 {}} -test menu-1.7 {Tk_MenuCmd procedure one clone cascade} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .t2} + menu .m1 +} -cleanup { + deleteWindows +} -result {.m1} +test menu-1.7 {Tk_MenuCmd procedure one clone cascade} -setup { + deleteWindows +} -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 menu .m1 .m1 add cascade -menu .m2 - list [catch {menu .m2} msg] $msg [destroy .t2 .m1 .m2] -} {0 .m2 {}} -test menu-1.8 {Tk_MenuCmd procedure two clone cascades} { - catch {destroy .m1} - catch {destroy .t2} - catch {destroy .t3} - catch {destroy .m2} + menu .m2 +} -cleanup { + deleteWindows +} -result {.m2} +test menu-1.8 {Tk_MenuCmd procedure two clone cascades} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -menu .m2 toplevel .t2 -menu .m1 wm geometry .t2 +0+0 toplevel .t3 -menu .m1 wm geometry .t3 +0+0 - list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2] -} {0 .m2 {}} -test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} { - catch {destroy .t2} - catch {destroy .m1} - catch {destroy .t3} - catch {destroy .m2} + menu .m2 +} -cleanup { + deleteWindows +} -result {.m2} +test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} -setup { + deleteWindows +} -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 menu .m1 .m1 add cascade -menu .m2 toplevel .t3 -menu .m1 wm geometry .t3 +0+0 - list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2] -} {0 .m2 {}} -test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} { - catch {destroy .t2} - catch {destroy .t3} - catch {destroy .m1} - catch {destroy .m2} + list [menu .m2] +} -cleanup { + deleteWindows +} -result {.m2} +test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} -setup { + deleteWindows +} -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 toplevel .t3 -menu .m1 wm geometry .t3 +0+0 menu .m1 .m1 add cascade -menu .m2 - list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2] -} {0 .m2 {}} -test menu-1.11 {Tk_MenuCmd procedure three clones cascades} { - catch {destroy .t2} - catch {destroy .t3} - catch {destroy .t4} - catch {destroy .m1} - catch {destroy .m2} + list [menu .m2] +} -cleanup { + deleteWindows +} -result {.m2} +test menu-1.11 {Tk_MenuCmd procedure three clones cascades} -setup { + deleteWindows +} -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 toplevel .t3 -menu .m1 @@ -102,93 +110,175 @@ test menu-1.11 {Tk_MenuCmd procedure three clones cascades} { wm geometry .t4 +0+0 menu .m1 .m1 add cascade -menu .m2 - list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .t4 .m1 .m2] -} {0 .m2 {}} -test menu-1.12 {Tk_MenuCmd procedure} { - catch {destroy .t2} - catch {destroy .m1} + list [menu .m2] +} -cleanup { + deleteWindows +} -result {.m2} +test menu-1.12 {Tk_MenuCmd procedure} -setup { + deleteWindows +} -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 - list [catch {menu .m1} msg] $msg [destroy .t2 .m1] -} {0 .m1 {}} -test menu-1.13 {Tk_MenuCmd procedure} { - catch {destroy .t2} - catch {destroy .t3} - catch {destroy .m1} + list [menu .m1] +} -cleanup { + deleteWindows +} -result {.m1} +test menu-1.13 {Tk_MenuCmd procedure} -setup { + deleteWindows +} -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 toplevel .t3 -menu .m1 wm geometry .t3 +0+0 - list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .m1] -} {0 .m1 {}} -test menu-1.14 {Tk_MenuCmd procedure} { - catch {destroy .t2} - catch {destroy .t3} - catch {destroy .t4} - catch {destroy .m1} + list [menu .m1] +} -cleanup { + deleteWindows +} -result {.m1} +test menu-1.14 {Tk_MenuCmd procedure} -setup { + deleteWindows +} -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 toplevel .t3 -menu .m1 wm geometry .t3 +0+0 toplevel .t4 -menu .m1 wm geometry .t4 +0+0 - list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .t4 .m1] -} {0 .m1 {}} + list [menu .m1] +} -cleanup { + deleteWindows +} -result {.m1} -catch {destroy .m1} +# Used for 2.1 - 2.30 tests +destroy .m1 menu .m1 -set i 1 -foreach configTest { - {-activebackground #012345 #012345 non-existent - {unknown color name "non-existent"}} - {-activeborderwidth 1.3 1.3 badValue {bad screen distance "badValue"}} - {-activeforeground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bg #110022 #110022 bogus {unknown color name "bogus"}} - {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}} - {-fg #110022 #110022 bogus {unknown color name "bogus"}} - {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {} - {font "" doesn't exist}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"}} - {-postcommand "any old string" "any old string" {} {}} - {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}} - {-takefocus "any string" "any string" {} {}} - {-tearoff 0 0} - {-tearoff 1 1} - {-tearoffcommand "any old string" "any old string" {} {}} -} { - set name [lindex $configTest 0] - set value [lindex $configTest 1] - set result [lindex $configTest 2] - test menu-2.$i [list configuration options $name $value $result] { - .m1 configure $name $value - lindex [.m1 configure $name] 4 - } $result - incr i - if {[lindex $configTest 3] != ""} { - set value [lindex $configTest 3] - set result [lindex $configTest 4] - test menu-2.$i [list configuration options $name $value $result] { - list [catch {.m1 configure $name $value} msg] $msg - } [list 1 $result] - } - .m1 configure $name [lindex [.m1 configure $name] 3] - incr i -} +test menu-2.1 {configuration options -activebackground #012345} -body { + .m1 configure -activebackground #012345 + .m1 cget -activebackground +} -result {#012345} +test menu-2.2 {configuration options -activebackground non-existent} -body { + .m1 configure -activebackground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.3 {configuration options -activeborderwidth 1.3} -body { + .m1 configure -activeborderwidth 1.3 + .m1 cget -activeborderwidth +} -result {1.3} +test menu-2.4 {configuration options -activeborderwidth badValue} -body { + .m1 configure -activeborderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} + +test menu-2.5 {configuration options -activeforeground #ff0000} -body { + .m1 configure -activeforeground #ff0000 + .m1 cget -activeforeground +} -result {#ff0000} +test menu-2.6 {configuration options -activeforeground non-existent} -body { + .m1 configure -activeforeground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.7 {configuration options -background #ff0000} -body { + .m1 configure -background #ff0000 + .m1 cget -background +} -result {#ff0000} +test menu-2.8 {configuration options -background non-existent} -body { + .m1 configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.9 {configuration options -bg #110022} -body { + .m1 configure -bg #110022 + .m1 cget -bg +} -result {#110022} +test menu-2.10 {configuration options -bg bogus} -body { + .m1 configure -bg bogus +} -returnCodes error -result {unknown color name "bogus"} + +test menu-2.11 {configuration options -borderwidth 1.3} -body { + .m1 configure -borderwidth 1.3 + .m1 cget -borderwidth +} -result {1.3} +test menu-2.12 {configuration options -borderwidth badValue} -body { + .m1 configure -borderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} + +test menu-2.13 {configuration options -cursor arrow} -body { + .m1 configure -cursor arrow + .m1 cget -cursor +} -result {arrow} +test menu-2.14 {configuration options -cursor badValue} -body { + .m1 configure -cursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} + +test menu-2.15 {configuration options -disabledforeground #00ff00} -body { + .m1 configure -disabledforeground #00ff00 + .m1 cget -disabledforeground +} -result {#00ff00} +test menu-2.16 {configuration options -disabledforeground xyzzy} -body { + .m1 configure -disabledforeground xyzzy +} -returnCodes error -result {unknown color name "xyzzy"} + +test menu-2.17 {configuration options -fg #110022} -body { + .m1 configure -fg #110022 + .m1 cget -fg +} -result {#110022} +test menu-2.18 {configuration options -fg bogus} -body { + .m1 configure -fg bogus +} -returnCodes error -result {unknown color name "bogus"} + +test menu-2.19 {configuration options -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} -body { + .m1 configure -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* + .m1 cget -font +} -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} +test menu-2.20 {configuration options -foreground #110022} -body { + .m1 configure -foreground #110022 + .m1 cget -foreground +} -result {#110022} +test menu-2.21 {configuration options -foreground bogus} -body { + .m1 configure -foreground bogus +} -returnCodes error -result {unknown color name "bogus"} + +test menu-2.22 {configuration options -postcommand {any old string}} -body { + .m1 configure -postcommand {any old string} + .m1 cget -postcommand +} -result {any old string} +test menu-2.23 {configuration options -relief groove} -body { + .m1 configure -relief groove + .m1 cget -relief +} -result {groove} +test menu-2.24 {configuration options -relief 1.5} -body { + .m1 configure -relief 1.5 +} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} + +test menu-2.25 {configuration options -selectcolor #110022} -body { + .m1 configure -selectcolor #110022 + .m1 cget -selectcolor +} -result {#110022} +test menu-2.26 {configuration options -selectcolor bogus} -body { + .m1 configure -selectcolor bogus +} -returnCodes error -result {unknown color name "bogus"} + +test menu-2.27 {configuration options -takefocus {any string}} -body { + .m1 configure -takefocus {any string} + .m1 cget -takefocus +} -result {any string} +test menu-2.28 {configuration options -tearoff 0} -body { + .m1 configure -tearoff 0 + .m1 cget -tearoff +} -result {0} +test menu-2.29 {configuration options -tearoff 1} -body { + .m1 configure -tearoff 1 + .m1 cget -tearoff +} -result {1} +test menu-2.30 {configuration options -tearoffcommand {any old string}} -body { + .m1 configure -tearoffcommand {any old string} + .m1 cget -tearoffcommand +} -result {any old string} destroy .m1 # We need to test all of the options with all of the different types of # menu entries. The following code sets up .m1 with 6 items. It then -# runs through the big table below it. +# runs through the 2.31 - 2.228 tests below # index 0 is tearoff, 1 command, 2 cascade, 3 separator, 4 checkbutton, # 5 radiobutton - +deleteWindows menu .m1 .m1 add command -label "command" menu .m2 @@ -197,488 +287,1172 @@ menu .m2 .m1 add separator .m1 add checkbutton -label "checkbutton" -variable check -onvalue on -offvalue off .m1 add radiobutton -label "radiobutton" -variable radio + if {[testConstraint hasEarthPhoto]} { image create photo image1 -file $earthPhotoFile } -foreach configTest { - {-activebackground - {{#012345 - {{unknown option "-activebackground"} #012345 #012345 - {unknown option "-activebackground"} #012345 #012345 - } - } - {non-existent - {{unknown option "-activebackground"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - {unknown option "-activebackground"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - } - }} - } - {-activeforeground - {{#ff0000 - {{unknown option "-activeforeground"} - #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000 - } - } - {non-existent - {{unknown option "-activeforeground"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - {unknown option "-activeforeground"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - } - }} - } - {-accelerator - {{"Ctrl+S" - {{unknown option "-accelerator"} - "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"} - "Ctrl+S" "Ctrl+S" - } - }} - } - {-background - {{#ff0000 - {#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 - } - } - {non-existent - {{unknown color name "non-existent"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - } - }} - } - {-bitmap - {{questhead - {{unknown option "-bitmap"} questhead questhead - {unknown option "-bitmap"} questhead questhead - } - } - {badValue - {{unknown option "-bitmap"} - {bitmap "badValue" not defined} - {bitmap "badValue" not defined} - {unknown option "-bitmap"} - {bitmap "badValue" not defined} - {bitmap "badValue" not defined} - } - }} - } - {-columnbreak - {{1 - {{unknown option "-columnbreak"} 1 1 - {unknown option "-columnbreak"} 1 1} - }} - } - {-command - {{beep - {{unknown option "-command"} beep beep - {unknown option "-command"} beep beep - } - }} - } - {-font - {{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - {{unknown option "-font"} - -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - {unknown option "-font"} - -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - } - } - {{kill rock stars} - {{unknown option "-font"} - {expected integer but got "rock"} - {expected integer but got "rock"} - {unknown option "-font"} - {expected integer but got "rock"} - {expected integer but got "rock"} - } - }} - } - {-foreground - {{#110022 - {{unknown option "-foreground"} #110022 #110022 - {unknown option "-foreground"} #110022 #110022 - } - } - {non-existent - {{unknown option "-foreground"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - {unknown option "-foreground"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - } - }} - } - {-image - {{image1 - {{unknown option "-image"} image1 image1 - {unknown option "-image"} image1 image1 - } - } - {bogus - {{unknown option "-image"} - {image "bogus" doesn't exist} - {image "bogus" doesn't exist} - {unknown option "-image"} - {image "bogus" doesn't exist} - {image "bogus" doesn't exist} - } - } - {"" - {{unknown option "-image"} - {} - {} - {unknown option "-image"} - {} - {} - } - }} - } - {-indicatoron - {{1 - {{unknown option "-indicatoron"} - {unknown option "-indicatoron"} - {unknown option "-indicatoron"} - {unknown option "-indicatoron"} 1 1 - } - }} - } - {-label - {{test - {{unknown option "-label"} test test - {unknown option "-label"} test test - } - }} - } - {-menu - {{.m2 - {{unknown option "-menu"} - {unknown option "-menu"} .m2 - {unknown option "-menu"} - {unknown option "-menu"} - {unknown option "-menu"} - } - }} - } - {-offvalue - {{off - {{unknown option "-offvalue"} - {unknown option "-offvalue"} - {unknown option "-offvalue"} - {unknown option "-offvalue"} - off - {unknown option "-offvalue"} - } - }} - } - {-onvalue - {{on - {{unknown option "-onvalue"} - {unknown option "-onvalue"} - {unknown option "-onvalue"} - {unknown option "-onvalue"} - on - {unknown option "-onvalue"} - } - }} - } - {-selectcolor - {{#110022 - {{unknown option "-selectcolor"} - {unknown option "-selectcolor"} - {unknown option "-selectcolor"} - {unknown option "-selectcolor"} - #110022 - #110022 - } - } - {non-existent - {{unknown option "-selectcolor"} - {unknown option "-selectcolor"} - {unknown option "-selectcolor"} - {unknown option "-selectcolor"} - {unknown color name "non-existent"} - {unknown color name "non-existent"} - } - }} - } - {-selectimage - {{image1 - {{unknown option "-selectimage"} - {unknown option "-selectimage"} - {unknown option "-selectimage"} - {unknown option "-selectimage"} image1 image1 - } - } - {bogus - {{unknown option "-selectimage"} - {unknown option "-selectimage"} - {unknown option "-selectimage"} - {unknown option "-selectimage"} - {image "bogus" doesn't exist} - {image "bogus" doesn't exist} - } - } - {"" - {{unknown option "-selectimage"} - {unknown option "-selectimage"} - {unknown option "-selectimage"} - {unknown option "-selectimage"} - {} - {} - } - }} - } - {-state - {{normal - {normal normal normal {unknown option "-state"} normal normal - } - }} - } - {-value - {{"any string" - {{unknown option "-value"} - {unknown option "-value"} - {unknown option "-value"} - {unknown option "-value"} - {unknown option "-value"} "any string" - } - }} - } - {-variable - {{"any string" - {{unknown option "-variable"} - {unknown option "-variable"} - {unknown option "-variable"} - {unknown option "-variable"} - "any string" - "any string" - } - }} - } - {-underline - {{0 - {{unknown option "-underline"} 0 0 - {unknown option "-underline"} 0 0 - } - } - {3p - {{unknown option "-underline"} - {expected integer but got "3p"} - {expected integer but got "3p"} - {unknown option "-underline"} - {expected integer but got "3p"} - {expected integer but got "3p"} - } - }} - } -} { - set name [lindex $configTest 0] - foreach attempt [lindex $configTest 1] { - set value [lindex $attempt 0] - set options [lindex $attempt 1] - foreach item {0 1 2 3 4 5} { - catch {unset msg} - # OK, it's an overeager constraint, but it should also - # normally hold anyway - test menu-2.$i [list entry configuration options $name $item $value [.m1 type $item]] hasEarthPhoto { - set result [catch {.m1 entryconfigure $item $name $value} msg] - if {$result == 1} { - set msg - } else { - lindex [.m1 entryconfigure $item $name] 4 - } - } [lindex $options $item] - incr i - } - } -} +test menu-2.31 {entry configuration options 0 -activebackground #012345 tearoff} -body { + .m1 entryconfigure 0 -activebackground #012345 +} -returnCodes error -result {unknown option "-activebackground"} + +test menu-2.32 {entry configuration options 1 -activebackground #012345 command} -body { + .m1 entryconfigure 1 -activebackground #012345 + lindex [.m1 entryconfigure 1 -activebackground] 4 +} -result {#012345} + +test menu-2.33 {entry configuration options 2 -activebackground #012345 cascade} -body { + .m1 entryconfigure 2 -activebackground #012345 + lindex [.m1 entryconfigure 2 -activebackground] 4 +} -result {#012345} + +test menu-2.34 {entry configuration options 3 -activebackground #012345 separator} -body { + .m1 entryconfigure 3 -activebackground #012345 +} -returnCodes error -result {unknown option "-activebackground"} + +test menu-2.35 {entry configuration options 4 -activebackground #012345 checkbutton} -body { + .m1 entryconfigure 4 -activebackground #012345 + lindex [.m1 entryconfigure 4 -activebackground] 4 +} -result {#012345} + +test menu-2.36 {entry configuration options 5 -activebackground #012345 radiobutton} -body { + .m1 entryconfigure 5 -activebackground #012345 + lindex [.m1 entryconfigure 5 -activebackground] 4 +} -result {#012345} + +test menu-2.37 {entry configuration options 0 -activebackground non-existent tearoff} -body { + .m1 entryconfigure 0 -activebackground non-existent +} -returnCodes error -result {unknown option "-activebackground"} + +test menu-2.38 {entry configuration options 1 -activebackground non-existent command} -body { + .m1 entryconfigure 1 -activebackground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.39 {entry configuration options 2 -activebackground non-existent cascade} -body { + .m1 entryconfigure 2 -activebackground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.40 {entry configuration options 3 -activebackground non-existent separator} -body { + .m1 entryconfigure 3 -activebackground non-existent +} -returnCodes error -result {unknown option "-activebackground"} + +test menu-2.41 {entry configuration options 4 -activebackground non-existent checkbutton} -body { + .m1 entryconfigure 4 -activebackground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.42 {entry configuration options 5 -activebackground non-existent radiobutton} -body { + .m1 entryconfigure 5 -activebackground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.43 {entry configuration options 0 -activeforeground #ff0000 tearoff} -body { + .m1 entryconfigure 0 -activeforeground #ff0000 +} -returnCodes error -result {unknown option "-activeforeground"} + +test menu-2.44 {entry configuration options 1 -activeforeground #ff0000 command} -body { + .m1 entryconfigure 1 -activeforeground #ff0000 + lindex [.m1 entryconfigure 1 -activeforeground] 4 +} -result {#ff0000} + +test menu-2.45 {entry configuration options 2 -activeforeground #ff0000 cascade} -body { + .m1 entryconfigure 2 -activeforeground #ff0000 + lindex [.m1 entryconfigure 2 -activeforeground] 4 +} -result {#ff0000} + +test menu-2.46 {entry configuration options 3 -activeforeground #ff0000 separator} -body { + .m1 entryconfigure 3 -activeforeground #ff0000 +} -returnCodes error -result {unknown option "-activeforeground"} + +test menu-2.47 {entry configuration options 4 -activeforeground #ff0000 checkbutton} -body { + .m1 entryconfigure 4 -activeforeground #ff0000 + lindex [.m1 entryconfigure 4 -activeforeground] 4 +} -result {#ff0000} + +test menu-2.48 {entry configuration options 5 -activeforeground #ff0000 radiobutton} -body { + .m1 entryconfigure 5 -activeforeground #ff0000 + lindex [.m1 entryconfigure 5 -activeforeground] 4 +} -result {#ff0000} + +test menu-2.49 {entry configuration options 0 -activeforeground non-existent tearoff} -body { + .m1 entryconfigure 0 -activeforeground non-existent +} -returnCodes error -result {unknown option "-activeforeground"} + +test menu-2.50 {entry configuration options 1 -activeforeground non-existent command} -body { + .m1 entryconfigure 1 -activeforeground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.51 {entry configuration options 2 -activeforeground non-existent cascade} -body { + .m1 entryconfigure 2 -activeforeground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.52 {entry configuration options 3 -activeforeground non-existent separator} -body { + .m1 entryconfigure 3 -activeforeground non-existent +} -returnCodes error -result {unknown option "-activeforeground"} + +test menu-2.53 {entry configuration options 4 -activeforeground non-existent checkbutton} -body { + .m1 entryconfigure 4 -activeforeground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.54 {entry configuration options 5 -activeforeground non-existent radiobutton} -body { + .m1 entryconfigure 5 -activeforeground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.55 {entry configuration options 0 -accelerator Ctrl+S tearoff} -body { + .m1 entryconfigure 0 -accelerator Ctrl+S +} -returnCodes error -result {unknown option "-accelerator"} + +test menu-2.56 {entry configuration options 1 -accelerator Ctrl+S command} -body { + .m1 entryconfigure 1 -accelerator Ctrl+S + lindex [.m1 entryconfigure 1 -accelerator] 4 +} -result {Ctrl+S} + +test menu-2.57 {entry configuration options 2 -accelerator Ctrl+S cascade} -body { + .m1 entryconfigure 2 -accelerator Ctrl+S + lindex [.m1 entryconfigure 2 -accelerator] 4 +} -result {Ctrl+S} + +test menu-2.58 {entry configuration options 3 -accelerator Ctrl+S separator} -body { + .m1 entryconfigure 3 -accelerator Ctrl+S +} -returnCodes error -result {unknown option "-accelerator"} + +test menu-2.59 {entry configuration options 4 -accelerator Ctrl+S checkbutton} -body { + .m1 entryconfigure 4 -accelerator Ctrl+S + lindex [.m1 entryconfigure 4 -accelerator] 4 +} -result {Ctrl+S} + +test menu-2.60 {entry configuration options 5 -accelerator Ctrl+S radiobutton} -body { + .m1 entryconfigure 5 -accelerator Ctrl+S + lindex [.m1 entryconfigure 5 -accelerator] 4 +} -result {Ctrl+S} + +test menu-2.61 {entry configuration options 0 -background #ff0000 tearoff} -body { + .m1 entryconfigure 0 -background #ff0000 + lindex [.m1 entryconfigure 0 -background] 4 +} -result {#ff0000} + +test menu-2.62 {entry configuration options 1 -background #ff0000 command} -body { + .m1 entryconfigure 1 -background #ff0000 + lindex [.m1 entryconfigure 1 -background] 4 +} -result {#ff0000} + +test menu-2.63 {entry configuration options 2 -background #ff0000 cascade} -body { + .m1 entryconfigure 2 -background #ff0000 + lindex [.m1 entryconfigure 2 -background] 4 +} -result {#ff0000} + +test menu-2.64 {entry configuration options 3 -background #ff0000 separator} -body { + .m1 entryconfigure 3 -background #ff0000 + lindex [.m1 entryconfigure 3 -background] 4 +} -result {#ff0000} + +test menu-2.65 {entry configuration options 4 -background #ff0000 checkbutton} -body { + .m1 entryconfigure 4 -background #ff0000 + lindex [.m1 entryconfigure 4 -background] 4 +} -result {#ff0000} + +test menu-2.66 {entry configuration options 5 -background #ff0000 radiobutton} -body { + .m1 entryconfigure 5 -background #ff0000 + lindex [.m1 entryconfigure 5 -background] 4 +} -result {#ff0000} + +test menu-2.67 {entry configuration options 0 -background non-existent tearoff} -body { + .m1 entryconfigure 0 -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.68 {entry configuration options 1 -background non-existent command} -body { + .m1 entryconfigure 1 -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.69 {entry configuration options 2 -background non-existent cascade} -body { + .m1 entryconfigure 2 -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.70 {entry configuration options 3 -background non-existent separator} -body { + .m1 entryconfigure 3 -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.71 {entry configuration options 4 -background non-existent checkbutton} -body { + .m1 entryconfigure 4 -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.72 {entry configuration options 5 -background non-existent radiobutton} -body { + .m1 entryconfigure 5 -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.73 {entry configuration options 0 -bitmap questhead tearoff} -body { + .m1 entryconfigure 0 -bitmap questhead +} -returnCodes error -result {unknown option "-bitmap"} + +test menu-2.74 {entry configuration options 1 -bitmap questhead command} -body { + .m1 entryconfigure 1 -bitmap questhead + lindex [.m1 entryconfigure 1 -bitmap] 4 +} -result {questhead} + +test menu-2.75 {entry configuration options 2 -bitmap questhead cascade} -body { + .m1 entryconfigure 2 -bitmap questhead + lindex [.m1 entryconfigure 2 -bitmap] 4 +} -result {questhead} + +test menu-2.76 {entry configuration options 3 -bitmap questhead separator} -body { + .m1 entryconfigure 3 -bitmap questhead +} -returnCodes error -result {unknown option "-bitmap"} + +test menu-2.77 {entry configuration options 4 -bitmap questhead checkbutton} -body { + .m1 entryconfigure 4 -bitmap questhead + lindex [.m1 entryconfigure 4 -bitmap] 4 +} -result {questhead} + +test menu-2.78 {entry configuration options 5 -bitmap questhead radiobutton} -body { + .m1 entryconfigure 5 -bitmap questhead + lindex [.m1 entryconfigure 5 -bitmap] 4 +} -result {questhead} + +test menu-2.79 {entry configuration options 0 -bitmap badValue tearoff} -body { + .m1 entryconfigure 0 -bitmap badValue +} -returnCodes error -result {unknown option "-bitmap"} + +test menu-2.80 {entry configuration options 1 -bitmap badValue command} -body { + .m1 entryconfigure 1 -bitmap badValue +} -returnCodes error -result {bitmap "badValue" not defined} + +test menu-2.81 {entry configuration options 2 -bitmap badValue cascade} -body { + .m1 entryconfigure 2 -bitmap badValue +} -returnCodes error -result {bitmap "badValue" not defined} + +test menu-2.82 {entry configuration options 3 -bitmap badValue separator} -body { + .m1 entryconfigure 3 -bitmap badValue +} -returnCodes error -result {unknown option "-bitmap"} + +test menu-2.83 {entry configuration options 4 -bitmap badValue checkbutton} -body { + .m1 entryconfigure 4 -bitmap badValue +} -returnCodes error -result {bitmap "badValue" not defined} + +test menu-2.84 {entry configuration options 5 -bitmap badValue radiobutton} -body { + .m1 entryconfigure 5 -bitmap badValue +} -returnCodes error -result {bitmap "badValue" not defined} + +test menu-2.85 {entry configuration options 0 -columnbreak 1 tearoff} -body { + .m1 entryconfigure 0 -columnbreak 1 +} -returnCodes error -result {unknown option "-columnbreak"} + +test menu-2.86 {entry configuration options 1 -columnbreak 1 command} -body { + .m1 entryconfigure 1 -columnbreak 1 + lindex [.m1 entryconfigure 1 -columnbreak] 4 +} -result {1} + +test menu-2.87 {entry configuration options 2 -columnbreak 1 cascade} -body { + .m1 entryconfigure 2 -columnbreak 1 + lindex [.m1 entryconfigure 2 -columnbreak] 4 +} -result {1} + +test menu-2.88 {entry configuration options 3 -columnbreak 1 separator} -body { + .m1 entryconfigure 3 -columnbreak 1 +} -returnCodes error -result {unknown option "-columnbreak"} + +test menu-2.89 {entry configuration options 4 -columnbreak 1 checkbutton} -body { + .m1 entryconfigure 4 -columnbreak 1 + lindex [.m1 entryconfigure 4 -columnbreak] 4 +} -result {1} + +test menu-2.90 {entry configuration options 5 -columnbreak 1 radiobutton} -body { + .m1 entryconfigure 5 -columnbreak 1 + lindex [.m1 entryconfigure 5 -columnbreak] 4 +} -result {1} + +test menu-2.91 {entry configuration options 0 -command beep tearoff} -body { + .m1 entryconfigure 0 -command beep +} -returnCodes error -result {unknown option "-command"} + +test menu-2.92 {entry configuration options 1 -command beep command} -body { + .m1 entryconfigure 1 -command beep + lindex [.m1 entryconfigure 1 -command] 4 +} -result {beep} + +test menu-2.93 {entry configuration options 2 -command beep cascade} -body { + .m1 entryconfigure 2 -command beep + lindex [.m1 entryconfigure 2 -command] 4 +} -result {beep} + +test menu-2.94 {entry configuration options 3 -command beep separator} -body { + .m1 entryconfigure 3 -command beep +} -returnCodes error -result {unknown option "-command"} + +test menu-2.95 {entry configuration options 4 -command beep checkbutton} -body { + .m1 entryconfigure 4 -command beep + lindex [.m1 entryconfigure 4 -command] 4 +} -result {beep} + +test menu-2.96 {entry configuration options 5 -command beep radiobutton} -body { + .m1 entryconfigure 5 -command beep + lindex [.m1 entryconfigure 5 -command] 4 +} -result {beep} + +test menu-2.97 {entry configuration options 0 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* tearoff} -body { + .m1 entryconfigure 0 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* +} -returnCodes error -result {unknown option "-font"} + +test menu-2.98 {entry configuration options 1 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* command} -body { + .m1 entryconfigure 1 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* + lindex [.m1 entryconfigure 1 -font] 4 +} -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} + +test menu-2.99 {entry configuration options 2 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* cascade} -body { + .m1 entryconfigure 2 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* + lindex [.m1 entryconfigure 2 -font] 4 +} -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} + +test menu-2.100 {entry configuration options 3 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* separator} -body { + .m1 entryconfigure 3 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* +} -returnCodes error -result {unknown option "-font"} + +test menu-2.101 {entry configuration options 4 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* checkbutton} -body { + .m1 entryconfigure 4 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* + lindex [.m1 entryconfigure 4 -font] 4 +} -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} + +test menu-2.102 {entry configuration options 5 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* radiobutton} -body { + .m1 entryconfigure 5 -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* + lindex [.m1 entryconfigure 5 -font] 4 +} -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} + +test menu-2.103 {entry configuration options 0 -font {kill rock stars} tearoff} -body { + .m1 entryconfigure 0 -font {kill rock stars} +} -returnCodes error -result {unknown option "-font"} + +test menu-2.104 {entry configuration options 1 -font {kill rock stars} command} -body { + .m1 entryconfigure 1 -font {kill rock stars} +} -returnCodes error -result {expected integer but got "rock"} + +test menu-2.105 {entry configuration options 2 -font {kill rock stars} cascade} -body { + .m1 entryconfigure 2 -font {kill rock stars} +} -returnCodes error -result {expected integer but got "rock"} + +test menu-2.106 {entry configuration options 3 -font {kill rock stars} separator} -body { + .m1 entryconfigure 3 -font {kill rock stars} +} -returnCodes error -result {unknown option "-font"} + +test menu-2.107 {entry configuration options 4 -font {kill rock stars} checkbutton} -body { + .m1 entryconfigure 4 -font {kill rock stars} +} -returnCodes error -result {expected integer but got "rock"} + +test menu-2.108 {entry configuration options 5 -font {kill rock stars} radiobutton} -body { + .m1 entryconfigure 5 -font {kill rock stars} +} -returnCodes error -result {expected integer but got "rock"} + +test menu-2.109 {entry configuration options 0 -foreground #110022 tearoff} -body { + .m1 entryconfigure 0 -foreground #110022 +} -returnCodes error -result {unknown option "-foreground"} + +test menu-2.110 {entry configuration options 1 -foreground #110022 command} -body { + .m1 entryconfigure 1 -foreground #110022 + lindex [.m1 entryconfigure 1 -foreground] 4 +} -result {#110022} + +test menu-2.111 {entry configuration options 2 -foreground #110022 cascade} -body { + .m1 entryconfigure 2 -foreground #110022 + lindex [.m1 entryconfigure 2 -foreground] 4 +} -result {#110022} + +test menu-2.112 {entry configuration options 3 -foreground #110022 separator} -body { + .m1 entryconfigure 3 -foreground #110022 +} -returnCodes error -result {unknown option "-foreground"} + +test menu-2.113 {entry configuration options 4 -foreground #110022 checkbutton} -body { + .m1 entryconfigure 4 -foreground #110022 + lindex [.m1 entryconfigure 4 -foreground] 4 +} -result {#110022} + +test menu-2.114 {entry configuration options 5 -foreground #110022 radiobutton} -body { + .m1 entryconfigure 5 -foreground #110022 + lindex [.m1 entryconfigure 5 -foreground] 4 +} -result {#110022} + +test menu-2.115 {entry configuration options 0 -foreground non-existent tearoff} -body { + .m1 entryconfigure 0 -foreground non-existent +} -returnCodes error -result {unknown option "-foreground"} + +test menu-2.116 {entry configuration options 1 -foreground non-existent command} -body { + .m1 entryconfigure 1 -foreground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.117 {entry configuration options 2 -foreground non-existent cascade} -body { + .m1 entryconfigure 2 -foreground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.118 {entry configuration options 3 -foreground non-existent separator} -body { + .m1 entryconfigure 3 -foreground non-existent +} -returnCodes error -result {unknown option "-foreground"} + +test menu-2.119 {entry configuration options 4 -foreground non-existent checkbutton} -body { + .m1 entryconfigure 4 -foreground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.120 {entry configuration options 5 -foreground non-existent radiobutton} -body { + .m1 entryconfigure 5 -foreground non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.121 {entry configuration options 0 -image image1 tearoff} -constraints { + hasEarthPhoto +} -body { + .m1 entryconfigure 0 -image image1 +} -returnCodes error -result {unknown option "-image"} + +test menu-2.122 {entry configuration options 1 -image image1 command} -constraints { + hasEarthPhoto +} -setup { + .m1 entryconfigure 1 -image {} +} -body { + .m1 entryconfigure 1 -image image1 + lindex [.m1 entryconfigure 1 -image] 4 +} -cleanup { + .m1 entryconfigure 1 -image {} +} -result {image1} + +test menu-2.123 {entry configuration options 2 -image image1 cascade} -constraints { + hasEarthPhoto +} -setup { + .m1 entryconfigure 2 -image {} +} -body { + .m1 entryconfigure 2 -image image1 + lindex [.m1 entryconfigure 2 -image] 4 +} -cleanup { + .m1 entryconfigure 2 -image {} +} -result {image1} + +test menu-2.124 {entry configuration options 3 -image image1 separator} -constraints { + hasEarthPhoto +} -body { + .m1 entryconfigure 3 -image image1 +} -returnCodes error -result {unknown option "-image"} + +test menu-2.125 {entry configuration options 4 -image image1 checkbutton} -constraints { + hasEarthPhoto +} -setup { + .m1 entryconfigure 4 -image {} +} -body { + .m1 entryconfigure 4 -image image1 + lindex [.m1 entryconfigure 4 -image] 4 +} -cleanup { + .m1 entryconfigure 4 -image {} +} -result {image1} + +test menu-2.126 {entry configuration options 5 -image image1 radiobutton} -constraints { + hasEarthPhoto +} -setup { + .m1 entryconfigure 5 -image {} +} -body { + .m1 entryconfigure 5 -image image1 + lindex [.m1 entryconfigure 5 -image] 4 +} -cleanup { + .m1 entryconfigure 5 -image {} +} -result {image1} + +test menu-2.127 {entry configuration options 0 -image bogus tearoff} -body { + .m1 entryconfigure 0 -image bogus +} -returnCodes error -result {unknown option "-image"} + +test menu-2.128 {entry configuration options 1 -image bogus command} -body { + .m1 entryconfigure 1 -image bogus +} -returnCodes error -result {image "bogus" doesn't exist} + +test menu-2.129 {entry configuration options 2 -image bogus cascade} -body { + .m1 entryconfigure 2 -image bogus +} -returnCodes error -result {image "bogus" doesn't exist} + +test menu-2.130 {entry configuration options 3 -image bogus separator} -body { + .m1 entryconfigure 3 -image bogus +} -returnCodes error -result {unknown option "-image"} + +test menu-2.131 {entry configuration options 4 -image bogus checkbutton} -body { + .m1 entryconfigure 4 -image bogus +} -returnCodes error -result {image "bogus" doesn't exist} + +test menu-2.132 {entry configuration options 5 -image bogus radiobutton} -body { + .m1 entryconfigure 5 -image bogus +} -returnCodes error -result {image "bogus" doesn't exist} + +test menu-2.133 {entry configuration options 0 -image {} tearoff} -body { + .m1 entryconfigure 0 -image +} -returnCodes error -result {unknown option "-image"} + +test menu-2.134 {entry configuration options 1 -image {} command} -setup { + .m1 entryconfigure 1 -image {} +} -body { + .m1 entryconfigure 1 -image + lindex [.m1 entryconfigure 1 -image] 4 +} -result {} + +test menu-2.135 {entry configuration options 2 -image {} cascade} -setup { + .m1 entryconfigure 2 -image {} +} -body { + .m1 entryconfigure 2 -image + lindex [.m1 entryconfigure 2 -image] 4 +} -result {} + +test menu-2.136 {entry configuration options 3 -image {} separator} -body { + .m1 entryconfigure 3 -image +} -returnCodes error -result {unknown option "-image"} + +test menu-2.137 {entry configuration options 4 -image {} checkbutton} -body { + .m1 entryconfigure 4 -image + lindex [.m1 entryconfigure 4 -image] 4 +} -result {} + +test menu-2.138 {entry configuration options 5 -image {} radiobutton} -body { + .m1 entryconfigure 5 -image + lindex [.m1 entryconfigure 5 -image] 4 +} -result {} + +test menu-2.139 {entry configuration options 0 -indicatoron 1 tearoff} -body { + .m1 entryconfigure 0 -indicatoron 1 +} -returnCodes error -result {unknown option "-indicatoron"} + +test menu-2.140 {entry configuration options 1 -indicatoron 1 command} -body { + .m1 entryconfigure 1 -indicatoron 1 +} -returnCodes error -result {unknown option "-indicatoron"} + +test menu-2.141 {entry configuration options 2 -indicatoron 1 cascade} -body { + .m1 entryconfigure 2 -indicatoron 1 +} -returnCodes error -result {unknown option "-indicatoron"} + +test menu-2.142 {entry configuration options 3 -indicatoron 1 separator} -body { + .m1 entryconfigure 3 -indicatoron 1 +} -returnCodes error -result {unknown option "-indicatoron"} + +test menu-2.143 {entry configuration options 4 -indicatoron 1 checkbutton} -body { + .m1 entryconfigure 4 -indicatoron 1 + lindex [.m1 entryconfigure 4 -indicatoron] 4 +} -result {1} + +test menu-2.144 {entry configuration options 5 -indicatoron 1 radiobutton} -body { + .m1 entryconfigure 5 -indicatoron 1 + lindex [.m1 entryconfigure 5 -indicatoron] 4 +} -result {1} + +test menu-2.145 {entry configuration options 0 -label test tearoff} -body { + .m1 entryconfigure 0 -label test +} -returnCodes error -result {unknown option "-label"} + +test menu-2.146 {entry configuration options 1 -label test command} -body { + .m1 entryconfigure 1 -label test + lindex [.m1 entryconfigure 1 -label] 4 +} -result {test} + +test menu-2.147 {entry configuration options 2 -label test cascade} -body { + .m1 entryconfigure 2 -label test + lindex [.m1 entryconfigure 2 -label] 4 +} -result {test} + +test menu-2.148 {entry configuration options 3 -label test separator} -body { + .m1 entryconfigure 3 -label test +} -returnCodes error -result {unknown option "-label"} + +test menu-2.149 {entry configuration options 4 -label test checkbutton} -body { + .m1 entryconfigure 4 -label test + lindex [.m1 entryconfigure 4 -label] 4 +} -result {test} + +test menu-2.150 {entry configuration options 5 -label test radiobutton} -body { + .m1 entryconfigure 5 -label test + lindex [.m1 entryconfigure 5 -label] 4 +} -result {test} + +test menu-2.151 {entry configuration options 0 -menu .m2 tearoff} -body { + .m1 entryconfigure 0 -menu .m2 +} -returnCodes error -result {unknown option "-menu"} + +test menu-2.152 {entry configuration options 1 -menu .m2 command} -body { + .m1 entryconfigure 1 -menu .m2 +} -returnCodes error -result {unknown option "-menu"} + +test menu-2.153 {entry configuration options 2 -menu .m2 cascade} -body { + .m1 entryconfigure 2 -menu .m2 + lindex [.m1 entryconfigure 2 -menu] 4 +} -result {.m2} + +test menu-2.154 {entry configuration options 3 -menu .m2 separator} -body { + .m1 entryconfigure 3 -menu .m2 +} -returnCodes error -result {unknown option "-menu"} + +test menu-2.155 {entry configuration options 4 -menu .m2 checkbutton} -body { + .m1 entryconfigure 4 -menu .m2 +} -returnCodes error -result {unknown option "-menu"} + +test menu-2.156 {entry configuration options 5 -menu .m2 radiobutton} -body { + .m1 entryconfigure 5 -menu .m2 +} -returnCodes error -result {unknown option "-menu"} + +test menu-2.157 {entry configuration options 0 -offvalue off tearoff} -body { + .m1 entryconfigure 0 -offvalue off +} -returnCodes error -result {unknown option "-offvalue"} + +test menu-2.158 {entry configuration options 1 -offvalue off command} -body { + .m1 entryconfigure 1 -offvalue off +} -returnCodes error -result {unknown option "-offvalue"} + +test menu-2.159 {entry configuration options 2 -offvalue off cascade} -body { + .m1 entryconfigure 2 -offvalue off +} -returnCodes error -result {unknown option "-offvalue"} + +test menu-2.160 {entry configuration options 3 -offvalue off separator} -body { + .m1 entryconfigure 3 -offvalue off +} -returnCodes error -result {unknown option "-offvalue"} + +test menu-2.161 {entry configuration options 4 -offvalue off checkbutton} -body { + .m1 entryconfigure 4 -offvalue off + lindex [.m1 entryconfigure 4 -offvalue] 4 +} -result {off} + +test menu-2.162 {entry configuration options 5 -offvalue off radiobutton} -body { + .m1 entryconfigure 5 -offvalue off +} -returnCodes error -result {unknown option "-offvalue"} + +test menu-2.163 {entry configuration options 0 -onvalue on tearoff} -body { + .m1 entryconfigure 0 -onvalue on +} -returnCodes error -result {unknown option "-onvalue"} + +test menu-2.164 {entry configuration options 1 -onvalue on command} -body { + .m1 entryconfigure 1 -onvalue on +} -returnCodes error -result {unknown option "-onvalue"} + +test menu-2.165 {entry configuration options 2 -onvalue on cascade} -body { + .m1 entryconfigure 2 -onvalue on +} -returnCodes error -result {unknown option "-onvalue"} + +test menu-2.166 {entry configuration options 3 -onvalue on separator} -body { + .m1 entryconfigure 3 -onvalue on +} -returnCodes error -result {unknown option "-onvalue"} + +test menu-2.167 {entry configuration options 4 -onvalue on checkbutton} -body { + .m1 entryconfigure 4 -onvalue on + lindex [.m1 entryconfigure 4 -onvalue] 4 +} -result {on} + +test menu-2.168 {entry configuration options 5 -onvalue on radiobutton} -body { + .m1 entryconfigure 5 -onvalue on +} -returnCodes error -result {unknown option "-onvalue"} + +test menu-2.169 {entry configuration options 0 -selectcolor #110022 tearoff} -body { + .m1 entryconfigure 0 -selectcolor #110022 +} -returnCodes error -result {unknown option "-selectcolor"} + +test menu-2.170 {entry configuration options 1 -selectcolor #110022 command} -body { + .m1 entryconfigure 1 -selectcolor #110022 +} -returnCodes error -result {unknown option "-selectcolor"} + +test menu-2.171 {entry configuration options 2 -selectcolor #110022 cascade} -body { + .m1 entryconfigure 2 -selectcolor #110022 +} -returnCodes error -result {unknown option "-selectcolor"} + +test menu-2.172 {entry configuration options 3 -selectcolor #110022 separator} -body { + .m1 entryconfigure 3 -selectcolor #110022 +} -returnCodes error -result {unknown option "-selectcolor"} + +test menu-2.173 {entry configuration options 4 -selectcolor #110022 checkbutton} -body { + .m1 entryconfigure 4 -selectcolor #110022 + lindex [.m1 entryconfigure 4 -selectcolor] 4 +} -result {#110022} + +test menu-2.174 {entry configuration options 5 -selectcolor #110022 radiobutton} -body { + .m1 entryconfigure 5 -selectcolor #110022 + lindex [.m1 entryconfigure 5 -selectcolor] 4 +} -result {#110022} + +test menu-2.175 {entry configuration options 0 -selectcolor non-existent tearoff} -body { + .m1 entryconfigure 0 -selectcolor non-existent +} -returnCodes error -result {unknown option "-selectcolor"} + +test menu-2.176 {entry configuration options 1 -selectcolor non-existent command} -body { + .m1 entryconfigure 1 -selectcolor non-existent +} -returnCodes error -result {unknown option "-selectcolor"} + +test menu-2.177 {entry configuration options 2 -selectcolor non-existent cascade} -body { + .m1 entryconfigure 2 -selectcolor non-existent +} -returnCodes error -result {unknown option "-selectcolor"} + +test menu-2.178 {entry configuration options 3 -selectcolor non-existent separator} -body { + .m1 entryconfigure 3 -selectcolor non-existent +} -returnCodes error -result {unknown option "-selectcolor"} + +test menu-2.179 {entry configuration options 4 -selectcolor non-existent checkbutton} -body { + .m1 entryconfigure 4 -selectcolor non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.180 {entry configuration options 5 -selectcolor non-existent radiobutton} -body { + .m1 entryconfigure 5 -selectcolor non-existent +} -returnCodes error -result {unknown color name "non-existent"} + +test menu-2.181 {entry configuration options 0 -selectimage image1 tearoff} -constraints { + hasEarthPhoto +} -body { + .m1 entryconfigure 0 -selectimage image1 +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.182 {entry configuration options 1 -selectimage image1 command} -constraints { + hasEarthPhoto +} -body { + .m1 entryconfigure 1 -selectimage image1 +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.183 {entry configuration options 2 -selectimage image1 cascade} -constraints { + hasEarthPhoto +} -body { + .m1 entryconfigure 2 -selectimage image1 +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.184 {entry configuration options 3 -selectimage image1 separator} -constraints { + hasEarthPhoto +} -body { + .m1 entryconfigure 3 -selectimage image1 +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.185 {entry configuration options 4 -selectimage image1 checkbutton} -constraints { + hasEarthPhoto +} -setup { + .m1 entryconfigure 4 -selectimage {} +} -body { + .m1 entryconfigure 4 -selectimage image1 + lindex [.m1 entryconfigure 4 -selectimage] 4 +} -cleanup { + .m1 entryconfigure 4 -selectimage {} +} -result {image1} + +test menu-2.186 {entry configuration options 5 -selectimage image1 radiobutton} -constraints { + hasEarthPhoto +} -setup { + .m1 entryconfigure 5 -selectimage {} +} -body { + .m1 entryconfigure 5 -selectimage image1 + lindex [.m1 entryconfigure 5 -selectimage] 4 +} -cleanup { + .m1 entryconfigure 5 -selectimage {} +} -result {image1} +test menu-2.187 {entry configuration options 0 -selectimage bogus tearoff} -body { + .m1 entryconfigure 0 -selectimage bogus +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.188 {entry configuration options 1 -selectimage bogus command} -body { + .m1 entryconfigure 1 -selectimage bogus +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.189 {entry configuration options 2 -selectimage bogus cascade} -body { + .m1 entryconfigure 2 -selectimage bogus +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.190 {entry configuration options 3 -selectimage bogus separator} -body { + .m1 entryconfigure 3 -selectimage bogus +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.191 {entry configuration options 4 -selectimage bogus checkbutton} -body { + .m1 entryconfigure 4 -selectimage bogus +} -returnCodes error -result {image "bogus" doesn't exist} + +test menu-2.192 {entry configuration options 5 -selectimage bogus radiobutton} -body { + .m1 entryconfigure 5 -selectimage bogus +} -returnCodes error -result {image "bogus" doesn't exist} + +test menu-2.193 {entry configuration options 0 -selectimage {} tearoff} -body { + .m1 entryconfigure 0 -selectimage +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.194 {entry configuration options 1 -selectimage {} command} -body { + .m1 entryconfigure 1 -selectimage +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.195 {entry configuration options 2 -selectimage {} cascade} -body { + .m1 entryconfigure 2 -selectimage +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.196 {entry configuration options 3 -selectimage {} separator} -body { + .m1 entryconfigure 3 -selectimage +} -returnCodes error -result {unknown option "-selectimage"} + +test menu-2.197 {entry configuration options 4 -selectimage {} checkbutton} -body { + .m1 entryconfigure 4 -selectimage + lindex [.m1 entryconfigure 4 -selectimage] 4 +} -result {} + +test menu-2.198 {entry configuration options 5 -selectimage {} radiobutton} -body { + .m1 entryconfigure 5 -selectimage + lindex [.m1 entryconfigure 5 -selectimage] 4 +} -result {} + +test menu-2.199 {entry configuration options 0 -state normal tearoff} -body { + .m1 entryconfigure 0 -state normal + lindex [.m1 entryconfigure 0 -state] 4 +} -result {normal} + +test menu-2.200 {entry configuration options 1 -state normal command} -body { + .m1 entryconfigure 1 -state normal + lindex [.m1 entryconfigure 1 -state] 4 +} -result {normal} + +test menu-2.201 {entry configuration options 2 -state normal cascade} -body { + .m1 entryconfigure 2 -state normal + lindex [.m1 entryconfigure 2 -state] 4 +} -result {normal} + +test menu-2.202 {entry configuration options 3 -state normal separator} -body { + .m1 entryconfigure 3 -state normal +} -returnCodes error -result {unknown option "-state"} + +test menu-2.203 {entry configuration options 4 -state normal checkbutton} -body { + .m1 entryconfigure 4 -state normal + lindex [.m1 entryconfigure 4 -state] 4 +} -result {normal} + +test menu-2.204 {entry configuration options 5 -state normal radiobutton} -body { + .m1 entryconfigure 5 -state normal + lindex [.m1 entryconfigure 5 -state] 4 +} -result {normal} + +test menu-2.205 {entry configuration options 0 -value {any string} tearoff} -body { + .m1 entryconfigure 0 -value {any string} +} -returnCodes error -result {unknown option "-value"} + +test menu-2.206 {entry configuration options 1 -value {any string} command} -body { + .m1 entryconfigure 1 -value {any string} +} -returnCodes error -result {unknown option "-value"} + +test menu-2.207 {entry configuration options 2 -value {any string} cascade} -body { + .m1 entryconfigure 2 -value {any string} +} -returnCodes error -result {unknown option "-value"} + +test menu-2.208 {entry configuration options 3 -value {any string} separator} -body { + .m1 entryconfigure 3 -value {any string} +} -returnCodes error -result {unknown option "-value"} + +test menu-2.209 {entry configuration options 4 -value {any string} checkbutton} -body { + .m1 entryconfigure 4 -value {any string} +} -returnCodes error -result {unknown option "-value"} + +test menu-2.210 {entry configuration options 5 -value {any string} radiobutton} -body { + .m1 entryconfigure 5 -value {any string} + lindex [.m1 entryconfigure 5 -value] 4 +} -result {any string} + +test menu-2.211 {entry configuration options 0 -variable {any string} tearoff} -body { + .m1 entryconfigure 0 -variable {any string} +} -returnCodes error -result {unknown option "-variable"} + +test menu-2.212 {entry configuration options 1 -variable {any string} command} -body { + .m1 entryconfigure 1 -variable {any string} +} -returnCodes error -result {unknown option "-variable"} + +test menu-2.213 {entry configuration options 2 -variable {any string} cascade} -body { + .m1 entryconfigure 2 -variable {any string} +} -returnCodes error -result {unknown option "-variable"} + +test menu-2.214 {entry configuration options 3 -variable {any string} separator} -body { + .m1 entryconfigure 3 -variable {any string} +} -returnCodes error -result {unknown option "-variable"} + +test menu-2.215 {entry configuration options 4 -variable {any string} checkbutton} -body { + .m1 entryconfigure 4 -variable {any string} + lindex [.m1 entryconfigure 4 -variable] 4 +} -result {any string} + +test menu-2.216 {entry configuration options 5 -variable {any string} radiobutton} -body { + .m1 entryconfigure 5 -variable {any string} + lindex [.m1 entryconfigure 5 -variable] 4 +} -result {any string} + +test menu-2.217 {entry configuration options 0 -underline 0 tearoff} -body { + .m1 entryconfigure 0 -underline 0 +} -returnCodes error -result {unknown option "-underline"} + +test menu-2.218 {entry configuration options 1 -underline 0 command} -body { + .m1 entryconfigure 1 -underline 0 + lindex [.m1 entryconfigure 1 -underline] 4 +} -result {0} + +test menu-2.219 {entry configuration options 2 -underline 0 cascade} -body { + .m1 entryconfigure 2 -underline 0 + lindex [.m1 entryconfigure 2 -underline] 4 +} -result {0} + +test menu-2.220 {entry configuration options 3 -underline 0 separator} -body { + .m1 entryconfigure 3 -underline 0 +} -returnCodes error -result {unknown option "-underline"} + +test menu-2.221 {entry configuration options 4 -underline 0 checkbutton} -body { + .m1 entryconfigure 4 -underline 0 + lindex [.m1 entryconfigure 4 -underline] 4 +} -result {0} + +test menu-2.222 {entry configuration options 5 -underline 0 radiobutton} -body { + .m1 entryconfigure 5 -underline 0 + lindex [.m1 entryconfigure 5 -underline] 4 +} -result {0} + +test menu-2.223 {entry configuration options 0 -underline 3p tearoff} -body { + .m1 entryconfigure 0 -underline 3p +} -returnCodes error -result {unknown option "-underline"} + +test menu-2.224 {entry configuration options 1 -underline 3p command} -body { + .m1 entryconfigure 1 -underline 3p +} -returnCodes error -result {expected integer but got "3p"} + +test menu-2.225 {entry configuration options 2 -underline 3p cascade} -body { + .m1 entryconfigure 2 -underline 3p +} -returnCodes error -result {expected integer but got "3p"} + +test menu-2.226 {entry configuration options 3 -underline 3p separator} -body { + .m1 entryconfigure 3 -underline 3p +} -returnCodes error -result {unknown option "-underline"} + +test menu-2.227 {entry configuration options 4 -underline 3p checkbutton} -body { + .m1 entryconfigure 4 -underline 3p +} -returnCodes error -result {expected integer but got "3p"} + +test menu-2.228 {entry configuration options 5 -underline 3p radiobutton} -body { + .m1 entryconfigure 5 -underline 3p +} -returnCodes error -result {expected integer but got "3p"} + +deleteWindows if {[testConstraint hasEarthPhoto]} { image delete image1 } -destroy .m1 -destroy .m2 -test menu-3.1 {MenuWidgetCmd procedure} { - catch {destroy .m1} + + +test menu-3.1 {MenuWidgetCmd procedure} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}} -test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {nonUnixUserInteraction } { - catch {destroy .m1} + .m1 +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 option ?arg ...?"} +test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} -constraints { + nonUnixUserInteraction +} -setup { + destroy .m1 +} -body { menu .m1 -postcommand "destroy .m1" .m1 add command -label "menu-3.2: Hit Escape" - list [catch {.m1 post 40 40} msg] $msg -} {0 {}} -test menu-3.3 {MenuWidgetCmd procedure, "activate" option} { - catch {destroy .m1} + .m1 post 40 40 +} -cleanup { + destroy .m1 +} -returnCodes ok -result {} +test menu-3.3 {MenuWidgetCmd procedure, "activate" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 activate} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 activate index"} {}} -test menu-3.4 {MenuWidgetCmd procedure, "activate" option} { - catch {destroy .m1} + .m1 activate +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 activate index"} +test menu-3.4 {MenuWidgetCmd procedure, "activate" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 activate "foo"} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-3.5 {MenuWidgetCmd procedure, "activate" option} { - catch {destroy .m1} + .m1 activate "foo" +} -returnCodes error -result {bad menu entry index "foo"} +test menu-3.5 {MenuWidgetCmd procedure, "activate" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" .m1 add separator - list [catch {.m1 activate 2} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.6 {MenuWidgetCmd procedure, "activate" option} { - catch {destroy .m1} + .m1 activate 2 +} -cleanup { + destroy .m1 +} -result {} +test menu-3.6 {MenuWidgetCmd procedure, "activate" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" .m1 entryconfigure 1 -state disabled - list [catch {.m1 activate 1} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.7 {MenuWidgetCmd procedure, "activate" option} { - catch {destroy .m1} + .m1 activate 1 +} -cleanup { + destroy .m1 +} -result {} +test menu-3.7 {MenuWidgetCmd procedure, "activate" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 activate 1} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.8 {MenuWidgetCmd procedure, "add" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 add type ?options?"} {}} -test menu-3.9 {MenuWidgetCmd procedure, "add" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add foo} msg] $msg [destroy .m1] -} {1 {bad menu entry type "foo": must be cascade, checkbutton, command, radiobutton, or separator} {}} -test menu-3.10 {MenuWidgetCmd procedure, "add" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add separator} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.11 {MenuWidgetCmd procedure, "cget" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 cget} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 cget option"} {}} -test menu-3.12 {MenuWidgetCmd procedure, "cget" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 cget -gorp} msg] $msg [destroy .m1] -} {1 {unknown option "-gorp"} {}} -test menu-3.13 {MenuWidgetCmd procedure, "cget" option} { - catch {destroy .m1} + .m1 activate 1 +} -cleanup { + destroy .m1 +} -result {} +test menu-3.8 {MenuWidgetCmd procedure, "add" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 add +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 add type ?-option value ...?"} +test menu-3.9 {MenuWidgetCmd procedure, "add" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 add foo +} -cleanup { + destroy .m1 +} -returnCodes error -result {bad menu entry type "foo": must be cascade, checkbutton, command, radiobutton, or separator} +test menu-3.10 {MenuWidgetCmd procedure, "add" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 add separator +} -cleanup { + destroy .m1 +} -result {} +test menu-3.11 {MenuWidgetCmd procedure, "cget" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 cget +} -returnCodes error -result {wrong # args: should be ".m1 cget option"} +test menu-3.12 {MenuWidgetCmd procedure, "cget" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 cget -gorp +} -returnCodes error -result {unknown option "-gorp"} +test menu-3.13 {MenuWidgetCmd procedure, "cget" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 configure -postcommand "Some string" - list [catch {.m1 cget -postcommand} msg] $msg [destroy .m1] -} {0 {Some string} {}} -test menu-3.14 {MenuWidgetCmd procedure, "clone" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 clone} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}} -test menu-3.15 {MenuWidgetCmd procedure, "clone" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 clone a b c d} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}} -test menu-3.16 {MenuWidgetCmd procedure, "clone" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 clone .m1.clone1} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.17 {MenuWidgetCmd procedure, "clone" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 clone .m1.clone1 tearoff} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.18 {MenuWidgetCmd procedure, "configure" option} { - catch {destroy .m1} - menu .m1 - list [catch {llength [.m1 configure]} msg] $msg [destroy .m1] -} {0 20 {}} -test menu-3.19 {MenuWidgetCmd procedure, "configure" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 configure -gorp} msg] $msg [destroy .m1] -} {1 {unknown option "-gorp"} {}} -test menu-3.20 {MenuWidgetCmd procedure, "configure" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 configure -postcommand "A random String"} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.21 {MenuWidgetCmd procedure, "configure" option} { - catch {destroy .m1} + .m1 cget -postcommand +} -cleanup { + destroy .m1 +} -result {Some string} +test menu-3.14 {MenuWidgetCmd procedure, "clone" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 clone +} -returnCodes error -result {wrong # args: should be ".m1 clone newMenuName ?menuType?"} +test menu-3.15 {MenuWidgetCmd procedure, "clone" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 clone a b c d +} -returnCodes error -result {wrong # args: should be ".m1 clone newMenuName ?menuType?"} +test menu-3.16 {MenuWidgetCmd procedure, "clone" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 clone .m1.clone1 +} -cleanup { + destroy .m1 +} -result {} +test menu-3.17 {MenuWidgetCmd procedure, "clone" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 clone .m1.clone1 tearoff +} -cleanup { + destroy .m1 +} -result {} +test menu-3.18 {MenuWidgetCmd procedure, "configure" option} -setup { + destroy .m1 +} -body { + menu .m1 + llength [.m1 configure] +} -cleanup { + destroy .m1 +} -result {20} +test menu-3.19 {MenuWidgetCmd procedure, "configure" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 configure -gorp +} -returnCodes error -result {unknown option "-gorp"} +test menu-3.20 {MenuWidgetCmd procedure, "configure" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 configure -postcommand "A random String" +} -cleanup { + destroy .m1 +} -result {} +test menu-3.21 {MenuWidgetCmd procedure, "configure" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 configure -postcommand "Another string" - list [catch {lindex [.m1 configure -postcommand] 4} msg] $msg [destroy .m1] -} {0 {Another string} {}} -test menu-3.22 {MenuWidgetCmd procedure, "delete" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 delete} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 delete first ?last?"} {}} -test menu-3.23 {MenuWidgetCmd procedure, "delete" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 delete foo} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-3.24 {MenuWidgetCmd procedure, "delete" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 delete 0 "foo"} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-3.25 {MenuWidgetCmd procedure, "delete" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 delete 0} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.26 {MenuWidgetCmd procedure, "delete" option} { - catch {destroy .m1} + lindex [.m1 configure -postcommand] 4 +} -cleanup { + destroy .m1 +} -result {Another string} +test menu-3.22 {MenuWidgetCmd procedure, "delete" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 delete +} -returnCodes error -result {wrong # args: should be ".m1 delete first ?last?"} +test menu-3.23 {MenuWidgetCmd procedure, "delete" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 delete foo +} -returnCodes error -result {bad menu entry index "foo"} +test menu-3.24 {MenuWidgetCmd procedure, "delete" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 delete 0 "foo" +} -returnCodes error -result {bad menu entry index "foo"} +test menu-3.25 {MenuWidgetCmd procedure, "delete" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 delete 0 +} -cleanup { + destroy .m1 +} -result {} +test menu-3.26 {MenuWidgetCmd procedure, "delete" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "foo" - list [catch {.m1 delete 1 0} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.27 {MenuWidgetCmd procedure, "delete" option} { - catch {destroy .m1} + .m1 delete 1 0 +} -cleanup { + destroy .m1 +} -result {} +test menu-3.27 {MenuWidgetCmd procedure, "delete" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "1" .m1 add command -label "2" .m1 add command -label "3" - list [catch {.m1 delete 1 3} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.28 {MenuWidgetCmd procedure, "delete" option} { - catch {destroy .m1} + .m1 delete 1 3 +} -cleanup { + destroy .m1 +} -result {} +test menu-3.28 {MenuWidgetCmd procedure, "delete" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "1" .m1 add command -label "2" .m1 add command -label "3" .m1 activate 2 - list [catch {.m1 delete 1 3} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.29 {MenuWidgetCmd procedure, "delete" option} { - catch {destroy .m1} + .m1 delete 1 3 +} -cleanup { + destroy .m1 +} -result {} +test menu-3.29 {MenuWidgetCmd procedure, "delete" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "1" .m1 add command -label "2" .m1 add command -label "3" .m1 activate 3 - list [catch {.m1 delete 1} msg] $msg [destroy .m1] -} {0 {} {}} + .m1 delete 1 +} -cleanup { + destroy .m1 +} -result {} test menu-3.29+1 {MenuWidgetCmd, "delete", Bug 220950} -setup { destroy .m1 } -body { @@ -690,68 +1464,88 @@ test menu-3.29+1 {MenuWidgetCmd, "delete", Bug 220950} -setup { } -cleanup { destroy .m1 } -result ok -test menu-3.30 {MenuWidgetCmd procedure, "entrycget" option} { - catch {destroy .m1} +test menu-3.30 {MenuWidgetCmd procedure, "entrycget" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 entrycget} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 entrycget index option"} {}} -test menu-3.31 {MenuWidgetCmd procedure, "entrycget" option} { - catch {destroy .m1} + .m1 entrycget +} -returnCodes error -result {wrong # args: should be ".m1 entrycget index option"} +test menu-3.31 {MenuWidgetCmd procedure, "entrycget" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 entrycget index option foo} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 entrycget index option"} {}} -test menu-3.32 {MenuWidgetCmd procedure, "entrycget" option} { - catch {destroy .m1} + .m1 entrycget index option foo +} -returnCodes error -result {wrong # args: should be ".m1 entrycget index option"} +test menu-3.32 {MenuWidgetCmd procedure, "entrycget" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 entrycget foo -label} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-3.33 {MenuWidgetCmd procedure, "entrycget" option} { - catch {destroy .m1} + .m1 entrycget foo -label +} -returnCodes error -result {bad menu entry index "foo"} +test menu-3.33 {MenuWidgetCmd procedure, "entrycget" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1] -} {0 test {}} -test menu-3.34 {MenuWidgetCmd procedure, "entryconfigure" option} { - catch {destroy .m1} + .m1 entrycget 1 -label +} -cleanup { + destroy .m1 +} -result {test} +test menu-3.34 {MenuWidgetCmd procedure, "entryconfigure" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 entryconfigure} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 entryconfigure index ?option value ...?"} {}} -test menu-3.35 {MenuWidgetCmd procedure, "entryconfigure" option} { - catch {destroy .m1} + .m1 entryconfigure +} -returnCodes error -result {wrong # args: should be ".m1 entryconfigure index ?-option value ...?"} +test menu-3.35 {MenuWidgetCmd procedure, "entryconfigure" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 entryconfigure foo} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} { - catch {destroy .m1} + .m1 entryconfigure foo +} -returnCodes error -result {bad menu entry index "foo"} +test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {llength [.m1 entryconfigure 1]} msg] $msg [destroy .m1] -} {0 15 {}} -test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} { - catch {destroy .m1} + llength [.m1 entryconfigure 1] +} -cleanup { + destroy .m1 +} -result {15} +test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1] -} {0 test {}} -test menu-3.38 {MenuWidgetCmd procedure, "entryconfigure" option} { - catch {destroy .m1} + lindex [.m1 entryconfigure 1 -label] 4 +} -cleanup { + destroy .m1 +} -result {test} +test menu-3.38 {MenuWidgetCmd procedure, "entryconfigure" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" .m1 entryconfigure 1 -label "changed" - list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1] -} {0 changed {}} -test menu-3.39 {MenuWidgetCmd procedure, "index" option} { - catch {destroy .m1} + lindex [.m1 entryconfigure 1 -label] 4 +} -cleanup { + destroy .m1 +} -result {changed} +test menu-3.39 {MenuWidgetCmd procedure, "index" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 index} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 index string"} {}} -test menu-3.40 {MenuWidgetCmd procedure, "index" option} { - catch {destroy .m1} + .m1 index +} -returnCodes error -result {wrong # args: should be ".m1 index string"} +test menu-3.40 {MenuWidgetCmd procedure, "index" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 index foo} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-3.41 {MenuWidgetCmd procedure, "index" option} { - catch {destroy .m1} + .m1 index foo +} -returnCodes error -result {bad menu entry index "foo"} +test menu-3.41 {MenuWidgetCmd procedure, "index" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "3" @@ -759,160 +1553,244 @@ test menu-3.41 {MenuWidgetCmd procedure, "index" option} { .m1 add command -label "end" .m1 add command -label "3a" .m1 add command -label "final entry" - list [.m1 index "test"] [.m1 index "3"] [.m1 index "3a"] [.m1 index "end"] [destroy .m1] -} {1 3 5 6 {}} -test menu-3.42 {MenuWidgetCmd procedure, "insert" option} { - catch {destroy .m1} + list [.m1 index "test"] [.m1 index "3"] [.m1 index "3a"] [.m1 index "end"] +} -cleanup { + destroy .m1 +} -result {1 3 5 6} +test menu-3.42 {MenuWidgetCmd procedure, "insert" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 insert} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 insert index type ?options?"} {}} -test menu-3.43 {MenuWidgetCmd procedure, "insert" option} { - catch {destroy .m1} + .m1 insert +} -returnCodes error -result {wrong # args: should be ".m1 insert index type ?-option value ...?"} +test menu-3.43 {MenuWidgetCmd procedure, "insert" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 insert 1 command -label "test" - list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1] -} {0 test {}} -test menu-3.44 {MenuWidgetCmd procedure, "invoke" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 invoke} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 invoke index"} {}} -test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 invoke foo} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} { - catch {destroy .m1} + .m1 entrycget 1 -label +} -cleanup { + destroy .m1 +} -result {test} +test menu-3.44 {MenuWidgetCmd procedure, "invoke" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 invoke +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 invoke index"} +test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 invoke foo +} -cleanup { + destroy .m1 +} -returnCodes error -result {bad menu entry index "foo"} +test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add command -label "set foo" -command "set foo hello" - list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1] -} {0 hello 0 hello 0 {} {}} -test menu-3.47 {MenuWidgetCmd procedure, "post" option} { - catch {destroy .m1} + list [.m1 invoke 1] [set foo] [unset foo] +} -cleanup { + destroy .m1 +} -returnCodes ok -result {hello hello {}} +test menu-3.47 {MenuWidgetCmd procedure, "post" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "On Windows, hit Escape to get this menu to go away" - list [catch {.m1 post} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 post x y"} {}} -test menu-3.48 {MenuWidgetCmd procedure, "post" option} { - catch {destroy .m1} + .m1 post +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 post x y"} +test menu-3.48 {MenuWidgetCmd procedure, "post" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 post foo 40} msg] $msg [destroy .m1] -} {1 {expected integer but got "foo"} {}} -test menu-3.49 {MenuWidgetCmd procedure, "post" option} { - catch {destroy .m1} + .m1 post foo 40 +} -cleanup { + destroy .m1 +} -returnCodes error -result {expected integer but got "foo"} +test menu-3.49 {MenuWidgetCmd procedure, "post" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 post 40 bar} msg] $msg [destroy .m1] -} {1 {expected integer but got "bar"} {}} -test menu-3.50 {MenuWidgetCmd procedure, "post" option} {nonUnixUserInteraction } { - catch {destroy .m1} + .m1 post 40 bar +} -cleanup { + destroy .m1 +} -returnCodes error -result {expected integer but got "bar"} +test menu-3.50 {MenuWidgetCmd procedure, "post" option} -constraints { + nonUnixUserInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "menu-3.53: hit Escape" -command "puts hello" - list [catch {.m1 post 40 40} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 postcascade} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 postcascade index"} {}} -test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 postcascade foo} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {nonUnixUserInteraction } { - catch {destroy .m1} - catch {destroy .m2} + .m1 post 40 40 +} -cleanup { + destroy .m1 +} -result {} +test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 postcascade +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 postcascade index"} +test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 postcascade foo +} -cleanup { + destroy .m1 +} -returnCodes error -result {bad menu entry index "foo"} +test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} -constraints { + nonUnixUserInteraction +} -setup { + destroy .m1 .m2 +} -body { menu .m1 .m1 add command -label "menu-3.56 - hit Escape" menu .m2 .m1 post 40 40 .m1 add cascade -menu .m2 - list [catch {.m1 postcascade 1} msg] $msg [destroy .m1 .m2] -} {0 {} {}} -test menu-3.54 {MenuWidgetCmd procedure, "postcascade" option} { - catch {destroy .m1} - catch {destroy .m2} + .m1 postcascade 1 +} -cleanup { + destroy .m1 .m2 +} -result {} +test menu-3.54 {MenuWidgetCmd procedure, "postcascade" option} -setup { + destroy .m1 .m2 +} -body { menu .m1 menu .m2 .m1 add cascade -menu .m2 -label "menu-3.57 - hit Escape" .m1 postcascade 1 - list [catch {.m1 postcascade none} msg] $msg [destroy .m1 .m2] -} {0 {} {}} -test menu-3.55 {MenuWidgetCmd procedure, "type" option} { - catch {destroy .m1} + .m1 postcascade none +} -cleanup { + destroy .m1 .m2 +} -result {} +test menu-3.55 {MenuWidgetCmd procedure, "type" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 type} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 type index"} {}} -test menu-3.56 {MenuWidgetCmd procedure, "type" option} { - catch {destroy .m1} + .m1 type +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 type index"} +test menu-3.56 {MenuWidgetCmd procedure, "type" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 type foo} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-3.57 {MenuWidgetCmd procedure, "type" option} { - catch {destroy .m1} + .m1 type foo +} -cleanup { + destroy .m1 +} -returnCodes error -result {bad menu entry index "foo"} +test menu-3.57 {MenuWidgetCmd procedure, "type" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 type 1} msg] $msg [destroy .m1] -} {0 command {}} -test menu-3.58 {MenuWidgetCmd procedure, "type" option} { - catch {destroy .m1} + .m1 type 1 +} -cleanup { + destroy .m1 +} -result {command} +test menu-3.58 {MenuWidgetCmd procedure, "type" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator - list [catch {.m1 type 1} msg] $msg [destroy .m1] -} {0 separator {}} -test menu-3.59 {MenuWidgetCmd procedure, "type" option} { - catch {destroy .m1} + .m1 type 1 +} -cleanup { + destroy .m1 +} -result {separator} +test menu-3.59 {MenuWidgetCmd procedure, "type" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label "test" - list [catch {.m1 type 1} msg] $msg [destroy .m1] -} {0 checkbutton {}} -test menu-3.60 {MenuWidgetCmd procedure, "type" option} { - catch {destroy .m1} + .m1 type 1 +} -cleanup { + destroy .m1 +} -result {checkbutton} +test menu-3.60 {MenuWidgetCmd procedure, "type" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add radiobutton -label "test" - list [catch {.m1 type 1} msg] $msg [destroy .m1] -} {0 radiobutton {}} -test menu-3.61 {MenuWidgetCmd procedure, "type" option} { - catch {destroy .m1} + .m1 type 1 +} -cleanup { + destroy .m1 +} -result {radiobutton} +test menu-3.61 {MenuWidgetCmd procedure, "type" option} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label "test" - list [catch {.m1 type 1} msg] $msg [destroy .m1] -} {0 cascade {}} -test menu-3.62 {MenuWidgetCmd procedure, "type" option} { - catch {destroy .m1} + .m1 type 1 +} -cleanup { + destroy .m1 +} -result {cascade} +test menu-3.62 {MenuWidgetCmd procedure, "type" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 type 0} msg] $msg [destroy .m1] -} {0 tearoff {}} -test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} { - catch {destroy .m1} + .m1 type 0 +} -cleanup { + destroy .m1 +} -result {tearoff} +test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 unpost foo} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 unpost"} {}} -test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {nonUnixUserInteraction } { - catch {destroy .m1} + .m1 unpost foo +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 unpost"} +test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} -constraints { + nonUnixUserInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "menu-3.68 - hit Escape" .m1 post 40 40 - list [catch {.m1 unpost} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 yposition} msg] $msg [destroy .m1] -} {1 {wrong # args: should be ".m1 yposition index"} {}} -test menu-3.66 {MenuWidgetCmd procedure, "yposition" option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 yposition 1}] [destroy .m1] -} {0 {}} -test menu-3.67 {MenuWidgetCmd procedure, bad option} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 foo} msg] $msg [destroy .m1] -} {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, xposition, or yposition} {}} -test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} { + .m1 unpost +} -cleanup { + destroy .m1 +} -result {} +test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 yposition +} -cleanup { + destroy .m1 +} -returnCodes error -result {wrong # args: should be ".m1 yposition index"} +test menu-3.66 {MenuWidgetCmd procedure, "yposition" option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 yposition 1 +} -cleanup { + destroy .m1 +} -result {1} +test menu-3.67 {MenuWidgetCmd procedure, bad option} -setup { + destroy .m1 +} -body { + menu .m1 + .m1 foo +} -cleanup { + destroy .m1 +} -returnCodes error -result {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, xposition, or yposition} +test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} -setup { + deleteWindows +} -body { set t .t set m1 .t.m1 set c1 .t.c1 @@ -927,12 +1805,12 @@ test menu-3.68 {MenuWidgetCmd procedure, fix for bug#508988} { $t configure -menu $m1 $m1 entryconfigure 1 -menu $c2 -label c2 $t configure -menu "" - set l [list [winfo exists $c1] [winfo exists $c2]] - destroy $t; - set l; -} {1 1} + list [winfo exists $c1] [winfo exists $c2] +} -cleanup { + deleteWindows +} -result {1 1} test menu-3.69 {MenuWidgetCmd procedure, "xposition" option} -setup { - catch {destroy .m1} + destroy .m1 menu .m1 } -body { .m1 xposition @@ -940,7 +1818,7 @@ test menu-3.69 {MenuWidgetCmd procedure, "xposition" option} -setup { destroy .m1 } -returnCodes error -result {wrong # args: should be ".m1 xposition index"} test menu-3.70 {MenuWidgetCmd procedure, "xposition" option} -setup { - catch {destroy .m1} + destroy .m1 menu .m1 } -body { .m1 xposition 1 @@ -949,126 +1827,162 @@ test menu-3.70 {MenuWidgetCmd procedure, "xposition" option} -setup { destroy .m1 } -result {} -test menu-4.1 {TkInvokeMenu: disabled} { - catch {destroy .m1} + +test menu-4.1 {TkInvokeMenu: disabled} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off \ -state disabled - list [catch {.m1 invoke 1} msg] [destroy .m1] $foo -} {0 {} off} -test menu-4.2 {TkInvokeMenu: tearoff} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 invoke 0} msg] [destroy .m1] -} {0 {}} -test menu-4.3 {TkInvokeMenu: checkbutton -on} { - catch {destroy .m1} + list [catch {.m1 invoke 1} msg] $foo +} -cleanup { + destroy .m1 +} -result {0 off} +test menu-4.2 {TkInvokeMenu: tearoff} -setup { + destroy .m1 +} -body { + menu .m1 + catch {.m1 invoke 0} +} -cleanup { + deleteWindows +} -result {0} +test menu-4.3 {TkInvokeMenu: checkbutton -on} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off - list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1] -} {0 {} 0 on 0 {} {}} -test menu-4.4 {TkInvokeMenu: checkbutton -off} { - catch {destroy .m1} + list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 \ + [catch {unset foo} msg3] $msg3 +} -cleanup { + destroy .m1 +} -result {0 {} 0 on 0 {}} +test menu-4.4 {TkInvokeMenu: checkbutton -off} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off .m1 invoke 1 - list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1] -} {0 {} 0 off 0 {} {}} -test menu-4.5 {TkInvokeMenu: checkbutton array element} { - catch {destroy .m1} + list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 +} -cleanup { + destroy .m1 +} -result {0 {} 0 off 0 {}} +test menu-4.5 {TkInvokeMenu: checkbutton array element} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add checkbutton -label "test" -variable foo(1) -onvalue on - list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1] -} {0 {} 0 on 0 {} {}} -test menu-4.6 {TkInvokeMenu: radiobutton} { - catch {destroy .m1} + list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3 +} -cleanup { + destroy .m1 +} -result {0 {} 0 on 0 {}} +test menu-4.6 {TkInvokeMenu: radiobutton} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add radiobutton -label "1" -variable foo -value one .m1 add radiobutton -label "2" -variable foo -value two .m1 add radiobutton -label "3" -variable foo -value three - list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1] -} {0 {} 0 one 0 {} {}} -test menu-4.7 {TkInvokeMenu: radiobutton} { - catch {destroy .m1} + list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 +} -cleanup { + destroy .m1 +} -result {0 {} 0 one 0 {}} +test menu-4.7 {TkInvokeMenu: radiobutton} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add radiobutton -label "1" -variable foo -value one .m1 add radiobutton -label "2" -variable foo -value two .m1 add radiobutton -label "3" -variable foo -value three - list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1] -} {0 {} 0 two 0 {} {}} -test menu-4.8 {TkInvokeMenu: radiobutton} { - catch {destroy .m1} + list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 +} -cleanup { + destroy .m1 +} -result {0 {} 0 two 0 {}} +test menu-4.8 {TkInvokeMenu: radiobutton} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add radiobutton -label "1" -variable foo -value one .m1 add radiobutton -label "2" -variable foo -value two .m1 add radiobutton -label "3" -variable foo -value three - list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1] -} {0 {} 0 three 0 {} {}} -test menu-4.9 {TkInvokeMenu: radiobutton array element} { - catch {destroy .m1} + list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 +} -cleanup { + destroy .m1 +} -result {0 {} 0 three 0 {}} +test menu-4.9 {TkInvokeMenu: radiobutton array element} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add radiobutton -label "1" -variable foo(2) -value one .m1 add radiobutton -label "2" -variable foo(2) -value two .m1 add radiobutton -label "3" -variable foo(2) -value three - list [catch {.m1 invoke 3} msg] $msg [catch {set foo(2)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1] -} {0 {} 0 three 0 {} {}} -test menu-4.10 {TkInvokeMenu} { - catch {destroy .m1} - catch {unset menu_test} + list [catch {.m1 invoke 3} msg] $msg [catch {set foo(2)} msg2] $msg2 [catch {unset foo} msg3] $msg3 +} -cleanup { + destroy .m1 +} -result {0 {} 0 three 0 {}} +test menu-4.10 {TkInvokeMenu} -setup { + destroy .m1 +} -body { + catch {unset foo} menu .m1 .m1 add command -label "test" -command "set menu_test menu-4.8" - list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1] -} {0 menu-4.8 0 menu-4.8 0 {} {}} -test menu-4.11 {TkInvokeMenu} { - catch {destroy .m1} + list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 +} -cleanup { + destroy .m1 +} -result {0 menu-4.8 0 menu-4.8 0 {}} +test menu-4.11 {TkInvokeMenu} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label "test" -menu .m1.m2 - list [catch {.m1 invoke 1} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-4.12 {TkInvokeMenu} { - catch {destroy .m1} + list [catch {.m1 invoke 1} msg] $msg +} -cleanup { + destroy .m1 +} -result {0 {}} +test menu-4.12 {TkInvokeMenu} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" -command ".m1 delete 1" - list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2 [destroy .m1] -} {0 {} 1 {bad menu entry index "test"} {}} + list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2 +} -cleanup { + destroy .m1 +} -result {0 {} 1 {bad menu entry index "test"}} -test menu-5.1 {DestroyMenuInstance} { - catch {destroy .m1} +test menu-5.1 {DestroyMenuInstance} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-5.2 {DestroyMenuInstance - cascade menu} { - catch {destroy .m1} - catch {destroy .m2} + destroy .m1 +} -returnCodes ok +test menu-5.2 {DestroyMenuInstance - cascade menu} -setup { + destroy .m1 .m2 +} -body { menu .m1 .m1 add cascade -menu .m2 menu .m2 - list [catch {destroy .m2} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-5.3 {DestroyMenuInstance - multiple cascade parents} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + destroy .m1 .m2 +} -returnCodes ok +test menu-5.3 {DestroyMenuInstance - multiple cascade parents} -setup { + destroy .m1 .m2 .m3 +} -body { menu .m1 .m1 add cascade -menu .m3 menu .m2 .m2 add cascade -menu .m3 menu .m3 - list [catch {destroy .m3} msg] $msg [destroy .m1 .m2] -} {0 {} {}} -test menu-5.4 {DestroyMenuInstance - multiple cascade parents} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} - catch {destroy .m4} + list [destroy .m3] [destroy .m1 .m2] +} -returnCodes ok -result {{} {}} +test menu-5.4 {DestroyMenuInstance - multiple cascade parents} -setup { + destroy .m1 .m2 .m3 .m4 +} -body { menu .m1 .m1 add cascade -menu .m4 menu .m2 @@ -1076,21 +1990,20 @@ test menu-5.4 {DestroyMenuInstance - multiple cascade parents} { menu .m3 .m3 add cascade -menu .m4 menu .m4 - list [catch {destroy .m4} msg] $msg [destroy .m1 .m2 .m3] -} {0 {} {}} -test menu-5.5 {DestroyMenuInstance - cascades of cloned menus} { - catch {destroy .m1} - catch {destroy .m2} + list [destroy .m4] [destroy .m1 .m2 .m3] +} -returnCodes ok -result {{} {}} +test menu-5.5 {DestroyMenuInstance - cascades of cloned menus} -setup { + destroy .m1 .m2 +} -body { menu .m1 menu .m2 .m1 add cascade -menu .m2 . configure -menu .m1 - list [catch {destroy .m2} msg] $msg [.m1 entrycget 1 -menu] [. configure -menu ""] [destroy .m1] -} {0 {} .m2 {} {}} -test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .t2} + list [destroy .m2] [.m1 entrycget 1 -menu] [. configure -menu ""] [destroy .m1] +} -returnCodes ok -result {{} .m2 {} {}} +test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -menu .m2 menu .m2 @@ -1098,190 +2011,190 @@ test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} { toplevel .t2 wm geometry .t2 +0+0 .t2 configure -menu .m1 - list [catch {destroy .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1] -} {0 {} {} {}} -test menu-5.7 {DestroyMenuInstance - basic clones} { - catch {destroy .m1} + list [destroy .m2] [. configure -menu ""] [destroy .t2 .m1] +} -returnCodes ok -result {{} {} {}} +test menu-5.7 {DestroyMenuInstance - basic clones} -setup { + destroy .m1 +} -body { menu .m1 set tearoff [tk::TearOffMenu .m1] - list [catch {destroy $tearoff} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-5.8 {DestroyMenuInstance - multiple clones} { - catch {destroy .m1} + list [destroy $tearoff] [destroy .m1] +} -result {{} {}} +test menu-5.8 {DestroyMenuInstance - multiple clones} -setup { + destroy .m1 +} -body { menu .m1 set tearoff1 [tk::TearOffMenu .m1] set tearoff2 [tk::TearOffMenu .m1] - list [catch {destroy $tearoff1} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-5.9 {DestroyMenuInstace - master menu} { - catch {destroy .m1} + list [destroy $tearoff1] [destroy .m1] +} -returnCodes ok -result {{} {}} +test menu-5.9 {DestroyMenuInstace - master menu} -setup { + destroy .m1 +} -body { menu .m1 tk::TearOffMenu .m1 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-5.10 {DestroyMenuInstance - freeing entries} { - catch {destroy .m1} + destroy .m1 +} -returnCodes ok +test menu-5.10 {DestroyMenuInstance - freeing entries} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "foo" - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-5.11 {DestroyMenuInstace - no entries} { - catch {destroy .m1} + destroy .m1 +} -returnCodes ok +test menu-5.11 {DestroyMenuInstace - no entries} -setup { + destroy .m1 +} -body { menu .m1 .m1 configure -tearoff 0 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-5.12 {DestroyMenuInstance - platform data} { - catch {destroy .m1} + destroy .m1 +} -returnCodes ok +test menu-5.12 {DestroyMenuInstance - platform data} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} { - catch {destroy .m1} - catch {destroy .m2} + destroy .m1 +} -returnCodes ok +test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} -setup { + destroy .m1 .m2 +} -body { menu .m1 menu .m2 .m1 add cascade -menu .m2 set tearoff [tk::TearOffMenu .m1 40 40] list [destroy .m2] [destroy .m1] -} {{} {}} +} -result {{} {}} + -test menu-6.1 {TkDestroyMenu} { - catch {destroy .m1} +test menu-6.1 {TkDestroyMenu} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-6.2 {TkDestroyMenu - reentrancy} { - catch {destroy .m1} - catch {destroy .m2} + destroy .m1 +} -returnCodes ok +test menu-6.2 {TkDestroyMenu - reentrancy} -setup { + destroy .m1 .m2 +} -body { menu .m1 bind .m1 <Destroy> {destroy .m1} menu .m2 bind .m2 <Destroy> {destroy .m2} - list [catch {destroy .m1} msg] $msg [destroy .m2] -} {0 {} {}} -test menu-6.3 {TkDestroyMenu - reentrancy} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + list [destroy .m1] [destroy .m2] +} -returnCodes ok -result {{} {}} +test menu-6.3 {TkDestroyMenu - reentrancy} -setup { + destroy .m1 .m2 .m3 +} -body { menu .m1 bind .m1 <Destroy> {destroy .m2} .m1 clone .m2 .m1 clone .m3 - list [catch {destroy .m1} msg] $msg [winfo exists .m2] -} {0 {} 0} -test menu-6.4 {TkDestroyMenu - reentrancy - clones} { - catch {destroy .m1} - catch {destroy .m2} + list [destroy .m1] [winfo exists .m2] +} -returnCodes ok -result {{} 0} +test menu-6.4 {TkDestroyMenu - reentrancy - clones} -setup { + destroy .m1 .m2 +} -body { menu .m1 .m1 clone .m2 .m1 clone .m1.m3 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-6.5 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .m2} + destroy .m1 +} -cleanup { + deleteWindows +} -returnCodes ok +test menu-6.5 {TkDestroyMenu} -setup { + destroy .m1 .m2 +} -body { menu .m1 .m1 clone .m2 destroy .m1 winfo exists .m2 -} {0} -test menu-6.6 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .m2} +} -result {0} +test menu-6.6 {TkDestroyMenu} -setup { + destroy .m1 .m2 +} -body { menu .m1 .m1 clone .m2 tearoff - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-6.7 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .m2} + destroy .m1 +} -result {} +test menu-6.7 {TkDestroyMenu} -setup { + destroy .m1 .m2 +} -body { menu .m1 .m1 clone .m2 destroy .m2 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-6.8 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + destroy .m1 +} -returnCodes ok -result {} +test menu-6.8 {TkDestroyMenu} -setup { + destroy .m1 .m2 .m3 +} -body { menu .m1 .m1 clone .m2 .m1 clone .m3 destroy .m1 list [winfo exists .m2] [winfo exists .m3] -} {0 0} -test menu-6.9 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} +} -result {0 0} +test menu-6.9 {TkDestroyMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 .m1 clone .m3 - list [catch {destroy .m2} msg] $msg [catch {destroy .m3} msg2] $msg2 [catch {destroy .m1} msg3] $msg3 -} {0 {} 0 {} 0 {}} -test menu-6.10 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + list [destroy .m2] [destroy .m3] [destroy .m1] +} -returnCodes ok -result {{} {} {}} +test menu-6.10 {TkDestroyMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 .m1 clone .m3 - list [catch {destroy .m3} msg] $msg [catch {destroy .m1} msg2] $msg2 -} {0 {} 0 {}} -test menu-6.11 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} - catch {destroy .m4} + list [destroy .m3] [destroy .m1] +} -returnCodes ok -result {{} {}} +test menu-6.11 {TkDestroyMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 .m1 clone .m3 .m1 clone .m4 - list [catch {destroy .m2} msg1] $msg1 [catch {destroy .m1} msg2] $msg2 -} {0 {} 0 {}} -test menu-6.12 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} - catch {destroy .m4} + list [destroy .m2] [destroy .m1] +} -returnCodes ok -result {{} {}} +test menu-6.12 {TkDestroyMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 .m1 clone .m3 .m1 clone .m4 - list [catch {destroy .m3} msg1] $msg1 [catch {destroy .m1} msg2] $msg2 -} {0 {} 0 {}} -test menu-6.13 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} - catch {destroy .m4} + list [destroy .m3] [destroy .m1] +} -returnCodes ok -result {{} {}} +test menu-6.13 {TkDestroyMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 .m1 clone .m3 .m1 clone .m4 - list [catch {destroy .m4} msg1] $msg1 [catch {destroy .m1} msg2] $msg2 -} {0 {} 0 {}} -test menu-6.14 {TkDestroyMenu} { - catch {destroy .m1} + list [destroy .m4] [destroy .m1] +} -returnCodes ok -result {{} {}} +test menu-6.14 {TkDestroyMenu} -setup { + destroy .m1 +} -body { menu .m1 . configure -menu .m1 - list [catch {destroy .m1} msg] $msg [. configure -menu ""] -} {0 {} {}} -test menu-6.15 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .t2} + list [destroy .m1] [. configure -menu ""] +} -returnCodes ok -result {{} {}} +test menu-6.15 {TkDestroyMenu} -setup { + deleteWindows +} -body { menu .m1 toplevel .t2 wm geometry .t2 +0+0 . configure -menu .m1 .t2 configure -menu .m1 - list [catch {destroy .m1} msg] $msg [destroy .t2] [. configure -menu ""] -} {0 {} {} {}} -test menu-6.16 {TkDestroyMenu} { - catch {destroy .m1} - catch {destroy .t2} - catch {destroy .t3} + list [destroy .m1] [destroy .t2] [. configure -menu ""] +} -result {{} {} {}} +test menu-6.16 {TkDestroyMenu} -setup { + deleteWindows +} -body { menu .m1 toplevel .t2 wm geometry .t2 +0+0 @@ -1290,298 +2203,367 @@ test menu-6.16 {TkDestroyMenu} { . configure -menu .m1 .t2 configure -menu .m1 .t3 configure -menu .m1 - list [catch {destroy .m1} msg] $msg [destroy .t2] [destroy .t3] [. configure -menu ""] -} {0 {} {} {} {}} + list [destroy .m1] [destroy .t2] [destroy .t3] [. configure -menu ""] +} -result {{} {} {} {}} -test menu-7.1 {UnhookCascadeEntry} { - catch {destroy .m1} +test menu-7.1 {UnhookCascadeEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-7.2 {UnhookCascadeEntry} { - catch {destroy .m1} + destroy .m1 +} -returnCodes ok +test menu-7.2 {UnhookCascadeEntry} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -menu .m2 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-7.3 {UnhookCascadeEntry} { - catch {destroy .m1} - catch {destroy .m2} + destroy .m1 +} -returnCodes ok +test menu-7.3 {UnhookCascadeEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 .m2 add cascade -menu .cascade .m1 add cascade -menu .cascade - list [catch {destroy .m1} msg] $msg [destroy .m2] -} {0 {} {}} -test menu-7.4 {UnhookCascadeEntry} { - catch {destroy .m1} - catch {destroy .m2} + list [destroy .m1] [destroy .m2] +} -returnCodes ok -result {{} {}} +test menu-7.4 {UnhookCascadeEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 .m1 add cascade -menu .cascade .m2 add cascade -menu .cascade - list [catch {destroy .m1} msg] $msg [destroy .m2] -} {0 {} {}} -test menu-7.5 {UnhookCascadeEntry} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + list [destroy .m1] [destroy .m2] +} -returnCodes ok -result {{} {}} +test menu-7.5 {UnhookCascadeEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 menu .m3 .m1 add cascade -menu .cascade .m2 add cascade -menu .cascade .m3 add cascade -menu .cascade - list [catch {destroy .m1} msg] $msg [destroy .m2 .m3] -} {0 {} {}} -test menu-7.6 {UnhookCascadeEntry} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + list [destroy .m1] [destroy .m2 .m3] +} -returnCodes ok -result {{} {}} +test menu-7.6 {UnhookCascadeEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 menu .m3 .m1 add cascade -menu .cascade .m2 add cascade -menu .cascade .m3 add cascade -menu .cascade - list [catch {destroy .m2} msg] $msg [destroy .m1 .m3] -} {0 {} {}} -test menu-7.7 {UnhookCascadeEntry} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + list [destroy .m2] [destroy .m1 .m3] +} -returnCodes ok -result {{} {}} +test menu-7.7 {UnhookCascadeEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 menu .m3 .m1 add cascade -menu .cascade .m2 add cascade -menu .cascade .m3 add cascade -menu .cascade - list [catch {destroy .m3} msg] $msg [destroy .m1 .m2] -} {0 {} {}} -test menu-7.8 {UnhookCascadeEntry} { - catch {destroy .m1} - catch {destroy .m2} + list [destroy .m3] [destroy .m1 .m2] +} -returnCodes ok -result {{} {}} +test menu-7.8 {UnhookCascadeEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 .m1 add cascade -menu .m2 - list [catch {destroy .m1} msg] $msg [destroy .m2] -} {0 {} {}} -test menu-7.9 {UnhookCascadeEntry} { - catch {destroy .m1} - catch {destroy .m2} + list [destroy .m1] [destroy .m2] +} -returnCodes ok -result {{} {}} +test menu-7.9 {UnhookCascadeEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 .m1 add cascade -menu .m2 destroy .m1 - list [catch {destroy .m2} msg] $msg -} {0 {}} + destroy .m2 +} -returnCodes ok -test menu-8.1 {DestroyMenuEntry} { - catch {destroy .m1} - catch {destroy .m2} +test menu-8.1 {DestroyMenuEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 .m1 add cascade -menu .m2 - list [catch {.m1 delete 1} msg] $msg [destroy .m1 .m2] -} {0 {} {}} -test menu-8.2 {DestroyMenuEntry} hasEarthPhoto { + list [.m1 delete 1] [destroy .m1 .m2] +} -result {{} {}} +test menu-8.2 {DestroyMenuEntry} -constraints hasEarthPhoto -setup { + deleteWindows catch {image delete image1a} - catch {destroy .m1} +} -body { image create photo image1a -file $earthPhotoFile menu .m1 .m1 add command -image image1a - list [catch {.m1 delete 1} msg] $msg [destroy .m1] [image delete image1a] -} {0 {} {} {}} -test menu-8.3 {DestroyMenuEntry} testImageType { - catch {eval image delete [image names]} - catch {destroy .m1} + list [.m1 delete 1] [destroy .m1] [image delete image1a] +} -result {{} {} {}} +test menu-8.3 {DestroyMenuEntry} -constraints testImageType -setup { + deleteWindows + imageCleanup +} -body { image create test image1 image create test image2 menu .m1 .m1 add checkbutton -image image1 -selectimage image2 .m1 invoke 1 - list [catch {.m1 delete 1} msg] $msg [destroy .m1] [eval image delete [image names]] -} {0 {} {} {}} -test menu-8.4 {DestroyMenuEntry} { - catch {destroy .m1} + list [.m1 delete 1] [destroy .m1] +} -cleanup { + imageCleanup + deleteWindows +} -result {{} {}} +test menu-8.4 {DestroyMenuEntry} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -variable foo - list [catch {.m1 delete 1} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-8.5 {DestroyMenuEntry} { - catch {destroy .m1} + list [.m1 delete 1] [destroy .m1] +} -result {{} {}} +test menu-8.5 {DestroyMenuEntry} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 delete 1} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-8.6 {DestroyMenuEntry} { - catch {destroy .m1} + list [.m1 delete 1] [destroy .m1] +} -result {{} {}} +test menu-8.6 {DestroyMenuEntry} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "one" .m1 add command -label "two" - list [catch {.m1 delete 1} msg] $msg [.m1 entrycget 1 -label] [destroy .m1] -} {0 {} two {}} -test menu-8.7 {DestroyMenuEntry} { - catch {destroy .m1} - catch {destroy .m2} + list [.m1 delete 1] [.m1 entrycget 1 -label] [destroy .m1] +} -result {{} two {}} +test menu-8.7 {DestroyMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "one" .m1 clone .m2 tearoff - list [catch {.m2 delete 0} msg] $msg [destroy .m1] -} {0 {} {}} + list [.m2 delete 1] [destroy .m1] +} -result {{} {}} + # test menu-9 - Can only change when fonts change on system, which cannot # be done from tcl. - -test menu-9.1 {ConfigureMenu} { - catch {destroy .m1} +test menu-9.1 {ConfigureMenu} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1] -} {0 {} beep {}} -test menu-9.2 {ConfigureMenu} { - catch {destroy .m1} + list [.m1 configure -postcommand "beep"] [.m1 cget -postcommand] +} -cleanup { + deleteWindows +} -result {{} beep} +test menu-9.2 {ConfigureMenu} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 configure -tearoff 0} msg] $msg [.m1 entrycget 1 -label] [destroy .m1] -} {0 {} test {}} -test menu-9.3 {ConfigureMenu} { - catch {destroy .m1} + list [.m1 configure -tearoff 0] [.m1 entrycget 1 -label] +} -cleanup { + deleteWindows +} -result {{} test} +test menu-9.3 {ConfigureMenu} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1] -} {0 {} beep {}} -test menu-9.4 {ConfigureMenu} { - catch {destroy .m1} + list [.m1 configure -postcommand "beep"] [.m1 cget -postcommand] +} -cleanup { + deleteWindows +} -result {{} beep} +test menu-9.4 {ConfigureMenu} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 configure -fg red} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-9.5 {ConfigureMenu} { - catch {destroy .m1} + .m1 configure -fg red +} -cleanup { + deleteWindows +} -result {} +test menu-9.5 {ConfigureMenu} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "two" - list [catch {.m1 configure -fg red} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-9.6 {ConfigureMenu} { - catch {destroy .m1} + .m1 configure -fg red +} -cleanup { + deleteWindows +} -result {} +test menu-9.6 {ConfigureMenu} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "two" .m1 add command -label "three" - list [catch {.m1 configure -fg red} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-9.7 {ConfigureMenu} { - catch {destroy .m1} - catch {destroy .m2} + .m1 configure -fg red +} -cleanup { + deleteWindows +} -result {} +test menu-9.7 {ConfigureMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 tearoff - list [catch {.m1 configure -fg red} msg] $msg [.m2 cget -fg] [destroy .m1] -} {0 {} red {}} -test menu-9.8 {ConfigureMenu} { - catch {destroy .m1} - catch {destroy .m2} + list [.m1 configure -fg red] [.m2 cget -fg] +} -cleanup { + deleteWindows +} -result {{} red} +test menu-9.8 {ConfigureMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 tearoff - list [catch {.m2 configure -fg red} msg] $msg [.m1 cget -fg] [destroy .m1] -} {0 {} red {}} -test menu-9.9 {ConfigureMenu} { - catch {destroy .m1} + list [.m2 configure -fg red] [.m1 cget -fg] +} -cleanup { + deleteWindows +} -result {{} red} +test menu-9.9 {ConfigureMenu} -setup { + destroy .m1 +} -body { menu .m1 - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} + -test menu-10.1 {PostProcessEntry: array variable} { - catch {destroy .m1} +test menu-10.1 {PostProcessEntry: array variable} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 set foo(1) on .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense" - list [catch {set foo(1)} msg] $msg [destroy .m1] -} {0 on {}} -test menu-10.2 {PostProcessEntry: array variable} { - catch {destroy .m1} + set foo(1) +} -cleanup { + deleteWindows +} -result {on} +test menu-10.2 {PostProcessEntry: array variable} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense" - list [catch {set foo(1)} msg] $msg [destroy .m1] -} {0 off {}} + set foo(1) +} -cleanup { + deleteWindows +} -result {off} -test menu-11.1 {ConfigureMenuEntry} { - catch {destroy .m1} + +test menu-11.1 {ConfigureMenuEntry} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense" - list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1] -} {0 {} bar {}} -test menu-11.2 {ConfigureMenuEntry} { - catch {destroy .m1} + list [.m1 entryconfigure 1 -variable bar] [.m1 entrycget 1 -variable] +} -cleanup { + deleteWindows +} -result {{} bar} +test menu-11.2 {ConfigureMenuEntry} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1] -} {0 {} {} {}} -test menu-11.3 {ConfigureMenuEntry} { - catch {destroy .m1} + list [.m1 entryconfigure 1 -label ""] [.m1 entrycget 1 -label] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-11.3 {ConfigureMenuEntry} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command - list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1] -} {0 {} test {}} -test menu-11.4 {ConfigureMenuEntry} { - catch {destroy .m1} + list [.m1 entryconfigure 1 -label "test"] [.m1 entrycget 1 -label] +} -cleanup { + deleteWindows +} -result {{} test} +test menu-11.4 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command - list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1] -} {0 {} S {}} -test menu-11.5 {ConfigureMenuEntry} { - catch {destroy .m1} + list [.m1 entryconfigure 1 -accel "S"] [.m1 entrycget 1 -accel] +} -cleanup { + deleteWindows +} -result {{} S} +test menu-11.5 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command - list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1] -} {0 {} test {}} -test menu-11.6 {ConfigureMenuEntry} { - catch {destroy .m1} + list [.m1 entryconfigure 1 -label "test"] [.m1 entrycget 1 -label] +} -cleanup { + deleteWindows +} -result {{} test} +test menu-11.6 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command - list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-11.7 {ConfigureMenuEntry} { - catch {destroy .m1} - catch {destroy .m2} + .m1 entryconfigure 1 -label "test" +} -cleanup { + deleteWindows +} -result {} +test menu-11.7 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m2 menu .m1 .m1 add cascade - list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2] -} {0 {} {}} -test menu-11.8 {ConfigureMenuEntry} { - catch {destroy .m1} + .m1 entryconfigure 1 -label "test" -menu .m2 +} -cleanup { + deleteWindows +} -result {} +test menu-11.8 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade - list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-11.9 {ConfigureMenuEntry} { - catch {destroy .m1} + .m1 entryconfigure 1 -label "test" -menu .m2 +} -cleanup { + deleteWindows +} -result {} +test menu-11.9 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -menu .m3 - list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-11.10 {ConfigureMenuEntry} { - catch {destroy .m1} + .m1 entryconfigure 1 -label "test" -menu .m2 +} -cleanup { + deleteWindows +} -result {} +test menu-11.10 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade - list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-11.11 {ConfigureMenuEntry} { - catch {destroy .m1} + .m1 entryconfigure 1 -label "test" -menu .m2 +} -cleanup { + deleteWindows +} -result {} +test menu-11.11 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -menu .m2 - list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-11.12 {ConfigureMenuEntry} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} - catch {destroy .m4} - catch {destroy .m5} + .m1 entryconfigure 1 -label "test" -menu .m2 +} -cleanup { + deleteWindows +} -result {} +test menu-11.12 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 .m2 add cascade -menu .m1 @@ -1591,13 +2573,13 @@ test menu-11.12 {ConfigureMenuEntry} { .m4 add cascade -menu .m1 menu .m5 .m5 add cascade - list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5] -} {0 {} {}} -test menu-11.13 {ConfigureMenuEntry} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} - catch {destroy .m4} + .m5 entryconfigure 1 -label "test" -menu .m1 +} -cleanup { + deleteWindows +} -result {} +test menu-11.13 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 menu .m2 .m2 add cascade -menu .m1 @@ -1605,360 +2587,489 @@ test menu-11.13 {ConfigureMenuEntry} { .m3 add cascade -menu .m1 menu .m4 .m4 add cascade -menu .m1 - list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4] -} {0 {} {}} -test menu-11.14 {ConfigureMenuEntry} { - catch {destroy .m1} + .m3 entryconfigure 1 -label "test" -menu .m1 +} -cleanup { + deleteWindows +} -result {} +test menu-11.14 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add checkbutton - list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1] -} {0 {} test {}} -test menu-11.15 {ConfigureMenuEntry} { - catch {destroy .m1} + list [.m1 entryconfigure 1 -variable "test"] [.m1 entrycget 1 -variable] +} -cleanup { + deleteWindows +} -result {{} test} +test menu-11.15 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 - list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1] -} {0 {} test {}} -test menu-11.16 {ConfigureMenuEntry} { - catch {destroy .m1} + list [.m1 add checkbutton -label "test"] [.m1 entrycget 1 -variable] +} -cleanup { + deleteWindows +} -result {{} test} +test menu-11.16 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 - list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-11.17 {ConfigureMenuEntry} { - catch {destroy .m1} + .m1 add radiobutton -label "test" +} -cleanup { + deleteWindows +} -result {} +test menu-11.17 {ConfigureMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add checkbutton - list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1] -} {0 {} test {}} -test menu-11.18 {ConfigureMenuEntry} testImageType { - catch {destroy .m1} - catch {image delete image1} + list [.m1 entryconfigure 1 -onvalue "test"] [.m1 entrycget 1 -onvalue] +} -cleanup { + deleteWindows +} -result {{} test} +test menu-11.18 {ConfigureMenuEntry} -constraints testImageType -setup { + deleteWindows + imageCleanup +} -body { menu .m1 .m1 add command image create test image1 - list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1] -} {0 {} {} {}} -test menu-11.19 {ConfigureMenuEntry} {testImageType hasEarthPhoto} { - catch {destroy .m1} - catch {image delete image1} - catch {image delete image2} + .m1 entryconfigure 1 -image image1 +} -cleanup { + deleteWindows + imageCleanup +} -result {} +test menu-11.19 {ConfigureMenuEntry} -constraints { + testImageType hasEarthPhoto +} -setup { + deleteWindows + imageCleanup +} -body { image create test image1 image create photo image2 -file $earthPhotoFile menu .m1 .m1 add command -image image1 - list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2] -} {0 {} {} {} {}} -test menu-11.20 {ConfigureMenuEntry} {testImageType hasEarthPhoto} { - catch {destroy .m1} - catch {image delete image1} - catch {image delete image2} + .m1 entryconfigure 1 -image image2 +} -cleanup { + deleteWindows + imageCleanup +} -result {} +test menu-11.20 {ConfigureMenuEntry} -constraints { + testImageType hasEarthPhoto +} -setup { + deleteWindows + imageCleanup +} -body { image create photo image1 -file $earthPhotoFile image create test image2 menu .m1 .m1 add checkbutton -image image1 - list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2] -} {0 {} {} {} {}} -test menu-11.21 {ConfigureMenuEntry} {testImageType hasEarthPhoto} { - catch {destroy .m1} - catch {image delete image1} - catch {image delete image2} - catch {image delete image3} + .m1 entryconfigure 1 -selectimage image2 +} -cleanup { + deleteWindows + imageCleanup +} -result {} +test menu-11.21 {ConfigureMenuEntry} -constraints { + testImageType hasEarthPhoto +} -setup { + deleteWindows + imageCleanup +} -body { image create photo image1 -file $earthPhotoFile image create test image2 image create test image3 menu .m1 .m1 add checkbutton -image image1 -selectimage image2 - list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3] -} {0 {} {} {} {} {}} + .m1 entryconfigure 1 -selectimage image3 +} -cleanup { + deleteWindows + imageCleanup +} -result {} -test menu-12.1 {ConfigureMenuCloneEntries} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + +test menu-12.1 {ConfigureMenuCloneEntries} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 .m2 configure -tearoff 0 .m1 clone .m3 .m1 add command -label "test" .m1 add command -label "test2" - list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1] -} {{1 {unknown option "-gork"}} {}} -test menu-12.2 {ConfigureMenuCloneEntries} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} - catch {destroy .m4} + .m1 entryconfigure 1 -gork "foo" +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown option "-gork"} +test menu-12.2 {ConfigureMenuCloneEntries} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 menu .m3 .m1 add cascade -menu .m3 menu .m4 - list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4] -} {0 {} {} {} {}} -test menu-12.3 {ConfigureMenuCloneEntries} { - catch {destroy .m1} - catch {destroy .m2} + .m1 entryconfigure 1 -menu .m4 +} -cleanup { + deleteWindows +} -result {} +test menu-12.3 {ConfigureMenuCloneEntries} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 .m1 add cascade -label dummy - list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1] -} {0 {} {}} - -test menu-12.4 {ConfigureMenuCloneEntries} { - catch {destroy .m1} - catch {destroy .m2} + .m1 entryconfigure dummy -menu .m3 +} -cleanup { + deleteWindows +} -result {} +test menu-12.4 {ConfigureMenuCloneEntries} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label File -menu .m1.foo menu .m1.foo .m1.foo add command -label bar .m1 clone .m2 - list [catch {.m1 entryconfigure File -state disabled} msg1] $msg1 [destroy .m1] -} {0 {} {}} + .m1 entryconfigure File -state disabled +} -cleanup { + deleteWindows +} -result {} -test menu-13.1 {TkGetMenuIndex} { - catch {destroy .m1} + +test menu-13.1 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "active" .m1 add command -label "test2" .m1 add command -label "test3" .m1 activate 2 - list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1] -} {0 test2 {}} -test menu-13.2 {TkGetMenuIndex} { - catch {destroy .m1} + .m1 entrycget active -label +} -cleanup { + deleteWindows +} -result {test2} +test menu-13.2 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "last" .m1 add command -label "test2" .m1 add command -label "test3" .m1 activate 2 - list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1] -} {0 test3 {}} -test menu-13.3 {TkGetMenuIndex} { - catch {destroy .m1} + .m1 entrycget last -label +} -cleanup { + deleteWindows +} -result {test3} +test menu-13.3 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "last" .m1 add command -label "test2" .m1 add command -label "test3" .m1 activate 2 - list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1] -} {0 test3 {}} -test menu-13.4 {TkGetMenuIndex} { - catch {destroy .m1} + .m1 entrycget end -label +} -cleanup { + deleteWindows +} -result {test3} +test menu-13.4 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1] -} {0 {} test2 {}} -test menu-13.5 {TkGetMenuIndex} { - catch {destroy .m1} + list [.m1 insert last command -label "test2"] [.m1 entrycget last -label] +} -cleanup { + deleteWindows +} -result {{} test2} +test menu-13.5 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1] -} {0 {} test2 {}} -test menu-13.6 {TkGetMenuIndex} { - catch {destroy .m1} + list [.m1 insert end command -label "test2"] [.m1 entrycget end -label] +} -cleanup { + deleteWindows +} -result {{} test2} +test menu-13.6 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "active" .m1 add command -label "test2" .m1 add command -label "test3" .m1 activate 2 - list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1] -} {0 {} {}} + .m1 entrycget none -label +} -cleanup { + deleteWindows +} -result {} #test menu-13.7 - Need to add @test here. -test menu-13.7 {TkGetMenuIndex} { - catch {destroy .m1} +test menu-13.7 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "active" .m1 add command -label "test2" .m1 add command -label "test3" - list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1] -} {0 active {}} -test menu-13.8 {TkGetMenuIndex} { - catch {destroy .m1} + .m1 entrycget 1 -label +} -cleanup { + deleteWindows +} -result {active} +test menu-13.8 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "active" - list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1] -} {1 {bad menu entry index "-1"} {}} -test menu-13.9 {TkGetMenuIndex} { - catch {destroy .m1} + .m1 entrycget -1 -label +} -returnCodes error -result {bad menu entry index "-1"} +test menu-13.9 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test2" - list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1] -} {0 test2 {}} -test menu-13.10 {TkGetMenuIndex} { - catch {destroy .m1} + .m1 entrycget 999 -label +} -cleanup { + deleteWindows +} -result {test2} +test menu-13.10 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 insert 999 command -label "test" - list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1] -} {0 test {}} -test menu-13.11 {TkGetMenuIndex} { - catch {destroy .m1} + .m1 entrycget 1 -label +} -cleanup { + deleteWindows +} -result {test} +test menu-13.11 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "1test" - list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1] -} {0 1test {}} -test menu-13.12 {TkGetMenuIndex} { - catch {destroy .m1} + .m1 entrycget 1test -label +} -cleanup { + deleteWindows +} -result {1test} +test menu-13.12 {TkGetMenuIndex} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test2" -command "beep" .m1 add command -label "test3" - list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1] -} {0 beep {}} + .m1 entrycget test2 -command +} -cleanup { + deleteWindows +} -result {beep} -test menu-14.1 {MenuCmdDeletedProc} { - catch {destroy .m1} +test menu-14.1 {MenuCmdDeletedProc} -setup { + deleteWindows +} -body { menu .m1 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-14.2 {MenuCmdDeletedProc} { - catch {destroy .m1} + destroy .m1 +} -cleanup { + deleteWindows +} -returnCodes ok +test menu-14.2 {MenuCmdDeletedProc} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 - list [catch {destroy .m1} msg] $msg -} {0 {}} + destroy .m1 +} -cleanup { + deleteWindows +} -returnCodes ok -test menu-15.1 {MenuNewEntry} { - catch {destroy .m1} +test menu-15.1 {MenuNewEntry} -setup { + deleteWindows +} -body { menu .m1 - list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-15.2 {MenuNewEntry} { - catch {destroy .m1} + .m1 add command -label "test" +} -cleanup { + deleteWindows +} -result {} +test menu-15.2 {MenuNewEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test3" - list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-15.3 {MenuNewEntry} { - catch {destroy .m1} + .m1 insert 2 command -label "test2" +} -cleanup { + deleteWindows +} -result {} +test menu-15.3 {MenuNewEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-15.4 {MenuNewEntry} { - catch {destroy .m1} + .m1 add command -label "test2" +} -cleanup { + deleteWindows +} -result {} +test menu-15.4 {MenuNewEntry} -setup { + deleteWindows +} -body { menu .m1 - list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1] -} {0 {} {}} + .m1 add command -label "test" +} -cleanup { + deleteWindows +} -result {} -test menu-16.1 {MenuAddOrInsert} { - catch {destroy .m1} +test menu-16.1 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 - list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1] -} {1 {bad menu entry index "foo"} {}} -test menu-16.2 {MenuAddOrInsert} { - catch {destroy .m1} + .m1 insert foo command -label "test" +} -returnCodes error -result {bad menu entry index "foo"} +test menu-16.2 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-16.3 {MenuAddOrInsert} { - catch {destroy .m1} + .m1 insert test command -label "foo" +} -cleanup { + deleteWindows +} -result {} +test menu-16.3 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 - list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1] -} {1 {bad menu entry index "-1"} {}} -test menu-16.4 {MenuAddOrInsert} { - catch {destroy .m1} + .m1 insert -1 command -label "test" +} -returnCodes error -result {bad menu entry index "-1"} +test menu-16.4 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" .m1 insert 0 command -label "test2" - list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1] -} {0 test2 {}} -test menu-16.5 {MenuAddOrInsert} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add cascade} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-16.6 {MenuAddOrInsert} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add checkbutton} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-16.7 {MenuAddOrInsert} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add command} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-16.8 {MenuAddOrInsert} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add radiobutton} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-16.9 {MenuAddOrInsert} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add separator} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-16.10 {MenuAddOrInsert} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add blork} msg] $msg [destroy .m1] -} {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}} -test menu-16.11 {MenuAddOrInsert} { - catch {destroy .m1} - menu .m1 - list [catch {.m1 add command} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-16.12 {MenuAddOrInsert} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + .m1 entrycget 1 -label +} -cleanup { + deleteWindows +} -result {test2} +test menu-16.5 {MenuAddOrInsert} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add cascade +} -cleanup { + deleteWindows +} -result {} +test menu-16.6 {MenuAddOrInsert} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add checkbutton +} -cleanup { + deleteWindows +} -result {} +test menu-16.7 {MenuAddOrInsert} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command +} -cleanup { + deleteWindows +} -result {} +test menu-16.8 {MenuAddOrInsert} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add radiobutton +} -cleanup { + deleteWindows +} -result {} +test menu-16.9 {MenuAddOrInsert} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add separator +} -cleanup { + deleteWindows +} -result {} +test menu-16.10 {MenuAddOrInsert} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add blork +} -returnCodes error -result {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} +test menu-16.11 {MenuAddOrInsert} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command +} -cleanup { + deleteWindows +} -result {} +test menu-16.12 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 .m2 clone .m3 - list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1] -} {0 {} 0 test 0 test {}} -test menu-16.13 {MenuAddOrInsert} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + list [.m2 add command -label "test"] [.m1 entrycget 1 -label] [.m3 entrycget 1 -label] +} -cleanup { + deleteWindows +} -result {{} test test} +test menu-16.13 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 .m2 clone .m3 - list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1] -} {0 {} 0 test 0 test {}} -test menu-16.14 {MenuAddOrInsert} { - catch {destroy .m1} + list [.m3 add command -label "test"] [.m1 entrycget 1 -label] [.m2 entrycget 1 -label] +} -cleanup { + deleteWindows +} -result {{} test test} +test menu-16.14 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 - list [catch {.m1 add command -blork} msg] $msg [destroy .m1] -} {1 {unknown option "-blork"} {}} -test menu-16.15 {MenuAddOrInsert} { - catch {destroy .m1} - catch {destroy .container} + .m1 add command -blork +} -returnCodes error -result {unknown option "-blork"} +test menu-16.15 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "File" menu .container . configure -menu .container - list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1] -} {0 {} {} {}} -test menu-16.16 {MenuAddOrInsert} { - catch {destroy .m1} - catch {destroy .m2} + list [.container add cascade -label "File" -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-16.16 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 menu .m2 set tearoff [tk::TearOffMenu .m2] - list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3 -} {0 {} {} 0 {} 0 {}} -test menu-16.17 {MenuAddOrInsert} { - catch {destroy .m1} - catch {destroy .container} + list [.m2 add cascade -menu .m1] [$tearoff unpost] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-16.17 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 menu .container . configure -menu .container set tearoff [tk::TearOffMenu .container] - list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container] -} {0 {} {} {}} -test menu-16.18 {MenuAddOrInsert} { - catch {destroy .m1} - catch {destroy .container} + list [.container add cascade -label "File" -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-16.18 {MenuAddOrInsert} -setup { + deleteWindows +} -body { menu .m1 menu .container .container add cascade -menu .m1 . configure -menu .container - list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container] -} {0 {} {} {}} -test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} { - catch {destroy .menubar} + list [.container add cascade -label "File" -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} -setup { + deleteWindows +} -body { menu .menubar menu .menubar.test -tearoff 0 .menubar add cascade -label Test -underline 0 -menu .menubar.test @@ -1966,198 +3077,270 @@ test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} { .menubar.test.cascade add command -label SubItem -command "puts SubItemSelected" . configure -menu .menubar list [catch {.menubar.test add cascade -label SubMenu \ - -menu .menubar.test.cascade} msg] \ - [info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \ - [. configure -menu ""] [destroy .menubar] -} {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}} + -menu .menubar.test.cascade}] \ + [info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \ + [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {0 .#menubar.#menubar#test.#menubar#test#cascade {}} + -test menu-17.1 {MenuVarProc} { - catch {destroy .m1} +test menu-17.1 {MenuVarProc} -setup { + deleteWindows +} -body { catch {unset foo} menu .m1 set foo "hello" - list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1] -} {0 {} 0 {} {}} + list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ + [unset foo] +} -cleanup { + deleteWindows +} -result {{} {}} # menu-17.2 - Don't know how to generate the flags in the if -test menu-17.2 {MenuVarProc} { - catch {destroy .m1} +test menu-17.2 {MenuVarProc} -setup { + deleteWindows +} -body { catch {unset foo} menu .m1 - list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1] -} {0 {} {} {}} -test menu-17.3 {MenuVarProc} { - catch {destroy .m1} + list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ + [set foo ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-17.3 {MenuVarProc} -setup { + deleteWindows +} -body { catch {unset foo} menu .m1 set foo "hello" - list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2 -} {0 {} hello {} 0 {}} -test menu-17.4 {MenuVarProc} { - catch {destroy .m1} + list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ + [set foo "hello"] [unset foo] +} -cleanup { + deleteWindows +} -result {{} hello {}} +test menu-17.4 {MenuVarProc} -setup { + deleteWindows +} -body { menu .m1 set foo "goodbye" - list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2 -} {0 {} hello {} 0 {}} -test menu-17.5 {MenuVarProc} { - catch {destroy .m1} + list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ + [set foo "hello"] [unset foo] +} -cleanup { + deleteWindows +} -result {{} hello {}} +test menu-17.5 {MenuVarProc} -setup { + deleteWindows +} -body { menu .m1 set foo "hello" - list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2 -} {0 {} goodbye {} 0 {}} + list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ + [set foo "goodbye"] [unset foo] +} -cleanup { + deleteWindows +} -result {{} goodbye {}} -test menu-18.1 {TkActivateMenuEntry} { - catch {destroy .m1} + +test menu-18.1 {TkActivateMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 activate 1} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-18.2 {TkActivateMenuEntry} { - catch {destroy .m1} + .m1 activate 1 +} -cleanup { + deleteWindows +} -result {} +test menu-18.2 {TkActivateMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" - list [catch {.m1 activate 0} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-18.3 {TkActivateMenuEntry} { - catch {destroy .m1} + .m1 activate 0 +} -cleanup { + deleteWindows +} -result {} +test menu-18.3 {TkActivateMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test2" .m1 activate 1 - list [catch {.m1 activate 2} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-18.4 {TkActivateMenuEntry} { - catch {destroy .m1} + .m1 activate 2 +} -cleanup { + deleteWindows +} -result {} +test menu-18.4 {TkActivateMenuEntry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test2" .m1 activate 1 - list [catch {.m1 activate 1} msg] $msg [destroy .m1] -} {0 {} {}} + .m1 activate 1 +} -cleanup { + deleteWindows +} -result {} + -test menu-19.1 {TkPostCommand} {nonUnixUserInteraction } { - catch {destroy .m1} +test menu-19.1 {TkPostCommand} -constraints nonUnixUserInteraction -setup { + deleteWindows +} -body { menu .m1 -postcommand "set menu_test menu-19.1" .m1 add command -label "menu-19.1 - hit Escape" - list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1] -} {0 menu-19.1 {} menu-19.1 {}} -test menu-19.2 {TkPostCommand} {nonUnixUserInteraction } { - catch {destroy .m1} + list [.m1 post 40 40] [.m1 unpost] [set menu_test] +} -cleanup { + deleteWindows +} -result {menu-19.1 {} menu-19.1} +test menu-19.2 {TkPostCommand} -constraints nonUnixUserInteraction -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "menu-19.2 - hit Escape" - list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1] -} {0 {} {} {}} - -test menu-20.1 {CloneMenu} { - catch {destroy .m1} - catch {destroy .m2} - menu .m1 - list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1] -} {0 {} {}} -test menu-20.2 {CloneMenu} { - catch {destroy .m1} - catch {destroy .m2} - menu .m1 - list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1] -} {0 {} {}} -test menu-20.3 {CloneMenu} { - catch {destroy .m1} - catch {destroy .m2} - menu .m1 - list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1] -} {0 {} {}} -test menu-20.4 {CloneMenu} { - catch {destroy .m1} - catch {destroy .m2} - menu .m1 - list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1] -} {0 {} {}} -test menu-20.5 {CloneMenu} { - catch {destroy .m1} - catch {destroy .m2} - menu .m1 - list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1] -} {1 {bad menu type "foo": must be normal, tearoff, or menubar} {}} -test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} { - catch {destroy .m1} - catch {destroy .m2} - menu .m1 - list [catch {.m1 clone .m2} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + list [.m1 post 40 40] [.m1 unpost] +} -cleanup { + deleteWindows +} -result {{} {}} + +test menu-20.1 {CloneMenu} -setup { + deleteWindows +} -body { + menu .m1 + .m1 clone .m2] +} -cleanup { + deleteWindows +} -result {} +test menu-20.2 {CloneMenu} -setup { + deleteWindows +} -body { + menu .m1 + .m1 clone .m2 normal + deleteWindows +} -result {} +test menu-20.3 {CloneMenu} -setup { + deleteWindows +} -body { + menu .m1 + .m1 clone .m2 tearoff +} -cleanup { + deleteWindows +} -result {} +test menu-20.4 {CloneMenu} -setup { + deleteWindows +} -body { + menu .m1 + .m1 clone .m2 menubar +} -cleanup { + deleteWindows +} -result {} +test menu-20.5 {CloneMenu} -setup { + deleteWindows +} -body { + menu .m1 + .m1 clone .m2 foo +} -returnCodes error -result {bad menu type "foo": must be normal, tearoff, or menubar} +test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} -setup { + deleteWindows +} -body { + menu .m1 + .m1 clone .m2 +} -cleanup { + deleteWindows +} -result {} +test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} -setup { + deleteWindows +} -body { menu .m1 .m1 clone .m2 - list [catch {.m1 clone .m3} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-20.8 {CloneMenu - cascade entries} { - catch {destroy .m1} - catch {destroy .foo} + .m1 clone .m3 +} -cleanup { + deleteWindows +} -result {} +test menu-20.8 {CloneMenu - cascade entries} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -menu .m2 - list [catch {.m1 clone .foo} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-20.9 {CloneMenu - cascades entries} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .foo} + .m1 clone .foo +} -cleanup { + deleteWindows +} -result {} +test menu-20.9 {CloneMenu - cascades entries} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -menu .m2 menu .m2 - list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2] -} {0 {} {}} -test menu-20.10 {CloneMenu - tearoff fields} { - catch {destroy .m1} - catch {destroy .m2} - menu .m1 - list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1] -} {0 {} 0 1 {}} -test menu-20.11 {CloneMenu} { - catch {destroy .m1} - catch {destroy .m2} + .m1 clone .foo +} -cleanup { + deleteWindows +} -result {} +test menu-20.10 {CloneMenu - tearoff fields} -setup { + deleteWindows +} -body { + menu .m1 + list [.m1 clone .m2 normal] [.m2 cget -tearoff] +} -cleanup { + deleteWindows +} -result {{} 1} +test menu-20.11 {CloneMenu} -setup { + deleteWindows +} -body { menu .m1 menu .m2 - list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2] -} {1 {window name "m2" already exists in parent} {}} + .m1 clone .m2 +} -returnCodes error -result {window name "m2" already exists in parent} -test menu-21.1 {MenuDoYPosition} { - catch {destroy .m1} +test menu-21.1 {MenuDoYPosition} -setup { + deleteWindows +} -body { menu .m1 - list [catch {.m1 yposition glorp} msg] $msg [destroy .m1] -} {1 {bad menu entry index "glorp"} {}} -test menu-21.2 {MenuDoYPosition} { - catch {destroy .m1} + .m1 yposition glorp +} -returnCodes error -result {bad menu entry index "glorp"} +test menu-21.2 {MenuDoYPosition} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "Test" - list [catch {.m1 yposition 1}] [destroy .m1] -} {0 {}} + .m1 yposition 1 +} -cleanup { + deleteWindows +} -returnCodes ok -match glob -result {*} -test menu-22.1 {GetIndexFromCoords} { - catch {destroy .m1} +test menu-22.1 {GetIndexFromCoords} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" .m1 configure -tearoff 0 - list [catch {.m1 index @5} msg] $msg [destroy .m1] -} {0 0 {}} -test menu-22.2 {GetIndexFromCoords} { - catch {destroy .m1} + .m1 index @5 +} -cleanup { + deleteWindows +} -result {0} +test menu-22.2 {GetIndexFromCoords} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "test" .m1 configure -tearoff 0 - list [catch {.m1 index @5,5} msg] $msg [destroy .m1] -} {0 0 {}} -test menu-22.3 {GetIndexFromCoords: mapped window, y only} unix { - catch {destroy .m1} + .m1 index @5,5 +} -cleanup { + deleteWindows +} -result {0} +test menu-22.3 {GetIndexFromCoords: mapped window, y only} -setup { + deleteWindows +} -constraints {unix} -body { menu .m1 .m1 add command -label "test" .m1 configure -tearoff 0 tk_popup .m1 0 0 tkwait visibility .m1 - list [catch {.m1 index @5} msg] $msg [destroy .m1] -} {0 0 {}} -test menu-22.4 {GetIndexFromCoords: mapped window x,y} unix { - catch {destroy .m1} + .m1 index @5 +} -cleanup { + deleteWindows +} -result {0} +test menu-22.4 {GetIndexFromCoords: mapped window x,y} -setup { + deleteWindows +} -constraints {unix} -body { menu .m1 .m1 add command -label "test" .m1 configure -tearoff 0 @@ -2165,10 +3348,13 @@ test menu-22.4 {GetIndexFromCoords: mapped window x,y} unix { tkwait visibility .m1 update set x [expr {[winfo width .m1] - [.m1 cget -borderwidth] - 1}] - list [catch {.m1 index @$x,5} msg] $msg [destroy .m1] -} {0 0 {}} -test menu-22.5 {GetIndexFromCoords: mapped wide window} unix { - catch {destroy .m1} + .m1 index @$x,5 +} -cleanup { + deleteWindows +} -result {0} +test menu-22.5 {GetIndexFromCoords: mapped wide window} -setup { + deleteWindows +} -constraints {unix} -body { menu .m1 .m1 add command -label "test" .m1 configure -tearoff 0 @@ -2177,105 +3363,137 @@ test menu-22.5 {GetIndexFromCoords: mapped wide window} unix { wm geometry .m1 200x100 update set x [expr {[winfo width .m1] - [.m1 cget -borderwidth] - 1}] - list [catch {.m1 index @$x,5} msg] $msg [destroy .m1] -} {0 0 {}} + .m1 index @$x,5 +} -cleanup { + deleteWindows +} -result {0} -test menu-23.1 {RecursivelyDeleteMenu} { - catch {destroy .m1} +test menu-23.1 {RecursivelyDeleteMenu} -setup { + deleteWindows +} -body { menu .m1 . configure -menu .m1 - list [catch {. configure -menu ""} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-23.2 {RecursivelyDeleteMenu} { - catch {destroy .m1} - catch {destroy .m2} + . configure -menu "" +} -cleanup { + deleteWindows +} -result {} +test menu-23.2 {RecursivelyDeleteMenu} -setup { + deleteWindows +} -body { menu .m2 .m2 add command -label "test2" menu .m1 .m1 add cascade -label "test1" -menu .m2 . configure -menu .m1 - list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2] -} {0 {} {}} + . configure -menu "" +} -cleanup { + deleteWindows +} -result {} -test menu-24.1 {TkNewMenuName} { - catch {destroy .m1} +test menu-24.1 {TkNewMenuName} -setup { + deleteWindows +} -body { menu .m1 - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test menu-24.2 {TkNewMenuName} { - catch {destroy .m1} - catch {destroy .m1\#0} + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-24.2 {TkNewMenuName} -setup { + deleteWindows +} -body { menu .m1 menu .m1\#0 - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test menu-24.3 {TkNewMenuName} { - catch {destroy .#m} + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-24.3 {TkNewMenuName} -setup { + deleteWindows +} -body { menu .#m rename .#m hideme - list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme] -} {0 {} {} {} {}} + list [catch {. configure -menu [menu .m]}] [. configure -menu ""] [destroy .#m] \ + [destroy .m] [destroy hideme] +} -result {0 {} {} {} {}} -test menu-25.1 {TkSetWindowMenuBar} { + +test menu-25.1 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] -} {0 {} {}} -test menu-25.2 {TkSetWindowMenuBar} { + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.2 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] -} {0 {} {}} -test menu-25.3 {TkSetWindowMenuBar} { + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.3 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" - catch {destroy .m1} + destroy .m1 menu .m1 - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test menu-25.4 {TkSetWindowMenuBar} { - catch {destroy .m1} - catch {destroy .m2} + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.4 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 . configure -menu .m1 menu .m2 - list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2] -} {0 {} {} {}} -test menu-25.5 {TkSetWindowMenuBar} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + list [. configure -menu .m2] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.5 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 . configure -menu .m1 .m1 clone .m2 menu .m3 - list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3] -} {0 {} {} {}} -test menu-25.6 {TkSetWindowMenuBar} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + list [. configure -menu .m3] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.6 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 .m1 clone .m2 . configure -menu .m2 menu .m3 - list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3] -} {0 {} {} {}} -test menu-25.7 {TkSetWindowMenuBar} { - catch {destroy .m1} - catch {destroy .m2} + list [. configure -menu .m3] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.7 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 menu .m2 . configure -menu .m1 toplevel .t2 .t2 configure -menu .m1 - list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2] -} {0 {} {} {}} -test menu-25.8 {TkSetWindowMenuBar} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .t2} + list [.t2 configure -menu .m2] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.8 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 menu .m2 @@ -2283,13 +3501,13 @@ test menu-25.8 {TkSetWindowMenuBar} { toplevel .t2 wm geometry .t2 +0+0 .t2 configure -menu .m1 - list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2] -} {0 {} {} {}} -test menu-25.9 {TkSetWindowMenuBar} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .t2} - catch {destroy .t3} + list [. configure -menu .m2] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.9 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 menu .m2 @@ -2298,13 +3516,13 @@ test menu-25.9 {TkSetWindowMenuBar} { wm geometry .t2 +0+0 toplevel .t3 -menu .m1 wm geometry .t3 +0+0 - list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2] -} {0 {} {} {}} -test menu-25.10 {TkSetWindowMenuBar} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .t2} - catch {destroy .t3} + list [.t3 configure -menu .m2] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.10 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 menu .m2 @@ -2313,13 +3531,13 @@ test menu-25.10 {TkSetWindowMenuBar} { wm geometry .t2 +0+0 toplevel .t3 -menu .m1 wm geometry .t3 +0+0 - list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2] -} {0 {} {} {}} -test menu-25.11 {TkSetWindowMenuBar} { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .t2} - catch {destroy .t3} + list [.t2 configure -menu .m2] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.11 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 menu .m2 @@ -2328,128 +3546,188 @@ test menu-25.11 {TkSetWindowMenuBar} { wm geometry .t2 +0+0 toplevel .t3 -menu .m1 wm geometry .t3 +0+0 - list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2] -} {0 {} {} {}} -test menu-25.12 {TkSetWindowMenuBar} { - catch {destroy .m1} + list [. configure -menu .m2] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.12 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test menu-25.13 {TkSetWindowMenuBar} { + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.13 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] -} {0 {} {}} -test menu-25.14 {TkSetWindowMenuBar} { - catch {destroy .m1} + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.14 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test menu-25.15 {TkSetWindowMenuBar} { + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.15 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] -} {0 {} {}} -test menu-25.16 {TkSetWindowMenuBar} { - catch {destroy .m1} + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menu-25.16 {TkSetWindowMenuBar} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 . configure -menu .m1 - list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1] -} {0 .t2 {} {}} + list [toplevel .t2 -menu m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {.t2 {}} + -test menu-26.1 {DestroyMenuHashTable} { - catch {interp destroy testinterp} +test menu-26.1 {DestroyMenuHashTable} -setup { + catch {interp delete testinterp} + deleteWindows +} -body { interp create testinterp load {} Tk testinterp interp eval testinterp {menu .m1} - list [catch {interp delete testinterp} msg] $msg -} {0 {}} + interp delete testinterp +} -returnCodes ok -result {} + -test menu-27.1 {GetMenuHashTable} { - catch {interp destroy testinterp} +test menu-27.1 {GetMenuHashTable} -setup { + catch {interp delete testinterp} + deleteWindows +} -body { interp create testinterp load {} Tk testinterp list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp] -} {0 .m1 {}} +} -cleanup { + deleteWindows +} -result {0 .m1 {}} -test menu-28.1 {TkCreateMenuReferences - not there before} { - catch {destroy .m1} - list [catch {menu .m1} msg] $msg [destroy .m1] -} {0 .m1 {}} -test menu-28.2 {TkCreateMenuReferences - there already} { - catch {destroy .m1} - catch {destroy .m2} + +test menu-28.1 {TkCreateMenuReferences - not there before} -setup { + deleteWindows +} -body { + menu .m1 +} -cleanup { + deleteWindows +} -result {.m1} +test menu-28.2 {TkCreateMenuReferences - there already} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -menu .m2 - list [catch {menu .m2} msg] $msg [destroy .m1 .m2] -} {0 .m2 {}} + menu .m2 +} -cleanup { + deleteWindows +} -result {.m2} + -test menu-29.1 {TkFindMenuReferences - not there} { - catch {destroy .m1} +test menu-29.1 {TkFindMenuReferences - not there} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 .m1 add cascade -menu .m2 - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test menu-30.1 {TkFindMenuReferences - there already} { - catch {destroy .m1} - catch {destroy .m2} + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} + + +test menu-30.1 {TkFindMenuReferences - there already} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 menu .m2 .m1 add cascade -menu .m2 - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2] -} {0 {} {} {}} + list [. configure -menu .m1] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} + -test menu-31.1 {TkFreeMenuReferences - menuPtr} { - catch {destroy .m1} +test menu-31.1 {TkFreeMenuReferences - menuPtr} -setup { + deleteWindows +} -body { menu .m1 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test menu-31.2 {TkFreeMenuReferences - cascadePtr} { - catch {destroy .m1} + destroy .m1 +} -cleanup { + deleteWindows +} -result {} +test menu-31.2 {TkFreeMenuReferences - cascadePtr} -setup { + deleteWindows +} -body { . configure -menu "" menu .m1 .m1 add cascade -menu .m2 - list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} { + .m1 entryconfigure 1 -menu .m3 +} -cleanup { + deleteWindows +} -result {} +test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} -setup { + deleteWindows +} -body { . configure -menu .m1 - list [catch {. configure -menu ""} msg] $msg -} {0 {}} -test menu-31.4 {TkFreeMenuReferences - not empty} { - catch {destroy .m1} - catch {destroy .m2} + . configure -menu "" +} -cleanup { + deleteWindows +} -returnCodes ok -result {} +test menu-31.4 {TkFreeMenuReferences - not empty} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -menu .m3 menu .m2 .m2 add cascade -menu .m3 - list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2] -} {0 {} {}} + .m2 entryconfigure 1 -menu ".foo" +} -cleanup { + deleteWindows +} -result {} + -test menu-32.1 {DeleteMenuCloneEntries} { - catch {destroy .m1} - catch {destroy .m2} +test menu-32.1 {DeleteMenuCloneEntries} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label foo .m1 clone .m2 - list [catch {.m1 delete 1} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-32.2 {DeleteMenuCloneEntries} { - catch {destroy .m1} - catch {destroy .m2} + .m1 delete 1 +} -cleanup { + deleteWindows +} -result {} +test menu-32.2 {DeleteMenuCloneEntries} -setup { + deleteWindows +} -body { + menu .m1 .m1 add command -label one .m1 add command -label two .m1 add command -label three .m1 add command -label four .m1 clone .m2 - list [catch {.m1 delete 2 3} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-32.3 {DeleteMenuCloneEntries} { - catch {destroy .m1} - catch {destroy .m2} + .m1 delete 2 3 +} -cleanup { + deleteWindows +} -result {} +test menu-32.3 {DeleteMenuCloneEntries} -setup { + deleteWindows +} -body { menu .m1 -tearoff 0 .m1 add command -label one .m1 add command -label two @@ -2457,11 +3735,13 @@ test menu-32.3 {DeleteMenuCloneEntries} { .m1 add command -label four .m1 clone .m2 .m2 configure -tearoff 1 - list [catch {.m1 delete 1 2} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-32.4 {DeleteMenuCloneEntries} { - catch {destroy .m1} - catch {destroy .m2} + .m1 delete 1 2 +} -cleanup { + deleteWindows +} -result {} +test menu-32.4 {DeleteMenuCloneEntries} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label one .m1 add command -label two @@ -2469,49 +3749,62 @@ test menu-32.4 {DeleteMenuCloneEntries} { .m1 add command -label four .m1 clone .m2 .m2 configure -tearoff 0 - list [catch {.m1 delete 2 3} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-32.5 {DeleteMenuCloneEntries} { - catch {destroy .m1} - catch {destroy .m2} + .m1 delete 2 3 +} -cleanup { + deleteWindows +} -result {} +test menu-32.5 {DeleteMenuCloneEntries} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label one .m1 add command -label two .m1 clone .m2 .m1 activate one - list [catch {.m1 delete one} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} { - catch {destroy .m1} - menu .m1 - .m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test" - list [catch {.m1 invoke test} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-32.7 {DeleteMenuCloneEntries - one entry} { - catch {destroy .m1} + .m1 delete one +} -cleanup { + deleteWindows +} -result {} +test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command -label test \ + -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test" + .m1 invoke test +} -cleanup { + deleteWindows +} -result {} +test menu-32.7 {DeleteMenuCloneEntries - one entry} -setup { + deleteWindows +} -body { menu .m1 -tearoff 0 .m1 add command -label Hello - list [catch {.m1 delete Hello} msg] $msg [destroy .m1] -} {0 {} {}} -test menu-32.8 {Ensure all menu clone commands are deleted} { + .m1 delete Hello +} -cleanup { + deleteWindows +} -result {} +test menu-32.8 {Ensure all menu clone commands are deleted} -setup { + deleteWindows +} -body { # SF bug #465324 - catch {destroy .menubar} - catch {destroy .menubar.test} menu .menubar . configure -menu .menubar menu .menubar.test .menubar.test add command -label "hi" for {set i 0} {$i < 10} {incr i} { - .menubar add cascade -menu .menubar.test -label "Test" - .menubar delete Test + .menubar add cascade -menu .menubar.test -label "Test" + .menubar delete Test } info commands .#menubar*test* -} {} -test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} { - catch {destroy .menubar} - catch {destroy .menubar.test} - +} -cleanup { + deleteWindows +} -result {} +test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} -setup { + set res {} + deleteWindows +} -body { menu .menubar . configure -menu .menubar menu .menubar.test @@ -2519,7 +3812,6 @@ test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} { menu .menubar.cascade .menubar.test add cascade -menu .menubar.cascade -label "Cascade" - set res {} lappend res [.menubar.test entrycget 1 -menu] lappend res [.#menubar.#menubar#test entrycget 1 -menu] destroy .menubar.test @@ -2527,55 +3819,72 @@ test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} { .menubar.test add cascade -menu .menubar.cascade -label "Cascade" lappend res [.menubar.test entrycget 1 -menu] lappend res [.#menubar.#menubar#test entrycget 1 -menu] - set res -} {.menubar.cascade .#menubar.#menubar#test.#menubar#cascade .menubar.cascade .#menubar.#menubar#test.#menubar#cascade} + return $res +} -cleanup { + deleteWindows +} -result {.menubar.cascade .#menubar.#menubar#test.#menubar#cascade .menubar.cascade .#menubar.#menubar#test.#menubar#cascade} -set l [interp hidden] -deleteWindows -test menu-33.1 {menu vs command hiding} { - catch {destroy .m} +test menu-33.1 {menu vs command hiding} -setup { + deleteWindows +} -body { + set l [interp hidden] menu .m interp hide {} .m destroy .m - list [winfo children .] [interp hidden] -} [list {} $l] + set result [list [winfo children .] [interp hidden]] + expr {$result eq [list {} $l]} +} -result 1 # menu-34 MenuInit only called at boot time # creating menus on two different screens then deleting the # menu from the first screen crashes Tk8.3.1 # -test menu-35.1 {menus on multiple screens - crashes tk8.3.1, Bug 5454} \ - {altDisplay} { +test menu-34.1 {menus on multiple screens - crashes tk8.3.1, Bug 5454} -constraints { + altDisplay +} -setup { + deleteWindows +} -body { toplevel .one menu .one.m toplevel .two -screen $::env(TK_ALT_DISPLAY) menu .two.m destroy .one destroy .two -} {} +} -result {} -test menu-36.1 {menu -underline string overruns Bug 1599877} {} { +test menu-35.1 {menu -underline string overruns Bug 1599877} -setup { + destroy .m +} -body { # ensure that -underline does not do string overruns [Bug 1599877] - catch {destroy .m} menu .m .m add command -label "File" -underline [expr {1<<30}] . configure -menu .m update tk::TraverseToMenu . "e" -} {} +} -cleanup { + deleteWindows +} -result {} -test menu-37.1 {menubar menues cannot be posted - bug 2160206} {} { +test menu-37.1 {menubar menues cannot be posted - bug 2160206} -setup { + catch {destroy .m} +} -body { # On Linux the following used to panic # It now returns an error (on all platforms) - catch {destroy .m} menu .m -type menubar list [catch ".m post 1 1" msg] $msg -} {1 {a menubar menu cannot be posted}} +} -cleanup { + destroy .m +} -result {1 {a menubar menu cannot be posted}} # cleanup +imageFinish deleteWindows cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/menuDraw.test b/tests/menuDraw.test index 225223c..bb632c6 100644 --- a/tests/menuDraw.test +++ b/tests/menuDraw.test @@ -5,173 +5,260 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test +imageInit -test menuDraw-1.1 {TkMenuInitializeDrawingFields} { - catch {destroy .m1} - list [menu .m1] [destroy .m1] -} {.m1 {}} - -test menuDraw-2.1 {TkIntializeMenuEntryDrawingFields} { - catch {destroy .m1} +test menuDraw-1.1 {TkMenuInitializeDrawingFields} -setup { + deleteWindows +} -body { menu .m1 - list [.m1 add command] [destroy .m1] -} {{} {}} +} -cleanup { + deleteWindows +} -result {.m1} + + +test menuDraw-2.1 {TkIntializeMenuEntryDrawingFields} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command +} -cleanup { + deleteWindows +} -result {} + -test menuDraw-3.1 {TkMenuFreeDrawOptions} { - catch {destroy .m1} +test menuDraw-3.1 {TkMenuFreeDrawOptions} -setup { + deleteWindows +} -body { menu .m1 - list [destroy .m1] -} {{}} + destroy .m1 +} -result {} -test menuDraw-4.1 {TkMenuEntryFreeDrawOptions} { - catch {destroy .m1} + +test menuDraw-4.1 {TkMenuEntryFreeDrawOptions} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "This is a test" - list [destroy .m1] -} {{}} -test menuDraw-4.2 {TkMenuEntryFreeDrawOptions} { - catch {destroy .m1} - menu .m1 - .m1 add checkbutton -label "This is a test." -font "Courier 12" -activeforeground red -background green -selectcolor purple - list [destroy .m1] -} {{}} - -test menuDraw-5.1 {TkMenuConfigureDrawOptions - new menu} { - catch {destroy .m1} - list [menu .m1] [destroy .m1] -} {.m1 {}} -test menuDraw-5.2 {TkMenuConfigureDrawOptions - old menu} { - catch {destroy .m1} - menu .m1 - list [.m1 configure -fg red] [destroy .m1] -} {{} {}} -test menuDraw-5.3 {TkMenuConfigureDrawOptions - no disabledFg} { - catch {destroy .m1} - list [menu .m1 -disabledforeground ""] [destroy .m1] -} {.m1 {}} - -test menuDraw-6.1 {TkMenuConfigureEntryDrawOptions - no tkfont specified} { - catch {destroy .m1} - menu .m1 - list [.m1 add command -label "foo"] [destroy .m1] -} {{} {}} -test menuDraw-6.2 {TkMenuConfigureEntryDrawOptions - tkfont specified} { - catch {destroy .m1} - menu .m1 - list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1] -} {{} {}} -test menuDraw-6.3 {TkMenuConfigureEntryDrawOptions - active state - wrong entry} { - catch {destroy .m1} + destroy .m1 +} -result {} +test menuDraw-4.2 {TkMenuEntryFreeDrawOptions} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add checkbutton -label "This is a test." -font "Courier 12" \ + -activeforeground red -background green -selectcolor purple + destroy .m1 +} -result {} + + +test menuDraw-5.1 {TkMenuConfigureDrawOptions - new menu} -setup { + deleteWindows +} -body { + menu .m1 +} -cleanup { + deleteWindows +} -result {.m1} +test menuDraw-5.2 {TkMenuConfigureDrawOptions - old menu} -setup { + deleteWindows +} -body { + menu .m1 + .m1 configure -fg red +} -cleanup { + deleteWindows +} -result {} +test menuDraw-5.3 {TkMenuConfigureDrawOptions - no disabledFg} -setup { + deleteWindows +} -body { + menu .m1 -disabledforeground "" +} -cleanup { + deleteWindows +} -result {.m1} + + +test menuDraw-6.1 {TkMenuConfigureEntryDrawOptions - no tkfont specified} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command -label "foo" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.2 {TkMenuConfigureEntryDrawOptions - tkfont specified} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command -label "foo" -font "Courier 12" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.3 {TkMenuConfigureEntryDrawOptions - active state - wrong entry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" - list [.m1 entryconfigure 1 -state active] [destroy .m1] -} {{} {}} -test menuDraw-6.4 {TkMenuConfigureEntryDrawOptions - active state - correct entry} { - catch {destroy .m1} + .m1 entryconfigure 1 -state active +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.4 {TkMenuConfigureEntryDrawOptions - active state - correct entry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" .m1 activate 1 - list [.m1 entryconfigure 1 -state active] [destroy .m1] -} {{} {}} -test menuDraw-6.5 {TkMenuConfigureEntryDrawOptions - deactivate entry} { - catch {destroy .m1} + .m1 entryconfigure 1 -state active +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.5 {TkMenuConfigureEntryDrawOptions - deactivate entry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" .m1 activate 1 - list [.m1 entryconfigure 1 -state normal] [destroy .m1] -} {{} {}} -test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} { - catch {destroy .m1} + .m1 entryconfigure 1 -state normal +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" - list [catch {.m1 entryconfigure 1 -state foo} msg] $msg [destroy .m1] -} {1 {bad state "foo": must be active, normal, or disabled} {}} -test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} { - catch {destroy .m1} - menu .m1 - list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1] -} {{} {}} -test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} { - catch {destroy .m1} - menu .m1 - list [.m1 add command -label "foo" -background "red"] [destroy .m1] -} {{} {}} -test menuDraw-6.9 {TkMenuConfigureEntryDrawOptions - foreground specified} { - catch {destroy .m1} - menu .m1 - list [.m1 add command -label "foo" -foreground "red"] [destroy .m1] -} {{} {}} -test menuDraw-6.10 {TkMenuConfigureEntryDrawOptions - activeBorder specified} { - catch {destroy .m1} - menu .m1 - list [.m1 add command -label "foo" -activebackground "red"] [destroy .m1] -} {{} {}} -test menuDraw-6.11 {TkMenuConfigureEntryDrawOptions - activeforeground specified} { - catch {destroy .m1} - menu .m1 - list [.m1 add command -label "foo" -activeforeground "red"] [destroy .m1] -} {{} {}} -test menuDraw-6.12 {TkMenuConfigureEntryDrawOptions - selectcolor specified} { - catch {destroy .m1} - menu .m1 - list [.m1 add radiobutton -label "foo" -selectcolor "red"] [destroy .m1] -} {{} {}} -test menuDraw-6.13 {TkMenuConfigureEntryDrawOptions - textGC disposal} { - catch {destroy .m1} + .m1 entryconfigure 1 -state foo +} -cleanup { + deleteWindows +} -returnCodes error -result {bad state "foo": must be active, normal, or disabled} +test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command -label "foo" -font "Courier 12" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command -label "foo" -background "red" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.9 {TkMenuConfigureEntryDrawOptions - foreground specified} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command -label "foo" -foreground "red" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.10 {TkMenuConfigureEntryDrawOptions - activeBorder specified} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command -label "foo" -activebackground "red" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.11 {TkMenuConfigureEntryDrawOptions - activeforeground specified} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add command -label "foo" -activeforeground "red" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.12 {TkMenuConfigureEntryDrawOptions - selectcolor specified} -setup { + deleteWindows +} -body { + menu .m1 + .m1 add radiobutton -label "foo" -selectcolor "red" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.13 {TkMenuConfigureEntryDrawOptions - textGC disposal} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" -font "Helvetica 12" - list [.m1 entryconfigure 1 -font "Courier 12"] [destroy .m1] -} {{} {}} -test menuDraw-6.14 {TkMenuConfigureEntryDrawOptions - activeGC disposal} { - catch {destroy .m1} + .m1 entryconfigure 1 -font "Courier 12" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.14 {TkMenuConfigureEntryDrawOptions - activeGC disposal} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" -activeforeground "red" - list [.m1 entryconfigure 1 -activeforeground "green"] [destroy .m1] -} {{} {}} -test menuDraw-6.15 {TkMenuConfigureEntryDrawOptions - disabledGC disposal} { - catch {destroy .m1} + .m1 entryconfigure 1 -activeforeground "green" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.15 {TkMenuConfigureEntryDrawOptions - disabledGC disposal} -setup { + deleteWindows +} -body { menu .m1 -disabledforeground "red" .m1 add command -label "foo" - list [.m1 configure -disabledforeground "green"] [destroy .m1] -} {{} {}} -test menuDraw-6.16 {TkMenuConfigureEntryDrawOptions - indicatorGC disposal} { - catch {destroy .m1} + .m1 configure -disabledforeground "green" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-6.16 {TkMenuConfigureEntryDrawOptions - indicatorGC disposal} -setup { + deleteWindows +} -body { menu .m1 .m1 add radiobutton -label "foo" -selectcolor "red" - list [.m1 entryconfigure 1 -selectcolor "green"] [destroy .m1] -} {{} {}} + .m1 entryconfigure 1 -selectcolor "green" +} -cleanup { + deleteWindows +} -result {} -test menuDraw-7.1 {TkEventuallyRecomputeMenu} { - catch {destroy .m1} + +test menuDraw-7.1 {TkEventuallyRecomputeMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "This is a long label" set tearoff [tk::TearOffMenu .m1] update idletasks - list [.m1 entryconfigure 1 -label "foo"] [destroy .m1] -} {{} {}} -test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} { - catch {destroy .m1} + .m1 entryconfigure 1 -label "foo" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "This is a long label" set tearoff [tk::TearOffMenu .m1] - list [.m1 entryconfigure 1 -label "foo"] [destroy .m1] -} {{} {}} + .m1 entryconfigure 1 -label "foo" +} -cleanup { + deleteWindows +} -result {} -test menuDraw-8.1 {TkRecomputeMenu} {win userInteraction} { - catch {destroy .m1} +test menuDraw-8.1 {TkRecomputeMenu} -constraints { + win userInteraction +} -setup { + deleteWindows +} -body { menu .m1 .m1 configure -postcommand [.m1 add command -label foo] .m1 add command -label "Hit ESCAPE to make this menu go away." - list [.m1 post 0 0] [destroy .m1] -} {{} {}} + .m1 post 0 0 +} -cleanup { + deleteWindows +} -result {} -test menuDraw-9.1 {TkEventuallyRedrawMenu - entry test} { - catch {destroy .m1} +test menuDraw-9.1 {TkEventuallyRedrawMenu - entry test} -setup { + deleteWindows +} -body { catch {unset foo} menu .m1 set foo 0 @@ -179,46 +266,66 @@ test menuDraw-9.1 {TkEventuallyRedrawMenu - entry test} { tk::TearOffMenu .m1 update idletasks list [set foo test] [destroy .m1] [unset foo] -} {test {} {}} -test menuDraw-9.2 {TkEventuallyRedrawMenu - whole menu} { - catch {destroy .m1} +} -result {test {} {}} +test menuDraw-9.2 {TkEventuallyRedrawMenu - whole menu} -setup { + deleteWindows +} -body { menu .m1 - list [catch {tk::TearOffMenu .m1}] [destroy .m1] -} {0 {}} + tk::TearOffMenu .m1 +} -cleanup { + deleteWindows +} -returnCodes ok -match glob -result * + # Don't know how to test when window has been deleted and ComputeMenuGeometry # gets called. -test menuDraw-10.1 {ComputeMenuGeometry - menubar} { - catch {destroy .m1} +test menuDraw-10.1 {ComputeMenuGeometry - menubar} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label test . configure -menu .m1 - list [update idletasks] [. configure -menu ""] [destroy .m1] -} {{} {} {}} -test menuDraw-10.2 {ComputeMenuGeometry - non-menubar} { - catch {destroy .m1} + list [update idletasks] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menuDraw-10.2 {ComputeMenuGeometry - non-menubar} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label test - list [update idletasks] [destroy .m1] -} {{} {}} -test menuDraw-10.3 {ComputeMenuGeometry - Resize necessary} { - catch {destroy .m1} + update idletasks +} -cleanup { + deleteWindows +} -result {} +test menuDraw-10.3 {ComputeMenuGeometry - Resize necessary} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label test - list [update idletasks] [destroy .m1] -} {{} {}} -test menuDraw-10.4 {ComputeMenuGeometry - resize not necessary} { - catch {destroy .m1} + update idletasks +} -cleanup { + deleteWindows +} -result {} +test menuDraw-10.4 {ComputeMenuGeometry - resize not necessary} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label test update idletasks .m1 entryconfigure 1 -label test - list [update idletasks] [destroy .m1] -} {{} {}} + update idletasks +} -cleanup { + deleteWindows +} -result {} -test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} testImageType { - catch {destroy .m1} - catch {eval image delete [image names]} + +test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} -constraints { + testImageType +} -setup { + deleteWindows + imageCleanup +} -body { image create test image1 image create test image2 menu .m1 @@ -226,80 +333,111 @@ test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] update idletasks - list [image delete image2] [destroy .m1] [eval image delete [image names]] -} {{} {} {}} -test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} testImageType { - catch {destroy .m1} - catch {eval image delete [image names]} + list [image delete image2] [destroy .m1] +} -cleanup { + imageCleanup +} -result {{} {}} +test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} -constraints { + testImageType +} -setup { + deleteWindows + imageCleanup +} -body { image create test image1 image create test image2 menu .m1 .m1 add checkbutton -image image1 -selectimage image2 .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] - list [image delete image2] [destroy .m1] [eval image delete [image names]] -} {{} {} {}} -test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} testImageType { - catch {destroy .m1} - catch {eval image delete [image names]} + list [image delete image2] [destroy .m1] +} -cleanup { + imageCleanup +} -result {{} {}} +test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} -constraints { + testImageType +} -setup { + deleteWindows + imageCleanup +} -body { image create test image1 image create test image2 menu .m1 .m1 add checkbutton -image image1 -selectimage image2 set tearoff [tk::TearOffMenu .m1 40 40] update idletasks - list [image delete image2] [destroy .m1] [eval image delete [image names]] -} {{} {} {}} + list [image delete image2] [destroy .m1] +} -cleanup { + imageCleanup +} -result {{} {}} #Don't know how to test missing tkwin in DisplayMenu -test menuDraw-12.1 {DisplayMenu - menubar background} unix { - catch {destroy .m1} +test menuDraw-12.1 {DisplayMenu - menubar background} -constraints unix -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label foo -menu .m2 . configure -menu .m1 - list [update] [. configure -menu ""] [destroy .m1] -} {{} {} {}} -test menuDraw-12.2 {Display menu - no entries} { - catch {destroy .m1} + list [update] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menuDraw-12.2 {Display menu - no entries} -setup { + deleteWindows +} -body { menu .m1 set tearoff [tk::TearOffMenu .m1 40 40] - list [update] [destroy .m1] -} {{} {}} -test menuDraw-12.3 {DisplayMenu - one entry} { - catch {destroy .m1} + update +} -cleanup { + deleteWindows +} -result {} +test menuDraw-12.3 {DisplayMenu - one entry} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] - list [update] [destroy .m1] -} {{} {}} -test menuDraw-12.4 {DisplayMenu - two entries} { - catch {destroy .m1} + update +} -cleanup { + deleteWindows +} -result {} +test menuDraw-12.4 {DisplayMenu - two entries} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "one" .m1 add command -label "two" set tearoff [tk::TearOffMenu .m1 40 40] - list [update] [destroy .m1] -} {{} {}} -test menuDraw.12.5 {DisplayMenu - two columns - first bigger} { - catch {destroy .m1} + update +} -cleanup { + deleteWindows +} -result {} +test menuDraw.12.5 {DisplayMenu - two columns - first bigger} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "one" .m1 add command -label "two" .m1 add command -label "three" -columnbreak 1 set tearoff [tk::TearOffMenu .m1 40 40] - list [update] [destroy .m1] -} {{} {}} -test menuDraw-12.5 {DisplayMenu - two column - second bigger} { - catch {destroy .m1} + update +} -cleanup { + deleteWindows +} -result {} +test menuDraw-12.5 {DisplayMenu - two column - second bigger} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "one" .m1 add command -label "two" -columnbreak 1 .m1 add command -label "three" set tearoff [tk::TearOffMenu .m1 40 40] - list [update] [destroy .m1] -} {{} {}} -test menuDraw.12.7 {DisplayMenu - three columns} { - catch {destroy .m1} + update +} -cleanup { + deleteWindows +} -result {} +test menuDraw.12.7 {DisplayMenu - three columns} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "one" .m1 add command -label "two" -columnbreak 1 @@ -308,133 +446,175 @@ test menuDraw.12.7 {DisplayMenu - three columns} { .m1 add command -label "five" .m1 add command -label "six" set tearoff [tk::TearOffMenu .m1 40 40] - list [update] [destroy .m1] -} {{} {}} -test menuDraw-12.6 {Display menu - testing for extra space and menubars} unix { - catch {destroy .m1} + update +} -cleanup { + deleteWindows +} -result {} +test menuDraw-12.6 {Display menu - testing for extra space and menubars} -constraints { + unix +} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label foo . configure -menu .m1 - list [update] [. configure -menu ""] [destroy .m1] -} {{} {} {}} -test menuDraw-12.7 {Display menu - extra space at end of menu} { - catch {destroy .m1} + update + . configure -menu "" +} -cleanup { + deleteWindows +} -result {} +test menuDraw-12.7 {Display menu - extra space at end of menu} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label foo set tearoff [tk::TearOffMenu .m1 40 40] wm geometry $tearoff 200x100 - list [update] [destroy .m1] -} {{} {}} + update +} -cleanup { + deleteWindows +} -result {} + -test menuDraw-13.1 {TkMenuEventProc - Expose} { - catch {destroy .m1} - catch {destroy .m2} +test menuDraw-13.1 {TkMenuEventProc - Expose} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "one" menu .m2 .m2 add command -label "two" set tearoff1 [tk::TearOffMenu .m1 40 40] set tearoff2 [tk::TearOffMenu .m2 40 40] - list [raise $tearoff2] [update] [destroy .m1] [destroy .m2] -} {{} {} {} {}} -test menuDraw-13.2 {TkMenuEventProc - ConfigureNotify} { - catch {destroy .m1} + list [raise $tearoff2] [update] +} -cleanup { + deleteWindows +} -result {{} {}} +test menuDraw-13.2 {TkMenuEventProc - ConfigureNotify} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" set tearoff [tk::TearOffMenu .m1 40 40] - list [wm geometry $tearoff 200x100] [update] [destroy .m1] -} {{} {} {}} + list [wm geometry $tearoff 200x100] [update] +} -cleanup { + deleteWindows +} -result {{} {}} # Testing deletes is hard, and I am going to do my best. Don't know how # to test the case where we have already cleared the tkwin field in the # menuPtr. -test menuDraw-13.4 {TkMenuEventProc - simple delete} { - catch {destroy .m1} +test menuDraw-13.4 {TkMenuEventProc - simple delete} -setup { + deleteWindows +} -body { menu .m1 - list [destroy .m1] -} {{}} -test menuDraw-13.5 {TkMenuEventProc - nothing pending} { - catch {destroy .m1} + destroy .m1 +} -result {} +test menuDraw-13.5 {TkMenuEventProc - nothing pending} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label foo update idletasks - list [destroy .m1] -} {{}} + destroy .m1 +} -result {} -test menuDraw-14.1 {TkMenuImageProc} testImageType { - catch {destroy .m1} + +test menuDraw-14.1 {TkMenuImageProc} -constraints testImageType -setup { + deleteWindows +} -body { catch {image delete image1} menu .m1 image create test image1 .m1 add command -image image1 update idletasks - list [image delete image1] [destroy .m1] -} {{} {}} -test menuDraw-14.2 {TkMenuImageProc} testImageType { - catch {destroy .m1} + image delete image1 +} -cleanup { + deleteWindows +} -result {} +test menuDraw-14.2 {TkMenuImageProc} -constraints testImageType -setup { + deleteWindows +} -body { catch {image delete image1} menu .m1 image create test image1 .m1 add command -image image1 - list [image delete image1] [destroy .m1] -} {{} {}} + image delete image1 +} -cleanup { + deleteWindows +} -result {} + -test menuDraw-15.1 {TkPostTearoffMenu - Basic posting} { - catch {destroy .m1} +test menuDraw-15.1 {TkPostTearoffMenu - Basic posting} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 +} -cleanup { + deleteWindows +} -returnCodes ok -match glob -result * +test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" -state active set tearoff [tk::TearOffMenu .m1 40 40] - list [$tearoff index active] [destroy .m1] -} {none {}} -test menuDraw-15.3 {TkPostTearoffMenu - post command} { - catch {destroy .m1} + $tearoff index active +} -cleanup { + deleteWindows +} -result {none} +test menuDraw-15.3 {TkPostTearoffMenu - post command} -setup { + deleteWindows +} -body { catch {unset foo} menu .m1 -postcommand "set foo .m1" .m1 add command -label "foo" list [catch {tk::TearOffMenu .m1 40 40}] [set foo] [unset foo] [destroy .m1] -} {0 .m1 {} {}} -test menuDraw-15.4 {TkPostTearoffMenu - post command deleting the menu} { - catch {destroy .m1} +} -result {0 .m1 {} {}} +test menuDraw-15.4 {TkPostTearoffMenu - post command deleting the menu} -setup { + deleteWindows +} -body { menu .m1 -postcommand "destroy .m1" .m1 add command -label "foo" list [catch {tk::TearOffMenu .m1 40 40} msg] $msg [winfo exists .m1] -} {0 {} 0} -test menuDraw-15.5 {TkPostTearoffMenu - tearoff at edge of screen} { - catch {destroy .m1} +} -result {0 {} 0} +test menuDraw-15.5 {TkPostTearoffMenu - tearoff at edge of screen} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" set height [winfo screenheight .m1] - list [catch {tk::TearOffMenu .m1 40 $height}] [destroy .m1] -} {0 {}} -test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} { - catch {destroy .m1} + tk::TearOffMenu .m1 40 $height +} -cleanup { + deleteWindows +} -returnCodes ok -match glob -result * +test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} -setup { + deleteWindows +} -body { menu .m1 .m1 add command -label "foo" set width [winfo screenwidth .m1] - list [catch {tk::TearOffMenu .m1 $width 40}] [destroy .m1] -} {0 {}} + tk::TearOffMenu .m1 $width 40 +} -cleanup { + deleteWindows +} -returnCodes ok -match glob -result * -test menuDraw-16.1 {TkPostSubmenu} nonUnixUserInteraction { - catch {destroy .m1} - catch {destroy .m2} +test menuDraw-16.1 {TkPostSubmenu} -constraints nonUnixUserInteraction -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label test -menu .m2 menu .m2 .m2 add command -label "Hit ESCAPE to make this menu go away." set tearoff [tk::TearOffMenu .m1 40 40] $tearoff postcascade 0 - list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] -} {{} {} {}} -test menuDraw-16.2 {TkPostSubMenu} nonUnixUserInteraction { - catch {destroy .m1} - catch {destroy .m2} - catch {destroy .m3} + $tearoff postcascade 0 +} -cleanup { + deleteWindows +} -result {} +test menuDraw-16.2 {TkPostSubMenu} -constraints nonUnixUserInteraction -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label "two" -menu .m2 .m1 add cascade -label "three" -menu .m3 @@ -444,68 +624,94 @@ test menuDraw-16.2 {TkPostSubMenu} nonUnixUserInteraction { .m3 add command -label "three" set tearoff [tk::TearOffMenu .m1 40 40] $tearoff postcascade 0 - list [$tearoff postcascade 1] [destroy .m1] [destroy .m2] [destroy .m3] -} {{} {} {} {}} -test menuDraw-16.3 {TkPostSubMenu} { - catch {destroy .m1} + $tearoff postcascade 1 +} -cleanup { + deleteWindows +} -result {} +test menuDraw-16.3 {TkPostSubMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label test -menu .m2 - list [.m1 postcascade 1] [destroy .m1] -} {{} {}} -test menuDraw-16.4 {TkPostSubMenu} { - catch {destroy .m1} + .m1 postcascade 1 +} -cleanup { + deleteWindows +} -result {} +test menuDraw-16.4 {TkPostSubMenu} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label test set tearoff [tk::TearOffMenu .m1 40 40] - list [$tearoff postcascade 0] [destroy .m1] -} {{} {}} -test menuDraw-16.5 {TkPostSubMenu} unix { - catch {destroy .m1} - catch {destroy .m2} + $tearoff postcascade 0 +} -cleanup { + deleteWindows +} -result {} +test menuDraw-16.5 {TkPostSubMenu} -constraints unix -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label test -menu .m2 menu .m2 -postcommand "glorp" set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2] -} {1 {invalid command name "glorp"} {} {}} -test menuDraw-16.6 {TkPostSubMenu} {win userInteraction} { - catch {destroy .m1} - catch {destroy .m2} + $tearoff postcascade test +} -cleanup { + deleteWindows +} -returnCodes error -result {invalid command name "glorp"} +test menuDraw-16.6 {TkPostSubMenu} -constraints { + win userInteraction +} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label test -menu .m2 menu .m2 .m2 add command -label "Hit ESCAPE to get rid of this menu" set tearoff [tk::TearOffMenu .m1 40 40] - list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] -} {{} {} {}} + $tearoff postcascade 0 +} -cleanup { + deleteWindows +} -result {} -test menuDraw-17.1 {AdjustMenuCoords - menubar} unix { - catch {destroy .m1} - catch {destroy .m2} + +test menuDraw-17.1 {AdjustMenuCoords - menubar} -constraints unix -setup { + deleteWindows +} -body { menu .m1 -tearoff 0 .m1 add cascade -label test -menu .m2 menu .m2 -tearoff 0 .m2 add command -label foo . configure -menu .m1 foreach w [winfo children .] { - if {[$w cget -type] == "menubar"} { - break - } + if {[$w cget -type] == "menubar"} { + break + } } - list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2] -} {{} {} {} {}} -test menuDraw-17.2 {AdjustMenuCoords - menu} {win userInteraction} { - catch {destroy .m1} - catch {destroy .m2} + list [$w postcascade 0] [. configure -menu ""] +} -cleanup { + deleteWindows +} -result {{} {}} +test menuDraw-17.2 {AdjustMenuCoords - menu} -constraints { + win userInteraction +} -setup { + deleteWindows +} -body { menu .m1 .m1 add cascade -label test -menu .m2 menu .m2 .m2 add command -label "Hit ESCAPE to make this menu go away" set tearoff [tk::TearOffMenu .m1 40 40] - list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] -} {{} {} {}} + $tearoff postcascade 0 +} -cleanup { + deleteWindows +} -result {} # cleanup +imageFinish deleteWindows cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/menubut.test b/tests/menubut.test index 3dfa1b5..6efdb0f 100644 --- a/tests/menubut.test +++ b/tests/menubut.test @@ -10,9 +10,11 @@ # XXX of a procedure has tests then the whole procedure has tests, # XXX but many procedures have no tests. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test +imageInit # Create entries in the option database to be sure that geometry options # like border width have predictable values. @@ -24,318 +26,737 @@ option add *Button.borderWidth 2 option add *Button.highlightThickness 2 option add *Button.font {Helvetica -12 bold} -eval image delete [image names] -if {[testConstraint testImageType]} { + +menubutton .mb -text "Test" +pack .mb +update +test menubutton-1.1 {configuration options} -body { + .mb configure -activebackground #012345 + .mb cget -activebackground +} -cleanup { + .mb configure -activebackground [lindex [.mb configure -activebackground] 3] +} -result {#012345} +test menubutton-1.2 {configuration options} -body { + .mb configure -activebackground non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test menubutton-1.3 {configuration options} -body { + .mb configure -activeforeground #ff0000 + .mb cget -activeforeground +} -cleanup { + .mb configure -activeforeground [lindex [.mb configure -activeforeground] 3] +} -result {#ff0000} +test menubutton-1.4 {configuration options} -body { + .mb configure -activeforeground non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test menubutton-1.5 {configuration options} -body { + .mb configure -anchor nw + .mb cget -anchor +} -cleanup { + .mb configure -anchor [lindex [.mb configure -anchor] 3] +} -result {nw} +test menubutton-1.6 {configuration options} -body { + .mb configure -anchor bogus +} -returnCodes error -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} +test menubutton-1.7 {configuration options} -body { + .mb configure -background #ff0000 + .mb cget -background +} -cleanup { + .mb configure -background [lindex [.mb configure -background] 3] +} -result {#ff0000} +test menubutton-1.8 {configuration options} -body { + .mb configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test menubutton-1.9 {configuration options} -body { + .mb configure -bd 4 + .mb cget -bd +} -cleanup { + .mb configure -bd [lindex [.mb configure -bd] 3] +} -result {4} +test menubutton-1.10 {configuration options} -body { + .mb configure -bd badValue +} -returnCodes error -result {bad screen distance "badValue"} +test menubutton-1.11 {configuration options} -body { + .mb configure -bg #ff0000 + .mb cget -bg +} -cleanup { + .mb configure -bg [lindex [.mb configure -bg] 3] +} -result {#ff0000} +test menubutton-1.12 {configuration options} -body { + .mb configure -bg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test menubutton-1.13 {configuration options} -body { + .mb configure -bitmap questhead + .mb cget -bitmap +} -cleanup { + .mb configure -bitmap [lindex [.mb configure -bitmap] 3] +} -result {questhead} +test menubutton-1.14 {configuration options} -body { + .mb configure -bitmap badValue +} -returnCodes error -result {bitmap "badValue" not defined} +test menubutton-1.15 {configuration options} -body { + .mb configure -borderwidth 1.3 + .mb cget -borderwidth +} -cleanup { + .mb configure -borderwidth [lindex [.mb configure -borderwidth] 3] +} -result {1} +test menubutton-1.16 {configuration options} -body { + .mb configure -borderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test menubutton-1.17 {configuration options} -body { + .mb configure -cursor arrow + .mb cget -cursor +} -cleanup { + .mb configure -cursor [lindex [.mb configure -cursor] 3] +} -result {arrow} +test menubutton-1.18 {configuration options} -body { + .mb configure -cursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} +test menubutton-1.19 {configuration options} -body { + .mb configure -direction below + .mb cget -direction +} -cleanup { + .mb configure -direction [lindex [.mb configure -direction] 3] +} -result {below} +test menubutton-1.20 {configuration options} -body { + .mb configure -direction badValue +} -returnCodes error -result {bad direction "badValue": must be above, below, flush, left, or right} +test menubutton-1.21 {configuration options} -body { + .mb configure -disabledforeground #00ff00 + .mb cget -disabledforeground +} -cleanup { + .mb configure -disabledforeground [lindex [.mb configure -disabledforeground] 3] +} -result {#00ff00} +test menubutton-1.22 {configuration options} -body { + .mb configure -disabledforeground xyzzy +} -returnCodes error -result {unknown color name "xyzzy"} +test menubutton-1.23 {configuration options} -body { + .mb configure -fg #110022 + .mb cget -fg +} -cleanup { + .mb configure -fg [lindex [.mb configure -fg] 3] +} -result {#110022} +test menubutton-1.24 {configuration options} -body { + .mb configure -fg bogus +} -returnCodes error -result {unknown color name "bogus"} +test menubutton-1.25 {configuration options} -body { + .mb configure -font {Helvetica 12} + .mb cget -font +} -cleanup { + .mb configure -font [lindex [.mb configure -font] 3] +} -result {Helvetica 12} +test menubutton-1.26 {configuration options} -body { + .mb configure -foreground #110022 + .mb cget -foreground +} -cleanup { + .mb configure -foreground [lindex [.mb configure -foreground] 3] +} -result {#110022} +test menubutton-1.27 {configuration options} -body { + .mb configure -foreground bogus +} -returnCodes error -result {unknown color name "bogus"} +test menubutton-1.28 {configuration options} -body { + .mb configure -height 18 + .mb cget -height +} -cleanup { + .mb configure -height [lindex [.mb configure -height] 3] +} -result {18} +test menubutton-1.29 {configuration options} -body { + .mb configure -height 20.0 +} -returnCodes error -result {expected integer but got "20.0"} +test menubutton-1.30 {configuration options} -body { + .mb configure -highlightbackground #112233 + .mb cget -highlightbackground +} -cleanup { + .mb configure -highlightbackground [lindex [.mb configure -highlightbackground] 3] +} -result {#112233} +test menubutton-1.31 {configuration options} -body { + .mb configure -highlightbackground ugly +} -returnCodes error -result {unknown color name "ugly"} +test menubutton-1.32 {configuration options} -body { + .mb configure -highlightcolor #110022 + .mb cget -highlightcolor +} -cleanup { + .mb configure -highlightcolor [lindex [.mb configure -highlightcolor] 3] +} -result {#110022} +test menubutton-1.33 {configuration options} -body { + .mb configure -highlightcolor bogus +} -returnCodes error -result {unknown color name "bogus"} +test menubutton-1.34 {configuration options} -body { + .mb configure -highlightthickness 18 + .mb cget -highlightthickness +} -cleanup { + .mb configure -highlightthickness [lindex [.mb configure -highlightthickness] 3] +} -result {18} +test menubutton-1.35 {configuration options} -body { + .mb configure -highlightthickness badValue +} -returnCodes error -result {bad screen distance "badValue"} +test menubutton-1.36 {configuration options} -constraints { + testImageType +} -setup { + catch {image delete image1} + image create test image1 +} -body { + .mb configure -image image1 + .mb cget -image +} -cleanup { + .mb configure -image [lindex [.mb configure -image] 3] image create test image1 -} +} -result {image1} +test menubutton-1.37 {configuration options} -setup { + catch {image delete bogus} +} -body { + .mb configure -image bogus +} -cleanup { + .mb configure -image [lindex [.mb configure -image] 3] +} -returnCodes error -result {image "bogus" doesn't exist} +test menubutton-1.38 {configuration options} -body { + .mb configure -indicatoron yes + .mb cget -indicatoron +} -cleanup { + .mb configure -indicatoron [lindex [.mb configure -indicatoron] 3] +} -result {1} +test menubutton-1.39 {configuration options} -body { + .mb configure -indicatoron no_way +} -returnCodes error -result {expected boolean value but got "no_way"} +test menubutton-1.40 {configuration options} -body { + .mb configure -justify right + .mb cget -justify +} -cleanup { + .mb configure -justify [lindex [.mb configure -justify] 3] +} -result {right} +test menubutton-1.41 {configuration options} -body { + .mb configure -justify bogus +} -returnCodes error -result {bad justification "bogus": must be left, right, or center} +test menubutton-1.42 {configuration options} -body { + .mb configure -menu {any old string} + .mb cget -menu +} -cleanup { + .mb configure -menu [lindex [.mb configure -menu] 3] +} -result {any old string} +test menubutton-1.43 {configuration options} -body { + .mb configure -padx 12 + .mb cget -padx +} -cleanup { + .mb configure -padx [lindex [.mb configure -padx] 3] +} -result {12} +test menubutton-1.44 {configuration options} -body { + .mb configure -padx 420x +} -returnCodes error -result {bad screen distance "420x"} +test menubutton-1.45 {configuration options} -body { + .mb configure -pady 12 + .mb cget -pady +} -cleanup { + .mb configure -pady [lindex [.mb configure -pady] 3] +} -result {12} +test menubutton-1.46 {configuration options} -body { + .mb configure -pady 420x +} -returnCodes error -result {bad screen distance "420x"} +test menubutton-1.47 {configuration options} -body { + .mb configure -relief groove + .mb cget -relief +} -cleanup { + .mb configure -relief [lindex [.mb configure -relief] 3] +} -result {groove} +test menubutton-1.48 {configuration options} -body { + .mb configure -relief 1.5 +} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test menubutton-1.49 {configuration options} -body { + .mb configure -state normal + .mb cget -state +} -cleanup { + .mb configure -state [lindex [.mb configure -state] 3] +} -result {normal} +test menubutton-1.50 {configuration options} -body { + .mb configure -state bogus +} -returnCodes error -result {bad state "bogus": must be active, disabled, or normal} +test menubutton-1.51 {configuration options} -body { + .mb configure -takefocus {any string} + .mb cget -takefocus +} -cleanup { + .mb configure -takefocus [lindex [.mb configure -takefocus] 3] +} -result {any string} +test menubutton-1.52 {configuration options} -body { + .mb configure -text {Sample text} + .mb cget -text +} -cleanup { + .mb configure -text [lindex [.mb configure -text] 3] +} -result {Sample text} +test menubutton-1.53 {configuration options} -body { + .mb configure -textvariable i + .mb cget -textvariable +} -cleanup { + .mb configure -textvariable [lindex [.mb configure -textvariable] 3] +} -result {i} +test menubutton-1.54 {configuration options} -body { + .mb configure -underline 5 + .mb cget -underline +} -cleanup { + .mb configure -underline [lindex [.mb configure -underline] 3] +} -result {5} +test menubutton-1.55 {configuration options} -body { + .mb configure -underline 3p +} -returnCodes error -result {expected integer but got "3p"} +test menubutton-1.56 {configuration options} -body { + .mb configure -width 402 + .mb cget -width +} -cleanup { + .mb configure -width [lindex [.mb configure -width] 3] +} -result {402} +test menubutton-1.57 {configuration options} -body { + .mb configure -width 3p +} -returnCodes error -result {expected integer but got "3p"} +test menubutton-1.58 {configuration options} -body { + .mb configure -wraplength 100 + .mb cget -wraplength +} -cleanup { + .mb configure -wraplength [lindex [.mb configure -wraplength] 3] +} -result {100} +test menubutton-1.59 {configuration options} -body { + .mb configure -wraplength 6x +} -returnCodes error -result {bad screen distance "6x"} + + +deleteWindows menubutton .mb -text "Test" pack .mb update -set i 1 -foreach test { - {-activebackground #012345 #012345 non-existent - {unknown color name "non-existent"}} - {-activeforeground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-bitmap questhead questhead badValue {bitmap "badValue" not defined}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-direction below below badValue {bad direction "badValue": must be above, below, flush, left, or right}} - {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}} - {-fg #110022 #110022 bogus {unknown color name "bogus"}} - {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"}} - {-height 18 18 20.0 {expected integer but got "20.0"}} - {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} - {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}} - {-highlightthickness 18 18 badValue {bad screen distance "badValue"}} - {-image image1 image1 bogus {image "bogus" doesn't exist}} - {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}} - {-justify right right bogus {bad justification "bogus": must be left, right, or center}} - {-menu "any old string" "any old string" {} {}} - {-padx 12 12 420x {bad screen distance "420x"}} - {-pady 12 12 420x {bad screen distance "420x"}} - {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal}} - {-takefocus "any string" "any string" {} {}} - {-text "Sample text" {Sample text} {} {}} - {-textvariable i i {} {}} - {-underline 5 5 3p {expected integer but got "3p"}} - {-width 402 402 3p {expected integer but got "3p"}} - {-wraplength 100 100 6x {bad screen distance "6x"}} -} { - set name [lindex $test 0] - test menubutton-1.$i {configuration options} testImageType { - .mb configure $name [lindex $test 1] - lindex [.mb configure $name] 4 - } [lindex $test 2] - incr i - if {[lindex $test 3] != ""} { - test menubutton-1.$i {configuration options} { - list [catch {.mb configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - .mb configure $name [lindex [.mb configure $name] 3] - incr i -} - -test menubutton-2.1 {Tk_MenubuttonCmd procedure} { - list [catch {menubutton} msg] $msg -} {1 {wrong # args: should be "menubutton pathName ?options?"}} -test menubutton-2.2 {Tk_MenubuttonCmd procedure} { - list [catch {menubutton foo} msg] $msg -} {1 {bad window path name "foo"}} -test menubutton-2.3 {Tk_MenubuttonCmd procedure} { +test menubutton-2.1 {Tk_MenubuttonCmd procedure} -body { + menubutton +} -returnCodes error -result {wrong # args: should be "menubutton pathName ?-option value ...?"} +test menubutton-2.2 {Tk_MenubuttonCmd procedure} -body { + menubutton foo +} -returnCodes error -result {bad window path name "foo"} +test menubutton-2.3 {Tk_MenubuttonCmd procedure} -body { catch {destroy .mb} menubutton .mb winfo class .mb -} {Menubutton} -test menubutton-2.4 {Tk_ButtonCmd procedure} { - catch {destroy .mb} - list [catch {menubutton .mb -gorp foo} msg] $msg [winfo exists .mb] -} {1 {unknown option "-gorp"} 0} +} -result {Menubutton} +test menubutton-2.4 {Tk_ButtonCmd procedure} -setup { + destroy .mb +} -body { + menubutton .mb -gorp foo +} -returnCodes error -result {unknown option "-gorp"} +test menubutton-2.5 {Tk_ButtonCmd procedure} -setup { + destroy .mb +} -body { + catch {menubutton .mb -gorp foo} + winfo exists .mb +} -result 0 -catch {destroy .mb} + +deleteWindows menubutton .mb -text "Test Menu" pack .mb -test menubutton-3.1 {MenuButtonWidgetCmd procedure} { - list [catch {.mb} msg] $msg -} {1 {wrong # args: should be ".mb option ?arg arg ...?"}} -test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.mb c} msg] $msg -} {1 {ambiguous option "c": must be cget or configure}} -test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.mb cget} msg] $msg -} {1 {wrong # args: should be ".mb cget option"}} -test menubutton-3.4 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.mb cget a b} msg] $msg -} {1 {wrong # args: should be ".mb cget option"}} -test menubutton-3.5 {ButtonWidgetCmd procedure, "cget" option} { - list [catch {.mb cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test menubutton-3.6 {ButtonWidgetCmd procedure, "cget" option} { +test menubutton-3.1 {MenuButtonWidgetCmd procedure} -body { + .mb +} -returnCodes error -result {wrong # args: should be ".mb option ?arg ...?"} +test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} -body { + .mb c +} -returnCodes error -result {ambiguous option "c": must be cget or configure} +test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} -body { + .mb cget +} -returnCodes error -result {wrong # args: should be ".mb cget option"} +test menubutton-3.4 {ButtonWidgetCmd procedure, "cget" option} -body { + .mb cget a b +} -returnCodes error -result {wrong # args: should be ".mb cget option"} +test menubutton-3.5 {ButtonWidgetCmd procedure, "cget" option} -body { + .mb cget -gorp +} -returnCodes error -result {unknown option "-gorp"} +test menubutton-3.6 {ButtonWidgetCmd procedure, "cget" option} -body { .mb configure -highlightthickness 3 .mb cget -highlightthickness -} {3} -test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} { +} -result {3} +test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} -body { llength [.mb configure] -} {33} -test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} { - list [catch {.mb configure -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test menubutton-3.9 {ButtonWidgetCmd procedure, "configure" option} { - list [catch {.mb co -bg #ffffff -fg} msg] $msg -} {1 {value for "-fg" missing}} -test menubutton-3.10 {ButtonWidgetCmd procedure, "configure" option} { +} -result {33} +test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} -body { + .mb configure -gorp +} -returnCodes error -result {unknown option "-gorp"} +test menubutton-3.9 {ButtonWidgetCmd procedure, "configure" option} -body { + .mb co -bg #ffffff -fg +} -returnCodes error -result {value for "-fg" missing} +test menubutton-3.10 {ButtonWidgetCmd procedure, "configure" option} -body { .mb configure -fg #123456 .mb configure -bg #654321 lindex [.mb configure -fg] 4 -} {#123456} -test menubutton-3.11 {ButtonWidgetCmd procedure, "configure" option} { - list [catch {.mb foobar} msg] $msg -} {1 {bad option "foobar": must be cget or configure}} +} -result {#123456} +test menubutton-3.11 {ButtonWidgetCmd procedure, "configure" option} -body { + .mb foobar +} -returnCodes error -result {bad option "foobar": must be cget or configure} +deleteWindows # XXX Need to add tests for several procedures here. The tests for XXX # XXX ConfigureMenuButton aren't complete either. XXX -test menubutton-4.1 {ConfigureMenuButton procedure} { - catch {destroy .mb1} +test menubutton-4.1 {ConfigureMenuButton procedure} -setup { + deleteWindows +} -body { + button .mb1 -text "Menubutton 1" + .mb1 configure -width 1i +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "1i"} +test menubutton-4.2 {ConfigureMenuButton procedure} -setup { + deleteWindows +} -body { button .mb1 -text "Menubutton 1" - list [catch {.mb1 configure -width 1i} msg] $msg $errorInfo -} {1 {expected integer but got "1i"} {expected integer but got "1i" + catch {.mb1 configure -width 1i} + return $errorInfo +} -cleanup { + deleteWindows +} -result {expected integer but got "1i" (processing -width option) invoked from within -".mb1 configure -width 1i"}} -test menubutton-4.2 {ConfigureMenuButton procedure} { - catch {destroy .mb1} +".mb1 configure -width 1i"} + +test menubutton-4.3 {ConfigureMenuButton procedure} -setup { + deleteWindows +} -body { button .mb1 -text "Menubutton 1" - list [catch {.mb1 configure -height 0.5c} msg] $msg $errorInfo -} {1 {expected integer but got "0.5c"} {expected integer but got "0.5c" + .mb1 configure -height 0.5c +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "0.5c"} +test menubutton-4.4 {ConfigureMenuButton procedure} -setup { + deleteWindows +} -body { + button .mb1 -text "Menubutton 1" + catch {.mb1 configure -height 0.5c} + return $errorInfo +} -cleanup { + deleteWindows +} -result {expected integer but got "0.5c" (processing -height option) invoked from within -".mb1 configure -height 0.5c"}} -test menubutton-4.3 {ConfigureMenuButton procedure} { - catch {destroy .mb1} +".mb1 configure -height 0.5c"} + +test menubutton-4.5 {ConfigureMenuButton procedure} -setup { + deleteWindows +} -body { + button .mb1 -bitmap questhead + .mb1 configure -width abc +} -cleanup { + deleteWindows +} -returnCodes error -result {bad screen distance "abc"} +test menubutton-4.6 {ConfigureMenuButton procedure} -setup { + deleteWindows +} -body { button .mb1 -bitmap questhead - list [catch {.mb1 configure -width abc} msg] $msg $errorInfo -} {1 {bad screen distance "abc"} {bad screen distance "abc" + catch {.mb1 configure -width abc} + return $errorInfo +} -cleanup { + deleteWindows +} -result {bad screen distance "abc" (processing -width option) invoked from within -".mb1 configure -width abc"}} -test menubutton-4.4 {ConfigureMenuButton procedure} testImageType { - catch {destroy .mb1} - eval image delete [image names] +".mb1 configure -width abc"} + +test menubutton-4.7 {ConfigureMenuButton procedure} -constraints { + testImageType +} -setup { + deleteWindows + imageCleanup +} -body { image create test image1 button .mb1 -image image1 - list [catch {.mb1 configure -height 0.5x} msg] $msg $errorInfo -} {1 {bad screen distance "0.5x"} {bad screen distance "0.5x" + .mb1 configure -height 0.5x +} -cleanup { + deleteWindows + imageCleanup +} -returnCodes error -result {bad screen distance "0.5x"} +test menubutton-4.8 {ConfigureMenuButton procedure} -constraints { + testImageType +} -setup { + deleteWindows + imageCleanup +} -body { + image create test image1 + button .mb1 -image image1 + catch {.mb1 configure -height 0.5x} + return $errorInfo +} -cleanup { + deleteWindows + imageCleanup +} -result {bad screen distance "0.5x" (processing -height option) invoked from within -".mb1 configure -height 0.5x"}} -test menubutton-4.5 {ConfigureMenuButton procedure} {nonPortable fonts} { - catch {destroy .mb1} +".mb1 configure -height 0.5x"} + +test menubutton-4.9 {ConfigureMenuButton procedure} -constraints { + nonPortable fonts +} -setup { + deleteWindows +} -body { button .mb1 -text "Sample text" -width 10 -height 2 pack .mb1 set result "[winfo reqwidth .mb1] [winfo reqheight .mb1]" .mb1 configure -bitmap questhead lappend result [winfo reqwidth .mb1] [winfo reqheight .mb1] -} {102 46 20 12} -test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} { - catch {destroy .mb} +} -cleanup { + deleteWindows +} -result {102 46 20 12} + +test menubutton-4.10 {ConfigureMenuButton procedure - bad direction} -setup { + deleteWindows +} -body { + menubutton .mb -text "Test" + .mb configure -direction badValue +} -cleanup { + deleteWindows +} -returnCodes error -result {bad direction "badValue": must be above, below, flush, left, or right} +test menubutton-4.11 {ConfigureMenuButton procedure - bad direction} -setup { + deleteWindows +} -body { menubutton .mb -text "Test" - list [catch {.mb configure -direction badValue} msg] $msg \ - [.mb cget -direction] [destroy .mb] -} {1 {bad direction "badValue": must be above, below, flush, left, or right} below {}} + catch {.mb configure -direction badValue} + list [.mb cget -direction] [destroy .mb] +} -cleanup { + deleteWindows +} -result {below {}} + + # XXX Need to add tests for several procedures here. XXX -test menubutton-5.1 {MenuButtonEventProc procedure} { +test menubutton-5.1 {MenuButtonEventProc procedure} -setup { deleteWindows + set x {} +} -body { menubutton .mb1 -bg #543210 rename .mb1 .mb2 - set x {} lappend x [winfo children .] lappend x [.mb2 cget -bg] destroy .mb1 lappend x [info command .mb*] [winfo children .] -} {.mb1 #543210 {} {}} +} -cleanup { + deleteWindows +} -result {.mb1 #543210 {} {}} + -test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} { +test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} -setup { deleteWindows +} -body { menubutton .mb1 rename .mb1 {} list [info command .mb*] [winfo children .] -} {{} {}} +} -cleanup { + deleteWindows +} -result {{} {}} -test menubutton-7.1 {ComputeMenuButtonGeometry procedure} testImageType { - catch {destroy .mb} + +test menubutton-7.1 {ComputeMenuButtonGeometry procedure} -constraints { + testImageType +} -setup { + deleteWindows + image create test image1 +} -body { menubutton .mb -image image1 -bd 4 -highlightthickness 0 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {38 23} -test menubutton-7.2 {ComputeMenuButtonGeometry procedure} testImageType { - catch {destroy .mb} +} -cleanup { + deleteWindows + imageCleanup +} -result {38 23} +test menubutton-7.2 {ComputeMenuButtonGeometry procedure} -constraints { + testImageType +} -setup { + deleteWindows + image create test image1 +} -body { menubutton .mb -image image1 -bd 1 -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {36 21} -test menubutton-7.3 {ComputeMenuButtonGeometry procedure} testImageType { - catch {destroy .mb} +} -cleanup { + deleteWindows + imageCleanup +} -result {36 21} +test menubutton-7.3 {ComputeMenuButtonGeometry procedure} -constraints { + testImageType +} -setup { + deleteWindows + image create test image1 +} -body { menubutton .mb -image image1 -bd 0 -highlightthickness 2 -padx 5 -pady 5 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {34 19} -test menubutton-7.4 {ComputeMenuButtonGeometry procedure} testImageType { - catch {destroy .mb} +} -cleanup { + deleteWindows + imageCleanup +} -result {34 19} +test menubutton-7.4 {ComputeMenuButtonGeometry procedure} -constraints { + testImageType +} -setup { + deleteWindows + image create test image1 +} -body { menubutton .mb -image image1 -bd 2 -relief raised -width 40 \ - -highlightthickness 2 + -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {48 23} -test menubutton-7.5 {ComputeMenuButtonGeometry procedure} testImageType { - catch {destroy .mb} +} -cleanup { + deleteWindows + imageCleanup +} -result {48 23} +test menubutton-7.5 {ComputeMenuButtonGeometry procedure} -constraints { + testImageType +} -setup { + deleteWindows + image create test image1 +} -body { menubutton .mb -image image1 -bd 2 -relief raised -height 30 \ - -highlightthickness 2 + -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {38 38} -test menubutton-7.6 {ComputeMenuButtonGeometry procedure} { - catch {destroy .mb} +} -cleanup { + deleteWindows + imageCleanup +} -result {38 38} +test menubutton-7.6 {ComputeMenuButtonGeometry procedure} -setup { + deleteWindows +} -body { menubutton .mb -bitmap question -bd 2 -relief raised \ - -highlightthickness 2 + -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {25 35} -test menubutton-7.7 {ComputeMenuButtonGeometry procedure} { - catch {destroy .mb} +} -cleanup { + deleteWindows +} -result {25 35} +test menubutton-7.7 {ComputeMenuButtonGeometry procedure} -setup { + deleteWindows +} -body { menubutton .mb -bitmap question -bd 2 -relief raised -width 40 \ - -highlightthickness 1 + -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {46 33} -test menubutton-7.8 {ComputeMenuButtonGeometry procedure} { - catch {destroy .mb} +} -cleanup { + deleteWindows +} -result {46 33} +test menubutton-7.8 {ComputeMenuButtonGeometry procedure} -setup { + deleteWindows +} -body { menubutton .mb -bitmap question -bd 2 -relief raised -height 50 \ - -highlightthickness 1 + -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {23 56} -test menubutton-7.9 {ComputeMenuButtonGeometry procedure} {fonts} { - catch {destroy .mb} +} -cleanup { + deleteWindows +} -result {23 56} +test menubutton-7.9 {ComputeMenuButtonGeometry procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { menubutton .mb -text String -bd 2 -relief raised -padx 0 -pady 0 \ - -highlightthickness 1 + -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {42 20} -test menubutton-7.10 {ComputeMenuButtonGeometry procedure} {fonts} { - catch {destroy .mb} +} -cleanup { + deleteWindows +} -result {42 20} +test menubutton-7.10 {ComputeMenuButtonGeometry procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { menubutton .mb -text String -bd 2 -relief raised -width 20 \ - -padx 0 -pady 0 -highlightthickness 1 + -padx 0 -pady 0 -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {146 20} -test menubutton-7.11 {ComputeMenuButtonGeometry procedure} {fonts} { - catch {destroy .mb} +} -cleanup { + deleteWindows +} -result {146 20} +test menubutton-7.11 {ComputeMenuButtonGeometry procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { menubutton .mb -text String -bd 2 -relief raised -height 2 \ - -padx 0 -pady 0 -highlightthickness 1 + -padx 0 -pady 0 -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {42 34} -test menubutton-7.12 {ComputeMenuButtonGeometry procedure} {fonts} { - catch {destroy .mb} +} -cleanup { + deleteWindows +} -result {42 34} +test menubutton-7.12 {ComputeMenuButtonGeometry procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { menubutton .mb -text String -bd 2 -relief raised -padx 10 -pady 5 \ - -highlightthickness 1 + -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {62 30} -test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {nonPortable fonts} { - catch {destroy .mb} +} -cleanup { + deleteWindows +} -result {62 30} +test menubutton-7.13 {ComputeMenuButtonGeometry procedure} -constraints { + nonPortable fonts +} -setup { + deleteWindows +} -body { menubutton .mb -text String -bd 2 -relief raised \ - -highlightthickness 1 -indicatoron 1 + -highlightthickness 1 -indicatoron 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {78 28} -test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {testImageType unix nonPortable} { +} -cleanup { + deleteWindows +} -result {78 28} +test menubutton-7.14 {ComputeMenuButtonGeometry procedure} -constraints { + testImageType unix nonPortable +} -setup { + deleteWindows + image create test image1 +} -body { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. - catch {destroy .mb} menubutton .mb -image image1 -bd 2 -relief raised \ - -highlightthickness 2 -indicatoron 1 + -highlightthickness 2 -indicatoron 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {64 23} -test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {testImageType win nonPortable} { +} -cleanup { + deleteWindows + imageCleanup +} -result {64 23} +test menubutton-7.15 {ComputeMenuButtonGeometry procedure} -constraints { + testImageType win nonPortable +} -setup { + deleteWindows + image create test image1 +} -body { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. - catch {destroy .mb} menubutton .mb -image image1 -bd 2 -relief raised \ - -highlightthickness 2 -indicatoron 1 + -highlightthickness 2 -indicatoron 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] -} {65 23} +} -cleanup { + deleteWindows + imageCleanup +} -result {65 23} -set l [interp hidden] -deleteWindows -test menubutton-8.1 {menubutton vs hidden commands} { - catch {destroy .mb} +test menubutton-8.1 {menubutton vs hidden commands} -body { + set l [interp hidden] + deleteWindows menubutton .mb interp hide {} .mb destroy .mb - list [winfo children .] [interp hidden] -} [list {} $l] + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 eq $res2} +} -result 1 + + -eval image delete [image names] deleteWindows option clear +imageFinish # cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/message.test b/tests/message.test index 93344c4..dcffc72 100644 --- a/tests/message.test +++ b/tests/message.test @@ -6,115 +6,469 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* tcltest::loadTestedCommands +eval tcltest::configure $argv + + +test message-1.1 {configuration option: "anchor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -anchor w + .m cget -anchor +} -cleanup { + destroy .m +} -result {w} +test message-1.2 {configuration option: "anchor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -anchor bogus +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} + +test message-1.3 {configuration option: "aspect"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -aspect 3 + .m cget -aspect +} -cleanup { + destroy .m +} -result {3} +test message-1.4 {configuration option: "aspect"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -aspect bogus +} -cleanup { + destroy .m +} -returnCodes {error} -result {expected integer but got "bogus"} + +test message-1.5 {configuration option: "background"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -background #ff0000 + .m cget -background +} -cleanup { + destroy .m +} -result {#ff0000} +test message-1.6 {configuration option: "background"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -background non-existent +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "non-existent"} + +test message-1.7 {configuration option: "bd"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -bd 4 + .m cget -bd +} -cleanup { + destroy .m +} -result {4} +test message-1.8 {configuration option: "bd"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -bd badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "badValue"} + +test message-1.9 {configuration option: "bg"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -bg #ff0000 + .m cget -bg +} -cleanup { + destroy .m +} -result {#ff0000} +test message-1.10 {configuration option: "bg"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -bg non-existent +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "non-existent"} + +test message-1.11 {configuration option: "borderwidth"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -borderwidth 1.3 + .m cget -borderwidth +} -cleanup { + destroy .m +} -result {1} +test message-1.12 {configuration option: "borderwidth"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -borderwidth badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "badValue"} + +test message-1.13 {configuration option: "cursor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -cursor arrow + .m cget -cursor +} -cleanup { + destroy .m +} -result {arrow} +test message-1.14 {configuration option: "cursor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -cursor badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test message-1.15 {configuration option: "fg"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -fg #00ff00 + .m cget -fg +} -cleanup { + destroy .m +} -result {#00ff00} +test message-1.16 {configuration option: "fg"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -fg badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "badValue"} + +test message-1.17 {configuration option: "font"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -font fixed + .m cget -font +} -cleanup { + destroy .m +} -result {fixed} +test message-1.18 {configuration option: "font"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -font {} +} -cleanup { + destroy .m +} -returnCodes {error} -result {font "" doesn't exist} + +test message-1.19 {configuration option: "-foreground"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -foreground green + .m cget -foreground +} -cleanup { + destroy .m +} -result {green} +test message-1.20 {configuration option: "-foreground"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -foreground badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "badValue"} -option add *Message.borderWidth 2 -option add *Message.highlightThickness 2 -option add *Message.font {Helvetica -12 bold} - -message .m -pack .m -update -set i 0 -foreach test { - {-anchor w w bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} - {-aspect 3 3 bogus {expected integer but got "bogus"}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}} - {-font fixed fixed {} {font "" doesn't exist}} - {-foreground green green badValue {unknown color name "badValue"}} - {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 non-existent - {unknown color name "non-existent"}} - {-highlightthickness 2 2 badValue {bad screen distance "badValue"}} - {-justify right right bogus {bad justification "bogus": must be left, right, or center}} - {-padx 12m 12m 420x {bad screen distance "420x"}} - {-pady 12m 12m 420x {bad screen distance "420x"}} - {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} - {-text "Sample text" {Sample text} {} {} {1 1 1 1}} - {-textvariable i i {} {} {1 1 1 1}} - {-width 32 32 badValue {bad screen distance "badValue"}} -} { - set name [lindex $test 0] - test message-1.$i {configuration options} { - .m configure $name [lindex $test 1] - lindex [.m configure $name] 4 - } [lindex $test 2] - incr i - if {[lindex $test 3] != ""} { - test message-1.$i {configuration options} { - list [catch {.m configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - .m configure $name [lindex [.m configure $name] 3] - incr i -} -destroy .m - -test message-2.1 {Tk_MessageObjCmd procedure} { - list [catch {message} msg] $msg -} {1 {wrong # args: should be "message pathName ?options?"}} -test message-2.2 {Tk_MessageObjCmd procedure} { - list [catch {message foo} msg] $msg [winfo child .] -} {1 {bad window path name "foo"} {}} -test message-2.3 {Tk_MessageObjCmd procedure} { - list [catch {message .s -gorp dumb} msg] $msg [winfo child .] -} {1 {unknown option "-gorp"} {}} - -test message-3.1 {MessageWidgetObjCmd procedure} { +test message-1.21 {configuration option: "highlightbackground"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightbackground #112233 + .m cget -highlightbackground +} -cleanup { + destroy .m +} -result {#112233} +test message-1.22 {configuration option: "highlightbackground"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightbackground ugly +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "ugly"} + +test message-1.23 {configuration option: "highlightcolor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightcolor #123456 + .m cget -highlightcolor +} -cleanup { + destroy .m +} -result {#123456} +test message-1.24 {configuration option: "highlightcolor"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightcolor non-existent +} -cleanup { + destroy .m +} -returnCodes {error} -result {unknown color name "non-existent"} + +test message-1.25 {configuration option: "highlightthickness"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightthickness 2 + .m cget -highlightthickness +} -cleanup { + destroy .m +} -result {2} +test message-1.26 {configuration option: "highlightthickness"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -highlightthickness badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "badValue"} + +test message-1.27 {configuration option: "justify"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -justify right + .m cget -justify +} -cleanup { + destroy .m +} -result {right} +test message-1.28 {configuration option: "justify"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -justify bogus +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} + +test message-1.29 {configuration option: "padx"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -padx 12m + .m cget -padx +} -cleanup { + destroy .m +} -result {12m} +test message-1.30 {configuration option: "padx"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -padx 420x +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "420x"} + +test message-1.31 {configuration option: "pady"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -pady 12m + .m cget -pady +} -cleanup { + destroy .m +} -result {12m} +test message-1.32 {configuration option: "pady"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -pady 420x +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "420x"} + +test message-1.33 {configuration option: "relief"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -relief ridge + .m cget -relief +} -cleanup { + destroy .m +} -result {ridge} +test message-1.34 {configuration option: "relief"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -relief badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} + +test message-1.35 {configuration options: "text"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -text "Sample text" + .m cget -text +} -cleanup { + destroy .m +} -result {Sample text} + +test message-1.36 {configuration option: "textvariable"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -textvariable i + .m cget -textvariable +} -cleanup { + destroy .m +} -result {i} + +test message-1.37 {configuration option: "width"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -width 2 + .m cget -width +} -cleanup { + destroy .m +} -result {2} +test message-1.38 {configuration option: "width"} -setup { + message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} + pack .m + update +} -body { + .m configure -width badValue +} -cleanup { + destroy .m +} -returnCodes {error} -result {bad screen distance "badValue"} + + +test message-2.1 {Tk_MessageObjCmd procedure} -body { + message +} -returnCodes {error} -result {wrong # args: should be "message pathName ?-option value ...?"} + +test message-2.2 {Tk_MessageObjCmd procedure} -body { + message foo +} -returnCodes {error} -result {bad window path name "foo"} +test message-2.3 {Tk_MessageObjCmd procedure} -body { + catch {message foo} + winfo child . +} -result {} + +test message-2.4 {Tk_MessageObjCmd procedure} -body { + message .s -gorp dump +} -returnCodes {error} -result {unknown option "-gorp"} +test message-2.5 {Tk_MessageObjCmd procedure} -body { + catch {message .s -gorp dump} + winfo child . +} -result {} + + +test message-3.1 {MessageWidgetObjCmd procedure} -setup { message .m - set result [list [catch {.m} msg] $msg] +} -body { + .m +} -cleanup { destroy .m - set result -} {1 {wrong # args: should be ".m option ?arg arg ...?"}} -test message-3.2 {MessageWidgetObjCmd procedure, "cget"} { +} -returnCodes error -result {wrong # args: should be ".m option ?arg ...?"} +test message-3.2 {MessageWidgetObjCmd procedure, "cget"} -setup { message .m - set result [list [catch {.m cget} msg] $msg] +} -body { + .m cget +} -cleanup { destroy .m - set result -} {1 {wrong # args: should be ".m cget option"}} -test message-3.3 {MessageWidgetObjCmd procedure, "cget"} { +} -returnCodes error -result {wrong # args: should be ".m cget option"} +test message-3.3 {MessageWidgetObjCmd procedure, "cget"} -setup { message .m - set result [list [catch {.m cget -gorp} msg] $msg] +} -body { + .m cget -gorp +} -cleanup { destroy .m - set result -} {1 {unknown option "-gorp"}} -test message-3.4 {MessageWidgetObjCmd procedure, "cget"} { +} -returnCodes error -result {unknown option "-gorp"} + +test message-3.4 {MessageWidgetObjCmd procedure, "configure"} -setup { message .m +} -body { .m configure -text foobar - set result [.m cget -text] + lindex [.m configure -text] 4 +} -cleanup { destroy .m - set result -} "foobar" -test message-3.5 {MessageWidgetObjCmd procedure, "configure"} { +} -result {foobar} +test message-3.5 {MessageWidgetObjCmd procedure, "configure"} -setup { message .m - set result [llength [.m configure]] +} -body { + llength [.m configure] +} -cleanup { destroy .m - set result -} 21 -test message-3.6 {MessageWidgetObjCmd procedure, "configure"} { +} -result {21} +test message-3.6 {MessageWidgetObjCmd procedure, "configure"} -setup { message .m - set result [list [catch {.m configure -foo} msg] $msg] +} -body { + .m configure -foo +} -cleanup { destroy .m - set result -} {1 {unknown option "-foo"}} -test message-3.7 {MessageWidgetObjCmd procedure, "configure"} { +} -returnCodes error -result {unknown option "-foo"} +test message-3.7 {MessageWidgetObjCmd procedure, "configure"} -setup { message .m +} -body { .m configure -bd 4 .m configure -bg #ffffff - set result [lindex [.m configure -bd] 4] + lindex [.m configure -bd] 4 +} -cleanup { destroy .m - set result -} {4} +} -result {4} -# cleanup cleanupTests return diff --git a/tests/msgbox.test b/tests/msgbox.test index ec98c89..643ae2c 100644 --- a/tests/msgbox.test +++ b/tests/msgbox.test @@ -5,65 +5,79 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test -test msgbox-1.1 {tk_messageBox command} { - list [catch {tk_messageBox -foo} msg] $msg -} {1 {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}} -test msgbox-1.2 {tk_messageBox command} { - list [catch {tk_messageBox -foo bar} msg] $msg -} {1 {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}} - -catch {tk_messageBox -foo bar} msg -regsub -all , $msg "" options -regsub \"-foo\" $options "" options - -foreach option $options { - if {[string index $option 0] eq "-"} { - test msgbox-1.3$option {tk_messageBox command} -body { - tk_messageBox $option - } -returnCodes error -result "value for \"$option\" missing" - } -} -test msgbox-1.4 {tk_messageBox command} { - list [catch {tk_messageBox -default} msg] $msg -} {1 {value for "-default" missing}} +test msgbox-1.1 {tk_messageBox command} -body { + tk_messageBox -foo +} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type} +test msgbox-1.2 {tk_messageBox command} -body { + tk_messageBox -foo bar +} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type} -test msgbox-1.5 {tk_messageBox command} { - list [catch {tk_messageBox -type foo} msg] $msg -} {1 {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}} +test msgbox-1.3 {tk_messageBox command} -body { + tk_messageBox -default +} -returnCodes error -result {value for "-default" missing} +test msgbox-1.4 {tk_messageBox command} -body { + tk_messageBox -detail +} -returnCodes error -result {value for "-detail" missing} +test msgbox-1.5 {tk_messageBox command} -body { + tk_messageBox -icon +} -returnCodes error -result {value for "-icon" missing} +test msgbox-1.6 {tk_messageBox command} -body { + tk_messageBox -message +} -returnCodes error -result {value for "-message" missing} +test msgbox-1.7 {tk_messageBox command} -body { + tk_messageBox -parent +} -returnCodes error -result {value for "-parent" missing} +test msgbox-1.8 {tk_messageBox command} -body { + tk_messageBox -title +} -returnCodes error -result {value for "-title" missing} +test msgbox-1.9 {tk_messageBox command} -body { + tk_messageBox -type +} -returnCodes error -result {value for "-type" missing} -proc createPlatformMsg {val} { - global tcl_platform - if {$tcl_platform(platform) == "unix"} { - return "invalid default button \"$val\"" - } - return "bad -default value \"$val\": must be abort, retry, ignore, ok, cancel, no, or yes" -} +test msgbox-1.10 {tk_messageBox command} -body { + tk_messageBox -default +} -returnCodes error -result {value for "-default" missing} + +test msgbox-1.11 {tk_messageBox command} -body { + tk_messageBox -type foo +} -returnCodes error -result {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel} -test msgbox-1.6 {tk_messageBox command} { - list [catch {tk_messageBox -default 1.1} msg] $msg -} [list 1 [createPlatformMsg "1.1"]] +test msgbox-1.12 {tk_messageBox command} -constraints unix -body { + tk_messageBox -default 1.1 +} -returnCodes error -result {invalid default button "1.1"} +test msgbox-1.13 {tk_messageBox command} -constraints macOrWin -body { + tk_messageBox -default 1.1 +} -returnCodes error -result {bad -default value "1.1": must be abort, retry, ignore, ok, cancel, no, or yes} -test msgbox-1.7 {tk_messageBox command} { - list [catch {tk_messageBox -default foo} msg] $msg -} [list 1 [createPlatformMsg "foo"]] +test msgbox-1.14 {tk_messageBox command} -constraints unix -body { + tk_messageBox -default foo +} -returnCodes error -result {invalid default button "foo"} +test msgbox-1.15 {tk_messageBox command} -constraints macOrWin -body { + tk_messageBox -default foo +} -returnCodes error -result {bad -default value "foo": must be abort, retry, ignore, ok, cancel, no, or yes} -test msgbox-1.8 {tk_messageBox command} { - list [catch {tk_messageBox -type yesno -default 3} msg] $msg -} [list 1 [createPlatformMsg "3"]] +test msgbox-1.16 {tk_messageBox command} -constraints unix -body { + tk_messageBox -type yesno -default 3 +} -returnCodes error -result {invalid default button "3"} +test msgbox-1.17 {tk_messageBox command} -constraints macOrWin -body { + tk_messageBox -type yesno -default 3 +} -returnCodes error -result {bad -default value "3": must be abort, retry, ignore, ok, cancel, no, or yes} -test msgbox-1.9 {tk_messageBox command} { - list [catch {tk_messageBox -icon foo} msg] $msg -} {1 {bad -icon value "foo": must be error, info, question, or warning}} +test msgbox-1.18 {tk_messageBox command} -body { + tk_messageBox -icon foo +} -returnCodes error -result {bad -icon value "foo": must be error, info, question, or warning} +test msgbox-1.19 {tk_messageBox command} -body { + tk_messageBox -parent foo.bar +} -returnCodes error -result {bad window path name "foo.bar"} -test msgbox-1.10 {tk_messageBox command} { - list [catch {tk_messageBox -parent foo.bar} msg] $msg -} {1 {bad window path name "foo.bar"}} +catch {tk_messageBox -foo bar} set isNative [expr {[info commands tk::MessageBox] == ""}] proc ChooseMsg {parent btn} { @@ -104,72 +118,332 @@ proc SendEventToMsg {parent btn type} { event generate $w <KeyPress> -keysym Return } } - -set parent . - -set specs { - {"abortretryignore" MB_ABORTRETRYIGNORE 3 {"abort" "retry" "ignore"}} - {"ok" MB_OK 1 {"ok" }} - {"okcancel" MB_OKCANCEL 2 {"ok" "cancel" }} - {"retrycancel" MB_RETRYCANCEL 2 {"retry" "cancel" }} - {"yesno" MB_YESNO 2 {"yes" "no" }} - {"yesnocancel" MB_YESNOCANCEL 3 {"yes" "no" "cancel"}} -} - # # Try out all combinations of (type) x (default button) and # (type) x (icon). # -set count 1 -foreach spec $specs { - set type [lindex $spec 0] - set buttons [lindex $spec 3] - - set button [lindex $buttons 0] - test msgbox-2.$count {tk_messageBox command} nonUnixUserInteraction { - ChooseMsg $parent $button - tk_messageBox -title Hi -message "Please press $button" \ - -type $type - } $button - incr count - - foreach icon {warning error info question} { - test msgbox-2.$count {tk_messageBox command -icon option} \ - nonUnixUserInteraction { - ChooseMsg $parent $button - tk_messageBox -title Hi -message "Please press $button" \ - -type $type -icon $icon - } $button - incr count - } +test msgbox-2.1 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . abort + tk_messageBox -title Hi -message "Please press abort" -type abortretryignore +} -result {abort} +test msgbox-2.2 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . abort + tk_messageBox -title Hi -message "Please press abort" \ + -type abortretryignore -icon warning +} -result {abort} +test msgbox-2.3 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . abort + tk_messageBox -title Hi -message "Please press abort" \ + -type abortretryignore -icon error +} -result {abort} +test msgbox-2.4 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . abort + tk_messageBox -title Hi -message "Please press abort" \ + -type abortretryignore -icon info +} -result {abort} +test msgbox-2.5 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . abort + tk_messageBox -title Hi -message "Please press abort" \ + -type abortretryignore -icon question +} -result {abort} +test msgbox-2.6 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . abort + tk_messageBox -title Hi -message "Please press abort" \ + -type abortretryignore -default abort +} -result {abort} +test msgbox-2.7 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . retry + tk_messageBox -title Hi -message "Please press retry" \ + -type abortretryignore -default retry +} -result {retry} +test msgbox-2.8 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ignore + tk_messageBox -title Hi -message "Please press ignore" \ + -type abortretryignore -default ignore +} -result {ignore} +test msgbox-2.9 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" -type ok +} -result {ok} +test msgbox-2.10 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type ok -icon warning +} -result {ok} +test msgbox-2.11 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type ok -icon error +} -result {ok} +test msgbox-2.12 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type ok -icon info +} -result {ok} +test msgbox-2.13 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type ok -icon question +} -result {ok} +test msgbox-2.14 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type ok -default ok +} -result {ok} +test msgbox-2.15 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" -type okcancel +} -result {ok} +test msgbox-2.16 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type okcancel -icon warning +} -result {ok} +test msgbox-2.17 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type okcancel -icon error +} -result {ok} +test msgbox-2.18 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type okcancel -icon info +} -result {ok} +test msgbox-2.19 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type okcancel -icon question +} -result {ok} +test msgbox-2.20 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . ok + tk_messageBox -title Hi -message "Please press ok" \ + -type okcancel -default ok +} -result {ok} +test msgbox-2.21 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . cancel + tk_messageBox -title Hi -message "Please press cancel" \ + -type okcancel -default cancel +} -result {cancel} +test msgbox-2.22 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . retry + tk_messageBox -title Hi -message "Please press retry" -type retrycancel +} -result {retry} +test msgbox-2.23 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . retry + tk_messageBox -title Hi -message "Please press retry" \ + -type retrycancel -icon warning +} -result {retry} +test msgbox-2.24 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . retry + tk_messageBox -title Hi -message "Please press retry" \ + -type retrycancel -icon error +} -result {retry} +test msgbox-2.25 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . retry + tk_messageBox -title Hi -message "Please press retry" \ + -type retrycancel -icon info +} -result {retry} +test msgbox-2.26 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . retry + tk_messageBox -title Hi -message "Please press retry" \ + -type retrycancel -icon question +} -result {retry} +test msgbox-2.27 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . retry + tk_messageBox -title Hi -message "Please press retry" \ + -type retrycancel -default retry +} -result {retry} +test msgbox-2.28 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . cancel + tk_messageBox -title Hi -message "Please press cancel" \ + -type retrycancel -default cancel +} -result {cancel} +test msgbox-2.29 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" -type yesno +} -result {yes} +test msgbox-2.30 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesno -icon warning +} -result {yes} +test msgbox-2.31 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesno -icon error +} -result {yes} +test msgbox-2.32 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesno -icon info +} -result {yes} +test msgbox-2.33 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesno -icon question +} -result {yes} +test msgbox-2.34 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesno -default yes +} -result {yes} +test msgbox-2.35 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . no + tk_messageBox -title Hi -message "Please press no" \ + -type yesno -default no +} -result {no} +test msgbox-2.36 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" -type yesnocancel +} -result {yes} +test msgbox-2.37 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesnocancel -icon warning +} -result {yes} +test msgbox-2.38 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesnocancel -icon error +} -result {yes} +test msgbox-2.39 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesnocancel -icon info +} -result {yes} +test msgbox-2.40 {tk_messageBox command -icon option} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesnocancel -icon question +} -result {yes} +test msgbox-2.41 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . yes + tk_messageBox -title Hi -message "Please press yes" \ + -type yesnocancel -default yes +} -result {yes} +test msgbox-2.42 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . no + tk_messageBox -title Hi -message "Please press no" \ + -type yesnocancel -default no +} -result {no} +test msgbox-2.43 {tk_messageBox command} -constraints { + nonUnixUserInteraction +} -body { + ChooseMsg . cancel + tk_messageBox -title Hi -message "Please press cancel" \ + -type yesnocancel -default cancel +} -result {cancel} - foreach button $buttons { - test msgbox-2.$count {tk_messageBox command} nonUnixUserInteraction { - ChooseMsg $parent $button - tk_messageBox -title Hi -message "Please press $button" \ - -type $type -default $button - } "$button" - incr count - } -} # These tests will hang your test suite if they fail. -test msgbox-3.1 {tk_messageBox handles withdrawn parent} nonUnixUserInteraction { +test msgbox-3.1 {tk_messageBox handles withdrawn parent} -constraints { + nonUnixUserInteraction +} -body { wm withdraw . ChooseMsg . "ok" tk_messageBox -title Hi -message "Please press ok" \ -type ok -default ok -} "ok" -wm deiconify . +} -cleanup { + wm deiconify . +} -result {ok} -test msgbox-3.2 {tk_messageBox handles iconified parent} nonUnixUserInteraction { +test msgbox-3.2 {tk_messageBox handles iconified parent} -constraints { + nonUnixUserInteraction +} -body { wm iconify . ChooseMsg . "ok" tk_messageBox -title Hi -message "Please press ok" \ -type ok -default ok -} "ok" -wm deiconify . +} -cleanup { + wm deiconify . +} -result {ok} # cleanup cleanupTests return + + diff --git a/tests/obj.test b/tests/obj.test index 25bd70f..eece58e 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -5,26 +5,24 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test obj-1.1 {TkGetPixelsFromObj} { -} {} +test obj-1.1 {TkGetPixelsFromObj} -body { +} -result {} -test obj-2.1 {FreePixelInternalRep} { -} {} +test obj-2.1 {FreePixelInternalRep} -body { +} -result {} -test obj-3.1 {DupPixelInternalRep} { -} {} +test obj-3.1 {DupPixelInternalRep} -body { +} -result {} -test obj-4.1 {SetPixelFromAny} { -} {} +test obj-4.1 {SetPixelFromAny} -body { +} -result {} - -deleteWindows - # cleanup cleanupTests return diff --git a/tests/oldpack.test b/tests/oldpack.test index 2f9b979..72ec065 100644 --- a/tests/oldpack.test +++ b/tests/oldpack.test @@ -7,13 +7,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test # First, test a single window packed in various ways in a parent -catch {destroy .pack} +destroy .pack frame .pack place .pack -width 100 -height 100 frame .pack.red -width 10 -height 20 @@ -29,189 +30,189 @@ frame .pack.violet -width 80 -height 20 label .pack.violet.l -text P -bd 2 -relief raised place .pack.violet.l -relwidth 1.0 -relheight 1.0 -test oldpack-1.1 {basic positioning} { +test oldpack-1.1 {basic positioning} -body { pack ap .pack .pack.red top update winfo geometry .pack.red -} 10x20+45+0 -test oldpack-1.2 {basic positioning} { +} -result 10x20+45+0 +test oldpack-1.2 {basic positioning} -body { pack append .pack .pack.red bottom update winfo geometry .pack.red -} 10x20+45+80 -test oldpack-1.3 {basic positioning} { +} -result 10x20+45+80 +test oldpack-1.3 {basic positioning} -body { pack append .pack .pack.red left update winfo geometry .pack.red -} 10x20+0+40 -test oldpack-1.4 {basic positioning} { +} -result 10x20+0+40 +test oldpack-1.4 {basic positioning} -body { pack append .pack .pack.red right update winfo geometry .pack.red -} 10x20+90+40 +} -result 10x20+90+40 # Try adding padding around the window and make sure that the # window gets a larger frame. -test oldpack-2.1 {padding} { +test oldpack-2.1 {padding} -body { pack append .pack .pack.red {t padx 20} update winfo geometry .pack.red -} 10x20+45+0 -test oldpack-2.2 {padding} { +} -result 10x20+45+0 +test oldpack-2.2 {padding} -body { pack append .pack .pack.red {top pady 20} update winfo geometry .pack.red -} 10x20+45+10 -test oldpack-2.3 {padding} { +} -result 10x20+45+10 +test oldpack-2.3 {padding} -body { pack append .pack .pack.red {l padx 20} update winfo geometry .pack.red -} 10x20+10+40 -test oldpack-2.4 {padding} { +} -result 10x20+10+40 +test oldpack-2.4 {padding} -body { pack append .pack .pack.red {left pady 20} update winfo geometry .pack.red -} 10x20+0+40 +} -result 10x20+0+40 # Position the window at different positions in its frame to # make sure they all work. Try two differenet frame locations, # to make sure that frame offsets are being added in correctly. -test oldpack-3.1 {framing} { +test oldpack-3.1 {framing} -body { pack append .pack .pack.red {b padx 20 pady 30} update winfo geometry .pack.red -} 10x20+45+65 -test oldpack-3.2 {framing} { +} -result 10x20+45+65 +test oldpack-3.2 {framing} -body { pack append .pack .pack.red {bottom padx 20 pady 30 fr n} update winfo geometry .pack.red -} 10x20+45+50 -test oldpack-3.3 {framing} { +} -result 10x20+45+50 +test oldpack-3.3 {framing} -body { pack append .pack .pack.red {bottom padx 20 pady 30 frame ne} update winfo geometry .pack.red -} 10x20+90+50 -test oldpack-3.4 {framing} { +} -result 10x20+90+50 +test oldpack-3.4 {framing} -body { pack append .pack .pack.red {bottom padx 20 pady 30 frame e} update winfo geometry .pack.red -} 10x20+90+65 -test oldpack-3.5 {framing} { +} -result 10x20+90+65 +test oldpack-3.5 {framing} -body { pack append .pack .pack.red {bottom padx 20 pady 30 frame se} update winfo geometry .pack.red -} 10x20+90+80 -test oldpack-3.6 {framing} { +} -result 10x20+90+80 +test oldpack-3.6 {framing} -body { pack append .pack .pack.red {bottom padx 20 pady 30 frame s} update winfo geometry .pack.red -} 10x20+45+80 -test oldpack-3.7 {framing} { +} -result 10x20+45+80 +test oldpack-3.7 {framing} -body { pack append .pack .pack.red {bottom padx 20 pady 30 frame sw} update winfo geometry .pack.red -} 10x20+0+80 -test oldpack-3.8 {framing} { +} -result 10x20+0+80 +test oldpack-3.8 {framing} -body { pack append .pack .pack.red {bottom padx 20 pady 30 frame w} update winfo geometry .pack.red -} 10x20+0+65 -test oldpack-3.9 {framing} { +} -result 10x20+0+65 +test oldpack-3.9 {framing} -body { pack append .pack .pack.red {bottom padx 20 pady 30 frame nw} update winfo geometry .pack.red -} 10x20+0+50 -test oldpack-3.10 {framing} { +} -result 10x20+0+50 +test oldpack-3.10 {framing} -body { pack append .pack .pack.red {bottom padx 20 pady 30 frame c} update winfo geometry .pack.red -} 10x20+45+65 -test oldpack-3.11 {framing} { +} -result 10x20+45+65 +test oldpack-3.11 {framing} -body { pack append .pack .pack.red {r padx 20 pady 30} update winfo geometry .pack.red -} 10x20+80+40 -test oldpack-3.12 {framing} { +} -result 10x20+80+40 +test oldpack-3.12 {framing} -body { pack append .pack .pack.red {right padx 20 pady 30 frame n} update winfo geometry .pack.red -} 10x20+80+0 -test oldpack-3.13 {framing} { +} -result 10x20+80+0 +test oldpack-3.13 {framing} -body { pack append .pack .pack.red {right padx 20 pady 30 frame ne} update winfo geometry .pack.red -} 10x20+90+0 -test oldpack-3.14 {framing} { +} -result 10x20+90+0 +test oldpack-3.14 {framing} -body { pack append .pack .pack.red {right padx 20 pady 30 frame e} update winfo geometry .pack.red -} 10x20+90+40 -test oldpack-3.15 {framing} { +} -result 10x20+90+40 +test oldpack-3.15 {framing} -body { pack append .pack .pack.red {right padx 20 pady 30 frame se} update winfo geometry .pack.red -} 10x20+90+80 -test oldpack-3.16 {framing} { +} -result 10x20+90+80 +test oldpack-3.16 {framing} -body { pack append .pack .pack.red {right padx 20 pady 30 frame s} update winfo geometry .pack.red -} 10x20+80+80 -test oldpack-3.17 {framing} { +} -result 10x20+80+80 +test oldpack-3.17 {framing} -body { pack append .pack .pack.red {right padx 20 pady 30 frame sw} update winfo geometry .pack.red -} 10x20+70+80 -test oldpack-3.18 {framing} { +} -result 10x20+70+80 +test oldpack-3.18 {framing} -body { pack append .pack .pack.red {right padx 20 pady 30 frame w} update winfo geometry .pack.red -} 10x20+70+40 -test oldpack-3.19 {framing} { +} -result 10x20+70+40 +test oldpack-3.19 {framing} -body { pack append .pack .pack.red {right padx 20 pady 30 frame nw} update winfo geometry .pack.red -} 10x20+70+0 -test oldpack-3.20 {framing} { +} -result 10x20+70+0 +test oldpack-3.20 {framing} -body { pack append .pack .pack.red {right padx 20 pady 30 frame center} update winfo geometry .pack.red -} 10x20+80+40 +} -result 10x20+80+40 # Try out various filling combinations in a couple of different # frame locations. -test oldpack-4.1 {filling} { +test oldpack-4.1 {filling} -body { pack append .pack .pack.red {bottom padx 20 pady 30 fillx} update winfo geometry .pack.red -} 100x20+0+65 -test oldpack-4.2 {filling} { +} -result 100x20+0+65 +test oldpack-4.2 {filling} -body { pack append .pack .pack.red {bottom padx 20 pady 30 filly} update winfo geometry .pack.red -} 10x50+45+50 -test oldpack-4.3 {filling} { +} -result 10x50+45+50 +test oldpack-4.3 {filling} -body { pack append .pack .pack.red {bottom padx 20 pady 30 fill} update winfo geometry .pack.red -} 100x50+0+50 -test oldpack-4.4 {filling} { +} -result 100x50+0+50 +test oldpack-4.4 {filling} -body { pack append .pack .pack.red {right padx 20 pady 30 fillx} update winfo geometry .pack.red -} 30x20+70+40 -test oldpack-4.5 {filling} { +} -result 30x20+70+40 +test oldpack-4.5 {filling} -body { pack append .pack .pack.red {right padx 20 pady 30 filly} update winfo geometry .pack.red -} 10x100+80+0 -test oldpack-4.6 {filling} { +} -result 10x100+80+0 +test oldpack-4.6 {filling} -body { pack append .pack .pack.red {right padx 20 pady 30 fill} update winfo geometry .pack.red -} 30x100+70+0 +} -result 30x100+70+0 # Multiple windows: make sure that space is properly subtracted # from the cavity as windows are positioned inwards from all @@ -219,57 +220,128 @@ test oldpack-4.6 {filling} { # there isn't enough space for them. pack append .pack .pack.red top .pack.green top .pack.blue top \ - .pack.violet top + .pack.violet top update -test oldpack-5.1 {multiple windows} {winfo geometry .pack.red} 10x20+45+0 -test oldpack-5.2 {multiple windows} {winfo geometry .pack.green} 30x40+35+20 -test oldpack-5.3 {multiple windows} {winfo geometry .pack.blue} 40x40+30+60 -test oldpack-5.4 {multiple windows} {winfo ismapped .pack.violet} 0 +test oldpack-5.1 {multiple windows} -body { + winfo geometry .pack.red +} -result 10x20+45+0 +test oldpack-5.2 {multiple windows} -body { + winfo geometry .pack.green +} -result 30x40+35+20 +test oldpack-5.3 {multiple windows} -body { + winfo geometry .pack.blue +} -result 40x40+30+60 +test oldpack-5.4 {multiple windows} -body { + winfo ismapped .pack.violet +} -result 0 + pack b .pack.blue .pack.violet top update -test oldpack-5.5 {multiple windows} {winfo ismapped .pack.violet} 1 -test oldpack-5.6 {multiple windows} {winfo geometry .pack.violet} 80x20+10+60 -test oldpack-5.7 {multiple windows} {winfo geometry .pack.blue} 40x20+30+80 +test oldpack-5.5 {multiple windows} -body { + winfo ismapped .pack.violet +} -result 1 +test oldpack-5.6 {multiple windows} -body { + winfo geometry .pack.violet +} -result 80x20+10+60 +test oldpack-5.7 {multiple windows} -body { + winfo geometry .pack.blue +} -result 40x20+30+80 + pack after .pack.blue .pack.red top update -test oldpack-5.8 {multiple windows} {winfo geometry .pack.green} 30x40+35+0 -test oldpack-5.9 {multiple windows} {winfo geometry .pack.violet} 80x20+10+40 -test oldpack-5.10 {multiple windows} {winfo geometry .pack.blue} 40x40+30+60 -test oldpack-5.11 {multiple windows} {winfo ismapped .pack.red} 0 +test oldpack-5.8 {multiple windows} -body { + winfo geometry .pack.green +} -result 30x40+35+0 +test oldpack-5.9 {multiple windows} -body { + winfo geometry .pack.violet +} -result 80x20+10+40 +test oldpack-5.10 {multiple windows} -body { + winfo geometry .pack.blue +} -result 40x40+30+60 +test oldpack-5.11 {multiple windows} -body { + winfo ismapped .pack.red +} -result 0 + pack before .pack.green .pack.red right .pack.blue left update -test oldpack-5.12 {multiple windows} {winfo ismapped .pack.red} 1 -test oldpack-5.13 {multiple windows} {winfo geometry .pack.red} 10x20+90+40 -test oldpack-5.14 {multiple windows} {winfo geometry .pack.blue} 40x40+0+30 -test oldpack-5.15 {multiple windows} {winfo geometry .pack.green} 30x40+50+0 -test oldpack-5.16 {multiple windows} {winfo geometry .pack.violet} 50x20+40+40 +test oldpack-5.12 {multiple windows} -body { + winfo ismapped .pack.red +} -result 1 +test oldpack-5.13 {multiple windows} -body { + winfo geometry .pack.red +} -result 10x20+90+40 +test oldpack-5.14 {multiple windows} -body { + winfo geometry .pack.blue +} -result 40x40+0+30 +test oldpack-5.15 {multiple windows} -body { + winfo geometry .pack.green +} -result 30x40+50+0 +test oldpack-5.16 {multiple windows} -body { + winfo geometry .pack.violet +} -result 50x20+40+40 + pack append .pack .pack.violet left .pack.green bottom .pack.red bottom \ - .pack.blue bottom + .pack.blue bottom update -test oldpack-5.17 {multiple windows} {winfo geometry .pack.violet} 80x20+0+40 -test oldpack-5.18 {multiple windows} {winfo geometry .pack.green} 20x40+80+60 -test oldpack-5.19 {multiple windows} {winfo geometry .pack.red} 10x20+85+40 -test oldpack-5.20 {multiple windows} {winfo geometry .pack.blue} 20x40+80+0 +test oldpack-5.17 {multiple windows} -body { + winfo geometry .pack.violet +} -result 80x20+0+40 +test oldpack-5.18 {multiple windows} -body { + winfo geometry .pack.green +} -result 20x40+80+60 +test oldpack-5.19 {multiple windows} -body { + winfo geometry .pack.red +} -result 10x20+85+40 +test oldpack-5.20 {multiple windows} -body { + winfo geometry .pack.blue +} -result 20x40+80+0 + pack after .pack.blue .pack.blue top .pack.red right .pack.green right \ - .pack.violet right + .pack.violet right update -test oldpack-5.21 {multiple windows} {winfo geometry .pack.blue} 40x40+30+0 -test oldpack-5.22 {multiple windows} {winfo geometry .pack.red} 10x20+90+60 -test oldpack-5.23 {multiple windows} {winfo geometry .pack.green} 30x40+60+50 -test oldpack-5.24 {multiple windows} {winfo geometry .pack.violet} 60x20+0+60 +test oldpack-5.21 {multiple windows} -body { + winfo geometry .pack.blue +} -result 40x40+30+0 +test oldpack-5.22 {multiple windows} -body { + winfo geometry .pack.red +} -result 10x20+90+60 +test oldpack-5.23 {multiple windows} -body { + winfo geometry .pack.green +} -result 30x40+60+50 +test oldpack-5.24 {multiple windows} -body { + winfo geometry .pack.violet +} -result 60x20+0+60 + pack after .pack.blue .pack.red left .pack.green left .pack.violet left update -test oldpack-5.25 {multiple windows} {winfo geometry .pack.blue} 40x40+30+0 -test oldpack-5.26 {multiple windows} {winfo geometry .pack.red} 10x20+0+60 -test oldpack-5.27 {multiple windows} {winfo geometry .pack.green} 30x40+10+50 -test oldpack-5.28 {multiple windows} {winfo geometry .pack.violet} 60x20+40+60 +test oldpack-5.25 {multiple windows} -body { + winfo geometry .pack.blue +} -result 40x40+30+0 +test oldpack-5.26 {multiple windows} -body { + winfo geometry .pack.red +} -result 10x20+0+60 +test oldpack-5.27 {multiple windows} -body { + winfo geometry .pack.green +} -result 30x40+10+50 +test oldpack-5.28 {multiple windows} -body { + winfo geometry .pack.violet +} -result 60x20+40+60 + pack append .pack .pack.violet left .pack.green left .pack.blue left \ - .pack.red left + .pack.red left update -test oldpack-5.29 {multiple windows} {winfo geometry .pack.violet} 80x20+0+40 -test oldpack-5.30 {multiple windows} {winfo geometry .pack.green} 20x40+80+30 -test oldpack-5.31 {multiple windows} {winfo ismapped .pack.blue} 0 -test oldpack-5.32 {multiple windows} {winfo ismapped .pack.red} 0 +test oldpack-5.29 {multiple windows} -body { + winfo geometry .pack.violet +} -result 80x20+0+40 +test oldpack-5.30 {multiple windows} -body { + winfo geometry .pack.green +} -result 20x40+80+30 +test oldpack-5.31 {multiple windows} -body { + winfo ismapped .pack.blue +} -result 0 +test oldpack-5.32 {multiple windows} -body { + winfo ismapped .pack.red +} -result 0 # Test the ability of the packer to propagate geometry information @@ -279,84 +351,92 @@ test oldpack-5.32 {multiple windows} {winfo ismapped .pack.red} 0 # "left" and "right" windows). pack append .pack .pack.red top .pack.green top .pack.blue top \ - .pack.violet top + .pack.violet top update -test oldpack-6.1 {geometry propagation} {winfo reqwidth .pack} 80 -test oldpack-6.2 {geometry propagation} {winfo reqheight .pack} 120 +test oldpack-6.1 {geometry propagation} -body { + winfo reqwidth .pack} -result 80 +test oldpack-6.2 {geometry propagation} -body { + winfo reqheight .pack} -result 120 destroy .pack.violet update -test oldpack-6.3 {geometry propagation} {winfo reqwidth .pack} 40 -test oldpack-6.4 {geometry propagation} {winfo reqheight .pack} 100 +test oldpack-6.3 {geometry propagation} -body { + winfo reqwidth .pack} -result 40 +test oldpack-6.4 {geometry propagation} -body { + winfo reqheight .pack} -result 100 frame .pack.violet -width 80 -height 20 -bg violet label .pack.violet.l -text P -bd 2 -relief raised place .pack.violet.l -relwidth 1.0 -relheight 1.0 pack append .pack .pack.red left .pack.green right .pack.blue bottom \ - .pack.violet top + .pack.violet top update -test oldpack-6.5 {geometry propagation} {winfo reqwidth .pack} 120 -test oldpack-6.6 {geometry propagation} {winfo reqheight .pack} 60 +test oldpack-6.5 {geometry propagation} -body { + winfo reqwidth .pack} -result 120 +test oldpack-6.6 {geometry propagation} -body { + winfo reqheight .pack} -result 60 pack append .pack .pack.violet top .pack.green top .pack.blue left \ - .pack.red left + .pack.red left update -test oldpack-6.7 {geometry propagation} {winfo reqwidth .pack} 80 -test oldpack-6.8 {geometry propagation} {winfo reqheight .pack} 100 +test oldpack-6.7 {geometry propagation} -body { + winfo reqwidth .pack} -result 80 +test oldpack-6.8 {geometry propagation} -body { + winfo reqheight .pack} -result 100 # Test the "expand" option, and make sure space is evenly divided # when several windows request expansion. pack append .pack .pack.violet top .pack.green {left e} \ - .pack.blue {left expand} .pack.red {left expand} + .pack.blue {left expand} .pack.red {left expand} update -test oldpack-7.1 {multiple expanded windows} { +test oldpack-7.1 {multiple expanded windows} -body { pack append .pack .pack.violet top .pack.green {left e} \ - .pack.blue {left expand} .pack.red {left expand} + .pack.blue {left expand} .pack.red {left expand} update list [winfo geometry .pack.green] [winfo geometry .pack.blue] \ - [winfo geometry .pack.red] -} {30x40+3+40 40x40+39+40 10x20+86+50} -test oldpack-7.2 {multiple expanded windows} { + [winfo geometry .pack.red] +} -result {30x40+3+40 40x40+39+40 10x20+86+50} +test oldpack-7.2 {multiple expanded windows} -body { pack append .pack .pack.green left .pack.violet {bottom expand} \ - .pack.blue {bottom expand} .pack.red {bottom expand} + .pack.blue {bottom expand} .pack.red {bottom expand} update list [winfo geometry .pack.violet] [winfo geometry .pack.blue] \ - [winfo geometry .pack.red] -} {70x20+30+77 40x40+45+30 10x20+60+3} -test oldpack-7.3 {multiple expanded windows} { + [winfo geometry .pack.red] +} -result {70x20+30+77 40x40+45+30 10x20+60+3} +test oldpack-7.3 {multiple expanded windows} -body { foreach i [winfo child .pack] { - pack unpack $i + pack unpack $i } pack append .pack .pack.green {left e fill} .pack.red {left expand fill} \ - .pack.blue {top fill} + .pack.blue {top fill} update list [winfo geometry .pack.green] [winfo geometry .pack.red] \ - [winfo geometry .pack.blue] -} {40x100+0+0 20x100+40+0 40x40+60+0} -test oldpack-7.4 {multiple expanded windows} { + [winfo geometry .pack.blue] +} -result {40x100+0+0 20x100+40+0 40x40+60+0} +test oldpack-7.4 {multiple expanded windows} -body { foreach i [winfo child .pack] { - pack unpack $i + pack unpack $i } pack append .pack .pack.red {top expand} .pack.violet {top expand} \ - .pack.blue {right fill} + .pack.blue {right fill} update list [winfo geometry .pack.red] [winfo geometry .pack.violet] \ - [winfo geometry .pack.blue] -} {10x20+45+5 80x20+10+35 40x40+60+60} -test oldpack-7.5 {multiple expanded windows} { + [winfo geometry .pack.blue] +} -result {10x20+45+5 80x20+10+35 40x40+60+60} +test oldpack-7.5 {multiple expanded windows} -body { foreach i [winfo child .pack] { - pack unpack $i + pack unpack $i } pack append .pack .pack.green {right frame s} .pack.red {top expand} update list [winfo geometry .pack.green] [winfo geometry .pack.red] -} {30x40+70+60 10x20+30+40} -test oldpack-7.6 {multiple expanded windows} { +} -result {30x40+70+60 10x20+30+40} +test oldpack-7.6 {multiple expanded windows} -body { foreach i [winfo child .pack] { - pack unpack $i + pack unpack $i } pack append .pack .pack.violet {bottom frame e} .pack.red {right expand} update list [winfo geometry .pack.violet] [winfo geometry .pack.red] -} {80x20+20+80 10x20+45+30} +} -result {80x20+20+80 10x20+45+30} # Need more bizarre tests with combinations of expanded windows and # windows in opposing directions! Also, include padding in expanded @@ -364,146 +444,109 @@ test oldpack-7.6 {multiple expanded windows} { # Syntax errors on pack commands -test oldpack-8.1 {syntax errors} { - set msg "" - set result [catch {pack} msg] - concat $result $msg -} {1 wrong # args: should be "pack option arg ?arg ...?"} -test oldpack-8.2 {syntax errors} { - set msg "" - set result [catch {pack append} msg] - concat $result $msg -} {1 wrong # args: should be "pack option arg ?arg ...?"} -test oldpack-8.3 {syntax errors} { - set msg "" - set result [catch {pack gorp foo} msg] - concat $result $msg -} {1 bad option "gorp": must be configure, forget, info, propagate, or slaves} -test oldpack-8.4 {syntax errors} { - set msg "" - set result [catch {pack a .pack} msg] - concat $result $msg -} {1 bad option "a": must be configure, forget, info, propagate, or slaves} -test oldpack-8.5 {syntax errors} { - set msg "" - set result [catch {pack after foobar} msg] - concat $result $msg -} {1 bad window path name "foobar"} -test oldpack-8.6 {syntax errors} { +test oldpack-8.1 {syntax errors} -body { + pack +} -returnCodes error -result {wrong # args: should be "pack option arg ?arg ...?"} +test oldpack-8.2 {syntax errors} -body { + pack append +} -returnCodes error -result {wrong # args: should be "pack option arg ?arg ...?"} +test oldpack-8.3 {syntax errors} -body { + pack gorp foo +} -returnCodes error -result {bad option "gorp": must be configure, forget, info, propagate, or slaves} +test oldpack-8.4 {syntax errors} -body { + pack a .pack +} -returnCodes error -result {bad option "a": must be configure, forget, info, propagate, or slaves} +test oldpack-8.5 {syntax errors} -body { + pack after foobar +} -returnCodes error -result {bad window path name "foobar"} +test oldpack-8.6 {syntax errors} -setup { + destroy .pack.yellow +} -body { frame .pack.yellow -bg yellow - set msg "" - set result [catch {pack after .pack.yellow} msg] + pack after .pack.yellow +} -cleanup { destroy .pack.yellow - concat $result $msg -} {1 window ".pack.yellow" isn't packed} -test oldpack-8.7 {syntax errors} { - set msg "" - set result [catch {pack append foobar} msg] - concat $result $msg -} {1 bad window path name "foobar"} -test oldpack-8.8 {syntax errors} { - set msg "" - set result [catch {pack before foobar} msg] - concat $result $msg -} {1 bad window path name "foobar"} -test oldpack-8.9 {syntax errors} { +} -returnCodes error -result {window ".pack.yellow" isn't packed} +test oldpack-8.7 {syntax errors} -body { + pack append foobar +} -returnCodes error -result {bad window path name "foobar"} +test oldpack-8.8 {syntax errors} -body { + pack before foobar +} -returnCodes error -result {bad window path name "foobar"} +test oldpack-8.9 {syntax errors} -setup { + destroy .pack.yellow +} -body { frame .pack.yellow -bg yellow - set msg "" - set result [catch {pack before .pack.yellow} msg] + pack before .pack.yellow +} -cleanup { destroy .pack.yellow - concat $result $msg -} {1 window ".pack.yellow" isn't packed} -test oldpack-8.10 {syntax errors} { - set msg "" - set result [catch {pack info .pack help} msg] - concat $result $msg -} {1 wrong # args: should be "pack info window"} -test oldpack-8.11 {syntax errors} { - set msg "" - set result [catch {pack info foobar} msg] - concat $result $msg -} {1 bad window path name "foobar"} -test oldpack-8.12 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue} msg] - concat $result $msg -} {1 wrong # args: window ".pack.blue" should be followed by options} -test oldpack-8.13 {syntax errors} { - set msg "" - set result [catch {pack append . .pack.blue top} msg] - concat $result $msg -} {1 can't pack .pack.blue inside .} -test oldpack-8.14 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue f} msg] - concat $result $msg -} {1 bad option "f": should be top, bottom, left, right, expand, fill, fillx, filly, padx, pady, or frame} -test oldpack-8.15 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue pad} msg] - concat $result $msg -} {1 bad option "pad": should be top, bottom, left, right, expand, fill, fillx, filly, padx, pady, or frame} -test oldpack-8.16 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue {frame south}} msg] - concat $result $msg -} {1 bad anchor "south": must be n, ne, e, se, s, sw, w, nw, or center} -test oldpack-8.17 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue {padx -2}} msg] - concat $result $msg -} {1 bad pad value "-2": must be positive screen distance} -test oldpack-8.18 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue {padx}} msg] - concat $result $msg -} {1 wrong # args: "padx" option must be followed by screen distance} -test oldpack-8.19 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue {pady -2}} msg] - concat $result $msg -} {1 bad pad value "-2": must be positive screen distance} -test oldpack-8.20 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue {pady}} msg] - concat $result $msg -} {1 wrong # args: "pady" option must be followed by screen distance} -test oldpack-8.21 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue "\{abc"} msg] - concat $result $msg -} {1 unmatched open brace in list} -test oldpack-8.22 {syntax errors} { - set msg "" - set result [catch {pack append .pack .pack.blue frame} msg] - concat $result $msg -} {1 wrong # args: "frame" option must be followed by anchor point} +} -returnCodes error -result {window ".pack.yellow" isn't packed} +test oldpack-8.10 {syntax errors} -body { + pack info .pack help +} -returnCodes error -result {wrong # args: should be "pack info window"} +test oldpack-8.11 {syntax errors} -body { + pack info foobar +} -returnCodes error -result {bad window path name "foobar"} +test oldpack-8.12 {syntax errors} -body { + pack append .pack .pack.blue +} -returnCodes error -result {wrong # args: window ".pack.blue" should be followed by options} +test oldpack-8.13 {syntax errors} -body { + pack append . .pack.blue top +} -returnCodes error -result {can't pack .pack.blue inside .} +test oldpack-8.14 {syntax errors} -body { + pack append .pack .pack.blue f +} -returnCodes error -result {bad option "f": should be top, bottom, left, right, expand, fill, fillx, filly, padx, pady, or frame} +test oldpack-8.15 {syntax errors} -body { + pack append .pack .pack.blue pad +} -returnCodes error -result {bad option "pad": should be top, bottom, left, right, expand, fill, fillx, filly, padx, pady, or frame} +test oldpack-8.16 {syntax errors} -body { + pack append .pack .pack.blue {frame south} +} -returnCodes error -result {bad anchor "south": must be n, ne, e, se, s, sw, w, nw, or center} +test oldpack-8.17 {syntax errors} -body { + pack append .pack .pack.blue {padx -2} +} -returnCodes error -result {bad pad value "-2": must be positive screen distance} +test oldpack-8.18 {syntax errors} -body { + pack append .pack .pack.blue {padx} +} -returnCodes error -result {wrong # args: "padx" option must be followed by screen distance} +test oldpack-8.19 {syntax errors} -body { + pack append .pack .pack.blue {pady -2} +} -returnCodes error -result {bad pad value "-2": must be positive screen distance} +test oldpack-8.20 {syntax errors} -body { + pack append .pack .pack.blue {pady} +} -returnCodes error -result {wrong # args: "pady" option must be followed by screen distance} +test oldpack-8.21 {syntax errors} -body { + pack append .pack .pack.blue "\{abc" +} -returnCodes error -result {unmatched open brace in list} +test oldpack-8.22 {syntax errors} -body { + pack append .pack .pack.blue frame +} -returnCodes error -result {wrong # args: "frame" option must be followed by anchor point} # Test "pack info" command output. -test oldpack-9.1 {information output} { +test oldpack-9.1 {information output} -body { pack append .pack .pack.blue {top fillx frame n} \ - .pack.red {bottom filly frame s} .pack.green {left fill frame w} \ - .pack.violet {right expand frame e} + .pack.red {bottom filly frame s} .pack.green {left fill frame w} \ + .pack.violet {right expand frame e} list [pack slaves .pack] [pack info .pack.blue] [pack info .pack.red] \ - [pack info .pack.green] [pack info .pack.violet] -} {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor n -expand 0 -fill x -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor s -expand 0 -fill y -ipadx 0 -ipady 0 -padx 0 -pady 0 -side bottom} {-in .pack -anchor w -expand 0 -fill both -ipadx 0 -ipady 0 -padx 0 -pady 0 -side left} {-in .pack -anchor e -expand 1 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side right}} -test oldpack-9.2 {information output} { + [pack info .pack.green] [pack info .pack.violet] +} -result {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor n -expand 0 -fill x -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor s -expand 0 -fill y -ipadx 0 -ipady 0 -padx 0 -pady 0 -side bottom} {-in .pack -anchor w -expand 0 -fill both -ipadx 0 -ipady 0 -padx 0 -pady 0 -side left} {-in .pack -anchor e -expand 1 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side right}} +test oldpack-9.2 {information output} -body { pack append .pack .pack.blue {padx 10 frame nw} \ - .pack.red {pady 20 frame ne} .pack.green {frame se} \ - .pack.violet {frame sw} + .pack.red {pady 20 frame ne} .pack.green {frame se} \ + .pack.violet {frame sw} list [pack slaves .pack] [pack info .pack.blue] [pack info .pack.red] \ - [pack info .pack.green] [pack info .pack.violet] -} {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor nw -expand 0 -fill none -ipadx 0 -ipady 0 -padx 5 -pady 0 -side top} {-in .pack -anchor ne -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 10 -side top} {-in .pack -anchor se -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor sw -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}} -test oldpack-9.3 {information output} { + [pack info .pack.green] [pack info .pack.violet] +} -result {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor nw -expand 0 -fill none -ipadx 0 -ipady 0 -padx 5 -pady 0 -side top} {-in .pack -anchor ne -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 10 -side top} {-in .pack -anchor se -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor sw -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}} +test oldpack-9.3 {information output} -body { pack append .pack .pack.blue {frame center} .pack.red {frame center} \ - .pack.green {frame c} .pack.violet {frame c} + .pack.green {frame c} .pack.violet {frame c} list [pack slaves .pack] [pack info .pack.blue] [pack info .pack.red] \ - [pack info .pack.green] [pack info .pack.violet] -} {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}} + [pack info .pack.green] [pack info .pack.violet] +} -result {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}} -catch {destroy .pack} +destroy .pack # cleanup cleanupTests return + diff --git a/tests/option.test b/tests/option.test index 4668771..ea5b5d1 100644 --- a/tests/option.test +++ b/tests/option.test @@ -6,14 +6,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint appNameIsTktest [expr {[winfo name .] eq "tktest"}] -catch {destroy .op1} -catch {destroy .op2} +deleteWindows set appName [winfo name .] # First, test basic retrievals, being sure to trigger all the various @@ -27,6 +27,7 @@ frame .op1.op4 -class Class3 frame .op2.op5 -class Class2 frame .op1.op3.op6 -class Class4 +# Configurations for tests 1.* - 12.* option clear option add *Color1 red option add *x blue @@ -38,97 +39,254 @@ option add $appName.Class1.Class3.y brown option add $appName*op6*Color2 black option add $appName*Class1.op1.Color2 grey -test option-1.1 {basic option retrieval} {option get . x Color1} blue -test option-1.2 {basic option retrieval} {option get . y Color1} red -test option-1.3 {basic option retrieval} {option get . z Color1} red -test option-1.4 {basic option retrieval} {option get . x Color2} blue -test option-1.5 {basic option retrieval} {option get . y Color2} {} -test option-1.6 {basic option retrieval} {option get . z Color2} {} - -test option-2.1 {basic option retrieval} {option get .op1 x Color1} green -test option-2.2 {basic option retrieval} {option get .op1 y Color1} red -test option-2.3 {basic option retrieval} {option get .op1 z Color1} red -test option-2.4 {basic option retrieval} {option get .op1 x Color2} green -test option-2.5 {basic option retrieval} {option get .op1 y Color2} {} -test option-2.6 {basic option retrieval} {option get .op1 z Color2} {} - -test option-3.1 {basic option retrieval} {option get .op1.op3 x Color1} yellow -test option-3.2 {basic option retrieval} {option get .op1.op3 y Color1} red -test option-3.3 {basic option retrieval} {option get .op1.op3 z Color1} red -test option-3.4 {basic option retrieval} {option get .op1.op3 x Color2} yellow -test option-3.5 {basic option retrieval} {option get .op1.op3 y Color2} {} -test option-3.6 {basic option retrieval} {option get .op1.op3 z Color2} {} - -test option-4.1 {basic option retrieval} {option get .op1.op3.op6 x Color1} blue -test option-4.2 {basic option retrieval} {option get .op1.op3.op6 y Color1} red -test option-4.3 {basic option retrieval} {option get .op1.op3.op6 z Color1} red -test option-4.4 {basic option retrieval} {option get .op1.op3.op6 x Color2} black -test option-4.5 {basic option retrieval} {option get .op1.op3.op6 y Color2} black -test option-4.6 {basic option retrieval} {option get .op1.op3.op6 z Color2} black - -test option-5.1 {basic option retrieval} {option get .op1.op4 x Color1} blue -test option-5.2 {basic option retrieval} {option get .op1.op4 y Color1} brown -test option-5.3 {basic option retrieval} {option get .op1.op4 z Color1} red -test option-5.4 {basic option retrieval} {option get .op1.op4 x Color2} blue -test option-5.5 {basic option retrieval} {option get .op1.op4 y Color2} brown -test option-5.6 {basic option retrieval} {option get .op1.op4 z Color2} {} - -test option-6.1 {basic option retrieval} {option get .op2 x Color1} orange -test option-6.2 {basic option retrieval} {option get .op2 y Color1} orange -test option-6.3 {basic option retrieval} {option get .op2 z Color1} orange -test option-6.4 {basic option retrieval} {option get .op2 x Color2} blue -test option-6.5 {basic option retrieval} {option get .op2 y Color2} {} -test option-6.6 {basic option retrieval} {option get .op2 z Color2} {} - -test option-7.1 {basic option retrieval} {option get .op2.op5 x Color1} orange -test option-7.2 {basic option retrieval} {option get .op2.op5 y Color1} orange -test option-7.3 {basic option retrieval} {option get .op2.op5 z Color1} orange -test option-7.4 {basic option retrieval} {option get .op2.op5 x Color2} purple -test option-7.5 {basic option retrieval} {option get .op2.op5 y Color2} purple -test option-7.6 {basic option retrieval} {option get .op2.op5 z Color2} purple +test option-1.1 {basic option retrieval} -body { + option get . x Color1 +} -result blue +test option-1.2 {basic option retrieval} -body { + option get . y Color1 +} -result red +test option-1.3 {basic option retrieval} -body { + option get . z Color1 +} -result red +test option-1.4 {basic option retrieval} -body { + option get . x Color2 +} -result blue +test option-1.5 {basic option retrieval} -body { + option get . y Color2 +} -result {} +test option-1.6 {basic option retrieval} -body { + option get . z Color2 +} -result {} + + +test option-2.1 {basic option retrieval} -body { + option get .op1 x Color1 +} -result green +test option-2.2 {basic option retrieval} -body { + option get .op1 y Color1 +} -result red +test option-2.3 {basic option retrieval} -body { + option get .op1 z Color1 +} -result red +test option-2.4 {basic option retrieval} -body { + option get .op1 x Color2 +} -result green +test option-2.5 {basic option retrieval} -body { + option get .op1 y Color2 +} -result {} +test option-2.6 {basic option retrieval} -body { + option get .op1 z Color2 +} -result {} + + +test option-3.1 {basic option retrieval} -body { + option get .op1.op3 x Color1 +} -result yellow +test option-3.2 {basic option retrieval} -body { + option get .op1.op3 y Color1 +} -result red +test option-3.3 {basic option retrieval} -body { + option get .op1.op3 z Color1 +} -result red +test option-3.4 {basic option retrieval} -body { + option get .op1.op3 x Color2 +} -result yellow +test option-3.5 {basic option retrieval} -body { + option get .op1.op3 y Color2 +} -result {} +test option-3.6 {basic option retrieval} -body { + option get .op1.op3 z Color2 +} -result {} + + +test option-4.1 {basic option retrieval} -body { + option get .op1.op3.op6 x Color1 +} -result blue +test option-4.2 {basic option retrieval} -body { + option get .op1.op3.op6 y Color1 +} -result red +test option-4.3 {basic option retrieval} -body { + option get .op1.op3.op6 z Color1 +} -result red +test option-4.4 {basic option retrieval} -body { + option get .op1.op3.op6 x Color2 +} -result black +test option-4.5 {basic option retrieval} -body { + option get .op1.op3.op6 y Color2 +} -result black +test option-4.6 {basic option retrieval} -body { + option get .op1.op3.op6 z Color2 +} -result black + + +test option-5.1 {basic option retrieval} -body { + option get .op1.op4 x Color1 +} -result blue +test option-5.2 {basic option retrieval} -body { + option get .op1.op4 y Color1 +} -result brown +test option-5.3 {basic option retrieval} -body { + option get .op1.op4 z Color1 +} -result red +test option-5.4 {basic option retrieval} -body { + option get .op1.op4 x Color2 +} -result blue +test option-5.5 {basic option retrieval} -body { + option get .op1.op4 y Color2 +} -result brown +test option-5.6 {basic option retrieval} -body { + option get .op1.op4 z Color2 +} -result {} + + +test option-6.1 {basic option retrieval} -body { + option get .op2 x Color1 +} -result orange +test option-6.2 {basic option retrieval} -body { + option get .op2 y Color1 +} -result orange +test option-6.3 {basic option retrieval} -body { + option get .op2 z Color1 +} -result orange +test option-6.4 {basic option retrieval} -body { + option get .op2 x Color2 +} -result blue +test option-6.5 {basic option retrieval} -body { + option get .op2 y Color2 +} -result {} +test option-6.6 {basic option retrieval} -body { + option get .op2 z Color2 +} -result {} + + +test option-7.1 {basic option retrieval} -body { + option get .op2.op5 x Color1 +} -result orange +test option-7.2 {basic option retrieval} -body { + option get .op2.op5 y Color1 +} -result orange +test option-7.3 {basic option retrieval} -body { + option get .op2.op5 z Color1 +} -result orange +test option-7.4 {basic option retrieval} -body { + option get .op2.op5 x Color2 +} -result purple +test option-7.5 {basic option retrieval} -body { + option get .op2.op5 y Color2 +} -result purple +test option-7.6 {basic option retrieval} -body { + option get .op2.op5 z Color2 +} -result purple + # Now try similar tests to above, except jump around non-hierarchically # between windows to make sure that the option stacks are pushed and # popped correctly. option get . foo Foo -test option-8.1 {stack pushing/popping} {option get .op2.op5 x Color1} orange -test option-8.2 {stack pushing/popping} {option get .op2.op5 y Color1} orange -test option-8.3 {stack pushing/popping} {option get .op2.op5 z Color1} orange -test option-8.4 {stack pushing/popping} {option get .op2.op5 x Color2} purple -test option-8.5 {stack pushing/popping} {option get .op2.op5 y Color2} purple -test option-8.6 {stack pushing/popping} {option get .op2.op5 z Color2} purple - -test option-9.1 {stack pushing/popping} {option get . x Color1} blue -test option-9.2 {stack pushing/popping} {option get . y Color1} red -test option-9.3 {stack pushing/popping} {option get . z Color1} red -test option-9.4 {stack pushing/popping} {option get . x Color2} blue -test option-9.5 {stack pushing/popping} {option get . y Color2} {} -test option-9.6 {stack pushing/popping} {option get . z Color2} {} - -test option-10.1 {stack pushing/popping} {option get .op1.op3.op6 x Color1} blue -test option-10.2 {stack pushing/popping} {option get .op1.op3.op6 y Color1} red -test option-10.3 {stack pushing/popping} {option get .op1.op3.op6 z Color1} red -test option-10.4 {stack pushing/popping} {option get .op1.op3.op6 x Color2} black -test option-10.5 {stack pushing/popping} {option get .op1.op3.op6 y Color2} black -test option-10.6 {stack pushing/popping} {option get .op1.op3.op6 z Color2} black - -test option-11.1 {stack pushing/popping} {option get .op1.op3 x Color1} yellow -test option-11.2 {stack pushing/popping} {option get .op1.op3 y Color1} red -test option-11.3 {stack pushing/popping} {option get .op1.op3 z Color1} red -test option-11.4 {stack pushing/popping} {option get .op1.op3 x Color2} yellow -test option-11.5 {stack pushing/popping} {option get .op1.op3 y Color2} {} -test option-11.6 {stack pushing/popping} {option get .op1.op3 z Color2} {} - -test option-12.1 {stack pushing/popping} {option get .op1 x Color1} green -test option-12.2 {stack pushing/popping} {option get .op1 y Color1} red -test option-12.3 {stack pushing/popping} {option get .op1 z Color1} red -test option-12.4 {stack pushing/popping} {option get .op1 x Color2} green -test option-12.5 {stack pushing/popping} {option get .op1 y Color2} {} -test option-12.6 {stack pushing/popping} {option get .op1 z Color2} {} +test option-8.1 {stack pushing/popping} -body { + option get .op2.op5 x Color1 +} -result orange +test option-8.2 {stack pushing/popping} -body { + option get .op2.op5 y Color1 +} -result orange +test option-8.3 {stack pushing/popping} -body { + option get .op2.op5 z Color1 +} -result orange +test option-8.4 {stack pushing/popping} -body { + option get .op2.op5 x Color2 +} -result purple +test option-8.5 {stack pushing/popping} -body { + option get .op2.op5 y Color2 +} -result purple +test option-8.6 {stack pushing/popping} -body { + option get .op2.op5 z Color2 +} -result purple + + +test option-9.1 {stack pushing/popping} -body { + option get . x Color1 +} -result blue +test option-9.2 {stack pushing/popping} -body { + option get . y Color1 +} -result red +test option-9.3 {stack pushing/popping} -body { + option get . z Color1 +} -result red +test option-9.4 {stack pushing/popping} -body { + option get . x Color2 +} -result blue +test option-9.5 {stack pushing/popping} -body { + option get . y Color2 +} -result {} +test option-9.6 {stack pushing/popping} -body { + option get . z Color2 +} -result {} + + +test option-10.1 {stack pushing/popping} -body { + option get .op1.op3.op6 x Color1 +} -result blue +test option-10.2 {stack pushing/popping} -body { + option get .op1.op3.op6 y Color1 +} -result red +test option-10.3 {stack pushing/popping} -body { + option get .op1.op3.op6 z Color1 +} -result red +test option-10.4 {stack pushing/popping} -body { + option get .op1.op3.op6 x Color2 +} -result black +test option-10.5 {stack pushing/popping} -body { + option get .op1.op3.op6 y Color2 +} -result black +test option-10.6 {stack pushing/popping} -body { + option get .op1.op3.op6 z Color2 +} -result black + + +test option-11.1 {stack pushing/popping} -body { + option get .op1.op3 x Color1 +} -result yellow +test option-11.2 {stack pushing/popping} -body { + option get .op1.op3 y Color1 +} -result red +test option-11.3 {stack pushing/popping} -body { + option get .op1.op3 z Color1 +} -result red +test option-11.4 {stack pushing/popping} -body { + option get .op1.op3 x Color2 +} -result yellow +test option-11.5 {stack pushing/popping} -body { + option get .op1.op3 y Color2 +} -result {} +test option-11.6 {stack pushing/popping} -body { + option get .op1.op3 z Color2 +} -result {} + + +test option-12.1 {stack pushing/popping} -body { + option get .op1 x Color1 +} -result green +test option-12.2 {stack pushing/popping} -body { + option get .op1 y Color1 +} -result red +test option-12.3 {stack pushing/popping} -body { + option get .op1 z Color1 +} -result red +test option-12.4 {stack pushing/popping} -body { + option get .op1 x Color2 +} -result green +test option-12.5 {stack pushing/popping} -body { + option get .op1 y Color2 +} -result {} +test option-12.6 {stack pushing/popping} -body { + option get .op1 z Color2 +} -result {} # Test the major priority levels (widgetDefault, etc.) +# Configurations for tests 13.* +option clear option add $appName.op1.a 100 100 option add $appName.op1.A interactive interactive option add $appName.op1.b userDefault userDefault @@ -136,96 +294,132 @@ option add $appName.op1.B startupFile startupFile option add $appName.op1.c widgetDefault widgetDefault option add $appName.op1.C 0 0 -test option-13.1 {priority levels} {option get .op1 a A} 100 -test option-13.2 {priority levels} {option get .op1 b A} interactive -test option-13.3 {priority levels} {option get .op1 b B} userDefault -test option-13.4 {priority levels} {option get .op1 c B} startupFile -test option-13.5 {priority levels} {option get .op1 c C} widgetDefault +test option-13.1 {priority levels} -body { + option get .op1 a A +} -result 100 +test option-13.2 {priority levels} -body { + option get .op1 b A +} -result interactive +test option-13.3 {priority levels} -body { + option get .op1 b B +} -result userDefault +test option-13.4 {priority levels} -body { + option get .op1 c B +} -result startupFile +test option-13.5 {priority levels} -body { + option get .op1 c C +} -result widgetDefault option add $appName.op1.B file2 widget -test option-13.6 {priority levels} {option get .op1 c B} startupFile +test option-13.6 {priority levels} -body { + option get .op1 c B +} -result startupFile option add $appName.op1.B file2 startupFile -test option-13.7 {priority levels} {option get .op1 c B} file2 +test option-13.7 {priority levels} -body { + option get .op1 c B +} -result file2 + # Test various error conditions -test option-14.1 {error conditions} { - list [catch {option} msg] $msg -} {1 {wrong # args: should be "option cmd arg ?arg ...?"}} -test option-14.2 {error conditions} { - list [catch {option x} msg] $msg -} {1 {bad option "x": must be add, clear, get, or readfile}} -test option-14.3 {error conditions} { - list [catch {option foo 3} msg] $msg -} {1 {bad option "foo": must be add, clear, get, or readfile}} -test option-14.4 {error conditions} { - list [catch {option add 3} msg] $msg -} {1 {wrong # args: should be "option add pattern value ?priority?"}} -test option-14.5 {error conditions} { - list [catch {option add . a b c} msg] $msg -} {1 {wrong # args: should be "option add pattern value ?priority?"}} -test option-14.6 {error conditions} { - list [catch {option add . a -1} msg] $msg -} {1 {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}} -test option-14.7 {error conditions} { - list [catch {option add . a 101} msg] $msg -} {1 {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}} -test option-14.8 {error conditions} { - list [catch {option add . a gorp} msg] $msg -} {1 {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}} -test option-14.9 {error conditions} { - list [catch {option get 3} msg] $msg -} {1 {wrong # args: should be "option get window name class"}} -test option-14.10 {error conditions} { - list [catch {option get 3 4} msg] $msg -} {1 {wrong # args: should be "option get window name class"}} -test option-14.11 {error conditions} { - list [catch {option get 3 4 5 6} msg] $msg -} {1 {wrong # args: should be "option get window name class"}} -test option-14.12 {error conditions} { - list [catch {option get .gorp.gorp a A} msg] $msg -} {1 {bad window path name ".gorp.gorp"}} +test option-14.1 {error conditions} -body { + option +} -returnCodes error -result {wrong # args: should be "option cmd arg ?arg ...?"} +test option-14.2 {error conditions} -body { + option x +} -returnCodes error -result {bad option "x": must be add, clear, get, or readfile} +test option-14.3 {error conditions} -body { + option foo 3 +} -returnCodes error -result {bad option "foo": must be add, clear, get, or readfile} +test option-14.4 {error conditions} -body { + option add 3 +} -returnCodes error -result {wrong # args: should be "option add pattern value ?priority?"} +test option-14.5 {error conditions} -body { + option add . a b c +} -returnCodes error -result {wrong # args: should be "option add pattern value ?priority?"} +test option-14.6 {error conditions} -body { + option add . a -1 +} -returnCodes error -result {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100} +test option-14.7 {error conditions} -body { + option add . a 101 +} -returnCodes error -result {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100} +test option-14.8 {error conditions} -body { + option add . a gorp +} -returnCodes error -result {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100} +test option-14.9 {error conditions} -body { + option get 3 +} -returnCodes error -result {wrong # args: should be "option get window name class"} +test option-14.10 {error conditions} -body { + option get 3 4 +} -returnCodes error -result {wrong # args: should be "option get window name class"} +test option-14.11 {error conditions} -body { + option get 3 4 5 6 +} -returnCodes error -result {wrong # args: should be "option get window name class"} +test option-14.12 {error conditions} -body { + option get .gorp.gorp a A +} -returnCodes error -result {bad window path name ".gorp.gorp"} + set option1 [file join [testsDirectory] option.file1] -set option2 [file join [testsDirectory] option.file2] +test option-15.1 {database files} -body { + option read non-existent +} -returnCodes error -result {couldn't open "non-existent": no such file or directory} +test option-15.2 {database files} -body { + option read $option1 + option get . x1 color +} -result blue +test option-15.3 {database files} -constraints appNameIsTktest -body { + option read $option1 + option get . x2 color +} -result green +test option-15.4 {database files} -body { + option read $option1 + option get . x3 color +} -result purple +test option-15.5 {database files} -body { + option read $option1 + option get . {x 4} color +} -result brown +test option-15.6 {database files} -body { + option read $option1 + option get . x6 color +} -result {} +test option-15.7 {database files} -body { + option read $option1 + option get . x9 color +} -result " \t\\A\n" +test option-15.8 {database files} -body { + option read $option1 widget foo +} -returnCodes error -result {wrong # args: should be "option readfile fileName ?priority?"} +test option-15.9 {database files} -body { + option add *x3 burgundy + catch {option read $option1 userDefault} + option get . x3 color +} -result burgundy +test option-15.10 {database files} -body { + set option2 [file join [testsDirectory] option.file2] + option read $option2 +} -returnCodes error -result {missing colon on line 2} set option3 [file join [testsDirectory] option.file3] - -test option-15.1 {database files} { - list [catch {option read non-existent} msg] $msg -} {1 {couldn't open "non-existent": no such file or directory}} -option read $option1 -test option-15.2 {database files} {option get . x1 color} blue -test option-15.3 {database files} appNameIsTktest {option get . x2 color} green -test option-15.4 {database files} {option get . x3 color} purple -test option-15.5 {database files} {option get . {x 4} color} brown -test option-15.6 {database files} {option get . x6 color} {} -test option-15.7 {database files} {option get . x9 color} " \t\\A\n" -test option-15.8 {database files} { - list [catch {option read $option1 widget foo} msg] $msg -} {1 {wrong # args: should be "option readfile fileName ?priority?"}} -option add *x3 burgundy -catch {option read $option1 userDefault} -test option-15.9 {database files} {option get . x3 color} burgundy -test option-15.10 {database files} { - list [catch {option read $option2} msg] $msg -} {1 {missing colon on line 2}} option read $option3 test option-15.11 {database files} {option get . {x 4} color} br\xf3wn -test option-16.1 {ReadOptionFile} { +test option-16.1 {ReadOptionFile} -body { set option4 [makeFile {} option.file3] set file [open $option4 w] fconfigure $file -translation crlf puts $file "*x7: true\n*x8: false" close $file option read $option4 userDefault - set result [list [option get . x7 color] [option get . x8 color]] + list [option get . x7 color] [option get . x8 color] +} -cleanup { removeFile $option4 - set result -} {true false} +} -result {true false} -catch {destroy .op1} -catch {destroy .op2} +deleteWindows # cleanup cleanupTests return + + + diff --git a/tests/pack.test b/tests/pack.test index edb9f18..eac1562 100644 --- a/tests/pack.test +++ b/tests/pack.test @@ -6,43 +6,15 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test -# Utility procedures: - -proc pack1 {args} { - pack forget .pack.a .pack.b .pack.c .pack.d - eval pack .pack.a $args - pack .pack.b -expand yes -fill both - update - list [winfo geometry .pack.a] [winfo geometry .pack.b] -} -proc pack2 {args} { - pack forget .pack.a .pack.b .pack.c .pack.d - eval pack .pack.a $args - update - winfo geometry .pack.a -} -proc pack3 {args} { - pack forget .pack.a .pack.b .pack.c .pack.d - pack .pack.a -side top - pack .pack.c -side left - eval pack .pack.b $args - update - winfo geometry .pack.b -} -proc pack4 {option value} { - pack forget .pack.a .pack.b .pack.c .pack.d - pack .pack.a $option $value - set i [pack info .pack.a] - lindex $i [expr [lsearch -exact $i $option]+1] -} # Create some test windows. -catch {destroy .pack} +destroy .pack toplevel .pack wm geom .pack 300x200+0+0 wm minsize .pack 1 1 @@ -57,400 +29,767 @@ foreach i {a b c d} { .pack.c config -width 80 -height 80 .pack.d config -width 40 -height 30 -test pack-1.1 {-side option} { - pack1 -side top -} {20x40+140+0 300x160+0+40} -test pack-1.2 {-side option} { - pack1 -side bottom -} {20x40+140+160 300x160+0+0} -test pack-1.3 {-side option} { - pack1 -side left -} {20x40+0+80 280x200+20+0} -test pack-1.4 {-side option} { - pack1 -side right -} {20x40+280+80 280x200+0+0} +test pack-1.1 {-side option} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+140+0 300x160+0+40} +test pack-1.2 {-side option} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side bottom + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+140+160 300x160+0+0} +test pack-1.3 {-side option} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side left + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+0+80 280x200+20+0} +test pack-1.4 {-side option} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+280+80 280x200+0+0} -test pack-2.1 {x padding and filling} { - pack1 -side right -padx 20 -} {20x40+260+80 240x200+0+0} -test pack-2.1.1 {x padding and filling} { - pack1 -side right -padx {10 30} -} {20x40+250+80 240x200+0+0} -test pack-2.1.2 {x padding and filling} { - pack1 -side right -padx {35 5} -} {20x40+275+80 240x200+0+0} -test pack-2.2 {x padding and filling} { - pack1 -side right -ipadx 20 -} {60x40+240+80 240x200+0+0} -test pack-2.3 {x padding and filling} { - pack1 -side right -ipadx 5 -padx 10 -} {30x40+260+80 250x200+0+0} -test pack-2.4 {x padding and filling} { - pack1 -side right -padx 20 -fill x -} {20x40+260+80 240x200+0+0} -test pack-2.4.1 {x padding and filling} { - pack1 -side right -padx {9 31} -fill x -} {20x40+249+80 240x200+0+0} -test pack-2.5 {x padding and filling} { - pack1 -side right -ipadx 20 -fill x -} {60x40+240+80 240x200+0+0} -test pack-2.6 {x padding and filling} { - pack1 -side right -ipadx 5 -padx 10 -fill x -} {30x40+260+80 250x200+0+0} -test pack-2.6.1 {x padding and filling} { - pack1 -side right -ipadx 5 -padx {5 15} -fill x -} {30x40+255+80 250x200+0+0} -test pack-2.7 {x padding and filling} { - pack1 -side top -padx 20 -} {20x40+140+0 300x160+0+40} -test pack-2.7.1 {x padding and filling} { - pack1 -side top -padx {0 40} -} {20x40+120+0 300x160+0+40} -test pack-2.7.2 {x padding and filling} { - pack1 -side top -padx {31 9} -} {20x40+151+0 300x160+0+40} -test pack-2.8 {x padding and filling} { - pack1 -side top -ipadx 20 -} {60x40+120+0 300x160+0+40} -test pack-2.9 {x padding and filling} { - pack1 -side top -ipadx 5 -padx 10 -} {30x40+135+0 300x160+0+40} -test pack-2.9.1 {x padding and filling} { - pack1 -side top -ipadx 5 -padx {5 15} -} {30x40+130+0 300x160+0+40} -test pack-2.10 {x padding and filling} { - pack1 -side top -padx 20 -fill x -} {260x40+20+0 300x160+0+40} -test pack-2.10.1 {x padding and filling} { - pack1 -side top -padx {25 15} -fill x -} {260x40+25+0 300x160+0+40} -test pack-2.11 {x padding and filling} { - pack1 -side top -ipadx 20 -fill x -} {300x40+0+0 300x160+0+40} -test pack-2.12 {x padding and filling} { - pack1 -side top -ipadx 5 -padx 10 -fill x -} {280x40+10+0 300x160+0+40} -test pack-2.12a {x padding and filling} { - pack1 -side top -ipadx 5 -padx {5 15} -fill x -} {280x40+5+0 300x160+0+40} -set pad [winfo pixels .pack 1c] -test pack-2.13 {x padding and filling} { + +test pack-2.1 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -padx 20 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+260+80 240x200+0+0} +test pack-2.2 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -padx {10 30} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+250+80 240x200+0+0} +test pack-2.3 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -padx {35 5} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+275+80 240x200+0+0} +test pack-2.4 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipadx 20 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {60x40+240+80 240x200+0+0} +test pack-2.5 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipadx 5 -padx 10 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {30x40+260+80 250x200+0+0} +test pack-2.6 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -padx 20 -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+260+80 240x200+0+0} +test pack-2.7 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -padx {9 31} -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+249+80 240x200+0+0} +test pack-2.8 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipadx 20 -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {60x40+240+80 240x200+0+0} +test pack-2.9 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipadx 5 -padx 10 -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {30x40+260+80 250x200+0+0} +test pack-2.10 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipadx 5 -padx {5 15} -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {30x40+255+80 250x200+0+0} +test pack-2.11 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -padx 20 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+140+0 300x160+0+40} +test pack-2.12 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -padx {0 40} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+120+0 300x160+0+40} +test pack-2.13 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -padx {31 9} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+151+0 300x160+0+40} +test pack-2.14 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 20 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {60x40+120+0 300x160+0+40} +test pack-2.15 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {30x40+135+0 300x160+0+40} +test pack-2.16 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx {5 15} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {30x40+130+0 300x160+0+40} +test pack-2.17 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -padx 20 -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {260x40+20+0 300x160+0+40} +test pack-2.18 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -padx {25 15} -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {260x40+25+0 300x160+0+40} +test pack-2.19 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 20 -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {300x40+0+0 300x160+0+40} +test pack-2.20 {x padding and filling} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {280x40+10+0 300x160+0+40} +test pack-2.21 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx {5 15} -fill x + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {280x40+5+0 300x160+0+40} + +test pack-2.22 {x padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -padx 1c set x [pack info .pack.a] - lindex $x [expr [lsearch -exact $x -padx]+1] -} $pad -test pack-2.14 {x padding and filling} { + set res1 [lindex $x [expr [lsearch -exact $x -padx]+1]] + set res2 [winfo pixels .pack 1c] + expr {$res1 eq $res2} +} -result 1 +test pack-2.23 {x padding and filling} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -ipadx 1c set x [pack info .pack.a] - lindex $x [expr [lsearch -exact $x -ipadx]+1] -} $pad + set res1 [lindex $x [expr [lsearch -exact $x -ipadx]+1]] + set res2 [winfo pixels .pack 1c] + expr {$res1 eq $res2} +} -result 1 -test pack-3.1 {y padding and filling} { - pack1 -side right -pady 20 -} {20x40+280+80 280x200+0+0} -test pack-3.1.1 {y padding and filling} { - pack1 -side right -pady {5 35} -} {20x40+280+65 280x200+0+0} -test pack-3.1.2 {y padding and filling} { - pack1 -side right -pady {40 0} -} {20x40+280+100 280x200+0+0} -test pack-3.2 {y padding and filling} { - pack1 -side right -ipady 20 -} {20x80+280+60 280x200+0+0} -test pack-3.3 {y padding and filling} { - pack1 -side right -ipady 5 -pady 10 -} {20x50+280+75 280x200+0+0} -test pack-3.3.1 {y padding and filling} { - pack1 -side right -ipady 5 -pady {5 15} -} {20x50+280+70 280x200+0+0} -test pack-3.4 {y padding and filling} { - pack1 -side right -pady 20 -fill y -} {20x160+280+20 280x200+0+0} -test pack-3.4.1 {y padding and filling} { - pack1 -side right -pady {35 5} -fill y -} {20x160+280+35 280x200+0+0} -test pack-3.5 {y padding and filling} { - pack1 -side right -ipady 20 -fill y -} {20x200+280+0 280x200+0+0} -test pack-3.6 {y padding and filling} { - pack1 -side right -ipady 5 -pady 10 -fill y -} {20x180+280+10 280x200+0+0} -test pack-3.6.1 {y padding and filling} { - pack1 -side right -ipady 5 -pady {0 20} -fill y -} {20x180+280+0 280x200+0+0} -test pack-3.7 {y padding and filling} { - pack1 -side top -pady 20 -} {20x40+140+20 300x120+0+80} -test pack-3.7.1 {y padding and filling} { - pack1 -side top -pady {40 0} -} {20x40+140+40 300x120+0+80} -test pack-3.8 {y padding and filling} { - pack1 -side top -ipady 20 -} {20x80+140+0 300x120+0+80} -test pack-3.9 {y padding and filling} { - pack1 -side top -ipady 5 -pady 10 -} {20x50+140+10 300x130+0+70} -test pack-3.9.1 {y padding and filling} { - pack1 -side top -ipady 5 -pady {3 17} -} {20x50+140+3 300x130+0+70} -test pack-3.10 {y padding and filling} { - pack1 -side top -pady 20 -fill y -} {20x40+140+20 300x120+0+80} -test pack-3.10.1 {y padding and filling} { - pack1 -side top -pady {39 1} -fill y -} {20x40+140+39 300x120+0+80} -test pack-3.11 {y padding and filling} { - pack1 -side top -ipady 20 -fill y -} {20x80+140+0 300x120+0+80} -test pack-3.12 {y padding and filling} { - pack1 -side top -ipady 5 -pady 10 -fill y -} {20x50+140+10 300x130+0+70} -test pack-3.12.1 {y padding and filling} { - pack1 -side top -ipady 5 -pady {1 19} -fill y -} {20x50+140+1 300x130+0+70} -set pad [winfo pixels .pack 1c] -test pack-3.13 {y padding and filling} { + +test pack-3.1 {y padding and filling} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -pady 20 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+280+80 280x200+0+0} +test pack-3.2 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -pady {5 35} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+280+65 280x200+0+0} +test pack-3.3 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -pady {40 0} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+280+100 280x200+0+0} +test pack-3.4 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipady 20 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x80+280+60 280x200+0+0} +test pack-3.5 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipady 5 -pady 10 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x50+280+75 280x200+0+0} +test pack-3.6 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipady 5 -pady {5 15} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x50+280+70 280x200+0+0} +test pack-3.7 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -pady 20 -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x160+280+20 280x200+0+0} +test pack-3.8 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -pady {35 5} -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x160+280+35 280x200+0+0} +test pack-3.9 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipady 20 -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x200+280+0 280x200+0+0} +test pack-3.10 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipady 5 -pady 10 -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x180+280+10 280x200+0+0} +test pack-3.11 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side right -ipady 5 -pady {0 20} -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x180+280+0 280x200+0+0} +test pack-3.12 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -pady 20 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+140+20 300x120+0+80} +test pack-3.13 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -pady {40 0} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+140+40 300x120+0+80} +test pack-3.14 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipady 20 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x80+140+0 300x120+0+80} +test pack-3.15 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipady 5 -pady 10 + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x50+140+10 300x130+0+70} +test pack-3.16 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipady 5 -pady {3 17} + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x50+140+3 300x130+0+70} +test pack-3.17 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -pady 20 -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+140+20 300x120+0+80} +test pack-3.18 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -pady {39 1} -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x40+140+39 300x120+0+80} +test pack-3.19 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipady 20 -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x80+140+0 300x120+0+80} +test pack-3.20 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipady 5 -pady 10 -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x50+140+10 300x130+0+70} +test pack-3.21 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipady 5 -pady {1 19} -fill y + pack .pack.b -expand yes -fill both + update + list [winfo geometry .pack.a] [winfo geometry .pack.b] +} -result {20x50+140+1 300x130+0+70} + +test pack-3.22 {y padding and filling} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -pady 1c set x [pack info .pack.a] - lindex $x [expr [lsearch -exact $x -pady]+1] -} $pad -test pack-3.14 {y padding and filling} { + set res1 [lindex $x [expr [lsearch -exact $x -pady]+1]] + set res2 [winfo pixels .pack 1c] + expr {$res1 eq $res2} +} -result 1 +test pack-3.23 {y padding and filling} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -ipady 1c set x [pack info .pack.a] - lindex $x [expr [lsearch -exact $x -ipady]+1] -} $pad + set res1 [lindex $x [expr [lsearch -exact $x -ipady]+1]] + set res2 [winfo pixels .pack 1c] + expr {$res1 eq $res2} +} -result 1 + + +test pack-4.1 {anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor n + update + winfo geometry .pack.a +} -result {30x70+135+20} +test pack-4.2 {anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor ne + update + winfo geometry .pack.a +} -result {30x70+260+20} +test pack-4.3 {anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor e + update + winfo geometry .pack.a +} -result {30x70+260+65} +test pack-4.4 {anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor se + update + winfo geometry .pack.a +} -result {30x70+260+110} +test pack-4.5 {anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor s + update + winfo geometry .pack.a +} -result {30x70+135+110} +test pack-4.6 {anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor sw + update + winfo geometry .pack.a +} -result {30x70+10+110} +test pack-4.7 {anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor w + update + winfo geometry .pack.a +} -result {30x70+10+65} +test pack-4.8 {anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor nw + update + winfo geometry .pack.a +} -result {30x70+10+20} +test pack-4.9 {anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor center + update + winfo geometry .pack.a +} -result {30x70+135+65} -test pack-4.1 {anchors} { - pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor n -} {30x70+135+20} -test pack-4.2 {anchors} { - pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor ne -} {30x70+260+20} -test pack-4.3 {anchors} { - pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor e -} {30x70+260+65} -test pack-4.4 {anchors} { - pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor se -} {30x70+260+110} -test pack-4.5 {anchors} { - pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor s -} {30x70+135+110} -test pack-4.6 {anchors} { - pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor sw -} {30x70+10+110} -test pack-4.7 {anchors} { - pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor w -} {30x70+10+65} -test pack-4.8 {anchors} { - pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor nw -} {30x70+10+20} -test pack-4.9 {anchors} { - pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor center -} {30x70+135+65} # Repeat above tests, but with a frame that isn't at (0,0), so that # we can be sure that the frame offset is being added in correctly. -test pack-5.1 {more anchors} { - pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor n -} {60x60+160+60} -test pack-5.2 {more anchors} { - pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor ne -} {60x60+230+60} -test pack-5.3 {more anchors} { - pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor e -} {60x60+230+90} -test pack-5.4 {more anchors} { - pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor se -} {60x60+230+120} -test pack-5.5 {more anchors} { - pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor s -} {60x60+160+120} -test pack-5.6 {more anchors} { - pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor sw -} {60x60+90+120} -test pack-5.7 {more anchors} { - pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor w -} {60x60+90+90} -test pack-5.8 {more anchors} { - pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor nw -} {60x60+90+60} -test pack-5.9 {more anchors} { - pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor center -} {60x60+160+90} +test pack-5.1 {more anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.c -side left + pack .pack.b -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor n + update + winfo geometry .pack.b +} -result {60x60+160+60} +test pack-5.2 {more anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.c -side left + pack .pack.b -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor ne + update + winfo geometry .pack.b +} -result {60x60+230+60} +test pack-5.3 {more anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.c -side left + pack .pack.b -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor e + update + winfo geometry .pack.b +} -result {60x60+230+90} +test pack-5.4 {more anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.c -side left + pack .pack.b -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor se + update + winfo geometry .pack.b +} -result {60x60+230+120} +test pack-5.5 {more anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.c -side left + pack .pack.b -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor s + update + winfo geometry .pack.b +} -result {60x60+160+120} +test pack-5.6 {more anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.c -side left + pack .pack.b -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor sw + update + winfo geometry .pack.b +} -result {60x60+90+120} +test pack-5.7 {more anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.c -side left + pack .pack.b -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor w + update + winfo geometry .pack.b +} -result {60x60+90+90} +test pack-5.8 {more anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.c -side left + pack .pack.b -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor nw + update + winfo geometry .pack.b +} -result {60x60+90+60} +test pack-5.9 {more anchors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side top + pack .pack.c -side left + pack .pack.b -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor center + update + winfo geometry .pack.b +} -result {60x60+160+90} + -test pack-6.1 {-expand option} { +test pack-6.1 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side left update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {20x40+0+80 50x30+20+85 80x80+70+60 40x30+150+85} -test pack-6.2 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {20x40+0+80 50x30+20+85 80x80+70+60 40x30+150+85} +test pack-6.2 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side left -expand yes pack .pack.b -side left pack .pack.c .pack.d -side left -expand 1 update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {20x40+18+80 50x30+56+85 80x80+124+60 40x30+241+85} -test pack-6.3 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {20x40+18+80 50x30+56+85 80x80+124+60 40x30+241+85} +test pack-6.3 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side top update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {20x40+140+0 50x30+125+40 80x80+110+70 40x30+130+150} -test pack-6.4 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {20x40+140+0 50x30+125+40 80x80+110+70 40x30+130+150} +test pack-6.4 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side top -expand yes pack .pack.b -side top pack .pack.c .pack.d -side top -expand 1 update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {20x40+140+3 50x30+125+46 80x80+110+79 40x30+130+166} -test pack-6.5 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {20x40+140+3 50x30+125+46 80x80+110+79 40x30+130+166} +test pack-6.5 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side right update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {20x40+280+80 50x30+230+85 80x80+150+60 40x30+110+85} -test pack-6.6 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {20x40+280+80 50x30+230+85 80x80+150+60 40x30+110+85} +test pack-6.6 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side right -expand yes pack .pack.b -side right pack .pack.c .pack.d -side right -expand 1 update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {20x40+262+80 50x30+194+85 80x80+95+60 40x30+18+85} -test pack-6.7 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {20x40+262+80 50x30+194+85 80x80+95+60 40x30+18+85} +test pack-6.7 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side bottom update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {20x40+140+160 50x30+125+130 80x80+110+50 40x30+130+20} -test pack-6.8 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {20x40+140+160 50x30+125+130 80x80+110+50 40x30+130+20} +test pack-6.8 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side bottom -expand yes pack .pack.b -side bottom pack .pack.c .pack.d -side bottom -expand 1 update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {20x40+140+157 50x30+125+124 80x80+110+40 40x30+130+3} -test pack-6.9 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {20x40+140+157 50x30+125+124 80x80+110+40 40x30+130+3} +test pack-6.9 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side bottom -expand yes -fill both pack .pack.b -side right pack .pack.c -side top -expand 1 -fill both pack .pack.d -side left update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {300x65+0+135 50x30+250+52 250x105+0+0 40x30+0+105} -test pack-6.10 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {300x65+0+135 50x30+250+52 250x105+0+0 40x30+0+105} +test pack-6.10 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side left -expand yes -fill both pack .pack.b -side top pack .pack.c -side right -expand 1 -fill both pack .pack.d -side bottom update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {100x200+0+0 50x30+175+0 160x170+140+30 40x30+100+170} -test pack-6.11 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {100x200+0+0 50x30+175+0 160x170+140+30 40x30+100+170} +test pack-6.11 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side left -expand yes -fill both pack .pack.b -side top -expand yes -fill both pack .pack.c -side right -expand 1 -fill both pack .pack.d -side bottom -expand yes -fill both update list [winfo geometry .pack.a] [winfo geometry .pack.b] \ - [winfo geometry .pack.c] [winfo geometry .pack.d] -} {100x200+0+0 200x100+100+0 160x100+140+100 40x100+100+100} -catch {destroy .pack2} -toplevel .pack2 -height 400 -width 400 -wm geometry .pack2 +0+0 -pack propagate .pack2 0 -pack forget .pack2.a .pack2.b .pack2.c .pack2.d -foreach i {w1 w2 w3} { - frame .pack2.$i -width 30 -height 30 -bd 2 -relief raised - label .pack2.$i.l -text $i - place .pack2.$i.l -relwidth 1.0 -relheight 1.0 -} -test pack-6.12 {-expand option} { + [winfo geometry .pack.c] [winfo geometry .pack.d] +} -result {100x200+0+0 200x100+100+0 160x100+140+100 40x100+100+100} + +test pack-6.12 {-expand option} -setup { + toplevel .pack2 -height 400 -width 400 + wm geometry .pack2 +0+0 + pack propagate .pack2 0 + foreach i {w1 w2 w3} { + frame .pack2.$i -width 30 -height 30 -bd 2 -relief raised + label .pack2.$i.l -text $i + place .pack2.$i.l -relwidth 1.0 -relheight 1.0 + } +} -body { pack .pack2.w1 .pack2.w2 .pack2.w3 -padx 5 -ipadx 4 -pady 2 -ipady 6 -expand 1 -side left update list [winfo geometry .pack2.w1] [winfo geometry .pack2.w2] [winfo geometry .pack2.w3] -} {38x42+47+179 38x42+180+179 38x42+314+179} -test pack-6.13 {-expand option} { - pack forget .pack2.w1 .pack2.w2 .pack2.w3 +} -cleanup { + destroy .pack2 +} -result {38x42+47+179 38x42+180+179 38x42+314+179} +test pack-6.13 {-expand option} -setup { + toplevel .pack2 -height 400 -width 400 + wm geometry .pack2 +0+0 + pack propagate .pack2 0 + foreach i {w1 w2 w3} { + frame .pack2.$i -width 30 -height 30 -bd 2 -relief raised + label .pack2.$i.l -text $i + place .pack2.$i.l -relwidth 1.0 -relheight 1.0 + } +} -body { pack .pack2.w1 .pack2.w2 .pack2.w3 -padx 5 -ipadx 4 -pady 2 \ - -ipady 6 -expand 1 -side top + -ipady 6 -expand 1 -side top update list [winfo geometry .pack2.w1] [winfo geometry .pack2.w2] [winfo geometry .pack2.w3] -} {38x42+181+45 38x42+181+178 38x42+181+312} -catch {destroy .pack2} +} -cleanup { + destroy .pack2 +} -result {38x42+181+45 38x42+181+178 38x42+181+312} + wm geometry .pack {} -test pack-7.1 {requesting size for parent} { +test pack-7.1 {requesting size for parent} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side left -padx 5 -pady 10 update list [winfo reqwidth .pack] [winfo reqheight .pack] -} {230 100} -test pack-7.2 {requesting size for parent} { +} -result {230 100} +test pack-7.2 {requesting size for parent} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side top -padx 5 -pady 10 update list [winfo reqwidth .pack] [winfo reqheight .pack] -} {90 260} -test pack-7.3 {requesting size for parent} { +} -result {90 260} +test pack-7.3 {requesting size for parent} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side right -padx 5 -pady 10 update list [winfo reqwidth .pack] [winfo reqheight .pack] -} {230 100} -test pack-7.4 {requesting size for parent} { +} -result {230 100} +test pack-7.4 {requesting size for parent} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side bottom -padx 5 -pady 10 update list [winfo reqwidth .pack] [winfo reqheight .pack] -} {90 260} -test pack-7.5 {requesting size for parent} { +} -result {90 260} +test pack-7.5 {requesting size for parent} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side top -padx 5 -pady 10 pack .pack.b -side right -padx 5 -pady 10 pack .pack.c -side bottom -padx 5 -pady 10 pack .pack.d -side left -padx 5 -pady 10 update list [winfo reqwidth .pack] [winfo reqheight .pack] -} {150 210} -test pack-7.6 {requesting size for parent} { +} -result {150 210} +test pack-7.6 {requesting size for parent} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side top pack .pack.c -side left pack .pack.d -side bottom update list [winfo reqwidth .pack] [winfo reqheight .pack] -} {120 120} -test pack-7.7 {requesting size for parent} { +} -result {120 120} +test pack-7.7 {requesting size for parent} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side right pack .pack.c -side bottom pack .pack.d -side top update list [winfo reqwidth .pack] [winfo reqheight .pack] -} {100 110} +} -result {100 110} # For the tests below, create a couple of "pad" windows to shrink @@ -466,363 +805,496 @@ pack .pack.right -side right pack .pack.bottom -side bottom pack .pack.a .pack.b .pack.c -side top update -test pack-8.1 {insufficient space} { +test pack-8.1 {insufficient space} -body { list [winfo geometry .pack.a] [winfo ismapped .pack.a] \ - [winfo geometry .pack.b] [winfo ismapped .pack.b] \ - [winfo geometry .pack.c] [winfo ismapped .pack.c] -} {20x40+30+0 1 50x30+15+40 1 80x80+0+70 1} + [winfo geometry .pack.b] [winfo ismapped .pack.b] \ + [winfo geometry .pack.c] [winfo ismapped .pack.c] +} -result {20x40+30+0 1 50x30+15+40 1 80x80+0+70 1} wm geom .pack 270x250 update -test pack-8.2 {insufficient space} { +test pack-8.2 {insufficient space} -body { list [winfo geometry .pack.a] [winfo ismapped .pack.a] \ - [winfo geometry .pack.b] [winfo ismapped .pack.b] \ - [winfo geometry .pack.c] [winfo ismapped .pack.c] -} {20x40+25+0 1 50x30+10+40 1 70x30+0+70 1} + [winfo geometry .pack.b] [winfo ismapped .pack.b] \ + [winfo geometry .pack.c] [winfo ismapped .pack.c] +} -result {20x40+25+0 1 50x30+10+40 1 70x30+0+70 1} wm geom .pack 240x220 update -test pack-8.3 {insufficient space} { +test pack-8.3 {insufficient space} -body { list [winfo geometry .pack.a] [winfo ismapped .pack.a] \ - [winfo geometry .pack.b] [winfo ismapped .pack.b] \ - [winfo geometry .pack.c] [winfo ismapped .pack.c] -} {20x40+10+0 1 40x30+0+40 1 70x30+0+70 0} + [winfo geometry .pack.b] [winfo ismapped .pack.b] \ + [winfo geometry .pack.c] [winfo ismapped .pack.c] +} -result {20x40+10+0 1 40x30+0+40 1 70x30+0+70 0} wm geom .pack 350x350 update -test pack-8.4 {insufficient space} { +test pack-8.4 {insufficient space} -body { list [winfo geometry .pack.a] [winfo ismapped .pack.a] \ - [winfo geometry .pack.b] [winfo ismapped .pack.b] \ - [winfo geometry .pack.c] [winfo ismapped .pack.c] -} {20x40+65+0 1 50x30+50+40 1 80x80+35+70 1} + [winfo geometry .pack.b] [winfo ismapped .pack.b] \ + [winfo geometry .pack.c] [winfo ismapped .pack.c] +} -result {20x40+65+0 1 50x30+50+40 1 80x80+35+70 1} wm geom .pack {} pack .pack.a -side left pack .pack.b -side right pack .pack.c -side left update -test pack-8.5 {insufficient space} { +test pack-8.5 {insufficient space} -body { list [winfo geometry .pack.a] [winfo ismapped .pack.a] \ - [winfo geometry .pack.b] [winfo ismapped .pack.b] \ - [winfo geometry .pack.c] [winfo ismapped .pack.c] -} {20x40+0+20 1 50x30+100+25 1 80x80+20+0 1} + [winfo geometry .pack.b] [winfo ismapped .pack.b] \ + [winfo geometry .pack.c] [winfo ismapped .pack.c] +} -result {20x40+0+20 1 50x30+100+25 1 80x80+20+0 1} wm geom .pack 320x180 update -test pack-8.6 {insufficient space} { +test pack-8.6 {insufficient space} -body { list [winfo geometry .pack.a] [winfo ismapped .pack.a] \ - [winfo geometry .pack.b] [winfo ismapped .pack.b] \ - [winfo geometry .pack.c] [winfo ismapped .pack.c] -} {20x30+0+0 1 50x30+70+0 1 50x30+20+0 1} + [winfo geometry .pack.b] [winfo ismapped .pack.b] \ + [winfo geometry .pack.c] [winfo ismapped .pack.c] +} -result {20x30+0+0 1 50x30+70+0 1 50x30+20+0 1} wm geom .pack 250x180 update -test pack-8.7 {insufficient space} { +test pack-8.7 {insufficient space} -body { list [winfo geometry .pack.a] [winfo ismapped .pack.a] \ - [winfo geometry .pack.b] [winfo ismapped .pack.b] \ - [winfo geometry .pack.c] [winfo ismapped .pack.c] -} {20x30+0+0 1 30x30+20+0 1 50x30+20+0 0} + [winfo geometry .pack.b] [winfo ismapped .pack.b] \ + [winfo geometry .pack.c] [winfo ismapped .pack.c] +} -result {20x30+0+0 1 30x30+20+0 1 50x30+20+0 0} pack forget .pack.b update -test pack-8.8 {insufficient space} { +test pack-8.8 {insufficient space} -body { list [winfo geometry .pack.a] [winfo ismapped .pack.a] \ - [winfo geometry .pack.b] [winfo ismapped .pack.b] \ - [winfo geometry .pack.c] [winfo ismapped .pack.c] -} {20x30+0+0 1 30x30+20+0 0 30x30+20+0 1} + [winfo geometry .pack.b] [winfo ismapped .pack.b] \ + [winfo geometry .pack.c] [winfo ismapped .pack.c] +} -result {20x30+0+0 1 30x30+20+0 0 30x30+20+0 1} pack .pack.b -side right -after .pack.a wm geom .pack {} update -test pack-8.9 {insufficient space} { +test pack-8.9 {insufficient space} -body { list [winfo geometry .pack.a] [winfo ismapped .pack.a] \ - [winfo geometry .pack.b] [winfo ismapped .pack.b] \ - [winfo geometry .pack.c] [winfo ismapped .pack.c] -} {20x40+0+20 1 50x30+100+25 1 80x80+20+0 1} + [winfo geometry .pack.b] [winfo ismapped .pack.b] \ + [winfo geometry .pack.c] [winfo ismapped .pack.c] +} -result {20x40+0+20 1 50x30+100+25 1 80x80+20+0 1} pack forget .pack.right .pack.bottom -test pack-9.1 {window ordering} { + +test pack-9.1 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side top pack .pack.a -after .pack.b pack slaves .pack -} {.pack.b .pack.a .pack.c .pack.d} -test pack-9.2 {window ordering} { +} -result {.pack.b .pack.a .pack.c .pack.d} +test pack-9.2 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side top pack .pack.a -after .pack.a pack slaves .pack -} {.pack.a .pack.b .pack.c .pack.d} -test pack-9.3 {window ordering} { +} -result {.pack.a .pack.b .pack.c .pack.d} +test pack-9.3 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side top pack .pack.a -before .pack.d pack slaves .pack -} {.pack.b .pack.c .pack.a .pack.d} -test pack-9.4 {window ordering} { +} -result {.pack.b .pack.c .pack.a .pack.d} +test pack-9.4 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side top pack .pack.d -before .pack.a pack slaves .pack -} {.pack.d .pack.a .pack.b .pack.c} -test pack-9.5 {window ordering} { +} -result {.pack.d .pack.a .pack.b .pack.c} +test pack-9.5 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side top pack propagate .pack.c 0 pack .pack.a -in .pack.c list [pack slaves .pack] [pack slaves .pack.c] -} {{.pack.b .pack.c .pack.d} .pack.a} -test pack-9.6 {window ordering} { +} -result {{.pack.b .pack.c .pack.d} .pack.a} +test pack-9.6 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side top pack .pack.a -in .pack pack slaves .pack -} {.pack.b .pack.c .pack.d .pack.a} -test pack-9.7 {window ordering} { +} -result {.pack.b .pack.c .pack.d .pack.a} +test pack-9.7 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d -side top pack .pack.a -padx 0 pack slaves .pack -} {.pack.a .pack.b .pack.c .pack.d} -test pack-9.8 {window ordering} { +} -result {.pack.a .pack.b .pack.c .pack.d} +test pack-9.8 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c pack .pack.d pack slaves .pack -} {.pack.a .pack.b .pack.c .pack.d} -test pack-9.9 {window ordering} { +} -result {.pack.a .pack.b .pack.c .pack.d} +test pack-9.9 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d pack .pack.b .pack.d .pack.c -before .pack.a pack slaves .pack -} {.pack.b .pack.d .pack.c .pack.a} -test pack-9.10 {window ordering} { +} -result {.pack.b .pack.d .pack.c .pack.a} +test pack-9.10 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d pack .pack.a .pack.c .pack.d .pack.b -after .pack.a pack slaves .pack -} {.pack.a .pack.c .pack.d .pack.b} +} -result {.pack.a .pack.c .pack.d .pack.b} + -test pack-10.1 {retaining/clearing configuration state} { +test pack-10.1 {retaining/clearing configuration state} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side bottom -anchor n -padx 1 -pady 2 -ipadx 3 -ipady 4 \ - -fill both -expand 1 + -fill both -expand 1 pack forget .pack.a pack .pack.a pack info .pack.a -} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} -test pack-10.2 {retaining/clearing configuration state} { +} -result {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} +test pack-10.2 {retaining/clearing configuration state} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a -side bottom -anchor n -padx 1 -pady 2 -ipadx 3 -ipady 4 \ - -fill both -expand 1 + -fill both -expand 1 pack .pack.a -pady 14 pack info .pack.a -} {-in .pack -anchor n -expand 1 -fill both -ipadx 3 -ipady 4 -padx 1 -pady 14 -side bottom} -test pack-10.3 {bad -in window does not change master} { +} -result {-in .pack -anchor n -expand 1 -fill both -ipadx 3 -ipady 4 -padx 1 -pady 14 -side bottom} +test pack-10.3 {bad -in window does not change master} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [winfo manager .pack.a] \ - [catch {pack .pack.a -in .pack.a} err] $err \ - [winfo manager .pack.a] -} {{} 1 {can't pack .pack.a inside itself} {}} +} -body { + set result [list [winfo manager .pack.a]] + catch {pack .pack.a -in .pack.a} + lappend result [winfo manager .pack.a] +} -result {{} {}} +test pack-10.4 {bad -in window does not change master} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + winfo manager .pack.a + pack .pack.a -in .pack.a +} -returnCodes error -result {can't pack .pack.a inside itself} -test pack-11.1 {info option} { - pack4 -in .pack -} .pack -test pack-11.2 {info option} { - pack4 -anchor n -} n -test pack-11.3 {info option} { - pack4 -anchor sw -} sw -test pack-11.4 {info option} { - pack4 -expand yes -} 1 -test pack-11.5 {info option} { - pack4 -expand no -} 0 -test pack-11.6 {info option} { - pack4 -fill x -} x -test pack-11.7 {info option} { - pack4 -fill y -} y -test pack-11.8 {info option} { - pack4 -fill both -} both -test pack-11.9 {info option} { - pack4 -fill none -} none -test pack-11.10 {info option} { - pack4 -ipadx 14 -} 14 -test pack-11.11 {info option} { - pack4 -ipady 22 -} 22 -test pack-11.12 {info option} { - pack4 -padx 2 -} 2 -test pack-11.12.1 {info option} { - pack4 -padx {2 9} -} {2 9} -test pack-11.13 {info option} { - pack4 -pady 3 -} 3 -test pack-11.13.1 {info option} { - pack4 -pady {3 11} -} {3 11} -test pack-11.14 {info option} { - pack4 -side top -} top -test pack-11.15 {info option} { - pack4 -side bottom -} bottom -test pack-11.16 {info option} { - pack4 -side left -} left -test pack-11.17 {info option} { - pack4 -side right -} right -test pack-12.1 {command options and errors} { - list [catch {pack} msg] $msg -} {1 {wrong # args: should be "pack option arg ?arg ...?"}} -test pack-12.2 {command options and errors} { - list [catch {pack foo} msg] $msg -} {1 {wrong # args: should be "pack option arg ?arg ...?"}} -test pack-12.3 {command options and errors} { - list [catch {pack configure x} msg] $msg -} {1 {bad argument "x": must be name of window}} -test pack-12.4 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - pack configure .pack.b .pack.c - pack slaves .pack -} {.pack.b .pack.c} -test pack-12.5 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .foo} msg] $msg -} {1 {bad window path name ".foo"}} -test pack-12.6 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack} msg] $msg -} {1 {can't pack ".pack": it's a top-level window}} -test pack-12.7 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -after .foo} msg] $msg -} {1 {bad window path name ".foo"}} -test pack-12.8 {command options and errors} { +test pack-11.1 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -after .pack.b} msg] $msg -} {1 {window ".pack.b" isn't packed}} -test pack-12.9 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -anchor gorp} msg] $msg -} {1 {bad anchor "gorp": must be n, ne, e, se, s, sw, w, nw, or center}} -test pack-12.10 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -before gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test pack-12.11 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -before .pack.b} msg] $msg -} {1 {window ".pack.b" isn't packed}} -test pack-12.12 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -expand "who cares?"} msg] $msg -} {1 {expected boolean value but got "who cares?"}} -test pack-12.13 {command options and errors} { +} -body { + pack .pack.a -in .pack + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -in]+1] +} -result .pack +test pack-11.2 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -fill z} msg] $msg -} {1 {bad fill style "z": must be none, x, y, or both}} -test pack-12.14 {command options and errors} { +} -body { + pack .pack.a -anchor n + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -anchor]+1] +} -result n +test pack-11.3 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -in z} msg] $msg -} {1 {bad window path name "z"}} -set pad [winfo pixels .pack 1c] -test pack-12.15 {command options and errors} { +} -body { + pack .pack.a -anchor sw + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -anchor]+1] +} -result sw +test pack-11.4 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -padx abc} msg] $msg -} {1 {bad pad value "abc": must be positive screen distance}} -test pack-12.15.1 {command options and errors} { +} -body { + pack .pack.a -expand yes + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -expand]+1] +} -result 1 +test pack-11.5 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -padx {5 abc}} msg] $msg -} {1 {bad 2nd pad value "abc": must be positive screen distance}} -test pack-12.16 {command options and errors} { +} -body { + pack .pack.a -expand no + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -expand]+1] +} -result 0 +test pack-11.6 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -padx -1} msg] $msg -} {1 {bad pad value "-1": must be positive screen distance}} -test pack-12.16.1 {command options and errors} { +} -body { + pack .pack.a -fill x + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -fill]+1] +} -result x +test pack-11.7 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -padx {5 -1}} msg] $msg -} {1 {bad 2nd pad value "-1": must be positive screen distance}} -test pack-12.17 {command options and errors} { +} -body { + pack .pack.a -fill y + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -fill]+1] +} -result y +test pack-11.8 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -pady abc} msg] $msg -} {1 {bad pad value "abc": must be positive screen distance}} -test pack-12.17.1 {command options and errors} { +} -body { + pack .pack.a -fill both + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -fill]+1] +} -result both +test pack-11.9 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -pady {0 abc}} msg] $msg -} {1 {bad 2nd pad value "abc": must be positive screen distance}} -test pack-12.18 {command options and errors} { +} -body { + pack .pack.a -fill none + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -fill]+1] +} -result none +test pack-11.10 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -pady -1} msg] $msg -} {1 {bad pad value "-1": must be positive screen distance}} -test pack-12.18.1 {command options and errors} { +} -body { + pack .pack.a -ipadx 14 + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -ipadx]+1] +} -result 14 +test pack-11.11 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -pady {0 -1}} msg] $msg -} {1 {bad 2nd pad value "-1": must be positive screen distance}} -test pack-12.19 {command options and errors} { +} -body { + pack .pack.a -ipady 22 + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -ipady]+1] +} -result 22 +test pack-11.12 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -ipadx abc} msg] $msg -} {1 {bad ipadx value "abc": must be positive screen distance}} -test pack-12.20 {command options and errors} { +} -body { + pack .pack.a -padx 2 + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -padx]+1] +} -result 2 +test pack-11.13 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -ipadx -1} msg] $msg -} {1 {bad ipadx value "-1": must be positive screen distance}} -test pack-12.20.1 {command options and errors} { +} -body { + pack .pack.a -padx {2 9} + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -padx]+1] +} -result {2 9} +test pack-11.14 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -ipadx {5 5}} msg] $msg -} {1 {bad ipadx value "5 5": must be positive screen distance}} -test pack-12.21 {command options and errors} { +} -body { + pack .pack.a -pady 3 + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -pady]+1] +} -result 3 +test pack-11.15 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -ipady abc} msg] $msg -} {1 {bad ipady value "abc": must be positive screen distance}} -test pack-12.22 {command options and errors} { +} -body { + pack .pack.a -pady {3 11} + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -pady]+1] +} -result {3 11} +test pack-11.16 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -ipady -1} msg] $msg -} {1 {bad ipady value "-1": must be positive screen distance}} -test pack-12.22.1 {command options and errors} { +} -body { + pack .pack.a -side top + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -side]+1] +} -result top +test pack-11.17 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -ipady {5 5}} msg] $msg -} {1 {bad ipady value "5 5": must be positive screen distance}} -test pack-12.23 {command options and errors} { +} -body { + pack .pack.a -side bottom + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -side]+1] +} -result bottom +test pack-11.18 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -side bac} msg] $msg -} {1 {bad side "bac": must be top, bottom, left, or right}} -test pack-12.24 {command options and errors} { +} -body { + pack .pack.a -side left + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -side]+1] +} -result left +test pack-11.19 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -lousy bac} msg] $msg -} {1 {bad option "-lousy": must be -after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, or -side}} -test pack-12.25 {command options and errors} { +} -body { + pack .pack.a -side right + set i [pack info .pack.a] + lindex $i [expr [lsearch -exact $i -side]+1] +} -result right + + +test pack-12.1 {command options and errors} -body { + pack +} -returnCodes error -result {wrong # args: should be "pack option arg ?arg ...?"} +test pack-12.2 {command options and errors} -body { + pack foo +} -returnCodes error -result {wrong # args: should be "pack option arg ?arg ...?"} +test pack-12.3 {command options and errors} -body { + pack configure x +} -returnCodes error -result {bad argument "x": must be name of window} +test pack-12.4 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack configure .pack.b .pack.c + pack slaves .pack +} -result {.pack.b .pack.c} +test pack-12.5 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -padx} msg] $msg -} {1 {extra option "-padx" (option with no value?)}} -test pack-12.26 {command options and errors} { +} -body { + pack .foo +} -returnCodes error -result {bad window path name ".foo"} +test pack-12.6 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a ? 22} msg] $msg -} {1 {bad option "?": must be -after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, or -side}} -test pack-12.27 {command options and errors} { +} -body { + pack .pack +} -returnCodes error -result {can't pack ".pack": it's a top-level window} +test pack-12.7 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -in .} msg] $msg -} {1 {can't pack .pack.a inside .}} -test pack-12.28 {command options and errors} { +} -body { + pack .pack.a -after .foo +} -returnCodes error -result {bad window path name ".foo"} +test pack-12.8 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -after .pack.b +} -returnCodes error -result {window ".pack.b" isn't packed} +test pack-12.9 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -anchor gorp +} -returnCodes error -result {bad anchor "gorp": must be n, ne, e, se, s, sw, w, nw, or center} +test pack-12.10 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -before gorp +} -returnCodes error -result {bad window path name "gorp"} +test pack-12.11 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -before .pack.b +} -returnCodes error -result {window ".pack.b" isn't packed} +test pack-12.12 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -expand "who cares?" +} -returnCodes error -result {expected boolean value but got "who cares?"} +test pack-12.13 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -fill z +} -returnCodes error -result {bad fill style "z": must be none, x, y, or both} +test pack-12.14 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -in z +} -returnCodes error -result {bad window path name "z"} +set pad [winfo pixels .pack 1c] +test pack-12.15 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -padx abc +} -returnCodes error -result {bad pad value "abc": must be positive screen distance} +test pack-12.16 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -padx {5 abc} +} -returnCodes error -result {bad 2nd pad value "abc": must be positive screen distance} +test pack-12.17 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -padx -1 +} -returnCodes error -result {bad pad value "-1": must be positive screen distance} +test pack-12.18 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -padx {5 -1} +} -returnCodes error -result {bad 2nd pad value "-1": must be positive screen distance} +test pack-12.19 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -pady abc +} -returnCodes error -result {bad pad value "abc": must be positive screen distance} +test pack-12.20 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -pady {0 abc} +} -returnCodes error -result {bad 2nd pad value "abc": must be positive screen distance} +test pack-12.21 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -pady -1 +} -returnCodes error -result {bad pad value "-1": must be positive screen distance} +test pack-12.22 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -pady {0 -1} +} -returnCodes error -result {bad 2nd pad value "-1": must be positive screen distance} +test pack-12.23 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -ipadx abc +} -returnCodes error -result {bad ipadx value "abc": must be positive screen distance} +test pack-12.24 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -ipadx -1 +} -returnCodes error -result {bad ipadx value "-1": must be positive screen distance} +test pack-12.25 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -ipadx {5 5} +} -returnCodes error -result {bad ipadx value "5 5": must be positive screen distance} +test pack-12.26 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -ipady abc +} -returnCodes error -result {bad ipady value "abc": must be positive screen distance} +test pack-12.27 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -ipady -1 +} -returnCodes error -result {bad ipady value "-1": must be positive screen distance} +test pack-12.28 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -ipady {5 5} +} -returnCodes error -result {bad ipady value "5 5": must be positive screen distance} +test pack-12.29 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -side bac +} -returnCodes error -result {bad side "bac": must be top, bottom, left, or right} +test pack-12.30 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -lousy bac +} -returnCodes error -result {bad option "-lousy": must be -after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, or -side} +test pack-12.31 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -padx +} -returnCodes error -result {extra option "-padx" (option with no value?)} +test pack-12.32 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a ? 22 +} -returnCodes error -result {bad option "?": must be -after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, or -side} +test pack-12.33 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a -in . +} -returnCodes error -result {can't pack .pack.a inside .} +test pack-12.34 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { frame .pack.a.a - list [catch {pack .pack.a.a -in .pack.b} msg] $msg -} {1 {can't pack .pack.a.a inside .pack.b}} -test pack-12.29 {command options and errors} { + pack .pack.a.a -in .pack.b +} -returnCodes error -result {can't pack .pack.a.a inside .pack.b} +test pack-12.35 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack .pack.a -in .pack.a} msg] $msg -} {1 {can't pack .pack.a inside itself}} -test pack-12.30 {command options and errors} { +} -body { + pack .pack.a -in .pack.a +} -returnCodes error -result {can't pack .pack.a inside itself} +test pack-12.36 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a .pack.b .pack.c .pack.d pack forget .pack.a .pack.d pack slaves .pack -} {.pack.b .pack.c} -test pack-12.31 {command options and errors} { +} -result {.pack.b .pack.c} +test pack-12.37 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { .pack configure -width 300 -height 200 pack propagate .pack 0 pack .pack.a @@ -831,63 +1303,77 @@ test pack-12.31 {command options and errors} { pack propagate .pack 1 update lappend result [winfo reqwidth .pack] [winfo reqheight .pack] - set result -} {300 200 20 40} -test pack-12.32 {command options and errors} { + return $result +} -result {300 200 20 40} +test pack-12.38 {command options and errors} -body { set result [pack propagate .pack.d] pack propagate .pack.d 0 lappend result [pack propagate .pack.d] pack propagate .pack.d 1 lappend result [pack propagate .pack.d] - set result -} {1 0 1} -test pack-12.33 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack propagate .dum} msg] $msg -} {1 {bad window path name ".dum"}} -test pack-12.34 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack propagate .pack foo} msg] $msg -} {1 {expected boolean value but got "foo"}} -test pack-12.35 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack propagate .pack foo bar} msg] $msg -} {1 {wrong # args: should be "pack propagate window ?boolean?"}} -test pack-12.36 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack slaves} msg] $msg -} {1 {wrong # args: should be "pack option arg ?arg ...?"}} -test pack-12.37 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack slaves a b} msg] $msg -} {1 {wrong # args: should be "pack slaves window"}} -test pack-12.38 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack slaves .x} msg] $msg -} {1 {bad window path name ".x"}} -test pack-12.39 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack slaves .pack.a} msg] $msg -} {0 {}} -test pack-12.40 {command options and errors} { - pack forget .pack.a .pack.b .pack.c .pack.d - list [catch {pack lousy .pack} msg] $msg -} {1 {bad option "lousy": must be configure, forget, info, propagate, or slaves}} + return $result +} -result {1 0 1} +test pack-12.39 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack propagate .dum +} -returnCodes error -result {bad window path name ".dum"} +test pack-12.40 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack propagate .pack foo +} -returnCodes error -result {expected boolean value but got "foo"} +test pack-12.41 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack propagate .pack foo bar +} -returnCodes error -result {wrong # args: should be "pack propagate window ?boolean?"} +test pack-12.42 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack slaves +} -returnCodes error -result {wrong # args: should be "pack option arg ?arg ...?"} +test pack-12.43 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack slaves a b +} -returnCodes error -result {wrong # args: should be "pack slaves window"} +test pack-12.44 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack slaves .x +} -returnCodes error -result {bad window path name ".x"} +test pack-12.45 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack slaves .pack.a +} -returnCodes ok -result {} +test pack-12.46 {command options and errors} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack lousy .pack +} -returnCodes error -result {bad option "lousy": must be configure, forget, info, propagate, or slaves} -pack .pack.right -side right -pack .pack.bottom -side bottom -test pack-13.1 {window deletion} { - pack forget .pack.a .pack.b .pack.c .pack.d + +test pack-13.1 {window deletion} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d .pack.right .pack.bottom +} -body { + pack .pack.right -side right + pack .pack.bottom -side bottom pack .pack.a .pack.d .pack.b .pack.c -side top update destroy .pack.d update set result [list [pack slaves .pack] [winfo geometry .pack.a] \ - [winfo geometry .pack.b] [winfo geometry .pack.c]] -} {{.pack.right .pack.bottom .pack.a .pack.b .pack.c} 20x40+30+0 50x30+15+40 80x80+0+70} + [winfo geometry .pack.b] [winfo geometry .pack.c]] +} -result {{.pack.right .pack.bottom .pack.a .pack.b .pack.c} 20x40+30+0 50x30+15+40 80x80+0+70} -test pack-14.1 {respond to changes in expansion} { - pack forget .pack.a .pack.b .pack.c .pack.d + +test pack-14.1 {respond to changes in expansion} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d .pack.right .pack.bottom +} -body { + pack .pack.right -side right + pack .pack.bottom -side bottom wm geom .pack {} pack .pack.a update @@ -898,11 +1384,15 @@ test pack-14.1 {respond to changes in expansion} { pack .pack.a -expand true -fill both update lappend result [winfo geom .pack.a] -} {20x40+0+0 20x40+90+0 200x150+0+0} -wm geom .pack {} +} -cleanup { + wm geom .pack {} +} -result {20x40+0+0 20x40+90+0 200x150+0+0} -test pack-15.1 {managing geometry with -in option} { + +test pack-15.1 {managing geometry with -in option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d + destroy .pack.f +} -body { pack .pack.a -side top frame .pack.f lower .pack.f @@ -916,10 +1406,13 @@ test pack-15.1 {managing geometry with -in option} { pack unpack .pack.a update lappend result [winfo geom .pack.b] -} {50x30+0+40 50x30+0+0} -catch {destroy .pack.f} -test pack-15.2 {managing geometry with -in option} { +} -cleanup { + destroy .pack.f +} -result {50x30+0+40 50x30+0+0} +test pack-15.2 {managing geometry with -in option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d + destroy .pack.f +} -body { frame .pack.f lower .pack.f pack .pack.a -in .pack.f -side top @@ -931,10 +1424,13 @@ test pack-15.2 {managing geometry with -in option} { place forget .pack.f update lappend result [winfo ismapped .pack.a] -} {0 1 20x40+30+45 0} -catch {destroy .pack.f} -test pack-15.3 {managing geometry with -in option} { +} -cleanup { + destroy .pack.f +} -result {0 1 20x40+30+45 0} +test pack-15.3 {managing geometry with -in option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d + destroy .pack.f +} -body { pack .pack.a -side top frame .pack.f lower .pack.f @@ -948,15 +1444,18 @@ test pack-15.3 {managing geometry with -in option} { pack unpack .pack.f update lappend result [winfo ismapped .pack.b] -} {1 0} -catch {destroy .pack.f} -test pack-15.4 {managing geometry with -in option} { +} -cleanup { + destroy .pack.f +} -result {1 0} +test pack-15.4 {managing geometry with -in option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d + destroy .pack.f1 .pack.f2 +} -body { foreach i {1 2} { - frame .pack.f$i -width 100 -height 40 -bd 2 -relief raised - lower .pack.f$i - pack propagate .pack.f$i 0 - pack .pack.f$i -side top + frame .pack.f$i -width 100 -height 40 -bd 2 -relief raised + lower .pack.f$i + pack propagate .pack.f$i 0 + pack .pack.f$i -side top } pack .pack.b -in .pack.f1 -side right update @@ -971,15 +1470,18 @@ test pack-15.4 {managing geometry with -in option} { pack forget .pack.b update lappend result [winfo geometry .pack.b] [winfo ismapped .pack.b] -} {50x30+48+5 1 50x30+25+48 1 50x30+25+28 1 50x30+25+28 0} -catch {destroy .pack.f1 .pack.f2} -test pack-15.5 {managing geometry with -in option} { +} -cleanup { + destroy .pack.f1 .pack.f2 +} -result {50x30+48+5 1 50x30+25+48 1 50x30+25+28 1 50x30+25+28 0} +test pack-15.5 {managing geometry with -in option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d + destroy .pack.f1 .pack.f2 +} -body { foreach i {1 2} { - frame .pack.f$i -width 100 -height 20 -bd 2 -relief raised - lower .pack.f$i - pack propagate .pack.f$i 0 - pack .pack.f$i -side top + frame .pack.f$i -width 100 -height 20 -bd 2 -relief raised + lower .pack.f$i + pack propagate .pack.f$i 0 + pack .pack.f$i -side top } pack .pack.b -in .pack.f2 -side top update @@ -988,30 +1490,50 @@ test pack-15.5 {managing geometry with -in option} { pack .pack.a -before .pack.b -side top update lappend result [winfo geometry .pack.b] [winfo ismapped .pack.b] -} {50x16+25+22 1 50x16+25+22 0} -catch {destroy .pack.f1 .pack.f2} +} -cleanup { + destroy .pack.f1 .pack.f2 +} -result {50x16+25+22 1 50x16+25+22 0} + -test pack-16.1 {geometry manager name} { +test pack-16.1 {geometry manager name} -setup { pack forget .pack.a .pack.b .pack.c .pack.d set result {} +} -body { lappend result [winfo manager .pack.a] pack .pack.a lappend result [winfo manager .pack.a] pack forget .pack.a lappend result [winfo manager .pack.a] -} {{} pack {}} +} -result {{} pack {}} + -test pack-17.1 {PackLostSlaveProc procedure} { +test pack-17.1 {PackLostSlaveProc procedure} -setup { pack forget .pack.a .pack.b .pack.c .pack.d +} -body { pack .pack.a update place .pack.a -x 40 -y 10 update - list [winfo manager .pack.a] [winfo geometry .pack.a] \ - [catch {pack info .pack.a} msg] $msg -} {place 20x40+40+10 1 {window ".pack.a" isn't packed}} + list [winfo manager .pack.a] [winfo geometry .pack.a] +} -result {place 20x40+40+10} +test pack-17.2 {PackLostSlaveProc procedure} -setup { + pack forget .pack.a .pack.b .pack.c .pack.d +} -body { + pack .pack.a + update + place .pack.a -x 40 -y 10 + update + winfo manager .pack.a + winfo geometry .pack.a + pack info .pack.a +} -returnCodes error -result {window ".pack.a" isn't packed} + -test pack-18.1 {unmap slaves when master unmapped} {tempNotPc} { +test pack-18.1 {unmap slaves when master unmapped} -constraints { + tempNotPc +} -setup { + eval destroy [winfo child .pack] +} -body { # adjust the position of .pack before test to avoid a screen switch # that occurs with window managers that have desktops four times as big @@ -1034,19 +1556,20 @@ test pack-18.1 {unmap slaves when master unmapped} {tempNotPc} { .pack.a configure -width 200 -height 75 update lappend result [winfo width .pack.a ] [winfo height .pack.a] \ - [winfo ismapped .pack.a] + [winfo ismapped .pack.a] wm deiconify .pack update lappend result [winfo ismapped .pack.a] -} {1 0 200 75 0 1} -test pack-18.2 {unmap slaves when master unmapped} { +} -result {1 0 200 75 0 1} +test pack-18.2 {unmap slaves when master unmapped} -setup { + eval destroy [winfo child .pack] +} -body { # adjust the position of .pack before test to avoid a screen switch # that occurs with window managers that have desktops four times as big # as the screen (screen switch causes scale and other tests to fail). wm geometry .pack +100+100 - eval destroy [winfo child .pack] frame .pack.a -relief raised -bd 2 frame .pack.b -width 70 -height 30 -relief sunken -bd 2 pack .pack.a @@ -1059,15 +1582,17 @@ test pack-18.2 {unmap slaves when master unmapped} { .pack.b configure -width 100 -height 30 update lappend result [winfo width .pack.b ] [winfo height .pack.b] \ - [winfo ismapped .pack.b] + [winfo ismapped .pack.b] wm deiconify .pack update lappend result [winfo ismapped .pack.b] -} {1 0 100 30 0 1} +} -result {1 0 100 30 0 1} + -test pack-19.1 {test respect for internalborder} { +test pack-19.1 {test respect for internalborder} -setup { catch {eval pack forget [pack slaves .pack]} destroy .pack.l .pack.lf +} -body { wm geometry .pack 200x200 frame .pack.l -width 15 -height 10 labelframe .pack.lf -labelwidget .pack.l @@ -1079,12 +1604,13 @@ test pack-19.1 {test respect for internalborder} { .pack.lf configure -labelanchor e -padx 3 -pady 5 update lappend res [winfo geometry .pack.lf.f] +} -cleanup { destroy .pack.l .pack.lf - set res -} {196x188+2+10 177x186+5+7} -test pack-19.2 {test support for minreqsize} { +} -result {196x188+2+10 177x186+5+7} +test pack-19.2 {test support for minreqsize} -setup { catch {eval pack forget [pack slaves .pack]} destroy .pack.l .pack.lf +} -body { wm geometry .pack {} frame .pack.l -width 150 -height 100 labelframe .pack.lf -labelwidget .pack.l @@ -1096,15 +1622,14 @@ test pack-19.2 {test support for minreqsize} { .pack.lf configure -labelanchor ws update lappend res [winfo geometry .pack.lf] +} -cleanup { destroy .pack.l .pack.lf - set res -} {162x127+0+0 172x112+0+0} +} -result {162x127+0+0 172x112+0+0} -destroy .pack -foreach i {pack1 pack2 pack3 pack4} { - rename $i {} -} # cleanup cleanupTests return + + + diff --git a/tests/packgrid.test b/tests/packgrid.test new file mode 100644 index 0000000..355b49d --- /dev/null +++ b/tests/packgrid.test @@ -0,0 +1,250 @@ +# This file is a Tcl script to test out interaction between Tk's "pack" and +# "grid" commands. +# It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 2008 Peter Spjuth +# All rights reserved. + +package require tcltest 2.2 +eval tcltest::configure $argv +tcltest::loadTestedCommands +namespace import -force tcltest::* + +test packgrid-1.1 {pack and grid in same master} -setup { + grid propagate . true + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Basic conflict + grid .g + pack .p +} -returnCodes error -cleanup { + destroy .p + destroy .g +} -result {cannot use geometry manager pack inside . which already has slaves managed by grid} + +test packgrid-1.2 {pack and grid in same master} -setup { + grid propagate . true + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Basic conflict + pack .p + grid .g +} -returnCodes error -cleanup { + destroy .p + destroy .g +} -result {cannot use geometry manager grid inside . which already has slaves managed by pack} + +test packgrid-1.3 {pack and grid in same master} -setup { + grid propagate . false + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Ok if one is non-propagating + grid .g + pack .p +} -cleanup { + destroy .p + destroy .g +} -result {} + +test packgrid-1.4 {pack and grid in same master} -setup { + grid propagate . false + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Ok if one is non-propagating + pack .p + grid .g +} -cleanup { + destroy .p + destroy .g +} -result {} + +test packgrid-1.5 {pack and grid in same master} -setup { + grid propagate . true + pack propagate . false + label .p -text PACK + label .g -text GRID +} -body { + # Ok if one is non-propagating + grid .g + pack .p +} -cleanup { + destroy .p + destroy .g +} -result {} + +test packgrid-1.6 {pack and grid in same master} -setup { + grid propagate . true + pack propagate . false + label .p -text PACK + label .g -text GRID +} -body { + # Ok if one is non-propagating + pack .p + grid .g +} -cleanup { + destroy .p + destroy .g +} -result {} + +test packgrid-1.7 {pack and grid in same master} -setup { + grid propagate . true + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Basic conflict should stop widget from being handled + grid .g + catch { pack .p } + pack slaves . +} -cleanup { + destroy .p + destroy .g +} -result {} + +test packgrid-1.8 {pack and grid in same master} -setup { + grid propagate . true + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Basic conflict should stop widget from being handled + pack .p + catch { grid .g } + grid slaves . +} -cleanup { + destroy .p + destroy .g +} -result {} + +test packgrid-2.1 {pack and grid in same master, change propagation} -setup { + grid propagate . false + pack propagate . true + label .p -text PACK + label .g -text GRID + pack .p + grid .g + update +} -body { + grid propagate . true +} -returnCodes error -cleanup { + destroy .p + destroy .g +} -result {cannot use geometry manager grid inside . which already has slaves managed by pack} + +test packgrid-2.2 {pack and grid in same master, change propagation} -setup { + grid propagate . true + pack propagate . false + label .p -text PACK + label .g -text GRID + pack .p + grid .g + update +} -body { + pack propagate . true +} -returnCodes error -cleanup { + destroy .p + update + destroy .g +} -result {cannot use geometry manager pack inside . which already has slaves managed by grid} + +test packgrid-2.3 {pack and grid in same master, change propagation} -setup { + grid propagate . false + pack propagate . false + label .p -text PACK + label .g -text GRID + pack .p + grid .g + update +} -body { + grid propagate . true + update + pack propagate . true +} -returnCodes error -cleanup { + destroy .p + destroy .g +} -result {cannot use geometry manager pack inside . which already has slaves managed by grid} + +test packgrid-2.4 {pack and grid in same master, change propagation} -setup { + grid propagate . false + pack propagate . false + label .p -text PACK + label .g -text GRID + pack .p + grid .g + update +} -body { + pack propagate . true + grid propagate . true +} -returnCodes error -cleanup { + destroy .p + destroy .g +} -result {cannot use geometry manager grid inside . which already has slaves managed by pack} + +test packgrid-3.1 {stealing slave} -setup { + grid propagate . true + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Ok to steal if the other one is emptied + grid .g + pack .g +} -cleanup { + destroy .p + destroy .g +} -result {} + +test packgrid-3.2 {stealing slave} -setup { + grid propagate . true + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Ok to steal if the other one is emptied + pack .g + grid .g +} -cleanup { + destroy .p + destroy .g +} -result {} + +test packgrid-3.3 {stealing slave} -setup { + grid propagate . true + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Not ok to steal if the other one is not emptied + grid .g + grid .p + pack .g +} -returnCodes error -cleanup { + destroy .p + destroy .g +} -result {cannot use geometry manager pack inside . which already has slaves managed by grid} + +test packgrid-3.4 {stealing slave} -setup { + grid propagate . true + pack propagate . true + label .p -text PACK + label .g -text GRID +} -body { + # Not ok to steal if the other one is not emptied + pack .g + pack .p + grid .g +} -returnCodes error -cleanup { + destroy .p + destroy .g +} -result {cannot use geometry manager grid inside . which already has slaves managed by pack} + +cleanupTests +return diff --git a/tests/panedwindow.test b/tests/panedwindow.test index b075e18..666ed9c 100644 --- a/tests/panedwindow.test +++ b/tests/panedwindow.test @@ -6,130 +6,339 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test -set i 1 +deleteWindows +# Panedwindow for tests 1.* panedwindow .p -foreach {testName testData} { - panedwindow-1.1 {-background - "#ff0000" "#ff0000" non-existent {unknown color name "non-existent"}} - panedwindow-1.2 {-bd - 4 4 badValue {bad screen distance "badValue"}} - panedwindow-1.3 {-bg - "#ff0000" "#ff0000" non-existent {unknown color name "non-existent"}} - panedwindow-1.4 {-borderwidth - 1.3 1 badValue {bad screen distance "badValue"}} - panedwindow-1.5 {-cursor - arrow arrow badValue {bad cursor spec "badValue"}} - panedwindow-1.6 {-handlesize - 20 20 badValue {bad screen distance "badValue"}} - panedwindow-1.7 {-height - 20 20 badValue {bad screen distance "badValue"}} - panedwindow-1.8 {-opaqueresize - true 1 foo {expected boolean value but got "foo"}} - panedwindow-1.9 {-proxybackground - "#f0a0a0" "#f0a0a0" non-existent {unknown color name "non-existent"}} - panedwindow-1.10 {-proxyborderwidth - 1.3 1.3 badValue {bad screen distance "badValue"}} - panedwindow-1.11 {-proxyrelief - groove groove - 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - panedwindow-1.12 {-orient - horizontal horizontal - badValue {bad orient "badValue": must be horizontal or vertical}} - panedwindow-1.13 {-relief - groove groove - 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - panedwindow-1.14 {-sashcursor - arrow arrow badValue {bad cursor spec "badValue"}} - panedwindow-1.15 {-sashpad - 1.3 1 badValue {bad screen distance "badValue"}} - panedwindow-1.16 {-sashrelief - groove groove - 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - panedwindow-1.17 {-sashwidth - 10 10 badValue {bad screen distance "badValue"}} - panedwindow-1.18 {-showhandle - true 1 foo {expected boolean value but got "foo"}} - panedwindow-1.19 {-width - 402 402 badValue {bad screen distance "badValue"}} -} { - lassign $testData optionName goodIn goodOut badIn badOut - test ${testName}(good) "configuration options: $optionName" { - .p configure $optionName $goodIn - list [lindex [.p configure $optionName] 4] [.p cget $optionName] - } [list $goodOut $goodOut] - test ${testName}(bad) "configuration options: $optionName" -body { - .p configure $optionName $badIn - } -returnCodes error -result $badOut - # Reset to default - .p configure $optionName [lindex [.p configure $optionName] 3] -} +# Buttons for tests 1.33 - 1.52 .p add [button .b] .p add [button .c] -foreach {testName testData} { - panedwindow-1a.1 {-after .c .c badValue {bad window path name "badValue"}} - panedwindow-1a.2 {-before .c .c badValue {bad window path name "badValue"}} - panedwindow-1a.3 {-height 10 10 badValue {bad screen distance "badValue"}} - panedwindow-1a.4 {-hide false 0 foo {expected boolean value but got "foo"}} - panedwindow-1a.5 {-minsize 10 10 badValue {bad screen distance "badValue"}} - panedwindow-1a.6 {-padx 1.3 1 badValue {bad screen distance "badValue"}} - panedwindow-1a.7 {-pady 1.3 1 badValue {bad screen distance "badValue"}} - panedwindow-1a.8 {-sticky nsew nesw abcd {bad stickyness value "abcd": must be a string containing zero or more of n, e, s, and w}} - panedwindow-1a.9 {-stretch alw always foo {bad stretch "foo": must be always, first, last, middle, or never}} - panedwindow-1a.10 {-width 10 10 badValue {bad screen distance "badValue"}} -} { - lassign $testData optionName goodIn goodOut badIn badOut - test ${testName}(good) "configuration options: $optionName" { - .p paneconfigure .b $optionName $goodIn - list [lindex [.p paneconfigure .b $optionName] 4] \ - [.p panecget .b $optionName] - } [list $goodOut $goodOut] - test ${testName}(bad) "configuration options: $optionName" -body { - .p paneconfigure .b $optionName $badIn - } -returnCodes error -result $badOut - # Reset to default - .p paneconfig .b $optionName [lindex [.p paneconfig .b $optionName] 3] -} -destroy .p .b .c - -test panedwindow-2.1 {panedwindow widget command} { - panedwindow .p - set result [list [catch {.p foo} msg] $msg] - destroy .p - set result -} {1 {bad command "foo": must be add, cget, configure, forget, identify, panecget, paneconfigure, panes, proxy, or sash}} +test panedwindow-1.1 {configuration options: -background (good)} -body { + .p configure -background #ff0000 + list [lindex [.p configure -background] 4] [.p cget -background] +} -cleanup { + .p configure -background [lindex [.p configure -background] 3] +} -result {{#ff0000} #ff0000} +test panedwindow-1.2 {configuration options: -background (bad)} -body { + .p configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test panedwindow-1.3 {configuration options: -bd (good)} -body { + .p configure -bd 4 + list [lindex [.p configure -bd] 4] [.p cget -bd] +} -cleanup { + .p configure -bd [lindex [.p configure -bd] 3] +} -result {4 4} +test panedwindow-1.4 {configuration options: -bd (bad)} -body { + .p configure -bd badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.5 {configuration options: -bg (good)} -body { + .p configure -bg #ff0000 + list [lindex [.p configure -bg] 4] [.p cget -bg] +} -cleanup { + .p configure -bg [lindex [.p configure -bg] 3] +} -result {{#ff0000} #ff0000} +test panedwindow-1.6 {configuration options: -bg (bad)} -body { + .p configure -bg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test panedwindow-1.7 {configuration options: -borderwidth (good)} -body { + .p configure -borderwidth 1.3 + list [lindex [.p configure -borderwidth] 4] [.p cget -borderwidth] +} -cleanup { + .p configure -borderwidth [lindex [.p configure -borderwidth] 3] +} -result {1 1} +test panedwindow-1.8 {configuration options: -borderwidth (bad)} -body { + .p configure -borderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.9 {configuration options: -cursor (good)} -body { + .p configure -cursor arrow + list [lindex [.p configure -cursor] 4] [.p cget -cursor] +} -cleanup { + .p configure -cursor [lindex [.p configure -cursor] 3] +} -result {arrow arrow} +test panedwindow-1.10 {configuration options: -cursor (bad)} -body { + .p configure -cursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} +test panedwindow-1.11 {configuration options: -handlesize (good)} -body { + .p configure -handlesize 20 + list [lindex [.p configure -handlesize] 4] [.p cget -handlesize] +} -cleanup { + .p configure -handlesize [lindex [.p configure -handlesize] 3] +} -result {20 20} +test panedwindow-1.12 {configuration options: -handlesize (bad)} -body { + .p configure -handlesize badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.13 {configuration options: -height (good)} -body { + .p configure -height 20 + list [lindex [.p configure -height] 4] [.p cget -height] +} -cleanup { + .p configure -height [lindex [.p configure -height] 3] +} -result {20 20} +test panedwindow-1.14 {configuration options: -height (bad)} -body { + .p configure -height badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.15 {configuration options: -opaqueresize (good)} -body { + .p configure -opaqueresize true + list [lindex [.p configure -opaqueresize] 4] [.p cget -opaqueresize] +} -cleanup { + .p configure -opaqueresize [lindex [.p configure -opaqueresize] 3] +} -result {1 1} +test panedwindow-1.16 {configuration options: -opaqueresize (bad)} -body { + .p configure -opaqueresize foo +} -returnCodes error -result {expected boolean value but got "foo"} +test panedwindow-1.17 {configuration options: -orient (good)} -body { + .p configure -orient horizontal + list [lindex [.p configure -orient] 4] [.p cget -orient] +} -cleanup { + .p configure -orient [lindex [.p configure -orient] 3] +} -result {horizontal horizontal} +test panedwindow-1.18 {configuration options: -orient (bad)} -body { + .p configure -orient badValue +} -returnCodes error -result {bad orient "badValue": must be horizontal or vertical} +test panedwindow-1.19 {configuration options: -proxybackground (good)} -body { + .p configure -proxybackground "#f0a0a0" + list [lindex [.p configure -proxybackground] 4] [.p cget -proxybackground] +} -cleanup { + .p configure -proxybackground [lindex [.p configure -proxybackground] 3] +} -result {{#f0a0a0} #f0a0a0} +test panedwindow-1.20 {configuration options: -proxybackground (bad)} -body { + .p configure -proxybackground badValue +} -returnCodes error -result {unknown color name "badValue"} +test panedwindow-1.21 {configuration options: -proxyborderwidth (good)} -body { + .p configure -proxyborderwidth 1.3 + list [lindex [.p configure -proxyborderwidth] 4] [.p cget -proxyborderwidth] +} -cleanup { + .p configure -proxyborderwidth [lindex [.p configure -proxyborderwidth] 3] +} -result {1.3 1.3} +test panedwindow-1.22 {configuration options: -proxyborderwidth (bad)} -body { + .p configure -proxyborderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.23 {configuration options: -proxyrelief (good)} -body { + .p configure -proxyrelief groove + list [lindex [.p configure -proxyrelief] 4] [.p cget -proxyrelief] +} -cleanup { + .p configure -proxyrelief [lindex [.p configure -proxyrelief] 3] +} -result {groove groove} +test panedwindow-1.24 {configuration options: -proxyrelief (bad)} -body { + .p configure -proxyrelief 1.5 +} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test panedwindow-1.25 {configuration options: -relief (good)} -body { + .p configure -relief groove + list [lindex [.p configure -relief] 4] [.p cget -relief] +} -cleanup { + .p configure -relief [lindex [.p configure -relief] 3] +} -result {groove groove} +test panedwindow-1.26 {configuration options: -relief (bad)} -body { + .p configure -relief 1.5 +} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test panedwindow-1.27 {configuration options: -sashcursor (good)} -body { + .p configure -sashcursor arrow + list [lindex [.p configure -sashcursor] 4] [.p cget -sashcursor] +} -cleanup { + .p configure -sashcursor [lindex [.p configure -sashcursor] 3] +} -result {arrow arrow} +test panedwindow-1.28 {configuration options: -sashcursor (bad)} -body { + .p configure -sashcursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} +test panedwindow-1.29 {configuration options: -sashpad (good)} -body { + .p configure -sashpad 1.3 + list [lindex [.p configure -sashpad] 4] [.p cget -sashpad] +} -cleanup { + .p configure -sashpad [lindex [.p configure -sashpad] 3] +} -result {1 1} +test panedwindow-1.30 {configuration options: -sashpad (bad)} -body { + .p configure -sashpad badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.31 {configuration options: -sashrelief (good)} -body { + .p configure -sashrelief groove + list [lindex [.p configure -sashrelief] 4] [.p cget -sashrelief] +} -cleanup { + .p configure -sashrelief [lindex [.p configure -sashrelief] 3] +} -result {groove groove} +test panedwindow-1.32 {configuration options: -sashrelief (bad)} -body { + .p configure -sashrelief 1.5 +} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +test panedwindow-1.33 {configuration options: -sashwidth (good)} -body { + .p configure -sashwidth 10 + list [lindex [.p configure -sashwidth] 4] [.p cget -sashwidth] +} -cleanup { + .p configure -sashwidth [lindex [.p configure -sashwidth] 3] +} -result {10 10} +test panedwindow-1.34 {configuration options: -sashwidth (bad)} -body { + .p configure -sashwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.35 {configuration options: -showhandle (good)} -body { + .p configure -showhandle true + list [lindex [.p configure -showhandle] 4] [.p cget -showhandle] +} -cleanup { + .p configure -showhandle [lindex [.p configure -showhandle] 3] +} -result {1 1} +test panedwindow-1.36 {configuration options: -showhandle (bad)} -body { + .p configure -showhandle foo +} -returnCodes error -result {expected boolean value but got "foo"} +test panedwindow-1.37 {configuration options: -width (good)} -body { + .p configure -width 402 + list [lindex [.p configure -width] 4] [.p cget -width] +} -cleanup { + .p configure -width [lindex [.p configure -width] 3] +} -result {402 402} +test panedwindow-1.38 {configuration options: -width (bad)} -body { + .p configure -width badValue +} -returnCodes error -result {bad screen distance "badValue"} + +test panedwindow-1.39 {configuration options: -after (good)} -body { + .p paneconfigure .b -after .c + list [lindex [.p paneconfigure .b -after] 4] \ + [.p panecget .b -after] +} -cleanup { + .p paneconfig .b -after [lindex [.p paneconfig .b -after] 3] +} -result {.c .c} +test panedwindow-1.40 {configuration options: -after (bad)} -body { + .p paneconfigure .b -after badValue +} -returnCodes error -result {bad window path name "badValue"} +test panedwindow-1.41 {configuration options: -before (good)} -body { + .p paneconfigure .b -before .c + list [lindex [.p paneconfigure .b -before] 4] \ + [.p panecget .b -before] +} -cleanup { + .p paneconfig .b -before [lindex [.p paneconfig .b -before] 3] +} -result {.c .c} +test panedwindow-1.42 {configuration options: -before (bad)} -body { + .p paneconfigure .b -before badValue +} -returnCodes error -result {bad window path name "badValue"} +test panedwindow-1.43 {configuration options: -height (good)} -body { + .p paneconfigure .b -height 10 + list [lindex [.p paneconfigure .b -height] 4] \ + [.p panecget .b -height] +} -cleanup { + .p paneconfig .b -height [lindex [.p paneconfig .b -height] 3] +} -result {10 10} +test panedwindow-1.44 {configuration options: -height (bad)} -body { + .p paneconfigure .b -height badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.45 {configuration options: -hide (good)} -body { + .p paneconfigure .b -hide false + list [lindex [.p paneconfigure .b -hide] 4] \ + [.p panecget .b -hide] +} -cleanup { + .p paneconfig .b -hide [lindex [.p paneconfig .b -hide] 3] +} -result {0 0} +test panedwindow-1.46 {configuration options: -hide (bad)} -body { + .p paneconfigure .b -hide foo +} -returnCodes error -result {expected boolean value but got "foo"} +test panedwindow-1.47 {configuration options: -minsize (good)} -body { + .p paneconfigure .b -minsize 10 + list [lindex [.p paneconfigure .b -minsize] 4] \ + [.p panecget .b -minsize] +} -cleanup { + .p paneconfig .b -minsize [lindex [.p paneconfig .b -minsize] 3] +} -result {10 10} +test panedwindow-1.48 {configuration options: -minsize (bad)} -body { + .p paneconfigure .b -minsize badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.49 {configuration options: -padx (good)} -body { + .p paneconfigure .b -padx 1.3 + list [lindex [.p paneconfigure .b -padx] 4] \ + [.p panecget .b -padx] +} -cleanup { + .p paneconfig .b -padx [lindex [.p paneconfig .b -padx] 3] +} -result {1 1} +test panedwindow-1.50 {configuration options: -padx (bad)} -body { + .p paneconfigure .b -padx badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.51 {configuration options: -pady (good)} -body { + .p paneconfigure .b -pady 1.3 + list [lindex [.p paneconfigure .b -pady] 4] \ + [.p panecget .b -pady] +} -cleanup { + .p paneconfig .b -pady [lindex [.p paneconfig .b -pady] 3] +} -result {1 1} +test panedwindow-1.52 {configuration options: -pady (bad)} -body { + .p paneconfigure .b -pady badValue +} -returnCodes error -result {bad screen distance "badValue"} +test panedwindow-1.53 {configuration options: -sticky (good)} -body { + .p paneconfigure .b -sticky nsew + list [lindex [.p paneconfigure .b -sticky] 4] \ + [.p panecget .b -sticky] +} -cleanup { + .p paneconfig .b -sticky [lindex [.p paneconfig .b -sticky] 3] +} -result {nesw nesw} +test panedwindow-1.54 {configuration options: -sticky (bad)} -body { + .p paneconfigure .b -sticky abcd +} -returnCodes error -result {bad stickyness value "abcd": must be a string containing zero or more of n, e, s, and w} +test panedwindow-1.55 {configuration options: -stretch (good)} -body { + .p paneconfigure .b -stretch alw + list [lindex [.p paneconfigure .b -stretch] 4] \ + [.p panecget .b -stretch] +} -cleanup { + .p paneconfig .b -stretch [lindex [.p paneconfig .b -stretch] 3] +} -result {always always} +test panedwindow-1.56 {configuration options: -stretch (bad)} -body { + .p paneconfigure .b -stretch foo +} -returnCodes error -result {bad stretch "foo": must be always, first, last, middle, or never} +test panedwindow-1.57 {configuration options: -width (good)} -body { + .p paneconfigure .b -width 10 + list [lindex [.p paneconfigure .b -width] 4] \ + [.p panecget .b -width] +} -cleanup { + .p paneconfig .b -width [lindex [.p paneconfig .b -width] 3] +} -result {10 10} +test panedwindow-1.58 {configuration options: -width (bad)} -body { + .p paneconfigure .b -width badValue +} -returnCodes error -result {bad screen distance "badValue"} +deleteWindows + + +test panedwindow-2.1 {panedwindow widget command} -setup { + deleteWindows +} -body { + panedwindow .p + .p foo +} -cleanup { + deleteWindows +} -returnCodes error -result {bad command "foo": must be add, cget, configure, forget, identify, panecget, paneconfigure, panes, proxy, or sash} -test panedwindow-3.1 {panedwindow panes subcommand} { + +test panedwindow-3.1 {panedwindow panes subcommand} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] .p add [button .c] set result [list [.p panes]] .p forget .b lappend result [.p panes] - destroy .p .b .c - set result -} [list [list .b .c] [list .c]] +} -cleanup { + deleteWindows +} -result [list [list .b .c] [list .c]] + -test panedwindow-4.1 {forget subcommand} { +test panedwindow-4.1 {forget subcommand} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p forget} msg] $msg] - destroy .p - set result -} [list 1 "wrong # args: should be \".p forget widget ?widget ...?\""] -test panedwindow-4.2 {forget subcommand, forget one from start} { + .p forget +} -cleanup { + deleteWindows +} -returnCodes error -result {wrong # args: should be ".p forget widget ?widget ...?"} +test panedwindow-4.2 {forget subcommand, forget one from start} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] .p add [button .c] set result [list [.p panes]] .p forget .b lappend result [.p panes] - destroy .p .b .c - set result -} [list {.b .c} .c] -test panedwindow-4.3 {forget subcommand, forget one from end} { +} -cleanup { + deleteWindows +} -result [list {.b .c} .c] +test panedwindow-4.3 {forget subcommand, forget one from end} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] .p add [button .c] @@ -138,10 +347,12 @@ test panedwindow-4.3 {forget subcommand, forget one from end} { .p forget .d update lappend result [.p panes] - destroy .p .b .c .d - set result -} [list {.b .c .d} {.b .c}] -test panedwindow-4.4 {forget subcommand, forget multiple} { +} -cleanup { + deleteWindows +} -result [list {.b .c .d} {.b .c}] +test panedwindow-4.4 {forget subcommand, forget multiple} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] .p add [button .c] @@ -150,317 +361,401 @@ test panedwindow-4.4 {forget subcommand, forget multiple} { .p forget .b .c update lappend result [.p panes] - destroy .p .b .c .d - set result -} [list {.b .c .d} .d] -test panedwindow-4.5 {forget subcommand, panes are unmapped} { +} -cleanup { + deleteWindows +} -result [list {.b .c .d} .d] +test panedwindow-4.5 {forget subcommand, panes are unmapped} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] .p add [button .c] pack .p update - set result [list [winfo ismapped .b] [winfo ismapped .c]] .p forget .b update - lappend result [winfo ismapped .b] [winfo ismapped .c] - destroy .p .b .c - - set result -} [list 1 1 0 1] -test panedwindow-4.6 {forget subcommand, changes reqsize of panedwindow} { +} -cleanup { + deleteWindows +} -result [list 1 1 0 1] +test panedwindow-4.6 {forget subcommand, changes reqsize of panedwindow} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [frame .g -width 20 -height 20] set result [list [winfo reqwidth .p]] .p forget .f lappend result [winfo reqwidth .p] - destroy .p .f .g - set result -} [list 44 20] +} -cleanup { + deleteWindows +} -result [list 44 20] + -test panedwindow-5.1 {sash subcommand} { +test panedwindow-5.1 {sash subcommand} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash} msg] $msg] - destroy .p - set result -} [list 1 "wrong # args: should be \".p sash option ?arg ...?\""] -test panedwindow-5.2 {sash subcommand} { + .p sash +} -cleanup { + deleteWindows +} -returnCodes error -result {wrong # args: should be ".p sash option ?arg ...?"} +test panedwindow-5.2 {sash subcommand} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash foo} msg] $msg] - destroy .p - set result -} [list 1 "bad option \"foo\": must be coord, dragto, mark, or place"] + .p sash foo +} -cleanup { + deleteWindows +} -returnCodes error -result {bad option "foo": must be coord, dragto, mark, or place} -test panedwindow-6.1 {sash coord subcommand, errors} { + +test panedwindow-6.1 {sash coord subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash coord} msg] $msg] - destroy .p - set result -} [list 1 "wrong # args: should be \".p sash coord index\""] -test panedwindow-6.2 {sash coord subcommand, errors} { + .p sash coord +} -cleanup { + deleteWindows +} -returnCodes error -result {wrong # args: should be ".p sash coord index"} +test panedwindow-6.2 {sash coord subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 - set result [list [catch {.p sash coord 0} msg] $msg] - destroy .p - set result -} [list 1 "invalid sash index"] -test panedwindow-6.3 {sash coord subcommand, errors} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -returnCodes error -result {invalid sash index} +test panedwindow-6.3 {sash coord subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash coord foo} msg] $msg] - destroy .p - set result -} [list 1 "expected integer but got \"foo\""] -test panedwindow-6.4 {sash coord subcommand sashes correctly placed} { + .p sash coord foo +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "foo"} +test panedwindow-6.4 {sash coord subcommand sashes correctly placed} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -showhandle false .p add [frame .p.f -width 20 -height 20] \ [frame .p.f2 -width 20 -height 20] \ [frame .p.f3 -width 20 -height 20] - set result [.p sash coord 0] - destroy .p .p.f .p.f2 .p.f3 - set result -} [list 22 0] -test panedwindow-6.5 {sash coord subcommand sashes correctly placed} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 22 0] +test panedwindow-6.5 {sash coord subcommand sashes correctly placed} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -showhandle false .p add [frame .p.f -width 20 -height 20] \ [frame .p.f2 -width 20 -height 20] \ [frame .p.f3 -width 20 -height 20] - set result [.p sash coord 1] - destroy .p .p.f .p.f2 .p.f3 - set result -} [list 50 0] -test panedwindow-6.6 {sash coord subcommand, sashes correctly placed} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 50 0] +test panedwindow-6.6 {sash coord subcommand, sashes correctly placed} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -orient vertical \ -showhandle false .p add [frame .p.f -width 20 -height 20] \ [frame .p.f2 -width 20 -height 20] \ [frame .p.f3 -width 20 -height 20] - set result [.p sash coord 0] - destroy .p .p.f .p.f2 .p.f3 - set result -} [list 0 22] -test panedwindow-6.7 {sash coord subcommand, sashes correctly placed} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 22] +test panedwindow-6.7 {sash coord subcommand, sashes correctly placed} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 -orient vertical \ -showhandle false .p add [frame .p.f -width 20 -height 20] \ [frame .p.f2 -width 20 -height 20] \ [frame .p.f3 -width 20 -height 20] - set result [.p sash coord 1] - destroy .p .p.f .p.f2 .p.f3 - set result -} [list 0 50] -test panedwindow-6.8 {sash coord subcommand, errors} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 0 50] +test panedwindow-6.8 {sash coord subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list \ - [catch {.p sash coord -1} msg] $msg \ - [catch {.p sash coord 0} msg] $msg \ - [catch {.p sash coord 1} msg] $msg \ - ] - destroy .p - set result -} [list 1 "invalid sash index" 1 "invalid sash index" 1 "invalid sash index"] -test panedwindow-6.9 {sash coord subcommand, errors} { + list [catch {.p sash coord -1} msg] $msg \ + [catch {.p sash coord 0} msg] $msg \ + [catch {.p sash coord 1} msg] $msg +} -cleanup { + deleteWindows +} -result [list 1 "invalid sash index" 1 "invalid sash index" 1 "invalid sash index"] +test panedwindow-6.9 {sash coord subcommand, errors} -setup { + deleteWindows +} -body { # There are no sashes until you have 2 panes panedwindow .p .p add [frame .p.f] - set result [list \ - [catch {.p sash coord -1} msg] $msg \ + list [catch {.p sash coord -1} msg] $msg \ [catch {.p sash coord 0} msg] $msg \ - [catch {.p sash coord 1} msg] $msg \ - ] - destroy .p - set result -} [list 1 "invalid sash index" 1 "invalid sash index" 1 "invalid sash index"] -test panedwindow-6.10 {sash coord subcommand, errors} { + [catch {.p sash coord 1} msg] $msg +} -cleanup { + deleteWindows +} -result [list 1 "invalid sash index" 1 "invalid sash index" 1 "invalid sash index"] +test panedwindow-6.10 {sash coord subcommand, errors} -setup { + deleteWindows +} -body { # There are no sashes until you have 2 panes panedwindow .p .p add [frame .p.f] [frame .p.f2] - set result [list \ - [catch {.p sash coord -1} msg] $msg \ + list [catch {.p sash coord -1} msg] $msg \ [catch {.p sash coord 0} msg] \ [catch {.p sash coord 1} msg] $msg \ - [catch {.p sash coord 2} msg] $msg \ - ] - destroy .p - set result -} [list 1 "invalid sash index" 0 1 "invalid sash index" 1 "invalid sash index"] + [catch {.p sash coord 2} msg] $msg +} -cleanup { + deleteWindows +} -result [list 1 "invalid sash index" 0 1 "invalid sash index" 1 "invalid sash index"] + -test panedwindow-8.1 {sash mark subcommand, errors} { +test panedwindow-7.1 {sash mark subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash mark} msg] $msg] - destroy .p - set result -} [list 1 "wrong # args: should be \".p sash mark index ?x y?\""] -test panedwindow-8.2 {sash mark subcommand, errors} { + .p sash mark +} -cleanup { + deleteWindows +} -returnCodes error -result {wrong # args: should be ".p sash mark index ?x y?"} +test panedwindow-7.2 {sash mark subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash mark foo} msg] $msg] - destroy .p - set result -} [list 1 "expected integer but got \"foo\""] -test panedwindow-8.3 {sash mark subcommand, errors} { + .p sash mark foo +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "foo"} +test panedwindow-7.3 {sash mark subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash mark 0 foo bar} msg] $msg] - destroy .p - set result -} [list 1 "invalid sash index"] -test panedwindow-8.4 {sash mark subcommand, errors} { + .p sash mark 0 foo bar +} -cleanup { + deleteWindows +} -returnCodes error -result {invalid sash index} +test panedwindow-7.4 {sash mark subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] - set result [list [catch {.p sash mark 0 foo bar} msg] $msg] - destroy .p .b .c - set result -} [list 1 "expected integer but got \"foo\""] -test panedwindow-8.5 {sash mark subcommand, errors} { + .p sash mark 0 foo bar +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "foo"} +test panedwindow-7.5 {sash mark subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] - set result [list [catch {.p sash mark 0 0 bar} msg] $msg] - destroy .p .b .c - set result -} [list 1 "expected integer but got \"bar\""] -test panedwindow-8.6 {sash mark subcommand, mark defaults to 0 0} { + .p sash mark 0 0 bar +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "bar"} +test panedwindow-7.6 {sash mark subcommand, mark defaults to 0 0} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] - set result [.p sash mark 0] - destroy .p .b .c - set result -} [list 0 0] -test panedwindow-8.7 {sash mark subcommand, set mark} { + .p sash mark 0 +} -cleanup { + deleteWindows +} -result [list 0 0] +test panedwindow-7.7 {sash mark subcommand, set mark} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] .p sash mark 0 10 10 - set result [.p sash mark 0] - destroy .p .b .c - set result -} [list 10 10] + .p sash mark 0 +} -cleanup { + deleteWindows +} -result [list 10 10] + -test panedwindow-9.1 {sash dragto subcommand, errors} { +test panedwindow-8.1 {sash dragto subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash dragto} msg] $msg] - destroy .p - set result -} [list 1 "wrong # args: should be \".p sash dragto index x y\""] -test panedwindow-9.2 {sash dragto subcommand, errors} { + .p sash dragto +} -cleanup { + deleteWindows +} -returnCodes error -result {wrong # args: should be ".p sash dragto index x y"} +test panedwindow-8.2 {sash dragto subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash dragto foo bar baz} msg] $msg] - destroy .p - set result -} [list 1 "expected integer but got \"foo\""] -test panedwindow-9.3 {sash dragto subcommand, errors} { + .p sash dragto foo bar baz +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "foo"} +test panedwindow-8.3 {sash dragto subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash dragto 0 foo bar} msg] $msg] - destroy .p - set result -} [list 1 "invalid sash index"] -test panedwindow-9.4 {sash dragto subcommand, errors} { + .p sash dragto 0 foo bar +} -cleanup { + deleteWindows +} -returnCodes error -result {invalid sash index} +test panedwindow-8.4 {sash dragto subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] - set result [list [catch {.p sash dragto 0 foo bar} msg] $msg] - destroy .p .b .c - set result -} [list 1 "expected integer but got \"foo\""] -test panedwindow-9.5 {sash dragto subcommand, errors} { + .p sash dragto 0 foo bar +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "foo"} +test panedwindow-8.5 {sash dragto subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] - set result [list [catch {.p sash dragto 0 0 bar} msg] $msg] - destroy .p .b .c - set result -} [list 1 "expected integer but got \"bar\""] + .p sash dragto 0 0 bar +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "bar"} -test panedwindow-10.1 {sash mark/sash dragto interaction} { + +test panedwindow-9.1 {sash mark/sash dragto interaction} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [button .c -text foobar] .p sash mark 0 10 10 .p sash dragto 0 20 10 - set result [.p sash coord 0] - destroy .p .f .c - set result -} [list 30 0] -test panedwindow-10.2 {sash mark/sash dragto interaction} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 30 0] +test panedwindow-9.2 {sash mark/sash dragto interaction} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -orient vertical \ -showhandle false .p add [frame .p.f -width 20 -height 20] [button .p.c -text foobar] .p sash mark 0 10 10 .p sash dragto 0 10 20 - set result [.p sash coord 0] - destroy .p .p.f .p.c - set result -} [list 0 30] -test panedwindow-10.3 {sash mark/sash dragto, respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 30] +test panedwindow-9.3 {sash mark/sash dragto, respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [button .c] -minsize 15 .p sash mark 0 20 10 .p sash dragto 0 10 10 - set result [.p sash coord 0] - destroy .p .f .c - set result -} [list 15 0] + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 15 0] + -test panedwindow-11.1 {sash place subcommand, errors} { +test panedwindow-10.1 {sash place subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p sash place} msg] $msg] - destroy .p - set result -} [list 1 "wrong # args: should be \".p sash place index x y\""] -test panedwindow-11.2 {sash place subcommand, errors} { - destroy .p + .p sash place +} -cleanup { + deleteWindows +} -returnCodes error -result {wrong # args: should be ".p sash place index x y"} +test panedwindow-10.2 {sash place subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - list [catch {.p sash place foo bar baz} msg] $msg -} [list 1 "expected integer but got \"foo\""] -test panedwindow-11.3 {sash place subcommand, errors} { - destroy .p + .p sash place foo bar baz +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "foo"} +test panedwindow-10.3 {sash place subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p - list [catch {.p sash place 0 foo bar} msg] $msg -} [list 1 "invalid sash index"] -test panedwindow-11.4 {sash place subcommand, errors} { - destroy .p .b .c + .p sash place 0 foo bar +} -cleanup { + deleteWindows +} -returnCodes error -result {invalid sash index} +test panedwindow-10.4 {sash place subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] - list [catch {.p sash place 0 foo bar} msg] $msg -} [list 1 "expected integer but got \"foo\""] -test panedwindow-11.5 {sash place subcommand, errors} { - destroy .p .f .c .b + .p sash place 0 foo bar +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "foo"} +test panedwindow-10.5 {sash place subcommand, errors} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] - list [catch {.p sash place 0 0 bar} msg] $msg -} [list 1 "expected integer but got \"bar\""] -test panedwindow-11.6 {sash place subcommand, moves sash} { - destroy .p .f .c .b + .p sash place 0 0 bar +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "bar"} +test panedwindow-10.6 {sash place subcommand, moves sash} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 20] [button .c] .p sash place 0 10 0 .p sash coord 0 -} [list 10 0] -test panedwindow-11.7 {sash place subcommand, moves sash} { - destroy .p .f .c +} -cleanup { + deleteWindows +} -result [list 10 0] +test panedwindow-10.7 {sash place subcommand, moves sash} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -orient vertical .p add [frame .f -width 20 -height 20] [button .c] .p sash place 0 0 10 .p sash coord 0 -} [list 0 10] -test panedwindow-11.8 {sash place subcommand, respects minsize} { - destroy .p .f .c +} -cleanup { + deleteWindows +} -result [list 0 10] +test panedwindow-10.8 {sash place subcommand, respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [button .c] -minsize 15 .p sash place 0 10 0 .p sash coord 0 -} [list 15 0] -test panedwindow-11.9 {sash place subcommand, respects minsize} { - destroy .p .f .c +} -cleanup { + deleteWindows +} -result [list 15 0] +test panedwindow-10.9 {sash place subcommand, respects minsize} -setup { + deleteWindows +} -body { panedwindow .p .p add [frame .f -width 20 -height 20 -bg pink] - list [catch {.p sash place 0 2 0} msg] $msg -} [list 1 {invalid sash index}] + .p sash place 0 2 0 +} -cleanup { + deleteWindows +} -returnCodes error -result {invalid sash index} + -test panedwindow-12.1 {moving sash changes size of pane to left} { - destroy .p .f .c +test panedwindow-11.1 {moving sash changes size of pane to left} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 4 -showhandle false .p add [frame .f -width 20 -height 20] [button .c -text foobar] -sticky nsew .p sash place 0 30 0 pack .p update winfo width .f -} 30 -test panedwindow-12.2 {moving sash changes size of pane to right} { - destroy .p .f .f2 +} -result 30 +test panedwindow-11.2 {moving sash changes size of pane to right} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 20] [frame .f2 -width 20 -height 20] pack .p @@ -469,16 +764,20 @@ test panedwindow-12.2 {moving sash changes size of pane to right} { .p sash place 0 30 0 update lappend result [winfo width .f2] -} {20 10} -test panedwindow-12.3 {moving sash does not change reqsize of panedwindow} { - destroy .p .f .f2 +} -cleanup { + deleteWindows +} -result {20 10} +test panedwindow-11.3 {moving sash does not change reqsize of panedwindow} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 20] [frame .f2 -width 20 -height 20] .p sash place 0 30 0 winfo reqwidth .p -} 44 -test panedwindow-12.4 {moving sash changes size of pane above} { - destroy .p .f .c +} -result 44 +test panedwindow-11.4 {moving sash changes size of pane above} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 10] [button .c -text foobar] -sticky nsew @@ -486,11 +785,11 @@ test panedwindow-12.4 {moving sash changes size of pane above} { pack .p update set result [winfo height .f] - destroy .p .f .c set result -} 20 -test panedwindow-12.5 {moving sash changes size of pane below} { - destroy .p .f .f2 +} -result 20 +test panedwindow-11.5 {moving sash changes size of pane below} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 10] [frame .f2 -width 20 -height 10] @@ -500,81 +799,92 @@ test panedwindow-12.5 {moving sash changes size of pane below} { .p sash place 0 0 15 update lappend result [winfo height .f2] - destroy .p .f .f2 set result -} {10 5} -test panedwindow-12.6 {moving sash does not change reqsize of panedwindow} { +} -cleanup { + deleteWindows +} -result {10 5} +test panedwindow-11.6 {moving sash does not change reqsize of panedwindow} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 10] [frame .f2 -width 20 -height 10] set result [winfo reqheight .p] .p sash place 0 0 20 lappend result [winfo reqheight .p] - destroy .p .f .f2 set result -} [list 24 24] -test panedwindow-12.7 {moving sash does not alter reqsize of widget} { - destroy .p .f .f2 +} -cleanup { + deleteWindows +} -result [list 24 24] +test panedwindow-11.7 {moving sash does not alter reqsize of widget} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 10] [frame .f2 -width 20 -height 10] set result [winfo reqheight .f] .p sash place 0 0 20 lappend result [winfo reqheight .f] - destroy .p .f .f2 - set result -} [list 10 10] -test panedwindow-12.8 {moving sash restricted to minsize} { - destroy .p .f .c +} -cleanup { + deleteWindows +} -result [list 10 10] +test panedwindow-11.8 {moving sash restricted to minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 20] [button .c] -minsize 15 .p sash place 0 10 0 pack .p update - set result [winfo width .f] - destroy .p .f .c - set result -} 15 -test panedwindow-12.10 {moving sash restricted to minsize} { - destroy .p .f .c + winfo width .f +} -result 15 +test panedwindow-11.9 {moving sash restricted to minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .f -width 20 -height 30] [button .c] -minsize 10 .p sash place 0 0 5 pack .p update - set result [winfo height .f] - destroy .p .f .c - set result -} 10 -test panedwindow-12.12 {moving sash in unmapped window restricted to reqsize} { + winfo height .f +} -result 10 +test panedwindow-11.10 {moving sash in unmapped window restricted to reqsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] set result [list [.p sash coord 0]] .p sash place 0 100 0 lappend result [.p sash coord 0] - destroy .p .f .f2 - set result -} [list {20 0} {40 0}] -test panedwindow-12.13 {moving sash right pushes other sashes} { +} -cleanup { + deleteWindows +} -result [list {20 0} {40 0}] +test panedwindow-11.11 {moving sash right pushes other sashes} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] .p sash place 0 80 0 - set result [list [.p sash coord 0] [.p sash coord 1]] - destroy .p .f .f2 .f3 - set result -} {{60 0} {64 0}} -test panedwindow-12.14 {moving sash left pushes other sashes} { + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{60 0} {64 0}} +test panedwindow-11.12 {moving sash left pushes other sashes} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] .p sash place 1 0 0 - set result [list [.p sash coord 0] [.p sash coord 1]] - destroy .p .f .f2 .f3 - set result -} {{0 0} {4 0}} -test panedwindow-12.15 {move sash in mapped window restricted to visible win} { + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{0 0} {4 0}} +test panedwindow-11.13 {move sash in mapped window restricted to visible win} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] @@ -582,11 +892,13 @@ test panedwindow-12.15 {move sash in mapped window restricted to visible win} { update .p sash place 1 100 0 update - set result [.p sash coord 1] - destroy .p .f .f2 .f3 - set result -} {46 0} -test panedwindow-12.16 {move sash in mapped window restricted to visible win} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result {46 0} +test panedwindow-11.14 {move sash in mapped window restricted to visible win} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] @@ -594,12 +906,13 @@ test panedwindow-12.16 {move sash in mapped window restricted to visible win} { update .p sash place 1 200 0 update - set result [.p sash coord 1] - destroy .p .f .f2 .f3 - set result -} {96 0} -test panedwindow-12.17 {moving sash into "virtual" space on \ - last pane increases reqsize} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result {96 0} +test panedwindow-11.15 {moving sash into "virtual" space on last pane increases reqsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .f -width 20 -height 30] [frame .f2 -width 20 -height 20] \ [frame .f3 -width 20 -height 30] @@ -609,36 +922,45 @@ test panedwindow-12.17 {moving sash into "virtual" space on \ .p sash place 1 200 0 update lappend result [winfo reqwidth .p] - destroy .p .f .f2 .f3 - set result -} {68 100} +} -cleanup { + deleteWindows +} -result {68 100} -test panedwindow-13.1 {horizontal panedwindow lays out widgets properly} { + +test panedwindow-12.1 {horizontal panedwindow lays out widgets properly} -setup { + deleteWindows + set result {} +} -body { panedwindow .p -showhandle false -borderwidth 2 -sashpad 2 -sashwidth 2 foreach win {.p.f .p.f2 .p.f3} {.p add [frame $win -width 20 -height 10]} pack .p update - set result {} foreach w [.p panes] {lappend result [winfo x $w] [winfo y $w]} - destroy .p .p.f .p.f2 .p.f3 - set result -} [list 2 2 28 2 54 2] -test panedwindow-13.2 {vertical panedwindow lays out widgets properly} { + return $result +} -cleanup { + deleteWindows +} -result [list 2 2 28 2 54 2] +test panedwindow-12.2 {vertical panedwindow lays out widgets properly} -setup { + deleteWindows + set result {} +} -body { panedwindow .p -showhandle false -borderwidth 2 -sashpad 2 -sashwidth 2 \ -orient vertical foreach win {.p.f .p.f2 .p.f3} {.p add [frame $win -width 20 -height 10]} pack .p update - set result {} foreach w [.p panes] {lappend result [winfo x $w] [winfo y $w]} - destroy .p .p.f .p.f2 .p.f3 - set result -} [list 2 2 2 18 2 34] -test panedwindow-13.3 {horizontal panedwindow lays out widgets properly} { + return $result +} -cleanup { + deleteWindows +} -result [list 2 2 2 18 2 34] +test panedwindow-12.3 {horizontal panedwindow lays out widgets properly} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach {win color} {.p.f blue .p.f2 green} { - .p add [frame $win -width 20 -height 20 -bg $color] -padx 10 -pady 5 \ - -sticky "" + .p add [frame $win -width 20 -height 20 -bg $color] -padx 10 -pady 5 \ + -sticky "" } pack .p update @@ -648,10 +970,13 @@ test panedwindow-13.3 {horizontal panedwindow lays out widgets properly} { update lappend result [winfo reqwidth .p] [winfo reqheight .p] foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]} - destroy .p .p.f .p.f2 - set result -} [list 80 30 10 5 50 5 60 30 0 5 30 5] -test panedwindow-13.4 {vertical panedwindow lays out widgets properly} { + return $result +} -cleanup { + deleteWindows +} -result [list 80 30 10 5 50 5 60 30 0 5 30 5] +test panedwindow-12.4 {vertical panedwindow lays out widgets properly} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach win {.p.f .p.f2} { @@ -665,10 +990,13 @@ test panedwindow-13.4 {vertical panedwindow lays out widgets properly} { update lappend result [winfo reqwidth .p] [winfo reqheight .p] foreach win {.p.f .p.f2} {lappend result [winfo x $win] [winfo y $win]} - destroy .p .p.f .p.f2 - set result -} [list 40 60 10 5 10 35 40 50 10 0 10 25] -test panedwindow-13.5 {panedwindow respects reqsize of panes when possible} { + return $result +} -cleanup { + deleteWindows +} -result [list 40 60 10 5 10 35 40 50 10 0 10 25] +test panedwindow-12.5 {panedwindow respects reqsize of panes when possible} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 .p add [frame .p.f -width 20 -height 20] -sticky "" place .p -width 40 @@ -677,10 +1005,12 @@ test panedwindow-13.5 {panedwindow respects reqsize of panes when possible} { .p.f configure -width 30 update lappend result [winfo width .p.f] - destroy .p .p.f - set result -} [list 20 30] -test panedwindow-13.6 {panedwindow takes explicit widget width over reqwidth} { +} -cleanup { + deleteWindows +} -result [list 20 30] +test panedwindow-12.6 {panedwindow takes explicit widget width over reqwidth} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 .p add [frame .p.f -width 20 -height 20] -width 20 -sticky "" place .p -width 40 @@ -689,29 +1019,35 @@ test panedwindow-13.6 {panedwindow takes explicit widget width over reqwidth} { .p.f configure -width 30 update lappend result [winfo width .p.f] - destroy .p .p.f - set result -} [list 20 20] -test panedwindow-13.7 {horizontal panedwindow reqheight is max slave height} { +} -cleanup { + deleteWindows +} -result [list 20 20] +test panedwindow-12.7 {horizontal panedwindow reqheight is max slave height} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 .p add [frame .p.f -width 20 -height 20] [frame .p.f2 -width 20 -height 20] set result [winfo reqheight .p] .p.f config -height 40 lappend result [winfo reqheight .p] - destroy .p .p.f .p.f2 - set result -} {20 40} -test panedwindow-13.8 {horizontal panedwindow reqheight is max slave height} { +} -cleanup { + deleteWindows +} -result {20 40} +test panedwindow-12.8 {horizontal panedwindow reqheight is max slave height} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]} .p paneconfigure .p.f -height 15 set result [winfo reqheight .p] .p.f config -height 40 lappend result [winfo reqheight .p] - destroy .p .p.f .p.f2 - set result -} {20 20} -test panedwindow-13.9 {panedwindow pane width overrides widget width} { +} -cleanup { + deleteWindows +} -result {20 20} +test panedwindow-12.9 {panedwindow pane width overrides widget width} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]} .p sash place 0 10 0 @@ -720,10 +1056,12 @@ test panedwindow-13.9 {panedwindow pane width overrides widget width} { set result [winfo width .p.f] .p paneconfigure .p.f -width 30 lappend result [winfo width .p.f] - destroy .p .p.f .p.f2 - set result -} [list 10 10] -test panedwindow-13.10 {panedwindow respects reqsize of panes when possible} { +} -cleanup { + deleteWindows +} -result [list 10 10] +test panedwindow-12.10 {panedwindow respects reqsize of panes when possible} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 .p add [frame .p.f -width 20 -height 20] -sticky "" place .p -height 40 @@ -732,10 +1070,12 @@ test panedwindow-13.10 {panedwindow respects reqsize of panes when possible} { .p.f configure -height 30 update lappend result [winfo height .p.f] - destroy .p .p.f - set result -} [list 20 30] -test panedwindow-13.11 {panedwindow takes explicit height over reqheight} { +} -cleanup { + deleteWindows +} -result [list 20 30] +test panedwindow-12.11 {panedwindow takes explicit height over reqheight} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 .p add [frame .p.f -width 20 -height 20] -height 20 -sticky "" place .p -height 40 @@ -744,20 +1084,24 @@ test panedwindow-13.11 {panedwindow takes explicit height over reqheight} { .p.f configure -height 30 update lappend result [winfo height .p.f] - destroy .p .p.f - set result -} [list 20 20] -test panedwindow-13.12 {vertical panedwindow reqwidth is max slave width} { +} -cleanup { + deleteWindows +} -result [list 20 20] +test panedwindow-12.12 {vertical panedwindow reqwidth is max slave width} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical .p add [frame .p.f -width 20 -height 20] [frame .p.f2 -width 20 -height 20] set result [winfo reqwidth .p] .p.f config -width 40 lappend result [winfo reqwidth .p] - destroy .p .p.f .p.f2 - set result -} {20 40} -test panedwindow-13.13 {vertical panedwindow reqwidth is max slave width} { +} -cleanup { + deleteWindows +} -result {20 40} +test panedwindow-12.13 {vertical panedwindow reqwidth is max slave width} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]} @@ -765,11 +1109,12 @@ test panedwindow-13.13 {vertical panedwindow reqwidth is max slave width} { set result [winfo reqwidth .p] .p.f config -width 40 lappend result [winfo reqwidth .p] - destroy .p .p.f .p.f2 - set result -} {20 20} -test panedwindow-13.14 {panedwindow pane height overrides widget width} { - destroy .p +} -cleanup { + deleteWindows +} -result {20 20} +test panedwindow-12.14 {panedwindow pane height overrides widget width} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 4 \ -orient vertical foreach win {.p.f .p.f2} {.p add [frame $win -width 20 -height 20]} @@ -779,32 +1124,34 @@ test panedwindow-13.14 {panedwindow pane height overrides widget width} { set result [winfo height .p.f] .p paneconfigure .p.f -height 30 lappend result [winfo height .p.f] - destroy .p - set result -} [list 10 10] +} -cleanup { + deleteWindows +} -result [list 10 10] -test panedwindow-14.1 {PanestructureProc, widget yields managements} { +test panedwindow-13.1 {PanestructureProc, widget yields managements} -setup { + deleteWindows +} -body { # Check that the panedwindow correctly yields geometry management of # a slave when the slave is destroyed. # This test should not cause a core dump, and it should not cause # a memory leak. - destroy .p .b panedwindow .p .p add [button .b] destroy .p pack .b destroy .b set result "" -} "" -test panedwindow-14.2 {PanedWindowLostSlaveProc, widget yields management} { +} -result {} +test panedwindow-13.2 {PanedWindowLostSlaveProc, widget yields management} -setup { + deleteWindows +} -body { # Check that the paned window correctly yields geometry management of # a slave when some other geometry manager steals the slave from us. # This test should not cause a core dump, and it should not cause a # memory leak. - destroy .p .b panedwindow .p .p add [button .b] pack .p @@ -814,56 +1161,359 @@ test panedwindow-14.2 {PanedWindowLostSlaveProc, widget yields management} { set result [.p panes] destroy .p .b set result -} {} - -set stickysets [list n s e w sn ns en ne wn nw esn nse nsw nsew ""] -set stickygets [list n s e w ns ns ne ne nw nw nes nes nsw nesw ""] -set i 0 -foreach s $stickysets g $stickygets { - test panedwindow-15.[incr i] {panedwindow sticky settings} { - destroy .p .b - panedwindow .p -showhandle false - .p add [button .b] - .p paneconfigure .b -sticky $s - set result [.p panecget .b -sticky] - destroy .p .b - set result - } $g -} - -set i 0 -foreach s [list {} n s e w ns ew nw ne se sw nse nsw sew new news] \ - x [list 10 10 10 20 0 10 0 0 20 20 0 20 0 0 0 0] \ - y [list 10 0 20 10 10 0 10 0 0 20 20 0 0 20 0 0] \ - w [list 20 20 20 20 20 20 40 20 20 20 20 20 20 40 40 40] \ - h [list 20 20 20 20 20 40 20 20 20 20 20 40 40 20 20 40] { - test panedwindow-16.[incr i] {panedwindow sticky works} { - panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky $s - place .p -width 40 -height 40 - update - set result [list $s [winfo x .p.f] [winfo y .p.f] \ - [winfo width .p.f] [winfo height .p.f]] - destroy .p .p.f - set result - } [list $s $x $y $w $h] -} - -test panedwindow-17.1 {setting minsize when pane is too small snaps width} { +} -result {} + + +test panedwindow-14.1 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky n + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {n} +test panedwindow-14.2 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky s + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {s} +test panedwindow-14.3 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky e + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {e} +test panedwindow-14.4 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky w + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {w} +test panedwindow-14.5 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky sn + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {ns} +test panedwindow-14.6 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky ns + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {ns} +test panedwindow-14.7 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky en + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {ne} +test panedwindow-14.8 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky ne + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {ne} +test panedwindow-14.9 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky wn + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {nw} +test panedwindow-14.10 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky nw + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {nw} +test panedwindow-14.11 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky esn + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {nes} +test panedwindow-14.12 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky nse + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {nes} +test panedwindow-14.13 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky nsw + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {nsw} +test panedwindow-14.14 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky nsew + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {nesw} +test panedwindow-14.15 {panedwindow sticky settings} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false + .p add [button .b] + .p paneconfigure .b -sticky "" + .p panecget .b -sticky +} -cleanup { + deleteWindows +} -result {} + + +test panedwindow-15.1 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky {} + place .p -width 40 -height 40 + update + list {} [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {{} 10 10 20 20} +test panedwindow-15.2 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky n + place .p -width 40 -height 40 + update + list n [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {n 10 0 20 20} +test panedwindow-15.3 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky s + place .p -width 40 -height 40 + update + list s [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {s 10 20 20 20} +test panedwindow-15.4 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky e + place .p -width 40 -height 40 + update + list e [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {e 20 10 20 20} +test panedwindow-15.5 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky w + place .p -width 40 -height 40 + update + list w [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {w 0 10 20 20} +test panedwindow-15.6 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky ns + place .p -width 40 -height 40 + update + list ns [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {ns 10 0 20 40} +test panedwindow-15.7 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky ew + place .p -width 40 -height 40 + update + list ew [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {ew 0 10 40 20} +test panedwindow-15.8 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky nw + place .p -width 40 -height 40 + update + list nw [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {nw 0 0 20 20} +test panedwindow-15.9 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky ne + place .p -width 40 -height 40 + update + list ne [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {ne 20 0 20 20} +test panedwindow-15.10 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky se + place .p -width 40 -height 40 + update + list se [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {se 20 20 20 20} +test panedwindow-15.11 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky sw + place .p -width 40 -height 40 + update + list sw [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {sw 0 20 20 20} +test panedwindow-15.12 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky nse + place .p -width 40 -height 40 + update + list nse [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {nse 20 0 20 40} +test panedwindow-15.13 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky nsw + place .p -width 40 -height 40 + update + list nsw [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {nsw 0 0 20 40} +test panedwindow-15.14 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky sew + place .p -width 40 -height 40 + update + list sew [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {sew 0 20 40 20} +test panedwindow-15.15 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky new + place .p -width 40 -height 40 + update + list new [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {new 0 0 40 20} +test panedwindow-15.16 {panedwindow sticky works} -setup { + deleteWindows +} -body { + panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 + .p add [frame .p.f -height 20 -width 20 -bg red] -sticky news + place .p -width 40 -height 40 + update + list news [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] +} -cleanup { + deleteWindows +} -result {news 0 0 40 40} + + +test panedwindow-16.1 {setting minsize when pane is too small snaps width} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .p.f -height 20 -width 20 -bg red] set result [winfo reqwidth .p] .p paneconfigure .p.f -minsize 40 lappend result [winfo reqwidth .p] - destroy .p .p.f .p.f2 - set result -} [list 20 40] +} -cleanup { + deleteWindows +} -result [list 20 40] + -test panedwindow-18.1 {MoveSash, move right} { +test panedwindow-17.1 {MoveSash, move right} -setup { + deleteWindows set result {} +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Get the requested width of the paned window @@ -876,33 +1526,31 @@ test panedwindow-18.1 {MoveSash, move right} { # Check that the sash moved lappend result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 42 42 {30 0}] -test panedwindow-18.2 {MoveSash, move right (unmapped) clipped by reqwidth} { +} -cleanup { + deleteWindows +} -result [list 42 42 {30 0}] +test panedwindow-17.2 {MoveSash, move right (unmapped) clipped by reqwidth} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 100 0 # Get the new sash coord; it should be clipped by the reqwidth of # the panedwindow. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 40 0] -test panedwindow-18.3 {MoveSash, move right (mapped, width < reqwidth) clipped by width} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 40 0] +test panedwindow-17.3 {MoveSash, move right (mapped, width < reqwidth) clipped by width} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Put the panedwindow up on the display and give it a width < reqwidth @@ -913,17 +1561,16 @@ test panedwindow-18.3 {MoveSash, move right (mapped, width < reqwidth) clipped b # Get the new sash coord; it should be clipped by the visible width of # the panedwindow. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 30 0] -test panedwindow-18.4 {MoveSash, move right (mapped, width > reqwidth) clipped by width} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 30 0] +test panedwindow-17.4 {MoveSash, move right (mapped, width > reqwidth) clipped by width} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Put the panedwindow up on the display and give it a width > reqwidth @@ -934,121 +1581,114 @@ test panedwindow-18.4 {MoveSash, move right (mapped, width > reqwidth) clipped b # Get the new sash coord; it should be clipped by the visible width of # the panedwindow. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 100 0] -test panedwindow-18.5 {MoveSash, move right respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 100 0] +test panedwindow-17.5 {MoveSash, move right respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 30 0] -test panedwindow-18.6 {MoveSash, move right respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 30 0] +test panedwindow-17.6 {MoveSash, move right respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 40 0] -test panedwindow-18.7 {MoveSash, move right pushes other sashes} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 40 0] +test panedwindow-17.7 {MoveSash, move right pushes other sashes} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 1] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 62 0] -test panedwindow-18.8 {MoveSash, move right pushes other sashes, respects minsize} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 62 0] +test panedwindow-17.8 {MoveSash, move right pushes other sashes, respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 1] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 52 0] -test panedwindow-18.9 {MoveSash, move right respects minsize, exludes pad} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 52 0] +test panedwindow-17.9 {MoveSash, move right respects minsize, exludes pad} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ - -sticky nsew -minsize 10 -padx 5 + .p add [frame $w -height 20 -width 20 -bg $c] \ + -sticky nsew -minsize 10 -padx 5 } .p sash place 0 100 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 50 0] -test panedwindow-18.10 {MoveSash, move right, negative minsize becomes 0} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 50 0] +test panedwindow-17.10 {MoveSash, move right, negative minsize becomes 0} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ - -sticky nsew -minsize -50 + .p add [frame $w -height 20 -width 20 -bg $c] \ + -sticky nsew -minsize -50 } .p sash place 0 50 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. - set result [list [.p sash coord 0] [.p sash coord 1]] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list [list 50 0] [list 52 0]] -test panedwindow-18.11 {MoveSash, move left} { + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result [list [list 50 0] [list 52 0]] +test panedwindow-17.11 {MoveSash, move left} -setup { + deleteWindows +} -body { set result {} panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Get the requested width of the paned window @@ -1061,139 +1701,132 @@ test panedwindow-18.11 {MoveSash, move left} { # Check that the sash moved lappend result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 42 42 {10 0}] -test panedwindow-18.12 {MoveSash, move left, can't move outside of window} { +} -cleanup { + deleteWindows +} -result [list 42 42 {10 0}] +test panedwindow-17.12 {MoveSash, move left, can't move outside of window} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 -100 0 # Get the new sash coord; it should be clipped by the reqwidth of # the panedwindow. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 0 0] -test panedwindow-18.13 {MoveSash, move left respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 0] +test panedwindow-17.13 {MoveSash, move left respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 10 0] -test panedwindow-18.14 {MoveSash, move left respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 10 0] +test panedwindow-17.14 {MoveSash, move left respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible. - set result [.p sash coord 1] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 22 0] -test panedwindow-18.15 {MoveSash, move left pushes other sashes} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 22 0] +test panedwindow-17.15 {MoveSash, move left pushes other sashes} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 0 0] -test panedwindow-18.16 {MoveSash, move left pushes other sashes, respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 0] +test panedwindow-17.16 {MoveSash, move left pushes other sashes, respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 10 0] -test panedwindow-18.17 {MoveSash, move left respects minsize, exludes pad} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 10 0] +test panedwindow-17.17 {MoveSash, move left respects minsize, exludes pad} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ - -sticky nsew -minsize 10 -padx 5 + .p add [frame $w -height 20 -width 20 -bg $c] \ + -sticky nsew -minsize 10 -padx 5 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. - set result [.p sash coord 1] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 42 0] -test panedwindow-18.18 {MoveSash, move left, negative minsize becomes 0} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 42 0] +test panedwindow-17.18 {MoveSash, move left, negative minsize becomes 0} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue green} { - .p add [frame $w -height 20 -width 20 -bg $c] \ - -sticky nsew -minsize -50 + .p add [frame $w -height 20 -width 20 -bg $c] \ + -sticky nsew -minsize -50 } .p sash place 1 10 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. - set result [list [.p sash coord 0] [.p sash coord 1]] - - # Cleanup - destroy .p .f1 .f2 .f3 + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result [list [list 8 0] [list 10 0]] - set result -} [list [list 8 0] [list 10 0]] -test panedwindow-19.1 {MoveSash, move down} { +test panedwindow-18.1 {MoveSash, move down} -setup { + deleteWindows +} -body { set result {} panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Get the requested width of the paned window @@ -1206,35 +1839,33 @@ test panedwindow-19.1 {MoveSash, move down} { # Check that the sash moved lappend result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 42 42 {0 30}] -test panedwindow-19.2 {MoveSash, move down (unmapped) clipped by reqheight} { +} -cleanup { + deleteWindows +} -result [list 42 42 {0 30}] +test panedwindow-18.2 {MoveSash, move down (unmapped) clipped by reqheight} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 0 100 # Get the new sash coord; it should be clipped by the reqheight of # the panedwindow. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 0 40] -test panedwindow-19.3 {MoveSash, move down (mapped, height < reqheight) clipped by height} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 40] +test panedwindow-18.3 {MoveSash, move down (mapped, height < reqheight) clipped by height} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Put the panedwindow up on the display and give it a height < reqheight @@ -1245,18 +1876,17 @@ test panedwindow-19.3 {MoveSash, move down (mapped, height < reqheight) clipped # Get the new sash coord; it should be clipped by the visible height of # the panedwindow. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 0 30] -test panedwindow-19.4 {MoveSash, move down (mapped, height > reqheight) clipped by height} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 30] +test panedwindow-18.4 {MoveSash, move down (mapped, height > reqheight) clipped by height} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Put the panedwindow up on the display and give it a width > reqwidth @@ -1267,129 +1897,122 @@ test panedwindow-19.4 {MoveSash, move down (mapped, height > reqheight) clipped # Get the new sash coord; it should be clipped by the visible width of # the panedwindow. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 0 100] -test panedwindow-19.5 {MoveSash, move down respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 100] +test panedwindow-18.5 {MoveSash, move down respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 0 30] -test panedwindow-19.6 {MoveSash, move down respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 30] +test panedwindow-18.6 {MoveSash, move down respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 0 40] -test panedwindow-19.7 {MoveSash, move down pushes other sashes} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 40] +test panedwindow-18.7 {MoveSash, move down pushes other sashes} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 1] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 0 62] -test panedwindow-19.8 {MoveSash, move down pushes other sashes, respects minsize} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 0 62] +test panedwindow-18.8 {MoveSash, move down pushes other sashes, respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 1] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 0 52] -test panedwindow-19.9 {MoveSash, move down respects minsize, exludes pad} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 0 52] +test panedwindow-18.9 {MoveSash, move down respects minsize, exludes pad} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ - -sticky nsew -minsize 10 -pady 5 + .p add [frame $w -height 20 -width 20 -bg $c] \ + -sticky nsew -minsize 10 -pady 5 } .p sash place 0 0 100 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 0 50] -test panedwindow-19.10 {MoveSash, move right, negative minsize becomes 0} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 50] +test panedwindow-18.10 {MoveSash, move right, negative minsize becomes 0} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ - -sticky nsew -minsize -50 + .p add [frame $w -height 20 -width 20 -bg $c] \ + -sticky nsew -minsize -50 } .p sash place 0 0 50 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. - set result [list [.p sash coord 0] [.p sash coord 1]] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list [list 0 50] [list 0 52]] -test panedwindow-19.11 {MoveSash, move up} { + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result [list [list 0 50] [list 0 52]] +test panedwindow-18.11 {MoveSash, move up} -setup { + deleteWindows +} -body { set result {} panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } # Get the requested width of the paned window @@ -1402,178 +2025,180 @@ test panedwindow-19.11 {MoveSash, move up} { # Check that the sash moved lappend result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 42 42 {0 10}] -test panedwindow-19.12 {MoveSash, move up, can't move outside of window} { +} -cleanup { + deleteWindows +} -result [list 42 42 {0 10}] +test panedwindow-18.12 {MoveSash, move up, can't move outside of window} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 0 0 -100 # Get the new sash coord; it should be clipped by the reqwidth of # the panedwindow. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 0 0] -test panedwindow-19.13 {MoveSash, move up respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 0] +test panedwindow-18.13 {MoveSash, move up respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 0 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 - - set result -} [list 0 10] -test panedwindow-19.14 {MoveSash, move up respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 10] +test panedwindow-18.14 {MoveSash, move up respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible. - set result [.p sash coord 1] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 0 22] -test panedwindow-19.15 {MoveSash, move up pushes other sashes} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 0 22] +test panedwindow-18.15 {MoveSash, move up pushes other sashes} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 0 0] -test panedwindow-19.16 {MoveSash, move up pushes other sashes, respects minsize} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 0] +test panedwindow-18.16 {MoveSash, move up pushes other sashes, respects minsize} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible while # respecting minsizes. - set result [.p sash coord 0] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 0 10] -test panedwindow-19.17 {MoveSash, move up respects minsize, exludes pad} { + .p sash coord 0 +} -cleanup { + deleteWindows +} -result [list 0 10] +test panedwindow-18.17 {MoveSash, move up respects minsize, exludes pad} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ - -sticky nsew -minsize 10 -pady 5 + .p add [frame $w -height 20 -width 20 -bg $c] \ + -sticky nsew -minsize 10 -pady 5 } .p sash place 1 0 0 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. - set result [.p sash coord 1] - - # Cleanup - destroy .p .f1 .f2 .f3 - - set result -} [list 0 42] -test panedwindow-19.18 {MoveSash, move up, negative minsize becomes 0} { + .p sash coord 1 +} -cleanup { + deleteWindows +} -result [list 0 42] +test panedwindow-18.18 {MoveSash, move up, negative minsize becomes 0} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue green} { - .p add [frame $w -height 20 -width 20 -bg $c] \ - -sticky nsew -minsize -50 + .p add [frame $w -height 20 -width 20 -bg $c] \ + -sticky nsew -minsize -50 } .p sash place 1 0 10 # Get the new sash coord; it should have moved as far as possible, # respecting minsizes. - set result [list [.p sash coord 0] [.p sash coord 1]] - - # Cleanup - destroy .p .f1 .f2 .f3 + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result [list [list 0 8] [list 0 10]] - set result -} [list [list 0 8] [list 0 10]] # The following tests check that the panedwindow is correctly computing its # geometry based on the various configuration options that can affect the # geometry. -test panedwindow-20.1 {ComputeGeometry, reqheight taken from widgets} { +test panedwindow-19.1 {ComputeGeometry, reqheight taken from widgets} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] + .p add [frame $w -width 20 -height 20 -bg blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .f3 configure -height 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .f1 .f2 .f3 - set result -} [list [list 60 20] [list 60 40]] -test panedwindow-20.2 {ComputeGeometry, reqheight taken from widgets} { +} -cleanup { + deleteWindows +} -result [list [list 60 20] [list 60 40]] + +test panedwindow-19.2 {ComputeGeometry, reqheight taken from widgets} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] + .p add [frame $w -width 20 -height 20 -bg blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -height 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .f1 .f2 .f3 - set result -} [list [list 60 20] [list 60 40]] -test panedwindow-20.3 {ComputeGeometry, reqheight taken from widgets} { +} -cleanup { + deleteWindows +} -result [list [list 60 20] [list 60 40]] + +test panedwindow-19.3 {ComputeGeometry, reqheight taken from widgets} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -pady 20 + .p add [frame $w -width 20 -height 20 -bg blue] -pady 20 } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -height 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .f1 .f2 .f3 - set result -} [list [list 60 60] [list 60 80]] -test panedwindow-20.4 {ComputeGeometry, reqwidth taken from widgets} { +} -cleanup { + deleteWindows +} -result [list [list 60 60] [list 60 80]] + +test panedwindow-19.4 {ComputeGeometry, reqwidth taken from widgets} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach w {.f1 .f2 .f3} { @@ -1582,10 +2207,13 @@ test panedwindow-20.4 {ComputeGeometry, reqwidth taken from widgets} { set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .f3 configure -width 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .f1 .f2 .f3 - set result -} [list [list 20 60] [list 40 60]] -test panedwindow-20.5 {ComputeGeometry, reqwidth taken from widgets} { +} -cleanup { + deleteWindows +} -result [list [list 20 60] [list 40 60]] + +test panedwindow-19.5 {ComputeGeometry, reqwidth taken from widgets} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach w {.f1 .f2 .f3} { @@ -1594,10 +2222,13 @@ test panedwindow-20.5 {ComputeGeometry, reqwidth taken from widgets} { set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -width 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .f1 .f2 .f3 - set result -} [list [list 20 60] [list 40 60]] -test panedwindow-20.6 {ComputeGeometry, reqwidth taken from widgets} { +} -cleanup { + deleteWindows +} -result [list [list 20 60] [list 40 60]] + +test panedwindow-19.6 {ComputeGeometry, reqwidth taken from widgets} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach w {.f1 .f2 .f3} { @@ -1606,219 +2237,2153 @@ test panedwindow-20.6 {ComputeGeometry, reqwidth taken from widgets} { set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -width 40 lappend result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .f1 .f2 .f3 - set result -} [list [list 60 60] [list 80 60]] - -set i 6 -foreach bd {0 2} { - foreach sp {0 5} { - foreach sw {0 3} { - foreach h {0 1} { - test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ - {ComputeGeometry, one slave, reqsize set properly} { - # With just one slave, sashpad and sashwidth should not - # affect the panedwindow's geometry, since no sash should - # ever be drawn. - panedwindow .p -borderwidth $bd -sashpad $sp \ - -sashwidth $sw -handlesize 6 -showhandle $h - .p add [frame .p.f -width 20 -height 20 -bg red] -padx $h \ +} -cleanup { + deleteWindows +} -result [list [list 60 60] [list 80 60]] + +test panedwindow-19.7 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 20} + +test panedwindow-19.8 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {60 20} + +test panedwindow-19.9 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{20 0} {40 0}} + +test panedwindow-19.10 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{11 3 20 20} {53 3 20 20} {95 3 20 20}} + +test panedwindow-19.11 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 0 \ + -orient vertical -sashwidth 0 -handlesize 6 \ + -showhandle 0 + .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 20} + +test panedwindow-19.12 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ -sticky "" - set result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .p.f - set result - } [list [expr {(2 * $bd) + 20 + (2 * $h)}] \ - [expr {(2 * $bd) + 20}]] - - test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ - {ComputeGeometry, three panes, reqsize set properly} { - panedwindow .p -borderwidth $bd -sashpad $sp \ - -sashwidth $sw -handlesize 6 -showhandle $h - foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ - -sticky "" - } - set result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .p.f1 .p.f2 .p.f3 - set result - } [list [expr {(2 * $bd) + ($h?12:(2*$sw)) + (4*$sp) + 60}] \ - [expr {(2 * $bd) + 20}]] - - test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ - {ComputeGeometry, sash coords} { - panedwindow .p -borderwidth $bd -sashpad $sp \ - -sashwidth $sw -handlesize 6 -showhandle $h - foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ - -sticky "" - } - set result [list [.p sash coord 0] [.p sash coord 1]] - destroy .p .f1 .f2 .f3 - set result - } [list [list [expr {$bd+20+($h?(6-$sw)/2:0)+$sp}] $bd] \ - [list [expr {$bd+40+($h?6+(6-$sw)/2:$sw)+(3*$sp)}] \ - $bd]] - - test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ - {ComputeGeometry/ArrangePanes, slave coords} { - panedwindow .p -borderwidth $bd -sashpad $sp \ - -sashwidth $sw -handlesize 6 -showhandle $h - foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ - -sticky nsew -pady 3 -padx 11 - } - pack .p - update - set result {} - foreach w {.p.f1 .p.f2 .p.f3} { - lappend result [list [winfo x $w] [winfo y $w] \ - [winfo width $w] [winfo height $w]] - } - destroy .p .p.f1 .p.f2 .p.f3 - set result - } [list [list [expr {$bd+11}] [expr {$bd+3}] 20 20] \ - [list [expr {$bd+53+($h?6:$sw)+(2*$sp)}] \ - [expr {$bd+3}] 20 20] \ - [list [expr {$bd+95+($h?12:2*$sw)+(4*$sp)}] \ - [expr {$bd+3}] 20 20]] - - test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ - {ComputeGeometry, one slave, vertical} { - # With just one slave, sashpad and sashwidth should not - # affect the panedwindow's geometry, since no sash should - # ever be drawn. - panedwindow .p -borderwidth $bd -sashpad $sp \ - -orient vertical -sashwidth $sw -handlesize 6 \ - -showhandle $h - .p add [frame .f -width 20 -height 20 -bg red] -pady $h \ + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 60} + +test panedwindow-19.13 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ -sticky "" - set result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .f - set result - } [list [expr {(2 * $bd) + 20}] \ - [expr {(2 * $bd) + 20 + (2 * $h)}]] - - test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ - {ComputeGeometry, three panes, vertical} { - panedwindow .p -borderwidth $bd -sashpad $sp \ - -sashwidth $sw -handlesize 6 -showhandle $h \ - -orient vertical - foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ - -sticky "" - } - set result [list [winfo reqwidth .p] [winfo reqheight .p]] - destroy .p .f1 .f2 .f3 - set result - } [list [expr {(2 * $bd) + 20}] \ - [expr {(2 * $bd) + ($h?12:(2*$sw)) + (4*$sp) + 60}]] - - test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ - {ComputeGeometry, sash coords, vertical} { - panedwindow .p -borderwidth $bd -sashpad $sp \ - -sashwidth $sw -handlesize 6 -showhandle $h \ - -orient vertical - foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ - -sticky "" - } - set result [list [.p sash coord 0] [.p sash coord 1]] - destroy .p .f1 .f2 .f3 - set result - } [list [list $bd [expr {$bd+20+($h?(6-$sw)/2:0)+$sp}]] \ - [list $bd \ - [expr {$bd+40+($h?6+(6-$sw)/2:$sw)+(3*$sp)}]]] - - test panedwindow-20.[incr i]-$bd-$sp-$sw-$h \ - {ComputeGeometry/ArrangePanes, slave coords, vert} { - panedwindow .p -borderwidth $bd -sashpad $sp \ - -sashwidth $sw -handlesize 6 -showhandle $h \ - -orient vertical - foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ - -sticky nsew -pady 11 -padx 3 - } - pack .p - update - set result {} - foreach w {.p.f1 .p.f2 .p.f3} { - lappend result [list [winfo x $w] [winfo y $w] \ - [winfo width $w] [winfo height $w]] - } - destroy .p .p.f1 .p.f2 .p.f3 - set result - } [list [list [expr {$bd+3}] [expr {$bd+11}] 20 20] \ - [list [expr {$bd+3}] \ - [expr {$bd+53+($h?6:$sw)+(2*$sp)}] 20 20] \ - [list [expr {$bd+3}] \ - [expr {$bd+95+($h?12:2*$sw)+(4*$sp)}] 20 20]] - } - } - } -} - -test panedwindow-21.1 {destroyed widgets are removed from panedwindow} { + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{0 20} {0 40}} + +test panedwindow-19.14 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{3 11 20 20} {3 53 20 20} {3 95 20 20}} +test panedwindow-19.15 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {22 20} + +test panedwindow-19.16 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {72 20} + +test panedwindow-19.17 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{23 0} {49 0}} + +test panedwindow-19.18 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{11 3 20 20} {59 3 20 20} {107 3 20 20}} + +test panedwindow-19.19 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 0 \ + -orient vertical -sashwidth 0 -handlesize 6 \ + -showhandle 1 + .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 22} + +test panedwindow-19.20 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 72} + +test panedwindow-19.21 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{0 23} {0 49}} + +test panedwindow-19.22 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{3 11 20 20} {3 59 20 20} {3 107 20 20}} +test panedwindow-19.23 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 20} + +test panedwindow-19.24 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {66 20} + +test panedwindow-19.25 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{20 0} {43 0}} + +test panedwindow-19.26 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{11 3 20 20} {56 3 20 20} {101 3 20 20}} + +test panedwindow-19.27 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 0 \ + -orient vertical -sashwidth 3 -handlesize 6 \ + -showhandle 0 + .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 20} + +test panedwindow-19.28 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 66} + +test panedwindow-19.29 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{0 20} {0 43}} + +test panedwindow-19.30 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{3 11 20 20} {3 56 20 20} {3 101 20 20}} +test panedwindow-19.31 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {22 20} + +test panedwindow-19.32 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {72 20} + +test panedwindow-19.33 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{21 0} {47 0}} + +test panedwindow-19.34 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{11 3 20 20} {59 3 20 20} {107 3 20 20}} + +test panedwindow-19.35 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 0 \ + -orient vertical -sashwidth 3 -handlesize 6 \ + -showhandle 1 + .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 22} + +test panedwindow-19.36 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 72} + +test panedwindow-19.37 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{0 21} {0 47}} + +test panedwindow-19.38 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{3 11 20 20} {3 59 20 20} {3 107 20 20}} +test panedwindow-19.39 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 20} + +test panedwindow-19.40 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {80 20} + +test panedwindow-19.41 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{25 0} {55 0}} + +test panedwindow-19.42 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{11 3 20 20} {63 3 20 20} {115 3 20 20}} + +test panedwindow-19.43 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 5 \ + -orient vertical -sashwidth 0 -handlesize 6 \ + -showhandle 0 + .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 20} + +test panedwindow-19.44 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 80} + +test panedwindow-19.45 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{0 25} {0 55}} + +test panedwindow-19.46 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{3 11 20 20} {3 63 20 20} {3 115 20 20}} +test panedwindow-19.47 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {22 20} + +test panedwindow-19.48 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {92 20} + +test panedwindow-19.49 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{28 0} {64 0}} + +test panedwindow-19.50 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{11 3 20 20} {69 3 20 20} {127 3 20 20}} + +test panedwindow-19.51 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 5 \ + -orient vertical -sashwidth 0 -handlesize 6 \ + -showhandle 1 + .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 22} + +test panedwindow-19.52 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 92} + +test panedwindow-19.53 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{0 28} {0 64}} + +test panedwindow-19.54 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{3 11 20 20} {3 69 20 20} {3 127 20 20}} +test panedwindow-19.55 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 20} + +test panedwindow-19.56 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {86 20} + +test panedwindow-19.57 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{25 0} {58 0}} + +test panedwindow-19.58 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{11 3 20 20} {66 3 20 20} {121 3 20 20}} + +test panedwindow-19.59 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 5 \ + -orient vertical -sashwidth 3 -handlesize 6 \ + -showhandle 0 + .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 20} + +test panedwindow-19.60 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 86} + +test panedwindow-19.61 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{0 25} {0 58}} + +test panedwindow-19.62 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{3 11 20 20} {3 66 20 20} {3 121 20 20}} +test panedwindow-19.63 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {22 20} + +test panedwindow-19.64 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {92 20} + +test panedwindow-19.65 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{26 0} {62 0}} + +test panedwindow-19.66 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{11 3 20 20} {69 3 20 20} {127 3 20 20}} + +test panedwindow-19.67 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 0 -sashpad 5 \ + -orient vertical -sashwidth 3 -handlesize 6 \ + -showhandle 1 + .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 22} + +test panedwindow-19.68 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {20 92} + +test panedwindow-19.69 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{0 26} {0 62}} + +test panedwindow-19.70 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 0 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{3 11 20 20} {3 69 20 20} {3 127 20 20}} +test panedwindow-19.71 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 24} + +test panedwindow-19.72 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {64 24} + +test panedwindow-19.73 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{22 2} {42 2}} + +test panedwindow-19.74 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{13 5 20 20} {55 5 20 20} {97 5 20 20}} + +test panedwindow-19.75 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 0 \ + -orient vertical -sashwidth 0 -handlesize 6 \ + -showhandle 0 + .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 24} + +test panedwindow-19.76 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 64} + +test panedwindow-19.77 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{2 22} {2 42}} + +test panedwindow-19.78 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{5 13 20 20} {5 55 20 20} {5 97 20 20}} +test panedwindow-19.79 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {26 24} + +test panedwindow-19.80 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {76 24} + +test panedwindow-19.81 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{25 2} {51 2}} + +test panedwindow-19.82 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{13 5 20 20} {61 5 20 20} {109 5 20 20}} + +test panedwindow-19.83 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 0 \ + -orient vertical -sashwidth 0 -handlesize 6 \ + -showhandle 1 + .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 26} + +test panedwindow-19.84 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 76} + +test panedwindow-19.85 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{2 25} {2 51}} + +test panedwindow-19.86 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{5 13 20 20} {5 61 20 20} {5 109 20 20}} +test panedwindow-19.87 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 24} + +test panedwindow-19.88 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {70 24} + +test panedwindow-19.89 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{22 2} {45 2}} + +test panedwindow-19.90 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{13 5 20 20} {58 5 20 20} {103 5 20 20}} + +test panedwindow-19.91 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 0 \ + -orient vertical -sashwidth 3 -handlesize 6 \ + -showhandle 0 + .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 24} + +test panedwindow-19.92 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 70} + +test panedwindow-19.93 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{2 22} {2 45}} + +test panedwindow-19.94 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{5 13 20 20} {5 58 20 20} {5 103 20 20}} +test panedwindow-19.95 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {26 24} + +test panedwindow-19.96 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {76 24} + +test panedwindow-19.97 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{23 2} {49 2}} + +test panedwindow-19.98 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{13 5 20 20} {61 5 20 20} {109 5 20 20}} + +test panedwindow-19.99 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 0 \ + -orient vertical -sashwidth 3 -handlesize 6 \ + -showhandle 1 + .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 26} + +test panedwindow-19.100 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 76} + +test panedwindow-19.101 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{2 23} {2 49}} + +test panedwindow-19.102 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 0 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{5 13 20 20} {5 61 20 20} {5 109 20 20}} +test panedwindow-19.103 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 24} + +test panedwindow-19.104 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {84 24} + +test panedwindow-19.105 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{27 2} {57 2}} + +test panedwindow-19.106 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{13 5 20 20} {65 5 20 20} {117 5 20 20}} + +test panedwindow-19.107 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 5 \ + -orient vertical -sashwidth 0 -handlesize 6 \ + -showhandle 0 + .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 24} + +test panedwindow-19.108 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 84} + +test panedwindow-19.109 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{2 27} {2 57}} + +test panedwindow-19.110 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{5 13 20 20} {5 65 20 20} {5 117 20 20}} +test panedwindow-19.111 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {26 24} + +test panedwindow-19.112 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {96 24} + +test panedwindow-19.113 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{30 2} {66 2}} + +test panedwindow-19.114 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{13 5 20 20} {71 5 20 20} {129 5 20 20}} + +test panedwindow-19.115 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 5 \ + -orient vertical -sashwidth 0 -handlesize 6 \ + -showhandle 1 + .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 26} + +test panedwindow-19.116 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 96} + +test panedwindow-19.117 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{2 30} {2 66}} + +test panedwindow-19.118 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 0 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{5 13 20 20} {5 71 20 20} {5 129 20 20}} +test panedwindow-19.119 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 24} + +test panedwindow-19.120 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {90 24} + +test panedwindow-19.121 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{27 2} {60 2}} + +test panedwindow-19.122 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{13 5 20 20} {68 5 20 20} {123 5 20 20}} + +test panedwindow-19.123 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 5 \ + -orient vertical -sashwidth 3 -handlesize 6 \ + -showhandle 0 + .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 24} + +test panedwindow-19.124 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 90} + +test panedwindow-19.125 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{2 27} {2 60}} + +test panedwindow-19.126 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 0 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{5 13 20 20} {5 68 20 20} {5 123 20 20}} +test panedwindow-19.127 {ComputeGeometry, one slave, reqsize set properly} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {26 24} + +test panedwindow-19.128 {ComputeGeometry, three panes, reqsize set properly} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {96 24} + +test panedwindow-19.129 {ComputeGeometry, sash coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{28 2} {64 2}} + +test panedwindow-19.130 {ComputeGeometry/ArrangePanes, slave coords} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 3 -padx 11 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{13 5 20 20} {71 5 20 20} {129 5 20 20}} + +test panedwindow-19.131 {ComputeGeometry, one slave, vertical} -setup { + deleteWindows +} -body { + # With just one slave, sashpad and sashwidth should not + # affect the panedwindow's geometry, since no sash should + # ever be drawn. + panedwindow .p -borderwidth 2 -sashpad 5 \ + -orient vertical -sashwidth 3 -handlesize 6 \ + -showhandle 1 + .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + -sticky "" + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 26} + +test panedwindow-19.132 {ComputeGeometry, three panes, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [winfo reqwidth .p] [winfo reqheight .p] +} -cleanup { + deleteWindows +} -result {24 96} + +test panedwindow-19.133 {ComputeGeometry, sash coords, vertical} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.f1 .f2 .f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky "" + } + list [.p sash coord 0] [.p sash coord 1] +} -cleanup { + deleteWindows +} -result {{2 28} {2 64}} + +test panedwindow-19.134 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup { + deleteWindows +} -body { + panedwindow .p -borderwidth 2 -sashpad 5 \ + -sashwidth 3 -handlesize 6 -showhandle 1 \ + -orient vertical + foreach w {.p.f1 .p.f2 .p.f3} { + .p add [frame $w -width 20 -height 20 -bg blue] \ + -sticky nsew -pady 11 -padx 3 + } + pack .p + update + set result {} + foreach w {.p.f1 .p.f2 .p.f3} { + lappend result [list [winfo x $w] [winfo y $w] \ + [winfo width $w] [winfo height $w]] + } + return $result +} -cleanup { + deleteWindows +} -result {{5 13 20 20} {5 71 20 20} {5 129 20 20}} + + +test panedwindow-20.1 {destroyed widgets are removed from panedwindow} -setup { + deleteWindows +} -body { panedwindow .p .p add [frame .f -width 20 -height 20 -bg blue] destroy .f - set result [.p panes] - destroy .p - set result -} {} -test panedwindow-21.2 {destroyed slave causes geometry recomputation} { + .p panes +} -cleanup { + deleteWindows +} -result {} +test panedwindow-20.2 {destroyed slave causes geometry recomputation} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] destroy .f - set result [winfo reqwidth .p] - destroy .p .f2 - set result -} 20 + winfo reqwidth .p +} -cleanup { + deleteWindows +} -result 20 -test panedwindow-22.1 {ArrangePanes, extra space is given to the last pane} { + +test panedwindow-21.1 {ArrangePanes, extra space is given to the last pane} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew place .p -width 100 -x 0 -y 0 update - set result [winfo width .f2] - destroy .p .f1 .f2 - set result -} 78 -test panedwindow-22.2 {ArrangePanes, extra space is given to the last pane} { + winfo width .f2 +} -cleanup { + deleteWindows +} -result 78 +test panedwindow-21.2 {ArrangePanes, extra space is given to the last pane} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew place .p -height 100 -x 0 -y 0 update - set result [winfo height .f2] - destroy .p .f1 .f2 - set result -} 78 -test panedwindow-22.3 {ArrangePanes, explicit height/width are preferred} { + winfo height .f2 +} -cleanup { + deleteWindows +} -result 78 +test panedwindow-21.3 {ArrangePanes, explicit height/width are preferred} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky "" .p paneconfigure .f1 -width 10 -height 15 pack .p update - set result [list [winfo width .f1] [winfo height .f1]] - destroy .p .f1 .f2 - set result -} {10 15} -test panedwindow-22.4 {ArrangePanes, panes clipped by size of pane} { + list [winfo width .f1] [winfo height .f1] +} -cleanup { + deleteWindows +} -result {10 15} +test panedwindow-21.4 {ArrangePanes, panes clipped by size of pane} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] .p sash place 0 10 0 pack .p update - set result [list [winfo width .f1] [winfo height .f1]] - destroy .p .f1 .f2 - set result -} {10 20} -test panedwindow-22.5 {ArrangePanes, panes clipped by size of pane} { + list [winfo width .f1] [winfo height .f1] +} -cleanup { + deleteWindows +} -result {10 20} +test panedwindow-21.5 {ArrangePanes, panes clipped by size of pane} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical .p add [frame .f1 -width 20 -height 20 -bg blue] \ @@ -1826,32 +4391,38 @@ test panedwindow-22.5 {ArrangePanes, panes clipped by size of pane} { .p sash place 0 0 10 pack .p update - set result [list [winfo width .f1] [winfo height .f1]] - destroy .p .f1 .f2 - set result -} {20 10} -test panedwindow-22.6 {ArrangePanes, height of pane taken from total height} { + list [winfo width .f1] [winfo height .f1] +} -cleanup { + deleteWindows +} -result {20 10} +test panedwindow-21.6 {ArrangePanes, height of pane taken from total height} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ [frame .p.f2 -width 20 -height 40 -bg red] -sticky "" pack .p update - set result [list [winfo y .p.f1]] - destroy .p .p.f1 .p.f2 - set result -} 10 -test panedwindow-22.8 {ArrangePanes, width of pane taken from total width} { + winfo y .p.f1 +} -cleanup { + deleteWindows +} -result 10 +test panedwindow-21.7 {ArrangePanes, width of pane taken from total width} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ [frame .p.f2 -width 40 -height 40 -bg red] -sticky "" pack .p update - set result [list [winfo x .p.f1]] - destroy .p .p.f1 .p.f2 - set result -} 10 -test panedwindow-22.9 {ArrangePanes, panes with width <= 0 are unmapped} { + winfo x .p.f1 +} -cleanup { + deleteWindows +} -result 10 +test panedwindow-21.8 {ArrangePanes, panes with width <= 0 are unmapped} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 40 -bg red] @@ -1861,10 +4432,12 @@ test panedwindow-22.9 {ArrangePanes, panes with width <= 0 are unmapped} { .p sash place 0 0 0 update lappend result [winfo ismapped .f1] - destroy .p .f1 .f2 - set result -} {1 0} -test panedwindow-22.10 {ArrangePanes, panes with width <= 0 are unmapped} { +} -cleanup { + deleteWindows +} -result {1 0} +test panedwindow-21.9 {ArrangePanes, panes with width <= 0 are unmapped} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ [frame .p.f2 -width 20 -height 40 -bg red] @@ -1874,10 +4447,12 @@ test panedwindow-22.10 {ArrangePanes, panes with width <= 0 are unmapped} { .p sash place 0 0 0 update lappend result [winfo ismapped .p.f1] - destroy .p .p.f1 .p.f2 - set result -} {1 0} -test panedwindow-22.11 {ArrangePanes, panes with width <= 0 are unmapped} { +} -cleanup { + deleteWindows +} -result {1 0} +test panedwindow-21.10 {ArrangePanes, panes with width <= 0 are unmapped} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 -orient vertical .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ [frame .p.f2 -width 20 -height 40 -bg red] @@ -1887,32 +4462,37 @@ test panedwindow-22.11 {ArrangePanes, panes with width <= 0 are unmapped} { .p sash place 0 0 0 update lappend result [winfo ismapped .p.f1] - destroy .p .p.f1 .p.f2 - set result -} {1 0} -test panedwindow-22.12 {ArrangePanes, last pane shrinks} { +} -cleanup { + deleteWindows +} -result {1 0} +test panedwindow-21.11 {ArrangePanes, last pane shrinks} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew place .p -width 40 -x 0 -y 0 update - set result [winfo width .f2] - destroy .p .f1 .f2 - set result -} 18 -test panedwindow-22.13 {ArrangePanes, last pane shrinks} { + winfo width .f2 +} -cleanup { + deleteWindows +} -result 18 +test panedwindow-21.12 {ArrangePanes, last pane shrinks} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical .p add [frame .f1 -width 20 -height 20 -bg blue] \ [frame .f2 -width 20 -height 20 -bg red] -sticky nsew place .p -height 40 -x 0 -y 0 update - set result [winfo height .f2] - destroy .p .f1 .f2 - set result -} 18 -test panedwindow-22.14 {ArrangePanes, panedwindow resizes} { - -body { + winfo height .f2 +} -cleanup { + deleteWindows +} -result 18 +test panedwindow-21.13 {ArrangePanes, panedwindow resizes} -setup { + deleteWindows +} -body { panedwindow .p -width 200 -borderwidth 0 frame .f1 -height 50 -bg blue set result [list] @@ -1920,12 +4500,12 @@ test panedwindow-22.14 {ArrangePanes, panedwindow resizes} { .p add .f1 pack .p lappend result [winfo reqwidth .p] [winfo reqheight .p] - } - -cleanup {destroy .p .f1} - -result {200 1 200 50} -} -test panedwindow-22.15 {ArrangePanes, panedwindow resizes} { - -body { +} -cleanup { + deleteWindows +} -result {200 1 200 50} +test panedwindow-21.14 {ArrangePanes, panedwindow resizes} -setup { + deleteWindows +} -body { panedwindow .p -height 200 -borderwidth 0 -orient vertical frame .f1 -width 50 -bg blue set result [list] @@ -1933,12 +4513,12 @@ test panedwindow-22.15 {ArrangePanes, panedwindow resizes} { .p add .f1 pack .p lappend result [winfo reqwidth .p] [winfo reqheight .p] - } - -cleanup {destroy .p .f1} - -result {1 200 50 200} -} -test panedwindow-22.16 {ArrangePanes, last pane grows} { - -body { +} -cleanup { + deleteWindows +} -result {1 200 50 200} +test panedwindow-21.15 {ArrangePanes, last pane grows} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -height 50 .p add [frame .f1 -width 50 -bg red] [frame .f2 -width 50 -bg white] \ [frame .f3 -width 50 -bg blue] [frame .f4 -width 50 -bg green] @@ -1952,13 +4532,14 @@ test panedwindow-22.16 {ArrangePanes, last pane grows} { update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] [winfo width .p] - } - -cleanup {destroy .p .f1 .f2 .f3 .f4} - -result {50 150 1 1 211 50 150 1 89 300} -} +} -cleanup { + deleteWindows +} -result {50 150 1 1 211 50 150 1 89 300} -test panedwindow-23.1 {PanedWindowReqProc, react to slave geometry changes} { +test panedwindow-22.1 {PanedWindowReqProc, react to slave geometry changes} -setup { + deleteWindows +} -body { # Basically just want to make sure that the PanedWindowReqProc is called panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 20 -height 20 -bg blue] \ @@ -1966,10 +4547,12 @@ test panedwindow-23.1 {PanedWindowReqProc, react to slave geometry changes} { set result [winfo reqheight .p] .f1 configure -height 80 lappend result [winfo reqheight .p] - destroy .p .f1 .f2 - set result -} {40 80} -test panedwindow-23.2 {PanedWindowReqProc, react to slave geometry changes} { +} -cleanup { + deleteWindows +} -result {40 80} +test panedwindow-22.2 {PanedWindowReqProc, react to slave geometry changes} -setup { + deleteWindows +} -body { panedwindow .p -orient horizontal -sashpad 0 -sashwidth 2 .p add [frame .f1 -width 10] [frame .f2 -width 10] set result [winfo reqwidth .p] @@ -1977,111 +4560,139 @@ test panedwindow-23.2 {PanedWindowReqProc, react to slave geometry changes} { lappend result [winfo reqwidth .p] destroy .p .f1 .f2 expr {[lindex $result 1] - [lindex $result 0]} -} {10} +} -cleanup { + deleteWindows +} -result {10} -test panedwindow-24.1 {ConfigurePanes, can't add panedwindow to itself} { +test panedwindow-23.1 {ConfigurePanes, can't add panedwindow to itself} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p add .p} msg] $msg] - destroy .p - set result -} [list 1 "can't add .p to itself"] -test panedwindow-24.2 {ConfigurePanes, bad window throws error} { + .p add .p +} -cleanup { + deleteWindows +} -returnCodes error -result {can't add .p to itself} +test panedwindow-23.2 {ConfigurePanes, bad window throws error} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p add .b} msg] $msg] - destroy .p - set result -} [list 1 "bad window path name \".b\""] -test panedwindow-24.3 {ConfigurePanes, bad window aborts processing} { + .p add .b +} -cleanup { + deleteWindows +} -returnCodes error -result {bad window path name ".b"} +test panedwindow-23.3 {ConfigurePanes, bad window aborts processing} -setup { + deleteWindows +} -body { panedwindow .p button .b catch {.p add .b .a} - set result [.p panes] - destroy .p .b - set result -} {} -test panedwindow-24.4 {ConfigurePanes, bad option aborts processing} { + .p panes +} -cleanup { + deleteWindows +} -result {} +test panedwindow-23.4 {ConfigurePanes, bad option aborts processing} -setup { + deleteWindows +} -body { panedwindow .p button .b catch {.p add .b -sticky foobar} - set result [.p panes] - destroy .p .b - set result -} {} -test panedwindow-24.5 {ConfigurePanes, after win isn't managed by panedwin} { + .p panes +} -cleanup { + deleteWindows +} -result {} +test panedwindow-23.5 {ConfigurePanes, after win isn't managed by panedwin} -setup { + deleteWindows +} -body { panedwindow .p button .b button .c - set result [list [catch {.p add .b -after .c} msg] $msg] - destroy .p .b .c - set result -} [list 1 "window \".c\" is not managed by .p"] -test panedwindow-24.6 {ConfigurePanes, before win isn't managed by panedwin} { + .p add .b -after .c +} -cleanup { + deleteWindows +} -returnCodes error -result {window ".c" is not managed by .p} +test panedwindow-23.6 {ConfigurePanes, before win isn't managed by panedwin} -setup { + deleteWindows +} -body { panedwindow .p button .b button .c - set result [list [catch {.p add .b -before .c} msg] $msg] - destroy .p .b .c - set result -} [list 1 "window \".c\" is not managed by .p"] -test panedwindow-24.7 {ConfigurePanes, -after {} is a no-op} { + .p add .b -before .c +} -cleanup { + deleteWindows +} -returnCodes error -result {window ".c" is not managed by .p} +test panedwindow-23.7 {ConfigurePanes, -after {} is a no-op} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] .p paneconfigure .b -after {} - set result [.p panes] - destroy .p .b .c - set result -} {.b .c} -test panedwindow-24.8 {ConfigurePanes, -before {} is a no-op} { + .p panes +} -cleanup { + deleteWindows +} -result {.b .c} +test panedwindow-23.8 {ConfigurePanes, -before {} is a no-op} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] .p paneconfigure .b -before {} - set result [.p panes] - destroy .p .b .c - set result -} {.b .c} -test panedwindow-24.9 {ConfigurePanes, new panes are added} { + .p panes +} -cleanup { + deleteWindows +} -result {.b .c} +test panedwindow-23.9 {ConfigurePanes, new panes are added} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] - set result [.p panes] - destroy .p .b .c - set result -} {.b .c} -test panedwindow-24.10 {ConfigurePanes, options applied to all panes} { + .p panes +} -cleanup { + deleteWindows +} -result {.b .c} +test panedwindow-23.10 {ConfigurePanes, options applied to all panes} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] [button .c] -sticky ne -height 5 -width 5 -minsize 10 set result {} foreach w {.b .c} { - set val {} - foreach option {-sticky -height -width -minsize} { - lappend val $option [.p panecget $w $option] - } - lappend result $w $val + set val {} + foreach option {-sticky -height -width -minsize} { + lappend val $option [.p panecget $w $option] + } + lappend result $w $val } - destroy .p .b .c - set result -} [list .b {-sticky ne -height 5 -width 5 -minsize 10} \ - .c {-sticky ne -height 5 -width 5 -minsize 10}] -test panedwindow-24.11 {ConfigurePanes, existing panes are reconfigured} { + return $result +} -cleanup { + deleteWindows +} -result {.b {-sticky ne -height 5 -width 5 -minsize 10} .c {-sticky ne -height 5 -width 5 -minsize 10}} + +test panedwindow-23.11 {ConfigurePanes, existing panes are reconfigured} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] -sticky nw -height 10 .p add .b [button .c] -sticky se -height 2 - set result [list [.p panes] \ - [.p panecget .b -sticky] [.p panecget .b -height] \ - [.p panecget .c -sticky] [.p panecget .c -height]] - destroy .p .b .c - set result -} [list {.b .c} es 2 es 2] -test panedwindow-24.12 {ConfigurePanes, widgets added to end by default} { + list [.p panes] [.p panecget .b -sticky] [.p panecget .b -height] \ + [.p panecget .c -sticky] [.p panecget .c -height] +} -cleanup { + deleteWindows +} -result [list {.b .c} es 2 es 2] +test panedwindow-23.12 {ConfigurePanes, widgets added to end by default} -setup { + deleteWindows +} -body { panedwindow .p .p add [button .b] .p add [button .c] .p add [button .d] - set result [.p panes] - destroy .p .b .c .d - set result -} {.b .c .d} -test panedwindow-24.13 {ConfigurePanes, -after, single addition} { + .p panes +} -cleanup { + deleteWindows +} -result {.b .c .d} +test panedwindow-23.13 {ConfigurePanes, -after, single addition} -setup { + deleteWindows +} -body { panedwindow .p button .a button .b @@ -2089,11 +4700,13 @@ test panedwindow-24.13 {ConfigurePanes, -after, single addition} { .p add .a .b .p add .c -after .a - set result [.p panes] - destroy .p .a .b .c - set result -} {.a .c .b} -test panedwindow-24.14 {ConfigurePanes, -after, multiple additions} { + .p panes +} -cleanup { + deleteWindows +} -result {.a .c .b} +test panedwindow-23.14 {ConfigurePanes, -after, multiple additions} -setup { + deleteWindows +} -body { panedwindow .p button .a button .b @@ -2102,11 +4715,13 @@ test panedwindow-24.14 {ConfigurePanes, -after, multiple additions} { .p add .a .b .p add .c .d -after .a - set result [.p panes] - destroy .p .a .b .c .d - set result -} {.a .c .d .b} -test panedwindow-24.15 {ConfigurePanes, -after, relocates existing widget} { + .p panes +} -cleanup { + deleteWindows +} -result {.a .c .d .b} +test panedwindow-23.15 {ConfigurePanes, -after, relocates existing widget} -setup { + deleteWindows +} -body { panedwindow .p button .a button .b @@ -2115,11 +4730,13 @@ test panedwindow-24.15 {ConfigurePanes, -after, relocates existing widget} { .p add .a .b .c .d .p add .d -after .a - set result [.p panes] - destroy .p .a .b .c .d - set result -} {.a .d .b .c} -test panedwindow-24.16 {ConfigurePanes, -after, relocates existing widgets} { + .p panes +} -cleanup { + deleteWindows +} -result {.a .d .b .c} +test panedwindow-23.16 {ConfigurePanes, -after, relocates existing widgets} -setup { + deleteWindows +} -body { panedwindow .p button .a button .b @@ -2128,11 +4745,13 @@ test panedwindow-24.16 {ConfigurePanes, -after, relocates existing widgets} { .p add .a .b .c .d .p add .b .d -after .a - set result [.p panes] - destroy .p .a .b .c .d - set result -} {.a .b .d .c} -test panedwindow-24.17 {ConfigurePanes, -after, relocates existing widgets} { + .p panes +} -cleanup { + deleteWindows +} -result {.a .b .d .c} +test panedwindow-23.17 {ConfigurePanes, -after, relocates existing widgets} -setup { + deleteWindows +} -body { panedwindow .p button .a button .b @@ -2141,11 +4760,13 @@ test panedwindow-24.17 {ConfigurePanes, -after, relocates existing widgets} { .p add .a .b .c .d .p add .d .a -after .b - set result [.p panes] - destroy .p .a .b .c .d - set result -} {.b .d .a .c} -test panedwindow-24.18 {ConfigurePanes, -after, relocates existing widgets} { + .p panes +} -cleanup { + deleteWindows +} -result {.b .d .a .c} +test panedwindow-23.18 {ConfigurePanes, -after, relocates existing widgets} -setup { + deleteWindows +} -body { panedwindow .p button .a button .b @@ -2154,11 +4775,13 @@ test panedwindow-24.18 {ConfigurePanes, -after, relocates existing widgets} { .p add .a .b .c .d .p add .d .a -after .a - set result [.p panes] - destroy .p .a .b .c .d - set result -} {.d .a .b .c} -test panedwindow-24.19 {ConfigurePanes, -after, after last window} { + .p panes +} -cleanup { + deleteWindows +} -result {.d .a .b .c} +test panedwindow-23.19 {ConfigurePanes, -after, after last window} -setup { + deleteWindows +} -body { panedwindow .p button .a button .b @@ -2167,11 +4790,13 @@ test panedwindow-24.19 {ConfigurePanes, -after, after last window} { .p add .a .b .c .p add .d -after .c - set result [.p panes] - destroy .p .a .b .c .d - set result -} {.a .b .c .d} -test panedwindow-24.20 {ConfigurePanes, -before, before first window} { + .p panes +} -cleanup { + deleteWindows +} -result {.a .b .c .d} +test panedwindow-23.20 {ConfigurePanes, -before, before first window} -setup { + deleteWindows +} -body { panedwindow .p button .a button .b @@ -2180,11 +4805,13 @@ test panedwindow-24.20 {ConfigurePanes, -before, before first window} { .p add .a .b .c .p add .d -before .a - set result [.p panes] - destroy .p .a .b .c .d - set result -} {.d .a .b .c} -test panedwindow-24.21 {ConfigurePanes, -before, relocate existing windows} { + .p panes +} -cleanup { + deleteWindows +} -result {.d .a .b .c} +test panedwindow-23.21 {ConfigurePanes, -before, relocate existing windows} -setup { + deleteWindows +} -body { panedwindow .p button .a button .b @@ -2193,11 +4820,13 @@ test panedwindow-24.21 {ConfigurePanes, -before, relocate existing windows} { .p add .a .b .c .p add .d .b -before .a - set result [.p panes] - destroy .p .a .b .c .d - set result -} {.d .b .a .c} -test panedwindow-24.22 {ConfigurePanes, slave specified multiple times} { + .p panes +} -cleanup { + deleteWindows +} -result {.d .b .a .c} +test panedwindow-23.22 {ConfigurePanes, slave specified multiple times} -setup { + deleteWindows +} -body { # This test should not cause a core dump panedwindow .p @@ -2206,11 +4835,13 @@ test panedwindow-24.22 {ConfigurePanes, slave specified multiple times} { button .c .p add .a .a .b .c - set result [.p panes] - destroy .p .a .b .c - set result -} {.a .b .c} -test panedwindow-24.23 {ConfigurePanes, slave specified multiple times} { + .p panes +} -cleanup { + deleteWindows +} -result {.a .b .c} +test panedwindow-23.23 {ConfigurePanes, slave specified multiple times} -setup { + deleteWindows +} -body { # This test should not cause a core dump panedwindow .p @@ -2220,52 +4851,63 @@ test panedwindow-24.23 {ConfigurePanes, slave specified multiple times} { .p add .a .a .b .c .p add .a .b .a -after .c - set result [.p panes] - destroy .p .a .b .c - set result -} {.c .a .b} -test panedwindow-24.24 {ConfigurePanes, panedwindow cannot manage toplevels} { + .p panes +} -cleanup { + deleteWindows +} -result {.c .a .b} +test panedwindow-23.24 {ConfigurePanes, panedwindow cannot manage toplevels} -setup { + deleteWindows +} -body { panedwindow .p toplevel .t - set result [list [catch {.p add .t} msg] $msg] - destroy .p .t - set result -} [list 1 "can't add toplevel .t to .p"] -test panedwindow-24.25 {ConfigurePanes, restrict possible panes} { + .p add .t +} -cleanup { + deleteWindows +} -returnCodes error -result {can't add toplevel .t to .p} +test panedwindow-23.25 {ConfigurePanes, restrict possible panes} -setup { + deleteWindows +} -body { panedwindow .p frame .f button .f.b - set result [list [catch {.p add .f.b} msg] $msg] - destroy .p .f .f.b - set result -} [list 1 "can't add .f.b to .p"] -test panedwindow-24.26 {ConfigurePanes, restrict possible panes} { + .p add .f.b +} -cleanup { + deleteWindows +} -returnCodes error -result {can't add .f.b to .p} +test panedwindow-23.26 {ConfigurePanes, restrict possible panes} -setup { + deleteWindows +} -body { frame .f panedwindow .f.p button .b - set result [list [catch {.f.p add .b} msg] $msg] - destroy .f.p .f .b - set result -} [list 0 ""] -test panedwindow-24.27 {ConfigurePanes, restrict possible panes} { + .f.p add .b +} -cleanup { + deleteWindows +} -result {} +test panedwindow-23.27 {ConfigurePanes, restrict possible panes} -setup { + deleteWindows +} -body { panedwindow .p button .p.b - set result [list [catch {.p add .p.b} msg] $msg] - destroy .p .p.b - set result -} [list 0 ""] -test panedwindow-24.28 {ConfigurePanes, restrict possible panes} { + .p add .p.b +} -cleanup { + deleteWindows +} -result {} +test panedwindow-23.28 {ConfigurePanes, restrict possible panes} -setup { + deleteWindows +} -body { frame .f frame .f.f frame .f.f.f panedwindow .f.f.f.p button .b - set result [list [catch {.f.f.f.p add .b} msg] $msg] - destroy .f .f.f .f.f.f .f.f.f.p .b - set result -} [list 0 ""] -test panedwindow-24.29.1 {ConfigurePanes, -hide works} { - -body { + .f.f.f.p add .b +} -cleanup { + deleteWindows +} -result {} +test panedwindow-23.29 {ConfigurePanes, -hide works} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false frame .f1 -width 40 -height 100 -bg red frame .f2 -width 40 -height 100 -bg white @@ -2285,12 +4927,12 @@ test panedwindow-24.29.1 {ConfigurePanes, -hide works} { [winfo ismapped .f3] [winfo ismapped .f4] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] [winfo width .p] - } - -cleanup {destroy .p .f1 .f2 .f3 .f4} - -result {1 1 1 1 40 40 40 40 171 1 0 1 1 40 40 40 40 128} -} -test panedwindow-24.29.2 {ConfigurePanes, -hide works} { - -body { +} -cleanup { + deleteWindows +} -result {1 1 1 1 40 40 40 40 171 1 0 1 1 40 40 40 40 128} +test panedwindow-23.30 {ConfigurePanes, -hide works} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -width 130 -height 100 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white @@ -2310,12 +4952,12 @@ test panedwindow-24.29.2 {ConfigurePanes, -hide works} { [winfo ismapped .f3] [winfo ismapped .f4] lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] [winfo width .p] - } - -cleanup {destroy .p .f1 .f2 .f3 .f4} - -result {1 1 1 0 39 40 40 1 130 1 0 1 1 40 40 40 42 130} -} -test panedwindow-24.29.3 {ConfigurePanes, -hide works, last pane stretches} { - -body { +} -cleanup { + deleteWindows +} -result {1 1 1 0 39 40 40 1 130 1 0 1 1 40 40 40 42 130} +test panedwindow-23.31 {ConfigurePanes, -hide works, last pane stretches} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -width 200 -height 200 -borderwidth 0 frame .f1 -width 50 -bg red frame .f2 -width 50 -bg green @@ -2327,13 +4969,13 @@ test panedwindow-24.29.3 {ConfigurePanes, -hide works, last pane stretches} { lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] .p paneconfigure .f2 -hide 1 update - lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] - } - -cleanup {destroy .p .f1 .f2 .f3} - -result {50 50 94 50 50 147} -} -test panedwindow-24.29.4 {ConfigurePanes, -hide works, last pane stretches} { - -body { + lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] +} -cleanup { + deleteWindows +} -result {50 50 94 50 50 147} +test panedwindow-23.32 {ConfigurePanes, -hide works, last pane stretches} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -width 200 -height 200 \ -borderwidth 0 -orient vertical frame .f1 -height 50 -bg red @@ -2347,13 +4989,13 @@ test panedwindow-24.29.4 {ConfigurePanes, -hide works, last pane stretches} { .p paneconfigure .f2 -hide 1 update lappend result [winfo height .f1] [winfo height .f2] [winfo height .f3] - } - -cleanup {destroy .p .f1 .f2 .f3} - -result {50 50 94 50 50 147} -} +} -cleanup { + deleteWindows +} -result {50 50 94 50 50 147} -test panedwindow-24.30 {ConfigurePanes, -stretch first} { - -body { +test panedwindow-23.33 {ConfigurePanes, -stretch first} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -height 100 -width 182 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white @@ -2369,12 +5011,12 @@ test panedwindow-24.30 {ConfigurePanes, -stretch first} { update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] - } - -cleanup {destroy .p .f1 .f2 .f3 .f4} - -result {51 40 40 40 94 40 40 40} -} -test panedwindow-24.31 {ConfigurePanes, -stretch middle} { - -body { +} -cleanup { + deleteWindows +} -result {51 40 40 40 94 40 40 40} +test panedwindow-23.34 {ConfigurePanes, -stretch middle} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -height 100 -width 182 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white @@ -2390,12 +5032,12 @@ test panedwindow-24.31 {ConfigurePanes, -stretch middle} { update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] - } - -cleanup {destroy .p .f1 .f2 .f3 .f4} - -result {40 45 46 40 40 45 94 40} -} -test panedwindow-24.32 {ConfigurePanes, -stretch always} { - -body { +} -cleanup { + deleteWindows +} -result {40 45 46 40 40 45 94 40} +test panedwindow-23.35 {ConfigurePanes, -stretch always} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -height 100 -width 182 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white @@ -2411,12 +5053,12 @@ test panedwindow-24.32 {ConfigurePanes, -stretch always} { update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] - } - -cleanup {destroy .p .f1 .f2 .f3 .f4} - -result {42 43 43 43 58 43 58 58} -} -test panedwindow-24.33 {ConfigurePanes, -stretch never} { - -body { +} -cleanup { + deleteWindows +} -result {42 43 43 43 58 43 58 58} +test panedwindow-23.36 {ConfigurePanes, -stretch never} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -height 100 -width 182 frame .f1 -width 40 -bg red frame .f2 -width 40 -bg white @@ -2432,12 +5074,14 @@ test panedwindow-24.33 {ConfigurePanes, -stretch never} { update lappend result [winfo width .f1] [winfo width .f2] [winfo width .f3] \ [winfo width .f4] - } - -cleanup {destroy .p .f1 .f2 .f3 .f4} - -result {40 40 40 40 40 40 40 40} -} +} -cleanup { + deleteWindows +} -result {40 40 40 40 40 40 40 40} + -test panedwindow-25.1 {Unlink, remove a paned with -before/-after refs} { +test panedwindow-24.1 {Unlink, remove a paned with -before/-after refs} -setup { + deleteWindows +} -body { # Bug 928413 set result {} panedwindow .pw @@ -2452,22 +5096,27 @@ test panedwindow-25.1 {Unlink, remove a paned with -before/-after refs} { lappend result [.pw panecget .pw.l2 -before] .pw paneconfigure .pw.l2 -before .pw.l1 lappend result [.pw panecget .pw.l2 -before] - destroy .pw - set result -} {.pw.l3 {} .pw.l1} +} -cleanup { + deleteWindows +} -result {.pw.l3 {} .pw.l1} -test panedwindow-26.1 {DestroyPanedWindow} { + +test panedwindow-25.1 {DestroyPanedWindow} -setup { + deleteWindows +} -body { # This test should not result in any memory leaks. panedwindow .p foreach w {.a .b .c .d .e .f .g .h .i .j .k .l .m .n .o .q .r .s .t} { - .p add [button $w] + .p add [button $w] } foreach w {.a .b .c .d .e .f .g .h .i .j .k .l .m .n .o .p .q .r .s .t} { - destroy $w + destroy $w } set result {} -} {} -test panedwindow-26.2 {UnmapNotify and MapNotify events are propagated to slaves} { +} -result {} +test panedwindow-25.2 {UnmapNotify and MapNotify events are propagated to slaves} -setup { + deleteWindows +} -body { panedwindow .pw .pw add [button .pw.b] pack .pw @@ -2483,301 +5132,371 @@ test panedwindow-26.2 {UnmapNotify and MapNotify events are propagated to slaves lappend result [winfo ismapped .pw.b] destroy .pw .pw.b set result -} {1 0 0 1 1} +} -cleanup { + deleteWindows +} -result {1 0 0 1 1} + -test panedwindow-27.1 {PanedWindowIdentifyCoords} { +test panedwindow-26.1 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 0 0] - destroy .p .f .f2 - set result -} {} -test panedwindow-27.2 {PanedWindowIdentifyCoords, padding is included} { + .p identify 0 0 +} -cleanup { + deleteWindows +} -result {} +test panedwindow-26.2 {PanedWindowIdentifyCoords, padding is included} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 20 0] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.3 {PanedWindowIdentifyCoords} { + .p identify 20 0 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.3 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 22 0] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.4 {PanedWindowIdentifyCoords} { + .p identify 22 0 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.4 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 24 0] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.5 {PanedWindowIdentifyCoords} { + .p identify 24 0 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.5 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 26 0] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.6 {PanedWindowIdentifyCoords} { + .p identify 26 0 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.6 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 26 -1] - destroy .p .f .f2 - set result -} {} -test panedwindow-27.7 {PanedWindowIdentifyCoords} { + .p identify 26 -1 +} -cleanup { + deleteWindows +} -result {} +test panedwindow-26.7 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 26 100] - destroy .p .f .f2 - set result -} {} -test panedwindow-27.8 {PanedWindowIdentifyCoords} { + .p identify 26 100 +} -cleanup { + deleteWindows +} -result {} +test panedwindow-26.8 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 22 4] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.9 {PanedWindowIdentifyCoords} { + .p identify 22 4 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.9 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 22 5] - destroy .p .f .f2 - set result -} {0 handle} -test panedwindow-27.10 {PanedWindowIdentifyCoords} { + .p identify 22 5 +} -cleanup { + deleteWindows +} -result {0 handle} +test panedwindow-26.10 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 20 5] - destroy .p .f .f2 - set result -} {0 handle} -test panedwindow-27.11 {PanedWindowIdentifyCoords} { + .p identify 20 5 +} -cleanup { + deleteWindows +} -result {0 handle} +test panedwindow-26.11 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 20 0] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.12 {PanedWindowIdentifyCoords} { + .p identify 20 0 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.12 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -bd 0 -sashwidth 2 -sashpad 2 .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] \ [frame .f3 -bg green -width 20 -height 20] - set result [.p identify 48 0] - destroy .p .f .f2 .f3 - set result -} {1 sash} -test panedwindow-27.13 {identify subcommand errors} { + .p identify 48 0 +} -cleanup { + deleteWindows +} -result {1 sash} +test panedwindow-26.13 {identify subcommand errors} -setup { + deleteWindows +} -body { panedwindow .p -borderwidth 0 -sashpad 2 -sashwidth 4 - set result [list [catch {.p identify} msg] $msg] - destroy .p - set result -} [list 1 "wrong # args: should be \".p identify x y\""] -test panedwindow-27.14 {identify subcommand errors} { + .p identify +} -cleanup { + deleteWindows +} -returnCodes error -result {wrong # args: should be ".p identify x y"} +test panedwindow-26.14 {identify subcommand errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p identify foo bar} msg] $msg] - destroy .p - set result -} [list 1 "expected integer but got \"foo\""] -test panedwindow-27.14a {identify subcommand errors} { + .p identify foo bar +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "foo"} +test panedwindow-26.15 {identify subcommand errors} -setup { + deleteWindows +} -body { panedwindow .p - set result [list [catch {.p identify 0 bar} msg] $msg] - destroy .p - set result -} [list 1 "expected integer but got \"bar\""] -test panedwindow-27.15 {PanedWindowIdentifyCoords} { + .p identify 0 bar +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "bar"} +test panedwindow-26.16 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 0 0] - destroy .p .f .f2 - set result -} {} -test panedwindow-27.16 {PanedWindowIdentifyCoords, padding is included} { + .p identify 0 0 +} -cleanup { + deleteWindows +} -result {} +test panedwindow-26.17 {PanedWindowIdentifyCoords, padding is included} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 0 20] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.17 {PanedWindowIdentifyCoords} { + .p identify 0 20 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.18 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 0 22] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.18 {PanedWindowIdentifyCoords} { + .p identify 0 22 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.19 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 0 24] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.19 {PanedWindowIdentifyCoords} { + .p identify 0 24 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.20 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 0 26] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.20 {PanedWindowIdentifyCoords} { + .p identify 0 26 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.21 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify -1 26] - destroy .p .f .f2 - set result -} {} -test panedwindow-27.21 {PanedWindowIdentifyCoords} { + .p identify -1 26 +} -cleanup { + deleteWindows +} -result {} +test panedwindow-26.22 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 100 26] - destroy .p .f .f2 - set result -} {} -test panedwindow-27.22 {PanedWindowIdentifyCoords} { + .p identify 100 26 +} -cleanup { + deleteWindows +} -result {} +test panedwindow-26.23 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 4 22] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.23 {PanedWindowIdentifyCoords} { + .p identify 4 22 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.24 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 5 22] - destroy .p .f .f2 - set result -} {0 handle} -test panedwindow-27.24 {PanedWindowIdentifyCoords} { + .p identify 5 22 +} -cleanup { + deleteWindows +} -result {0 handle} +test panedwindow-26.25 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 5 20] - destroy .p .f .f2 - set result -} {0 handle} -test panedwindow-27.25 {PanedWindowIdentifyCoords} { + .p identify 5 20 +} -cleanup { + deleteWindows +} -result {0 handle} +test panedwindow-26.26 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] - set result [.p identify 0 20] - destroy .p .f .f2 - set result -} {0 sash} -test panedwindow-27.26 {PanedWindowIdentifyCoords} { + .p identify 0 20 +} -cleanup { + deleteWindows +} -result {0 sash} +test panedwindow-26.27 {PanedWindowIdentifyCoords} -setup { + deleteWindows +} -body { panedwindow .p -showhandle false -bd 0 -sashwidth 2 -sashpad 2 -orient vertical .p add [frame .f -bg red -width 20 -height 20] \ [frame .f2 -bg blue -width 20 -height 20] \ [frame .f3 -bg green -width 20 -height 20] - set result [.p identify 0 48] - destroy .p .f .f2 .f3 - set result -} {1 sash} - -test panedwindow-28.1 {destroy the window cleanly on error [Bug #616589]} { - list [catch {panedwindow .p -bogusopt bogus} msg] $msg -} {1 {unknown option "-bogusopt"}} -test panedwindow-28.2 {destroy the window cleanly on rename [Bug #616589]} { + .p identify 0 48 +} -cleanup { + deleteWindows +} -result {1 sash} + + +test panedwindow-27.1 {destroy the window cleanly on error [Bug #616589]} -setup { + deleteWindows +} -body { + panedwindow .p -bogusopt bogus +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown option "-bogusopt"} +test panedwindow-27.2 {destroy the window cleanly on rename [Bug #616589]} -setup { + deleteWindows +} -body { destroy .p panedwindow .p rename .p {} winfo exists .p -} {0} - - -test panedwindow-29.1 {resizing width} { - -body { - panedwindow .p -bd 5 - frame .f1 -width 100 -height 50 -bg blue - frame .f2 -width 100 -height 50 -bg red - - .p add .f1 -sticky news - .p add .f2 -sticky news - pack .p -side top -fill both -expand 1 - wm geometry . "" - update - # Note the width - set a [winfo width .f2] - # Increase the size by 10 - regexp {^(\d+)x(\d+)} [wm geometry .] -> w h - wm geometry . [expr {$w + 10}]x$h - update - set b "$a [winfo width .f2]" - } - -cleanup {destroy .p .f1 .f2} - -result {100 110} -} - -test panedwindow-29.2 {resizing height} { - -body { - panedwindow .p -orient vertical -bd 5 - frame .f1 -width 50 -height 100 -bg blue - frame .f2 -width 50 -height 100 -bg red - - .p add .f1 -sticky news - .p add .f2 -sticky news - pack .p -side top -fill both -expand 1 - wm geometry . "" - update - # Note the height - set a [winfo height .f2] - # Increase the size by 10 - regexp {^(\d+)x(\d+)} [wm geometry .] -> w h - wm geometry . ${w}x[expr {$h + 10}] - update - set b "$a [winfo height .f2]" - } - -cleanup {destroy .p .f1 .f2} - -result {100 110} -} - -test panedwindow-30.1 {display on depths other than the default one} { - -constraints {pseudocolor8 haveTruecolor24} - -body { +} -cleanup { + deleteWindows +} -result {0} + + +test panedwindow-28.1 {resizing width} -setup { + deleteWindows +} -body { + panedwindow .p -bd 5 + frame .f1 -width 100 -height 50 -bg blue + frame .f2 -width 100 -height 50 -bg red + + .p add .f1 -sticky news + .p add .f2 -sticky news + pack .p -side top -fill both -expand 1 + wm geometry . "" + update + # Note the width + set a [winfo width .f2] + # Increase the size by 10 + regexp {^(\d+)x(\d+)} [wm geometry .] -> w h + wm geometry . [expr {$w + 10}]x$h + update + set b "$a [winfo width .f2]" +} -cleanup { + deleteWindows +} -result {100 110} + +test panedwindow-28.2 {resizing height} -setup { + deleteWindows +} -body { + panedwindow .p -orient vertical -bd 5 + frame .f1 -width 50 -height 100 -bg blue + frame .f2 -width 50 -height 100 -bg red + + .p add .f1 -sticky news + .p add .f2 -sticky news + pack .p -side top -fill both -expand 1 + wm geometry . "" + update + # Note the height + set a [winfo height .f2] + # Increase the size by 10 + regexp {^(\d+)x(\d+)} [wm geometry .] -> w h + wm geometry . ${w}x[expr {$h + 10}] + update + set b "$a [winfo height .f2]" +} -cleanup { + deleteWindows +} -result {100 110} + + +test panedwindow-29.1 {display on depths other than the default one} -constraints { + pseudocolor8 haveTruecolor24 +} -setup { + deleteWindows +} -body { toplevel .t -visual {truecolor 24} pack [panedwindow .t.p] .t.p add [frame .t.p.f1] [frame .t.p.f2] update # If we got here, we didn't crash and that's good - } - -cleanup {destroy .t} - -result {} -} -test panedwindow-30.2 {display on depths other than the default one} { - -constraints {pseudocolor8 haveTruecolor24} - -body { +} -cleanup { + deleteWindows +} -result {} +test panedwindow-29.2 {display on depths other than the default one} -constraints { + pseudocolor8 haveTruecolor24 +} -setup { + deleteWindows +} -body { toplevel .t -visual {pseudocolor 8} pack [frame .t.f -visual {truecolor 24}] pack [panedwindow .t.f.p] @@ -2788,11 +5507,13 @@ test panedwindow-30.2 {display on depths other than the default one} { .t.f.p proxy forget update # If we got here, we didn't crash and that's good - } - -cleanup {destroy .t} - -result {} -} +} -cleanup { + deleteWindows +} -result {} + # cleanup cleanupTests return + + diff --git a/tests/place.test b/tests/place.test index ac2ece7..ddfa64c 100644 --- a/tests/place.test +++ b/tests/place.test @@ -5,7 +5,8 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands @@ -15,6 +16,7 @@ testConstraint memory [llength [info commands memory]] # XXX - This test file is woefully incomplete. At present, only a # few of the features are tested. +# Widgets used in tests 1.* - 8.* toplevel .t -width 300 -height 200 -bd 0 wm geom .t +0+0 frame .t.f -width 154 -height 84 -bd 2 -relief raised @@ -22,145 +24,181 @@ place .t.f -x 48 -y 38 frame .t.f2 -width 30 -height 60 -bd 2 -relief raised update -test place-1.1 {Tk_PlaceCmd procedure, "info" option} { +test place-1.1 {Tk_PlaceCmd procedure, "info" option} -setup { + place forget .t.f2 +} -body { place .t.f2 -x 0 place info .t.f2 -} {-in .t -x 0 -relx 0 -y 0 -rely 0 -width {} -relwidth {} -height {} -relheight {} -anchor nw -bordermode inside} -test place-1.2 {Tk_PlaceCmd procedure, "info" option} { +} -result {-in .t -x 0 -relx 0 -y 0 -rely 0 -width {} -relwidth {} -height {} -relheight {} -anchor nw -bordermode inside} +test place-1.2 {Tk_PlaceCmd procedure, "info" option} -setup { + place forget .t.f2 +} -body { place .t.f2 -x 1 -y 2 -width 3 -height 4 -relx 0.1 -rely 0.2 \ - -relwidth 0.3 -relheight 0.4 -anchor se -in .t.f \ - -bordermode outside + -relwidth 0.3 -relheight 0.4 -anchor se -in .t.f \ + -bordermode outside place info .t.f2 -} {-in .t.f -x 1 -relx 0.1 -y 2 -rely 0.2 -width 3 -relwidth 0.3 -height 4 -relheight 0.4 -anchor se -bordermode outside} -test place-1.3 {Tk_PlaceCmd procedure, "info" option} { +} -result {-in .t.f -x 1 -relx 0.1 -y 2 -rely 0.2 -width 3 -relwidth 0.3 -height 4 -relheight 0.4 -anchor se -bordermode outside} +test place-1.3 {Tk_PlaceCmd procedure, "info" option} -setup { + place forget .t.f2 + destroy .t.a.b +} -body { # Make sure the result is built as a proper list by using a space in parent frame ".t.a b" place .t.f2 -x 1 -y 2 -width {} -height 4 -relx 0.2 -rely 0.2 \ - -relwidth 0.3 -relheight {} -anchor w -in ".t.a b" \ - -bordermode ignore - set res [place info .t.f2] - destroy ".t.a b" - set res -} {-in {.t.a b} -x 1 -relx 0.2 -y 2 -rely 0.2 -width {} -relwidth 0.3 -height 4 -relheight {} -anchor w -bordermode ignore} - -test place-2.1 {ConfigureSlave procedure, -height option} { - list [catch {place .t.f2 -height abcd} msg] $msg -} {1 {bad screen distance "abcd"}} -test place-2.2 {ConfigureSlave procedure, -height option} { + -relwidth 0.3 -relheight {} -anchor w -in ".t.a b" \ + -bordermode ignore + place info .t.f2 +} -cleanup { + destroy ".t.a.b" +} -result {-in {.t.a b} -x 1 -relx 0.2 -y 2 -rely 0.2 -width {} -relwidth 0.3 -height 4 -relheight {} -anchor w -bordermode ignore} + + +test place-2.1 {ConfigureSlave procedure, -height option} -body { + place .t.f2 -height abcd +} -returnCodes error -result {bad screen distance "abcd"} +test place-2.2 {ConfigureSlave procedure, -height option} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -height 40 update winfo height .t.f2 -} {40} -test place-2.3 {ConfigureSlave procedure, -height option} { +} -result {40} +test place-2.3 {ConfigureSlave procedure, -height option} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -height 120 update place .t.f2 -height {} update winfo height .t.f2 -} {60} +} -result {60} -test place-3.1 {ConfigureSlave procedure, -relheight option} { - list [catch {place .t.f2 -relheight abcd} msg] $msg -} {1 {expected floating-point number but got "abcd"}} -test place-3.2 {ConfigureSlave procedure, -relheight option} { + +test place-3.1 {ConfigureSlave procedure, -relheight option} -body { + place .t.f2 -relheight abcd +} -returnCodes error -result {expected floating-point number but got "abcd"} +test place-3.2 {ConfigureSlave procedure, -relheight option} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -relheight .5 update winfo height .t.f2 -} {40} -test place-3.3 {ConfigureSlave procedure, -relheight option} { +} -result {40} +test place-3.3 {ConfigureSlave procedure, -relheight option} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -relheight .8 update place .t.f2 -relheight {} update winfo height .t.f2 -} {60} +} -result {60} + -test place-4.1 {ConfigureSlave procedure, bad -in options} { +test place-4.1 {ConfigureSlave procedure, bad -in options} -setup { + place forget .t.f2 +} -body { + place .t.f2 -in .t.f2 +} -returnCodes error -result {can't place .t.f2 relative to itself} +test place-4.2 {ConfigureSlave procedure, bad -in option} -setup { place forget .t.f2 - list [catch {place .t.f2 -in .t.f2} msg] $msg -} [list 1 "can't place .t.f2 relative to itself"] -test place-4.2 {ConfigureSlave procedure, bad -in option} { +} -body { + set result [list [winfo manager .t.f2]] + catch {place .t.f2 -in .t.f2} + lappend result [winfo manager .t.f2] +} -result {{} {}} +test place-4.3 {ConfigureSlave procedure, bad -in option} -setup { place forget .t.f2 - list [winfo manager .t.f2] \ - [catch {place .t.f2 -in .t.f2} err] $err \ - [winfo manager .t.f2] -} {{} 1 {can't place .t.f2 relative to itself} {}} -test place-4.3 {ConfigureSlave procedure, bad -in option} { +} -body { + winfo manager .t.f2 + place .t.f2 -in .t.f2 +} -returnCodes error -result {can't place .t.f2 relative to itself} +test place-4.4 {ConfigureSlave procedure, bad -in option} -setup { place forget .t.f2 - list [catch {place .t.f2 -in .} msg] $msg -} [list 1 "can't place .t.f2 relative to ."] +} -body { + place .t.f2 -in . +} -returnCodes error -result {can't place .t.f2 relative to .} -test place-5.1 {ConfigureSlave procedure, -relwidth option} { - list [catch {place .t.f2 -relwidth abcd} msg] $msg -} {1 {expected floating-point number but got "abcd"}} -test place-5.2 {ConfigureSlave procedure, -relwidth option} { + +test place-5.1 {ConfigureSlave procedure, -relwidth option} -body { + place .t.f2 -relwidth abcd +} -returnCodes error -result {expected floating-point number but got "abcd"} +test place-5.2 {ConfigureSlave procedure, -relwidth option} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -relwidth .5 update winfo width .t.f2 -} {75} -test place-5.3 {ConfigureSlave procedure, -relwidth option} { +} -result {75} +test place-5.3 {ConfigureSlave procedure, -relwidth option} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -relwidth .8 update place .t.f2 -relwidth {} update winfo width .t.f2 -} {30} +} -result {30} -test place-6.1 {ConfigureSlave procedure, -width option} { - list [catch {place .t.f2 -width abcd} msg] $msg -} {1 {bad screen distance "abcd"}} -test place-6.2 {ConfigureSlave procedure, -width option} { +test place-6.1 {ConfigureSlave procedure, -width option} -body { + place .t.f2 -width abcd +} -returnCodes error -result {bad screen distance "abcd"} +test place-6.2 {ConfigureSlave procedure, -width option} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -width 100 update winfo width .t.f2 -} {100} -test place-6.3 {ConfigureSlave procedure, -width option} { +} -result {100} +test place-6.3 {ConfigureSlave procedure, -width option} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -width 120 update place .t.f2 -width {} update winfo width .t.f2 -} {30} +} -result {30} + -test place-7.1 {ReconfigurePlacement procedure, computing position} { +test place-7.1 {ReconfigurePlacement procedure, computing position} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -x -2 -relx .5 -y 3 -rely .4 update winfo geometry .t.f2 -} {30x60+123+75} -test place-7.2 {ReconfigurePlacement procedure, position rounding} { +} -result {30x60+123+75} +test place-7.2 {ReconfigurePlacement procedure, position rounding} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -x -1.4 -y -2.3 update winfo geometry .t.f2 -} {30x60+49+38} -test place-7.3 {ReconfigurePlacement procedure, position rounding} { +} -result {30x60+49+38} +test place-7.3 {ReconfigurePlacement procedure, position rounding} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -x 1.4 -y 2.3 update winfo geometry .t.f2 -} {30x60+51+42} -test place-7.4 {ReconfigurePlacement procedure, position rounding} { +} -result {30x60+51+42} +test place-7.4 {ReconfigurePlacement procedure, position rounding} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -x -1.6 -y -2.7 update winfo geometry .t.f2 -} {30x60+48+37} -test place-7.5 {ReconfigurePlacement procedure, position rounding} { +} -result {30x60+48+37} +test place-7.5 {ReconfigurePlacement procedure, position rounding} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -x 1.6 -y 2.7 update winfo geometry .t.f2 -} {30x60+52+43} -test place-7.6 {ReconfigurePlacement procedure, position rounding} { +} -result {30x60+52+43} +test place-7.6 {ReconfigurePlacement procedure, position rounding} -setup { + destroy .t.f3 +} -body { frame .t.f3 -width 100 -height 100 -bg #f00000 -bd 0 place .t.f3 -x 0 -y 0 raise .t.f2 @@ -168,38 +206,44 @@ test place-7.6 {ReconfigurePlacement procedure, position rounding} { place .t.f2 -in .t.f3 -relx .303 -rely .406 -relwidth .304 -relheight .206 update winfo geometry .t.f2 -} {31x20+30+41} -catch {destroy .t.f3} -test place-7.7 {ReconfigurePlacement procedure, computing size} { +} -cleanup { + destroy .t.f3 +} -result {31x20+30+41} +test place-7.7 {ReconfigurePlacement procedure, computing size} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -width 120 -height 89 update list [winfo width .t.f2] [winfo height .t.f2] -} {120 89} -test place-7.8 {ReconfigurePlacement procedure, computing size} { +} -result {120 89} +test place-7.8 {ReconfigurePlacement procedure, computing size} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -relwidth .4 -relheight .5 update list [winfo width .t.f2] [winfo height .t.f2] -} {60 40} -test place-7.9 {ReconfigurePlacement procedure, computing size} { +} -result {60 40} +test place-7.9 {ReconfigurePlacement procedure, computing size} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -width 10 -relwidth .4 -height -4 -relheight .5 update list [winfo width .t.f2] [winfo height .t.f2] -} {70 36} -test place-7.10 {ReconfigurePlacement procedure, computing size} { +} -result {70 36} +test place-7.10 {ReconfigurePlacement procedure, computing size} -setup { place forget .t.f2 +} -body { place .t.f2 -in .t.f -width 10 -relwidth .4 -height -4 -relheight .5 place .t.f2 -width {} -relwidth {} -height {} -relheight {} update list [winfo width .t.f2] [winfo height .t.f2] -} {30 60} +} -result {30 60} -test place-8.1 {MasterStructureProc, mapping and unmapping slaves} { +test place-8.1 {MasterStructureProc, mapping and unmapping slaves} -setup { place forget .t.f2 place forget .t.f +} -body { place .t.f2 -relx 1.0 -rely 1.0 -anchor sw update set result [winfo ismapped .t.f2] @@ -212,10 +256,11 @@ test place-8.1 {MasterStructureProc, mapping and unmapping slaves} { wm deiconify .t update lappend result [winfo ismapped .t.f2] -} {1 0 40 30 0 1} -test place-8.2 {MasterStructureProc, mapping and unmapping slaves} { +} -result {1 0 40 30 0 1} +test place-8.2 {MasterStructureProc, mapping and unmapping slaves} -setup { place forget .t.f2 place forget .t.f +} -body { place .t.f -x 0 -y 0 -width 200 -height 100 place .t.f2 -in .t.f -relx 1.0 -rely 1.0 -anchor sw -width 50 -height 20 update @@ -229,130 +274,153 @@ test place-8.2 {MasterStructureProc, mapping and unmapping slaves} { wm deiconify .t update lappend result [winfo ismapped .t.f2] -} {1 0 42 32 0 1} - -test place-9.1 {PlaceObjCmd} { - list [catch {place} msg] $msg -} [list 1 "wrong # args: should be \"place option|pathName args\""] -test place-9.2 {PlaceObjCmd} { - list [catch {place foo} msg] $msg -} [list 1 "wrong # args: should be \"place option|pathName args\""] -test place-9.3 {PlaceObjCmd} { - catch {destroy .foo} - list [catch {place .foo bar} msg] $msg -} [list 1 "bad window path name \".foo\""] -test place-9.4 {PlaceObjCmd} { - catch {destroy .foo} - list [catch {place bar .foo} msg] $msg -} [list 1 "bad window path name \".foo\""] -test place-9.5 {PlaceObjCmd} { - catch {destroy .foo} +} -result {1 0 42 32 0 1} +destroy .t + + +test place-9.1 {PlaceObjCmd} -body { + place +} -returnCodes error -result {wrong # args: should be "place option|pathName args"} +test place-9.2 {PlaceObjCmd} -body { + place foo +} -returnCodes error -result {wrong # args: should be "place option|pathName args"} +test place-9.3 {PlaceObjCmd} -setup { + destroy .foo +} -body { + place .foo bar +} -returnCodes error -result {bad window path name ".foo"} +test place-9.4 {PlaceObjCmd} -setup { + destroy .foo +} -body { + place bar .foo +} -cleanup { + destroy .foo +} -returnCodes error -result {bad window path name ".foo"} +test place-9.5 {PlaceObjCmd} -setup { + destroy .foo +} -body { frame .foo - set res [list [catch {place badopt .foo} msg] $msg] + place badopt .foo +} -cleanup { destroy .foo - set res -} [list 1 "bad option \"badopt\": must be configure, forget, info, or slaves"] -test place-9.6 {PlaceObjCmd, configure errors} { - catch {destroy .foo} +} -returnCodes error -result {bad option "badopt": must be configure, forget, info, or slaves} +test place-9.6 {PlaceObjCmd, configure errors} -setup { + destroy .foo +} -body { frame .foo - set res [list [catch {place configure .foo} msg] $msg] + place configure .foo +} -cleanup { + destroy .foo +} -returnCodes ok -result {} +test place-9.7 {PlaceObjCmd, configure errors} -setup { destroy .foo - set res -} [list 0 ""] -test place-9.7 {PlaceObjCmd, configure errors} { - catch {destroy .foo} +} -body { frame .foo - set res [list [catch {place configure .foo bar} msg] $msg] + place configure .foo bar +} -cleanup { + destroy .foo +} -returnCodes ok -result {} +test place-9.8 {PlaceObjCmd, configure} -setup { destroy .foo - set res -} [list 0 ""] -test place-9.8 {PlaceObjCmd, configure} { - catch {destroy .foo} +} -body { frame .foo place .foo -x 0 -y 0 - set res [place configure .foo] + place configure .foo +} -cleanup { destroy .foo - set res -} [list {-anchor {} {} nw nw} {-bordermode {} {} inside inside} {-height {} {} {} {}} {-in {} {} {} .} {-relheight {} {} {} {}} {-relwidth {} {} {} {}} {-relx {} {} 0 0.0} {-rely {} {} 0 0.0} {-width {} {} {} {}} {-x {} {} 0 0} {-y {} {} 0 0}] -test place-9.9 {PlaceObjCmd, configure} { - catch {destroy .foo} +} -result [list {-anchor {} {} nw nw} {-bordermode {} {} inside inside} {-height {} {} {} {}} {-in {} {} {} .} {-relheight {} {} {} {}} {-relwidth {} {} {} {}} {-relx {} {} 0 0.0} {-rely {} {} 0 0.0} {-width {} {} {} {}} {-x {} {} 0 0} {-y {} {} 0 0}] +test place-9.9 {PlaceObjCmd, configure} -setup { + destroy .foo +} -body { frame .foo place .foo -x 0 -y 0 - set res [place configure .foo -x] + place configure .foo -x +} -cleanup { + destroy .foo +} -result {-x {} {} 0 0} +test place-9.10 {PlaceObjCmd, forget errors} -setup { destroy .foo - set res -} [list -x {} {} 0 0] -test place-9.10 {PlaceObjCmd, forget errors} { - catch {destroy .foo} +} -body { frame .foo - set res [list [catch {place forget .foo bar} msg] $msg] + place forget .foo bar +} -cleanup { destroy .foo - set res -} [list 1 "wrong # args: should be \"place forget pathName\""] -test place-9.11 {PlaceObjCmd, info errors} { - catch {destroy .foo} +} -returnCodes error -result {wrong # args: should be "place forget pathName"} +test place-9.11 {PlaceObjCmd, info errors} -setup { + destroy .foo +} -body { frame .foo - set res [list [catch {place info .foo bar} msg] $msg] + place info .foo bar +} -cleanup { + destroy .foo +} -returnCodes error -result {wrong # args: should be "place info pathName"} +test place-9.12 {PlaceObjCmd, slaves errors} -setup { destroy .foo - set res -} [list 1 "wrong # args: should be \"place info pathName\""] -test place-9.12 {PlaceObjCmd, slaves errors} { - catch {destroy .foo} +} -body { frame .foo - set res [list [catch {place slaves .foo bar} msg] $msg] + place slaves .foo bar +} -cleanup { destroy .foo - set res -} [list 1 "wrong # args: should be \"place slaves pathName\""] - -test place-10.1 {ConfigureSlave} { - catch {destroy .foo} +} -returnCodes error -result {wrong # args: should be "place slaves pathName"} + + +test place-10.1 {ConfigureSlave} -setup { + destroy .foo +} -body { frame .foo - set res [list [catch {place .foo -badopt} msg] $msg] + place .foo -badopt +} -cleanup { destroy .foo - set res -} [list 1 "unknown option \"-badopt\""] -test place-10.2 {ConfigureSlave} { - catch {destroy .foo} +} -returnCodes error -result {unknown option "-badopt"} +test place-10.2 {ConfigureSlave} -setup { + destroy .foo +} -body { frame .foo - set res [list [catch {place .foo -anchor} msg] $msg] + place .foo -anchor +} -cleanup { + destroy .foo +} -returnCodes error -result {value for "-anchor" missing} +test place-10.3 {ConfigureSlave} -setup { destroy .foo - set res -} [list 1 "value for \"-anchor\" missing"] -test place-10.3 {ConfigureSlave} { - catch {destroy .foo} +} -body { frame .foo - set res [list [catch {place .foo -bordermode j} msg] $msg] + place .foo -bordermode j +} -cleanup { + destroy .foo +} -returnCodes error -result {bad bordermode "j": must be inside, outside, or ignore} +test place-10.4 {ConfigureSlave} -setup { destroy .foo - set res -} [list 1 "bad bordermode \"j\": must be inside, outside, or ignore"] -test place-10.4 {ConfigureSlave} { - catch {destroy .foo} +} -body { frame .foo - set res [list [catch {place configure .foo -x 0 -y} msg] $msg] + place configure .foo -x 0 -y +} -cleanup { + destroy .foo +} -returnCodes error -result {value for "-y" missing} + + +test place-11.1 {PlaceObjCmd, slaves command} -setup { destroy .foo - set res -} [list 1 "value for \"-y\" missing"] - -test place-11.1 {PlaceObjCmd, slaves command} { - catch {destroy .foo} +} -body { frame .foo - set res [place slaves .foo] + place slaves .foo +} -cleanup { destroy .foo - set res -} {} -test place-11.2 {PlaceObjCmd, slaves command} { - catch {destroy .foo .bar} +} -result {} +test place-11.2 {PlaceObjCmd, slaves command} -setup { + destroy .foo .bar +} -body { frame .foo frame .bar place .bar -in .foo - set res [place slaves .foo] - destroy .foo - destroy .bar - set res -} [list .bar] + place slaves .foo +} -cleanup { + destroy .foo .bar +} -result [list .bar] + -test place-12.1 {PlaceObjCmd, forget command} { - catch {destroy .foo} +test place-12.1 {PlaceObjCmd, forget command} -setup { + destroy .foo +} -body { frame .foo place .foo -width 50 -height 50 update @@ -360,11 +428,14 @@ test place-12.1 {PlaceObjCmd, forget command} { place forget .foo update lappend res [winfo ismapped .foo] +} -cleanup { destroy .foo - set res -} [list 1 0] +} -result {1 0} + -test place-13.1 {test respect for internalborder} { +test place-13.1 {test respect for internalborder} -setup { + destroy .pack +} -body { toplevel .pack wm geometry .pack 200x200 frame .pack.l -width 15 -height 10 @@ -377,11 +448,13 @@ test place-13.1 {test respect for internalborder} { .pack.lf configure -labelanchor e -padx 3 -pady 5 update lappend res [winfo geometry .pack.lf.f] +} -cleanup { destroy .pack - set res -} {196x188+2+10 177x186+5+7} +} -result {196x188+2+10 177x186+5+7} -test place-14.1 {memory leak testing} -setup { + +test place-14.1 {memory leak testing} -constraints memory -setup { + destroy .f proc getbytes {} { set lines [split [memory info] "\n"] lindex [lindex $lines 3] 3 @@ -400,7 +473,7 @@ test place-14.1 {memory leak testing} -setup { } return $res } -} -constraints memory -body { +} -body { # Test all manners of forgetting a slave frame .f frame .f.f @@ -416,14 +489,16 @@ test place-14.1 {memory leak testing} -setup { frame .f frame .f.f } -} -result {0 0 0} -cleanup { +} -cleanup { destroy .f rename getbytes {} rename stress {} -} +} -result {0 0 0} -catch {destroy .t} # cleanup cleanupTests return + + + diff --git a/tests/raise.test b/tests/raise.test index a17fa2e..461ccbf 100644 --- a/tests/raise.test +++ b/tests/raise.test @@ -8,19 +8,20 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test # Procedure to create a bunch of overlapping windows, which should # make it easy to detect differences in order. proc raise_setup {} { foreach i [winfo child .raise] { - destroy $i - } + destroy $i + } foreach i {a b c d e} { - label .raise.$i -text $i -relief raised -bd 2 + label .raise.$i -text $i -relief raised -bd 2 } place .raise.a -x 20 -y 60 -width 60 -height 80 place .raise.b -x 60 -y 60 -width 60 -height 80 @@ -59,149 +60,173 @@ proc raise_makeToplevels {} { toplevel .raise wm geom .raise 250x200+0+0 -test raise-1.1 {preserve creation order} { + +test raise-1.1 {preserve creation order} -body { raise_setup tkwait visibility .raise.e raise_getOrder -} {d d d b c e e e} -test raise-1.2 {preserve creation order} testmakeexist { +} -result {d d d b c e e e} +test raise-1.2 {preserve creation order} -constraints testmakeexist -body { raise_setup testmakeexist .raise.a update raise_getOrder -} {d d d b c e e e} -test raise-1.3 {preserve creation order} testmakeexist { +} -result {d d d b c e e e} +test raise-1.3 {preserve creation order} -constraints testmakeexist -body { raise_setup testmakeexist .raise.c update raise_getOrder -} {d d d b c e e e} -test raise-1.4 {preserve creation order} testmakeexist { +} -result {d d d b c e e e} +test raise-1.4 {preserve creation order} -constraints testmakeexist -body { raise_setup testmakeexist .raise.e update raise_getOrder -} {d d d b c e e e} -test raise-1.5 {preserve creation order} testmakeexist { +} -result {d d d b c e e e} +test raise-1.5 {preserve creation order} -constraints testmakeexist -body { raise_setup testmakeexist .raise.d .raise.c .raise.b update raise_getOrder -} {d d d b c e e e} +} -result {d d d b c e e e} -test raise-2.1 {raise internal windows before creation} { + +test raise-2.1 {raise internal windows before creation} -body { raise_setup raise .raise.a update raise_getOrder -} {a d d a c a e e} -test raise-2.2 {raise internal windows before creation} { +} -result {a d d a c a e e} +test raise-2.2 {raise internal windows before creation} -body { raise_setup raise .raise.c update raise_getOrder -} {d d c b c e e c} -test raise-2.3 {raise internal windows before creation} { +} -result {d d c b c e e c} +test raise-2.3 {raise internal windows before creation} -body { raise_setup raise .raise.e update raise_getOrder -} {d d d b c e e e} -test raise-2.4 {raise internal windows before creation} { +} -result {d d d b c e e e} +test raise-2.4 {raise internal windows before creation} -body { raise_setup raise .raise.e .raise.a update raise_getOrder -} {d d d b c e b c} -test raise-2.5 {raise internal windows before creation} { +} -result {d d d b c e b c} +test raise-2.5 {raise internal windows before creation} -body { raise_setup raise .raise.a .raise.d update raise_getOrder -} {a d d a c e e e} +} -result {a d d a c e e e} + -test raise-3.1 {raise internal windows after creation} { +test raise-3.1 {raise internal windows after creation} -body { raise_setup update raise .raise.a .raise.d raise_getOrder -} {a d d a c e e e} -test raise-3.2 {raise internal windows after creation} testmakeexist { +} -result {a d d a c e e e} +test raise-3.2 {raise internal windows after creation} -constraints { + testmakeexist +} -body { raise_setup testmakeexist .raise.a .raise.b raise .raise.a .raise.b update raise_getOrder -} {d d d a c e e e} -test raise-3.3 {raise internal windows after creation} testmakeexist { +} -result {d d d a c e e e} +test raise-3.3 {raise internal windows after creation} -constraints { + testmakeexist +} -body { raise_setup testmakeexist .raise.a .raise.d raise .raise.a .raise.b update raise_getOrder -} {d d d a c e e e} -test raise-3.4 {raise internal windows after creation} testmakeexist { +} -result {d d d a c e e e} +test raise-3.4 {raise internal windows after creation} -constraints { + testmakeexist +} -body { raise_setup testmakeexist .raise.a .raise.c .raise.d raise .raise.a .raise.b update raise_getOrder -} {d d d a c e e e} +} -result {d d d a c e e e} -test raise-4.1 {raise relative to nephews} { + +test raise-4.1 {raise relative to nephews} -body { raise_setup update frame .raise.d.child raise .raise.a .raise.d.child raise_getOrder -} {a d d a c e e e} -test raise-4.2 {raise relative to nephews} { +} -result {a d d a c e e e} +test raise-4.2 {raise relative to nephews} -setup { + destroy .raise2 +} -body { raise_setup update frame .raise2 - list [catch {raise .raise.a .raise2} msg] $msg -} {1 {can't raise ".raise.a" above ".raise2"}} -catch {destroy .raise2} + raise .raise.a .raise2 +} -cleanup { + destroy .raise2 +} -returnCodes error -result {can't raise ".raise.a" above ".raise2"} -test raise-5.1 {lower internal windows} { + +test raise-5.1 {lower internal windows} -body { raise_setup update lower .raise.d raise_getOrder -} {a b c b c e e e} -test raise-5.2 {lower internal windows} { +} -result {a b c b c e e e} +test raise-5.2 {lower internal windows} -body { raise_setup update lower .raise.d .raise.b raise_getOrder -} {d b c b c e e e} -test raise-5.3 {lower internal windows} { +} -result {d b c b c e e e} +test raise-5.3 {lower internal windows} -body { raise_setup update lower .raise.a .raise.e raise_getOrder -} {a d d a c e e e} -test raise-5.4 {lower internal windows} { +} -result {a d d a c e e e} +test raise-5.4 {lower internal windows} -setup { + destroy .raise2 +} -body { raise_setup update frame .raise2 - list [catch {lower .raise.a .raise2} msg] $msg -} {1 {can't lower ".raise.a" below ".raise2"}} -catch {destroy .raise2} + lower .raise.a .raise2 +} -cleanup { + destroy .raise2 +} -returnCodes error -result {can't lower ".raise.a" below ".raise2"} -test raise-6.1 {raise/lower toplevel windows} {nonPortable} { + +test raise-6.1 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise1 winfo containing [winfo rootx .raise1] [winfo rooty .raise1] -} .raise1 -test raise-6.2 {raise/lower toplevel windows} {nonPortable} { +} -result {.raise1} +test raise-6.2 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise2 winfo containing [winfo rootx .raise1] [winfo rooty .raise1] -} .raise2 -test raise-6.3 {raise/lower toplevel windows} {nonPortable} { +} -result {.raise2} +test raise-6.3 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise3 @@ -214,8 +239,10 @@ test raise-6.3 {raise/lower toplevel windows} {nonPortable} { after 500 list $result [winfo containing [winfo rootx .raise1] \ [winfo rooty .raise1]] -} {.raise2 .raise1} -test raise-6.4 {raise/lower toplevel windows} {nonPortable} { +} -result {.raise2 .raise1} +test raise-6.4 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise2 @@ -230,14 +257,18 @@ test raise-6.4 {raise/lower toplevel windows} {nonPortable} { after 500 list $result [winfo containing [winfo rootx .raise2] \ [winfo rooty .raise2]] -} {.raise1 .raise3} -test raise-6.5 {raise/lower toplevel windows} {nonPortable} { +} -result {.raise1 .raise3} +test raise-6.5 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels raise .raise1 set time [lindex [time {raise .raise1}] 0] expr {$time < 2000000} -} 1 -test raise-6.6 {raise/lower toplevel windows} {nonPortable} { +} -result 1 +test raise-6.6 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise2 @@ -253,35 +284,37 @@ test raise-6.6 {raise/lower toplevel windows} {nonPortable} { after 500 list $result [winfo containing [winfo rootx .raise2] \ [winfo rooty .raise2]] -} {.raise1 .raise3} +} -result {.raise1 .raise3} + -test raise-7.1 {errors in raise/lower commands} { - list [catch {raise} msg] $msg -} {1 {wrong # args: should be "raise window ?aboveThis?"}} -test raise-7.2 {errors in raise/lower commands} { - list [catch {raise a b c} msg] $msg -} {1 {wrong # args: should be "raise window ?aboveThis?"}} -test raise-7.3 {errors in raise/lower commands} { - list [catch {raise badName} msg] $msg -} {1 {bad window path name "badName"}} -test raise-7.4 {errors in raise/lower commands} { - list [catch {raise . badName2} msg] $msg -} {1 {bad window path name "badName2"}} -test raise-7.5 {errors in raise/lower commands} { - list [catch {lower} msg] $msg -} {1 {wrong # args: should be "lower window ?belowThis?"}} -test raise-7.6 {errors in raise/lower commands} { - list [catch {lower a b c} msg] $msg -} {1 {wrong # args: should be "lower window ?belowThis?"}} -test raise-7.7 {errors in raise/lower commands} { - list [catch {lower badName3} msg] $msg -} {1 {bad window path name "badName3"}} -test raise-7.8 {errors in raise/lower commands} { - list [catch {lower . badName4} msg] $msg -} {1 {bad window path name "badName4"}} +test raise-7.1 {errors in raise/lower commands} -body { + raise +} -returnCodes error -result {wrong # args: should be "raise window ?aboveThis?"} +test raise-7.2 {errors in raise/lower commands} -body { + raise a b c +} -returnCodes error -result {wrong # args: should be "raise window ?aboveThis?"} +test raise-7.3 {errors in raise/lower commands} -body { + raise badName +} -returnCodes error -result {bad window path name "badName"} +test raise-7.4 {errors in raise/lower commands} -body { + raise . badName2 +} -returnCodes error -result {bad window path name "badName2"} +test raise-7.5 {errors in raise/lower commands} -body { + lower +} -returnCodes error -result {wrong # args: should be "lower window ?belowThis?"} +test raise-7.6 {errors in raise/lower commands} -body { + lower a b c +} -returnCodes error -result {wrong # args: should be "lower window ?belowThis?"} +test raise-7.7 {errors in raise/lower commands} -body { + lower badName3 +} -returnCodes error -result {bad window path name "badName3"} +test raise-7.8 {errors in raise/lower commands} -body { + lower . badName4 +} -returnCodes error -result {bad window path name "badName4"} deleteWindows # cleanup cleanupTests return + diff --git a/tests/safe.test b/tests/safe.test index 3e9f716..e7ed6c7 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1,14 +1,15 @@ -# This file is a Tcl script to test the Safe Tk facility. It is organized -# in the standard fashion for Tk tests. +# This file is a Tcl script to test the Safe Tk facility. It is organized in +# the standard fashion for Tk tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test ## NOTE: Any time tests fail here with an error like: @@ -27,190 +28,221 @@ tcltest::loadTestedCommands # This probably means that tk wasn't installed properly. ## it indicates that something went wrong sourcing tk.tcl. -## Ensure that any changes that occured to tk.tcl will work or -## are properly prevented in a safe interpreter. -- hobbs +## Ensure that any changes that occured to tk.tcl will work or are properly +## prevented in a safe interpreter. -- hobbs # The set of hidden commands is platform dependent: -if {[string equal $tcl_platform(platform) "windows"]} { - set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel unload wm} -} else { - set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel unload wm} +set hidden_cmds {bell cd clipboard encoding exec exit fconfigure glob grab load menu open pwd selection socket source toplevel unload wm} +lappend hidden_cmds {*}[apply {{} { + foreach cmd { + atime attributes copy delete dirname executable exists extension + isdirectory isfile link lstat mkdir mtime nativename normalize owned + readable readlink rename rootname size stat tail tempfile type + volumes writable + } {lappend result tcl:file:$cmd}; return $result +}}] +if {[tk windowingsystem] ne "x11"} { + lappend hidden_cmds tk_chooseColor tk_chooseDirectory tk_getOpenFile \ + tk_getSaveFile tk_messageBox +} +if {[llength [info commands send]]} { + lappend hidden_cmds send } set saveAutoPath $::auto_path set auto_path [list [info library] $::tk_library] - -test safe-1.1 {Safe Tk loading into an interpreter} { +set hidden_cmds [lsort $hidden_cmds] + +test safe-1.1 {Safe Tk loading into an interpreter} -setup { catch {safe::interpDelete a} +} -body { safe::loadTk [safe::interpCreate a] safe::interpDelete a set x {} - set x -} "" -test safe-1.2 {Safe Tk loading into an interpreter} { + return $x +} -result {} +test safe-1.2 {Safe Tk loading into an interpreter} -setup { catch {safe::interpDelete a} +} -body { safe::interpCreate a safe::loadTk a - set l [lsort [interp hidden a]] + lsort [interp hidden a] +} -cleanup { safe::interpDelete a - set l -} $hidden_cmds -test safe-1.3 {Safe Tk loading into an interpreter} -body { +} -result $hidden_cmds +test safe-1.3 {Safe Tk loading into an interpreter} -setup { catch {safe::interpDelete a} +} -body { safe::interpCreate a safe::loadTk a - set l [lsort [interp aliases a]] + lsort [interp aliases a] +} -cleanup { safe::interpDelete a - set l -} -match glob -result {*encoding*exit*file*load*source*} +} -match glob -result {*encoding*exit*glob*load*source*} -test safe-2.1 {Unsafe commands not available} { +test safe-2.1 {Unsafe commands not available} -setup { catch {safe::interpDelete a} +} -body { safe::interpCreate a safe::loadTk a set status broken if {[catch {interp eval a {toplevel .t}} msg]} { set status ok } + return $status +} -cleanup { safe::interpDelete a - set status -} ok -test safe-2.2 {Unsafe commands not available} { +} -result ok +test safe-2.2 {Unsafe commands not available} -setup { catch {safe::interpDelete a} +} -body { safe::interpCreate a safe::loadTk a set status broken if {[catch {interp eval a {menu .m}} msg]} { set status ok } + return $status +} -cleanup { safe::interpDelete a - set status -} ok -test safe-2.3 {Unsafe subcommands not available} { +} -result ok +test safe-2.3 {Unsafe subcommands not available} -setup { catch {safe::interpDelete a} +} -body { safe::interpCreate a safe::loadTk a set status broken if {[catch {interp eval a {tk appname}} msg]} { set status ok } - safe::interpDelete a list $status $msg -} {ok {appname not accessible in a safe interpreter}} -test safe-2.4 {Unsafe subcommands not available} { +} -cleanup { + safe::interpDelete a +} -result {ok {appname not accessible in a safe interpreter}} +test safe-2.4 {Unsafe subcommands not available} -setup { catch {safe::interpDelete a} +} -body { safe::interpCreate a safe::loadTk a set status broken if {[catch {interp eval a {tk scaling}} msg]} { set status ok } - safe::interpDelete a list $status $msg -} {ok {scaling not accessible in a safe interpreter}} +} -cleanup { + safe::interpDelete a +} -result {ok {scaling not accessible in a safe interpreter}} -test safe-3.1 {Unsafe commands are available hidden} { +test safe-3.1 {Unsafe commands are available hidden} -setup { catch {safe::interpDelete a} +} -body { safe::interpCreate a safe::loadTk a set status ok if {[catch {interp invokehidden a toplevel .t} msg]} { set status broken } + return $status +} -cleanup { safe::interpDelete a - set status -} ok -test safe-3.2 {Unsafe commands are available hidden} { +} -result ok +test safe-3.2 {Unsafe commands are available hidden} -setup { catch {safe::interpDelete a} +} -body { safe::interpCreate a safe::loadTk a set status ok if {[catch {interp invokehidden a menu .m} msg]} { set status broken } + return $status +} -cleanup { safe::interpDelete a - set status -} ok +} -result ok -test safe-4.1 {testing loadTk} { - # no error shall occur, the user will - # eventually see a new toplevel +test safe-4.1 {testing loadTk} -body { + # no error shall occur, the user will eventually see a new toplevel set i [safe::loadTk [safe::interpCreate]] interp eval $i {button .b -text "hello world!"; pack .b} - # lets don't update because it might imply that the user has - # to position the window (if the wm does not do it automatically) - # and thus make the test suite not runable non interactively + # lets don't update because it might imply that the user has to position + # the window (if the wm does not do it automatically) and thus make the + # test suite not runable non interactively safe::interpDelete $i -} {} - -test safe-4.2 {testing loadTk -use} { +} -result {} +test safe-4.2 {testing loadTk -use} -setup { + destroy .safeTkFrame +} -body { set w .safeTkFrame - catch {destroy $w} frame $w -container 1; - pack .safeTkFrame + pack $w set i [safe::loadTk [safe::interpCreate] -use [winfo id $w]] interp eval $i {button .b -text "hello world!"; pack .b} safe::interpDelete $i destroy $w -} {} +} -result {} -test safe-5.1 {loading Tk in safe interps without master's clearance} { +test safe-5.1 {loading Tk in safe interps without master's clearance} -body { set i [safe::interpCreate] - catch {interp eval $i {load {} Tk}} msg + interp eval $i {load {} Tk} +} -cleanup { safe::interpDelete $i - set msg -} {not allowed to start Tk by master's safe::TkInit} - -test safe-5.2 {multi-level Tk loading with clearance} { - # No error shall occur in that test and no window - # shall remain at the end. - set i [safe::interpCreate] - set j [list $i x] - set j [safe::interpCreate $j] - safe::loadTk $j - interp eval $j { +} -returnCodes error -result {not allowed to start Tk by master's safe::TkInit} +test safe-5.2 {multi-level Tk loading with clearance} -setup { + set safeParent [safe::interpCreate] +} -body { + # No error shall occur in that test and no window shall remain at the end. + set i [safe::interpCreate [list $safeParent x]] + safe::loadTk $i + interp eval $i { button .b -text Ok -command {destroy .} pack .b # tkwait window . ; # for interactive testing/debugging } - safe::interpDelete $j - safe::interpDelete $i -} {} - -test safe-6.1 {loadTk -use windowPath} { +} -cleanup { + catch {safe::interpDelete $i} + safe::interpDelete $safeParent +} -result {} + +test safe-6.1 {loadTk -use windowPath} -setup { + destroy .safeTkFrame +} -body { set w .safeTkFrame - catch {destroy $w} frame $w -container 1; - pack .safeTkFrame + pack $w set i [safe::loadTk [safe::interpCreate] -use $w] interp eval $i {button .b -text "hello world!"; pack .b} safe::interpDelete $i destroy $w -} {} - -test safe-6.2 {loadTk -use windowPath, conflicting -display} { +} -result {} +test safe-6.2 {loadTk -use windowPath, conflicting -display} -setup { + destroy .safeTkFrame +} -body { set w .safeTkFrame - catch {destroy $w} frame $w -container 1; - pack .safeTkFrame + pack $w set i [safe::interpCreate] catch {safe::loadTk $i -use $w -display :23.56} msg + string range $msg 0 36 +} -cleanup { safe::interpDelete $i destroy $w - string range $msg 0 36 -} {conflicting -display :23.56 and -use } - +} -result {conflicting -display :23.56 and -use } -test safe-7.1 {canvas printing} { +test safe-7.1 {canvas printing} -body { set i [safe::loadTk [safe::interpCreate]] - set r [catch {interp eval $i {canvas .c; .c postscript}}] + interp eval $i {canvas .c; .c postscript} +} -cleanup { safe::interpDelete $i - set r -} 0 - +} -returnCodes ok -match glob -result * + # cleanup set ::auto_path $saveAutoPath unset hidden_cmds cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/scale.test b/tests/scale.test index f8e58bb..a8d08a8 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -6,7 +6,8 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands @@ -17,220 +18,497 @@ option add *Scale.borderWidth 2 option add *Scale.highlightThickness 2 option add *Scale.font {Helvetica -12 bold} +# Widget used in 1.* tests scale .s -from 100 -to 300 pack .s update -set i 1 -foreach test { - {-activebackground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bigincrement 12.5 12.5 badValue - {expected floating-point number but got "badValue"}} - {-bg #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-command "set x" {set x} {} {}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-digits 5 5 badValue {expected integer but got "badValue"}} - {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}} - {-font fixed fixed {} {font "" doesn't exist}} - {-foreground green green badValue {unknown color name "badValue"}} - {-from -15.0 -15.0 badValue - {expected floating-point number but got "badValue"}} - {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 non-existent - {unknown color name "non-existent"}} - {-highlightthickness 2 2 badValue {bad screen distance "badValue"}} - {-label "Some text" {Some text} {} {}} - {-length 130 130 badValue {bad screen distance "badValue"}} - {-orient horizontal horizontal badValue - {bad orient "badValue": must be horizontal or vertical}} - {-orient horizontal horizontal {} {}} - {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} - {-repeatdelay 14 14 bogus {expected integer but got "bogus"}} - {-repeatinterval 14 14 bogus {expected integer but got "bogus"}} - {-resolution 2.0 2.0 badValue - {expected floating-point number but got "badValue"}} - {-showvalue 0 0 badValue {expected boolean value but got "badValue"}} - {-sliderlength 86 86 badValue {bad screen distance "badValue"}} - {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} - {-state d disabled badValue - {bad state "badValue": must be active, disabled, or normal}} - {-state n normal {} {}} - {-takefocus "any string" "any string" {} {}} - {-tickinterval 4.3 4.0 badValue - {expected floating-point number but got "badValue"}} - {-to 14.9 15.0 badValue - {expected floating-point number but got "badValue"}} - {-troughcolor #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-variable x x {} {}} - {-width 32 32 badValue {bad screen distance "badValue"}} -} { - set name [lindex $test 0] - test scale-1.$i {configuration options} { - .s configure $name [lindex $test 1] - lindex [.s configure $name] 4 - } [lindex $test 2] - incr i - if {[lindex $test 3] ne ""} { - test scale-1.$i {configuration options} { - list [catch {.s configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - .s configure $name [lindex [.s configure $name] 3] - incr i -} + +test scale-1.1 {configuration options} -body { + .s configure -activebackground #ff0000 + .s cget -activebackground +} -cleanup { + .s configure -activebackground [lindex [.s configure -activebackground] 3] +} -result {#ff0000} +test scale-1.2 {configuration options} -body { + .s configure -activebackground non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test scale-1.3 {configuration options} -body { + .s configure -background #ff0000 + .s cget -background +} -cleanup { + .s configure -background [lindex [.s configure -background] 3] +} -result {#ff0000} +test scale-1.4 {configuration options} -body { + .s configure -background non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test scale-1.5 {configuration options} -body { + .s configure -bd 4 + .s cget -bd +} -cleanup { + .s configure -bd [lindex [.s configure -bd] 3] +} -result {4} +test scale-1.6 {configuration options} -body { + .s configure -bd badValue +} -returnCodes error -result {bad screen distance "badValue"} +test scale-1.7 {configuration options} -body { + .s configure -bigincrement 12.5 + .s cget -bigincrement +} -cleanup { + .s configure -bigincrement [lindex [.s configure -bigincrement] 3] +} -result {12.5} +test scale-1.8 {configuration options} -body { + .s configure -bigincrement badValue +} -returnCodes error -result {expected floating-point number but got "badValue"} +test scale-1.9 {configuration options} -body { + .s configure -bg #ff0000 + .s cget -bg +} -cleanup { + .s configure -bg [lindex [.s configure -bg] 3] +} -result {#ff0000} +test scale-1.10 {configuration options} -body { + .s configure -bg non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test scale-1.11 {configuration options} -body { + .s configure -borderwidth 1.3 + .s cget -borderwidth +} -cleanup { + .s configure -borderwidth [lindex [.s configure -borderwidth] 3] +} -result {1} +test scale-1.12 {configuration options} -body { + .s configure -borderwidth badValue +} -returnCodes error -result {bad screen distance "badValue"} +test scale-1.13 {configuration options} -body { + .s configure -command {set x} + .s cget -command +} -cleanup { + .s configure -command [lindex [.s configure -command] 3] +} -result {set x} +test scale-1.15 {configuration options} -body { + .s configure -cursor arrow + .s cget -cursor +} -cleanup { + .s configure -cursor [lindex [.s configure -cursor] 3] +} -result {arrow} +test scale-1.16 {configuration options} -body { + .s configure -cursor badValue +} -returnCodes error -result {bad cursor spec "badValue"} +test scale-1.17 {configuration options} -body { + .s configure -digits 5 + .s cget -digits +} -cleanup { + .s configure -digits [lindex [.s configure -digits] 3] +} -result {5} +test scale-1.18 {configuration options} -body { + .s configure -digits badValue +} -returnCodes error -result {expected integer but got "badValue"} +test scale-1.19 {configuration options} -body { + .s configure -fg #00ff00 + .s cget -fg +} -cleanup { + .s configure -fg [lindex [.s configure -fg] 3] +} -result {#00ff00} +test scale-1.20 {configuration options} -body { + .s configure -fg badValue +} -returnCodes error -result {unknown color name "badValue"} +test scale-1.21 {configuration options} -body { + .s configure -font fixed + .s cget -font +} -cleanup { + .s configure -font [lindex [.s configure -font] 3] +} -result {fixed} +test scale-1.23 {configuration options} -body { + .s configure -foreground green + .s cget -foreground +} -cleanup { + .s configure -foreground [lindex [.s configure -foreground] 3] +} -result {green} +test scale-1.24 {configuration options} -body { + .s configure -foreground badValue +} -returnCodes error -result {unknown color name "badValue"} +test scale-1.25 {configuration options} -body { + .s configure -from -15.0 + .s cget -from +} -cleanup { + .s configure -from [lindex [.s configure -from] 3] +} -result {-15.0} +test scale-1.26 {configuration options} -body { + .s configure -from badValue +} -returnCodes error -result {expected floating-point number but got "badValue"} +test scale-1.27 {configuration options} -body { + .s configure -highlightbackground #112233 + .s cget -highlightbackground +} -cleanup { + .s configure -highlightbackground [lindex [.s configure -highlightbackground] 3] +} -result {#112233} +test scale-1.28 {configuration options} -body { + .s configure -highlightbackground ugly +} -returnCodes error -result {unknown color name "ugly"} +test scale-1.29 {configuration options} -body { + .s configure -highlightcolor #123456 + .s cget -highlightcolor +} -cleanup { + .s configure -highlightcolor [lindex [.s configure -highlightcolor] 3] +} -result {#123456} +test scale-1.30 {configuration options} -body { + .s configure -highlightcolor non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test scale-1.31 {configuration options} -body { + .s configure -highlightthickness 2 + .s cget -highlightthickness +} -cleanup { + .s configure -highlightthickness [lindex [.s configure -highlightthickness] 3] +} -result {2} +test scale-1.32 {configuration options} -body { + .s configure -highlightthickness badValue +} -returnCodes error -result {bad screen distance "badValue"} +test scale-1.33 {configuration options} -body { + .s configure -label {Some text} + .s cget -label +} -cleanup { + .s configure -label [lindex [.s configure -label] 3] +} -result {Some text} +test scale-1.35 {configuration options} -body { + .s configure -length 130 + .s cget -length +} -cleanup { + .s configure -length [lindex [.s configure -length] 3] +} -result {130} +test scale-1.36 {configuration options} -body { + .s configure -length badValue +} -returnCodes error -result {bad screen distance "badValue"} +test scale-1.37 {configuration options} -body { + .s configure -orient horizontal + .s cget -orient +} -cleanup { + .s configure -orient [lindex [.s configure -orient] 3] +} -result {horizontal} +test scale-1.38 {configuration options} -body { + .s configure -orient badValue +} -returnCodes error -result {bad orient "badValue": must be horizontal or vertical} +test scale-1.39 {configuration options} -body { + .s configure -orient horizontal + .s cget -orient +} -cleanup { + .s configure -orient [lindex [.s configure -orient] 3] +} -result {horizontal} +test scale-1.41 {configuration options} -body { + .s configure -relief ridge + .s cget -relief +} -cleanup { + .s configure -relief [lindex [.s configure -relief] 3] +} -result {ridge} +test scale-1.42 {configuration options} -body { + .s configure -relief badValue +} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} +test scale-1.43 {configuration options} -body { + .s configure -repeatdelay 14 + .s cget -repeatdelay +} -cleanup { + .s configure -repeatdelay [lindex [.s configure -repeatdelay] 3] +} -result {14} +test scale-1.44 {configuration options} -body { + .s configure -repeatdelay bogus +} -returnCodes error -result {expected integer but got "bogus"} +test scale-1.45 {configuration options} -body { + .s configure -repeatinterval 14 + .s cget -repeatinterval +} -cleanup { + .s configure -repeatinterval [lindex [.s configure -repeatinterval] 3] +} -result {14} +test scale-1.46 {configuration options} -body { + .s configure -repeatinterval bogus +} -returnCodes error -result {expected integer but got "bogus"} +test scale-1.47 {configuration options} -body { + .s configure -resolution 2.0 + .s cget -resolution +} -cleanup { + .s configure -resolution [lindex [.s configure -resolution] 3] +} -result {2.0} +test scale-1.48 {configuration options} -body { + .s configure -resolution badValue +} -returnCodes error -result {expected floating-point number but got "badValue"} +test scale-1.49 {configuration options} -body { + .s configure -showvalue 0 + .s cget -showvalue +} -cleanup { + .s configure -showvalue [lindex [.s configure -showvalue] 3] +} -result {0} +test scale-1.50 {configuration options} -body { + .s configure -showvalue badValue +} -returnCodes error -result {expected boolean value but got "badValue"} +test scale-1.51 {configuration options} -body { + .s configure -sliderlength 86 + .s cget -sliderlength +} -cleanup { + .s configure -sliderlength [lindex [.s configure -sliderlength] 3] +} -result {86} +test scale-1.52 {configuration options} -body { + .s configure -sliderlength badValue +} -returnCodes error -result {bad screen distance "badValue"} +test scale-1.53 {configuration options} -body { + .s configure -sliderrelief raised + .s cget -sliderrelief +} -cleanup { + .s configure -sliderrelief [lindex [.s configure -sliderrelief] 3] +} -result {raised} +test scale-1.54 {configuration options} -body { + .s configure -sliderrelief badValue +} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken} +test scale-1.55 {configuration options} -body { + .s configure -state d + .s cget -state +} -cleanup { + .s configure -state [lindex [.s configure -state] 3] +} -result {disabled} +test scale-1.56 {configuration options} -body { + .s configure -state badValue +} -returnCodes error -result {bad state "badValue": must be active, disabled, or normal} +test scale-1.57 {configuration options} -body { + .s configure -state n + .s cget -state +} -cleanup { + .s configure -state [lindex [.s configure -state] 3] +} -result {normal} +test scale-1.59 {configuration options} -body { + .s configure -takefocus {any string} + .s cget -takefocus +} -cleanup { + .s configure -takefocus [lindex [.s configure -takefocus] 3] +} -result {any string} +test scale-1.61 {configuration options} -body { + .s configure -tickinterval 4.3 + .s cget -tickinterval +} -cleanup { + .s configure -tickinterval [lindex [.s configure -tickinterval] 3] +} -result {4.0} +test scale-1.62 {configuration options} -body { + .s configure -tickinterval badValue +} -returnCodes error -result {expected floating-point number but got "badValue"} +test scale-1.63 {configuration options} -body { + .s configure -to 14.9 + .s cget -to +} -cleanup { + .s configure -to [lindex [.s configure -to] 3] +} -result {15.0} +test scale-1.64 {configuration options} -body { + .s configure -to badValue +} -returnCodes error -result {expected floating-point number but got "badValue"} +test scale-1.65 {configuration options} -body { + .s configure -troughcolor #ff0000 + .s cget -troughcolor +} -cleanup { + .s configure -troughcolor [lindex [.s configure -troughcolor] 3] +} -result {#ff0000} +test scale-1.66 {configuration options} -body { + .s configure -troughcolor non-existent +} -returnCodes error -result {unknown color name "non-existent"} +test scale-1.67 {configuration options} -body { + .s configure -variable x + .s cget -variable +} -cleanup { + .s configure -variable [lindex [.s configure -variable] 3] +} -result {x} +test scale-1.69 {configuration options} -body { + .s configure -width 32 + .s cget -width +} -cleanup { + .s configure -width [lindex [.s configure -width] 3] +} -result {32} +test scale-1.70 {configuration options} -body { + .s configure -width badValue +} -returnCodes error -result {bad screen distance "badValue"} destroy .s -test scale-2.1 {Tk_ScaleCmd procedure} { - list [catch {scale} msg] $msg -} {1 {wrong # args: should be "scale pathName ?options?"}} -test scale-2.2 {Tk_ScaleCmd procedure} { - list [catch {scale foo} msg] $msg [winfo child .] -} {1 {bad window path name "foo"} {}} -test scale-2.3 {Tk_ScaleCmd procedure} { - list [catch {scale .s -gorp dumb} msg] $msg [winfo child .] -} {1 {unknown option "-gorp"} {}} +test scale-2.1 {Tk_ScaleCmd procedure} -body { + scale +} -returnCodes error -result {wrong # args: should be "scale pathName ?-option value ...?"} +test scale-2.2 {Tk_ScaleCmd procedure} -body { + scale foo +} -returnCodes error -result {bad window path name "foo"} +test scale-2.3 {Tk_ScaleCmd procedure} -body { + catch {scale foo} + winfo child . +} -result {} +test scale-2.4 {Tk_ScaleCmd procedure} -body { + scale .s -gorp dumb +} -returnCodes error -result {unknown option "-gorp"} +test scale-2.5 {Tk_ScaleCmd procedure} -body { + catch {scale .s -gorp dumb} + winfo child . +} -result {} + + +# Widget used in 3.* tests +destroy .s scale .s -from 100 -to 200 pack .s update idletasks -test scale-3.1 {ScaleWidgetCmd procedure} { - list [catch {.s} msg] $msg -} {1 {wrong # args: should be ".s option ?arg arg ...?"}} -test scale-3.2 {ScaleWidgetCmd procedure, cget option} { - list [catch {.s cget} msg] $msg -} {1 {wrong # args: should be ".s cget option"}} -test scale-3.3 {ScaleWidgetCmd procedure, cget option} { - list [catch {.s cget a b} msg] $msg -} {1 {wrong # args: should be ".s cget option"}} -test scale-3.4 {ScaleWidgetCmd procedure, cget option} { - list [catch {.s cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test scale-3.5 {ScaleWidgetCmd procedure, cget option} { +test scale-3.1 {ScaleWidgetCmd procedure} -body { + .s +} -returnCodes error -result {wrong # args: should be ".s option ?arg ...?"} +test scale-3.2 {ScaleWidgetCmd procedure, cget option} -body { + .s cget +} -returnCodes error -result {wrong # args: should be ".s cget option"} +test scale-3.3 {ScaleWidgetCmd procedure, cget option} -body { + .s cget a b +} -returnCodes error -result {wrong # args: should be ".s cget option"} +test scale-3.4 {ScaleWidgetCmd procedure, cget option} -body { + .s cget -gorp +} -returnCodes error -result {unknown option "-gorp"} +test scale-3.5 {ScaleWidgetCmd procedure, cget option} -body { + .s configure -highlightthickness 2 .s cget -highlightthickness -} {2} -test scale-3.6 {ScaleWidgetCmd procedure, configure option} { +} -result {2} +test scale-3.6 {ScaleWidgetCmd procedure, configure option} -body { list [llength [.s configure]] [lindex [.s configure] 6] -} {33 {-command command Command {} {}}} -test scale-3.7 {ScaleWidgetCmd procedure, configure option} { - list [catch {.s configure -foo} msg] $msg -} {1 {unknown option "-foo"}} -test scale-3.8 {ScaleWidgetCmd procedure, configure option} { - list [catch {.s configure -borderwidth 2 -bg} msg] $msg -} {1 {value for "-bg" missing}} -test scale-3.9 {ScaleWidgetCmd procedure, coords option} { - list [catch {.s coords a b} msg] $msg -} {1 {wrong # args: should be ".s coords ?value?"}} -test scale-3.10 {ScaleWidgetCmd procedure, coords option} { - list [catch {.s coords bad} msg] $msg -} {1 {expected floating-point number but got "bad"}} -test scale-3.11 {ScaleWidgetCmd procedure} {fonts} { +} -result {33 {-command command Command {} {}}} +test scale-3.7 {ScaleWidgetCmd procedure, configure option} -body { + .s configure -foo +} -returnCodes error -result {unknown option "-foo"} +test scale-3.8 {ScaleWidgetCmd procedure, configure option} -body { + .s configure -borderwidth 2 -bg +} -returnCodes error -result {value for "-bg" missing} +test scale-3.9 {ScaleWidgetCmd procedure, coords option} -body { + .s coords a b +} -returnCodes error -result {wrong # args: should be ".s coords ?value?"} +test scale-3.10 {ScaleWidgetCmd procedure, coords option} -body { + .s coords bad +} -returnCodes error -result {expected floating-point number but got "bad"} +test scale-3.11 {ScaleWidgetCmd procedure} -constraints { + fonts +} -body { + .s configure -from 100 -to 200 + update idletasks .s set 120 .s coords -} {38 34} -test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} { - .s configure -orient horizontal - update +} -result {38 34} +test scale-3.12 {ScaleWidgetCmd procedure, coords option} -constraints { + fonts +} -body { + .s configure -from 100 -to 200 -orient horizontal + update idletasks .s set 120 .s coords -} {34 31} -.s configure -orient vertical -update -test scale-3.13 {ScaleWidgetCmd procedure, get option} { - list [catch {.s get a} msg] $msg -} {1 {wrong # args: should be ".s get ?x y?"}} -test scale-3.14 {ScaleWidgetCmd procedure, get option} { - list [catch {.s get a b c} msg] $msg -} {1 {wrong # args: should be ".s get ?x y?"}} -test scale-3.15 {ScaleWidgetCmd procedure, get option} { - list [catch {.s get a 11} msg] $msg -} {1 {expected integer but got "a"}} -test scale-3.16 {ScaleWidgetCmd procedure, get option} { - list [catch {.s get 12 b} msg] $msg -} {1 {expected integer but got "b"}} -test scale-3.17 {ScaleWidgetCmd procedure, get option} { +} -result {34 31} +test scale-3.13 {ScaleWidgetCmd procedure, get option} -body { + .s configure -orient vertical + update + .s get a +} -returnCodes error -result {wrong # args: should be ".s get ?x y?"} +test scale-3.14 {ScaleWidgetCmd procedure, get option} -body { + .s configure -orient vertical + update + .s get a b c +} -returnCodes error -result {wrong # args: should be ".s get ?x y?"} +test scale-3.15 {ScaleWidgetCmd procedure, get option} -body { + .s configure -orient vertical + update + .s get a 11 +} -returnCodes error -result {expected integer but got "a"} +test scale-3.16 {ScaleWidgetCmd procedure, get option} -body { + .s configure -orient vertical + update + .s get 12 b +} -returnCodes error -result {expected integer but got "b"} +test scale-3.17 {ScaleWidgetCmd procedure, get option} -body { + .s configure -orient vertical + update .s set 133 .s get -} 133 -test scale-3.18 {ScaleWidgetCmd procedure, get option} { - .s configure -resolution 0.5 +} -result 133 +test scale-3.18 {ScaleWidgetCmd procedure, get option} -body { + .s configure -orient vertical -resolution 0.5 + update .s set 150 .s get 37 34 -} 119.5 +} -result {119.5} .s configure -resolution 1 -test scale-3.19 {ScaleWidgetCmd procedure, identify option} { - list [catch {.s identify} msg] $msg -} {1 {wrong # args: should be ".s identify x y"}} -test scale-3.20 {ScaleWidgetCmd procedure, identify option} { - list [catch {.s identify 1 2 3} msg] $msg -} {1 {wrong # args: should be ".s identify x y"}} -test scale-3.21 {ScaleWidgetCmd procedure, identify option} { - list [catch {.s identify boo 16} msg] $msg -} {1 {expected integer but got "boo"}} -test scale-3.22 {ScaleWidgetCmd procedure, identify option} { - list [catch {.s identify 17 bad} msg] $msg -} {1 {expected integer but got "bad"}} -test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} { +test scale-3.19 {ScaleWidgetCmd procedure, identify option} -body { + .s identify +} -returnCodes error -result {wrong # args: should be ".s identify x y"} +test scale-3.20 {ScaleWidgetCmd procedure, identify option} -body { + .s identify 1 2 3 +} -returnCodes error -result {wrong # args: should be ".s identify x y"} +test scale-3.21 {ScaleWidgetCmd procedure, identify option} -body { + .s identify boo 16 +} -returnCodes error -result {expected integer but got "boo"} +test scale-3.22 {ScaleWidgetCmd procedure, identify option} -body { + .s identify 17 bad +} -returnCodes error -result {expected integer but got "bad"} +test scale-3.23 {ScaleWidgetCmd procedure, identify option} -constraints { + fonts +} -body { + .s configure -from 100 -to 200 -orient vertical -resolution 1 + update .s set 120 list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80] -} {trough1 slider trough2 {}} -test scale-3.24 {ScaleWidgetCmd procedure, set option} { - list [catch {.s set} msg] $msg -} {1 {wrong # args: should be ".s set value"}} -test scale-3.25 {ScaleWidgetCmd procedure, set option} { - list [catch {.s set a b} msg] $msg -} {1 {wrong # args: should be ".s set value"}} -test scale-3.26 {ScaleWidgetCmd procedure, set option} { - list [catch {.s set bad} msg] $msg -} {1 {expected floating-point number but got "bad"}} -test scale-3.27 {ScaleWidgetCmd procedure, set option} { +} -result {trough1 slider trough2 {}} +test scale-3.24 {ScaleWidgetCmd procedure, set option} -body { + .s set +} -returnCodes error -result {wrong # args: should be ".s set value"} +test scale-3.25 {ScaleWidgetCmd procedure, set option} -body { + .s set a b +} -returnCodes error -result {wrong # args: should be ".s set value"} +test scale-3.26 {ScaleWidgetCmd procedure, set option} -body { + .s set bad +} -returnCodes error -result {expected floating-point number but got "bad"} +test scale-3.27 {ScaleWidgetCmd procedure, set option} -body { + .s configure -from 100 -to 200 -orient vertical -resolution 0.5 + update .s set 142 -} {} -test scale-3.28 {ScaleWidgetCmd procedure, set option} { +} -result {} +test scale-3.28 {ScaleWidgetCmd procedure, set option} -body { + .s configure -from 100 -to 200 -orient vertical -resolution 1 + update .s set 118 .s configure -state disabled .s set 181 .s configure -state normal .s get -} {118} -test scale-3.29 {ScaleWidgetCmd procedure} { - list [catch {.s dumb} msg] $msg -} {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}} -test scale-3.30 {ScaleWidgetCmd procedure} { - list [catch {.s c} msg] $msg -} {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}} -test scale-3.31 {ScaleWidgetCmd procedure} { - list [catch {.s co} msg] $msg -} {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}} -test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} { +} -result {118} +test scale-3.29 {ScaleWidgetCmd procedure} -body { + .s dumb +} -returnCodes error -result {bad option "dumb": must be cget, configure, coords, get, identify, or set} +test scale-3.30 {ScaleWidgetCmd procedure} -body { + .s c +} -returnCodes error -result {ambiguous option "c": must be cget, configure, coords, get, identify, or set} +test scale-3.31 {ScaleWidgetCmd procedure} -body { + .s co +} -returnCodes error -result {ambiguous option "co": must be cget, configure, coords, get, identify, or set} +destroy .s + +test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} -setup { + destroy .s +} -body { proc kill args { - destroy .s + destroy .s } - catch {destroy .s} scale .s -variable x -from 0 -to 100 -orient horizontal pack .s update .s configure -command kill .s set 55 -} {} +} -cleanup { + destroy .s +} -result {} + -test scale-4.1 {DestroyScale procedure} { - catch {destroy .s} +test scale-4.1 {DestroyScale procedure} -setup { + deleteWindows +} -body { set x 50 scale .s -variable x -from 0 -to 100 -orient horizontal pack .s update destroy .s list [catch {set x foo} msg] $msg $x -} {0 foo foo} +} -result {0 foo foo} + -test scale-5.1 {ConfigureScale procedure} { - catch {destroy .s} +test scale-5.1 {ConfigureScale procedure} -setup { + deleteWindows +} -body { set x 66 set y 77 scale .s -variable x -from 0 -to 100 @@ -238,14 +516,20 @@ test scale-5.1 {ConfigureScale procedure} { update .s configure -variable y list [catch {set x foo} msg] $msg $x [.s get] -} {0 foo foo 77} -test scale-5.2 {ConfigureScale procedure} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {0 foo foo 77} +test scale-5.2 {ConfigureScale procedure} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 - list [catch {.s configure -foo bar} msg] $msg -} {1 {unknown option "-foo"}} -test scale-5.3 {ConfigureScale procedure} { - catch {destroy .s} + .s configure -foo bar +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown option "-foo"} +test scale-5.3 {ConfigureScale procedure} -setup { + deleteWindows +} -body { catch {unset x} scale .s -from 0 -to 100 -variable x set result $x @@ -255,354 +539,480 @@ test scale-5.3 {ConfigureScale procedure} { .s set 3 lappend result $x unset x - lappend result [catch {set x} msg] $msg -} {0 0 92 3 0 3} -test scale-5.4 {ConfigureScale procedure} { - catch {destroy .s} + lappend result [set x] +} -cleanup { + deleteWindows +} -result {0 0 92 3 3} +test scale-5.4 {ConfigureScale procedure} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 - list [catch {.s configure -orient dumb} msg] $msg -} {1 {bad orient "dumb": must be horizontal or vertical}} -test scale-5.5 {ConfigureScale procedure} { - catch {destroy .s} + .s configure -orient dumb +} -cleanup { + deleteWindows +} -returnCodes error -result {bad orient "dumb": must be horizontal or vertical} +test scale-5.5 {ConfigureScale procedure} -setup { + deleteWindows +} -body { scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76 list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \ - [format %.1f [.s cget -tickinterval]] -} {1.1 1.9 0.8} -test scale-5.6 {ConfigureScale procedure} { - catch {destroy .s} + [format %.1f [.s cget -tickinterval]] +} -cleanup { + deleteWindows +} -result {1.1 1.9 0.8} +test scale-5.6 {ConfigureScale procedure} -setup { + deleteWindows +} -body { scale .s -from 1 -to 10 -tickinterval -2 pack .s set result [lindex [.s configure -tickinterval] 4] .s configure -from 10 -to 1 -tickinterval 2 lappend result [lindex [.s configure -tickinterval] 4] -} {2.0 -2.0} -test scale-5.7 {ConfigureScale procedure} { - catch {destroy .s} - list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg -} {1 {bad state "bogus": must be active, disabled, or normal}} +} -cleanup { + deleteWindows +} -result {2.0 -2.0} +test scale-5.7 {ConfigureScale procedure} -setup { + deleteWindows +} -body { + scale .s -from 0 -to 100 -state bogus +} -cleanup { + deleteWindows +} -returnCodes error -result {bad state "bogus": must be active, disabled, or normal} + -catch {destroy .s} +# Widget used in 6.* tests +destroy .s scale .s -orient horizontal -length 200 pack .s -test scale-6.1 {ComputeFormat procedure} { +test scale-6.1 {ComputeFormat procedure} -body { .s configure -from 10 -to 100 -resolution 10 .s set 49.3 .s get -} {50} -test scale-6.2 {ComputeFormat procedure} { +} -result {50} +test scale-6.2 {ComputeFormat procedure} -body { .s configure -from 100 -to 1000 -resolution 100 .s set 493 .s get -} {500} -test scale-6.3 {ComputeFormat procedure} { +} -result {500} +test scale-6.3 {ComputeFormat procedure} -body { .s configure -from 1000 -to 10000 -resolution 1000 .s set 4930 .s get -} {5000} -test scale-6.4 {ComputeFormat procedure} { +} -result {5000} +test scale-6.4 {ComputeFormat procedure} -body { .s configure -from 10000 -to 100000 -resolution 10000 .s set 49000 .s get -} {50000} -test scale-6.5 {ComputeFormat procedure} { +} -result {50000} +test scale-6.5 {ComputeFormat procedure} -body { .s configure -from 100000 -to 1000000 -resolution 100000 .s set 493000 .s get -} {500000} -test scale-6.6 {ComputeFormat procedure} {nonPortable} { +} -result {500000} +test scale-6.6 {ComputeFormat procedure} -constraints { + nonPortable +} -body { # This test is non-portable because some platforms format the # result as 5e+06. - .s configure -from 1000000 -to 10000000 -resolution 1000000 .s set 4930000 .s get -} {5000000} -test scale-6.7 {ComputeFormat procedure} { +} -result {5000000} +test scale-6.7 {ComputeFormat procedure} -body { .s configure -from 1000000000 -to 10000000000 -resolution 1000000000 .s set 4930000000 expr {[.s get] == 5.0e+09} -} 1 -test scale-6.8 {ComputeFormat procedure} { +} -result 1 +test scale-6.8 {ComputeFormat procedure} -body { .s configure -from .1 -to 1 -resolution .1 .s set .6 .s get -} {0.6} -test scale-6.9 {ComputeFormat procedure} { +} -result {0.6} +test scale-6.9 {ComputeFormat procedure} -body { .s configure -from .01 -to .1 -resolution .01 .s set .06 .s get -} {0.06} -test scale-6.10 {ComputeFormat procedure} { +} -result {0.06} +test scale-6.10 {ComputeFormat procedure} -body { .s configure -from .001 -to .01 -resolution .001 .s set .006 .s get -} {0.006} -test scale-6.11 {ComputeFormat procedure} { +} -result {0.006} +test scale-6.11 {ComputeFormat procedure} -body { .s configure -from .0001 -to .001 -resolution .0001 .s set .0006 .s get -} {0.0006} -test scale-6.12 {ComputeFormat procedure} { +} -result {0.0006} +test scale-6.12 {ComputeFormat procedure} -body { .s configure -from .00001 -to .0001 -resolution .00001 .s set .00006 .s get -} {0.00006} -test scale-6.13 {ComputeFormat procedure} { +} -result {0.00006} +test scale-6.13 {ComputeFormat procedure} -body { .s configure -from .000001 -to .00001 -resolution .000001 .s set .000006 expr {[.s get] == 6.0e-06} -} {1} -test scale-6.14 {ComputeFormat procedure} { +} -result {1} +test scale-6.14 {ComputeFormat procedure} -body { .s configure -to .00001 -from .0001 -resolution .00001 .s set .00006 .s get -} {0.00006} -test scale-6.15 {ComputeFormat procedure} { +} -result {0.00006} +test scale-6.15 {ComputeFormat procedure} -body { .s configure -to .000001 -from .00001 -resolution .000001 .s set .000006 expr {[.s get] == 6.0e-06} -} {1} -test scale-6.16 {ComputeFormat procedure} { +} -result {1} +test scale-6.16 {ComputeFormat procedure} -body { .s configure -from .00001 -to .0001 -resolution .00001 -digits 1 .s set .00006 expr {[.s get] == 6e-05} -} {1} -test scale-6.17 {ComputeFormat procedure} { +} -result {1} +test scale-6.17 {ComputeFormat procedure} -body { .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3 .s set 49300000 .s get -} {50000000} -test scale-6.18 {ComputeFormat procedure} { +} -result {50000000} +test scale-6.18 {ComputeFormat procedure} -body { .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0 .s set .111111111 .s get -} {0.11} -test scale-6.19 {ComputeFormat procedure} { +} -result {0.11} +test scale-6.19 {ComputeFormat procedure} -body { .s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0 .s set 1001.23456789 .s get -} {1001.23} -test scale-6.20 {ComputeFormat procedure} { +} -result {1001.23} +test scale-6.20 {ComputeFormat procedure} -body { .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0 .s set 1001.23456789 .s get -} {1001.235} -test scale-6.21 {ComputeFormat procedure} { +} -result {1001.235} +test scale-6.21 {ComputeFormat procedure} -body { .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 200 .s set 1001.23456789 .s get -} {1001.235} +} -result {1001.235} +destroy .s -test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} { - catch {destroy .s} + +test scale-7.1 {ComputeScaleGeometry procedure} -constraints { + nonPortable fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i pack .s update list [winfo reqwidth .s] [winfo reqheight .s] -} {88 458} -test scale-7.2 {ComputeScaleGeometry procedure} {fonts} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {88 458} +test scale-7.2 {ComputeScaleGeometry procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] -} {168 108} -test scale-7.3 {ComputeScaleGeometry procedure} {fonts} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {168 108} +test scale-7.3 {ComputeScaleGeometry procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \ - -sliderlength 10 + -sliderlength 10 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] -} {22 108} -test scale-7.4 {ComputeScaleGeometry procedure} {fonts} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {22 108} +test scale-7.4 {ComputeScaleGeometry procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \ - -relief sunken + -relief sunken pack .s update list [winfo reqwidth .s] [winfo reqheight .s] -} {39 114} -test scale-7.5 {ComputeScaleGeometry procedure} {nonPortable fonts} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {39 114} +test scale-7.5 {ComputeScaleGeometry procedure} -constraints { + nonPortable fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i pack .s update list [winfo reqwidth .s] [winfo reqheight .s] -} {458 61} -test scale-7.6 {ComputeScaleGeometry procedure} {fonts} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {458 61} +test scale-7.6 {ComputeScaleGeometry procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \ - -tick 500 + -tick 500 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] -} {108 79} -test scale-7.7 {ComputeScaleGeometry procedure} {fonts} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {108 79} +test scale-7.7 {ComputeScaleGeometry procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] -} {108 27} -test scale-7.8 {ComputeScaleGeometry procedure} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {108 27} +test scale-7.8 {ComputeScaleGeometry procedure} -setup { + deleteWindows +} -body { scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \ - -relief raised -highlightthickness 2 + -relief raised -highlightthickness 2 pack .s update list [winfo reqwidth .s] [winfo reqheight .s] -} {114 39} +} -cleanup { + deleteWindows +} -result {114 39} + -test scale-8.1 {ScaleElement procedure} {fonts} { - catch {destroy .s} +test scale-8.1 {ScaleElement procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 pack .s .s set 30 update list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] \ - [.s identify 71 52] -} {{} trough1 trough1 {}} -test scale-8.2 {ScaleElement procedure} {fonts} { - catch {destroy .s} + [.s identify 71 52] +} -cleanup { + deleteWindows +} -result {{} trough1 trough1 {}} +test scale-8.2 {ScaleElement procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 pack .s .s set 30 update list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \ - [.s identify 60 303] -} {{} trough1 trough2 {}} -test scale-8.3 {ScaleElement procedure} {fonts} { - catch {destroy .s} + [.s identify 60 303] +} -cleanup { + deleteWindows +} -result {{} trough1 trough2 {}} +test scale-8.3 {ScaleElement procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 pack .s .s set 30 update list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \ - [.s identify 60 114] \ -} {trough1 slider slider trough2} -test scale-8.4 {ScaleElement procedure} { - catch {destroy .s} + [.s identify 60 114] \ +} -cleanup { + deleteWindows +} -result {trough1 slider slider trough2} +test scale-8.4 {ScaleElement procedure} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \ - -highlightthickness 1 -length 300 -showvalue 0 + -highlightthickness 1 -length 300 -showvalue 0 pack .s .s set 30 update list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \ - [.s identify 23 40] \ -} {{} trough1 trough1 {}} -test scale-8.5 {ScaleElement procedure} {fonts} { - catch {destroy .s} + [.s identify 23 40] \ +} -cleanup { + deleteWindows +} -result {{} trough1 trough1 {}} +test scale-8.5 {ScaleElement procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -orient horizontal -bd 1 \ - -highlightthickness 2 -tick 20 -sliderlength 20 \ - -length 200 -label Test + -highlightthickness 2 -tick 20 -sliderlength 20 \ + -length 200 -label Test pack .s .s set 30 update list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] \ - [.s identify 150 54] -} {{} trough2 trough2 {}} -test scale-8.6 {ScaleElement procedure} {fonts} { - catch {destroy .s} + [.s identify 150 54] +} -cleanup { + deleteWindows +} -result {{} trough2 trough2 {}} +test scale-8.6 {ScaleElement procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -orient horizontal -bd 2 \ - -highlightthickness 1 -tick 20 -length 200 + -highlightthickness 1 -tick 20 -length 200 pack .s .s set 30 update list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] \ - [.s identify 150 40] -} {{} trough2 trough2 {}} -test scale-8.7 {ScaleElement procedure} { - catch {destroy .s} + [.s identify 150 40] +} -cleanup { + deleteWindows +} -result {{} trough2 trough2 {}} +test scale-8.7 {ScaleElement procedure} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \ - -length 200 -width 10 -showvalue 0 + -length 200 -width 10 -showvalue 0 pack .s .s set 30 update list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \ - [.s identify 30 24] -} {{} trough1 trough1 {}} -test scale-8.8 {ScaleElement procedure} { - catch {destroy .s} + [.s identify 30 24] +} -cleanup { + deleteWindows +} -result {{} trough1 trough1 {}} +test scale-8.8 {ScaleElement procedure} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \ - -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 + -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 pack .s .s set 30 update list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \ - [.s identify 203 28] -} {{} trough1 trough2 {}} -test scale-8.9 {ScaleElement procedure} { - catch {destroy .s} + [.s identify 203 28] +} -cleanup { + deleteWindows +} -result {{} trough1 trough2 {}} +test scale-8.9 {ScaleElement procedure} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \ - -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 + -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 pack .s .s set 80 update list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \ - [.s identify 166 28] -} {trough1 slider slider trough2} + [.s identify 166 28] +} -cleanup { + deleteWindows +} -result {trough1 slider slider trough2} -catch {destroy .s} -scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -pack .s -update -test scale-9.1 {PixelToValue procedure} { + +#widget used in 9.* tests +destroy .s +pack [scale .s] +test scale-9.1 {PixelToValue procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + update .s get 46 0 -} 0 -test scale-9.2 {PixelToValue procedure} { +} -result 0 +test scale-9.2 {PixelToValue procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + update .s get -10 9 -} 0 -test scale-9.3 {PixelToValue procedure} { +} -result 0 +test scale-9.3 {PixelToValue procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + update .s get -10 12 -} 1 -test scale-9.4 {PixelToValue procedure} { +} -result 1 +test scale-9.4 {PixelToValue procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + update .s get -10 46 -} 35 -test scale-9.5 {PixelToValue procedure} { +} -result 35 +test scale-9.5 {PixelToValue procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + update .s get -10 110 -} 99 -test scale-9.6 {PixelToValue procedure} { +} -result 99 +test scale-9.6 {PixelToValue procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + update .s get -10 111 -} 100 -test scale-9.7 {PixelToValue procedure} { +} -result 100 +test scale-9.7 {PixelToValue procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + update .s get -10 112 -} 100 -test scale-9.8 {PixelToValue procedure} { +} -result 100 +test scale-9.8 {PixelToValue procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + update .s get -10 154 -} 100 -.s configure -orient horizontal -update -test scale-9.9 {PixelToValue procedure} { +} -result 100 +test scale-9.9 {PixelToValue procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal + update .s get 76 152 -} 65 +} -result 65 +destroy .s + -test scale-10.1 {ValueToPixel procedure} {fonts} { - catch {destroy .s} +test scale-10.1 {ValueToPixel procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \ - -orient horizontal -label Test -tick 20 + -orient horizontal -label Test -tick 20 pack .s update list [.s coords -10] [.s coords 40] [.s coords 1000] -} {{16 47} {56 47} {116 47}} -test scale-10.2 {ValueToPixel procedure} {fonts} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {{16 47} {56 47} {116 47}} +test scale-10.2 {ValueToPixel procedure} -constraints { + fonts +} -setup { + deleteWindows +} -body { scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \ - -orient vertical -label Test -tick 20 + -orient vertical -label Test -tick 20 pack .s update list [.s coords -10] [.s coords 40] [.s coords 1000] -} {{62 114} {62 74} {62 14}} +} -cleanup { + deleteWindows +} -result {{62 114} {62 74} {62 14}} + -test scale-11.1 {ScaleEventProc procedure} { +test scale-11.1 {ScaleEventProc procedure} -setup { + deleteWindows +} -body { proc killScale value { - global x - if {$value > 30} { - destroy .s1 - lappend x [winfo exists .s1] [info commands .s1] - } + global x + if {$value > 30} { + destroy .s1 + lappend x [winfo exists .s1] [info commands .s1] + } } - catch {destroy .s1} set x initial scale .s1 -from 0 -to 100 -command killScale .s1 set 20 @@ -611,60 +1021,74 @@ test scale-11.1 {ScaleEventProc procedure} { lappend x [winfo exists .s1] .s1 set 40 update idletasks + return $x +} -cleanup { rename killScale {} - set x -} {initial 1 0 {}} -test scale-11.2 {ScaleEventProc procedure} { deleteWindows +} -result {initial 1 0 {}} +test scale-11.2 {ScaleEventProc procedure} -setup { + deleteWindows + set x {} +} -body { scale .s1 -bg #543210 rename .s1 .s2 - set x {} lappend x [winfo children .] lappend x [.s2 cget -bg] destroy .s1 lappend x [info command .s*] [winfo children .] -} {.s1 #543210 {} {}} +} -cleanup { + deleteWindows +} -result {.s1 #543210 {} {}} -test scale-12.1 {ScaleCmdDeletedProc procedure} { +test scale-12.1 {ScaleCmdDeletedProc procedure} -setup { deleteWindows +} -body { scale .s1 rename .s1 {} list [info command .s*] [winfo children .] -} {{} {}} +} -cleanup { + deleteWindows +} -result {{} {}} -catch {destroy .s} -scale .s -from 0 -to 100 -command {set x} -variable y -pack .s + +# Widget used in 13.* tests +destroy .s +pack [scale .s] update -proc varTrace args { - global traceInfo - set traceInfo $args -} -test scale-13.1 {SetScaleValue procedure} { +test scale-13.1 {SetScaleValue procedure} -body { + .s configure -from 0 -to 100 -command {set x} -variable y + update set x xyzzy .s set 44 set result [list $x $y] update lappend result $x $y -} {xyzzy 44 44 44} -test scale-13.2 {SetScaleValue procedure} { +} -result {xyzzy 44 44 44} +test scale-13.2 {SetScaleValue procedure} -body { .s set -3 .s get -} 0 -test scale-13.3 {SetScaleValue procedure} { +} -result 0 +test scale-13.3 {SetScaleValue procedure} -body { .s set 105 .s get -} 100 +} -result 100 .s configure -from 100 -to 0 -test scale-13.4 {SetScaleValue procedure} { +test scale-13.4 {SetScaleValue procedure} -body { .s set -3 .s get -} 0 -test scale-13.5 {SetScaleValue procedure} { +} -result 0 +test scale-13.5 {SetScaleValue procedure} -body { .s set 105 .s get -} 100 -test scale-13.6 {SetScaleValue procedure} { +} -result 100 +test scale-13.6 {SetScaleValue procedure} -body { + proc varTrace args { + global traceInfo + set traceInfo $args + } + .s configure -from 0 -to 100 -command {set x} -variable y + update + .s set 50 update trace variable y w varTrace @@ -673,127 +1097,201 @@ test scale-13.6 {SetScaleValue procedure} { .s set 50 update list $x $traceInfo -} {untouched empty} +} -result {untouched empty} -catch {destroy .s} -scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal -pack .s -update -.s configure -resolution 4.0 + +# Widget used in 14.* tests +destroy .s +pack [scale .s] update -test scale-14.1 {RoundToResolution procedure} { +test scale-14.1 {RoundToResolution procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 4.0 + update .s get 84 152 -} 72 -test scale-14.2 {RoundToResolution procedure} { +} -result 72 +test scale-14.2 {RoundToResolution procedure} -body { + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 4.0 + update .s get 86 152 -} 76 -.s configure -from 100 -to 0 -update -test scale-14.3 {RoundToResolution procedure} { +} -result 76 + +test scale-14.3 {RoundToResolution procedure} -body { + .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 4.0 + update .s get 84 152 -} 28 -test scale-14.4 {RoundToResolution procedure} { +} -result 28 +test scale-14.4 {RoundToResolution procedure} -body { + .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 4.0 + update .s get 86 152 -} 24 -.s configure -from -100 -to 0 -update -test scale-14.5 {RoundToResolution procedure} { +} -result 24 + +test scale-14.5 {RoundToResolution procedure} -body { + .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 4.0 + update .s get 84 152 -} -28 -test scale-14.6 {RoundToResolution procedure} { +} -result {-28} +test scale-14.6 {RoundToResolution procedure} -body { + .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 4.0 + update .s get 86 152 -} -24 -.s configure -from 0 -to -100 -update -test scale-14.7 {RoundToResolution procedure} { +} -result {-24} + +test scale-14.7 {RoundToResolution procedure} -body { + .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 4.0 + update .s get 84 152 -} -72 -test scale-14.8 {RoundToResolution procedure} { +} -result {-72} +test scale-14.8 {RoundToResolution procedure} -body { + .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 4.0 + update .s get 86 152 -} -76 -.s configure -from 0 -to 2.25 -resolution 0 -update -test scale-14.9 {RoundToResolution procedure} { +} -result {-76} + +test scale-14.9 {RoundToResolution procedure} -body { + .s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 0 + update .s get 84 152 -} 1.64 -test scale-14.10 {RoundToResolution procedure} { +} -result {1.64} +test scale-14.10 {RoundToResolution procedure} -body { + .s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 0 + update .s get 86 152 -} 1.69 -.s configure -from 0 -to 225 -resolution 0 -digits 5 -update -test scale-14.11 {RoundToResolution procedure} { +} -result {1.69} + +test scale-14.11 {RoundToResolution procedure} -body { + .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 0 -digits 5 + update .s get 84 152 -} 164.25 -test scale-14.12 {RoundToResolution procedure} { +} -result {164.25} +test scale-14.12 {RoundToResolution procedure} -body { + .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \ + -orient horizontal -resolution 0 -digits 5 + update .s get 86 152 -} 168.75 +} -result {168.75} +destroy .s + -test scale-15.1 {ScaleVarProc procedure} { - catch {destroy .s} +test scale-15.1 {ScaleVarProc procedure} -setup { + deleteWindows +} -body { set y -130 scale .s -from 0 -to -200 -variable y -orient horizontal -length 150 pack .s - set y -} -130 -test scale-15.2 {ScaleVarProc procedure} { - catch {destroy .s} + return $y +} -result {-130} +test scale-15.2 {ScaleVarProc procedure} -setup { + deleteWindows +} -body { set y -130 scale .s -from -200 -to 0 -variable y -orient horizontal -length 150 pack .s set y -87 .s get -} -87 -test scale-15.3 {ScaleVarProc procedure} { - catch {destroy .s} +} -result {-87} +test scale-15.3 {ScaleVarProc procedure} -setup { + deleteWindows +} -body { + set y -130 + scale .s -from -200 -to 0 -variable y -orient horizontal -length 150 + pack .s + set y 40q +} -cleanup { + deleteWindows +} -returnCodes error -result {can't set "y": can't assign non-numeric value to scale variable} +test scale-15.4 {ScaleVarProc procedure} -setup { + deleteWindows +} -body { set y -130 scale .s -from -200 -to 0 -variable y -orient horizontal -length 150 pack .s - list [catch {set y 40q} msg] $msg [.s get] -} {1 {can't set "y": can't assign non-numeric value to scale variable} -130} -test scale-15.4 {ScaleVarProc procedure} { - catch {destroy .s} + catch {set y 40q} + .s get +} -cleanup { + deleteWindows +} -result {-130} +test scale-15.5 {ScaleVarProc procedure} -setup { + deleteWindows +} -body { set y 1 scale .s -from 1 -to 0 -variable y -orient horizontal -length 150 pack .s - list [catch {set y x} msg] $msg [.s get] -} {1 {can't set "y": can't assign non-numeric value to scale variable} 1} -test scale-15.5 {ScaleVarProc procedure, variable deleted} { - catch {destroy .s} + set y x +} -cleanup { + deleteWindows +} -returnCodes error -result {can't set "y": can't assign non-numeric value to scale variable} +test scale-15.6 {ScaleVarProc procedure} -setup { + deleteWindows +} -body { + set y 1 + scale .s -from 1 -to 0 -variable y -orient horizontal -length 150 + pack .s + catch {set y x} + .s get +} -cleanup { + deleteWindows +} -result 1 +test scale-15.7 {ScaleVarProc procedure, variable deleted} -setup { + deleteWindows +} -body { set y 6 scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \ - -command "set x" + -command "set x" pack .s update set x untouched unset y update list [catch {set y} msg] $msg [.s get] $x -} {0 6 6 untouched} -test scale-15.6 {ScaleVarProc procedure, don't call -command} { - catch {destroy .s} +} -cleanup { + deleteWindows +} -result {0 6 6 untouched} +test scale-15.8 {ScaleVarProc procedure, don't call -command} -setup { + deleteWindows +} -body { set y 6 scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \ - -command "set x" + -command "set x" pack .s update set x untouched set y 60 update list $x [.s get] -} {untouched 60} +} -cleanup { + deleteWindows +} -result {untouched 60} -set l [interp hidden] -deleteWindows -test scale-16.1 {scale widget vs hidden commands} { - catch {destroy .s} +test scale-16.1 {scale widget vs hidden commands} -body { + set l [interp hidden] + deleteWindows scale .s interp hide {} .s destroy .s - list [winfo children .] [interp hidden] -} [list {} $l] + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 eq $res2} +} -cleanup { + deleteWindows +} -result 1 + -test scale-17.1 {bug fix 1786} { +test scale-17.1 {bug fix 1786} -setup { + deleteWindows +} -body { # Perhaps x is set to {}, depending on what other tests have run. # If x is unset, or set to something not convertable to a double, # then the scale try to initialize its value with the contents @@ -808,64 +1306,61 @@ test scale-17.1 {bug fix 1786} { # Bug 4833 changed the result to realize that x should pick up # a value from the scale. In an FPE occurs, it is due to the # lack of errno being set to 0 by some libc's. (see bug 4942) - set x -} {100} + return $x +} -cleanup { + deleteWindows +} -result {100} + -test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} { - catch {destroy .s} +test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} -setup { + deleteWindows +} -body { scale .s -cursor trek destroy .s -} {} +} -result {} -test scale-18.2 {Scale button 1 events [Bug 787065]} \ - -setup { - catch {destroy .s} - set y 5 - scale .s -from 0 -to 10 -variable y -orient horizontal -length 150 - pack .s - tkwait visibility .s - set ::error {} - proc bgerror {args} {set ::error $args} - } \ - -body { - list [catch { - event generate .s <1> -x 0 -y 0 - event generate .s <ButtonRelease-1> -x 0 -y 0 - update - set ::error - } msg] $msg - } \ - -cleanup { - unset ::error - rename bgerror {} - catch {destroy .s} - } \ - -result {0 {}} +test scale-18.2 {Scale button 1 events [Bug 787065]} -setup { + destroy .s + set ::error {} + proc bgerror {args} {set ::error $args} +} -body { + set y 5 + scale .s -from 0 -to 10 -variable y -orient horizontal -length 150 + pack .s + tkwait visibility .s + list [catch { + event generate .s <1> -x 0 -y 0 + event generate .s <ButtonRelease-1> -x 0 -y 0 + update + set ::error + } msg] $msg +} -cleanup { + unset ::error + rename bgerror {} + destroy .s +} -result {0 {}} + +test scale-18.3 {Scale button 2 events [Bug 787065]} -setup { + destroy .s + set ::error {} + proc bgerror {args} {set ::error $args} +} -body { + set y 5 + scale .s -from 0 -to 10 -variable y -orient horizontal -length 150 + pack .s + tkwait visibility .s + list [catch { + event generate .s <2> -x 0 -y 0 + event generate .s <ButtonRelease-2> -x 0 -y 0 + update + set ::error + } msg] $msg +} -cleanup { + unset ::error + rename bgerror {} + destroy .s +} -result {0 {}} -test scale-18.3 {Scale button 2 events [Bug 787065]} \ - -setup { - catch {destroy .s} - set y 5 - scale .s -from 0 -to 10 -variable y -orient horizontal -length 150 - pack .s - tkwait visibility .s - set ::error {} - proc bgerror {args} {set ::error $args} - } \ - -body { - list [catch { - event generate .s <2> -x 0 -y 0 - event generate .s <ButtonRelease-2> -x 0 -y 0 - update - set ::error - } msg] $msg - } \ - -cleanup { - unset ::error - rename bgerror {} - catch {destroy .s} - } \ - -result {0 {}} test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \ -setup { @@ -901,7 +1396,6 @@ test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \ } \ -result {1.0 1.0 1.0 1.0} -catch {destroy .s} option clear # cleanup diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 10aa7d6..8f92c93 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -57,7 +57,7 @@ foreach test { {-activebackground #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-activerelief sunken sunken non-existent - {bad relief type "non-existent": must be flat, groove, raised, ridge, solid, or sunken}} + {bad relief "non-existent": must be flat, groove, raised, ridge, solid, or sunken}} {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-bd 4 4 badValue {bad screen distance "badValue"}} @@ -75,7 +75,7 @@ foreach test { {-orient horizontal horizontal badValue {bad orientation "badValue": must be vertical or horizontal}} {-orient horizontal horizontal bogus {bad orientation "bogus": must be vertical or horizontal}} - {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}} + {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}} {-repeatdelay 140 140 129.3 {expected integer but got "129.3"}} {-repeatinterval 140 140 129.3 {expected integer but got "129.3"}} {-takefocus "any string" "any string" {} {}} @@ -99,7 +99,7 @@ foreach test { destroy .s test scrollbar-2.1 {Tk_ScrollbarCmd procedure} -returnCodes error -body { scrollbar -} -result {wrong # args: should be "scrollbar pathName ?options?"} +} -result {wrong # args: should be "scrollbar pathName ?-option value ...?"} test scrollbar-2.2 {Tk_ScrollbarCmd procedure} -body { scrollbar gorp } -returnCodes error -result {bad window path name "gorp"} @@ -127,7 +127,7 @@ pack .s -side right -fill y update test scrollbar-3.1 {ScrollbarWidgetCmd procedure} { list [catch {.s} msg] $msg -} {1 {wrong # args: should be ".s option ?arg arg ...?"}} +} {1 {wrong # args: should be ".s option ?arg ...?"}} test scrollbar-3.2 {ScrollbarWidgetCmd procedure, "cget" option} { list [catch {.s cget} msg] $msg } {1 {wrong # args: should be ".s cget option"}} @@ -405,7 +405,7 @@ test scrollbar-3.73 {ScrollbarWidgetCmd procedure} { } {1 {bad option "bogus": must be activate, cget, configure, delta, fraction, get, identify, or set}} test scrollbar-3.74 {ScrollbarWidgetCmd procedure} { list [catch {.s c} msg] $msg -} {1 {bad option "c": must be activate, cget, configure, delta, fraction, get, identify, or set}} +} {1 {ambiguous option "c": must be activate, cget, configure, delta, fraction, get, identify, or set}} test scrollbar-4.1 {ScrollbarEventProc procedure} { catch {destroy .s1} diff --git a/tests/select.test b/tests/select.test index 8cbfd39..77bfb2e 100644 --- a/tests/select.test +++ b/tests/select.test @@ -1,6 +1,6 @@ # This file is a Tcl script to test out Tk's selection management code, -# especially the "selection" command. It is organized in the standard -# fashion for Tcl tests. +# especially the "selection" command. It is organized in the standard fashion +# for Tcl tests. # # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. @@ -11,12 +11,12 @@ # environment variable TK_ALT_DISPLAY is set to an alternate display. # -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* +namespace import ::tk::test:loadTkCommand eval tcltest::configure $argv tcltest::loadTestedCommands -namespace import -force ::tk::test:loadTkCommand - global longValue selValue selInfo set selValue {} @@ -109,48 +109,55 @@ foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} { } # Now we start the main body of the test code - -test select-1.1 {Tk_CreateSelHandler procedure} { + +test select-1.1 {Tk_CreateSelHandler procedure} -setup { setup +} -body { lsort [selection get TARGETS] -} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} -test select-1.2 {Tk_CreateSelHandler procedure} { +} -result {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} +test select-1.2 {Tk_CreateSelHandler procedure} -setup { setup +} -body { selection handle .f1 {handler TEST} TEST lsort [selection get TARGETS] -} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} -test select-1.3 {Tk_CreateSelHandler procedure} { +} -result {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} +test select-1.3 {Tk_CreateSelHandler procedure} -setup { global selValue selInfo setup +} -body { selection handle .f1 {handler TEST} TEST set selValue "Test value" set selInfo "" list [selection get TEST] $selInfo -} {{Test value} {TEST 0 4000}} -test select-1.4.1 {Tk_CreateSelHandler procedure} unix { +} -result {{Test value} {TEST 0 4000}} +test select-1.4.1 {Tk_CreateSelHandler procedure} -constraints unix -setup { setup +} -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} lsort [selection get TARGETS] -} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} -test select-1.4.2 {Tk_CreateSelHandler procedure} win { +} -result {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} +test select-1.4.2 {Tk_CreateSelHandler procedure} -constraints win -setup { setup +} -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} lsort [selection get TARGETS] -} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} -test select-1.5 {Tk_CreateSelHandler procedure} { +} -result {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} +test select-1.5 {Tk_CreateSelHandler procedure} -setup { global selValue selInfo setup +} -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} set selValue "" set selInfo "" list [selection get] $selInfo -} {{} {STRING 0 4000}} -test select-1.6.1 {Tk_CreateSelHandler procedure} unix { +} -result {{} {STRING 0 4000}} +test select-1.6.1 {Tk_CreateSelHandler procedure} -constraints unix -setup { global selValue selInfo setup +} -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} set selValue "" @@ -159,11 +166,12 @@ test select-1.6.1 {Tk_CreateSelHandler procedure} unix { selection get -type TEST selection handle .f1 {handler TEST2} TEST selection get -type TEST - list [set selInfo] [lsort [selection get TARGETS]] -} {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} -test select-1.6.2 {Tk_CreateSelHandler procedure} win { + list $selInfo [lsort [selection get TARGETS]] +} -result {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} +test select-1.6.2 {Tk_CreateSelHandler procedure} -constraints win -setup { global selValue selInfo setup +} -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} set selValue "" @@ -172,141 +180,157 @@ test select-1.6.2 {Tk_CreateSelHandler procedure} win { selection get -type TEST selection handle .f1 {handler TEST2} TEST selection get -type TEST - list [set selInfo] [lsort [selection get TARGETS]] -} {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-1.7.1 {Tk_CreateSelHandler procedure} unix { + list $selInfo [lsort [selection get TARGETS]] +} -result {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-1.7.1 {Tk_CreateSelHandler procedure} -constraints unix -setup { setup +} -body { selection own -selection CLIPBOARD .f1 selection handle -selection CLIPBOARD .f1 {handler TEST} TEST selection handle -selection PRIMARY .f1 {handler TEST2} STRING list [lsort [selection get -selection PRIMARY TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] -} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-1.7.2 {Tk_CreateSelHandler procedure} win { +} -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-1.7.2 {Tk_CreateSelHandler procedure} -constraints win -setup { setup +} -body { selection own -selection CLIPBOARD .f1 selection handle -selection CLIPBOARD .f1 {handler TEST} TEST selection handle -selection PRIMARY .f1 {handler TEST2} STRING list [lsort [selection get -selection PRIMARY TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] -} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-1.8 {Tk_CreateSelHandler procedure} { +} -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-1.8 {Tk_CreateSelHandler procedure} -setup { setup +} -body { selection handle -format INTEGER -type TEST .f1 {handler TEST} lsort [selection get TARGETS] -} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} +} -result {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} ############################################################################## -test select-2.1 {Tk_DeleteSelHandler procedure} unix { +test select-2.1 {Tk_DeleteSelHandler procedure} -constraints unix -setup { setup +} -body { selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} selection handle -type USER .f1 {handler USER} set result [list [lsort [selection get TARGETS]]] selection handle -type TEST .f1 {} lappend result [lsort [selection get TARGETS]] -} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING}} -test select-2.2 {Tk_DeleteSelHandler procedure} unix { +} -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING}} +test select-2.2 {Tk_DeleteSelHandler procedure} -constraints unix -setup { setup +} -body { selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} selection handle -type USER .f1 {handler USER} set result [list [lsort [selection get TARGETS]]] selection handle -type USER .f1 {} lappend result [lsort [selection get TARGETS]] -} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} -test select-2.3 {Tk_DeleteSelHandler procedure} unix { +} -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} +test select-2.3 {Tk_DeleteSelHandler procedure} -constraints unix -setup { setup +} -body { selection own -selection CLIPBOARD .f1 selection handle -selection PRIMARY .f1 {handler STRING} selection handle -selection CLIPBOARD .f1 {handler STRING} selection handle -selection CLIPBOARD .f1 {} list [lsort [selection get TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] -} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-2.4 {Tk_DeleteSelHandler procedure} win { +} -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-2.4 {Tk_DeleteSelHandler procedure} -constraints win -setup { setup +} -body { selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} selection handle -type USER .f1 {handler USER} set result [list [lsort [selection get TARGETS]]] selection handle -type TEST .f1 {} lappend result [lsort [selection get TARGETS]] -} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}} -test select-2.5 {Tk_DeleteSelHandler procedure} win { +} -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}} +test select-2.5 {Tk_DeleteSelHandler procedure} -constraints win -setup { setup +} -body { selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} selection handle -type USER .f1 {handler USER} set result [list [lsort [selection get TARGETS]]] selection handle -type USER .f1 {} lappend result [lsort [selection get TARGETS]] -} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-2.6 {Tk_DeleteSelHandler procedure} win { +} -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-2.6 {Tk_DeleteSelHandler procedure} -constraints win -setup { setup +} -body { selection own -selection CLIPBOARD .f1 selection handle -selection PRIMARY .f1 {handler STRING} selection handle -selection CLIPBOARD .f1 {handler STRING} selection handle -selection CLIPBOARD .f1 {} list [lsort [selection get TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] -} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-2.7 {Tk_DeleteSelHandler procedure} { +} -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-2.7 {Tk_DeleteSelHandler procedure} -setup { setup +} -body { selection handle .f1 {handler STRING} list [selection handle .f1 {}] [selection handle .f1 {}] -} {{} {}} +} -result {{} {}} ############################################################################## -test select-3.1 {Tk_OwnSelection procedure} { +test select-3.1 {Tk_OwnSelection procedure} -setup { setup +} -body { selection own -} {.f1} -test select-3.2 {Tk_OwnSelection procedure} { +} -result {.f1} +test select-3.2 {Tk_OwnSelection procedure} -body { setup .f1 set result [selection own] setup .f2 lappend result [selection own] -} {.f1 .f2} -test select-3.3 {Tk_OwnSelection procedure} { +} -result {.f1 .f2} +test select-3.3 {Tk_OwnSelection procedure} -setup { setup .f1 setup .f2 +} -body { selection own -selection CLIPBOARD .f1 list [selection own] [selection own -selection CLIPBOARD] -} {.f2 .f1} -test select-3.4 {Tk_OwnSelection procedure} { +} -result {.f2 .f1} +test select-3.4 {Tk_OwnSelection procedure} -setup { global lostSel setup +} -body { set lostSel {owned} selection own -command { set lostSel {lost} } .f1 selection clear .f1 set lostSel -} {lost} -test select-3.5 {Tk_OwnSelection procedure} { +} -result {lost} +test select-3.5 {Tk_OwnSelection procedure} -setup { global lostSel setup .f1 setup .f2 +} -body { set lostSel {owned} selection own -command { set lostSel {lost1} } .f1 selection own -command { set lostSel {lost2} } .f2 list $lostSel [selection own] -} {lost1 .f2} -test select-3.6 {Tk_OwnSelection procedure} { +} -result {lost1 .f2} +test select-3.6 {Tk_OwnSelection procedure} -setup { global lostSel setup +} -body { set lostSel {owned} selection own -command { set lostSel {lost1} } .f1 selection own -command { set lostSel {lost2} } .f1 set result $lostSel selection clear .f1 lappend result $lostSel -} {owned lost2} -test select-3.7 {Tk_OwnSelection procedure} unix { +} -result {owned lost2} +test select-3.7 {Tk_OwnSelection procedure} -constraints unix -setup { global lostSel setup setupbg +} -body { set lostSel {owned} selection own -command { set lostSel {lost1} } .f1 update @@ -316,60 +340,71 @@ test select-3.7 {Tk_OwnSelection procedure} unix { update cleanupbg lappend result $lostSel -} {{} . lost1} +} -result {{} . lost1} # check reentrancy on selection replacement -test select-3.8 {Tk_OwnSelection procedure} { +test select-3.8 {Tk_OwnSelection procedure} -setup { setup +} -body { selection own -selection CLIPBOARD -command { destroy .f1 } .f1 selection own -selection CLIPBOARD . -} {} -test select-3.9 {Tk_OwnSelection procedure} { +} -result {} +test select-3.9 {Tk_OwnSelection procedure} -setup { setup .f2 setup .f1 +} -body { selection own -selection CLIPBOARD -command { destroy .f2 } .f1 selection own -selection CLIPBOARD .f2 -} {} +} -result {} # multiple display tests -test select-3.10 {Tk_OwnSelection procedure} {altDisplay} { +test select-3.10 {Tk_OwnSelection procedure} -constraints { + altDisplay +} -body { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) list [selection own -displayof .f1] [selection own -displayof .f2] -} {.f1 .f2} -test select-3.11 {Tk_OwnSelection procedure} {altDisplay} { +} -result {.f1 .f2} +test select-3.11 {Tk_OwnSelection procedure} -constraints { + altDisplay +} -setup { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) setupbg update set result "" +} -body { lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection own .t; update"] lappend result [selection own -displayof .f1] \ [selection own -displayof .f2] +} -cleanup { cleanupbg - set result -} {{} .f1 {}} +} -result {{} .f1 {}} ############################################################################## -test select-4.1 {Tk_ClearSelection procedure} { +test select-4.1 {Tk_ClearSelection procedure} -setup { setup +} -body { set result [selection own] selection clear .f1 lappend result [selection own] -} {.f1 {}} -test select-4.2 {Tk_ClearSelection procedure} { +} -result {.f1 {}} +test select-4.2 {Tk_ClearSelection procedure} -setup { setup +} -body { selection own -selection CLIPBOARD .f1 selection clear .f1 selection own -selection CLIPBOARD -} {.f1} -test select-4.3 {Tk_ClearSelection procedure} { +} -result {.f1} +test select-4.3 {Tk_ClearSelection procedure} -setup { setup +} -body { list [selection clear .f1] [selection clear .f1] -} {{} {}} -test select-4.4 {Tk_ClearSelection procedure} unix { +} -result {{} {}} +test select-4.4 {Tk_ClearSelection procedure} -constraints unix -setup { global lostSel setup setupbg +} -body { set lostSel {owned} selection own -command { set lostSel {lost1} } .f1 update @@ -378,12 +413,15 @@ test select-4.4 {Tk_ClearSelection procedure} unix { update cleanupbg lappend result [selection own] -} {{} {}} +} -result {{} {}} # multiple display tests -test select-4.5 {Tk_ClearSelection procedure} {altDisplay} { +test select-4.5 {Tk_ClearSelection procedure} -constraints { + altDisplay +} -setup { global lostSel lostSel2 setup .f1 setup .f2 $env(TK_ALT_DISPLAY) +} -body { set lostSel {owned} set lostSel2 {owned2} selection own -command { set lostSel {lost1} } .f1 @@ -392,11 +430,14 @@ test select-4.5 {Tk_ClearSelection procedure} {altDisplay} { selection clear -displayof .f2 update list $lostSel $lostSel2 -} {owned lost2} -test select-4.6 {Tk_ClearSelection procedure} {unix altDisplay} { +} -result {owned lost2} +test select-4.6 {Tk_ClearSelection procedure} -constraints { + unix altDisplay +} -setup { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) setupbg +} -body { set lostSel {owned} set lostSel2 {owned2} selection own -command { set lostSel {lost1} } .f1 @@ -408,73 +449,79 @@ test select-4.6 {Tk_ClearSelection procedure} {unix altDisplay} { [selection own -displayof .f2] $lostSel $lostSel2 cleanupbg set result -} {{} .f1 {} owned lost2} +} -result {{} .f1 {} owned lost2} ############################################################################## -test select-5.1 {Tk_GetSelection procedure} { +test select-5.1 {Tk_GetSelection procedure} -returnCodes error -setup { setup - list [catch {selection get TEST} msg] $msg -} {1 {PRIMARY selection doesn't exist or form "TEST" not defined}} -test select-5.2 {Tk_GetSelection procedure} { +} -body { + selection get TEST +} -result {PRIMARY selection doesn't exist or form "TEST" not defined} +test select-5.2 {Tk_GetSelection procedure} -setup { setup +} -body { selection get TK_WINDOW -} {.f1} -test select-5.3 {Tk_GetSelection procedure} { +} -result {.f1} +test select-5.3 {Tk_GetSelection procedure} -setup { setup +} -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST set selValue "Test value" set selInfo "" list [selection get TEST] $selInfo -} {{Test value} {TEST 0 4000}} -test select-5.4 {Tk_GetSelection procedure} { +} -result {{Test value} {TEST 0 4000}} +test select-5.4 {Tk_GetSelection procedure} -setup { setup +} -returnCodes error -body { selection handle .f1 ERROR errHandler - list [catch {selection get ERROR} msg] $msg -} {1 {PRIMARY selection doesn't exist or form "ERROR" not defined}} -test select-5.5 {Tk_GetSelection procedure} { + selection get ERROR +} -result {PRIMARY selection doesn't exist or form "ERROR" not defined} +test select-5.5 {Tk_GetSelection procedure} -setup { setup +} -body { set selValue $longValue set selInfo "" selection handle .f1 {handler STRING} list [selection get] $selInfo -} "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000}" -test select-5.6 {Tk_GetSelection procedure} { - proc weirdHandler {type offset count} { - selection handle .f1 {} - handler $type $offset $count - } +} -result "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000}" +test select-5.6 {Tk_GetSelection procedure} -setup { setup +} -returnCodes error -body { set selValue $longValue set selInfo "" - selection handle .f1 {weirdHandler STRING} - list [catch {selection get} msg] $msg -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined}} -test select-5.7 {Tk_GetSelection procedure} { - proc weirdHandler {type offset count} { - destroy .f1 + selection handle .f1 {apply {{type offset count} { + selection handle .f1 {} handler $type $offset $count - } + }} STRING} + selection get +} -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test select-5.7 {Tk_GetSelection procedure} -setup { setup +} -returnCodes error -body { set selValue "Test Value" set selInfo "" - selection handle .f1 {weirdHandler STRING} - list [catch {selection get} msg] $msg -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined}} -test select-5.8 {Tk_GetSelection procedure} { - proc weirdHandler {type offset count} { - selection clear + selection handle .f1 {apply {{type offset count} { + destroy .f1 handler $type $offset $count - } + }} STRING} + selection get +} -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test select-5.8 {Tk_GetSelection procedure} -setup { setup +} -body { set selValue $longValue set selInfo "" - selection handle .f1 {weirdHandler STRING} + selection handle .f1 {apply {{type offset count} { + selection clear + handler $type $offset $count + }} STRING} list [selection get] $selInfo [catch {selection get} msg] $msg -} "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}" -test select-5.9 {Tk_GetSelection procedure} unix { +} -result "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}" +test select-5.9 {Tk_GetSelection procedure} -constraints unix -setup { setup setupbg +} -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST update set selValue "Test value" @@ -483,10 +530,11 @@ test select-5.9 {Tk_GetSelection procedure} unix { lappend result [dobg {selection get TEST}] cleanupbg lappend result $selInfo -} {{Test value} {TEST 0 4000}} -test select-5.10 {Tk_GetSelection procedure} unix { +} -result {{Test value} {TEST 0 4000}} +test select-5.10 {Tk_GetSelection procedure} -constraints unix -setup { setup setupbg +} -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST update set selValue "Test value" @@ -496,11 +544,14 @@ test select-5.10 {Tk_GetSelection procedure} unix { lappend result [dobg {selection get TEST} 1] cleanupbg lappend result $selInfo -} {{selection owner didn't respond} {}} +} -result {{selection owner didn't respond} {}} # multiple display tests -test select-5.11 {Tk_GetSelection procedure} {altDisplay} { +test select-5.11 {Tk_GetSelection procedure} -constraints { + altDisplay +} -setup { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) +} -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST selection handle -selection PRIMARY .f2 {handler TEST2} TEST set selValue "Test value" @@ -509,11 +560,14 @@ test select-5.11 {Tk_GetSelection procedure} {altDisplay} { set selValue "Test value2" set selInfo "" lappend result [selection get -displayof .f2 TEST] $selInfo -} {{Test value} {TEST 0 4000} {Test value2} {TEST2 0 4000}} -test select-5.12 {Tk_GetSelection procedure} {altDisplay} { +} -result {{Test value} {TEST 0 4000} {Test value2} {TEST2 0 4000}} +test select-5.12 {Tk_GetSelection procedure} -constraints { + altDisplay +} -setup { global lostSel lostSel2 setup .f1 setup .f2 $env(TK_ALT_DISPLAY) +} -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST selection handle -selection PRIMARY .f2 {} TEST set selValue "Test value" @@ -523,11 +577,14 @@ test select-5.12 {Tk_GetSelection procedure} {altDisplay} { set selInfo "" lappend result [catch {selection get -displayof .f2 TEST} msg] $msg \ $selInfo -} {0 {Test value} {TEST 0 4000} 1 {PRIMARY selection doesn't exist or form "TEST" not defined} {}} -test select-5.13 {Tk_GetSelection procedure} {unix altDisplay} { +} -result {0 {Test value} {TEST 0 4000} 1 {PRIMARY selection doesn't exist or form "TEST" not defined} {}} +test select-5.13 {Tk_GetSelection procedure} -constraints { + unix altDisplay +} -setup { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) setupbg +} -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST selection own .f1 selection handle -selection PRIMARY .f2 {handler TEST2} TEST @@ -541,11 +598,14 @@ test select-5.13 {Tk_GetSelection procedure} {unix altDisplay} { lappend result [dobg "selection get TEST"] cleanupbg lappend result $selInfo -} {{Test value} {Test value2} {TEST2 0 4000 TEST 0 4000}} -test select-5.14 {Tk_GetSelection procedure} {unix altDisplay} { +} -result {{Test value} {Test value2} {TEST2 0 4000 TEST 0 4000}} +test select-5.14 {Tk_GetSelection procedure} -constraints { + unix altDisplay +} -setup { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) setupbg +} -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST selection own .f1 selection handle -selection PRIMARY .f2 {} TEST @@ -559,215 +619,244 @@ test select-5.14 {Tk_GetSelection procedure} {unix altDisplay} { lappend result [dobg "selection get TEST"] cleanupbg lappend result $selInfo -} {{PRIMARY selection doesn't exist or form "TEST" not defined} {Test value2} {TEST 0 4000}} +} -result {{PRIMARY selection doesn't exist or form "TEST" not defined} {Test value2} {TEST 0 4000}} +test select-5.15 {Tk_GetSelection procedure} -setup { + setup + if {[llength [info command ::bgerror]]} { + rename ::bgerror ::TMPbgerror + } + set ::bgerrors {} +} -body { + proc ::bgerror msg {lappend ::bgerrors $msg} + selection handle -type ERROR .f1 errHandler + list [catch {selection get ERROR} msg] $msg [update] {*}$::bgerrors +} -cleanup { + rename ::bgerror {} + if {[llength [info command ::TMPbgerror]]} { + rename ::TMPbgerror ::bgerror + } +} -result {1 {PRIMARY selection doesn't exist or form "ERROR" not defined} {} {selection handler aborted}} ############################################################################## -test select-6.1 {Tk_SelectionCmd procedure} { - list [catch {selection} cmd] $cmd -} {1 {wrong # args: should be "selection option ?arg arg ...?"}} +test select-6.1 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection +} -result {wrong # args: should be "selection option ?arg ...?"} # selection clear -test select-6.2 {Tk_SelectionCmd procedure} { - list [catch {selection clear -selection} cmd] $cmd -} {1 {value for "-selection" missing}} -test select-6.3 {Tk_SelectionCmd procedure} { +test select-6.2 {Tk_SelectionCmd procedure} -body { + selection clear -selection +} -returnCodes error -result {value for "-selection" missing} +test select-6.3 {Tk_SelectionCmd procedure} -setup { setup +} -body { selection own . set result [selection own] selection clear -displayof .f1 lappend result [selection own] -} {. {}} -test select-6.4 {Tk_SelectionCmd procedure} { +} -result {. {}} +test select-6.4 {Tk_SelectionCmd procedure} -setup { setup +} -body { selection own -selection CLIPBOARD .f1 set result [list [selection own] [selection own -selection CLIPBOARD]] selection clear -selection CLIPBOARD .f1 lappend result [selection own] [selection own -selection CLIPBOARD] -} {.f1 .f1 .f1 {}} -test select-6.5 {Tk_SelectionCmd procedure} { +} -result {.f1 .f1 .f1 {}} +test select-6.5 {Tk_SelectionCmd procedure} -setup { setup +} -body { selection own -selection CLIPBOARD . set result [list [selection own] [selection own -selection CLIPBOARD]] selection clear -selection CLIPBOARD -displayof .f1 lappend result [selection own] [selection own -selection CLIPBOARD] -} {.f1 . .f1 {}} -test select-6.6 {Tk_SelectionCmd procedure} { - list [catch {selection clear -badopt foo} cmd] $cmd -} {1 {bad option "-badopt": must be -displayof or -selection}} -test select-6.7 {Tk_SelectionCmd procedure} { - list [catch {selection clear -selectionfoo foo} cmd] $cmd -} {1 {bad option "-selectionfoo": must be -displayof or -selection}} -test select-6.8 {Tk_SelectionCmd procedure} { - catch {destroy .f2} - list [catch {selection clear -displayof .f2} cmd] $cmd -} {1 {bad window path name ".f2"}} -test select-6.9 {Tk_SelectionCmd procedure} { - catch {destroy .f2} - list [catch {selection clear .f2} cmd] $cmd -} {1 {bad window path name ".f2"}} -test select-6.10 {Tk_SelectionCmd procedure} { +} -result {.f1 . .f1 {}} +test select-6.6 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection clear -badopt foo +} -result {bad option "-badopt": must be -displayof or -selection} +test select-6.7 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection clear -selectionfoo foo +} -result {bad option "-selectionfoo": must be -displayof or -selection} +test select-6.8 {Tk_SelectionCmd procedure} -body { + destroy .f2 + selection clear -displayof .f2 +} -returnCodes error -result {bad window path name ".f2"} +test select-6.9 {Tk_SelectionCmd procedure} -body { + destroy .f2 + selection clear .f2 +} -returnCodes error -result {bad window path name ".f2"} +test select-6.10 {Tk_SelectionCmd procedure} -setup { setup +} -body { set result [selection own -selection PRIMARY] selection clear lappend result [selection own -selection PRIMARY] -} {.f1 {}} -test select-6.11 {Tk_SelectionCmd procedure} { +} -result {.f1 {}} +test select-6.11 {Tk_SelectionCmd procedure} -setup { setup +} -body { selection own -selection CLIPBOARD .f1 set result [selection own -selection CLIPBOARD] selection clear -selection CLIPBOARD lappend result [selection own -selection CLIPBOARD] -} {.f1 {}} -test select-6.12 {Tk_SelectionCmd procedure} { - list [catch {selection clear foo bar} cmd] $cmd -} {1 {wrong # args: should be "selection clear ?options?"}} +} -result {.f1 {}} +test select-6.12 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection clear foo bar +} -result {wrong # args: should be "selection clear ?-option value ...?"} # selection get -test select-6.13 {Tk_SelectionCmd procedure} { - list [catch {selection get -selection} cmd] $cmd -} {1 {value for "-selection" missing}} -test select-6.14 {Tk_SelectionCmd procedure} { +test select-6.13 {Tk_SelectionCmd procedure} -body { + selection get -selection +} -returnCodes error -result {value for "-selection" missing} +test select-6.14 {Tk_SelectionCmd procedure} -setup { global selValue selInfo setup +} -body { selection handle .f1 {handler TEST} set selValue "Test value" set selInfo "" list [selection get -displayof .f1] $selInfo -} {{Test value} {TEST 0 4000}} -test select-6.15 {Tk_SelectionCmd procedure} { +} -result {{Test value} {TEST 0 4000}} +test select-6.15 {Tk_SelectionCmd procedure} -setup { global selValue selInfo setup +} -body { selection handle .f1 {handler STRING} selection handle -selection CLIPBOARD .f1 {handler TEST} selection own -selection CLIPBOARD .f1 set selValue "Test value" set selInfo "" list [selection get -selection CLIPBOARD] $selInfo -} {{Test value} {TEST 0 4000}} -test select-6.16 {Tk_SelectionCmd procedure} { +} -result {{Test value} {TEST 0 4000}} +test select-6.16 {Tk_SelectionCmd procedure} -setup { global selValue selInfo setup +} -body { selection handle -type TEST .f1 {handler TEST} selection handle -type STRING .f1 {handler STRING} set selValue "Test value" set selInfo "" list [selection get -type TEST] $selInfo -} {{Test value} {TEST 0 4000}} -test select-6.17 {Tk_SelectionCmd procedure} { - list [catch {selection get -badopt foo} cmd] $cmd -} {1 {bad option "-badopt": must be -displayof, -selection, or -type}} -test select-6.18 {Tk_SelectionCmd procedure} { - list [catch {selection get -selectionfoo foo} cmd] $cmd -} {1 {bad option "-selectionfoo": must be -displayof, -selection, or -type}} -test select-6.19 {Tk_SelectionCmd procedure} { +} -result {{Test value} {TEST 0 4000}} +test select-6.17 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection get -badopt foo +} -result {bad option "-badopt": must be -displayof, -selection, or -type} +test select-6.18 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection get -selectionfoo foo +} -result {bad option "-selectionfoo": must be -displayof, -selection, or -type} +test select-6.19 {Tk_SelectionCmd procedure} -body { catch { destroy .f2 } - list [catch {selection get -displayof .f2} cmd] $cmd -} {1 {bad window path name ".f2"}} -test select-6.20 {Tk_SelectionCmd procedure} { - list [catch {selection get foo bar} cmd] $cmd -} {1 {wrong # args: should be "selection get ?options?"}} -test select-6.21 {Tk_SelectionCmd procedure} { + selection get -displayof .f2 +} -returnCodes error -result {bad window path name ".f2"} +test select-6.20 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection get foo bar +} -result {wrong # args: should be "selection get ?-option value ...?"} +test select-6.21 {Tk_SelectionCmd procedure} -setup { global selValue selInfo setup +} -body { selection handle -type TEST .f1 {handler TEST} selection handle -type STRING .f1 {handler STRING} set selValue "Test value" set selInfo "" list [selection get TEST] $selInfo -} {{Test value} {TEST 0 4000}} +} -result {{Test value} {TEST 0 4000}} # selection handle # most of the handle section has been covered earlier -test select-6.22 {Tk_SelectionCmd procedure} { - list [catch {selection handle -selection} cmd] $cmd -} {1 {value for "-selection" missing}} -test select-6.23 {Tk_SelectionCmd procedure} { +test select-6.22 {Tk_SelectionCmd procedure} -body { + selection handle -selection +} -returnCodes error -result {value for "-selection" missing} +test select-6.23 {Tk_SelectionCmd procedure} -setup { global selValue selInfo setup +} -body { set selValue "Test value" set selInfo "" list [selection handle -format INTEGER .f1 {handler TEST}] [selection get -displayof .f1] $selInfo -} {{} {Test value} {TEST 0 4000}} -test select-6.24 {Tk_SelectionCmd procedure} { - list [catch {selection handle -badopt foo} cmd] $cmd -} {1 {bad option "-badopt": must be -format, -selection, or -type}} -test select-6.25 {Tk_SelectionCmd procedure} { - list [catch {selection handle -selectionfoo foo} cmd] $cmd -} {1 {bad option "-selectionfoo": must be -format, -selection, or -type}} -test select-6.26 {Tk_SelectionCmd procedure} { - list [catch {selection handle} cmd] $cmd -} {1 {wrong # args: should be "selection handle ?options? window command"}} -test select-6.27 {Tk_SelectionCmd procedure} { - list [catch {selection handle .} cmd] $cmd -} {1 {wrong # args: should be "selection handle ?options? window command"}} -test select-6.28 {Tk_SelectionCmd procedure} { - list [catch {selection handle . foo bar baz blat} cmd] $cmd -} {1 {wrong # args: should be "selection handle ?options? window command"}} -test select-6.29 {Tk_SelectionCmd procedure} { +} -result {{} {Test value} {TEST 0 4000}} +test select-6.24 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection handle -badopt foo +} -result {bad option "-badopt": must be -format, -selection, or -type} +test select-6.25 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection handle -selectionfoo foo +} -result {bad option "-selectionfoo": must be -format, -selection, or -type} +test select-6.26 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection handle +} -result {wrong # args: should be "selection handle ?-option value ...? window command"} +test select-6.27 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection handle . +} -result {wrong # args: should be "selection handle ?-option value ...? window command"} +test select-6.28 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection handle . foo bar baz blat +} -result {wrong # args: should be "selection handle ?-option value ...? window command"} +test select-6.29 {Tk_SelectionCmd procedure} -body { catch { destroy .f2 } - list [catch {selection handle .f2 dummy} cmd] $cmd -} {1 {bad window path name ".f2"}} + selection handle .f2 dummy +} -returnCodes error -result {bad window path name ".f2"} # selection own -test select-6.30 {Tk_SelectionCmd procedure} { - list [catch {selection own -selection} cmd] $cmd -} {1 {value for "-selection" missing}} -test select-6.31 {Tk_SelectionCmd procedure} { +test select-6.30 {Tk_SelectionCmd procedure} -body { + selection own -selection +} -returnCodes error -result {value for "-selection" missing} +test select-6.31 {Tk_SelectionCmd procedure} -setup { setup +} -body { selection own . selection own -displayof .f1 -} {.} -test select-6.32 {Tk_SelectionCmd procedure} { +} -result {.} +test select-6.32 {Tk_SelectionCmd procedure} -setup { setup +} -body { selection own . selection own -selection CLIPBOARD .f1 list [selection own] [selection own -selection CLIPBOARD] -} {. .f1} -test select-6.33 {Tk_SelectionCmd procedure} { +} -result {. .f1} +test select-6.33 {Tk_SelectionCmd procedure} -setup { global lostSel setup +} -body { set lostSel owned selection own -command { set lostSel lost } . selection own -selection CLIPBOARD .f1 set result $lostSel selection own .f1 lappend result $lostSel -} {owned lost} -test select-6.34 {Tk_SelectionCmd procedure} { - list [catch {selection own -badopt foo} cmd] $cmd -} {1 {bad option "-badopt": must be -command, -displayof, or -selection}} -test select-6.35 {Tk_SelectionCmd procedure} { - list [catch {selection own -selectionfoo foo} cmd] $cmd -} {1 {bad option "-selectionfoo": must be -command, -displayof, or -selection}} -test select-6.36 {Tk_SelectionCmd procedure} { - catch {destroy .f2} - list [catch {selection own -displayof .f2} cmd] $cmd -} {1 {bad window path name ".f2"}} -test select-6.37 {Tk_SelectionCmd procedure} { - catch {destroy .f2} - list [catch {selection own .f2} cmd] $cmd -} {1 {bad window path name ".f2"}} -test select-6.38 {Tk_SelectionCmd procedure} { - list [catch {selection own foo bar baz} cmd] $cmd -} {1 {wrong # args: should be "selection own ?options? ?window?"}} -test select-6.39 {Tk_SelectionCmd procedure} { - list [catch {selection foo} cmd] $cmd -} {1 {bad option "foo": must be clear, get, handle, or own}} +} -result {owned lost} +test select-6.34 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection own -badopt foo +} -result {bad option "-badopt": must be -command, -displayof, or -selection} +test select-6.35 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection own -selectionfoo foo +} -result {bad option "-selectionfoo": must be -command, -displayof, or -selection} +test select-6.36 {Tk_SelectionCmd procedure} -body { + destroy .f2 + selection own -displayof .f2 +} -returnCodes error -result {bad window path name ".f2"} +test select-6.37 {Tk_SelectionCmd procedure} -body { + destroy .f2 + selection own .f2 +} -returnCodes error -result {bad window path name ".f2"} +test select-6.38 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection own foo bar baz +} -result {wrong # args: should be "selection own ?-option value ...? ?window?"} +test select-6.39 {Tk_SelectionCmd procedure} -returnCodes error -body { + selection foo +} -result {bad option "foo": must be clear, get, handle, or own} ############################################################################## -# This test is non-portable because some old X11/News servers ignore -# a selection request when the window doesn't exist, which causes a -# different error message. -test select-7.1 {TkSelDeadWindow procedure} nonPortable { +# This test is non-portable because some old X11/News servers ignore a +# selection request when the window doesn't exist, which causes a different +# error message. +test select-7.1 {TkSelDeadWindow procedure} -constraints nonPortable -setup { setup +} -body { selection handle .f1 { handler TEST } set result [selection own] destroy .f1 lappend result [selection own] [catch {selection get} msg] $msg -} {.f1 {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined}} +} -result {.f1 {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined}} ############################################################################## # Check reentrancy on losing selection - test select-8.1 {TkSelEventProc procedure} -constraints unix -setup { setup setupbg @@ -788,16 +877,17 @@ test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup { set selValue "1024" set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ - .f1 {handler TEST} + .f1 {handler TEST} update set result "" lappend result [dobg {selection get TEST}] cleanupbg lappend result $selInfo } -result {{0x400 } {TEST 0 4000}} -test select-9.2 {SelCvtToX and SelCvtFromX procedures} unix { +test select-9.2 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg +} -constraints unix -body { set selValue "1024 0xffff 2048 -2 " set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ @@ -806,10 +896,11 @@ test select-9.2 {SelCvtToX and SelCvtFromX procedures} unix { lappend result [dobg {selection get TEST}] cleanupbg lappend result $selInfo -} {{0x400 0xffff 0x800 0xfffffffe } {TEST 0 4000}} -test select-9.3 {SelCvtToX and SelCvtFromX procedures} unix { +} -result {{0x400 0xffff 0x800 0xfffffffe } {TEST 0 4000}} +test select-9.3 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg +} -constraints unix -body { set selValue " " set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ @@ -818,10 +909,11 @@ test select-9.3 {SelCvtToX and SelCvtFromX procedures} unix { lappend result [dobg {selection get TEST}] cleanupbg lappend result $selInfo -} {{ } {TEST 0 4000}} -test select-9.4 {SelCvtToX and SelCvtFromX procedures} unix { +} -result {{ } {TEST 0 4000}} +test select-9.4 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg +} -constraints unix -body { set selValue "16 foobar 32" set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ @@ -830,7 +922,7 @@ test select-9.4 {SelCvtToX and SelCvtFromX procedures} unix { lappend result [dobg {selection get TEST}] cleanupbg lappend result $selInfo -} {{0x10 0x0 0x20 } {TEST 0 4000}} +} -result {{0x10 0x0 0x20 } {TEST 0 4000}} test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg @@ -841,19 +933,21 @@ test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup { set selInfo "" set selType {text/x-tk-test;detail="foo bar"} selection handle -selection PRIMARY -format STRING -type $selType \ - .f1 [list handler $selType] + .f1 [list handler $selType] lsort [dobg {selection get TARGETS}] } -cleanup { cleanupbg } -result {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW {text/x-tk-test;detail="foo bar"}} ############################################################################## - # note, we are not testing MULTIPLE style selections # most control paths have been exercised above -test select-10.1 {ConvertSelection procedure, race with selection clear} unix { +test select-10.1 {ConvertSelection procedure, race with selection clear} -constraints { + unix +} -setup { setup +} -body { proc Ready {fd} { variable x lappend x [gets $fd] @@ -867,7 +961,7 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} unix { set selInfo "" selection handle .f1 {handler STRING} update - puts $fd {puts "[catch {selection get} msg] $msg"; puts **DONE**; flush stdout} + puts $fd {puts "[catch {selection get} msg]:$msg"; puts **DONE**; flush stdout} flush $fd after 200 selection own . @@ -879,10 +973,11 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} unix { # a "broken pipe" error when Tk was actually [load]ed in the child. catch {close $fd} lappend x $selInfo -} {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}} -test select-10.2 {ConvertSelection procedure} unix { +} -result {{1:PRIMARY selection doesn't exist or form "STRING" not defined} {}} +test select-10.2 {ConvertSelection procedure} -constraints unix -setup { setup setupbg +} -body { set selValue [string range $longValue 0 3999] set selInfo "" selection handle .f1 {handler STRING} @@ -890,21 +985,24 @@ test select-10.2 {ConvertSelection procedure} unix { lappend result [dobg {selection get}] cleanupbg lappend result $selInfo -} [list [string range $longValue 0 3999] {STRING 0 4000 STRING 4000 4000 STRING 0 4000 STRING 4000 4000}] -test select-10.3 {ConvertSelection procedure} unix { +} -result [list [string range $longValue 0 3999] {STRING 0 4000 STRING 4000 4000 STRING 0 4000 STRING 4000 4000}] +test select-10.3 {ConvertSelection procedure} -constraints unix -setup { setup setupbg +} -body { selection handle .f1 ERROR errHandler - set result "" - lappend result [dobg {selection get ERROR}] + dobg {selection get ERROR} +} -cleanup { cleanupbg - set result -} {{PRIMARY selection doesn't exist or form "ERROR" not defined}} +} -result {PRIMARY selection doesn't exist or form "ERROR" not defined} # testing timers # This one hangs in Exceed -test select-10.4 {ConvertSelection procedure} {unix noExceed} { +test select-10.4 {ConvertSelection procedure} -constraints { + unix noExceed +} -setup { setup setupbg +} -body { set selValue $longValue set selInfo "" selection handle .f1 {errIncrHandler STRING} @@ -913,10 +1011,13 @@ test select-10.4 {ConvertSelection procedure} {unix noExceed} { lappend result [dobg {selection get}] cleanupbg lappend result $selInfo -} {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}} -test select-10.5 {ConvertSelection procedure, reentrancy issues} unix { +} -result {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}} +test select-10.5 {ConvertSelection procedure, reentrancy issues} -constraints { + unix +} -setup { setup setupbg +} -body { set selValue "Test value" set selInfo "" selection handle -type TEST .f1 { handler TEST } @@ -925,14 +1026,17 @@ test select-10.5 {ConvertSelection procedure, reentrancy issues} unix { lappend result [dobg {selection get}] cleanupbg lappend result $selInfo -} {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}} -test select-10.6 {ConvertSelection procedure, reentrancy issues} unix { +} -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}} +test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints { + unix +} -setup { + setup + setupbg +} -body { proc weirdHandler {type offset count} { destroy .f1 handler $type $offset $count } - setup - setupbg set selValue $longValue set selInfo "" selection handle .f1 {weirdHandler STRING} @@ -940,14 +1044,15 @@ test select-10.6 {ConvertSelection procedure, reentrancy issues} unix { lappend result [dobg {selection get}] cleanupbg lappend result $selInfo -} {{PRIMARY selection doesn't exist or form "STRING" not defined} {STRING 0 4000}} +} -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {STRING 0 4000}} ############################################################################## # testing reentrancy -test select-11.1 {TkSelPropProc procedure} unix { +test select-11.1 {TkSelPropProc procedure} -constraints unix -setup { setup setupbg +} -body { set selValue $longValue set selInfo "" selection handle -type TEST .f1 { handler TEST } @@ -957,28 +1062,28 @@ test select-11.1 {TkSelPropProc procedure} unix { lappend result [dobg {selection get}] cleanupbg lappend result $selInfo -} {{selection owner didn't respond} {.f1 STRING 0 4000 .f1 STRING 4000 4000 .f1 STRING 8000 4000 .f1 STRING 12000 4000 .f1 STRING 16000 4000 .f1 STRING 0 4000 .f1 STRING 4000 4000}} +} -result {{selection owner didn't respond} {.f1 STRING 0 4000 .f1 STRING 4000 4000 .f1 STRING 8000 4000 .f1 STRING 12000 4000 .f1 STRING 16000 4000 .f1 STRING 0 4000 .f1 STRING 4000 4000}} ############################################################################## # Note, this assumes we are using CurrentTtime -test select-12.1 {DefaultSelection procedure} unix { +test select-12.1 {DefaultSelection procedure} -constraints unix -body { setup set result [selection get -type TIMESTAMP] setupbg lappend result [dobg {selection get -type TIMESTAMP}] cleanupbg set result -} {0x0 {0x0 }} -test select-12.2 {DefaultSelection procedure} unix { +} -result {0x0 {0x0 }} +test select-12.2 {DefaultSelection procedure} -constraints unix -body { setup set result [lsort [list [selection get -type TARGETS]]] setupbg lappend result [dobg {lsort [selection get -type TARGETS]}] cleanupbg set result -} {{MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-12.3 {DefaultSelection procedure} unix { +} -result {{MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-12.3 {DefaultSelection procedure} -constraints unix -body { setup selection handle .f1 {handler TEST} TEST set result [list [lsort [selection get -type TARGETS]]] @@ -986,25 +1091,26 @@ test select-12.3 {DefaultSelection procedure} unix { lappend result [dobg {lsort [selection get -type TARGETS]}] cleanupbg set result -} {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-12.4 {DefaultSelection procedure} unix { +} -result {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} +test select-12.4 {DefaultSelection procedure} -constraints unix -setup { setup set result "" +} -body { lappend result [selection get -type TK_APPLICATION] setupbg lappend result [dobg {selection get -type TK_APPLICATION}] cleanupbg set result -} [list [winfo name .] [winfo name .]] -test select-12.5 {DefaultSelection procedure} unix { +} -result [list [winfo name .] [winfo name .]] +test select-12.5 {DefaultSelection procedure} -constraints unix -body { setup set result [selection get -type TK_WINDOW] setupbg lappend result [dobg {selection get -type TK_WINDOW}] cleanupbg set result -} {.f1 .f1} -test select-12.6 {DefaultSelection procedure} { +} -result {.f1 .f1} +test select-12.6 {DefaultSelection procedure} -body { setup selection handle .f1 {handler TARGETS.f1} TARGETS set selValue "Targets value" @@ -1012,9 +1118,14 @@ test select-12.6 {DefaultSelection procedure} { set result [list [selection get TARGETS] $selInfo] selection handle .f1 {} TARGETS lappend result [selection get TARGETS] -} {{Targets value} {TARGETS.f1 0 4000} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} +} -result {{Targets value} {TARGETS.f1 0 4000} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-13.1 {SelectionSize procedure, handler deleted} unix { +test select-13.1 {SelectionSize procedure, handler deleted} -constraints { + unix +} -setup { + setup + setupbg +} -body { proc badHandler {path type offset count} { global selValue selInfo abortCount incr abortCount -1 @@ -1028,8 +1139,6 @@ test select-13.1 {SelectionSize procedure, handler deleted} unix { } string range $selValue $offset [expr $numBytes+$offset] } - setup - setupbg set selValue $longValue set selInfo "" selection handle .f1 {badHandler .f1 STRING} @@ -1038,10 +1147,14 @@ test select-13.1 {SelectionSize procedure, handler deleted} unix { lappend result [dobg {selection get}] cleanupbg lappend result $selInfo -} {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}} - +} -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}} + catch {rename weirdHandler {}} # cleanup cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/send.test b/tests/send.test index d3fce3b..945d4d0 100644 --- a/tests/send.test +++ b/tests/send.test @@ -227,13 +227,13 @@ test send-8.3 {Tk_SendCmd procedure, options} {secureserver} { } {1 {no application named "-async"}} test send-8.4 {Tk_SendCmd procedure, options} {secureserver} { list [catch {send -gorp foo bar baz} msg] $msg -} {1 {bad option "-gorp": must be -async, -displayof, or --}} +} {1 {no application named "-gorp"}} test send-8.5 {Tk_SendCmd procedure, options} {secureserver} { list [catch {send -async foo} msg] $msg -} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}} +} {1 {wrong # args: should be "send ?-option value ...? interpName arg ?arg ...?"}} test send-8.6 {Tk_SendCmd procedure, options} {secureserver} { list [catch {send foo} msg] $msg -} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}} +} {1 {wrong # args: should be "send ?-option value ...? interpName arg ?arg ...?"}} test send-8.7 {Tk_SendCmd procedure, local execution} {secureserver} { set a initial send [tk appname] {set a new} diff --git a/tests/spinbox.test b/tests/spinbox.test index 68c6fae..594cc90 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -1,238 +1,1240 @@ # This file is a Tcl script to test spinbox widgets in Tk. It is # organized in the standard fashion for Tcl tests. # -# Copyright (c) 1998-2000 by Scriptics Corporation. +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +# For xscrollcommand proc scroll args { - global scrollInfo - set scrollInfo $args + global scrollInfo + set scrollInfo $args +} +# For trace variable +proc override args { + global x + set x 12345 } -# Create additional widget that's used to hold the selection at times. - -spinbox .sel -.sel insert end "This is some sample text" - -# Font names - -set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1 -set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1 - -# Create entries in the option database to be sure that geometry options -# like border width have predictable values. - -option add *Spinbox.borderWidth 2 -option add *Spinbox.highlightThickness 2 -option add *Spinbox.font {Helvetica -12} - -spinbox .e -bd 2 -relief sunken -pack .e -update - -set i 1 -foreach test { - {-activebackground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-background #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-buttonbackground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"}} - {-buttoncursor arrow arrow badValue {bad cursor spec "badValue"}} - {-command {a command} {a command} {} {}} - {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-disabledbackground green green non-existent - {unknown color name "non-existent"}} - {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}} - {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} - {-fg #110022 #110022 bogus {unknown color name "bogus"}} - {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {} - {font "" doesn't exist}} - {-foreground #110022 #110022 bogus {unknown color name "bogus"}} - {-format %0.5f %0.5f %d {bad spinbox format specifier "%d"}} - {-from -10 -10.0 bogus {expected floating-point number but got "bogus"}} - {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}} - {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} - {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} - {-highlightthickness -2 0 {} {}} - {-increment 1.0 1.0 bogus {expected floating-point number but got "bogus"}} - {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}} - {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} - {-insertontime 100 100 3.2 {expected integer but got "3.2"}} - {-invalidcommand "a command" "a command" {} {}} - {-invcmd "a command" "a command" {} {}} - {-justify right right bogus {bad justification "bogus": must be left, right, or center}} - {-readonlybackground green green non-existent - {unknown color name "non-existent"}} - {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-repeatdelay 500 500 3p {expected integer but got "3p"}} - {-repeatinterval -500 -500 3p {expected integer but got "3p"}} - {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} - {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} - {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} - {-state n normal bogus {bad state "bogus": must be disabled, normal, or readonly}} - {-takefocus "any string" "any string" {} {}} - {-textvariable i i {} {}} - {-to 14.9 14.9 bogus {expected floating-point number but got "bogus"}} - {-validate "key" "key" "bogus" {bad validate "bogus": must be all, key, focus, focusin, focusout, or none}} - {-validatecommand "a command" "a command" {} {}} - {-values {mon tue wed thur} {mon tue wed thur} {bad {}list} {list element in braces followed by "list" instead of space}} - {-vcmd "a command" "a command" {} {}} - {-width 402 402 3p {expected integer but got "3p"}} - {-wrap yes 1 xyzzy {expected boolean value but got "xyzzy"}} - {-xscrollcommand {Some command} {Some command} {} {}} -} { - set name [lindex $test 0] - test spinbox-1.$i {configuration options} { - .e configure $name [lindex $test 1] - list [lindex [.e configure $name] 4] [.e cget $name] - } [list [lindex $test 2] [lindex $test 2]] - incr i - if {[lindex $test 3] != ""} { - test spinbox-1.$i {configuration options} { - list [catch {.e configure $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - .e configure $name [lindex [.e configure $name] 3] - incr i +# Procedures used in widget VALIDATION tests +proc doval {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 1 +} +proc doval2 {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + set ::e mydata + return 1 +} +proc doval3 {W d i P s S v V} { + set ::vVals [list $W $d $i $P $s $S $v $V] + return 0 } -test spinbox-2.1 {Tk_SpinboxCmd procedure} { - list [catch {spinbox} msg] $msg -} {1 {wrong # args: should be "spinbox pathName ?options?"}} -test spinbox-2.2 {Tk_SpinboxCmd procedure} { - list [catch {spinbox gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test spinbox-2.3 {Tk_SpinboxCmd procedure} { - catch {destroy .e} +set cy [font metrics {Courier -12} -linespace] + +test spinbox-1.1 {configuration option: "activebackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -activebackground #ff0000 + .e cget -activebackground +} -cleanup { + destroy .e +} -result {#ff0000} +test spinbox-1.2 {configuration option: "activebackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -activebackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.3 {configuration option: "background"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -background #ff0000 + .e cget -background +} -cleanup { + destroy .e +} -result {#ff0000} +test spinbox-1.4 {configuration option: "background" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -background non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.5 {configuration option: "bd"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -bd 4 + .e cget -bd +} -cleanup { + destroy .e +} -result {4} +test spinbox-1.6 {configuration option: "bd" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -bd badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test spinbox-1.7 {configuration option: "bg"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -bg #ff0000 + .e cget -bg +} -cleanup { + destroy .e +} -result {#ff0000} +test spinbox-1.8 {configuration option: "bg" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -bg non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.9 {configuration option: "borderwidth"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -borderwidth 1.3 + .e cget -borderwidth +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.10 {configuration option: "borderwidth" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -borderwidth badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test spinbox-1.11 {configuration option: "buttonbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -buttonbackground #ff0000 + .e cget -buttonbackground +} -cleanup { + destroy .e +} -result {#ff0000} +test spinbox-1.12 {configuration option: "buttonbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -buttonbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.13 {configuration option: "buttoncursor"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -buttoncursor arrow + .e cget -buttoncursor +} -cleanup { + destroy .e +} -result {arrow} +test spinbox-1.14 {configuration option: "buttoncursor" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -buttoncursor badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test spinbox-1.15 {configuration option: "command"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -command {a command} + .e cget -command +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.16 {configuration option: "cursor"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -cursor arrow + .e cget -cursor +} -cleanup { + destroy .e +} -result {arrow} +test spinbox-1.17 {configuration option: "cursor" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -cursor badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad cursor spec "badValue"} + +test spinbox-1.18 {configuration option: "disabledbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -disabledbackground green + .e cget -disabledbackground +} -cleanup { + destroy .e +} -result {green} +test spinbox-1.19 {configuration option: "disabledbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -disabledbackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.20 {configuration option: "disabledforeground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -disabledforeground #110022 + .e cget -disabledforeground +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.21 {configuration option: "disabledforeground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -disabledforeground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.22 {configuration option: "exportselection"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -exportselection yes + .e cget -exportselection +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.23 {configuration option: "exportselection" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -exportselection xyzzy +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected boolean value but got "xyzzy"} + +test spinbox-1.24 {configuration option: "fg"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -fg #110022 + .e cget -fg +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.25 {configuration option: "fg" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -fg bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.26 {configuration option: "font"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* + .e cget -font +} -cleanup { + destroy .e +} -result {-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} +test spinbox-1.27 {configuration option: "font" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -font {} +} -cleanup { + destroy .e +} -returnCodes {error} -result {font "" doesn't exist} + +test spinbox-1.28 {configuration option: "foreground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -foreground #110022 + .e cget -foreground +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.29 {configuration option: "foreground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -foreground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.30 {configuration option: "format"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -format %0.5f + .e cget -format +} -cleanup { + destroy .e +} -result {%0.5f} +test spinbox-1.31 {configuration option: "format" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -format %d +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad spinbox format specifier "%d"} + +test spinbox-1.32 {configuration option: "from"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -from -10 + .e cget -from +} -cleanup { + destroy .e +} -result {-10.0} +test spinbox-1.33 {configuration option: "from" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -from bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected floating-point number but got "bogus"} + +test spinbox-1.34 {configuration option: "highlightbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightbackground #123456 + .e cget -highlightbackground +} -cleanup { + destroy .e +} -result {#123456} +test spinbox-1.35 {configuration option: "highlightbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightbackground ugly +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "ugly"} + +test spinbox-1.36 {configuration option: "highlightcolor"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightcolor #123456 + .e cget -highlightcolor +} -cleanup { + destroy .e +} -result {#123456} +test spinbox-1.37 {configuration option: "highlightcolor" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightcolor bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.38 {configuration option: "highlightthickness"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightthickness 6 + .e cget -highlightthickness +} -cleanup { + destroy .e +} -result {6} +test spinbox-1.39 {configuration option: "highlightthickness" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightthickness bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "bogus"} + +test spinbox-1.40 {configuration option: "highlightthickness"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -highlightthickness -2 + .e cget -highlightthickness +} -cleanup { + destroy .e +} -result {0} + +test spinbox-1.41 {configuration option: "increment"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -increment 1.0 + .e cget -increment +} -cleanup { + destroy .e +} -result {1.0} +test spinbox-1.42 {configuration option: "increment" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -increment bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected floating-point number but got "bogus"} + +test spinbox-1.43 {configuration option: "insertbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertbackground #110022 + .e cget -insertbackground +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.44 {configuration option: "insertbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertbackground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.45 {configuration option: "insertborderwidth"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertborderwidth 1.3 + .e cget -insertborderwidth +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.46 {configuration option: "insertborderwidth" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertborderwidth 2.6x +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "2.6x"} + +test spinbox-1.47 {configuration option: "insertofftime"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertofftime 100 + .e cget -insertofftime +} -cleanup { + destroy .e +} -result {100} +test spinbox-1.48 {configuration option: "insertofftime" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertofftime 3.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3.2"} + +test spinbox-1.49 {configuration option: "insertontime"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertontime 100 + .e cget -insertontime +} -cleanup { + destroy .e +} -result {100} +test spinbox-1.50 {configuration option: "insertontime" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -insertontime 3.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3.2"} + +test spinbox-1.51 {configuration option: "invalidcommand"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -invalidcommand "a command" + .e cget -invalidcommand +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.52 {configuration option: "invcmd"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -invcmd "a command" + .e cget -invcmd +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.53 {configuration option: "justify"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -justify right + .e cget -justify +} -cleanup { + destroy .e +} -result {right} +test spinbox-1.54 {configuration option: "justify" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -justify bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad justification "bogus": must be left, right, or center} + +test spinbox-1.55 {configuration option: "readonlybackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -readonlybackground green + .e cget -readonlybackground +} -cleanup { + destroy .e +} -result {green} +test spinbox-1.56 {configuration option: "readonlybackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -readonlybackground non-existent +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "non-existent"} + +test spinbox-1.57 {configuration option: "relief"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -relief groove + .e cget -relief +} -cleanup { + destroy .e +} -result {groove} +test spinbox-1.58 {configuration option: "relief" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -relief 1.5 +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} + +test spinbox-1.59 {configuration option: "repeatdelay"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -repeatdelay 500 + .e cget -repeatdelay +} -cleanup { + destroy .e +} -result {500} +test spinbox-1.60 {configuration option: "repeatdelay" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -repeatdelay 3p +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3p"} + +test spinbox-1.61 {configuration option: "repeatinterval"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -repeatinterval -500 + .e cget -repeatinterval +} -cleanup { + destroy .e +} -result {-500} +test spinbox-1.62 {configuration option: "repeatinterval" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -repeatinterval 3p +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3p"} + +test spinbox-1.63 {configuration option: "selectbackground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectbackground #110022 + .e cget -selectbackground +} -cleanup { + destroy .e +} -result {#110022} +test spinbox-1.64 {configuration option: "selectbackground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectbackground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.65 {configuration option: "selectborderwidth"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectborderwidth 1.3 + .e cget -selectborderwidth +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.66 {configuration option: "selectborderwidth" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectborderwidth badValue +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad screen distance "badValue"} + +test spinbox-1.67 {configuration option: "selectforeground"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectforeground #654321 + .e cget -selectforeground +} -cleanup { + destroy .e +} -result {#654321} +test spinbox-1.68 {configuration option: "selectforeground" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -selectforeground bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {unknown color name "bogus"} + +test spinbox-1.69 {configuration option: "state"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -state n + .e cget -state +} -cleanup { + destroy .e +} -result {normal} +test spinbox-1.70 {configuration option: "state" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -state bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad state "bogus": must be disabled, normal, or readonly} + +test spinbox-1.71 {configuration option: "takefocus"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -takefocus "any string" + .e cget -takefocus +} -cleanup { + destroy .e +} -result {any string} + +test spinbox-1.72 {configuration option: "textvariable"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -textvariable i + .e cget -textvariable +} -cleanup { + destroy .e +} -result {i} + +test spinbox-1.73 {configuration option: "to"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -to 14.9 + .e cget -to +} -cleanup { + destroy .e +} -result {14.9} +test spinbox-1.74 {configuration option: "to" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -to bogus +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected floating-point number but got "bogus"} + +test spinbox-1.75 {configuration option: "validate"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -validate "key" + .e cget -validate +} -cleanup { + destroy .e +} -result {key} +test spinbox-1.76 {configuration option: "validate" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -validate "bogus" +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad validate "bogus": must be all, key, focus, focusin, focusout, or none} + +test spinbox-1.77 {configuration option: "validatecommand"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -validatecommand "a command" + .e cget -validatecommand +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.78 {configuration option: "values"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -values {mon tue wed thur} + .e cget -values +} -cleanup { + destroy .e +} -result {mon tue wed thur} +test spinbox-1.79 {configuration option: "values" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -values {bad {}list} +} -cleanup { + destroy .e +} -returnCodes {error} -result {list element in braces followed by "list" instead of space} + +test spinbox-1.80 {configuration option: "vcmd"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -vcmd "a command" + .e cget -vcmd +} -cleanup { + destroy .e +} -result {a command} + +test spinbox-1.81 {configuration option: "width"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -width 402 + .e cget -width +} -cleanup { + destroy .e +} -result {402} +test spinbox-1.82 {configuration option: "width" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -width 3p +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected integer but got "3p"} + +test spinbox-1.83 {configuration option: "wrap"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -wrap yes + .e cget -wrap +} -cleanup { + destroy .e +} -result {1} +test spinbox-1.84 {configuration option: "wrap" for spinbox} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -wrap xyzzy +} -cleanup { + destroy .e +} -returnCodes {error} -result {expected boolean value but got "xyzzy"} + +test spinbox-1.85 {configuration option: "xscrollcommand"} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \ + -relief sunken + pack .e + update +} -body { + .e configure -xscrollcommand {Some command} + .e cget -xscrollcommand +} -cleanup { + destroy .e +} -result {Some command} + + +test spinbox-2.1 {Tk_SpinboxCmd procedure} -body { + spinbox +} -returnCodes error -result {wrong # args: should be "spinbox pathName ?-option value ...?"} +test spinbox-2.2 {Tk_SpinboxCmd procedure} -body { + spinbox gorp +} -returnCodes error -result {bad window path name "gorp"} +test spinbox-2.3 {Tk_SpinboxCmd procedure} -body { spinbox .e + pack .e + update list [winfo exists .e] [winfo class .e] [info commands .e] -} {1 Spinbox .e} -test spinbox-2.4 {Tk_SpinboxCmd procedure} { - catch {destroy .e} - list [catch {spinbox .e -gorp foo} msg] $msg [winfo exists .e] \ - [info commands .e] -} {1 {unknown option "-gorp"} 0 {}} -test spinbox-2.5 {Tk_SpinboxCmd procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {1 Spinbox .e} +test spinbox-2.4 {Tk_SpinboxCmd procedure} -body { + spinbox .e -gorp foo +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-gorp"} +test spinbox-2.4.1 {Tk_SpinboxCmd procedure} -body { + catch {spinbox .e -gorp foo} + list [winfo exists .e] [info commands .e] +} -cleanup { + destroy .e +} -result {0 {}} +test spinbox-2.5 {Tk_SpinboxCmd procedure} -body { spinbox .e -} {.e} - -catch {destroy .e} -spinbox .e -font $fixed -pack .e -update - -set cx [font measure $fixed a] -set cy [font metrics $fixed -linespace] -set ux [font measure $fixed \u4e4e] - -test spinbox-3.1 {SpinboxWidgetCmd procedure} { - list [catch {.e} msg] $msg -} {1 {wrong # args: should be ".e option ?arg arg ...?"}} -test spinbox-3.2 {SpinboxWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox} msg] $msg -} {1 {wrong # args: should be ".e bbox index"}} -test spinbox-3.3 {SpinboxWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox a b} msg] $msg -} {1 {wrong # args: should be ".e bbox index"}} -test spinbox-3.4 {SpinboxWidgetCmd procedure, "bbox" widget command} { - list [catch {.e bbox bogus} msg] $msg -} {1 {bad spinbox index "bogus"}} -test spinbox-3.5 {SpinboxWidgetCmd procedure, "bbox" widget command} { - .e delete 0 end - .e bbox 0 -} [list 5 5 0 $cy] -test spinbox-3.6 {SpinboxWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): no utf chars +} -cleanup { + destroy .e +} -result {.e} - .e delete 0 end + +test spinbox-3.1 {SpinboxWidgetCmd procedure} -setup { + spinbox .e + pack .e + update +} -body { + .e +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e option ?arg ...?"} +test spinbox-3.2 {SpinboxWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e bbox index"} +test spinbox-3.3 {SpinboxWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox a b +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e bbox index"} +test spinbox-3.4 {SpinboxWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e bbox bogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "bogus"} +test spinbox-3.5 {SpinboxWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e bbox 0 +} -cleanup { + destroy .e +} -result [list 5 5 0 $cy] + +# Oryginaly the result was count using measurements +# and metrics. It was changed to less verbose solution - the result is the one +# that passes fonts constraint (this concerns tests 3.6, 3.7, 3.8, 3.10) +test spinbox-3.6 {SpinboxWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): no utf chars .e insert 0 "abc" list [.e bbox 3] [.e bbox end] -} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"] -test spinbox-3.7 {SpinboxWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): utf at end - .e delete 0 end +} -cleanup { + destroy .e +} -result {{19 5 7 13} {19 5 7 13}} +test spinbox-3.7 {SpinboxWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): utf at end .e insert 0 "ab\u4e4e" .e bbox end -} "[expr 5+2*$cx] 5 $ux $cy" -test spinbox-3.8 {SpinboxWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): utf before index - .e delete 0 end +} -cleanup { + destroy .e +} -result {19 5 12 13} +test spinbox-3.8 {SpinboxWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): utf before index .e insert 0 "ab\u4e4ec" .e bbox 3 -} "[expr 5+2*$cx+$ux] 5 $cx $cy" -test spinbox-3.9 {SpinboxWidgetCmd procedure, "bbox" widget command} { - # Tcl_UtfAtIndex(): no chars - .e delete 0 end +} -cleanup { + destroy .e +} -result {31 5 7 13} +test spinbox-3.9 {SpinboxWidgetCmd procedure, "bbox" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { +# Tcl_UtfAtIndex(): no chars .e bbox end -} "5 5 0 $cy" -test spinbox-3.10 {SpinboxWidgetCmd procedure, "bbox" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result "5 5 0 $cy" +test spinbox-3.10 {SpinboxWidgetCmd procedure, "bbox" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { .e insert 0 "abcdefghij\u4e4eklmnop" list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end] -} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"] -test spinbox-3.11 {SpinboxWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget} msg] $msg -} {1 {wrong # args: should be ".e cget option"}} -test spinbox-3.12 {SpinboxWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget a b} msg] $msg -} {1 {wrong # args: should be ".e cget option"}} -test spinbox-3.13 {SpinboxWidgetCmd procedure, "cget" widget command} { - list [catch {.e cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test spinbox-3.14 {SpinboxWidgetCmd procedure, "cget" widget command} { +} -cleanup { + destroy .e +} -result {{5 5 7 13} {12 5 7 13} {75 5 12 13} {122 5 7 13}} +test spinbox-3.11 {SpinboxWidgetCmd procedure, "cget" widget command} -setup { + spinbox .e +} -body { + .e cget +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e cget option"} +test spinbox-3.12 {SpinboxWidgetCmd procedure, "cget" widget command} -setup { + spinbox .e +} -body { + .e cget a b +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e cget option"} +test spinbox-3.13 {SpinboxWidgetCmd procedure, "cget" widget command} -setup { + spinbox .e +} -body { + .e cget -gorp +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-gorp"} +test spinbox-3.14 {SpinboxWidgetCmd procedure, "cget" widget command} -setup { + spinbox .e +} -body { .e configure -bd 4 .e cget -bd -} {4} -test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} { +} -cleanup { + destroy .e +} -result {4} +test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} -setup { + spinbox .e + pack .e + update +} -body { llength [.e configure] -} {49} -test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} { - list [catch {.e configure -foo} msg] $msg -} {1 {unknown option "-foo"}} -test spinbox-3.17 {SpinboxWidgetCmd procedure, "configure" widget command} { +} -cleanup { + destroy .e +} -result {49} +test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} -setup { + spinbox .e +} -body { + .e configure -foo +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "-foo"} +test spinbox-3.17 {SpinboxWidgetCmd procedure, "configure" widget command} -setup { + spinbox .e +} -body { .e configure -bd 4 .e configure -bg #ffffff lindex [.e configure -bd] 4 -} {4} -test spinbox-3.18 {SpinboxWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete} msg] $msg -} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} -test spinbox-3.19 {SpinboxWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete a b c} msg] $msg -} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} -test spinbox-3.20 {SpinboxWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete foo} msg] $msg -} {1 {bad spinbox index "foo"}} -test spinbox-3.21 {SpinboxWidgetCmd procedure, "delete" widget command} { - list [catch {.e delete 0 bar} msg] $msg -} {1 {bad spinbox index "bar"}} -test spinbox-3.22 {SpinboxWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-3.18 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { + .e delete +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e delete firstIndex ?lastIndex?"} +test spinbox-3.19 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { + .e delete a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e delete firstIndex ?lastIndex?"} +test spinbox-3.20 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { + .e delete foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "foo"} +test spinbox-3.21 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { + .e delete 0 bar +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "bar"} +test spinbox-3.22 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e delete 2 4 .e get -} {014567890} -test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {014567890} +test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e +} -body { .e insert end "01234567890" .e delete 6 .e get -} {0123457890} -test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} { - # UTF +} -cleanup { + destroy .e +} -result {0123457890} +test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update set x {} - .e delete 0 end +} -body { +# UTF .e insert end "01234\u4e4e67890" .e delete 6 lappend x [.e get] @@ -244,277 +1246,659 @@ test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} { .e insert end "0123456\u4e4e890" .e delete 6 lappend x [.e get] -} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] -test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] +test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e delete 6 5 .e get -} {01234567890} -test spinbox-3.26 {SpinboxWidgetCmd procedure, "delete" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.26 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state disabled .e delete 2 8 .e configure -state normal .e get -} {01234567890} -test spinbox-3.27 {SpinboxWidgetCmd procedure, "get" widget command} { - list [catch {.e get foo} msg] $msg -} {1 {wrong # args: should be ".e get"}} -test spinbox-3.28 {SpinboxWidgetCmd procedure, "icursor" widget command} { - list [catch {.e icursor} msg] $msg -} {1 {wrong # args: should be ".e icursor pos"}} -test spinbox-3.29 {SpinboxWidgetCmd procedure, "icursor" widget command} { - list [catch {.e icursor foo} msg] $msg -} {1 {bad spinbox index "foo"}} -test spinbox-3.30 {SpinboxWidgetCmd procedure, "icursor" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.26.1 {SpinboxWidgetCmd procedure, "delete" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end "01234567890" + .e configure -state readonly + .e delete 2 8 + .e configure -state normal + .e get +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.27 {SpinboxWidgetCmd procedure, "get" widget command} -setup { + spinbox .e +} -body { + .e get foo +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e get"} +test spinbox-3.28 {SpinboxWidgetCmd procedure, "icursor" widget command} -setup { + spinbox .e +} -body { + .e icursor +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e icursor pos"} +test spinbox-3.29 {SpinboxWidgetCmd procedure, "icursor" widget command} -setup { + spinbox .e +} -body { + .e icursor foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "foo"} +test spinbox-3.30 {SpinboxWidgetCmd procedure, "icursor" widget command} -setup { + spinbox .e +} -body { .e insert end "01234567890" .e icursor 4 .e index insert -} {4} -test spinbox-3.31 {SpinboxWidgetCmd procedure, "index" widget command} { - list [catch {.e in} msg] $msg -} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}} -test spinbox-3.32 {SpinboxWidgetCmd procedure, "index" widget command} { - list [catch {.e index} msg] $msg -} {1 {wrong # args: should be ".e index string"}} -test spinbox-3.33 {SpinboxWidgetCmd procedure, "index" widget command} { - list [catch {.e index foo} msg] $msg -} {1 {bad spinbox index "foo"}} -test spinbox-3.34 {SpinboxWidgetCmd procedure, "index" widget command} { - list [catch {.e index 0} msg] $msg -} {0 0} -test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} { - # UTF - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-3.31 {SpinboxWidgetCmd procedure, "index" widget command} -setup { + spinbox .e +} -body { + .e in +} -cleanup { + destroy .e +} -returnCodes error -result {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview} +test spinbox-3.32 {SpinboxWidgetCmd procedure, "index" widget command} -setup { + spinbox .e +} -body { + .e index +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e index string"} +test spinbox-3.33 {SpinboxWidgetCmd procedure, "index" widget command} -setup { + spinbox .e +} -body { + .e index foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "foo"} +test spinbox-3.34 {SpinboxWidgetCmd procedure, "index" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e index 0 +} -cleanup { + destroy .e +} -returnCodes {ok} -match glob -result {*} +test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} -setup { + spinbox .e + pack .e + update +} -body { +# UTF .e insert 0 abc\u4e4e\u0153def list [.e index 3] [.e index 4] [.e index end] -} {3 4 8} -test spinbox-3.36 {SpinboxWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test spinbox-3.37 {SpinboxWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a b c} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test spinbox-3.38 {SpinboxWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert foo Text} msg] $msg -} {1 {bad spinbox index "foo"}} -test spinbox-3.39 {SpinboxWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 4 8} +test spinbox-3.36 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e +} -body { + .e insert a +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test spinbox-3.37 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e +} -body { + .e insert a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test spinbox-3.38 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e +} -body { + .e insert foo Text +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "foo"} +test spinbox-3.39 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e insert 3 xxx .e get -} {012xxx34567890} -test spinbox-3.40 {SpinboxWidgetCmd procedure, "insert" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {012xxx34567890} +test spinbox-3.40 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "01234567890" .e configure -state disabled .e insert 3 xxx .e configure -state normal .e get -} {01234567890} -test spinbox-3.41 {SpinboxWidgetCmd procedure, "insert" widget command} { - list [catch {.e insert a b c} msg] $msg -} {1 {wrong # args: should be ".e insert index text"}} -test spinbox-3.42 {SpinboxWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan a} msg] $msg -} {1 {wrong # args: should be ".e scan mark|dragto x"}} -test spinbox-3.43 {SpinboxWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan a b c} msg] $msg -} {1 {wrong # args: should be ".e scan mark|dragto x"}} -test spinbox-3.44 {SpinboxWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan foobar 20} msg] $msg -} {1 {bad scan option "foobar": must be mark or dragto}} -test spinbox-3.45 {SpinboxWidgetCmd procedure, "scan" widget command} { - list [catch {.e scan mark 20.1} msg] $msg -} {1 {expected integer but got "20.1"}} -# This test is non-portable because character sizes vary. +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.40.1 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end "01234567890" + .e configure -state readonly + .e insert 3 xxx + .e configure -state normal + .e get +} -cleanup { + destroy .e +} -result {01234567890} +test spinbox-3.41 {SpinboxWidgetCmd procedure, "insert" widget command} -setup { + spinbox .e +} -body { + .e insert a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e insert index text"} +test spinbox-3.42 {SpinboxWidgetCmd procedure, "scan" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e scan a +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} +test spinbox-3.43 {SpinboxWidgetCmd procedure, "scan" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e scan a b c +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e scan mark|dragto x"} +test spinbox-3.44 {SpinboxWidgetCmd procedure, "scan" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e scan foobar 20 +} -cleanup { + destroy .e +} -returnCodes error -result {bad scan option "foobar": must be mark or dragto} +test spinbox-3.45 {SpinboxWidgetCmd procedure, "scan" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e scan mark 20.1 +} -cleanup { + destroy .e +} -returnCodes error -result {expected integer but got "20.1"} -test spinbox-3.46 {SpinboxWidgetCmd procedure, "scan" widget command} {fonts} { - .e delete 0 end +# This test is non-portable because character sizes vary. +test spinbox-3.46 {SpinboxWidgetCmd procedure, "scan" widget command} -constraints { + fonts +} -setup { + spinbox .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 + pack .e update +} -body { .e insert end "This is quite a long string, in fact a " .e insert end "very very long string" .e scan mark 30 .e scan dragto 28 .e index @0 -} {2} -test spinbox-3.47 {SpinboxWidgetCmd procedure, "select" widget command} { - list [catch {.e select} msg] $msg -} {1 {wrong # args: should be ".e selection option ?index?"}} -test spinbox-3.48 {SpinboxWidgetCmd procedure, "select" widget command} { - list [catch {.e select foo} msg] $msg -} {1 {bad selection option "foo": must be adjust, clear, element, from, present, range, or to}} -test spinbox-3.49 {SpinboxWidgetCmd procedure, "select clear" widget command} { - list [catch {.e select clear gorp} msg] $msg -} {1 {wrong # args: should be ".e selection clear"}} -test spinbox-3.50 {SpinboxWidgetCmd procedure, "select clear" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2} +test spinbox-3.47 {SpinboxWidgetCmd procedure, "select" widget command} -setup { + spinbox .e +} -body { + .e select +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection option ?index?"} +test spinbox-3.48 {SpinboxWidgetCmd procedure, "select" widget command} -setup { + spinbox .e +} -body { + .e select foo +} -cleanup { + destroy .e +} -returnCodes error -result {bad selection option "foo": must be adjust, clear, element, from, present, range, or to} + +test spinbox-3.49 {SpinboxWidgetCmd procedure, "select clear" widget command} -setup { + spinbox .e +} -body { + .e select clear gorp +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection clear"} +test spinbox-3.50 {SpinboxWidgetCmd procedure, "select clear" widget command} -setup { + spinbox .e +} -body { .e insert end "0123456789" .e select from 1 .e select to 4 update .e select clear - list [catch {selection get} msg] $msg [selection own] -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e} -test spinbox-3.51 {SpinboxWidgetCmd procedure, "selection present" widget command} { - list [catch {.e selection present foo} msg] $msg -} {1 {wrong # args: should be ".e selection present"}} -test spinbox-3.52 {SpinboxWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end + selection get +} -cleanup { + destroy .e +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test spinbox-3.50.1 {SpinboxWidgetCmd procedure, "select clear" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end "0123456789" + .e select from 1 + .e select to 4 + update + .e select clear + catch {selection get} + selection own +} -cleanup { + destroy .e +} -result {.e} + +test spinbox-3.51 {SpinboxWidgetCmd procedure, "selection present" widget command} -setup { + spinbox .e +} -body { + .e selection present foo +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection present"} +test spinbox-3.52 {SpinboxWidgetCmd procedure, "selection present" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e selection present -} {1} -test spinbox-3.53 {SpinboxWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-3.53 {SpinboxWidgetCmd procedure, "selection present" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e configure -exportselection false .e selection present -} {1} -.e configure -exportselection true -test spinbox-3.54 {SpinboxWidgetCmd procedure, "selection present" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-3.54 {SpinboxWidgetCmd procedure, "selection present" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 6 .e delete 0 end .e selection present -} {0} -test spinbox-3.55 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { - list [catch {.e select adjust x} msg] $msg -} {1 {bad spinbox index "x"}} -test spinbox-3.56 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { - list [catch {.e select adjust 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection adjust index"}} -test spinbox-3.57 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0} +test spinbox-3.55 {SpinboxWidgetCmd procedure, "selection adjust" widget command} -setup { + spinbox .e +} -body { + .e select adjust x +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "x"} +test spinbox-3.56 {SpinboxWidgetCmd procedure, "selection adjust" widget command} -setup { + spinbox .e +} -body { + .e select adjust 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection adjust index"} +test spinbox-3.57 {SpinboxWidgetCmd procedure, "selection adjust" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 4 selection get -} {123} -test spinbox-3.58 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {123} +test spinbox-3.58 {SpinboxWidgetCmd procedure, "selection adjust" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 2 selection get -} {234} -test spinbox-3.59 {SpinboxWidgetCmd procedure, "selection from" widget command} { - list [catch {.e select from 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection from index"}} -test spinbox-3.60 {SpinboxWidgetCmd procedure, "selection range" widget command} { - list [catch {.e select range 2} msg] $msg -} {1 {wrong # args: should be ".e selection range start end"}} -test spinbox-3.61 {SpinboxWidgetCmd procedure, "selection range" widget command} { - list [catch {.e selection range 2 3 4} msg] $msg -} {1 {wrong # args: should be ".e selection range start end"}} -test spinbox-3.62 {SpinboxWidgetCmd procedure, "selection range" widget command} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {234} +test spinbox-3.59 {SpinboxWidgetCmd procedure, "selection from" widget command} -setup { + spinbox .e +} -body { + .e select from 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection from index"} + +test spinbox-3.60 {SpinboxWidgetCmd procedure, "selection range" widget command} -setup { + spinbox .e +} -body { + .e select range 2 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection range start end"} +test spinbox-3.61 {SpinboxWidgetCmd procedure, "selection range" widget command} -setup { + spinbox .e +} -body { + .e selection range 2 3 4 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection range start end"} +test spinbox-3.62 {SpinboxWidgetCmd procedure, "selection range" widget command} -setup { + spinbox .e +} -body { .e insert end 0123456789 .e select from 1 .e select to 5 .e select range 4 4 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-3.63 {SpinboxWidgetCmd procedure, "selection range" widget command} { - .e delete 0 end + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test spinbox-3.63 {SpinboxWidgetCmd procedure, "selection range" widget command} -setup { + spinbox .e + pack .e + update +} -body { .e insert end 0123456789 .e select from 3 .e select to 7 .e select range 2 9 list [.e index sel.first] [.e index sel.last] [.e index anchor] -} {2 9 3} -.e delete 0 end -.e insert end "This is quite a long text string, so long that it " -.e insert end "runs off the end of the window quite a bit." -test spinbox-3.64 {SpinboxWidgetCmd procedure, "selection to" widget command} { - list [catch {.e select to 2 3} msg] $msg -} {1 {wrong # args: should be ".e selection to index"}} -test spinbox-3.65 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {2 9 3} +test spinbox-3.64 {SpinboxWidgetCmd procedure, "selection to" widget command} -setup { + spinbox .e + pack .e + update + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." +} -body { + .e select to 2 3 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e selection to index"} +test spinbox-3.64.1 {SpinboxWidgetCmd procedure, "selection" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end 0123456789 + .e selection range 0 end + .e configure -state disabled + .e selection range 2 4 + .e configure -state normal + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {0 10} +test spinbox-3.64.2 {SpinboxWidgetCmd procedure, "selection" widget command} -setup { + spinbox .e + pack .e + update +} -body { + .e insert end 0123456789 + .e selection range 0 end + .e configure -state readonly + .e selection range 2 4 + .e configure -state normal + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {2 4} + +test spinbox-3.65 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 5 format {%.6f %.6f} {*}[.e xview] -} {0.053763 0.268817} -test spinbox-3.66 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview gorp} msg] $msg -} {1 {bad spinbox index "gorp"}} -test spinbox-3.67 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.053763 0.268817} +test spinbox-3.66 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview gorp +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "gorp"} +test spinbox-3.67 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 0 .e icursor 10 .e xview insert format {%.6f %.6f} {*}[.e xview] -} {0.107527 0.322581} -test spinbox-3.68 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview moveto foo bar} msg] $msg -} {1 {wrong # args: should be ".e xview moveto fraction"}} -test spinbox-3.69 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview moveto foo} msg] $msg -} {1 {expected floating-point number but got "foo"}} -test spinbox-3.70 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.107527 0.322581} +test spinbox-3.68 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview moveto foo bar +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e xview moveto fraction"} +test spinbox-3.69 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e xview moveto foo +} -cleanup { + destroy .e +} -returnCodes error -result {expected floating-point number but got "foo"} +test spinbox-3.70 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview moveto 0.5 format {%.6f %.6f} {*}[.e xview] -} {0.505376 0.720430} -test spinbox-3.71 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll 24} msg] $msg -} {1 {wrong # args: should be ".e xview scroll number units|pages"}} -test spinbox-3.72 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll gorp units} msg] $msg -} {1 {expected integer but got "gorp"}} -test spinbox-3.73 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.505376 0.720430} +test spinbox-3.71 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + .e xview scroll 24 +} -cleanup { + destroy .e +} -returnCodes error -result {wrong # args: should be ".e xview scroll number units|pages"} +test spinbox-3.72 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview scroll gorp units +} -cleanup { + destroy .e +} -returnCodes error -result {expected integer but got "gorp"} +test spinbox-3.73 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview moveto 0 .e xview scroll 1 pages format {%.6f %.6f} {*}[.e xview] -} {0.193548 0.408602} -test spinbox-3.74 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.193548 0.408602} +test spinbox-3.74 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview moveto .9 update .e xview scroll -2 p format {%.6f %.6f} {*}[.e xview] -} {0.397849 0.612903} -test spinbox-3.75 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0.397849 0.612903} +test spinbox-3.75 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 30 update .e xview scroll 2 units .e index @0 -} {32} -test spinbox-3.76 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {32} +test spinbox-3.76 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 30 update .e xview scroll -1 units .e index @0 -} {29} -test spinbox-3.77 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview scroll 23 foobars} msg] $msg -} {1 {bad argument "foobars": must be units or pages}} -test spinbox-3.78 {SpinboxWidgetCmd procedure, "xview" widget command} { - list [catch {.e xview eat 23 hamburgers} msg] $msg -} {1 {unknown option "eat": must be moveto or scroll}} -test spinbox-3.79 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {29} +test spinbox-3.77 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview scroll 23 foobars +} -cleanup { + destroy .e +} -returnCodes error -result {bad argument "foobars": must be units or pages} +test spinbox-3.78 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update + .e xview eat 23 hamburgers +} -cleanup { + destroy .e +} -returnCodes error -result {unknown option "eat": must be moveto or scroll} +test spinbox-3.79 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." .e xview 0 update .e xview -4 .e index @0 -} {0} -test spinbox-3.80 {SpinboxWidgetCmd procedure, "xview" widget command} { +} -cleanup { + destroy .e +} -result {0} +test spinbox-3.80 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + update .e xview 300 .e index @0 -} {73} -.e insert 10 \u4e4e -test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} { - # UTF - # If Tcl_NumUtfChars wasn't used, wrong answer would be: - # 0.106383 0.117021 0.117021 - +} -cleanup { + destroy .e +} -result {73} +test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e +} -body { + .e insert end "This is quite a long text string, so long that it " + .e insert end "runs off the end of the window quite a bit." + .e insert 10 \u4e4e + update +# UTF +# If Tcl_NumUtfChars wasn't used, wrong answer would be: +# 0.106383 0.117021 0.117021 set x {} .e xview moveto .1 lappend x [format {%.6f} [lindex [.e xview] 0]] @@ -522,221 +1906,327 @@ test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} { lappend x [format {%.6f} [lindex [.e xview] 0]] .e xview moveto .12 lappend x [format {%.6f} [lindex [.e xview] 0]] -} {0.095745 0.106383 0.117021} -test spinbox-3.82 {SpinboxWidgetCmd procedure} { - list [catch {.e gorp} msg] $msg -} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}} - -frame .f -width 200 -height 50 -relief raised -bd 2 -pack .f -side right -test spinbox-5.1 {ConfigureSpinbox procedure, -textvariable} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {0.095745 0.106383 0.117021} + +test spinbox-3.82 {SpinboxWidgetCmd procedure} -setup { + spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .e + update +} -body { + .e gorp +} -cleanup { + destroy .e +} -returnCodes error -result {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview} + +test spinbox-5.1 {ConfigureSpinbox procedure, -textvariable} -body { set x 12345 spinbox .e -textvariable x .e get -} {12345} -test spinbox-5.2 {ConfigureSpinbox procedure, -textvariable} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {12345} +test spinbox-5.2 {ConfigureSpinbox procedure, -textvariable} -body { set x 12345 spinbox .e -textvariable x set y abcde .e configure -textvariable y set x 54321 .e get -} {abcde} -test spinbox-5.3 {ConfigureSpinbox procedure, -textvariable} { - catch {destroy .e} - catch {unset x} +} -cleanup { + destroy .e +} -result {abcde} +test spinbox-5.3 {ConfigureSpinbox procedure, -textvariable} -setup { + unset -nocomplain x spinbox .e +} -body { .e insert 0 "Some text" .e configure -textvariable x set x -} {Some text} -test spinbox-5.4 {ConfigureSpinbox procedure, -textvariable} { - proc override args { - global x - set x 12345 - } - catch {destroy .e} - catch {unset x} - trace variable x w override +} -cleanup { + destroy .e +} -result {Some text} +test spinbox-5.4 {ConfigureSpinbox procedure, -textvariable} -setup { + unset -nocomplain x spinbox .e +} -body { + trace variable x w override .e insert 0 "Some text" .e configure -textvariable x - set result [list $x [.e get]] - unset x; rename override {} - set result -} {12345 12345} -test spinbox-5.5 {ConfigureSpinbox procedure} { - catch {destroy .e} - spinbox .e -exportselection false - pack .e - .e insert end "0123456789" - .sel select from 0 - .sel select to 10 + list $x [.e get] +} -cleanup { + destroy .e + trace vdelete x w override +} -result {12345 12345} + +test spinbox-5.5 {ConfigureSpinbox procedure} -setup { set x {} + spinbox .e1 + spinbox .e2 +} -body { + .e2 insert end "This is some sample text" + .e1 configure -exportselection false + .e1 insert end "0123456789" + pack .e1 .e2 + .e2 select from 0 + .e2 select to 10 lappend x [selection get] - .e select from 1 - .e select to 5 + .e1 select from 1 + .e1 select to 5 lappend x [selection get] - .e configure -exportselection 1 + .e1 configure -exportselection 1 lappend x [selection get] set x -} {{This is so} {This is so} 1234} -test spinbox-5.6 {ConfigureSpinbox procedure} { - catch {destroy .e} +} -cleanup { + destroy .e1 .e2 +} -result {{This is so} {This is so} 1234} +test spinbox-5.6 {ConfigureSpinbox procedure} -setup { + spinbox .e + pack .e +} -body { + .e insert end "0123456789" + .e select from 1 + .e select to 5 + .e configure -exportselection 0 + selection get +} -cleanup { + destroy .e +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test spinbox-5.6.1 {ConfigureSpinbox procedure} -setup { spinbox .e pack .e +} -body { .e insert end "0123456789" .e select from 1 .e select to 5 .e configure -exportselection 0 - list [catch {selection get} msg] $msg [.e index sel.first] \ - [.e index sel.last] -} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5} -test spinbox-5.7 {ConfigureSpinbox procedure} { - catch {destroy .e} - spinbox .e -font $fixed -width 4 -xscrollcommand scroll + catch {selection get} + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {1 5} + +test spinbox-5.7 {ConfigureSpinbox procedure} -setup { + spinbox .e -font {Helvetica -12} -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -width 4 -xscrollcommand scroll .e insert end "01234567890" update .e configure -width 5 format {%.6f %.6f} {*}$scrollInfo -} {0.000000 0.363636} -test spinbox-5.8 {ConfigureSpinbox procedure} {fonts} { - catch {destroy .e} - spinbox .e -width 0 +} -cleanup { + destroy .e +} -result {0.000000 0.363636} + +test spinbox-5.8 {ConfigureSpinbox procedure} -constraints { + fonts +} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -width 0 -font {Helvetica -12} .e insert end "0123" update - .e configure -font $big + .e configure -font {Helvetica -24} update winfo geom .e -} {79x37+0+0} -test spinbox-5.9 {ConfigureSpinbox procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised +} -cleanup { + destroy .e +} -result {79x37+0+0} +test spinbox-5.9 {ConfigureSpinbox procedure} -constraints { + fonts +} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] -} {0 0 1 1} -test spinbox-5.10 {ConfigureSpinbox procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief flat +} -cleanup { + destroy .e +} -result {0 0 1 1} +test spinbox-5.10 {ConfigureSpinbox procedure} -constraints { + fonts +} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief flat .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] -} {0 0 1 1} -test spinbox-5.11 {ConfigureSpinbox procedure} { - # If "0" in selected font had 0 width, caused divide-by-zero error. - - catch {destroy .e} - pack [spinbox .e -font {{open look glyph}}] +} -cleanup { + destroy .e +} -result {0 0 1 1} +test spinbox-5.11 {ConfigureSpinbox procedure} -setup { + spinbox .e -borderwidth 2 -highlightthickness 2 + pack .e +} -body { +# If "0" in selected font had 0 width, caused divide-by-zero error. + .e configure -font {{open look glyph}} .e scan dragto 30 update -} {} +} -cleanup { + destroy .e +} -result {} # No tests for DisplaySpinbox. -test spinbox-6.1 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3 +test spinbox-6.1 {SpinboxComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 -highlightthickness 3 .e insert end 012\t45 update list [.e index @61] [.e index @62] -} {3 4} -test spinbox-6.2 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify center \ - -highlightthickness 3 +} -cleanup { + destroy .e +} -result {3 4} +test spinbox-6.2 {SpinboxComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 -justify center \ + -highlightthickness 3 .e insert end 012\t45 update list [.e index @96] [.e index @97] -} {3 4} -test spinbox-6.3 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify right \ - -highlightthickness 3 +} -cleanup { + destroy .e +} -result {3 4} +test spinbox-6.3 {SpinboxComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 20 -justify right \ + -highlightthickness 3 .e insert end 012\t45 update list [.e index @131] [.e index @132] -} {3 4} -test spinbox-6.4 {SpinboxComputeGeometry procedure} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {3 4} +test spinbox-6.4 {SpinboxComputeGeometry procedure} -setup { + spinbox .e pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 6 .e index @0 -} {6} -test spinbox-6.5 {SpinboxComputeGeometry procedure} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {6} +test spinbox-6.5 {SpinboxComputeGeometry procedure} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 7 .e index @0 -} {6} -test spinbox-6.6 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $fixed -bd 2 -relief raised -width 10 +} -cleanup { + destroy .e +} -result {6} +test spinbox-6.6 {SpinboxComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Courier -12} -bd 2 -relief raised -width 10 .e insert end "01234\t67890" update .e xview 3 list [.e index @39] [.e index @40] -} {5 6} -test spinbox-6.7 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $big -bd 3 -relief raised -width 5 +} -cleanup { + destroy .e +} -result {5 6} +test spinbox-6.7 {SpinboxComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 5 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] -} {94 39} -test spinbox-6.8 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $big -bd 3 -relief raised -width 0 +} -cleanup { + destroy .e +} -result {94 39} +test spinbox-6.8 {SpinboxComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] -} {133 39} -test spinbox-6.9 {SpinboxComputeGeometry procedure} {fonts} { - catch {destroy .e} - spinbox .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2 +} -cleanup { + destroy .e +} -result {133 39} +test spinbox-6.9 {SpinboxComputeGeometry procedure} -constraints { + fonts +} -setup { + spinbox .e -highlightthickness 2 pack .e +} -body { + .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 update list [winfo reqwidth .e] [winfo reqheight .e] -} {42 39} +} -cleanup { + destroy .e +} -result {42 39} -catch {destroy .e} -spinbox .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll -pack .e -focus .e -test spinbox-7.1 {InsertChars procedure} { - .e delete 0 end + +test spinbox-7.1 {InsertChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e insert 2 XXX update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {abXXXcde abXXXcde {0.000000 1.000000}} -test spinbox-7.2 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abXXXcde abXXXcde {0.000000 1.000000}} + +test spinbox-7.2 {InsertChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e insert 500 XXX update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {abcdeXXX abcdeXXX {0.000000 1.000000}} -test spinbox-7.3 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abcdeXXX abcdeXXX {0.000000 1.000000}} +test spinbox-7.3 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -744,9 +2234,13 @@ test spinbox-7.3 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {5 9 5 8} -test spinbox-7.4 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {5 9 5 8} +test spinbox-7.4 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -754,9 +2248,13 @@ test spinbox-7.4 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {2 9 2 8} -test spinbox-7.5 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 2 8} +test spinbox-7.5 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -764,9 +2262,13 @@ test spinbox-7.5 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {2 9 2 8} -test spinbox-7.6 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 9 2 8} +test spinbox-7.6 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e select from 2 .e select to 6 @@ -774,70 +2276,118 @@ test spinbox-7.6 {InsertChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {2 6 2 5} -test spinbox-7.7 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {2 6 2 5} +test spinbox-7.7 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -xscrollcommand scroll .e insert 0 0123456789 .e icursor 4 .e insert 4 XXX .e index insert -} {7} -test spinbox-7.8 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {7} +test spinbox-7.8 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789 .e icursor 4 .e insert 5 XXX .e index insert -} {4} -test spinbox-7.9 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-7.9 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "This is a very long string" update .e xview 4 .e insert 3 XXX .e index @0 -} {7} -test spinbox-7.10 {InsertChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {7} +test spinbox-7.10 {InsertChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "This is a very long string" update .e xview 4 .e insert 4 XXX .e index @0 -} {4} -.e configure -width 0 -test spinbox-7.11 {InsertChars procedure} {fonts} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} + +test spinbox-7.11 {InsertChars procedure} -constraints { + fonts +} -setup { + spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 "xyzzy" update .e insert 2 00 winfo reqwidth .e -} {70} +} -cleanup { + destroy .e +} -result {70} -.e configure -width 10 -test spinbox-8.1 {DeleteChars procedure} { - .e delete 0 end +test spinbox-8.1 {DeleteChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete 2 4 update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {abe abe {0.000000 1.000000}} -test spinbox-8.2 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abe abe {0.000000 1.000000}} +test spinbox-8.2 {DeleteChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete -2 2 update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {cde cde {0.000000 1.000000}} -test spinbox-8.3 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {cde cde {0.000000 1.000000}} +test spinbox-8.3 {DeleteChars procedure} -setup { + unset -nocomplain contents + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { + .e configure -textvariable contents -xscrollcommand scroll .e insert 0 abcde .e delete 3 1000 update list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] -} {abc abc {0.000000 1.000000}} -test spinbox-8.4 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {abc abc {0.000000 1.000000}} +test spinbox-8.4 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -846,9 +2396,14 @@ test spinbox-8.4 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {1 6 1 5} -test spinbox-8.5 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 6 1 5} +test spinbox-8.5 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -857,9 +2412,14 @@ test spinbox-8.5 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] -} {1 5 1 4} -test spinbox-8.6 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 5 1 4} +test spinbox-8.6 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -868,17 +2428,28 @@ test spinbox-8.6 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] -} {1 2 1 5} -test spinbox-8.7 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1 2 1 5} +test spinbox-8.7 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 1 8 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-8.8 {DeleteChars procedure} { - .e delete 0 end + update + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test spinbox-8.8 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 @@ -887,17 +2458,27 @@ test spinbox-8.8 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {3 4 3 8} -test spinbox-8.9 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 4 3 8} +test spinbox-8.9 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e +} -body { .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 3 8 - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-8.10 {DeleteChars procedure} { - .e delete 0 end + update + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test spinbox-8.10 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 8 .e select to 3 @@ -906,9 +2487,14 @@ test spinbox-8.10 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] -} {3 5 5 8} -test spinbox-8.11 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 5 5 8} +test spinbox-8.11 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e select from 8 .e select to 3 @@ -917,124 +2503,185 @@ test spinbox-8.11 {DeleteChars procedure} { set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] -} {3 8 4 8} -test spinbox-8.12 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {3 8 4 8} +test spinbox-8.12 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 1 4 + update .e index insert -} {1} -test spinbox-8.13 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-8.13 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 1 5 + update .e index insert -} {1} -test spinbox-8.14 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-8.14 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 0123456789abcde .e icursor 4 .e delete 4 6 + update .e index insert -} {4} -test spinbox-8.15 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-8.15 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 1 4 + update .e index @0 -} {1} -test spinbox-8.16 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-8.16 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 1 5 + update .e index @0 -} {1} -test spinbox-8.17 {DeleteChars procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {1} +test spinbox-8.17 {DeleteChars procedure} -setup { + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "This is a very long string" .e xview 4 .e delete 4 6 + update .e index @0 -} {4} -.e configure -width 0 -test spinbox-8.18 {DeleteChars procedure} {fonts} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {4} +test spinbox-8.18 {DeleteChars procedure} -setup { + spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + pack .e + focus .e +} -body { .e insert 0 "xyzzy" update .e delete 2 4 winfo reqwidth .e -} {42} +} -cleanup { + destroy .e +} -result {42} -test spinbox-9.1 {SpinboxValueChanged procedure} { - catch {destroy .e} - proc override args { - global x - set x 12345 - } - catch {unset x} +test spinbox-9.1 {SpinboxValueChanged procedure} -setup { + unset -nocomplain x +} -body { trace variable x w override - spinbox .e -textvariable x + spinbox .e -textvariable x -width 0 .e insert 0 foo - set result [list $x [.e get]] - unset x; rename override {} - set result -} {12345 12345} - -catch {destroy .e} -spinbox .e -pack .e -.e configure -width 0 -test spinbox-10.1 {SpinboxSetValue procedure} {fonts} { + list $x [.e get] +} -cleanup { + destroy .e + trace vdelete x w override +} -result {12345 12345} + + +test spinbox-10.1 {SpinboxSetValue procedure} -constraints fonts -body { set x abcde set y ab - .e configure -textvariable x - update + spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 -width 0 + pack .e + .e configure -textvariable x .e configure -textvariable y update list [.e get] [winfo reqwidth .e] -} {ab 35} -test spinbox-10.2 {SpinboxSetValue procedure, updating selection} { - catch {destroy .e} - spinbox .e -textvariable x +} -cleanup { + destroy .e +} -result {ab 35} +test spinbox-10.2 {SpinboxSetValue procedure, updating selection} -setup { + unset -nocomplain x + spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "a" - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-10.3 {SpinboxSetValue procedure, updating selection} { - catch {destroy .e} - spinbox .e -textvariable x + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} +test spinbox-10.3 {SpinboxSetValue procedure, updating selection} -setup { + unset -nocomplain x + spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefg" list [.e index sel.first] [.e index sel.last] -} {4 7} -test spinbox-10.4 {SpinboxSetValue procedure, updating selection} { - catch {destroy .e} - spinbox .e -textvariable x +} -cleanup { + destroy .e +} -result {4 7} +test spinbox-10.4 {SpinboxSetValue procedure, updating selection} -setup { + unset -nocomplain x + spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefghijklmn" list [.e index sel.first] [.e index sel.last] -} {4 10} -test spinbox-10.5 {SpinboxSetValue procedure, updating display position} { - catch {destroy .e} - spinbox .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {4 10} +test spinbox-10.5 {SpinboxSetValue procedure, updating display position} -setup { + unset -nocomplain x + spinbox .e -highlightthickness 2 -bd 2 pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 update set x "abcdefg" update .e index @0 -} {0} -test spinbox-10.6 {SpinboxSetValue procedure, updating display position} { - catch {destroy .e} - spinbox .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {0} +test spinbox-10.6 {SpinboxSetValue procedure, updating display position} -setup { + unset -nocomplain x + spinbox .e -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 @@ -1042,177 +2689,444 @@ test spinbox-10.6 {SpinboxSetValue procedure, updating display position} { set x "1234567890123456789012" update .e index @0 -} {10} -test spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} { - catch {destroy .e} - spinbox .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {10} +test spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} -setup { + unset -nocomplain x + spinbox .e -highlightthickness 2 -bd 2 + pack .e + update +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123" .e index insert -} {3} -test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} { - catch {destroy .e} - spinbox .e -width 10 -font $fixed -textvariable x +} -cleanup { + destroy .e +} -result {3} +test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} -setup { + unset -nocomplain x + spinbox .e -highlightthickness 2 -bd 2 + pack .e +} -body { + .e configure -width 10 -font {Courier -12} -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123456" .e index insert -} {5} +} -cleanup { + destroy .e +} -result {5} -test spinbox-11.1 {SpinboxEventProc procedure} { - catch {destroy .e} - spinbox .e +test spinbox-11.1 {SpinboxEventProc procedure} -setup { + spinbox .e -highlightthickness 2 -bd 2 -font {Helvetica -12} + pack .e +} -body { .e insert 0 abcdefg destroy .e update -} {} -test spinbox-11.2 {SpinboxEventProc procedure} { - deleteWindows +} -cleanup { + destroy .e +} -result {} +test spinbox-11.2 {SpinboxEventProc procedure} -setup { + set x {} +} -body { spinbox .e1 -fg #112233 rename .e1 .e2 - set x {} lappend x [winfo children .] lappend x [.e2 cget -fg] destroy .e1 lappend x [info command .e*] [winfo children .] -} {.e1 #112233 {} {}} - -test spinbox-12.1 {SpinboxCmdDeletedProc procedure} { - deleteWindows - button .e1 -text "xyz_123" - rename .e1 {} - list [info command .e*] [winfo children .] -} {{} {}} - -catch {destroy .e} -spinbox .e -font $fixed -width 5 -bd 2 -relief sunken -pack .e -.e insert 0 012345678901234567890 -.e xview 4 -update -test spinbox-13.1 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e1 +} -result {.e1 #112233 {} {}} + +test spinbox-12.1 {SpinboxCmdDeletedProc procedure} -body { + button .b -text "xyz_123" + rename .b {} + list [info command .b*] [winfo children .] +} -cleanup { + destroy .b +} -result {{} {}} + + +test spinbox-13.1 {GetSpinboxIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e index end -} {21} -test spinbox-13.2 {GetSpinboxIndex procedure} { - list [catch {.e index abogus} msg] $msg -} {1 {bad spinbox index "abogus"}} -test spinbox-13.3 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {21} +test spinbox-13.2 {GetSpinboxIndex procedure} -body { + spinbox .e + .e index abogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "abogus"} +test spinbox-13.3 {GetSpinboxIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 1 .e select to 6 .e index anchor -} {1} -test spinbox-13.4 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {1} +test spinbox-13.4 {GetSpinboxIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 4 .e select to 1 .e index anchor -} {4} -test spinbox-13.5 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {4} +test spinbox-13.5 {GetSpinboxIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 3 .e select to 15 .e select adjust 4 .e index anchor -} {15} -test spinbox-13.6 {GetSpinboxIndex procedure} { - list [catch {.e index ebogus} msg] $msg -} {1 {bad spinbox index "ebogus"}} -test spinbox-13.7 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {15} +test spinbox-13.6 {GetSpinboxIndex procedure} -setup { + spinbox .e +} -body { + .e index ebogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "ebogus"} +test spinbox-13.7 {GetSpinboxIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update .e icursor 2 .e index insert -} {2} -test spinbox-13.8 {GetSpinboxIndex procedure} { - list [catch {.e index ibogus} msg] $msg -} {1 {bad spinbox index "ibogus"}} -test spinbox-13.9 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {2} +test spinbox-13.8 {GetSpinboxIndex procedure} -setup { + spinbox .e +} -body { + .e index ibogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "ibogus"} +test spinbox-13.9 {GetSpinboxIndex procedure} -setup { + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e +} -body { + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +} -cleanup { + destroy .e +} -result {1 6} + +test spinbox-13.10 {GetSpinboxIndex procedure} -constraints unix -body { +# On unix, when selection is cleared, spinbox widget's internal +# selection range is reset. +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e select from 1 .e select to 6 list [.e index sel.first] [.e index sel.last] -} {1 6} -selection clear .e -test spinbox-13.10 {GetSpinboxIndex procedure} unix { - # On unix, when selection is cleared, spinbox widget's internal - # selection range is reset. - - list [catch {.e index sel.first} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-13.11 {GetSpinboxIndex procedure} win { - # On mac and pc, when selection is cleared, spinbox widget remembers - # last selected range. When selection ownership is restored to - # spinbox, the old range will be rehighlighted. - - list [catch {selection get}] [.e index sel.first] -} {1 1} -test spinbox-13.12 {GetSpinboxIndex procedure} unix { - list [catch {.e index sbogus} msg] $msg -} {1 {selection isn't in widget .e}} -test spinbox-13.13 {GetSpinboxIndex procedure} win { - list [catch {.e index sbogus} msg] $msg -} {1 {bad spinbox index "sbogus"}} -test spinbox-13.14 {GetSpinboxIndex procedure} win { - list [catch {selection get}] [catch {.e index sbogus}] -} {1 1} -test spinbox-13.15 {GetSpinboxIndex procedure} { - list [catch {.e index @xyz} msg] $msg -} {1 {bad spinbox index "@xyz"}} -test spinbox-13.16 {GetSpinboxIndex procedure} {fonts} { +# Testing: + selection clear .e + .e index sel.first +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} + +test spinbox-13.11 {GetSpinboxIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, spinbox widget remembers +# last selected range. When selection ownership is restored to +# spinbox, the old range will be rehighlighted. +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + catch {selection get} + .e index sel.first +} -cleanup { + destroy .e +} -result {1} + +test spinbox-13.12 {GetSpinboxIndex procedure} -constraints unix -body { +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -result {selection isn't in widget .e} + +test spinbox-13.12.1 {GetSpinboxIndex procedure} -constraints unix -body { +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index bogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "bogus"} + +test spinbox-13.13 {GetSpinboxIndex procedure} -constraints win -body { +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "sbogus"} + +test spinbox-13.14 {GetSpinboxIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, spinbox widget remembers +# last selected range. When selection ownership is restored to +# spinbox, the old range will be rehighlighted. +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + selection get +} -cleanup { + destroy .e +} -returnCodes error -match glob -result {*} + +test spinbox-13.14.1 {GetSpinboxIndex procedure} -constraints win -body { +# On mac and pc, when selection is cleared, spinbox widget remembers +# last selected range. When selection ownership is restored to +# spinbox, the old range will be rehighlighted. +# Previous settings: + spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e select from 1 + .e select to 6 + list [.e index sel.first] [.e index sel.last] +# Testing: + selection clear .e + catch {selection get} + .e index sbogus +} -cleanup { + destroy .e +} -returnCodes error -match glob -result {*} + +test spinbox-13.15 {GetSpinboxIndex procedure} -body { + spinbox .e + selection clear .e + .e index @xyz +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "@xyz"} + +test spinbox-13.16 {GetSpinboxIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @4 -} {4} -test spinbox-13.17 {GetSpinboxIndex procedure} {fonts} { +} -cleanup { + destroy .e +} -result {4} +test spinbox-13.17 {GetSpinboxIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @11 -} {4} -test spinbox-13.18 {GetSpinboxIndex procedure} {fonts} { +} -cleanup { + destroy .e +} -result {4} +test spinbox-13.18 {GetSpinboxIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @12 -} {5} -test spinbox-13.19 {GetSpinboxIndex procedure} {fonts} { - # 11 is the minimum button width - .e index @[expr [winfo width .e] - 6 - 11] -} {8} -test spinbox-13.20 {GetSpinboxIndex procedure} {fonts} { - .e index @[expr [winfo width .e] - 5] -} {9} -test spinbox-13.21 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {5} +test spinbox-13.19 {GetSpinboxIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e index @[expr {[winfo width .e] - 6-11}] +} -cleanup { + destroy .e +} -result {8} +test spinbox-13.20 {GetSpinboxIndex procedure} -constraints fonts -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update + .e index @[expr {[winfo width .e] - 5}] +} -cleanup { + destroy .e +} -result {9} +test spinbox-13.21 {GetSpinboxIndex procedure} -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index @1000 -} {9} -test spinbox-13.22 {GetSpinboxIndex procedure} { - list [catch {.e index 1xyz} msg] $msg -} {1 {bad spinbox index "1xyz"}} -test spinbox-13.23 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {9} +test spinbox-13.22 {GetSpinboxIndex procedure} -setup { + spinbox .e + pack .e + update +} -body { + .e index 1xyz +} -cleanup { + destroy .e +} -returnCodes error -result {bad spinbox index "1xyz"} +test spinbox-13.23 {GetSpinboxIndex procedure} -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index -10 -} {0} -test spinbox-13.24 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {0} +test spinbox-13.24 {GetSpinboxIndex procedure} -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index 12 -} {12} -test spinbox-13.25 {GetSpinboxIndex procedure} { +} -cleanup { + destroy .e +} -result {12} +test spinbox-13.25 {GetSpinboxIndex procedure} -body { + spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + -font {Courier -12} + pack .e + .e insert 0 012345678901234567890 + .e xview 4 + update .e index 49 -} {21} +} -cleanup { + destroy .e +} -result {21} # XXX Still need to write tests for SpinboxScanTo and SpinboxSelectTo. -set x {} -for {set i 1} {$i <= 500} {incr i} { - append x "This is line $i, out of 500\n" -} -test spinbox-14.1 {SpinboxFetchSelection procedure} { - catch {destroy .e} +test spinbox-14.1 {SpinboxFetchSelection procedure} -body { spinbox .e .e insert end "This is a test string" .e select from 1 .e select to 18 selection get -} {his is a test str} -test spinbox-14.3 {SpinboxFetchSelection procedure} { - catch {destroy .e} +} -cleanup { + destroy .e +} -result {his is a test str} +test spinbox-14.3 {SpinboxFetchSelection procedure} -setup { + set x {} + for {set i 1} {$i <= 500} {incr i} { + append x "This is line $i, out of 500\n" +} +} -body { spinbox .e - .e insert end $x + .e insert end $x .e select from 0 .e select to end string compare [selection get] $x -} 0 +} -cleanup { + destroy .e +} -result {0} -test spinbox-15.1 {SpinboxLostSelection} { - catch {destroy .e} +test spinbox-15.1 {SpinboxLostSelection} -body { spinbox .e .e insert 0 "Text" .e select from 0 @@ -1222,265 +3136,546 @@ test spinbox-15.1 {SpinboxLostSelection} { .e select from 0 .e select to 4 lappend result [selection get] -} {Text Text} - -# No tests for EventuallyRedraw. +} -cleanup { + destroy .e +} -result {Text Text} -catch {destroy .e} -spinbox .e -width 10 -xscrollcommand scroll -pack .e -update -test spinbox-16.1 {SpinboxVisibleRange procedure} {fonts} { - .e delete 0 end - .e insert 0 ............................. +test spinbox-16.1 {SpinboxVisibleRange procedure} -constraints fonts -body { + spinbox .e -width 10 -font {Helvetica -12} + pack .e + update + .e insert 0 "............................." format {%.6f %.6f} {*}[.e xview] -} {0.000000 0.827586} -test spinbox-16.2 {SpinboxVisibleRange procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0.000000 0.827586} +test spinbox-16.2 {SpinboxVisibleRange procedure} -body { + spinbox .e format {%.6f %.6f} {*}[.e xview] -} {0.000000 1.000000} +} -cleanup { + destroy .e +} -result {0.000000 1.000000} + -catch {destroy .e} -spinbox .e -width 10 -xscrollcommand scroll -font $fixed -pack .e -update -test spinbox-17.1 {SpinboxUpdateScrollbar procedure} { +test spinbox-17.1 {SpinboxUpdateScrollbar procedure} -body { + spinbox .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e delete 0 end .e insert 0 123 update format {%.6f %.6f} {*}$scrollInfo -} {0.000000 1.000000} -test spinbox-17.2 {SpinboxUpdateScrollbar procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0.000000 1.000000} +test spinbox-17.2 {SpinboxUpdateScrollbar procedure} -body { + spinbox .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e insert 0 0123456789abcdef .e xview 3 update format {%.6f %.6f} {*}$scrollInfo -} {0.187500 0.812500} -test spinbox-17.3 {SpinboxUpdateScrollbar procedure} { - .e delete 0 end +} -cleanup { + destroy .e +} -result {0.187500 0.812500} +test spinbox-17.3 {SpinboxUpdateScrollbar procedure} -body { + spinbox .e -width 10 -xscrollcommand scroll -font {Courier -12} + pack .e .e insert 0 abcdefghijklmnopqrs .e xview 6 update format {%.6f %.6f} {*}$scrollInfo -} {0.315789 0.842105} -test spinbox-17.4 {SpinboxUpdateScrollbar procedure} { +} -cleanup { destroy .e - set x "Background error did not happen" +} -result {0.315789 0.842105} +test spinbox-17.4 {SpinboxUpdateScrollbar procedure} -setup { proc bgerror msg { global x set x $msg - } +} +} -body { spinbox .e -width 5 -xscrollcommand thisisnotacommand pack .e update - rename bgerror {} list $x $errorInfo -} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" +} -cleanup { + destroy .e + rename bgerror {} +} -result {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" while executing "thisisnotacommand 0.0 1.0" (horizontal scrolling command executed by .e)}} -set l [interp hidden] -deleteWindows -test spinbox-18.1 {Spinbox widget vs hiding} { - destroy .e +test spinbox-18.1 {Spinbox widget vs hiding} -setup { spinbox .e +} -body { + set l [interp hidden] interp hide {} .e destroy .e - list [winfo children .] [interp hidden] -} [list {} $l] + set res1 [list [winfo children .] [interp hidden]] + set res2 [list {} $l] + expr {$res1 == $res2} +} -result {1} ## ## Spinbox widget VALIDATION tests ## - -destroy .e -catch {unset ::e} -catch {unset ::vVals} -spinbox .e -validate all \ - -validatecommand [list doval %W %d %i %P %s %S %v %V] \ - -invalidcommand bell \ - -textvariable ::e \ - -background red -foreground white -pack .e -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 1 -} - # The validation tests build each one upon the previous, so cascading # failures aren't good # -test spinbox-19.1 {spinbox widget validation} { +# 19.* test cases in previous version highly depended on the previous +# test cases. This was replaced by inserting recently set configurations +# that matters for the test case +test spinbox-19.1 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e .e insert 0 a set ::vVals -} {.e 1 0 a {} a all key} -test spinbox-19.2 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e 1 0 a {} a all key} + +test spinbox-19.2 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a ;# previous settings .e insert 1 b set ::vVals -} {.e 1 1 ab a b all key} -test spinbox-19.3 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e 1 1 ab a b all key} + +test spinbox-19.3 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 ab ;# previous settings .e insert end c set ::vVals -} {.e 1 2 abc ab c all key} -test spinbox-19.4 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e 1 2 abc ab c all key} + +test spinbox-19.4 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 abc ;# previous settings .e insert 1 123 list $::vVals $::e -} {{.e 1 1 a123bc abc 123 all key} a123bc} -test spinbox-19.5 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {{.e 1 1 a123bc abc 123 all key} a123bc} + +test spinbox-19.5 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a123bc ;# previous settings .e delete 2 set ::vVals -} {.e 0 2 a13bc a123bc 2 all key} -test spinbox-19.6 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e 0 2 a13bc a123bc 2 all key} + +test spinbox-19.6 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 a13bc ;# previous settings .e configure -validate key .e delete 1 3 set ::vVals -} {.e 0 1 abc a13bc 13 key key} -test spinbox-19.7 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e 0 1 abc a13bc 13 key key} + +test spinbox-19.7 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focus \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abc ;# previous settings set ::vVals {} - .e configure -validate focus .e insert end d set ::vVals -} {} -test spinbox-19.8 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {} + +test spinbox-19.8 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e configure -validate focus ;# previous settings + .e insert end abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update set ::vVals -} {.e -1 -1 abcd abcd {} focus focusin} -test spinbox-19.9 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focus focusin} + +test spinbox-19.9 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focus \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + focus -force .e ;# previous settings + update ;# previous settings +# update necessary to process FocusIn event focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update set ::vVals -} {.e -1 -1 abcd abcd {} focus focusout} -.e configure -validate all -test spinbox-19.10 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focus focusout} + +test spinbox-19.10 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update set ::vVals -} {.e -1 -1 abcd abcd {} all focusin} -test spinbox-19.11 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} all focusin} + +test spinbox-19.11 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update set ::vVals -} {.e -1 -1 abcd abcd {} all focusout} -.e configure -validate focusin -test spinbox-19.12 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} all focusout} + +test spinbox-19.12 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focusin \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert 0 abcd ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update set ::vVals -} {.e -1 -1 abcd abcd {} focusin focusin} -test spinbox-19.13 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focusin focusin} + +test spinbox-19.13 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focusin \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings set ::vVals {} focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update set ::vVals -} {} -.e configure -validate focuso -test spinbox-19.14 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {} + +test spinbox-19.14 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings focus -force .e - # update necessary to process FocusIn event +# update necessary to process FocusIn event update set ::vVals -} {} -test spinbox-19.15 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {} + +test spinbox-19.15 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings focus -force . - # update necessary to process FocusOut event +# update necessary to process FocusOut event update set ::vVals -} {.e -1 -1 abcd abcd {} focusout focusout} -test spinbox-19.16 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {.e -1 -1 abcd abcd {} focusout focusout} + +# the same as 19.16 but added [.e validate] to returned list +test spinbox-19.16 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings + set ::vVals {} ;# previous settings + focus -force .e ;# previous settings +# update necessary to process FocusIn event + update ;# previous settings + focus -force . +# update necessary to process FocusOut event + update list [.e validate] $::vVals -} {1 {.e -1 -1 abcd abcd {} all forced}} -test spinbox-19.17 {spinbox widget validation} { +} -cleanup { + destroy .e +} -result {1 {.e -1 -1 abcd abcd {} all forced}} + + +test spinbox-19.17 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate focuso \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + .e insert end abcd ;# previous settings set ::e newdata list [.e cget -validate] $::vVals -} {focusout {.e -1 -1 newdata abcd {} focusout forced}} +} -cleanup { + destroy .e +} -result {focusout {.e -1 -1 newdata abcd {} focusout forced}} -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - return 0 -} -.e configure -validate all -test spinbox-19.18 {spinbox widget validation} { +# proc doval changed - returns 0 +test spinbox-19.18 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval3 %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e newdata ;# previous settings + .e configure -validate all set ::e nextdata list [.e cget -validate] $::vVals -} {none {.e -1 -1 nextdata newdata {} all forced}} +} -cleanup { + destroy .e +} -result {none {.e -1 -1 nextdata newdata {} all forced}} -proc doval {W d i P s S v V} { - set ::vVals [list $W $d $i $P $s $S $v $V] - set ::e mydata - return 1 -} -.e configure -validate all ## This sets validate to none because it shows that we prevent a possible ## loop condition in the validation, when the spinbox textvar is also set -test spinbox-19.19 {spinbox widget validation} { +# proc doval2 used +test spinbox-19.19 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval3 %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e nextdata ;# previous settings + + .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] .e validate list [.e cget -validate] [.e get] $::vVals -} {none mydata {.e -1 -1 nextdata nextdata {} all forced}} - -.e configure -validate all +} -cleanup { + destroy .e +} -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}} ## This leaves validate alone because we trigger validation through the ## textvar (a write trace), and the write during validation triggers ## nothing (by definition of avoiding loops on var traces). This is ## one of those "dangerous" conditions where the user will have a ## different value in the spinbox widget shown as is in the textvar. -test spinbox-19.20 {spinbox widget validation} { +test spinbox-19.20 {spinbox widget validation} -setup { + unset -nocomplain ::e ::vVals +} -body { + spinbox .e -validate all \ + -validatecommand [list doval %W %d %i %P %s %S %v %V] \ + -invalidcommand bell \ + -textvariable ::e \ + -background red -foreground white + pack .e + set ::e nextdata ;# previous settings + .e configure -validatecommand [list doval2 %W %d %i %P %s %S %v %V] ;# prev + .e validate ;# previous settings + + .e configure -validate all set ::e testdata list [.e cget -validate] [.e get] $::e $::vVals -} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} +} -cleanup { + destroy .e +} -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} +## +## End validation tests +## -# A format specifier is allowed to be of the form %[-+ 0]{0,1}\d.?\d?f -# -destroy .e -spinbox .e -test spinbox-20.1 {spinbox config, -format specifier} { - list [catch {.e config -format %2f} msg] $msg -} {0 {}} -test spinbox-20.2 {spinbox config, -format specifier} { - list [catch {.e config -format %2.2f} msg] $msg -} {0 {}} -test spinbox-20.3 {spinbox config, -format specifier} { - list [catch {.e config -format %.2f} msg] $msg -} {0 {}} -test spinbox-20.4 {spinbox config, -format specifier} { - list [catch {.e config -format %2.f} msg] $msg -} {0 {}} -test spinbox-20.5 {spinbox config, -format specifier} { - list [catch {.e config -format %2e-1f} msg] $msg -} {1 {bad spinbox format specifier "%2e-1f"}} -test spinbox-20.6 {spinbox config, -format specifier} { - list [catch {.e config -format 2.2} msg] $msg -} {1 {bad spinbox format specifier "2.2"}} -test spinbox-20.7 {spinbox config, -format specifier} { - list [catch {.e config -format %2.-2f} msg] $msg -} {1 {bad spinbox format specifier "%2.-2f"}} -test spinbox-20.8 {spinbox config, -format specifier} { - list [catch {.e config -format %-2.02f} msg] $msg -} {0 {}} -test spinbox-20.9 {spinbox config, -format specifier} { - list [catch {.e config -format "% 2.02f"} msg] $msg -} {0 {}} -test spinbox-20.10 {spinbox config, -format specifier} { - list [catch {.e config -format "% -2.200f"} msg] $msg -} {0 {}} -test spinbox-20.11 {spinbox config, -format specifier} { - list [catch {.e config -format "%09.200f"} msg] $msg -} {0 {}} -test spinbox-20.12 {spinbox config, -format specifier does something} { +test spinbox-20.1 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-20.2 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2.2f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-20.3 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %.2f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-20.4 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2.f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-20.5 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2e-1f +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad spinbox format specifier "%2e-1f"} +test spinbox-20.6 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format 2.2 +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad spinbox format specifier "2.2"} +test spinbox-20.7 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %2.-2f +} -cleanup { + destroy .e +} -returnCodes {error} -result {bad spinbox format specifier "%2.-2f"} +test spinbox-20.8 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format %-2.02f +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-20.9 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format "% 2.02f" +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-20.10 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format "% -2.200f" +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-20.11 {spinbox config, -format specifier} -body { + spinbox .e + .e config -format "%09.200f" +} -cleanup { + destroy .e +} -returnCodes ok +test spinbox-20.12 {spinbox config, -format specifier does something} -setup { + spinbox .e set out {} +} -body { .e config -format "%02.f" .e config -values {} -from 0 -to 10 -increment 1 lappend out [.e set 0]; # set currently doesn't force format @@ -1489,10 +3684,12 @@ test spinbox-20.12 {spinbox config, -format specifier does something} { lappend out [.e set 3]; # set currently doesn't force format .e config -format "%03.f" lappend out [.e set]; # changing -format should cause formatting -} {0 01 3 003} - -test spinbox-21.1 {spinbox button, out of range checking} { +} -cleanup { destroy .e +} -result {0 01 3 003} + + +test spinbox-21.1 {spinbox button, out of range checking} -body { spinbox .e -from -10 -to 20 -increment 2 set out {} lappend out [.e get]; # -10 @@ -1550,42 +3747,52 @@ test spinbox-21.1 {spinbox button, out of range checking} { lappend out [.e get]; # 18 .e invoke buttonup; # no wrap lappend out [.e get]; # 20 +} -cleanup { + destroy .e +} -result {-10 20 20 -10 -10 -10 20 20 18 -10 -10 -8 -10 -8 -10 20 18 20} -} {-10 20 20 -10 -10 -10 20 20 18 -10 -10 -8 -10 -8 -10 20 18 20} - -test spinbox-22.1 {spinbox config, -from changes SF bug 559078} { +test spinbox-22.1 {spinbox config, -from changes SF bug 559078} -body { set val 5 - destroy .s - spinbox .s -from 1 -to 10 -textvariable val + spinbox .e -from 1 -to 10 -textvariable val set val -} {5} -test spinbox-22.2 {spinbox config, -from changes SF bug 559078} { - .s configure -from 3 -to 10 +} -cleanup { + destroy .e +} -result {5} +test spinbox-22.2 {spinbox config, -from changes SF bug 559078} -body { + set val 5 + spinbox .e -from 1 -to 10 -textvariable val + .e configure -from 3 -to 10 set val -} {5} -test spinbox-22.3 {spinbox config, -from changes SF bug 559078} { - .s configure -from 6 -to 10 +} -cleanup { + destroy .e +} -result {5} +test spinbox-22.3 {spinbox config, -from changes SF bug 559078} -body { + set val 5 + spinbox .e -from 3 -to 10 -textvariable val + .e configure -from 6 -to 10 set val -} {6} - -test spinbox-23.1 {selection present while disabled, bug 637828} { +} -cleanup { destroy .e +} -result {6} + +test spinbox-23.1 {selection present while disabled, bug 637828} -body { spinbox .e .e insert end 0123456789 .e select from 3 .e select to 6 set out [.e selection present] .e configure -state disabled - # still return 1 when disabled, because 'selection get' will work, - # but selection cannot be changed (new behavior since 8.4) +# still return 1 when disabled, because 'selection get' will work, +# but selection cannot be changed (new behavior since 8.4) .e select to 9 lappend out [.e selection present] [selection get] -} {1 1 345} - -destroy .e +} -cleanup { + destroy .e +} -result {1 1 345} -test spinbox-24.1 {error in trace proc attached to the textvariable} { +test spinbox-24.1 {error in trace proc attached to the textvariable} -setup { destroy .s +} -body { trace variable myvar w traceit proc traceit args {error "Intentional error here!"} spinbox .s -textvariable myvar -from 1 -to 10 @@ -1594,28 +3801,32 @@ test spinbox-24.1 {error in trace proc attached to the textvariable} { catch {.s delete 0} result3 catch {.s invoke buttonup} result4 list $result1 $result2 $result3 $result4 -} [list {can't set "myvar": Intentional error here!} \ +} -cleanup { + destroy .s +} -result [list {can't set "myvar": Intentional error here!} \ {can't set "myvar": Intentional error here!} \ {can't set "myvar": Intentional error here!} \ {can't set "myvar": Intentional error here!}] -test spinbox-25.1 {textvariable lives in a non-existing namespace} { +test spinbox-25.1 {textvariable lives in a non-existing namespace} -setup { destroy .s +} -body { catch {spinbox .s -textvariable thisnsdoesntexist::myvar} result1 set result1 -} {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist} - -catch {unset ::e ::vVals} - -## -## End validation tests -## +} -cleanup { + destroy .s +} -result {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist} +# Collected comments about lacks from the test # XXX Still need to write tests for SpinboxBlinkProc, SpinboxFocusProc, # and SpinboxTextVarProc. +# No tests for DisplaySpinbox. +# XXX Still need to write tests for SpinboxScanTo and SpinboxSelectTo. +# No tests for EventuallyRedraw -option clear - +# option clear # cleanup cleanupTests return + + diff --git a/tests/text.test b/tests/text.test index 7c1731d..7ade29a 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6,344 +6,1443 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test -# Create entries in the odeption database to be sure that geometry options -# like border width have predictable values. - -option add *Text.borderWidth 2 -option add *Text.highlightThickness 2 -option add *Text.font {Courier -12} - -text .t -width 20 -height 10 -pack append . .t {top expand fill} -update -.t debug on -wm geometry . {} - # The statements below reset the main window; it's needed if the window # manager is mwm to make mwm forget about a previous minimum size setting. - +wm geometry . {} wm withdraw . wm minsize . 1 1 wm positionfrom . user wm deiconify . + +test text-1.1 {configuration option: "autoseparators"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -autoseparators yes + .t cget -autoseparators +} -cleanup { + destroy .t +} -result {1} +test text-1.2 {configuration option: "autoseparators"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -autoseparators nah +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.3 {configuration option: "background"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -background #ff00ff + .t cget -background +} -cleanup { + destroy .t +} -result {#ff00ff} +test text-1.4 {configuration option: "background"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -background <gorp> +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.5 {configuration option: "bd"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -bd 4 + .t cget -bd +} -cleanup { + destroy .t +} -result {4} +test text-1.6 {configuration option: "bd"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -bd foo +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.7 {configuration option: "bg"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -bg blue + .t cget -bg +} -cleanup { + destroy .t +} -result {blue} +test text-1.8 {configuration option: "bg"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -bg #xx +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.9 {configuration option: "blockcursor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -blockcursor 0 + .t cget -blockcursor +} -cleanup { + destroy .t +} -result {0} +test text-1.10 {configuration option: "blockcursor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -blockcursor xx +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.11 {configuration option: "borderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -borderwidth 7 + .t cget -borderwidth +} -cleanup { + destroy .t +} -result {7} +test text-1.12 {configuration option: "borderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -borderwidth ++ +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.13 {configuration option: "cursor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -cursor watch + .t cget -cursor +} -cleanup { + destroy .t +} -result {watch} +test text-1.14 {configuration option: "cursor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -cursor lousy +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.15 {configuration option: "exportselection"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -exportselection no + .t cget -exportselection +} -cleanup { + destroy .t +} -result {0} +test text-1.16 {configuration option: "exportselection"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -exportselection maybe +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.17 {configuration option: "fg"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -fg red + .t cget -fg +} -cleanup { + destroy .t +} -result {red} +test text-1.18 {configuration option: "fg"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -fg stupid +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.19 {configuration option: "font"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -font fixed + .t cget -font +} -cleanup { + destroy .t +} -result {fixed} +test text-1.20 {configuration option: "font"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -font {} +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.21 {configuration option: "foreground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -foreground #012 + .t cget -foreground +} -cleanup { + destroy .t +} -result {#012} +test text-1.22 {configuration option: "foreground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -foreground bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.23 {configuration option: "height"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -height 5 + .t cget -height +} -cleanup { + destroy .t +} -result {5} +test text-1.24 {configuration option: "height"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -height bad +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.25 {configuration option: "highlightbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightbackground #123 + .t cget -highlightbackground +} -cleanup { + destroy .t +} -result {#123} +test text-1.26 {configuration option: "highlightbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightbackground bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.27 {configuration option: "highlightcolor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightcolor #234 + .t cget -highlightcolor +} -cleanup { + destroy .t +} -result {#234} +test text-1.28 {configuration option: "highlightcolor"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightcolor bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.29 {configuration option: "highlightthickness"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightthickness -2 + .t cget -highlightthickness +} -cleanup { + destroy .t +} -result {0} +test text-1.30 {configuration option: "highlightthickness"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -highlightthickness bad +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.31 {configuration option: "inactiveselectbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -inactiveselectbackground #ffff01234567 + .t cget -inactiveselectbackground +} -cleanup { + destroy .t +} -result {#ffff01234567} +test text-1.32 {configuration option: "inactiveselectbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -inactiveselectbackground bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.33 {configuration option: "insertbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertbackground green + .t cget -insertbackground +} -cleanup { + destroy .t +} -result {green} +test text-1.34 {configuration option: "insertbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertbackground <bogus> +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.35 {configuration option: "insertborderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertborderwidth 45 + .t cget -insertborderwidth +} -cleanup { + destroy .t +} -result {45} +test text-1.36 {configuration option: "insertborderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertborderwidth bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.37 {configuration option: "insertofftime"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertofftime 100 + .t cget -insertofftime +} -cleanup { + destroy .t +} -result {100} +test text-1.38 {configuration option: "insertofftime"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertofftime 2.4 +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.39 {configuration option: "insertontime"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertontime 47 + .t cget -insertontime +} -cleanup { + destroy .t +} -result {47} +test text-1.40 {configuration option: "insertontime"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertontime e1 +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.41 {configuration option: "insertwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertwidth 2.3 + .t cget -insertwidth +} -cleanup { + destroy .t +} -result {2} +test text-1.42 {configuration option: "insertwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertwidth 47d +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.43 {configuration option: "maxundo"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -maxundo 5 + .t cget -maxundo +} -cleanup { + destroy .t +} -result {5} +test text-1.44 {configuration option: "maxundo"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -maxundo noway +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.45 {configuration option: "padx"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -padx 3.4 + .t cget -padx +} -cleanup { + destroy .t +} -result {3} +test text-1.46 {configuration option: "padx"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -padx 2.4. +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.47 {configuration option: "pady"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -pady 82 + .t cget -pady +} -cleanup { + destroy .t +} -result {82} +test text-1.48 {configuration option: "pady"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -pady bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.49 {configuration option: "relief"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -relief raised + .t cget -relief +} -cleanup { + destroy .t +} -result {raised} +test text-1.50 {configuration option: "relief"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -relief bumpy +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.51 {configuration option: "selectbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectbackground #ffff01234567 + .t cget -selectbackground +} -cleanup { + destroy .t +} -result {#ffff01234567} +test text-1.52 {configuration option: "selectbackground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectbackground bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.53 {configuration option: "selectborderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectborderwidth 21 + .t cget -selectborderwidth +} -cleanup { + destroy .t +} -result {21} +test text-1.54 {configuration option: "selectborderwidth"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectborderwidth 3x +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.55 {configuration option: "selectforeground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectforeground yellow + .t cget -selectforeground +} -cleanup { + destroy .t +} -result {yellow} +test text-1.56 {configuration option: "selectforeground"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -selectforeground #12345 +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.57 {configuration option: "spacing1"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing1 20 + .t cget -spacing1 +} -cleanup { + destroy .t +} -result {20} +test text-1.58 {configuration option: "spacing1"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing1 1.3x +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.59 {configuration option: "spacing1"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing1 -5 + .t cget -spacing1 +} -cleanup { + destroy .t +} -result {0} +test text-1.60 {configuration option: "spacing1"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing1 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.61 {configuration option: "spacing2"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing2 5 + .t cget -spacing2 +} -cleanup { + destroy .t +} -result {5} +test text-1.62 {configuration option: "spacing2"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing2 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.63 {configuration option: "spacing2"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing2 -1 + .t cget -spacing2 +} -cleanup { + destroy .t +} -result {0} +test text-1.64 {configuration option: "spacing2"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing2 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.65 {configuration option: "spacing3"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing3 20 + .t cget -spacing3 +} -cleanup { + destroy .t +} -result {20} +test text-1.66 {configuration option: "spacing3"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing3 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.67 {configuration option: "spacing3"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing3 -10 + .t cget -spacing3 +} -cleanup { + destroy .t +} -result {0} +test text-1.68 {configuration option: "spacing3"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -spacing3 bogus +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.69 {configuration option: "state"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -state d + .t cget -state +} -cleanup { + destroy .t +} -result {disabled} +test text-1.70 {configuration option: "state"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -state foo +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.71 {configuration option: "tabs"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -tabs {1i 2i 3i 4i} + .t cget -tabs +} -cleanup { + destroy .t +} -result {1i 2i 3i 4i} +test text-1.72 {configuration option: "tabs"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -tabs bad_tabs +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.73 {configuration option: "tabstyle"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -tabstyle wordprocessor + .t cget -tabstyle +} -cleanup { + destroy .t +} -result {wordprocessor} +test text-1.74 {configuration option: "tabstyle"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -tabstyle garbage +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.75 {configuration option: "undo"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -undo 1 + .t cget -undo +} -cleanup { + destroy .t +} -result {1} +test text-1.76 {configuration option: "undo"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -undo eh +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.77 {configuration option: "width"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -width 73 + .t cget -width +} -cleanup { + destroy .t +} -result {73} +test text-1.78 {configuration option: "width"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -width 2.4 +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.79 {configuration option: "wrap"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -wrap w + .t cget -wrap +} -cleanup { + destroy .t +} -result {word} +test text-1.80 {configuration option: "wrap"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -wrap bad_wrap +} -cleanup { + destroy .t +} -match glob -returnCodes {error} -result {*} +test text-1.81 {text options} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -takefocus "any old thing" + .t cget -takefocus +} -cleanup { + destroy .t +} -result {any old thing} +test text-1.82 {text options} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -xscrollcommand "x scroll command" + .t configure -xscrollcommand +} -cleanup { + destroy .t +} -result {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}} +test text-1.83 {text options} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -yscrollcommand "test command" + .t configure -yscrollcommand +} -cleanup { + destroy .t +} -result {-yscrollcommand yScrollCommand ScrollCommand {} {test command}} +test text-1.83.1 {configuration option: "insertunfocussed"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertunfocussed none + .t cget -insertunfocussed +} -cleanup { + destroy .t +} -result none +test text-1.84 {configuration option: "insertunfocussed"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertunfocussed hollow + .t cget -insertunfocussed +} -cleanup { + destroy .t +} -result hollow +test text-1.85 {configuration option: "insertunfocussed"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -body { + .t configure -insertunfocussed solid + .t cget -insertunfocussed +} -cleanup { + destroy .t +} -result solid +test text-1.86 {configuration option: "insertunfocussed"} -setup { + text .t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} + pack .t + update +} -returnCodes error -body { + .t configure -insertunfocussed gorp +} -cleanup { + destroy .t +} -result {bad insertunfocussed "gorp": must be hollow, none, or solid} -entry .t.e -.t.e insert end abcdefg -.t.e select from 0 -.t insert 1.0 "Line 1 +test text-2.1 {Tk_TextCmd procedure} -body { + text +} -returnCodes {error} -result {wrong # args: should be "text pathName ?-option value ...?"} +test text-2.2 {Tk_TextCmd procedure} -body { + text foobar +} -returnCodes {error} -result {bad window path name "foobar"} +test text-2.3 {Tk_TextCmd procedure} -body { + text .t -gorp nofun +} -cleanup { + destroy .t +} -returnCodes {error} -result {unknown option "-gorp"} +test text-2.4 {Tk_TextCmd procedure} -body { + catch {text .t -gorp nofun} + winfo exists .t +} -cleanup { + destroy .t +} -result 0 +test text-2.5 {Tk_TextCmd procedure} -body { + text .t -bd 2 -fg red +} -cleanup { + destroy .t +} -returnCodes ok -result {.t} +test text-2.6 {Tk_TextCmd procedure} -body { + text .t -bd 2 -fg red + list [lindex [.t config -bd] 4] [lindex [.t config -fg] 4] +} -cleanup { + destroy .t +} -result {2 red} +test text-2.7 {Tk_TextCmd procedure} -constraints { + win +} -body { + catch {destroy .t} + text .t + .t tag cget sel -relief +} -cleanup { + destroy .t +} -result {flat} +test text-2.8 {Tk_TextCmd procedure} -constraints { + aqua +} -body { + catch {destroy .t} + text .t + .t tag cget sel -relief +} -cleanup { + destroy .t +} -result {solid} +test text-2.9 {Tk_TextCmd procedure} -constraints { + unix +} -body { + catch {destroy .t} + text .t + .t tag cget sel -relief +} -cleanup { + destroy .t +} -result {raised} +test text-2.10 {Tk_TextCmd procedure} -body { + list [text .t] [winfo class .t] +} -cleanup { + destroy .t +} -result {.t Text} + + +test text-3.1 {TextWidgetCmd procedure, basics} -setup { + text .t +} -body { + .t +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t option ?arg ...?"} +test text-3.2 {TextWidgetCmd procedure} -setup { + text .t +} -body { + .t gorp 1.0 z 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview} + +test text-4.1 {TextWidgetCmd procedure, "bbox" option} -setup { + text .t +} -body { + .t bbox +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t bbox index"} +test text-4.2 {TextWidgetCmd procedure, "bbox" option} -setup { + text .t +} -body { + .t bbox a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t bbox index"} +test text-4.3 {TextWidgetCmd procedure, "bbox" option} -setup { + text .t +} -body { + .t bbox bad_mark +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "bad_mark"} + +test text-5.1 {TextWidgetCmd procedure, "cget" option} -setup { + text .t +} -body { + .t cget +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t cget option"} +test text-5.2 {TextWidgetCmd procedure, "cget" option} -setup { + text .t +} -body { + .t cget a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t cget option"} +test text-5.3 {TextWidgetCmd procedure, "cget" option} -setup { + text .t +} -body { + .t cget -gorp +} -cleanup { + destroy .t +} -returnCodes {error} -result {unknown option "-gorp"} +test text-5.4 {TextWidgetCmd procedure, "cget" option} -setup { + text .t +} -body { + .t configure -bd 17 + .t cget -bd +} -cleanup { + destroy .t +} -result {17} + + +test text-6.1 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t compare a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t compare index1 op index2"} +test text-6.2 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t compare a b c d +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t compare index1 op index2"} +test text-6.3 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t compare @x == 1.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@x"} +test text-6.4 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t compare 1.0 < @y +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@y"} +test text-6.5 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 abcdefghijklm 12345 Line 4 bOy GIrl .#@? x_yz !@#$% Line 7" - -catch {destroy .t2} -text .t2 -set i 0 -foreach test { - {-autoseparators yes 1 nah} - {-background #ff00ff #ff00ff <gorp>} - {-bd 4 4 foo} - {-bg blue blue #xx} - {-blockcursor 0 0 xx} - {-borderwidth 7 7 ++} - {-cursor watch watch lousy} - {-exportselection no 0 maybe} - {-fg red red stupid} - {-font fixed fixed {}} - {-foreground #012 #012 bogus} - {-height 5 5 bad} - {-highlightbackground #123 #123 bogus} - {-highlightcolor #234 #234 bogus} - {-highlightthickness -2 0 bad} - {-inactiveselectbackground #ffff01234567 #ffff01234567 bogus} - {-insertbackground green green <bogus>} - {-insertborderwidth 45 45 bogus} - {-insertofftime 100 100 2.4} - {-insertontime 47 47 e1} - {-insertwidth 2.3 2 47d} - {-maxundo 5 5 noway} - {-padx 3.4 3 2.4.} - {-pady 82 82 bogus} - {-relief raised raised bumpy} - {-selectbackground #ffff01234567 #ffff01234567 bogus} - {-selectborderwidth 21 21 3x} - {-selectforeground yellow yellow #12345} - {-spacing1 20 20 1.3x} - {-spacing1 -5 0 bogus} - {-spacing2 5 5 bogus} - {-spacing2 -1 0 bogus} - {-spacing3 20 20 bogus} - {-spacing3 -10 0 bogus} - {-state d disabled foo} - {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs} - {-tabstyle wordprocessor wordprocessor garbage} - {-undo 1 1 eh} - {-width 73 73 2.4} - {-wrap w word bad_wrap} -} { - test text-1.[incr i] {text options} { - set result {} - lappend result [catch {.t2 configure [lindex $test 0] [lindex $test 3]}] - .t2 configure [lindex $test 0] [lindex $test 1] - lappend result [.t2 cget [lindex $test 0]] - } [list 1 [lindex $test 2]] -} -test text-1.[incr i] {text options} { - .t2 configure -takefocus "any old thing" - .t2 cget -takefocus -} {any old thing} -test text-1.[incr i] {text options} { - .t2 configure -xscrollcommand "x scroll command" - .t2 configure -xscrollcommand -} {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}} -test text-1.[incr i] {text options} { - .t2 configure -yscrollcommand "test command" - .t2 configure -yscrollcommand -} {-yscrollcommand yScrollCommand ScrollCommand {} {test command}} -test text-1.[incr i] {text options} { - set result {} - foreach i [.t2 configure] { - lappend result [lindex $i 4] - } - set result -} {1 blue {} {} 0 7 watch {} 0 {} fixed #012 5 #123 #234 0 #ffff01234567 green 45 100 47 2 5 3 82 raised #ffff01234567 21 yellow 0 0 0 0 {} disabled {1i 2i 3i 4i} wordprocessor {any old thing} 1 73 word {x scroll command} {test command}} - -test text-2.1 {Tk_TextCmd procedure} { - list [catch {text} msg] $msg -} {1 {wrong # args: should be "text pathName ?options?"}} -test text-2.2 {Tk_TextCmd procedure} { - list [catch {text foobar} msg] $msg -} {1 {bad window path name "foobar"}} -test text-2.3 {Tk_TextCmd procedure} { - catch {destroy .t2} - list [catch {text .t2 -gorp nofun} msg] $msg [winfo exists .t2] -} {1 {unknown option "-gorp"} 0} -test text-2.4 {Tk_TextCmd procedure} { - catch {destroy .t2} - list [catch {text .t2 -bd 2 -fg red} msg] $msg \ - [lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4] -} {0 .t2 2 red} -if {$tcl_platform(platform) == "windows"} { - set relief flat -} elseif {[tk windowingsystem] eq "aqua"} { - set relief solid -} else { - set relief raised -} -test text-2.5 {Tk_TextCmd procedure} { - catch {destroy .t2} - text .t2 - .t2 tag cget sel -relief -} $relief -test text-2.6 {Tk_TextCmd procedure} { - catch {destroy .t2} - list [text .t2] [winfo class .t2] -} {.t2 Text} - -test text-3.1 {TextWidgetCmd procedure, basics} { - list [catch {.t} msg] $msg -} {1 {wrong # args: should be ".t option ?arg arg ...?"}} -test text-3.2 {TextWidgetCmd procedure} { - list [catch {.t gorp 1.0 z 1.2} msg] $msg -} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} - -test text-4.1 {TextWidgetCmd procedure, "bbox" option} { - list [catch {.t bbox} msg] $msg -} {1 {wrong # args: should be ".t bbox index"}} -test text-4.2 {TextWidgetCmd procedure, "bbox" option} { - list [catch {.t bbox a b} msg] $msg -} {1 {wrong # args: should be ".t bbox index"}} -test text-4.3 {TextWidgetCmd procedure, "bbox" option} { - list [catch {.t bbox bad_mark} msg] $msg -} {1 {bad text index "bad_mark"}} - -test text-5.1 {TextWidgetCmd procedure, "cget" option} { - list [catch {.t cget} msg] $msg -} {1 {wrong # args: should be ".t cget option"}} -test text-5.2 {TextWidgetCmd procedure, "cget" option} { - list [catch {.t cget a b} msg] $msg -} {1 {wrong # args: should be ".t cget option"}} -test text-5.3 {TextWidgetCmd procedure, "cget" option} { - list [catch {.t cget -gorp} msg] $msg -} {1 {unknown option "-gorp"}} -test text-5.4 {TextWidgetCmd procedure, "cget" option} { - .t configure -bd 17 - .t cget -bd -} {17} -.t configure -bd [lindex [.t configure -bd] 3] - -test text-6.1 {TextWidgetCmd procedure, "compare" option} { - list [catch {.t compare a b} msg] $msg -} {1 {wrong # args: should be ".t compare index1 op index2"}} -test text-6.2 {TextWidgetCmd procedure, "compare" option} { - list [catch {.t compare a b c d} msg] $msg -} {1 {wrong # args: should be ".t compare index1 op index2"}} -test text-6.3 {TextWidgetCmd procedure, "compare" option} { - list [catch {.t compare @x == 1.0} msg] $msg -} {1 {bad text index "@x"}} -test text-6.4 {TextWidgetCmd procedure, "compare" option} { - list [catch {.t compare 1.0 < @y} msg] $msg -} {1 {bad text index "@y"}} -test text-6.5 {TextWidgetCmd procedure, "compare" option} { list [.t compare 1.1 < 1.0] [.t compare 1.1 < 1.1] [.t compare 1.1 < 1.2] -} {0 0 1} -test text-6.6 {TextWidgetCmd procedure, "compare" option} { +} -cleanup { + destroy .t +} -result {0 0 1} +test text-6.6 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" list [.t compare 1.1 <= 1.0] [.t compare 1.1 <= 1.1] [.t compare 1.1 <= 1.2] -} {0 1 1} -test text-6.7 {TextWidgetCmd procedure, "compare" option} { +} -cleanup { + destroy .t +} -result {0 1 1} +test text-6.7 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" list [.t compare 1.1 == 1.0] [.t compare 1.1 == 1.1] [.t compare 1.1 == 1.2] -} {0 1 0} -test text-6.8 {TextWidgetCmd procedure, "compare" option} { +} -cleanup { + destroy .t +} -result {0 1 0} +test text-6.8 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" list [.t compare 1.1 >= 1.0] [.t compare 1.1 >= 1.1] [.t compare 1.1 >= 1.2] -} {1 1 0} -test text-6.9 {TextWidgetCmd procedure, "compare" option} { +} -cleanup { + destroy .t +} -result {1 1 0} +test text-6.9 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" list [.t compare 1.1 > 1.0] [.t compare 1.1 > 1.1] [.t compare 1.1 > 1.2] -} {1 0 0} -test text-6.10 {TextWidgetCmd procedure, "compare" option} { +} -cleanup { + destroy .t +} -result {1 0 0} +test text-6.10 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" list [.t com 1.1 != 1.0] [.t compare 1.1 != 1.1] [.t compare 1.1 != 1.2] -} {1 0 1} -test text-6.11 {TextWidgetCmd procedure, "compare" option} { - list [catch {.t compare 1.0 <x 1.2} msg] $msg -} {1 {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=}} -test text-6.12 {TextWidgetCmd procedure, "compare" option} { - list [catch {.t compare 1.0 >> 1.2} msg] $msg -} {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}} -test text-6.13 {TextWidgetCmd procedure, "compare" option} { - list [catch {.t compare 1.0 z 1.2} msg] $msg -} {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}} -test text-6.14 {TextWidgetCmd procedure, "compare" option} { - list [catch {.t co 1.0 z 1.2} msg] $msg -} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} - +} -cleanup { + destroy .t +} -result {1 0 1} +test text-6.11 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t compare 1.0 <x 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=} +test text-6.12 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t compare 1.0 >> 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=} +test text-6.13 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t compare 1.0 z 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad comparison operator "z": must be <, <=, ==, >=, >, or !=} +test text-6.14 {TextWidgetCmd procedure, "compare" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t co 1.0 z 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview} # "configure" option is already covered above -test text-7.1 {TextWidgetCmd procedure, "debug" option} { - list [catch {.t debug 0 1} msg] $msg -} {1 {wrong # args: should be ".t debug boolean"}} -test text-7.2 {TextWidgetCmd procedure, "debug" option} { - list [catch {.t de 0 1} msg] $msg -} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} -test text-7.3 {TextWidgetCmd procedure, "debug" option} { +test text-7.1 {TextWidgetCmd procedure, "debug" option} -setup { + text .t +} -body { + .t debug 0 1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t debug boolean"} +test text-7.2 {TextWidgetCmd procedure, "debug" option} -setup { + text .t +} -body { + .t de 0 1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview} +test text-7.3 {TextWidgetCmd procedure, "debug" option} -setup { + text .t +} -body { .t debug true .t deb -} 1 -test text-7.4 {TextWidgetCmd procedure, "debug" option} { +} -cleanup { + destroy .t +} -result {1} +test text-7.4 {TextWidgetCmd procedure, "debug" option} -setup { + text .t +} -body { .t debug false .t debug -} 0 -.t debug - -test text-8.1 {TextWidgetCmd procedure, "delete" option} { - list [catch {.t delete} msg] $msg -} {1 {wrong # args: should be ".t delete index1 ?index2 ...?"}} -test text-8.2 {TextWidgetCmd procedure, "delete" option} { - list [catch {.t delete a b c} msg] $msg -} {1 {bad text index "a"}} -test text-8.3 {TextWidgetCmd procedure, "delete" option} { - list [catch {.t delete @x 2.2} msg] $msg -} {1 {bad text index "@x"}} -test text-8.4 {TextWidgetCmd procedure, "delete" option} { - list [catch {.t delete 2.3 @y} msg] $msg -} {1 {bad text index "@y"}} -test text-8.5 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {0} + + +test text-8.1 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t delete +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t delete index1 ?index2 ...?"} +test text-8.2 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t delete a b c +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "a"} +test text-8.3 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t delete @x 2.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@x"} +test text-8.4 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" + .t delete 2.3 @y +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@y"} +test text-8.5 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t configure -state disabled .t delete 2.3 .t g 2.0 2.end -} abcdefghijklm -.t configure -state normal -test text-8.6 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {abcdefghijklm} +test text-8.6 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t delete 2.3 .t get 2.0 2.end -} abcefghijklm -test text-8.7 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {abcefghijklm} +test text-8.7 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t delete 2.1 2.3 .t get 2.0 2.end -} aefghijklm -test text-8.8 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {adefghijklm} +test text-8.8 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" # All indices are checked before we actually delete anything - list [catch {.t delete 2.1 2.3 foo} msg] $msg \ - [.t get 2.0 2.end] -} {1 {bad text index "foo"} aefghijklm} -set prevtext [.t get 1.0 end-1c] -test text-8.9 {TextWidgetCmd procedure, "delete" option} { + .t delete 2.1 2.3 foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "foo"} +test text-8.9 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" +# All indices are checked before we actually delete anything + catch {.t delete 2.1 2.3 foo} + .t get 2.0 2.end +} -cleanup { + destroy .t +} -result {abcdefghijklm} +test text-8.10 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" # auto-forward one byte if the last "pair" is just one - .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t delete 1.0 end + .t insert 1.0 "foo\nabcdefghijklm" .t delete 2.1 2.3 2.3 .t get 1.0 end-1c -} foo\naefghijklm -test text-8.10 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {foo +aefghijklm} +test text-8.11 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { # all indices will be ordered before deletion - .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t insert 1.0 "foo\nabcdefghijklm" .t delete 2.0 2.3 2.7 2.9 2.4 .t get 1.0 end-1c -} foo\ndfgjklm -test text-8.11 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {foo +dfgjklm} +test text-8.12 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { # and check again with even pairs - .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t insert 1.0 "foo\nabcdefghijklm" .t delete 2.0 2.2 2.7 2.9 2.4 2.5 .t get 1.0 end-1c -} foo\ncdfgjklm -test text-8.12 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {foo +cdfgjklm} +test text-8.13 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { # we should get the longest range on equal start indices - .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t insert 1.0 "foo\nabcdefghijklm" .t delete 2.0 2.2 2.0 2.5 2.0 2.3 2.8 2.7 .t get 1.0 end-1c -} foo\nfghijklm -test text-8.13 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {foo +fghijklm} +test text-8.14 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { # we should get the longest range on equal start indices - .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t insert 1.0 "foo\nabcdefghijklm" .t delete 2.0 2.2 1.2 2.6 2.0 2.5 .t get 1.0 end-1c -} foghijklm -test text-8.14 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {foghijklm} +test text-8.15 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { # we should get the longest range on equal start indices - .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t insert 1.0 "foo\nabcdefghijklm" .t delete 2.0 2.2 2.0 2.5 1.1 2.3 2.8 2.7 .t get 1.0 end-1c -} ffghijklm -test text-8.15 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {ffghijklm} +test text-8.16 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { # we should get the watch for overlapping ranges - they should # essentially be merged into one span. - .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t insert 1.0 "foo\nabcdefghijklm" .t delete 2.0 2.6 2.2 2.8 .t get 1.0 end-1c -} foo\nijklm -test text-8.16 {TextWidgetCmd procedure, "delete" option} { +} -cleanup { + destroy .t +} -result {foo +ijklm} +test text-8.17 {TextWidgetCmd procedure, "delete" option} -setup { + text .t +} -body { # we should get the watch for overlapping ranges - they should # essentially be merged into one span. - .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" + .t insert 1.0 "foo\nabcdefghijklm" .t delete 2.0 2.6 2.2 2.4 .t get 1.0 end-1c -} foo\nghijklm -.t delete 1.0 end; .t insert 1.0 $prevtext -test text-8.17 {TextWidgetCmd procedure, "replace" option} { - list [catch {.t replace 1.3 2.3} err] $err -} {1 {wrong # args: should be ".t replace index1 index2 chars ?tagList chars tagList ...?"}} -test text-8.18 {TextWidgetCmd procedure, "replace" option} { - list [catch {.t replace 3.1 2.3 foo} err] $err -} {1 {Index "2.3" before "3.1" in the text}} -test text-8.19 {TextWidgetCmd procedure, "replace" option} { - list [catch {.t replace 2.1 2.3 foo} err] $err -} {0 {}} -.t delete 1.0 end; .t insert 1.0 $prevtext -test text-8.20 {TextWidgetCmd procedure, "replace" option with undo} { +} -cleanup { + destroy .t +} -result {foo +ghijklm} +test text-8.18 {TextWidgetCmd procedure, "replace" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" + .t replace 1.3 2.3 +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t replace index1 index2 chars ?tagList chars tagList ...?"} +test text-8.19 {TextWidgetCmd procedure, "replace" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345" + .t replace 3.1 2.3 foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {index "2.3" before "3.1" in the text} +test text-8.20 {TextWidgetCmd procedure, "replace" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t replace 2.1 2.3 foo +} -cleanup { + destroy .t +} -returnCodes ok -result {} +test text-8.21 {TextWidgetCmd procedure, "replace" option with undo} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +abcdefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + set prevtext [.t get 1.0 end-1c] .t configure -undo 0 .t configure -undo 1 # Ensure it is treated as a single undo action .t replace 2.1 2.3 foo .t edit undo - .t configure -undo 0 string equal [.t get 1.0 end-1c] $prevtext -} {1} -test text-8.21 {TextWidgetCmd procedure, "replace" option with undo} { +} -cleanup { + destroy .t +} -result {1} +test text-8.22 {TextWidgetCmd procedure, "replace" option with undo} -setup { + text .t + set res {} +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t configure -undo 0 .t configure -undo 1 .t replace 2.1 2.3 foo @@ -352,15 +1451,25 @@ test text-8.21 {TextWidgetCmd procedure, "replace" option with undo} { # to do this, then we should be able to change this test. The # behaviour tested for here is not, strictly speaking, documented. rename .t test.t - set res {} proc .t {args} { lappend ::res $args ; uplevel 1 test.t $args } .t edit undo + return $res +} -cleanup { rename .t {} rename test.t .t - .t configure -undo 0 - set res -} {{edit undo} {delete 2.1 2.4} {mark set insert 2.1} {see insert} {insert 2.1 ef} {mark set insert 2.3} {see insert}} -test text-8.22 {TextWidgetCmd procedure, "replace" option with undo} { + destroy .t +} -result {{edit undo} {delete 2.1 2.4} {mark set insert 2.1} {see insert} {insert 2.1 ef} {mark set insert 2.3} {see insert}} +test text-8.23 {TextWidgetCmd procedure, "replace" option with undo} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + set prevtext [.t get 1.0 end-1c] .t configure -undo 0 .t configure -undo 1 # Ensure that undo (even composite undo like 'replace') @@ -370,322 +1479,1145 @@ test text-8.22 {TextWidgetCmd procedure, "replace" option with undo} { .t edit undo .t configure -start {} -end {} .t configure -undo 0 - if {![string equal [.t get 1.0 end-1c] $prevtext]} { - set res [list [.t get 1.0 end-1c] ne $prevtext] - } else { - set res 1 - } -} {1} -.t delete 1.0 end; .t insert 1.0 $prevtext -test text-8.23 {TextWidgetCmd procedure, "replace" option with peers, undo} { + string equal [.t get 1.0 end-1c] $prevtext +} -cleanup { + destroy .t +} -result {1} +test text-8.24 {TextWidgetCmd procedure, "replace" option with peers, undo} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + set prevtext [.t get 1.0 end-1c] .t configure -undo 0 .t configure -undo 1 .t peer create .tt -undo 1 - # Ensure that undo (even composite undo like 'replace') - # works when the the event took place in one peer, which - # is then deleted, before the undo takes place in another peer. +# Ensure that undo (even composite undo like 'replace') +# works when the the event took place in one peer, which +# is then deleted, before the undo takes place in another peer. .tt replace 2.1 2.3 foo .tt configure -start 1 -end 1 destroy .tt .t edit undo .t configure -start {} -end {} .t configure -undo 0 - if {![string equal [.t get 1.0 end-1c] $prevtext]} { - set res [list [.t get 1.0 end-1c] ne $prevtext] - } else { - set res 1 - } -} {1} -.t delete 1.0 end; .t insert 1.0 $prevtext -test text-8.24 {TextWidgetCmd procedure, "replace" option with peers, undo} { + string equal [.t get 1.0 end-1c] $prevtext +} -cleanup { + destroy .t +} -result {1} +test text-8.25 {TextWidgetCmd procedure, "replace" option with peers, undo} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + set prevtext [.t get 1.0 end-1c] .t configure -undo 0 .t configure -undo 1 .t peer create .tt -undo 1 - # Ensure that undo (even composite undo like 'replace') - # works when the the event took place in one peer, which - # is then deleted, before the undo takes place in another peer - # which isn't showing everything. +# Ensure that undo (even composite undo like 'replace') +# works when the the event took place in one peer, which +# is then deleted, before the undo takes place in another peer +# which isn't showing everything. .tt replace 2.1 2.3 foo set res [.tt get 2.1 2.4] .tt configure -start 1 -end 1 destroy .tt .t configure -start 3 -end 4 - # msg will actually be set to a silently ignored error message here, - # (that the .tt command doesn't exist), but that is not important. - lappend res [catch {.t edit undo} msg] +# msg will actually be set to a silently ignored error message here, +# (that the .tt command doesn't exist), but that is not important. + lappend res [catch {.t edit undo}] .t configure -undo 0 .t configure -start {} -end {} - if {![string equal [.t get 1.0 end-1c] $prevtext]} { - lappend res [list [.t get 1.0 end-1c] ne $prevtext] - } else { - lappend res 1 - } -} {foo 0 1} -test text-8.25 {TextWidgetCmd procedure, "replace" option crash} -setup { - destroy .tt -} -body { + lappend res [string equal [.t get 1.0 end-1c] $prevtext] +} -cleanup { + destroy .t +} -result {foo 0 1} +test text-8.26 {TextWidgetCmd procedure, "replace" option crash} -setup { text .tt +} -body { .tt insert 0.0 foo\n .tt replace end-1l end bar } -cleanup { destroy .tt } -result {} -.t delete 1.0 end; .t insert 1.0 $prevtext - -test text-9.1 {TextWidgetCmd procedure, "get" option} { - list [catch {.t get} msg] $msg -} {1 {wrong # args: should be ".t get ?-displaychars? ?--? index1 ?index2 ...?"}} -test text-9.2 {TextWidgetCmd procedure, "get" option} { - list [catch {.t get a b c} msg] $msg -} {1 {bad text index "a"}} -test text-9.3 {TextWidgetCmd procedure, "get" option} { - list [catch {.t get @q 3.1} msg] $msg -} {1 {bad text index "@q"}} -test text-9.4 {TextWidgetCmd procedure, "get" option} { - list [catch {.t get 3.1 @r} msg] $msg -} {1 {bad text index "@r"}} -test text-9.5 {TextWidgetCmd procedure, "get" option} { + +test text-9.1 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t get +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t get ?-displaychars? ?--? index1 ?index2 ...?"} +test text-9.2 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t get a b c +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "a"} +test text-9.3 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t get @q 3.1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@q"} +test text-9.4 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t get 3.1 @r +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@r"} +test text-9.5 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.7 5.3 -} {} -test text-9.6 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {} +test text-9.6 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.3 5.5 -} { G} -test text-9.7 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result { G} +test text-9.7 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.3 end -} { GIrl .#@? x_yz +} -cleanup { + destroy .t +} -result { GIrl .#@? x_yz !@#$% Line 7 } -.t mark set a 5.3 -.t mark set b 5.3 -.t mark set c 5.5 -test text-9.8 {TextWidgetCmd procedure, "get" option} { +test text-9.8 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.2 5.7 -} {y GIr} -test text-9.9 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {y GIr} +test text-9.9 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.2 -} {y} -test text-9.10 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {y} +test text-9.10 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.2 5.4 -} {y } -test text-9.11 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {y } +test text-9.11 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.2 5.4 5.4 -} {{y } G} -test text-9.12 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {{y } G} +test text-9.12 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.2 5.4 5.4 5.5 -} {{y } G} -test text-9.13 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {{y } G} +test text-9.13 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.2 5.4 5.5 "5.5+5c" -} {{y } {Irl .}} -test text-9.14 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {{y } {Irl .}} +test text-9.14 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.2 5.4 5.4 5.5 end-3c -} {{y } G { }} -test text-9.15 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {{y } G { }} +test text-9.15 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.2 5.4 5.4 5.5 end-3c end -} {{y } G { 7 +} -cleanup { + destroy .t +} -result {{y } G { 7 }} -test text-9.16 {TextWidgetCmd procedure, "get" option} { +test text-9.16 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t get 5.2 5.3 5.4 5.3 -} {y} -test text-9.17 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {y} +test text-9.17 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t index "5.2 +3 indices" -} {5.5} -test text-9.17a {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.5} +test text-9.18 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t index "5.2 +3chars" -} {5.5} -test text-9.17b {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.5} +test text-9.19 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t index "5.2 +3displayindices" -} {5.5} -.t tag configure elide -elide 1 -.t tag add elide 5.2 5.4 -test text-9.18 {TextWidgetCmd procedure, "get" option} { - list [catch {.t get 5.2 5.4 5.5 foo} msg] $msg -} {1 {bad text index "foo"}} -test text-9.19 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.5} +test text-9.20 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t get 5.2 5.4 5.5 foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "foo"} +test text-9.21 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 .t get 5.2 5.4 5.4 5.5 end-3c end -} {{y } G { 7 +} -cleanup { + destroy .t +} -result {{y } G { 7 }} -test text-9.20 {TextWidgetCmd procedure, "get" option} { +test text-9.22 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 .t get -displaychars 5.2 5.4 5.4 5.5 end-3c end -} {{} G { 7 +} -cleanup { + destroy .t +} -result {{} G { 7 }} -test text-9.21 {TextWidgetCmd procedure, "get" option} { +test text-9.23 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 list [.t index "5.1 +4indices"] [.t index "5.1+4d indices"] -} {5.5 5.7} -test text-9.22 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.5 5.7} +test text-9.24 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 list [.t index "5.1 +4a chars"] [.t index "5.1+4d chars"] -} {5.5 5.7} -test text-9.23 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.5 5.7} +test text-9.25 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 list [.t index "5.5 -4indices"] [.t index "5.7-4d indices"] -} {5.1 5.1} -test text-9.24 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.1 5.1} +test text-9.26 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 list [.t index "5.5 -4a chars"] [.t index "5.7-4d chars"] -} {5.1 5.1} -.t window create 5.4 -test text-9.25 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.1 5.1} +test text-9.27 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 list [.t index "5.1 +4indices"] [.t index "5.1+4d indices"] -} {5.5 5.7} -test text-9.25a {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.5 5.7} +test text-9.28 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 list [.t index "5.1 +4a chars"] [.t index "5.1+4d chars"] -} {5.6 5.8} -test text-9.26 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.6 5.8} +test text-9.29 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 list [.t index "5.5 -4indices"] [.t index "5.7-4d indices"] -} {5.1 5.1} -test text-9.26a {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.1 5.1} +test text-9.30 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 list [.t index "5.6 -4a chars"] [.t index "5.8-4d chars"] -} {5.1 5.1} -.t delete 5.4 -.t tag add elide 5.5 5.6 -test text-9.27 {TextWidgetCmd procedure, "get" option} { +} -cleanup { + destroy .t +} -result {5.1 5.1} +test text-9.31 {TextWidgetCmd procedure, "get" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 5.2 5.4 + .t window create 5.4 + .t delete 5.4 + .t tag add elide 5.5 5.6 .t get -displaychars 5.2 5.8 -} {Grl} -.t tag delete elide -.t mark unset a -.t mark unset b -.t mark unset c -test text-9.2.1 {TextWidgetCmd procedure, "count" option} { - list [catch {.t count} msg] $msg -} {1 {wrong # args: should be ".t count ?options? index1 index2"}} -test text-9.2.2.1 {TextWidgetCmd procedure, "count" option} { - list [catch {.t count blah 1.0 2.0} msg] $msg -} {1 {bad option "blah" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels}} -test text-9.2.2 {TextWidgetCmd procedure, "count" option} { - list [catch {.t count a b} msg] $msg -} {1 {bad text index "a"}} -test text-9.2.3 {TextWidgetCmd procedure, "count" option} { - list [catch {.t count @q 3.1} msg] $msg -} {1 {bad text index "@q"}} -test text-9.2.4 {TextWidgetCmd procedure, "count" option} { - list [catch {.t count 3.1 @r} msg] $msg -} {1 {bad text index "@r"}} -test text-9.2.5 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {Grl} + + +test text-10.1 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t count ?-option value ...? index1 index2"} +test text-10.2 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count blah 1.0 2.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad option "blah" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels} +test text-10.3 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "a"} +test text-10.4 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count @q 3.1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@q"} +test text-10.5 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t count 3.1 @r +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@r"} +test text-10.6 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { .t count 5.7 5.3 -} {-4} -test text-9.2.6 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {-4} +test text-10.7 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { .t count 5.3 5.5 -} {2} -test text-9.2.7 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {2} +test text-10.8 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t count 5.3 end -} {29} -.t mark set a 5.3 -.t mark set b 5.3 -.t mark set c 5.5 -test text-9.2.8 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {29} +test text-10.9 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { .t count 5.2 5.7 -} {5} -test text-9.2.9 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {5} +test text-10.10 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { .t count 5.2 5.3 -} {1} -test text-9.2.10 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {1} +test text-10.11 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { .t count 5.2 5.4 -} {2} -test text-9.2.17 {TextWidgetCmd procedure, "count" option} { - list [catch {.t count 5.2 foo} msg] $msg -} {1 {bad text index "foo"}} -.t tag configure elide -elide 1 -.t tag add elide 2.2 3.4 -.t tag add elide 4.0 4.1 -test text-9.2.18 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {2} +test text-10.12 {TextWidgetCmd procedure, "count" option} -setup { + text .t + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t count 5.2 foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "foo"} +test text-10.13 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 .t count -displayindices 2.0 3.0 -} {2} -test text-9.2.19 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {2} +test text-10.14 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 .t count -displayindices 2.2 3.0 -} {0} -test text-9.2.20 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {0} +test text-10.15 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 .t count -displayindices 2.0 4.2 -} {5} +} -cleanup { + destroy .t +} -result {5} +test text-10.16 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 # Create one visible and one invisible window -frame .t.w1 -frame .t.w2 -.t mark set a 2.2 + frame .t.w1 + frame .t.w2 # Creating this window here means that the elidden text -# now starts at 2.3, but 'a' is automatically moved to 2.3 -.t window create 2.1 -window .t.w1 -.t window create 3.1 -window .t.w2 -test text-9.2.21 {TextWidgetCmd procedure, "count" option} { +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 .t count -displayindices 2.0 3.0 -} {3} -test text-9.2.22 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {3} +test text-10.17 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 .t count -displayindices 2.2 3.0 -} {1} -test text-9.2.23 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {1} +test text-10.18 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 + .t mark set a 2.2 +# Creating this window here means that the elidden text +# now starts at 2.3, but 'a' is automatically moved to 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 .t count -displayindices a 3.0 -} {0} -test text-9.2.24 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {0} +test text-10.19 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 .t count -displayindices 2.0 4.2 -} {6} -test text-9.2.25 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {6} +test text-10.20 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 .t count -displaychars 2.0 3.0 -} {2} -test text-9.2.26 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {2} +test text-10.21 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 .t count -displaychars 2.2 3.0 -} {1} -test text-9.2.27 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {1} +test text-10.22 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 + .t mark set a 2.2 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3, but 'a' is automatically moved to 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 .t count -displaychars a 3.0 -} {0} -test text-9.2.28 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {0} +test text-10.23 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 4.2 +} -cleanup { + destroy .t +} -result {5} +test text-10.24 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 .t count -displaychars 2.0 4.2 -} {5} -test text-9.2.29 {TextWidgetCmd procedure, "count" option} { list [.t count -indices 2.2 3.0] [.t count 2.2 3.0] -} {10 10} -test text-9.2.30 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {10 10} +test text-10.25 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 + .t mark set a 2.2 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3, but 'a' is automatically moved to 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 list [.t count -indices a 3.0] [.t count a 3.0] -} {9 9} -test text-9.2.31 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {9 9} +test text-10.26 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 4.2 .t count -indices 2.0 4.2 -} {21} -test text-9.2.32 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {21} +test text-10.27 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 4.2 .t count -chars 2.2 3.0 -} {10} -test text-9.2.33 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {10} +test text-10.28 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 + .t mark set a 2.2 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3, but 'a' is automatically moved to 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 .t count -chars a 3.0 -} {9} -test text-9.2.34 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {9} +test text-10.29 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" + .t tag configure elide -elide 1 + .t tag add elide 2.2 3.4 + .t tag add elide 4.0 4.1 +# Create one visible and one invisible window + frame .t.w1 + frame .t.w2 +# Creating this window here means that the elidden text +# now starts at 2.3 + .t window create 2.1 -window .t.w1 + .t window create 3.1 -window .t.w2 + .t count -displaychars 2.0 4.2 .t count -chars 2.0 4.2 -} {19} -destroy .t.w1 -destroy .t.w2 -set current [.t get 1.0 end-1c] -.t delete 1.0 end -.t insert end [string repeat "abcde " 50]\n -.t insert end [string repeat "fghij " 50]\n -.t insert end [string repeat "klmno " 50] -test text-9.2.35 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {19} +test text-10.30 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] .t count -lines 1.0 end -} {3} -test text-9.2.36 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {3} +test text-10.31 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] .t count -lines end 1.0 -} {-3} -test text-9.2.37 {TextWidgetCmd procedure, "count" option} { - list [catch {.t count -lines 1.0 2.0 3.0} res] $res -} {1 {bad option "1.0" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels}} -test text-9.2.38 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {-3} +test text-10.32 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] + .t count -lines 1.0 2.0 3.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad option "1.0" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels} +test text-10.33 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] .t count -lines end end -} {0} -test text-9.2.39 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {0} +test text-10.34 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] .t count -lines 1.5 2.5 -} {1} -test text-9.2.40 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {1} +test text-10.35 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] .t count -lines 2.5 "2.5 lineend" -} {0} -test text-9.2.41 {TextWidgetCmd procedure, "count" option} { +} -cleanup { + destroy .t +} -result {0} +test text-10.36 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] .t count -lines 2.7 "1.0 lineend" -} {-1} -test text-9.2.42 {TextWidgetCmd procedure, "count" option} { - set old_wrap [.t cget -wrap] +} -cleanup { + destroy .t +} -result {-1} +test text-10.37 {TextWidgetCmd procedure, "count" option} -setup { + text .t +} -body { + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] .t configure -wrap none - set res [.t count -displaylines 1.0 end] - .t configure -wrap $old_wrap - set res -} {3} -test text-9.2.43 {TextWidgetCmd procedure, "count" option} { + .t count -displaylines 1.0 end +} -cleanup { + destroy .t +} -result {3} +test text-10.38 {TextWidgetCmd procedure, "count" option} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack append . .t {top expand fill} +} -body { + .t configure -width 20 -height 10 + update + .t insert end [string repeat "abcde " 50]\n + .t insert end [string repeat "fghij " 50]\n + .t insert end [string repeat "klmno " 50] .t count -lines -chars -indices -displaylines 1.0 end -} {3 903 903 45} -.t configure -wrap none -test text-9.2.44 {TextWidgetCmd procedure, "count" option} -setup { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {3 903 903 45} +test text-10.39 {TextWidgetCmd procedure, "count" option} -setup { + text .t + pack .t update set res {} } -body { @@ -698,9 +2630,12 @@ test text-9.2.44 {TextWidgetCmd procedure, "count" option} -setup { .t tag add hidden 2.9 3.17 .t tag configure hidden -elide true lappend res [.t count -displaylines 1.19 3.24] [.t count -displaylines 1.0 end] +} -cleanup { + destroy .t } -result {2 6 1 5} test text-9.2.45 {TextWidgetCmd procedure, "count" option} -setup { - .t delete 1.0 end + text .t + pack .t update set res {} } -body { @@ -711,6 +2646,8 @@ test text-9.2.45 {TextWidgetCmd procedure, "count" option} -setup { .t tag add hidden 2.15 3.10 .t configure -wrap none set res [.t count -displaylines 2.0 3.0] +} -cleanup { + destroy .t } -result {0} test text-9.2.46 {TextWidgetCmd procedure, "count" option} -setup { toplevel .mytop @@ -735,7 +2672,8 @@ test text-9.2.46 {TextWidgetCmd procedure, "count" option} -setup { destroy .mytop } -result {1 3} test text-9.2.47 {TextWidgetCmd procedure, "count" option} -setup { - .t delete 1.0 end + text .t + pack .t update set res {} } -body { @@ -755,17 +2693,17 @@ test text-9.2.47 {TextWidgetCmd procedure, "count" option} -setup { .t count -displaylines 5.0 12.0 set y3 [lindex [.t yview] 1] list [expr {$y1 == $y2}] [expr {$y1 == $y3}] +} -cleanup { + destroy .t } -result {1 1} -# Newer tags are higher priority -.t tag configure elide1 -elide 0 -.t tag configure elide2 -elide 1 -.t tag configure elide3 -elide 0 -.t tag configure elide4 -elide 1 -test text-0.2.44.0 {counting with tag priority eliding} { - .t delete 1.0 end +test text-11.1 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack append . .t {top expand fill} +} -body { .t insert end "hello" + .t configure -wrap none list [.t count -displaychars 1.0 1.0] \ [.t count -displaychars 1.0 1.1] \ [.t count -displaychars 1.0 1.2] \ @@ -774,23 +2712,42 @@ test text-0.2.44.0 {counting with tag priority eliding} { [.t count -displaychars 1.0 1.5] \ [.t count -displaychars 1.0 1.6] \ [.t count -displaychars 1.0 2.6] \ -} {0 1 2 3 4 5 5 6} -test text-0.2.44 {counting with tag priority eliding} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {0 1 2 3 4 5 5 6} +test text-11.2 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack append . .t {top expand fill} +} -body { .t insert end "hello" + .t tag configure elide1 -elide 0 .t tag add elide1 1.2 1.4 .t count -displaychars 1.0 1.5 -} {5} -test text-0.2.45 {counting with tag priority eliding} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {5} +test text-11.3 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag add elide1 1.2 1.4 .t tag add elide2 1.2 1.4 .t count -displaychars 1.0 1.5 -} {3} -test text-0.2.46 {counting with tag priority eliding} { +} -cleanup { + destroy .t +} -result {3} +test text-11.4 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 set res {} - .t delete 1.0 end +} -body { .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag add elide1 1.2 1.4 .t tag add elide2 1.2 1.4 .t tag add elide1 1.2 1.4 lappend res [.t count -displaychars 1.0 1.5] @@ -799,11 +2756,19 @@ test text-0.2.46 {counting with tag priority eliding} { .t tag add elide1 1.2 1.4 .t tag add elide2 1.2 1.4 lappend res [.t count -displaychars 1.0 1.5] -} {3 3} -test text-0.2.47 {counting with tag priority eliding} { +} -cleanup { + destroy .t +} -result {3 3} +test text-11.5 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 set res {} - .t delete 1.0 end +} -body { .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag configure elide3 -elide 0 + .t tag add elide1 1.2 1.4 .t tag add elide2 1.2 1.4 .t tag add elide3 1.2 1.4 lappend res [.t count -displaychars 1.0 1.5] @@ -812,11 +2777,19 @@ test text-0.2.47 {counting with tag priority eliding} { .t tag add elide3 1.2 1.4 .t tag add elide3 1.2 1.4 lappend res [.t count -displaychars 1.0 1.5] -} {5 5} -test text-0.2.48 {counting with tag priority eliding} { +} -cleanup { + destroy .t +} -result {5 5} +test text-11.6 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 set res {} - .t delete 1.0 end +} -body { .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag configure elide3 -elide 0 + .t tag configure elide4 -elide 1 .t tag add elide2 1.2 1.4 .t tag add elide3 1.2 1.4 .t tag add elide4 1.2 1.4 @@ -829,10 +2802,17 @@ test text-0.2.48 {counting with tag priority eliding} { .t tag add elide2 1.2 1.4 .t tag add elide3 1.2 1.4 lappend res [.t count -displaychars 1.0 1.5] -} {3 3} -test text-0.2.49 {counting with tag priority eliding} { +} -cleanup { + destroy .t +} -result {3 3} +test text-11.7 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 set res {} - .t delete 1.0 end +} -body { +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 + .t tag configure elide3 -elide 0 .t insert end "hello" .t tag add elide2 1.2 1.4 .t tag add elide3 1.2 1.4 @@ -844,11 +2824,18 @@ test text-0.2.49 {counting with tag priority eliding} { .t tag add elide2 1.2 1.4 .t tag add elide3 1.2 1.4 lappend res [.t count -displaychars 1.0 1.5] -} {5 5} -test text-0.2.50 {counting with tag priority eliding} { +} -cleanup { + destroy .t +} -result {5 5} +test text-11.8 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack append . .t {top expand fill} set res {} - .t delete 1.0 end +} -body { .t insert end "hello" +# Newer tags are higher priority + .t tag configure elide1 -elide 0 + .t tag configure elide2 -elide 1 .t tag add elide2 1.0 1.5 .t tag add elide1 1.2 1.4 lappend res [.t count -displaychars 1.0 1.5] @@ -863,10 +2850,14 @@ test text-0.2.50 {counting with tag priority eliding} { lappend res [.t count -displaychars 1.1 1.5] lappend res [.t count -displaychars 1.2 1.5] lappend res [.t count -displaychars 1.3 1.5] -} {0 0 0 0 3 2 1 1} -test text-0.2.51 {counting with tag priority eliding} { +} -cleanup { + destroy .t +} -result {0 0 0 0 3 2 1 1} +test text-11.9 {counting with tag priority eliding} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack append . .t {top expand fill} set res {} - .t delete 1.0 end +} -body { .t tag configure WELCOME -elide 1 .t tag configure SYSTEM -elide 0 .t tag configure TRAFFIC -elide 1 @@ -887,225 +2878,410 @@ test text-0.2.51 {counting with tag priority eliding} { lappend res [.t index "end -2 indices"] lappend res [.t index "end -2 display indices"] lappend res [.t index "end -2 display chars"] -} {1 0 0 1 0 2.0 4.0 4.0 4.0 3.0 3.0 3.0 2.0 1.0 1.0} - -.t delete 1.0 end -.t insert end $current -unset current - -test text-10.1 {TextWidgetCmd procedure, "index" option} { - list [catch {.t index} msg] $msg -} {1 {wrong # args: should be ".t index index"}} -test text-10.2 {TextWidgetCmd procedure, "index" option} { - list [catch {.t ind a b} msg] $msg -} {1 {wrong # args: should be ".t index index"}} -test text-10.3 {TextWidgetCmd procedure, "index" option} { - list [catch {.t in a b} msg] $msg -} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} -test text-10.4 {TextWidgetCmd procedure, "index" option} { - list [catch {.t index @xyz} msg] $msg -} {1 {bad text index "@xyz"}} -test text-10.5 {TextWidgetCmd procedure, "index" option} { +} -cleanup { + destroy .t +} -result {1 0 0 1 0 2.0 4.0 4.0 4.0 3.0 3.0 3.0 2.0 1.0 1.0} + + +test text-12.1 {TextWidgetCmd procedure, "index" option} -setup { + text .t +} -body { + .t index +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t index index"} +test text-12.2 {TextWidgetCmd procedure, "index" option} -setup { + text .t +} -body { + .t ind a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t index index"} +test text-12.3 {TextWidgetCmd procedure, "index" option} -setup { + text .t +} -body { + .t in a b +} -cleanup { + destroy .t +} -returnCodes {error} -result {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview} +test text-12.4 {TextWidgetCmd procedure, "index" option} -setup { + text .t +} -body { + .t index @xyz +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "@xyz"} +test text-12.5 {TextWidgetCmd procedure, "index" option} -setup { + [text .t] insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { .t index 1.2 -} 1.2 +} -cleanup { + destroy .t +} -result 1.2 + -test text-11.1 {TextWidgetCmd procedure, "insert" option} { - list [catch {.t insert 1.2} msg] $msg -} {1 {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"}} -test text-11.2 {TextWidgetCmd procedure, "insert" option} { +test text-13.1 {TextWidgetCmd procedure, "insert" option} -setup { + [text .t] insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" +} -body { + .t insert 1.2 +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"} +test text-13.2 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t config -state disabled .t insert 1.2 xyzzy .t get 1.0 1.end -} {Line 1} -.t config -state normal -test text-11.3 {TextWidgetCmd procedure, "insert" option} { +} -cleanup { + destroy .t +} -result {Line 1} +test text-13.3 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t insert 1.2 xyzzy .t get 1.0 1.end -} {Lixyzzyne 1} -test text-11.4 {TextWidgetCmd procedure, "insert" option} { +} -cleanup { + destroy .t +} -result {Lixyzzyne 1} +test text-13.4 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Line 1 +aefghijklm +12345 +Line 4 +bOy GIrl .#@? x_yz +!@#$% +Line 7" .t delete 1.0 end .t insert 1.0 "Sample text" x .t tag ranges x -} {1.0 1.11} -test text-11.5 {TextWidgetCmd procedure, "insert" option} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {1.0 1.11} +test text-13.5 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { .t insert 1.0 "Sample text" x .t insert 1.2 "XYZ" y list [.t tag ranges x] [.t tag ranges y] -} {{1.0 1.2 1.5 1.14} {1.2 1.5}} -test text-11.6 {TextWidgetCmd procedure, "insert" option} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {{1.0 1.2 1.5 1.14} {1.2 1.5}} +test text-13.6 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { .t insert 1.0 "Sample text" {x y z} list [.t tag ranges x] [.t tag ranges y] [.t tag ranges z] -} {{1.0 1.11} {1.0 1.11} {1.0 1.11}} -test text-11.7 {TextWidgetCmd procedure, "insert" option} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {{1.0 1.11} {1.0 1.11} {1.0 1.11}} +test text-13.7 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { .t insert 1.0 "Sample text" {x y z} .t insert 1.3 "A" {a b z} list [.t tag ranges a] [.t tag ranges b] [.t tag ranges x] [.t tag ranges y] [.t tag ranges z] -} {{1.3 1.4} {1.3 1.4} {1.0 1.3 1.4 1.12} {1.0 1.3 1.4 1.12} {1.0 1.12}} -test text-11.8 {TextWidgetCmd procedure, "insert" option} { - .t delete 1.0 end - list [catch {.t insert 1.0 "Sample text" "a \{b"} msg] $msg -} {1 {unmatched open brace in list}} -test text-11.9 {TextWidgetCmd procedure, "insert" option} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {{1.3 1.4} {1.3 1.4} {1.0 1.3 1.4 1.12} {1.0 1.3 1.4 1.12} {1.0 1.12}} +test text-13.8 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { + .t insert 1.0 "Sample text" "a \{b" +} -cleanup { + destroy .t +} -returnCodes {error} -result {unmatched open brace in list} +test text-13.9 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { .t insert 1.0 "First" bold " " {} second "x y z" " third" list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges x] \ [.t tag ranges y] [.t tag ranges z] -} {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}} -test text-11.10 {TextWidgetCmd procedure, "insert" option} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}} +test text-13.10 {TextWidgetCmd procedure, "insert" option} -setup { + text .t +} -body { .t insert 1.0 "First" bold " second" silly list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly] -} {{First second} {1.0 1.5} {1.5 1.12}} +} -cleanup { + destroy .t +} -result {{First second} {1.0 1.5} {1.5 1.12}} # Edit, mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere. -test text-12.1 {ConfigureText procedure} { - list [catch {.t2 configure -state foobar} msg] $msg -} {1 {bad state "foobar": must be disabled or normal}} -test text-12.2 {ConfigureText procedure} { - .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1 - list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3] -} {0 1 1} -test text-12.3 {ConfigureText procedure} { - .t2 configure -spacing1 1 -spacing2 -1 -spacing3 1 - list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3] -} {1 0 1} -test text-12.4 {ConfigureText procedure} { - .t2 configure -spacing1 1 -spacing2 1 -spacing3 -3 - list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3] -} {1 1 0} -test text-12.5 {ConfigureText procedure} { - set x [list [catch {.t2 configure -tabs {30 foo}} msg] $msg $errorInfo] - .t2 configure -tabs {10 20 30} - set x -} {1 {bad tab alignment "foo": must be left, right, center, or numeric} {bad tab alignment "foo": must be left, right, center, or numeric +test text-14.1 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -state foobar +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad state "foobar": must be disabled or normal} +test text-14.2 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -spacing1 -2 -spacing2 1 -spacing3 1 + list [.t cget -spacing1] [.t cget -spacing2] [.t cget -spacing3] +} -cleanup { + destroy .t +} -result {0 1 1} +test text-14.3 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -spacing1 1 -spacing2 -1 -spacing3 1 + list [.t cget -spacing1] [.t cget -spacing2] [.t cget -spacing3] +} -cleanup { + destroy .t +} -result {1 0 1} +test text-14.4 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -spacing1 1 -spacing2 1 -spacing3 -3 + list [.t cget -spacing1] [.t cget -spacing2] [.t cget -spacing3] +} -cleanup { + destroy .t +} -result {1 1 0} +test text-14.5 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -tabs {30 foo} +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad tab alignment "foo": must be left, right, center, or numeric} +test text-14.6 {ConfigureText procedure} -setup { + text .t +} -body { + catch {.t configure -tabs {30 foo}} + .t configure -tabs {10 20 30} + return $errorInfo +} -cleanup { + destroy .t +} -result {bad tab alignment "foo": must be left, right, center, or numeric (while processing -tabs option) invoked from within -".t2 configure -tabs {30 foo}"}} -test text-12.6 {ConfigureText procedure} { - .t2 configure -tabs {10 20 30} - .t2 configure -tabs {} - .t2 cget -tabs -} {} -test text-12.7 {ConfigureText procedure} { - list [catch {.t2 configure -wrap bogus} msg] $msg -} {1 {bad wrap "bogus": must be char, none, or word}} -test text-12.8 {ConfigureText procedure} { - .t2 configure -selectborderwidth 17 -selectforeground #332211 \ +".t configure -tabs {30 foo}"} +test text-14.7 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -tabs {10 20 30} + .t configure -tabs {} + .t cget -tabs +} -cleanup { + destroy .t +} -result {} +test text-14.8 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -wrap bogus +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad wrap "bogus": must be char, none, or word} +test text-14.9 {ConfigureText procedure} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .t configure -selectborderwidth 17 -selectforeground #332211 \ -selectbackground #abc - list [lindex [.t2 tag config sel -borderwidth] 4] \ - [lindex [.t2 tag config sel -foreground] 4] \ - [lindex [.t2 tag config sel -background] 4] -} {17 #332211 #abc} -test text-12.9 {ConfigureText procedure} { - .t2 configure -selectborderwidth {} - .t2 tag cget sel -borderwidth -} {} -test text-12.10 {ConfigureText procedure} { - list [catch {.t2 configure -selectborderwidth foo} msg] $msg -} {1 {bad screen distance "foo"}} -test text-12.11 {ConfigureText procedure} { - catch {destroy .t2} + list [lindex [.t tag config sel -borderwidth] 4] \ + [lindex [.t tag config sel -foreground] 4] \ + [lindex [.t tag config sel -background] 4] +} -cleanup { + destroy .t +} -result {17 #332211 #abc} +test text-14.10 {ConfigureText procedure} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .t configure -selectborderwidth {} + .t tag cget sel -borderwidth +} -cleanup { + destroy .t +} -result {} +test text-14.11 {ConfigureText procedure} -setup { + text .t +} -body { + .t configure -selectborderwidth foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad screen distance "foo"} +test text-14.12 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 .t.e select to 2 text .t2 -exportselection 1 selection get -} {ab} -test text-12.12 {ConfigureText procedure} { - catch {destroy .t2} +} -cleanup { + destroy .t .t2 +} -result {ab} +test text-14.13 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 .t.e select to 2 text .t2 -exportselection 0 .t2 insert insert 1234657890 .t2 tag add sel 1.0 1.4 selection get -} {ab} -test text-12.13 {ConfigureText procedure} { - catch {destroy .t2} +} -cleanup { + destroy .t .t2 +} -result {ab} +test text-14.14 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 .t.e select to 1 text .t2 -exportselection 1 .t2 insert insert 1234657890 .t2 tag add sel 1.0 1.4 selection get -} {1234} -test text-12.14 {ConfigureText procedure} { - catch {destroy .t2} +} -cleanup { + destroy .t .t2 +} -result {1234} +test text-14.15 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 .t.e select to 1 text .t2 -exportselection 0 .t2 insert insert 1234657890 .t2 tag add sel 1.0 1.4 .t2 configure -exportselection 1 selection get -} {1234} -test text-12.15 {ConfigureText procedure} { - catch {destroy .t2} +} -cleanup { + destroy .t2 .t +} -result {1234} +test text-14.16 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 + text .t2 -exportselection 1 + .t2 insert insert 1234657890 + .t2 tag add sel 1.0 1.4 + selection get + .t2 configure -exportselection 0 + selection get +} -cleanup { + destroy .t .t2 +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test text-14.17 {ConfigureText procedure} -body { + text .t + entry .t.e + .t.e insert end abcdefg + .t.e select from 0 text .t2 -exportselection 1 .t2 insert insert 1234657890 .t2 tag add sel 1.0 1.4 set result [selection get] .t2 configure -exportselection 0 - lappend result [catch {selection get} msg] $msg -} {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}} -test text-12.16 {ConfigureText procedure} {fonts} { - # This test is non-portable because the window size will vary depending - # on the font size, which can vary. - catch {destroy .t2} - toplevel .t2 - text .t2.t -width 20 -height 10 - pack append .t2 .t2.t top - wm geometry .t2 +0+0 - update - wm geometry .t2 -} {150x140+0+0} -test text-12.17 {ConfigureText procedure} { - # This test was failing Windows because the title bar on .t2 - # was a certain minimum size and it was interfering with the size - # requested by the -setgrid. The "overrideredirect" gets rid of the - # titlebar so the toplevel can shrink to the appropriate size. - catch {destroy .t2} - toplevel .t2 - wm overrideredirect .t2 1 - text .t2.t -width 20 -height 10 -setgrid 1 - pack append .t2 .t2.t top - wm geometry .t2 +0+0 - update - wm geometry .t2 -} {20x10+0+0} -test text-12.18 {ConfigureText procedure} { - # This test was failing on Windows because the title bar on .t2 - # was a certain minimum size and it was interfering with the size - # requested by the -setgrid. The "overrideredirect" gets rid of the - # titlebar so the toplevel can shrink to the appropriate size. - catch {destroy .t2} - toplevel .t2 - wm overrideredirect .t2 1 - text .t2.t -width 20 -height 10 -setgrid 1 - pack append .t2 .t2.t top - wm geometry .t2 +0+0 - update - set result [wm geometry .t2] - wm geometry .t2 15x8 - update - lappend result [wm geometry .t2] - .t2.t configure -wrap word - update - lappend result [wm geometry .t2] -} {20x10+0+0 15x8+0+0 15x8+0+0} - -test text-13.1 {TextWorldChanged procedure, spacing options} fonts { - catch {destroy .t2} - text .t2 -width 20 -height 10 - set result [winfo reqheight .t2] - .t2 configure -spacing1 2 - lappend result [winfo reqheight .t2] - .t2 configure -spacing3 1 - lappend result [winfo reqheight .t2] - .t2 configure -spacing1 0 - lappend result [winfo reqheight .t2] -} {140 160 170 150} - -test text-14.1 {TextEventProc procedure} { + catch {selection get} + return $result +} -cleanup { + destroy .t .t2 +} -result {1234} +test text-14.18 {ConfigureText procedure} -constraints fonts -setup { + toplevel .top + text .top.t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .top.t configure -width 20 -height 10 + pack append .top .top.t top + update + set geom [wm geometry .top] + set x [string range $geom 0 [string first + $geom]] +} -cleanup { + destroy .top +} -result {150x140+} +# This test was failing Windows because the title bar on .t was a certain +# minimum size and it was interfering with the size requested by the -setgrid. +# The "overrideredirect" gets rid of the titlebar so the toplevel can shrink +# to the appropriate size. +test text-14.19 {ConfigureText procedure} -setup { + toplevel .top + text .top.t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .top.t configure -width 20 -height 10 -setgrid 1 + wm overrideredirect .top 1 + pack append .top .top.t top + wm geometry .top +0+0 + update + wm geometry .top +} -cleanup { + destroy .top +} -result {20x10+0+0} +# This test was failing on Windows because the title bar on .t was a certain +# minimum size and it was interfering with the size requested by the -setgrid. +# The "overrideredirect" gets rid of the titlebar so the toplevel can shrink +# to the appropriate size. +test text-14.20 {ConfigureText procedure} -setup { + toplevel .top + text .top.t -font {Courier -12} -borderwidth 2 -highlightthickness 2 +} -body { + .top.t configure -width 20 -height 10 -setgrid 1 + wm overrideredirect .top 1 + pack append .top .top.t top + wm geometry .top +0+0 + update + set result [wm geometry .top] + wm geometry .top 15x8 + update + lappend result [wm geometry .top] + .top.t configure -wrap word + update + lappend result [wm geometry .top] +} -cleanup { + destroy .top +} -result {20x10+0+0 15x8+0+0 15x8+0+0} + + +test text-15.1 {TextWorldChanged procedure, spacing options} -constraints { + fonts +} -body { + text .t -width 20 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + set result [winfo reqheight .t] + .t configure -spacing1 2 + lappend result [winfo reqheight .t] + .t configure -spacing3 1 + lappend result [winfo reqheight .t] + .t configure -spacing1 0 + lappend result [winfo reqheight .t] +} -cleanup { + destroy .t +} -result {140 160 170 150} + + +test text-16.1 {TextEventProc procedure} -body { text .tx1 -bg #543210 rename .tx1 .tx2 set x {} @@ -1113,266 +3289,364 @@ test text-14.1 {TextEventProc procedure} { lappend x [.tx2 cget -bg] destroy .tx1 lappend x [info command .tx*] [winfo exists .tx1] [winfo exists .tx2] -} {1 #543210 {} 0 0} +} -cleanup { + destroy .txt1 +} -result {1 #543210 {} 0 0} + -test text-15.1 {TextCmdDeletedProc procedure} { +test text-17.1 {TextCmdDeletedProc procedure} -body { text .tx1 rename .tx1 {} list [info command .tx*] [winfo exists .tx1] -} {{} 0} -test text-15.2 {TextCmdDeletedProc procedure, disabling -setgrid} fonts { - catch {destroy .top} - toplevel .top - wm geom .top +0+0 - text .top.t -setgrid 1 -width 20 -height 10 - pack .top.t - update - set x [wm geometry .top] - rename .top.t {} - update - lappend x [wm geometry .top] +} -cleanup { + destroy .txt1 +} -result {{} 0} +test text-17.2 {TextCmdDeletedProc procedure, disabling -setgrid} -constraints { + fonts +} -body { + toplevel .top + text .top.t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} \ + -setgrid 1 -width 20 -height 10 + pack .top.t + update + set geom [wm geometry .top] + set x [string range $geom 0 [string first + $geom]] + rename .top.t {} + update + set geom [wm geometry .top] + lappend x [string range $geom 0 [string first + $geom]] + return $x +} -cleanup { destroy .top - set x -} {20x10+0+0 150x140+0+0} +} -result {20x10+ 150x140+} -test text-16.1 {InsertChars procedure} { - catch {destroy .t2} - text .t2 - .t2 insert 2.0 abcd\n - .t2 get 1.0 end -} {abcd + +test text-18.1 {InsertChars procedure} -body { + text .t + .t insert 2.0 abcd\n + .t get 1.0 end +} -cleanup { + destroy .t +} -result {abcd } -test text-16.2 {InsertChars procedure} { - catch {destroy .t2} - text .t2 - .t2 insert 1.0 abcd\n - .t2 insert end 123\n - .t2 get 1.0 end -} {abcd +test text-18.2 {InsertChars procedure} -body { + text .t + .t insert 1.0 abcd\n + .t insert end 123\n + .t get 1.0 end +} -cleanup { + destroy .t +} -result {abcd 123 } -test text-16.3 {InsertChars procedure} { - catch {destroy .t2} - text .t2 - .t2 insert 1.0 abcd\n - .t2 insert 10.0 123 - .t2 get 1.0 end -} {abcd +test text-18.3 {InsertChars procedure} -body { + text .t + .t insert 1.0 abcd\n + .t insert 10.0 123 + .t get 1.0 end +} -cleanup { + destroy .t +} -result {abcd 123 } -test text-16.4 {InsertChars procedure, inserting on top visible line} { - catch {destroy .t2} - text .t2 -width 20 -height 4 -wrap word - pack .t2 - .t2 insert insert "Now is the time for all great men to come to the " - .t2 insert insert "aid of their party.\n" - .t2 insert insert "Now is the time for all great men.\n" - .t2 see end - update - .t2 insert 1.0 "Short\n" - .t2 index @0,0 -} {2.56} -test text-16.5 {InsertChars procedure, inserting on top visible line} { - catch {destroy .t2} - text .t2 -width 20 -height 4 -wrap word - pack .t2 - .t2 insert insert "Now is the time for all great men to come to the " - .t2 insert insert "aid of their party.\n" - .t2 insert insert "Now is the time for all great men.\n" - .t2 see end - update - .t2 insert 1.55 "Short\n" - .t2 index @0,0 -} {2.0} -test text-16.6 {InsertChars procedure, inserting on top visible line} { - catch {destroy .t2} - text .t2 -width 20 -height 4 -wrap word - pack .t2 - .t2 insert insert "Now is the time for all great men to come to the " - .t2 insert insert "aid of their party.\n" - .t2 insert insert "Now is the time for all great men.\n" - .t2 see end - update - .t2 insert 1.56 "Short\n" - .t2 index @0,0 -} {1.56} -test text-16.7 {InsertChars procedure, inserting on top visible line} { - catch {destroy .t2} - text .t2 -width 20 -height 4 -wrap word - pack .t2 - .t2 insert insert "Now is the time for all great men to come to the " - .t2 insert insert "aid of their party.\n" - .t2 insert insert "Now is the time for all great men.\n" - .t2 see end - update - .t2 insert 1.57 "Short\n" - .t2 index @0,0 -} {1.56} -catch {destroy .t2} - -proc setup {} { - .t delete 1.0 end +test text-18.4 {InsertChars procedure, inserting on top visible line} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t +} -body { + .t configure -width 20 -height 4 -wrap word + .t insert insert "Now is the time for all great men to come to the " + .t insert insert "aid of their party.\n" + .t insert insert "Now is the time for all great men.\n" + .t see end + update + .t insert 1.0 "Short\n" + .t index @0,0 +} -cleanup { + destroy .t +} -result {2.56} +test text-18.5 {InsertChars procedure, inserting on top visible line} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t +} -body { + .t configure -width 20 -height 4 -wrap word + .t insert insert "Now is the time for all great men to come to the " + .t insert insert "aid of their party.\n" + .t insert insert "Now is the time for all great men.\n" + .t see end + update + .t insert 1.55 "Short\n" + .t index @0,0 +} -cleanup { + destroy .t +} -result {2.0} +test text-18.6 {InsertChars procedure, inserting on top visible line} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t +} -body { + .t configure -width 20 -height 4 -wrap word + .t insert insert "Now is the time for all great men to come to the " + .t insert insert "aid of their party.\n" + .t insert insert "Now is the time for all great men.\n" + .t see end + update + .t insert 1.56 "Short\n" + .t index @0,0 +} -cleanup { + destroy .t +} -result {1.56} +test text-18.7 {InsertChars procedure, inserting on top visible line} -setup { + text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .t +} -body { + .t configure -width 20 -height 4 -wrap word + .t insert insert "Now is the time for all great men to come to the " + .t insert insert "aid of their party.\n" + .t insert insert "Now is the time for all great men.\n" + .t see end + update + .t insert 1.57 "Short\n" + .t index @0,0 +} -cleanup { + destroy .t +} -result {1.56} + + +test text-19.1 {DeleteChars procedure} -body { + text .t + .t get 1.0 end +} -cleanup { + destroy .t +} -result { +} +test text-19.2 {DeleteChars procedure} -body { + text .t + .t delete foobar +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "foobar"} +test text-19.3 {DeleteChars procedure} -body { + text .t + .t delete 1.0 lousy +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "lousy"} +test text-19.4 {DeleteChars procedure} -body { + text .t .t insert 1.0 "Line 1 abcde 12345 Line 4" -} - -.t delete 1.0 end -test text-17.1 {DeleteChars procedure} { - .t get 1.0 end -} { -} -test text-17.2 {DeleteChars procedure} { - list [catch {.t delete foobar} msg] $msg -} {1 {bad text index "foobar"}} -test text-17.3 {DeleteChars procedure} { - list [catch {.t delete 1.0 lousy} msg] $msg -} {1 {bad text index "lousy"}} -test text-17.4 {DeleteChars procedure} { - setup .t delete 2.1 .t get 1.0 end -} {Line 1 +} -cleanup { + destroy .t +} -result {Line 1 acde 12345 Line 4 } -test text-17.5 {DeleteChars procedure} { - setup +test text-19.5 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" .t delete 2.3 .t get 1.0 end -} {Line 1 +} -cleanup { + destroy .t +} -result {Line 1 abce 12345 Line 4 } -test text-17.6 {DeleteChars procedure} { - setup +test text-19.6 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" .t delete 2.end .t get 1.0 end -} {Line 1 +} -cleanup { + destroy .t +} -result {Line 1 abcde12345 Line 4 } -test text-17.7 {DeleteChars procedure} { - setup +test text-19.7 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" .t tag add sel 4.2 end .t delete 4.2 end list [.t tag ranges sel] [.t get 1.0 end] -} {{} {Line 1 +} -cleanup { + destroy .t +} -result {{} {Line 1 abcde 12345 Li }} -test text-17.8 {DeleteChars procedure} { - setup +test text-19.8 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" .t tag add sel 1.0 end .t delete 4.0 end list [.t tag ranges sel] [.t get 1.0 end] -} {{1.0 4.0} {Line 1 +} -cleanup { + destroy .t +} -result {{1.0 4.0} {Line 1 abcde 12345 }} -test text-17.9 {DeleteChars procedure} { - setup +test text-19.9 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" .t delete 2.2 2.2 .t get 1.0 end -} {Line 1 +} -cleanup { + destroy .t +} -result {Line 1 abcde 12345 Line 4 } -test text-17.10 {DeleteChars procedure} { - setup +test text-19.10 {DeleteChars procedure} -body { + text .t + .t insert 1.0 "Line 1 +abcde +12345 +Line 4" .t delete 2.3 2.1 .t get 1.0 end -} {Line 1 +} -cleanup { + destroy .t +} -result {Line 1 abcde 12345 Line 4 } -test text-17.11 {DeleteChars procedure} { - catch {destroy .t2} - toplevel .t2 - text .t2.t -width 20 -height 5 - pack append .t2 .t2.t top - wm geometry .t2 +0+0 - .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns" - update - .t2.t delete 1.0 3.0 - list [.t2.t index @0,0] [.t2.t get @0,0] -} {1.0 x} -test text-17.12 {DeleteChars procedure} { - catch {destroy .t2} - toplevel .t2 - text .t2.t -width 20 -height 5 - pack append .t2 .t2.t top - wm geometry .t2 +0+0 - .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns" - .t2.t yview 3.0 - update - .t2.t delete 2.0 4.0 - list [.t2.t index @0,0] [.t2.t get @0,0] -} {2.0 y} -catch {destroy .t2} -toplevel .t2 -text .t2.t -width 1 -height 10 -wrap char -frame .t2.f -width 200 -height 20 -relief raised -bd 2 -pack .t2.f .t2.t -side left -wm geometry .t2 +0+0 -update -test text-17.13 {DeleteChars procedure, updates affecting topIndex} { - .t2.t delete 1.0 end - .t2.t insert end "abcde\n12345\nqrstuv" - .t2.t yview 2.1 - .t2.t delete 1.4 2.3 - .t2.t index @0,0 -} {1.2} -test text-17.14 {DeleteChars procedure, updates affecting topIndex} { - .t2.t delete 1.0 end - .t2.t insert end "abcde\n12345\nqrstuv" - .t2.t yview 2.1 - .t2.t delete 2.3 2.4 - .t2.t index @0,0 -} {2.0} -test text-17.15 {DeleteChars procedure, updates affecting topIndex} { - .t2.t delete 1.0 end - .t2.t insert end "abcde\n12345\nqrstuv" - .t2.t yview 1.3 - .t2.t delete 1.0 1.2 - .t2.t index @0,0 -} {1.1} -test text-17.16 {DeleteChars procedure, updates affecting topIndex} { - catch {destroy .t2} - toplevel .t2 - text .t2.t -width 6 -height 10 -wrap word - frame .t2.f -width 200 -height 20 -relief raised -bd 2 - pack .t2.f .t2.t -side left - wm geometry .t2 +0+0 - update - .t2.t insert end "abc def\n01 2345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n" - .t2.t yview 2.4 - .t2.t delete 2.5 - set x [.t2.t index @0,0] - .t2.t delete 2.5 - list $x [.t2.t index @0,0] -} {2.3 2.0} - -.t delete 1.0 end -foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { - .t insert end $i.0$i.1$i.2$i.3$i.4\n -} -test text-18.1 {TextFetchSelection procedure} { +test text-19.11 {DeleteChars procedure} -body { + toplevel .top + text .top.t -width 20 -height 5 + pack append .top .top.t top + wm geometry .top +0+0 + .top.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns" + update + .top.t delete 1.0 3.0 + list [.top.t index @0,0] [.top.t get @0,0] +} -cleanup { + destroy .top +} -result {1.0 x} +test text-19.12 {DeleteChars procedure} -body { + toplevel .top + text .top.t -width 20 -height 5 + pack append .top .top.t top + wm geometry .top +0+0 + .top.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns" + .top.t yview 3.0 + update + .top.t delete 2.0 4.0 + list [.top.t index @0,0] [.top.t get @0,0] +} -cleanup { + destroy .top +} -result {2.0 y} +test text-19.13 {DeleteChars procedure, updates affecting topIndex} -setup { + toplevel .top + text .top.t -width 1 -height 10 -wrap char + pack .top.t -side left + wm geometry .top +0+0 + update +} -body { + .top.t insert end "abcde\n12345\nqrstuv" + .top.t yview 2.1 + .top.t delete 1.4 2.3 + .top.t index @0,0 +} -cleanup { + destroy .top +} -result {1.2} +test text-19.14 {DeleteChars procedure, updates affecting topIndex} -setup { + toplevel .top + text .top.t -width 1 -height 10 -wrap char + pack .top.t -side left + wm geometry .top +0+0 + update +} -body { + .top.t insert end "abcde\n12345\nqrstuv" + .top.t yview 2.1 + .top.t delete 2.3 2.4 + .top.t index @0,0 +} -cleanup { + destroy .top +} -result {2.0} +test text-19.15 {DeleteChars procedure, updates affecting topIndex} -setup { + toplevel .top + text .top.t -width 1 -height 10 -wrap char + pack .top.t -side left + wm geometry .top +0+0 + update +} -body { + .top.t insert end "abcde\n12345\nqrstuv" + .top.t yview 1.3 + .top.t delete 1.0 1.2 + .top.t index @0,0 +} -cleanup { + destroy .top +} -result {1.1} +test text-19.16 {DeleteChars procedure, updates affecting topIndex} -setup { + toplevel .top + text .top.t -width 6 -height 10 -wrap word + frame .top.f -width 200 -height 20 -relief raised -bd 2 + pack .top.f .top.t -side left + wm geometry .top +0+0 + update +} -body { + .top.t insert end "abc def\n01 2345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n" + .top.t yview 2.4 + .top.t delete 2.5 + set x [.top.t index @0,0] + .top.t delete 2.5 + list $x [.top.t index @0,0] +} -cleanup { + destroy .top +} -result {2.3 2.0} + + +test text-20.1 {TextFetchSelection procedure} -setup { + text .t -width 20 -height 10 + pack append . .t {top expand fill} + update +} -body { + foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { + .t insert end $i.0$i.1$i.2$i.3$i.4\n + } .t tag add sel 1.3 3.4 selection get -} {a.1a.2a.3a.4 +} -cleanup { + destroy .t +} -result {a.1a.2a.3a.4 b.0b.1b.2b.3b.4 c.0c} -test text-18.2 {TextFetchSelection procedure} { +test text-20.2 {TextFetchSelection procedure} -setup { + text .t -width 20 -height 10 + pack append . .t {top expand fill} + update +} -body { + foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { + .t insert end $i.0$i.1$i.2$i.3$i.4\n + } .t tag add x 1.2 .t tag add x 1.4 .t tag add x 2.0 @@ -1380,15 +3654,33 @@ test text-18.2 {TextFetchSelection procedure} { .t tag remove sel 1.0 end .t tag add sel 1.0 3.4 selection get -} {a.0a.1a.2a.3a.4 +} -cleanup { + destroy .t +} -result {a.0a.1a.2a.3a.4 b.0b.1b.2b.3b.4 c.0c} -test text-18.3 {TextFetchSelection procedure} { +test text-20.3 {TextFetchSelection procedure} -setup { + text .t -width 20 -height 10 + pack append . .t {top expand fill} + update +} -body { + foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { + .t insert end $i.0$i.1$i.2$i.3$i.4\n + } .t tag remove sel 1.0 end .t tag add sel 13.3 selection get -} {m} -test text-18.4 {TextFetchSelection procedure} { +} -cleanup { + destroy .t +} -result {m} +test text-20.4 {TextFetchSelection procedure} -setup { + text .t -width 20 -height 10 + pack append . .t {top expand fill} + update +} -body { + foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} { + .t insert end $i.0$i.1$i.2$i.3$i.4\n + } .t tag remove x 1.0 end .t tag add sel 1.0 3.4 .t tag remove sel 1.0 end @@ -1397,674 +3689,1043 @@ test text-18.4 {TextFetchSelection procedure} { .t tag add sel 10.0 10.end .t tag add sel 13.3 selection get -} {0a..1b.2b.3b.4 +} -cleanup { + destroy .t +} -result {0a..1b.2b.3b.4 cj.0j.1j.2j.3j.4m} -set x "" -for {set i 1} {$i < 200} {incr i} { - append x "This is line $i, padded to just about 53 characters.\n" -} -test text-18.5 {TextFetchSelection procedure, long selections} { - .t delete 1.0 end +test text-20.5 {TextFetchSelection procedure, long selections} -setup { + text .t -width 20 -height 10 + pack append . .t {top expand fill} + update + set x "" +} -body { + for {set i 1} {$i < 200} {incr i} { + append x "This is line $i, padded to just about 53 characters.\n" + } .t insert end $x .t tag add sel 1.0 end - selection get -} $x\n + expr {[selection get] eq "$x\n"} +} -cleanup { + destroy .t +} -result {1} + -test text-19.1 {TkTextLostSelection procedure} unix { - catch {destroy .t2} +test text-21.1 {TkTextLostSelection procedure} -constraints unix -setup { + text .t + .t insert 1.0 "Line 1" + entry .t.e + .t.e insert end "abcdefg" text .t2 .t2 insert 1.0 "abc\ndef\nghijk\n1234" +} -body { .t2 tag add sel 1.2 3.3 + .t.e select from 0 .t.e select to 1 .t2 tag ranges sel -} {} -test text-19.2 {TkTextLostSelection procedure} win { - catch {destroy .t2} +} -cleanup { + destroy .t .t2 +} -result {} +test text-21.2 {TkTextLostSelection procedure} -constraints win -setup { + text .t + .t insert 1.0 "Line 1" + entry .t.e + .t.e insert end "abcdefg" text .t2 .t2 insert 1.0 "abc\ndef\nghijk\n1234" +} -body { .t2 tag add sel 1.2 3.3 + .t.e select from 0 .t.e select to 1 .t2 tag ranges sel -} {1.2 3.3} -catch {destroy .t2} -test text-19.3 {TkTextLostSelection procedure} { - catch {destroy .t2} - text .t2 - .t2 insert 1.0 "abcdef\nghijk\n1234" - .t2 tag add sel 1.0 1.3 +} -cleanup { + destroy .t .t2 +} -result {1.2 3.3} +test text-21.3 {TkTextLostSelection procedure} -body { + text .t + .t insert 1.0 "abcdef\nghijk\n1234" + .t tag add sel 1.0 1.3 + selection get + selection clear + selection get +} -cleanup { + destroy .t +} -returnCodes error -result {PRIMARY selection doesn't exist or form "STRING" not defined} +test text-21.4 {TkTextLostSelection procedure} -body { + text .t + .t insert 1.0 "abcdef\nghijk\n1234" + .t tag add sel 1.0 1.3 set x [selection get] selection clear - lappend x [catch {selection get} msg] $msg - .t2 tag add sel 1.0 1.3 + catch {selection get} + .t tag add sel 1.0 1.3 lappend x [selection get] -} {abc 1 {PRIMARY selection doesn't exist or form "STRING" not defined} abc} - -.t delete 1.0 end -.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" -test text-20.1 {TextSearchCmd procedure, argument parsing} { - list [catch {.t search -} msg] $msg -} {1 {bad switch "-": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}} -test text-20.2 {TextSearchCmd procedure, -backwards option} { +} -cleanup { + destroy .t +} -result {abc abc} + + +test text-22.1 {TextSearchCmd procedure, argument parsing} -body { + text .t + .t search - +} -cleanup { + destroy .t +} -returnCodes error -result {ambiguous switch "-": must be --, -all, -backwards, -count, -elide, -exact, -forwards, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits} +test text-22.2 {TextSearchCmd procedure, -backwards option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -backwards xyz 1.4 -} {1.1} -test text-20.2.1 {TextSearchCmd procedure, -all option} { +} -cleanup { + destroy .t +} -result {1.1} +test text-22.3 {TextSearchCmd procedure, -all option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -all xyz 1.4 -} {1.5 3.0 3.5 1.1} -test text-20.3 {TextSearchCmd procedure, -forwards option} { +} -cleanup { + destroy .t +} -result {1.5 3.0 3.5 1.1} +test text-22.4 {TextSearchCmd procedure, -forwards option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -forwards xyz 1.4 -} {1.5} -test text-20.4 {TextSearchCmd procedure, -exact option} { +} -cleanup { + destroy .t +} -result {1.5} +test text-22.5 {TextSearchCmd procedure, -exact option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -f -exact x. 1.0 -} {1.9} -test text-20.5 {TextSearchCmd procedure, -regexp option} { +} -cleanup { + destroy .t +} -result {1.9} +test text-22.6 {TextSearchCmd procedure, -regexp option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -b -regexp x.z 1.4 -} {1.1} -test text-20.6 {TextSearchCmd procedure, -count option} { +} -cleanup { + destroy .t +} -result {1.1} +test text-22.7 {TextSearchCmd procedure, -count option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" set length unmodified list [.t search -count length x. 1.4] $length -} {1.9 2} -test text-20.7 {TextSearchCmd procedure, -count option} { - list [catch {.t search -count} msg] $msg -} {1 {no value given for "-count" option}} -test text-20.8 {TextSearchCmd procedure, -nocase option} { +} -cleanup { + destroy .t +} -result {1.9 2} +test text-22.8 {TextSearchCmd procedure, -count option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -count +} -cleanup { + destroy .t +} -returnCodes {error} -result {no value given for "-count" option} +test text-22.9 {TextSearchCmd procedure, -nocase option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" list [.t search -nocase BaR 1.1] [.t search BaR 1.1] -} {2.13 2.23} -test text-20.9 {TextSearchCmd procedure, -n ambiguous option} { - list [catch {.t search -n BaR 1.1} msg] $msg -} {1 {bad switch "-n": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}} -test text-20.9.1 {TextSearchCmd procedure, -nocase option} { +} -cleanup { + destroy .t +} -result {2.13 2.23} +test text-22.10 {TextSearchCmd procedure, -n ambiguous option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -n BaR 1.1 +} -cleanup { + destroy .t +} -returnCodes error -result {ambiguous switch "-n": must be --, -all, -backwards, -count, -elide, -exact, -forwards, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits} +test text-22.11 {TextSearchCmd procedure, -nocase option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -noc BaR 1.1 -} {2.13} -test text-20.9.2 {TextSearchCmd procedure, -nolinestop option} { - list [catch {.t search -nolinestop BaR 1.1} msg] $msg -} {1 {the "-nolinestop" option requires the "-regexp" option to be present}} -test text-20.9.3 {TextSearchCmd procedure, -nolinestop option} { +} -cleanup { + destroy .t +} -result {2.13} +test text-22.12 {TextSearchCmd procedure, -nolinestop option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -nolinestop BaR 1.1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {the "-nolinestop" option requires the "-regexp" option to be present} +test text-22.13 {TextSearchCmd procedure, -nolinestop option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" set msg "" list [.t search -nolinestop -regexp -count msg e.*o 1.1] $msg -} {1.14 32} -test text-20.10 {TextSearchCmd procedure, -- option} { +} -cleanup { + destroy .t +} -result {1.14 32} +test text-22.14 {TextSearchCmd procedure, -- option} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -- -forward 1.0 -} {2.4} -test text-20.11 {TextSearchCmd procedure, argument parsing} { - list [catch {.t search abc} msg] $msg -} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}} -test text-20.12 {TextSearchCmd procedure, argument parsing} { - list [catch {.t search abc d e f} msg] $msg -} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}} -test text-20.13 {TextSearchCmd procedure, check index} { - list [catch {.t search abc gorp} msg] $msg -} {1 {bad text index "gorp"}} -test text-20.14 {TextSearchCmd procedure, startIndex == "end"} { +} -cleanup { + destroy .t +} -result {2.4} +test text-22.15 {TextSearchCmd procedure, argument parsing} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search abc +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"} +test text-22.16 {TextSearchCmd procedure, argument parsing} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search abc d e f +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"} +test text-22.17 {TextSearchCmd procedure, check index} -body { + text .t + .t search abc gorp +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "gorp"} +test text-22.18 {TextSearchCmd procedure, startIndex == "end"} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search non-existent end -} {} -test text-20.15 {TextSearchCmd procedure, startIndex == "end"} { +} -cleanup { + destroy .t +} -result {} +test text-22.19 {TextSearchCmd procedure, startIndex == "end"} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search non-existent end -} {} -test text-20.16 {TextSearchCmd procedure, bad stopIndex} { - list [catch {.t search abc 1.0 lousy} msg] $msg -} {1 {bad text index "lousy"}} -test text-20.17 {TextSearchCmd procedure, pattern case conversion} { +} -cleanup { + destroy .t +} -result {} +test text-22.20 {TextSearchCmd procedure, bad stopIndex} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search abc 1.0 lousy +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "lousy"} +test text-22.21 {TextSearchCmd procedure, pattern case conversion} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" list [.t search -nocase BAR 1.1] [.t search BAR 1.1] -} {2.13 {}} -test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} { - list [catch {.t search -regexp a( 1.0} msg] $msg -} {1 {couldn't compile regular expression pattern: parentheses () not balanced}} -test text-20.19 {TextSearchCmd procedure, skip dummy last line} { +} -cleanup { + destroy .t +} -result {2.13 {}} +test text-22.22 {TextSearchCmd procedure, bad regular expression pattern} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + .t search -regexp a( 1.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {couldn't compile regular expression pattern: parentheses () not balanced} +test text-22.23 {TextSearchCmd procedure, skip dummy last line} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -backwards BaR end 1.0 -} {2.23} -test text-20.20 {TextSearchCmd procedure, skip dummy last line} { +} -cleanup { + destroy .t +} -result {2.23} +test text-22.24 {TextSearchCmd procedure, skip dummy last line} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -backwards \n end 1.0 -} {3.9} -test text-20.21 {TextSearchCmd procedure, skip dummy last line} { +} -cleanup { + destroy .t +} -result {3.9} +test text-22.25 {TextSearchCmd procedure, skip dummy last line} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search \n end -} {1.15} -test text-20.22 {TextSearchCmd procedure, skip dummy last line} { +} -cleanup { + destroy .t +} -result {1.15} +test text-22.26 {TextSearchCmd procedure, skip dummy last line} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -back \n 1.0 -} {3.9} -test text-20.23 {TextSearchCmd procedure, extract line contents} { +} -cleanup { + destroy .t +} -result {3.9} +test text-22.27 {TextSearchCmd procedure, extract line contents} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t tag add foo 1.2 .t tag add x 1.3 .t mark set silly 1.2 .t search xyz 3.6 -} {1.1} -test text-20.24 {TextSearchCmd procedure, stripping newlines} { +} -cleanup { + destroy .t +} -result {1.1} +test text-22.28 {TextSearchCmd procedure, stripping newlines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search the\n 1.0 -} {1.12} -test text-20.25 {TextSearchCmd procedure, handling newlines} { +} -cleanup { + destroy .t +} -result {1.12} +test text-22.29 {TextSearchCmd procedure, handling newlines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -regexp the\n 1.0 -} {1.12} -test text-20.26 {TextSearchCmd procedure, stripping newlines} { +} -cleanup { + destroy .t +} -result {1.12} +test text-22.30 {TextSearchCmd procedure, stripping newlines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -regexp {the$} 1.0 -} {1.12} -test text-20.27 {TextSearchCmd procedure, handling newlines} { +} -cleanup { + destroy .t +} -result {1.12} +test text-22.31 {TextSearchCmd procedure, handling newlines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -regexp \n 1.0 -} {1.15} -test text-20.28 {TextSearchCmd procedure, line case conversion} { +} -cleanup { + destroy .t +} -result {1.15} +test text-22.32 {TextSearchCmd procedure, line case conversion} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" list [.t search -nocase bar 2.18] [.t search bar 2.18] -} {2.23 2.13} -test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} { +} -cleanup { + destroy .t +} -result {2.23 2.13} +test text-22.33 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -backwards xyz 1.6 -} {1.5} -test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} { +} -cleanup { + destroy .t +} -result {1.5} +test text-22.34 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -backwards xyz 1.5 -} {1.1} -test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} { +} -cleanup { + destroy .t +} -result {1.1} +test text-22.35 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search xyz 1.5 -} {1.5} -test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} { +} -cleanup { + destroy .t +} -result {1.5} +test text-22.36 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search xyz 1.6 -} {3.0} -test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} { +} -cleanup { + destroy .t +} -result {3.0} +test text-22.37 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search {} 1.end -} {1.15} -test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} { +} -cleanup { + destroy .t +} -result {1.15} +test text-22.38 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search f 1.end -} {2.0} -test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} { +} -cleanup { + destroy .t +} -result {2.0} +test text-22.39 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search {} end -} {1.0} -test text-20.35a {TextSearchCmd procedure, regexp finds empty lines} { - # Test for fix of bug #1643 +} -cleanup { + destroy .t +} -result {1.0} +test text-22.40 {TextSearchCmd procedure, regexp finds empty lines} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" +# Test for fix of bug #1643 .t insert end "\n" tk::TextSetCursor .t 4.0 .t search -forward -regexp {^$} insert end -} {4.0} - -catch {destroy .t2} -toplevel .t2 -wm geometry .t2 +0+0 -text .t2.t -width 30 -height 10 -pack .t2.t -.t2.t insert 1.0 "This is a line\nand this is another" -.t2.t insert end "\nand this is yet another" -frame .t2.f -width 20 -height 20 -bd 2 -relief raised -.t2.t window create 2.5 -window .t2.f -test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} { - .t2.t search his 2.6 -} {2.6} -test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} { - .t2.t search this 2.6 -} {3.4} -test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} { - .t2.t search is 2.6 -} {2.7} -test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} { - .t2.t search his 2.7 -} {3.5} -test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} { - .t2.t search -backwards "his is another" 2.6 -} {2.6} -test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} { - .t2.t search -backwards "his is" 2.6 -} {1.1} -destroy .t2 -test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} { +} -cleanup { + destroy .t +} -result {4.0} +test text-22.41 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search his 2.6 +} -cleanup { + destroy .top +} -result {2.6} +test text-22.42 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search this 2.6 +} -cleanup { + destroy .top +} -result {3.4} +test text-22.43 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search is 2.6 +} -cleanup { + destroy .top +} -result {2.7} +test text-22.44 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search his 2.7 +} -cleanup { + destroy .top +} -result {3.5} +test text-22.45 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search -backwards "his is another" 2.6 +} -cleanup { + destroy .top +} -result {2.6} +test text-22.46 {TextSearchCmd procedure, firstChar and lastChar} -setup { + toplevel .top + text .top.t -width 30 -height 10 -font {Courier -12} -borderwidth 2 -highlightthickness 2 + pack .top.t +} -body { + .top.t insert 1.0 "This is a line\nand this is another" + .top.t insert end "\nand this is yet another" + frame .top.f -width 20 -height 20 -bd 2 -relief raised + .top.t window create 2.5 -window .top.f + .top.t search -backwards "his is" 2.6 +} -cleanup { + destroy .top +} -result {1.1} +test text-22.47 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -backwards forw 2.5 -} {2.5} -test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} { +} -cleanup { + destroy .t +} -result {2.5} +test text-22.48 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search forw 2.5 -} {2.5} -test text-20.44 {TextSearchCmd procedure, firstChar and lastChar} { - catch {destroy .t2} +} -cleanup { + destroy .t +} -result {2.5} +test text-22.49 {TextSearchCmd procedure, firstChar and lastChar} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" + catch {destroy .t} text .t2 list [.t2 search a 1.0] [.t2 search -backward a 1.0] -} {{} {}} -test text-20.45 {TextSearchCmd procedure, regexp match length} { +} -cleanup { + destroy .t .t2 +} -result {{} {}} +test text-22.50 {TextSearchCmd procedure, regexp match length} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" set length unchanged list [.t search -regexp -count length x(.)(.*)z 1.1] $length -} {1.1 7} -test text-20.46 {TextSearchCmd procedure, regexp match length} { +} -cleanup { + destroy .t +} -result {1.1 7} +test text-22.51 {TextSearchCmd procedure, regexp match length} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" set length unchanged list [.t search -regexp -backward -count length fo* 2.5] $length -} {2.0 3} -test text-20.47 {TextSearchCmd procedure, checking stopIndex} { +} -cleanup { + destroy .t +} -result {2.0 3} +test text-22.52 {TextSearchCmd procedure, checking stopIndex} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" list [.t search bar 2.1 2.13] [.t search bar 2.1 2.14] \ [.t search bar 2.12 2.14] [.t search bar 2.14 2.14] -} {{} 2.13 2.13 {}} -test text-20.48 {TextSearchCmd procedure, checking stopIndex} { +} -cleanup { + destroy .t +} -result {{} 2.13 2.13 {}} +test text-22.53 {TextSearchCmd procedure, checking stopIndex} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" list [.t search -backwards bar 2.20 2.13] \ [.t search -backwards bar 2.20 2.14] \ [.t search -backwards bar 2.14 2.13] \ [.t search -backwards bar 2.13 2.13] -} {2.13 {} 2.13 {}} -test text-20.48.1 {TextSearchCmd procedure, checking stopIndex} { +} -cleanup { + destroy .t +} -result {2.13 {} 2.13 {}} +test text-22.54 {TextSearchCmd procedure, checking stopIndex} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" list [.t search -backwards -strict bar 2.20 2.13] \ [.t search -backwards -strict bar 2.20 2.14] \ [.t search -backwards -strict bar 2.14 2.13] \ [.t search -backwards -strict bar 2.13 2.13] -} {2.13 {} {} {}} -test text-20.49 {TextSearchCmd procedure, embedded windows and index/count} { +} -cleanup { + destroy .t +} -result {2.13 {} {} {}} +test text-22.55 {TextSearchCmd procedure, embedded windows and index/count} -setup { + text .t frame .t.f1 -width 20 -height 20 -relief raised -bd 2 frame .t.f2 -width 20 -height 20 -relief raised -bd 2 frame .t.f3 -width 20 -height 20 -relief raised -bd 2 frame .t.f4 -width 20 -height 20 -relief raised -bd 2 + set result "" +} -body { + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t window create 2.10 -window .t.f3 .t window create 2.8 -window .t.f2 .t window create 2.8 -window .t.f1 .t window create 2.1 -window .t.f4 - set result "" lappend result [.t search -count x forward 1.0] $x lappend result [.t search -count x wa 1.0] $x - .t delete 2.1 - .t delete 2.8 2.10 - .t delete 2.10 - set result -} {2.6 10 2.11 2} -test text-20.50 {TextSearchCmd procedure, error setting variable} { - catch {unset a} + return $result +} -cleanup { + destroy .t +} -result {2.6 10 2.11 2} +test text-22.56 {TextSearchCmd procedure, error setting variable} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" set a 44 - list [catch {.t search -count a(2) xyz 1.0} msg] $msg -} {1 {can't set "a(2)": variable isn't array}} -test text-20.51 {TextSearchCmd procedure, wrap-around} { + .t search -count a(2) xyz 1.0 +} -cleanup { + destroy .t +} -returnCodes {error} -result {can't set "a(2)": variable isn't array} +test text-22.57 {TextSearchCmd procedure, wrap-around} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -backwards xyz 1.1 -} {3.5} -test text-20.52 {TextSearchCmd procedure, wrap-around} { +} -cleanup { + destroy .t +} -result {3.5} +test text-22.58 {TextSearchCmd procedure, wrap-around} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -backwards xyz 1.1 1.0 -} {} -test text-20.53 {TextSearchCmd procedure, wrap-around} { +} -cleanup { + destroy .t +} -result {} +test text-22.59 {TextSearchCmd procedure, wrap-around} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search xyz 3.6 -} {1.1} -test text-20.54 {TextSearchCmd procedure, wrap-around} { +} -cleanup { + destroy .t +} -result {1.1} +test text-22.60 {TextSearchCmd procedure, wrap-around} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search xyz 3.6 end -} {} -test text-20.55 {TextSearchCmd procedure, no match} { +} -cleanup { + destroy .t +} -result {} +test text-22.61 {TextSearchCmd procedure, no match} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search non_existent 3.5 -} {} -test text-20.56 {TextSearchCmd procedure, no match} { +} -cleanup { + destroy .t +} -result {} +test text-22.62 {TextSearchCmd procedure, no match} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -regexp non_existent 3.5 -} {} -test text-20.57 {TextSearchCmd procedure, special cases} { +} -cleanup { + destroy .t +} -result {} +test text-22.63 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -back x 1.1 -} {1.0} -test text-20.58 {TextSearchCmd procedure, special cases} { +} -cleanup { + destroy .t +} -result {1.0} +test text-22.64 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search -back x 1.0 -} {3.8} -test text-20.59 {TextSearchCmd procedure, special cases} { +} -cleanup { + destroy .t +} -result {3.8} +test text-22.65 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search \n {end-2c} -} {3.9} -test text-20.60 {TextSearchCmd procedure, special cases} { +} -cleanup { + destroy .t +} -result {3.9} +test text-22.66 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search \n end -} {1.15} -test text-20.61 {TextSearchCmd procedure, special cases} { +} -cleanup { + destroy .t +} -result {1.15} +test text-22.67 {TextSearchCmd procedure, special cases} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" .t search x 1.0 -} {1.0} -test text-20.62 {TextSearchCmd, freeing copy of pattern} { - # This test doesn't return a result, but it will generate - # a core leak if the pattern copy isn't properly freed. - # (actually in Tk 8.5 objectification means there is no - # longer a copy of the pattern, but we leave this test in - # anyway). +} -cleanup { + destroy .t +} -result {1.0} +test text-22.68 {TextSearchCmd, freeing copy of pattern} -body { + text .t + .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" +# This test doesn't return a result, but it will generate +# a core leak if the pattern copy isn't properly freed. +# (actually in Tk 8.5 objectification means there is no +# longer a copy of the pattern, but we leave this test in +# anyway). set p abcdefg1234567890 set p $p$p$p$p$p$p$p$p set p $p$p$p$p$p .t search -nocase $p 1.0 -} {} -test text-20.63 {TextSearchCmd, unicode} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {} +test text-22.69 {TextSearchCmd, unicode} -body { + text .t .t insert end "foo\u30c9\u30cabar" .t search \u30c9\u30ca 1.0 -} 1.3 -test text-20.64 {TextSearchCmd, unicode} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {1.3} +test text-22.70 {TextSearchCmd, unicode} -body { + text .t .t insert end "foo\u30c9\u30cabar" list [.t search -count n \u30c9\u30ca 1.0] $n -} {1.3 2} -test text-20.65 {TextSearchCmd, unicode with non-text segments} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {1.3 2} +test text-22.71 {TextSearchCmd, unicode with non-text segments} -body { + text .t button .b1 -text baz .t insert end "foo\u30c9" .t window create end -window .b1 .t insert end "\u30cabar" - set result [list [.t search -count n \u30c9\u30ca 1.0] $n] - destroy .b1 - set result -} {1.3 3} -test text-20.66 {TextSearchCmd, hidden text does not affect match index} { - deleteWindows - pack [text .t2] - .t2 insert end "12345H7890" - .t2 search 7 1.0 -} 1.6 -test text-20.67 {TextSearchCmd, hidden text does not affect match index} { - deleteWindows - pack [text .t2] - .t2 insert end "12345H7890" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.5 - .t2 search 7 1.0 -} 1.6 -test text-20.68 {TextSearchCmd, hidden text does not affect match index} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nbarbaz\nbazboo" - .t2 search boo 1.0 -} 3.3 -test text-20.69 {TextSearchCmd, hidden text does not affect match index} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nbarbaz\nbazboo" - .t2 tag configure hidden -elide true - .t2 tag add hidden 2.0 3.0 - .t2 search boo 1.0 -} 3.3 -test text-20.70 {TextSearchCmd, -regexp -nocase searches} { - catch {destroy .t} + list [.t search -count n \u30c9\u30ca 1.0] $n +} -cleanup { + destroy .t .b1 +} -result {1.3 3} +test text-22.72 {TextSearchCmd, hidden text does not affect match index} -body { + pack [text .t] + .t insert end "12345H7890" + .t search 7 1.0 +} -cleanup { + destroy .t +} -result {1.6} +test text-22.73 {TextSearchCmd, hidden text does not affect match index} -body { + pack [text .t] + .t insert end "12345H7890" + .t tag configure hidden -elide true + .t tag add hidden 1.5 + .t search 7 1.0 +} -cleanup { + destroy .t +} -result {1.6} +test text-22.74 {TextSearchCmd, hidden text does not affect match index} -body { + pack [text .t] + .t insert end "foobar\nbarbaz\nbazboo" + .t search boo 1.0 +} -cleanup { + destroy .t +} -result {3.3} +test text-22.75 {TextSearchCmd, hidden text does not affect match index} -body { + pack [text .t] + .t insert end "foobar\nbarbaz\nbazboo" + .t tag configure hidden -elide true + .t tag add hidden 2.0 3.0 + .t search boo 1.0 +} -cleanup { + destroy .t +} -result {3.3} +test text-22.76 {TextSearchCmd, -regexp -nocase searches} -body { pack [text .t] .t insert end "word1 word2" - set res [.t search -nocase -regexp {\mword.} 1.0 end] + .t search -nocase -regexp {\mword.} 1.0 end +} -cleanup { destroy .t - set res -} 1.0 -test text-20.71 {TextSearchCmd, -regexp -nocase searches} { - catch {destroy .t} +} -result {1.0} +test text-22.77 {TextSearchCmd, -regexp -nocase searches} -body { pack [text .t] .t insert end "word1 word2" - set res [.t search -nocase -regexp {word.\M} 1.0 end] + .t search -nocase -regexp {word.\M} 1.0 end +} -cleanup { destroy .t - set res -} 1.0 -test text-20.72 {TextSearchCmd, -regexp -nocase searches} { - catch {destroy .t} +} -result {1.0} +test text-22.78 {TextSearchCmd, -regexp -nocase searches} -body { pack [text .t] .t insert end "word1 word2" - set res [.t search -nocase -regexp {word.\W} 1.0 end] - destroy .t - set res -} 1.0 -test text-20.73 {TextSearchCmd, hidden text and start index} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search bar 1.3 -} 1.3 -test text-20.74 {TextSearchCmd, hidden text shouldn't influence start index} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.0 1.2 - .t2 search bar 1.3 -} 1.3 -test text-20.75 {TextSearchCmd, hidden text inside match must count in length} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.2 1.4 - list [.t2 search -count foo foar 1.3] $foo -} {1.0 6} -test text-20.75.1 {TextSearchCmd, hidden text inside match must count in length} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.2 1.4 + .t search -nocase -regexp {word.\W} 1.0 end +} -cleanup { + destroy .t +} -result {1.0} +test text-22.79 {TextSearchCmd, hidden text and start index} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search bar 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.80 {TextSearchCmd, hidden text shouldn't influence start index} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.0 1.2 + .t search bar 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.81 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + list [.t search -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {1.0 6} +test text-22.82 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 list \ - [.t2 search -strict -count foo foar 1.3] \ - [.t2 search -strict -count foo foar 2.3] $foo -} {{} 1.0 6} -test text-20.76 {TextSearchCmd, hidden text and start index} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search -regexp bar 1.3 -} 1.3 -test text-20.77 {TextSearchCmd, hidden text shouldn't influence start index} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.0 1.2 - .t2 search -regexp bar 1.3 -} 1.3 -test text-20.78 {TextSearchCmd, hidden text inside match must count in length} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.2 1.4 - list [.t2 search -regexp -count foo foar 1.3] $foo -} {1.0 6} -test text-20.78.1 {TextSearchCmd, hidden text inside match must count in length} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.2 1.4 - list [.t2 search -count foo foar 1.3] $foo -} {1.0 6} -test text-20.78.2 {TextSearchCmd, hidden text inside match must count in length} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.2 1.4 - .t2 search -strict -count foo foar 1.3 -} {} -test text-20.78.3 {TextSearchCmd, hidden text inside match must count in length} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.2 1.4 - .t2 tag add hidden 2.2 2.4 - list [.t2 search -regexp -all -count foo foar 1.3] $foo -} {{2.0 3.0 1.0} {6 4 6}} -test text-20.78.4 {TextSearchCmd, hidden text inside match must count in length} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.2 1.4 - .t2 tag add hidden 2.2 2.4 - list [.t2 search -all -count foo foar 1.3] $foo -} {{2.0 3.0 1.0} {6 4 6}} -test text-20.78.5 {TextSearchCmd, hidden text inside match must count in length} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoar" - .t2 tag configure hidden -elide true - .t2 tag add hidden 1.2 1.4 - .t2 tag add hidden 2.2 2.4 - list [.t2 search -strict -all -count foo foar 1.3] $foo -} {{2.0 3.0} {6 4}} -test text-20.78.6 {TextSearchCmd, single line with -all} { - deleteWindows - pack [text .t2] - .t2 insert end " X\n X\n X\n X\n X\n X\n" - .t2 search -all -regexp { +| *\n} 1.0 end -} {1.0 1.2 2.0 2.2 3.0 3.2 4.0 4.2 5.0 5.2 6.0 6.2 7.0} -test text-20.79 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -count foo foobar\nfoo 1.0] $foo -} {1.0 10} -test text-20.80 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -count foo bar\nfoo 1.0] $foo -} {1.3 7} -test text-20.81 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -count foo \nfoo 1.0] $foo -} {1.6 4} -test text-20.82 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -count foo bar\nfoobar\nfoo 1.0] $foo -} {1.3 14} -test text-20.83 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search -count foo bar\nfoobar\nfoobanearly 1.0 -} {} -test text-20.84 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -regexp -count foo foobar\nfoo 1.0] $foo -} {1.0 10} -test text-20.85 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -regexp -count foo bar\nfoo 1.0] $foo -} {1.3 7} -test text-20.86 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -regexp -count foo \nfoo 1.0] $foo -} {1.6 4} -test text-20.87 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -regexp -count foo bar\nfoobar\nfoo 1.0] $foo -} {1.3 14} -test text-20.88 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search -regexp -count foo bar\nfoobar\nfoobanearly 1.0 -} {} -test text-20.89 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfaoobar\nfoobar" - .t2 search -regexp -count foo bar\nfoo 1.0 -} {2.4} -test text-20.90 {TextSearchCmd, multiline matching end of window} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfaoobar\nfoobar" - .t2 search -regexp -count foo bar\nfoobar\n\n 1.0 -} {} -test text-20.91 {TextSearchCmd, multiline matching end of window} { - deleteWindows - pack [text .t2] - .t2 search "\n\n" 1.0 -} {} -test text-20.92 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -backwards -count foo foobar\nfoo end] $foo -} {2.0 10} -test text-20.93 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -backwards -count foo bar\nfoo 1.0] $foo -} {2.3 7} -test text-20.94 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -backwards -count foo \nfoo 1.0] $foo -} {2.6 4} -test text-20.95 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -backwards -count foo bar\nfoobar\nfoo 1.0] $foo -} {1.3 14} -test text-20.96 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search -backwards -count foo bar\nfoobar\nfoobanearly 1.0 -} {} -test text-20.97 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -backwards -regexp -count foo foobar\nfoo end] $foo -} {2.0 10} -test text-20.97.1 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -backwards -regexp -count foo foobar\nfo end] $foo -} {2.0 9} -test text-20.98 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -backwards -regexp -count foo bar\nfoo 1.0] $foo -} {2.3 7} -test text-20.99 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -backwards -regexp -count foo \nfoo 1.0] $foo -} {2.6 4} -test text-20.100 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - list [.t2 search -backwards -regexp -count foo bar\nfoobar\nfoo 1.0] $foo -} {1.3 14} -test text-20.101 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search -backwards -regexp -count foo bar\nfoobar\nfoobanearly 1.0 -} {} -test text-20.102 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfaoobar\nfoobar" - .t2 search -backwards -regexp -count foo bar\nfoo 1.0 -} {2.4} -test text-20.103 {TextSearchCmd, multiline matching end of window} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfaoobar\nfoobar" - .t2 search -backwards -regexp -count foo bar\nfoobar\n\n 1.0 -} {} -test text-20.104 {TextSearchCmd, multiline matching end of window} { - deleteWindows - pack [text .t2] - .t2 search -backwards "\n\n" 1.0 -} {} -test text-20.105 {TextSearchCmd, multiline regexp matching} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 { Tcl_Obj *objPtr)); + [.t search -strict -count foo foar 1.3] \ + [.t search -strict -count foo foar 2.3] $foo +} -cleanup { + destroy .t +} -result {{} 1.0 6} +test text-22.83 {TextSearchCmd, hidden text and start index} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -regexp bar 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.84 {TextSearchCmd, hidden text shouldn't influence start index} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.0 1.2 + .t search -regexp bar 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.85 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + list [.t search -regexp -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {1.0 6} +test text-22.86 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + list [.t search -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {1.0 6} +test text-22.87 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + .t search -strict -count foo foar 1.3 +} -cleanup { + destroy .t +} -result {} +test text-22.88 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + .t tag add hidden 2.2 2.4 + list [.t search -regexp -all -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {{2.0 3.0 1.0} {6 4 6}} +test text-22.89 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + .t tag add hidden 2.2 2.4 + list [.t search -all -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {{2.0 3.0 1.0} {6 4 6}} +test text-22.90 {TextSearchCmd, hidden text inside match must count in length} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoar" + .t tag configure hidden -elide true + .t tag add hidden 1.2 1.4 + .t tag add hidden 2.2 2.4 + list [.t search -strict -all -count foo foar 1.3] $foo +} -cleanup { + destroy .t +} -result {{2.0 3.0} {6 4}} +test text-22.91 {TextSearchCmd, single line with -all} -body { + pack [text .t] + .t insert end " X\n X\n X\n X\n X\n X\n" + .t search -all -regexp { +| *\n} 1.0 end +} -cleanup { + destroy .t +} -result {1.0 1.2 2.0 2.2 3.0 3.2 4.0 4.2 5.0 5.2 6.0 6.2 7.0} +test text-22.92 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -count foo foobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 10} +test text-22.93 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -count foo bar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 7} +test text-22.94 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -count foo \nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.6 4} +test text-22.95 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -count foo bar\nfoobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 14} +test text-22.96 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -count foo bar\nfoobar\nfoobanearly 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.97 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -regexp -count foo foobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 10} +test text-22.98 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -regexp -count foo bar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 7} +test text-22.99 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -regexp -count foo \nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.6 4} +test text-22.100 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 14} +test text-22.101 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.102 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfaoobar\nfoobar" + .t search -regexp -count foo bar\nfoo 1.0 +} -cleanup { + destroy .t +} -result {2.4} +test text-22.103 {TextSearchCmd, multiline matching end of window} -body { + pack [text .t] + .t insert end "foobar\nfaoobar\nfoobar" + .t search -regexp -count foo bar\nfoobar\n\n 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.104 {TextSearchCmd, multiline matching end of window} -body { + pack [text .t] + .t search "\n\n" 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.105 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -count foo foobar\nfoo end] $foo +} -cleanup { + destroy .t +} -result {2.0 10} +test text-22.106 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -count foo bar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {2.3 7} +test text-22.107 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -count foo \nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {2.6 4} +test text-22.108 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -count foo bar\nfoobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 14} +test text-22.109 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -backwards -count foo bar\nfoobar\nfoobanearly 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.110 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo foobar\nfoo end] $foo +} -cleanup { + destroy .t +} -result {2.0 10} +test text-22.111 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo foobar\nfo end] $foo +} -cleanup { + destroy .t +} -result {2.0 9} +test text-22.112 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo bar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {2.3 7} +test text-22.113 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo \nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {2.6 4} +test text-22.114 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + list [.t search -backwards -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} -cleanup { + destroy .t +} -result {1.3 14} +test text-22.115 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -backwards -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.116 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfaoobar\nfoobar" + .t search -backwards -regexp -count foo bar\nfoo 1.0 +} -cleanup { + destroy .t +} -result {2.4} +test text-22.117 {TextSearchCmd, multiline matching end of window} -body { + pack [text .t] + .t insert end "foobar\nfaoobar\nfoobar" + .t search -backwards -regexp -count foo bar\nfoobar\n\n 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.118 {TextSearchCmd, multiline matching end of window} -body { + pack [text .t] + .t search -backwards "\n\n" 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.119 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 { Tcl_Obj *objPtr)); static Tcl_Obj* FSNormalizeAbsolutePath _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" append markExpr "\[ \n\t\r\]*\\()" - .t2 search -forwards -regexp $markExpr 1.41 end -} {} -test text-20.106 {TextSearchCmd, multiline regexp matching} { - # Practical example which used to crash Tk, but only after the - # search is complete. This is memory corruption caused by - # a bug in Tcl's handling of string objects. - # (Tcl bug 635200) - deleteWindows - pack [text .t2] - .t2 insert 1.0 {static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, + .t search -forwards -regexp $markExpr 1.41 end +} -cleanup { + destroy .t +} -result {} +test text-22.120 {TextSearchCmd, multiline regexp matching} -body { +# Practical example which used to crash Tk, but only after the +# search is complete. This is memory corruption caused by +# a bug in Tcl's handling of string objects. +# (Tcl bug 635200) + pack [text .t] + .t insert 1.0 {static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static Tcl_Obj* FSNormalizeAbsolutePath _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" append markExpr "\[ \n\t\r\]*\\()" - .t2 search -forwards -regexp $markExpr 1.41 end -} {} -test text-20.107 {TextSearchCmd, multiline regexp matching} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 { + .t search -forwards -regexp $markExpr 1.41 end +} -cleanup { + destroy .t +} -result {} +test text-22.121 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 { static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static Tcl_Obj* FSNormalizeAbsolutePath @@ -2072,240 +4733,275 @@ static Tcl_Obj* FSNormalizeAbsolutePath set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" append markExpr "\[ \n\t\r\]*\\()" - .t2 search -backwards -all -regexp $markExpr end -} {2.0} -test text-20.108 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search -all -regexp -count foo bar\nfoo 1.0 -} {1.3 2.3} -test text-20.109 {TextSearchCmd, multiline matching} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search -all -backwards -regexp -count foo bar\nfoo 1.0 -} {2.3 1.3} -test text-20.110 {TextSearchCmd, wrapping and limits} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search -- "blah" 3.3 1.3 -} {} -test text-20.111 {TextSearchCmd, wrapping and limits} { - deleteWindows - pack [text .t2] - .t2 insert end "foobar\nfoobar\nfoobar" - .t2 search -backwards -- "blah" 1.3 3.3 -} {} -test text-20.112 {TextSearchCmd, wrapping and limits} { - deleteWindows - pack [text .t2] - .t2 insert end "if (stringPtr->uallocated > 0) \{x" - .t2 search -backwards -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 -} {1.31} -test text-20.113 {TextSearchCmd, wrapping and limits} { - deleteWindows - pack [text .t2] - .t2 insert end "if (stringPtr->uallocated > 0) \{x" - .t2 search -regexp -- "\[\]\")\}\[(\{\]" 1.30 "1.0 lineend" -} {1.31} -test text-20.114 {TextSearchCmd, wrapping and limits} { - deleteWindows - pack [text .t2] - .t2 insert end "if (stringPtr->uallocated > 0) \{x" - .t2 search -backwards -all -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 -} {1.31 1.29 1.3} -test text-20.115 {TextSearchCmd, wrapping and limits} { - deleteWindows - pack [text .t2] - .t2 insert end "if (stringPtr->uallocated > 0) \{x" - .t2 search -all -regexp -- "\[\]\")\}\[(\{\]" 1.0 "1.0 lineend" -} {1.3 1.29 1.31} -test text-20.116 {TextSearchCmd, wrapping and limits} { - deleteWindows - pack [text .t2] - .t2 insert end "if (stringPtr->uallocated > 0) \{x" - .t2 search -backwards -- "\{" "1.32" 1.0 -} {1.31} -test text-20.117 {TextSearchCmd, wrapping and limits} { - deleteWindows - pack [text .t2] - .t2 insert end "if (stringPtr->uallocated > 0) \{x" - .t2 search -- "\{" 1.30 "1.0 lineend" -} {1.31} -test text-20.118 {TextSearchCmd, multiline regexp matching} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 { + .t search -backwards -all -regexp $markExpr end +} -cleanup { + destroy .t +} -result {2.0} +test text-22.122 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -all -regexp -count foo bar\nfoo 1.0 +} -cleanup { + destroy .t +} -result {1.3 2.3} +test text-22.123 {TextSearchCmd, multiline matching} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -all -backwards -regexp -count foo bar\nfoo 1.0 +} -cleanup { + destroy .t +} -result {2.3 1.3} +test text-22.124 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -- "blah" 3.3 1.3 +} -cleanup { + destroy .t +} -result {} +test text-22.125 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "foobar\nfoobar\nfoobar" + .t search -backwards -- "blah" 1.3 3.3 +} -cleanup { + destroy .t +} -result {} +test text-22.126 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -backwards -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} -cleanup { + destroy .t +} -result {1.31} +test text-22.127 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -regexp -- "\[\]\")\}\[(\{\]" 1.30 "1.0 lineend" +} -cleanup { + destroy .t +} -result {1.31} +test text-22.128 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -backwards -all -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} -cleanup { + destroy .t +} -result {1.31 1.29 1.3} +test text-22.129 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -all -regexp -- "\[\]\")\}\[(\{\]" 1.0 "1.0 lineend" +} -cleanup { + destroy .t +} -result {1.3 1.29 1.31} +test text-22.130 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -backwards -- "\{" "1.32" 1.0 +} -cleanup { + destroy .t +} -result {1.31} +test text-22.131 {TextSearchCmd, wrapping and limits} -body { + pack [text .t] + .t insert end "if (stringPtr->uallocated > 0) \{x" + .t search -- "\{" 1.30 "1.0 lineend" +} -cleanup { + destroy .t +} -result {1.31} +test text-22.132 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 { void Tcl_SetObjLength(objPtr, length) register Tcl_Obj *objPtr; /* Pointer to object. This object must - * not currently be shared. */ + * not currently be shared. */ register int length; /* Number of bytes desired for string * representation of object, not including - * terminating null byte. */ + * terminating null byte. */ \{ char *new; } set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" append markExpr "\[ \n\t\r\]*\\()" - .t2 search -all -regexp -- $markExpr 1.0 -} {4.0} -test text-20.119 {TextSearchCmd, multiline regexp matching} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "first line\nlast line of text" + .t search -all -regexp -- $markExpr 1.0 +} -cleanup { + destroy .t +} -result {4.0} +test text-22.133 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" set markExpr {^[a-z]+} - # This should not match, and should not wrap - .t2 search -regexp -- $markExpr end end -} {} -test text-20.120 {TextSearchCmd, multiline regexp matching} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "first line\nlast line of text" +# This should not match, and should not wrap + .t search -regexp -- $markExpr end end +} -cleanup { + destroy .t +} -result {} +test text-22.134 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" set markExpr {^[a-z]+} - # This should not match, and should not wrap - .t2 search -regexp -- $markExpr end+10c end -} {} -test text-20.121 {TextSearchCmd, multiline regexp matching} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "first line\nlast line of text" +# This should not match, and should not wrap + .t search -regexp -- $markExpr end+10c end +} -cleanup { + destroy .t +} -result {} +test text-22.135 {TextSearchCmd, multiline regexp matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" set markExpr {^[a-z]+} - # This should not match, and should not wrap - .t2 search -regexp -backwards -- $markExpr 1.0 1.0 -} {} -test text-20.122 {TextSearchCmd, regexp linestop} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "first line\nlast line of text" - .t2 search -regexp -- {i.*x} 1.0 -} {2.6} -test text-20.123 {TextSearchCmd, multiline regexp nolinestop matching} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "first line\nlast line of text" - .t2 search -regexp -nolinestop -- {i.*x} 1.0 -} {1.1} -test text-20.124 {TextSearchCmd, regexp linestop} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "first line\nlast line of text" - .t2 search -regexp -all -overlap -- {i.*x} 1.0 -} {2.6} -test text-20.124.1 {TextSearchCmd, regexp linestop} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "first line\nlast line of text" - .t2 search -regexp -all -- {i.*x} 1.0 -} {2.6} -test text-20.125 {TextSearchCmd, multiline regexp nolinestop matching} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "first line\nlast line of text" - list [.t2 search -regexp -all -overlap -count c -nolinestop -- {i.*x} 1.0] $c -} {{1.1 2.6} {26 10}} -test text-20.125.1 {TextSearchCmd, multiline regexp nolinestop matching} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "first line\nlast line of text" - list [.t2 search -regexp -all -count c -nolinestop -- {i.*x} 1.0] $c -} {1.1 26} -test text-20.126 {TextSearchCmd, stop at end of line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 " \t\n last line of text" - .t2 search -regexp -nolinestop -- {[^ \t]} 1.0 -} {1.3} -test text-20.127 {TextSearchCmd, overlapping all matches} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde abcde" - list [.t2 search -regexp -all -overlap -count c -- {\w+} 1.0] $c -} {{1.0 1.6} {5 5}} -test text-20.127.1 {TextSearchCmd, non-overlapping all matches} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde abcde" - list [.t2 search -regexp -all -count c -- {\w+} 1.0] $c -} {{1.0 1.6} {5 5}} -test text-20.128 {TextSearchCmd, stop at end of line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde abcde" - list [.t2 search -backwards -regexp -all -count c -- {\w+} 1.0] $c -} {{1.6 1.0} {5 5}} -test text-20.129 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - list [.t2 search -backwards -regexp -count c -- {Z\w+} 1.21 1.5] $c -} {1.8 8} -test text-20.130 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - list [.t2 search -backwards -all -overlap -regexp -count c -- {Z\w+} 1.21 1.5] $c -} {1.8 8} -test text-20.130.1 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.5] $c -} {1.8 8} -test text-20.131 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - list [.t2 search -backwards -overlap -all -regexp -count c -- {Z\w+} 1.21 1.1] $c -} {1.4 12} -test text-20.131.1 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - list [.t2 search -backwards -overlap -all -regexp -count c -- {Z[^Z]+Z} 1.21 1.1] $c -} {{1.8 1.4} {5 5}} -test text-20.131.2 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.1] $c -} {1.4 12} -test text-20.132 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" - list [.t2 search -backwards -all -overlap -regexp -count c -- {Z\w+} 2.21 1.5] $c -} {{2.4 1.8} {12 8}} -test text-20.132.1 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" - list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.5] $c -} {{2.4 1.8} {12 8}} -test text-20.133 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" - list [.t2 search -backwards -overlap -all -regexp -count c -- {Z\w+} 2.21 1.1] $c -} {{2.4 1.4} {12 12}} -test text-20.133.1 {TextSearchCmd, backwards search stop index } { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "bla ZabcZdefZghi and some text again" - .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" - list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.1] $c -} {{2.4 1.4} {12 12}} -test text-20.134 {TextSearchCmd, search -all example} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 { +# This should not match, and should not wrap + .t search -regexp -backwards -- $markExpr 1.0 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.136 {TextSearchCmd, regexp linestop} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + .t search -regexp -- {i.*x} 1.0 +} -cleanup { + destroy .t +} -result {2.6} +test text-22.137 {TextSearchCmd, multiline regexp nolinestop matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + .t search -regexp -nolinestop -- {i.*x} 1.0 +} -cleanup { + destroy .t +} -result {1.1} +test text-22.138 {TextSearchCmd, regexp linestop} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + .t search -regexp -all -overlap -- {i.*x} 1.0 +} -cleanup { + destroy .t +} -result {2.6} +test text-22.139 {TextSearchCmd, regexp linestop} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + .t search -regexp -all -- {i.*x} 1.0 +} -cleanup { + destroy .t +} -result {2.6} +test text-22.140 {TextSearchCmd, multiline regexp nolinestop matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + list [.t search -regexp -all -overlap -count c -nolinestop -- {i.*x} 1.0] $c +} -cleanup { + destroy .t +} -result {{1.1 2.6} {26 10}} +test text-22.141 {TextSearchCmd, multiline regexp nolinestop matching} -body { + pack [text .t] + .t insert 1.0 "first line\nlast line of text" + list [.t search -regexp -all -count c -nolinestop -- {i.*x} 1.0] $c +} -cleanup { + destroy .t +} -result {1.1 26} +test text-22.142 {TextSearchCmd, stop at end of line} -body { + pack [text .t] + .t insert 1.0 " \t\n last line of text" + .t search -regexp -nolinestop -- {[^ \t]} 1.0 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.143 {TextSearchCmd, overlapping all matches} -body { + pack [text .t] + .t insert 1.0 "abcde abcde" + list [.t search -regexp -all -overlap -count c -- {\w+} 1.0] $c +} -cleanup { + destroy .t +} -result {{1.0 1.6} {5 5}} +test text-22.144 {TextSearchCmd, non-overlapping all matches} -body { + pack [text .t] + .t insert 1.0 "abcde abcde" + list [.t search -regexp -all -count c -- {\w+} 1.0] $c +} -cleanup { + destroy .t +} -result {{1.0 1.6} {5 5}} +test text-22.145 {TextSearchCmd, stop at end of line} -body { + pack [text .t] + .t insert 1.0 "abcde abcde" + list [.t search -backwards -regexp -all -count c -- {\w+} 1.0] $c +} -cleanup { + destroy .t +} -result {{1.6 1.0} {5 5}} +test text-22.146 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -regexp -count c -- {Z\w+} 1.21 1.5] $c +} -cleanup { + destroy .t +} -result {1.8 8} +test text-22.147 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -all -overlap -regexp -count c -- {Z\w+} 1.21 1.5] $c +} -cleanup { + destroy .t +} -result {1.8 8} +test text-22.148 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.5] $c +} -cleanup { + destroy .t +} -result {1.8 8} +test text-22.149 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -overlap -all -regexp -count c -- {Z\w+} 1.21 1.1] $c +} -cleanup { + destroy .t +} -result {1.4 12} +test text-22.150 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -overlap -all -regexp -count c -- {Z[^Z]+Z} 1.21 1.1] $c +} -cleanup { + destroy .t +} -result {{1.8 1.4} {5 5}} +test text-22.151 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.1] $c +} -cleanup { + destroy .t +} -result {1.4 12} +test text-22.152 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + .t insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t search -backwards -all -overlap -regexp -count c -- {Z\w+} 2.21 1.5] $c +} -cleanup { + destroy .t +} -result {{2.4 1.8} {12 8}} +test text-22.153 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + .t insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.5] $c +} -cleanup { + destroy .t +} -result {{2.4 1.8} {12 8}} +test text-22.154 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + .t insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t search -backwards -overlap -all -regexp -count c -- {Z\w+} 2.21 1.1] $c +} -cleanup { + destroy .t +} -result {{2.4 1.4} {12 12}} +test text-22.155 {TextSearchCmd, backwards search stop index } -body { + pack [text .t] + .t insert 1.0 "bla ZabcZdefZghi and some text again" + .t insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.1] $c +} -cleanup { + destroy .t +} -result {{2.4 1.4} {12 12}} +test text-22.156 {TextSearchCmd, search -all example} -body { + pack [text .t] + .t insert 1.0 { See the package: supersearch for more information. @@ -2319,715 +5015,968 @@ See the package: marks for more information. } set pat {package: ([a-zA-Z0-9][-a-zA-Z0-9._+#/]*)} - list [.t2 search -nolinestop -regexp -nocase -all -forwards \ + list [.t search -nolinestop -regexp -nocase -all -forwards \ -count c -- $pat 1.0 end] $c -} {{3.8 6.8 8.0 11.8} {20 26 13 14}} -test text-20.135 {TextSearchCmd, backwards search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" - .t2 search -backwards -regexp {fooba+rfoo} end -} {1.6} -test text-20.135.1 {TextSearchCmd, backwards search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" - .t2 search -backwards -overlap -all -regexp {fooba+rfoo} end -} {1.6 1.0} -test text-20.135.2 {TextSearchCmd, backwards search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" - .t2 search -backwards -all -regexp {fooba+rfoo} end -} {1.6} -test text-20.135.3 {TextSearchCmd, forwards search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" - .t2 search -all -overlap -regexp {fooba+rfoo} end -} {1.0 1.6} -test text-20.135.4 {TextSearchCmd, forwards search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" - .t2 search -all -regexp {fooba+rfoo} end -} {1.0} -test text-20.136 {TextSearchCmd, forward exact search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abababab" - .t2 search -exact -overlap -all {abab} 1.0 -} {1.0 1.2 1.4} -test text-20.136.1 {TextSearchCmd, forward exact search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abababab" - .t2 search -exact -all {abab} 1.0 -} {1.0 1.4} -test text-20.137 {TextSearchCmd, backward exact search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "ababababab" - .t2 search -exact -overlap -backwards -all {abab} end -} {1.6 1.4 1.2 1.0} -test text-20.137.1 {TextSearchCmd, backward exact search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "ababababab" - .t2 search -exact -backwards -all {abab} end -} {1.6 1.2} -test text-20.137.2 {TextSearchCmd, backward exact search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abababababab" - .t2 search -exact -backwards -all {abab} end -} {1.8 1.4 1.0} -test text-20.138 {TextSearchCmd, forward exact search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" - .t2 search -exact -overlap -all "foo\nbar\nfoo" 1.0 -} {1.0 3.0 5.0} -test text-20.138.1 {TextSearchCmd, forward exact search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" - .t2 search -exact -all "foo\nbar\nfoo" 1.0 -} {1.0 5.0} -test text-20.139 {TextSearchCmd, backward exact search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" - .t2 search -exact -overlap -backward -all "foo\nbar\nfoo" end -} {5.0 3.0 1.0} -test text-20.140 {TextSearchCmd, backward exact search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" - .t2 search -exact -backward -all "foo\nbar\nfoo" end -} {5.0 1.0} -test text-20.141 {TextSearchCmd, backward exact search overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" - .t2 search -regexp -backward -overlap -all "foo\nbar\nfoo" end -} {5.0 3.0 1.0} -test text-20.142 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" - .t2 search -regexp -backward -all "foo\nbar\nfoo" end -} {5.0 1.0} -test text-20.142a {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 " aasda asdj werwer" - .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 -} {1.7} -test text-20.143 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 " aasda asdj werwer" - .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.5 -} {1.7} -test text-20.144 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 " aasda asdj werwer" - .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.7 -} {1.7} -test text-20.145 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 " aasda asdj werwer" - .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.8 -} {1.8} -test text-20.146 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 " aasda asdj werwer" - .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.3 -} {1.7 1.3} -test text-20.147 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 " aasda asdj werwer" - .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.13 -} {} -test text-20.148 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 " aasda asdj werwer" - .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 2.0 1.3 -} {1.12 1.7 1.3} -test text-20.149 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 " aasda asdj werwer" - .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 1.3 -} {1.1 1.12 1.7 1.3} -test text-20.150 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\n" - .t2 search -regexp -backward -all -- {(\w+\n)+} end -} {1.0} -test text-20.151 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\n" - .t2 search -regexp -backward -all -- {(\w+\n)+} end 1.5 -} {2.0} -test text-20.152 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - .t2 search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 -} {2.0} -test text-20.153 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - list [.t2 search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo -} {1.0 20} -test text-20.154 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" +} -cleanup { + destroy .t +} -result {{3.8 6.8 8.0 11.8} {20 26 13 14}} +test text-22.157 {TextSearchCmd, backwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -backwards -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.6} +test text-22.158 {TextSearchCmd, backwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -backwards -overlap -all -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.6 1.0} +test text-22.159 {TextSearchCmd, backwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -backwards -all -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.6} +test text-22.160 {TextSearchCmd, forwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -all -overlap -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.0 1.6} +test text-22.161 {TextSearchCmd, forwards search overlaps} -body { + pack [text .t] + .t insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t search -all -regexp {fooba+rfoo} end +} -cleanup { + destroy .t +} -result {1.0} +test text-22.162 {TextSearchCmd, forward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "abababab" + .t search -exact -overlap -all {abab} 1.0 +} -cleanup { + destroy .t +} -result {1.0 1.2 1.4} +test text-22.163 {TextSearchCmd, forward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "abababab" + .t search -exact -all {abab} 1.0 +} -cleanup { + destroy .t +} -result {1.0 1.4} +test text-22.164 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "ababababab" + .t search -exact -overlap -backwards -all {abab} end +} -cleanup { + destroy .t +} -result {1.6 1.4 1.2 1.0} +test text-22.165 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "ababababab" + .t search -exact -backwards -all {abab} end +} -cleanup { + destroy .t +} -result {1.6 1.2} +test text-22.166 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "abababababab" + .t search -exact -backwards -all {abab} end +} -cleanup { + destroy .t +} -result {1.8 1.4 1.0} +test text-22.167 {TextSearchCmd, forward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -exact -overlap -all "foo\nbar\nfoo" 1.0 +} -cleanup { + destroy .t +} -result {1.0 3.0 5.0} +test text-22.168 {TextSearchCmd, forward exact search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -exact -all "foo\nbar\nfoo" 1.0 +} -cleanup { + destroy .t +} -result {1.0 5.0} +test text-22.169 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -exact -overlap -backward -all "foo\nbar\nfoo" end +} -cleanup { + destroy .t +} -result {5.0 3.0 1.0} +test text-22.170 {TextSearchCmd, backward exact search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -exact -backward -all "foo\nbar\nfoo" end +} -cleanup { + destroy .t +} -result {5.0 1.0} +test text-22.171 {TextSearchCmd, backward exact search overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -regexp -backward -overlap -all "foo\nbar\nfoo" end +} -cleanup { + destroy .t +} -result {5.0 3.0 1.0} +test text-22.172 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t search -regexp -backward -all "foo\nbar\nfoo" end +} -cleanup { + destroy .t +} -result {5.0 1.0} +test text-22.173 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -- {(\$)?[\w:_]+} 1.9 +} -cleanup { + destroy .t +} -result {1.7} +test text-22.174 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.5 +} -cleanup { + destroy .t +} -result {1.7} +test text-22.175 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.7 +} -cleanup { + destroy .t +} -result {1.7} +test text-22.176 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.8 +} -cleanup { + destroy .t +} -result {1.8} +test text-22.177 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.3 +} -cleanup { + destroy .t +} -result {1.7 1.3} +test text-22.178 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.13 +} -cleanup { + destroy .t +} -result {} +test text-22.179 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -all -- {(\$)?[\w:_]+} 2.0 1.3 +} -cleanup { + destroy .t +} -result {1.12 1.7 1.3} +test text-22.180 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 " aasda asdj werwer" + .t search -regexp -backward -all -- {(\$)?[\w:_]+} 1.3 +} -cleanup { + destroy .t +} -result {1.1 1.12 1.7 1.3} +test text-22.181 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\n" + .t search -regexp -backward -all -- {(\w+\n)+} end +} -cleanup { + destroy .t +} -result {1.0} +test text-22.182 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\n" + .t search -regexp -backward -all -- {(\w+\n)+} end 1.5 +} -cleanup { + destroy .t +} -result {2.0} +test text-22.183 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + .t search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 +} -cleanup { + destroy .t +} -result {2.0} +test text-22.184 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 20} +test text-22.185 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" set res {} lappend res \ - [list [.t2 search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo] \ - [list [.t2 search -regexp -all -count foo -- {(\w+)+} 1.0] $foo] -} {{1.0 20} {{1.0 2.0 3.0 4.0} {5 5 5 1}}} -test text-20.155 {TextSearchCmd, regexp search greedy} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - list [.t2 search -regexp -all -nolinestop -count foo -- {.*} 1.0] $foo -} {1.0 20} -test text-20.156 {TextSearchCmd, regexp search greedy} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - list [.t2 search -regexp -all -count foo -- {.*} 1.0] $foo -} {{1.0 2.0 3.0 4.0} {5 5 5 1}} -test text-20.157 {TextSearchCmd, regexp search greedy multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - list [.t2 search -regexp -count foo -- {(\w+\n\w)+} 1.0] $foo -} {1.0 19} -test text-20.158 {TextSearchCmd, regexp search greedy multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - list [.t2 search -regexp -backwards -count foo -- {(\w+\n\w)+} end] $foo -} {1.0 19} -test text-20.159 {TextSearchCmd, regexp search greedy multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - list [.t2 search -regexp -all -backwards -count foo -- {(\w+\n\w)+} end] $foo -} {1.0 19} -test text-20.160 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - .t2 search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 -} {2.0} -test text-20.161 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - .t2 search -regexp -backward -all -- {(\w+\n\w)+} end 1.3 -} {1.3} -test text-20.162 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - list [.t2 search -regexp -forward -count foo -- {(\w+\n\w)+} 1.3] $foo -} {1.3 16} -test text-20.163 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - list [.t2 search -regexp -forward -all -count foo -- {(\w+\n\w)+} 1.3] $foo - # This result is somewhat debatable -- the two results do overlap, - # but only because the search has totally wrapped around back to - # the start. -} {{1.3 1.0} {16 19}} -test text-20.164 {TextSearchCmd, backward regexp search no-overlaps} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "abcde\nabcde\nabcde\na" - list [.t2 search -regexp -forward -all -count foo -- {(\w+\n\w)+} 1.0 1.3] $foo -} {1.0 19} -test text-20.165 {TextSearchCmd, regexp search multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" - list [.t2 search -regexp -forward -all -count foo -- {(a+\n(b+\n))+} 1.0] $foo -} {1.0 20} -test text-20.166 {TextSearchCmd, regexp search complex cases} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" - list [.t2 search -regexp -forward -all -count foo \ + [list [.t search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo] \ + [list [.t search -regexp -all -count foo -- {(\w+)+} 1.0] $foo] +} -cleanup { + destroy .t +} -result {{1.0 20} {{1.0 2.0 3.0 4.0} {5 5 5 1}}} +test text-22.186 {TextSearchCmd, regexp search greedy} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -all -nolinestop -count foo -- {.*} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 20} +test text-22.187 {TextSearchCmd, regexp search greedy} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -all -count foo -- {.*} 1.0] $foo +} -cleanup { + destroy .t +} -result {{1.0 2.0 3.0 4.0} {5 5 5 1}} +test text-22.188 {TextSearchCmd, regexp search greedy multi-line} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -count foo -- {(\w+\n\w)+} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 19} +test text-22.189 {TextSearchCmd, regexp search greedy multi-line} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -backwards -count foo -- {(\w+\n\w)+} end] $foo +} -cleanup { + destroy .t +} -result {1.0 19} +test text-22.190 {TextSearchCmd, regexp search greedy multi-line} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -all -backwards -count foo -- {(\w+\n\w)+} end] $foo +} -cleanup { + destroy .t +} -result {1.0 19} +test text-22.191 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + .t search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 +} -cleanup { + destroy .t +} -result {2.0} +test text-22.192 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + .t search -regexp -backward -all -- {(\w+\n\w)+} end 1.3 +} -cleanup { + destroy .t +} -result {1.3} +test text-22.193 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -forward -count foo -- {(\w+\n\w)+} 1.3] $foo +} -cleanup { + destroy .t +} -result {1.3 16} +test text-22.194 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -forward -all -count foo -- {(\w+\n\w)+} 1.3] $foo +# This result is somewhat debatable -- the two results do overlap, +# but only because the search has totally wrapped around back to +# the start. +} -cleanup { + destroy .t +} -result {{1.3 1.0} {16 19}} +test text-22.195 {TextSearchCmd, backward regexp search no-overlaps} -body { + pack [text .t] + .t insert 1.0 "abcde\nabcde\nabcde\na" + list [.t search -regexp -forward -all -count foo -- {(\w+\n\w)+} 1.0 1.3] $foo +} -cleanup { + destroy .t +} -result {1.0 19} +test text-22.196 {TextSearchCmd, regexp search multi-line} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" + list [.t search -regexp -forward -all -count foo -- {(a+\n(b+\n))+} 1.0] $foo +} -cleanup { + destroy .t +} -result {1.0 20} +test text-22.197 {TextSearchCmd, regexp search complex cases} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" + list [.t search -regexp -forward -all -count foo \ -- {(a+\n(b+\n))+} 1.0] $foo -} {1.0 20} -test text-20.167 {TextSearchCmd, regexp search multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" +} -cleanup { + destroy .t +} -result {1.0 20} +test text-22.198 {TextSearchCmd, regexp search multi-line} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} - list [.t2 search -regexp -forward -all -count foo \ + list [.t search -regexp -forward -all -count foo \ -- {(b+\nc+\nb+)\na+} 1.0] $foo -} {2.0 19} -test text-20.168 {TextSearchCmd, regexp search multi-line} {knownBug} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" +} -cleanup { + destroy .t +} -result {2.0 19} +test text-22.199 {TextSearchCmd, regexp search multi-line} -constraints { + knownBug +} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} - list [.t2 search -regexp -forward -all -count foo \ + list [.t search -regexp -forward -all -count foo \ -- {(a+|b+\nc+\nb+)\na+} 1.0] $foo -} {2.0 19} -test text-20.169 {TextSearchCmd, regexp search multi-line} {knownBug} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" +} -cleanup { + destroy .t +} -result {2.0 19} +test text-22.200 {TextSearchCmd, regexp search multi-line} -constraints { + knownBug +} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} - list [.t2 search -regexp -forward -all -count foo \ + list [.t search -regexp -forward -all -count foo \ -- {(a+|b+\nc+\nb+)+\na+} 1.0] $foo -} {2.0 19} -test text-20.170 {TextSearchCmd, regexp search multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" +} -cleanup { + destroy .t +} -result {2.0 19} +test text-22.201 {TextSearchCmd, regexp search multi-line} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" set foo {} - list [.t2 search -regexp -forward -all -count foo \ + list [.t search -regexp -forward -all -count foo \ -- {((a+|b+\nc+\nb+)+\n)+a+} 1.0] $foo -} {1.0 24} -test text-20.171 {TextSearchCmd, regexp search multi-line} {knownBug} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" - list [.t2 search -regexp -backward -all -count foo \ +} -cleanup { + destroy .t +} -result {1.0 24} +test text-22.202 {TextSearchCmd, regexp search multi-line} -constraints { + knownBug +} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" + list [.t search -regexp -backward -all -count foo \ -- {b+\n|a+\n(b+\n)+} end] $foo -} {1.0 25} -test text-20.172 {TextSearchCmd, regexp search multi-line} {knownBug} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" - .t2 search -regexp -backward -- {b+\n|a+\n(b+\n)+} end - # Should match at 1.0 for a true greedy match -} {1.0} -test text-20.172.1 {TextSearchCmd, regexp search multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "line0\nline1\nline1\nline1\nline1\nline2\nline2\nline2\nline3\n" - .t2 search -nolinestop -regexp -nocase -forwards -- {^(.*)\n(\1\n)+} 1.0 end - # Matches at 6.0 currently -} {2.0} -test text-20.173 {TextSearchCmd, regexp search multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "\naaaxxx\nyyy\n" +} -cleanup { + destroy .t +} -result {1.0 25} +test text-22.203 {TextSearchCmd, regexp search multi-line} -constraints { + knownBug +} -body { + pack [text .t] + .t insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" + .t search -regexp -backward -- {b+\n|a+\n(b+\n)+} end +# Should match at 1.0 for a true greedy match +} -cleanup { + destroy .t +} -result {1.0} +test text-22.204 {TextSearchCmd, regexp search multi-line} -body { + pack [text .t] + .t insert 1.0 "line0\nline1\nline1\nline1\nline1\nline2\nline2\nline2\nline3\n" + .t search -nolinestop -regexp -nocase -forwards -- {^(.*)\n(\1\n)+} 1.0 end +# Matches at 6.0 currently +} -cleanup { + destroy .t +} -result {2.0} +test text-22.205 {TextSearchCmd, regexp search multi-line} -setup { + pack [text .t] set res {} - lappend res [.t2 search -count c -regexp -- {x*\ny*} 2.0] $c - lappend res [.t2 search -count c -regexp -- {x*\ny*} 2.1] $c - set res -} {2.3 7 2.3 7} -test text-20.174 {TextSearchCmd, regexp search multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "\naaa\n\n\n\n\nxxx\n" +} -body { + .t insert 1.0 "\naaaxxx\nyyy\n" + lappend res [.t search -count c -regexp -- {x*\ny*} 2.0] $c + lappend res [.t search -count c -regexp -- {x*\ny*} 2.1] $c + return $res +} -cleanup { + destroy .t +} -result {2.3 7 2.3 7} +test text-22.206 {TextSearchCmd, regexp search multi-line} -setup { + pack [text .t] + set res {} +} -body { + .t insert 1.0 "\naaa\n\n\n\n\nxxx\n" + lappend res [.t search -count c -regexp -- {\n+} 2.0] $c + lappend res [.t search -count c -regexp -- {\n+} 2.1] $c + return $res +} -cleanup { + destroy .t +} -result {2.3 5 2.3 5} +test text-22.207 {TextSearchCmd, regexp search multi-line} -setup { + pack [text .t] set res {} - lappend res [.t2 search -count c -regexp -- {\n+} 2.0] $c - lappend res [.t2 search -count c -regexp -- {\n+} 2.1] $c - set res -} {2.3 5 2.3 5} -test text-20.175 {TextSearchCmd, regexp search multi-line} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "\naaa\n\n\t \n\t\t\t \n\nxxx\n" +} -body { + .t insert 1.0 "\naaa\n\n\t \n\t\t\t \n\nxxx\n" + lappend res [.t search -count c -regexp -- {(\n+(\t+ *)*)+} 2.0] $c + return $res +} -cleanup { + destroy .t +} -result {2.3 13} +test text-22.208 {TextSearchCmd, empty search range} -body { + pack [text .t] + .t insert 1.0 "a\na\na\n" + .t search -- a 2.0 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.209 {TextSearchCmd, empty search range} -body { + pack [text .t] + .t insert 1.0 "a\na\na\n" + .t search -backwards -- a 1.0 2.0 +} -cleanup { + destroy .t +} -result {} +test text-22.210 {TextSearchCmd, empty search range} -body { + pack [text .t] + .t insert 1.0 "a\na\na\n" + .t search -- a 1.0 1.0 +} -cleanup { + destroy .t +} -result {} +test text-22.211 {TextSearchCmd, empty search range} -body { + pack [text .t] + .t insert 1.0 "a\na\na\n" + .t search -backwards -- a 2.0 2.0 +} -cleanup { + destroy .t +} -result {} +test text-22.212 {TextSearchCmd, elide up to match} -setup { + pack [text .t] set res {} - lappend res [.t2 search -count c -regexp -- {(\n+(\t+ *)*)+} 2.0] $c - set res -} {2.3 13} -test text-20.176 {TextSearchCmd, empty search range} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "a\na\na\n" - .t2 search -- a 2.0 1.0 -} {} -test text-20.177 {TextSearchCmd, empty search range} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "a\na\na\n" - .t2 search -backwards -- a 1.0 2.0 -} {} -test text-20.178 {TextSearchCmd, empty search range} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "a\na\na\n" - .t2 search -- a 1.0 1.0 -} {} -test text-20.179 {TextSearchCmd, empty search range} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "a\na\na\n" - .t2 search -backwards -- a 2.0 2.0 -} {} -test text-20.180 {TextSearchCmd, elide up to match} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "a\nb\nc" - .t2 tag configure e -elide 1 +} -body { + .t insert 1.0 "a\nb\nc" + .t tag configure e -elide 1 + lappend res [.t search -regexp a 1.0] + lappend res [.t search -regexp b 1.0] + lappend res [.t search -regexp c 1.0] + .t tag add e 1.0 2.0 + lappend res [.t search -regexp a 1.0] + lappend res [.t search -regexp b 1.0] + lappend res [.t search -regexp c 1.0] + lappend res [.t search -elide -regexp a 1.0] + lappend res [.t search -elide -regexp b 1.0] + lappend res [.t search -elide -regexp c 1.0] +} -cleanup { + destroy .t +} -result {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-22.213 {TextSearchCmd, elide up to match, backwards} -setup { + pack [text .t] set res {} - lappend res [.t2 search -regexp a 1.0] - lappend res [.t2 search -regexp b 1.0] - lappend res [.t2 search -regexp c 1.0] - .t2 tag add e 1.0 2.0 - lappend res [.t2 search -regexp a 1.0] - lappend res [.t2 search -regexp b 1.0] - lappend res [.t2 search -regexp c 1.0] - lappend res [.t2 search -elide -regexp a 1.0] - lappend res [.t2 search -elide -regexp b 1.0] - lappend res [.t2 search -elide -regexp c 1.0] -} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} -test text-20.181 {TextSearchCmd, elide up to match, backwards} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "a\nb\nc" - .t2 tag configure e -elide 1 +} -body { + .t insert 1.0 "a\nb\nc" + .t tag configure e -elide 1 + lappend res [.t search -backward -regexp a 1.0] + lappend res [.t search -backward -regexp b 1.0] + lappend res [.t search -backward -regexp c 1.0] + .t tag add e 1.0 2.0 + lappend res [.t search -backward -regexp a 1.0] + lappend res [.t search -backward -regexp b 1.0] + lappend res [.t search -backward -regexp c 1.0] + lappend res [.t search -backward -elide -regexp a 1.0] + lappend res [.t search -backward -elide -regexp b 1.0] + lappend res [.t search -backward -elide -regexp c 1.0] +} -cleanup { + destroy .t +} -result {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-22.214 {TextSearchCmd, elide up to match} -setup { + pack [text .t] set res {} - lappend res [.t2 search -backward -regexp a 1.0] - lappend res [.t2 search -backward -regexp b 1.0] - lappend res [.t2 search -backward -regexp c 1.0] - .t2 tag add e 1.0 2.0 - lappend res [.t2 search -backward -regexp a 1.0] - lappend res [.t2 search -backward -regexp b 1.0] - lappend res [.t2 search -backward -regexp c 1.0] - lappend res [.t2 search -backward -elide -regexp a 1.0] - lappend res [.t2 search -backward -elide -regexp b 1.0] - lappend res [.t2 search -backward -elide -regexp c 1.0] -} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} -test text-20.182 {TextSearchCmd, elide up to match} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "a\nb\nc" - .t2 tag configure e -elide 1 +} -body { + .t insert 1.0 "a\nb\nc" + .t tag configure e -elide 1 + lappend res [.t search a 1.0] + lappend res [.t search b 1.0] + lappend res [.t search c 1.0] + .t tag add e 1.0 2.0 + lappend res [.t search a 1.0] + lappend res [.t search b 1.0] + lappend res [.t search c 1.0] + lappend res [.t search -elide a 1.0] + lappend res [.t search -elide b 1.0] + lappend res [.t search -elide c 1.0] +} -cleanup { + destroy .t +} -result {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-22.215 {TextSearchCmd, elide up to match, backwards} -setup { + pack [text .t] set res {} - lappend res [.t2 search a 1.0] - lappend res [.t2 search b 1.0] - lappend res [.t2 search c 1.0] - .t2 tag add e 1.0 2.0 - lappend res [.t2 search a 1.0] - lappend res [.t2 search b 1.0] - lappend res [.t2 search c 1.0] - lappend res [.t2 search -elide a 1.0] - lappend res [.t2 search -elide b 1.0] - lappend res [.t2 search -elide c 1.0] -} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} -test text-20.183 {TextSearchCmd, elide up to match, backwards} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "a\nb\nc" - .t2 tag configure e -elide 1 +} -body { + .t insert 1.0 "a\nb\nc" + .t tag configure e -elide 1 + lappend res [.t search -backward a 1.0] + lappend res [.t search -backward b 1.0] + lappend res [.t search -backward c 1.0] + .t tag add e 1.0 2.0 + lappend res [.t search -backward a 1.0] + lappend res [.t search -backward b 1.0] + lappend res [.t search -backward c 1.0] + lappend res [.t search -backward -elide a 1.0] + lappend res [.t search -backward -elide b 1.0] + lappend res [.t search -backward -elide c 1.0] +} -cleanup { + destroy .t +} -result {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-22.216 {TextSearchCmd, elide up to match} -setup { + pack [text .t] set res {} - lappend res [.t2 search -backward a 1.0] - lappend res [.t2 search -backward b 1.0] - lappend res [.t2 search -backward c 1.0] - .t2 tag add e 1.0 2.0 - lappend res [.t2 search -backward a 1.0] - lappend res [.t2 search -backward b 1.0] - lappend res [.t2 search -backward c 1.0] - lappend res [.t2 search -backward -elide a 1.0] - lappend res [.t2 search -backward -elide b 1.0] - lappend res [.t2 search -backward -elide c 1.0] -} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} -test text-20.184 {TextSearchCmd, elide up to match} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aa\nbb\ncc" - .t2 tag configure e -elide 1 +} -body { + .t insert 1.0 "aa\nbb\ncc" + .t tag configure e -elide 1 + lappend res [.t search ab 1.0] + lappend res [.t search bc 1.0] + .t tag add e 1.1 2.1 + lappend res [.t search ab 1.0] + lappend res [.t search b 1.0] + .t tag remove e 1.0 end + .t tag add e 2.1 3.1 + lappend res [.t search bc 1.0] + lappend res [.t search c 1.0] + .t tag remove e 1.0 end + .t tag add e 2.1 3.0 + lappend res [.t search bc 1.0] + lappend res [.t search c 1.0] +} -cleanup { + destroy .t +} -result {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} +test text-22.217 {TextSearchCmd, elide up to match} -setup { + pack [text .t] set res {} - lappend res [.t2 search ab 1.0] - lappend res [.t2 search bc 1.0] - .t2 tag add e 1.1 2.1 - lappend res [.t2 search ab 1.0] - lappend res [.t2 search b 1.0] - .t2 tag remove e 1.0 end - .t2 tag add e 2.1 3.1 - lappend res [.t2 search bc 1.0] - lappend res [.t2 search c 1.0] - .t2 tag remove e 1.0 end - .t2 tag add e 2.1 3.0 - lappend res [.t2 search bc 1.0] - lappend res [.t2 search c 1.0] -} {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} -test text-20.185 {TextSearchCmd, elide up to match} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "aa\nbb\ncc" - .t2 tag configure e -elide 1 +} -body { + .t insert 1.0 "aa\nbb\ncc" + .t tag configure e -elide 1 + lappend res [.t search -regexp ab 1.0] + lappend res [.t search -regexp bc 1.0] + .t tag add e 1.1 2.1 + lappend res [.t search -regexp ab 1.0] + lappend res [.t search -regexp b 1.0] + .t tag remove e 1.0 end + .t tag add e 2.1 3.1 + lappend res [.t search -regexp bc 1.0] + lappend res [.t search -regexp c 1.0] + .t tag remove e 1.0 end + .t tag add e 2.1 3.0 + lappend res [.t search -regexp bc 1.0] + lappend res [.t search -regexp c 1.0] +} -cleanup { + destroy .t +} -result {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} +test text-22.217.1 {elide up to match, with UTF-8 chars before the match} -setup { + pack [text .t] set res {} - lappend res [.t2 search -regexp ab 1.0] - lappend res [.t2 search -regexp bc 1.0] - .t2 tag add e 1.1 2.1 - lappend res [.t2 search -regexp ab 1.0] - lappend res [.t2 search -regexp b 1.0] - .t2 tag remove e 1.0 end - .t2 tag add e 2.1 3.1 - lappend res [.t2 search -regexp bc 1.0] - lappend res [.t2 search -regexp c 1.0] - .t2 tag remove e 1.0 end - .t2 tag add e 2.1 3.0 - lappend res [.t2 search -regexp bc 1.0] - lappend res [.t2 search -regexp c 1.0] -} {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} -test text-20.185.1 {TextSearchCmd, elide up to match, with UTF-8 chars before the match} { - deleteWindows - pack [text .t2] - .t2 tag configure e -elide 0 - .t2 insert end A {} xyz e bb\n - .t2 insert end \u00c4 {} xyz e bb +} -body { + .t tag configure e -elide 0 + .t insert end A {} xyz e bb\n + .t insert end \u00c4 {} xyz e bb set res {} - lappend res [.t2 search bb 1.0 "1.0 lineend"] - lappend res [.t2 search bb 2.0 "2.0 lineend"] - lappend res [.t2 search -regexp bb 1.0 "1.0 lineend"] - lappend res [.t2 search -regexp bb 2.0 "2.0 lineend"] - .t2 tag configure e -elide 1 - lappend res [.t2 search bb 1.0 "1.0 lineend"] - lappend res [.t2 search bb 2.0 "2.0 lineend"] - lappend res [.t2 search -regexp bb 1.0 "1.0 lineend"] - lappend res [.t2 search -regexp -elide bb 2.0 "2.0 lineend"] - lappend res [.t2 search -regexp bb 2.0 "2.0 lineend"] -} {1.4 2.4 1.4 2.4 1.4 2.4 1.4 2.4 2.4} -test text-20.186 {TextSearchCmd, strict limits} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "Hello world!\nThis is a test\n" - .t2 search -strictlimits -- "world" 1.3 1.8 -} {} -test text-20.187 {TextSearchCmd, strict limits} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "Hello world!\nThis is a test\n" - .t2 search -strictlimits -- "world" 1.3 1.10 -} {} -test text-20.188 {TextSearchCmd, strict limits} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "Hello world!\nThis is a test\n" - .t2 search -strictlimits -- "world" 1.3 1.11 -} {1.6} -test text-20.189 {TextSearchCmd, strict limits backwards} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "Hello world!\nThis is a test\n" - .t2 search -strictlimits -backward -- "world" 2.3 1.8 -} {} -test text-20.190 {TextSearchCmd, strict limits backwards} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "Hello world!\nThis is a test\n" - .t2 search -strictlimits -backward -- "world" 2.3 1.6 -} {1.6} -test text-20.191 {TextSearchCmd, strict limits backwards} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "Hello world!\nThis is a test\n" - .t2 search -strictlimits -backward -- "world" 2.3 1.7 -} {} -test text-20.192 {TextSearchCmd, strict limits} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "Hello world!\nThis is a test\n" - .t2 search -regexp -strictlimits -- "world" 1.3 1.8 -} {} -test text-20.193 {TextSearchCmd, strict limits} { - deleteWindows - pack [text .t2] - .t2 insert 1.0 "Hello world!\nThis is a test\n" - .t2 search -regexp -strictlimits -backward -- "world" 2.3 1.8 -} {} - -deleteWindows -text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 -pack .t2 -.t2 insert end "1\t2\t3\t4\t55.5" - -test text-21.1 {TkTextGetTabs procedure} { - list [catch {.t2 configure -tabs "\{{}"} msg] $msg -} {1 {unmatched open brace in list}} -test text-21.2 {TkTextGetTabs procedure} { - list [catch {.t2 configure -tabs xyz} msg] $msg -} {1 {bad screen distance "xyz"}} -test text-21.3 {TkTextGetTabs procedure} { - .t2 configure -tabs {100 200} + lappend res [.t search bb 1.0 "1.0 lineend"] + lappend res [.t search bb 2.0 "2.0 lineend"] + lappend res [.t search -regexp bb 1.0 "1.0 lineend"] + lappend res [.t search -regexp bb 2.0 "2.0 lineend"] + .t tag configure e -elide 1 + lappend res [.t search bb 1.0 "1.0 lineend"] + lappend res [.t search bb 2.0 "2.0 lineend"] + lappend res [.t search -regexp bb 1.0 "1.0 lineend"] + lappend res [.t search -regexp -elide bb 2.0 "2.0 lineend"] + lappend res [.t search -regexp bb 2.0 "2.0 lineend"] +} -cleanup { + destroy .t +} -result {1.4 2.4 1.4 2.4 1.4 2.4 1.4 2.4 2.4} +test text-22.218 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -- "world" 1.3 1.8 +} -cleanup { + destroy .t +} -result {} +test text-22.219 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -- "world" 1.3 1.10 +} -cleanup { + destroy .t +} -result {} +test text-22.220 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -- "world" 1.3 1.11 +} -cleanup { + destroy .t +} -result {1.6} +test text-22.221 {TextSearchCmd, strict limits backwards} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -backward -- "world" 2.3 1.8 +} -cleanup { + destroy .t +} -result {} +test text-22.222 {TextSearchCmd, strict limits backwards} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -backward -- "world" 2.3 1.6 +} -cleanup { + destroy .t +} -result {1.6} +test text-22.223 {TextSearchCmd, strict limits backwards} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -strictlimits -backward -- "world" 2.3 1.7 +} -cleanup { + destroy .t +} -result {} +test text-22.224 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -regexp -strictlimits -- "world" 1.3 1.8 +} -cleanup { + destroy .t +} -result {} +test text-22.225 {TextSearchCmd, strict limits} -body { + pack [text .t] + .t insert 1.0 "Hello world!\nThis is a test\n" + .t search -regexp -strictlimits -backward -- "world" 2.3 1.8 +} -cleanup { + destroy .t +} -result {} + + +test text-23.1 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs "\{{}" +} -cleanup { + destroy .t +} -returnCodes {error} -result {unmatched open brace in list} +test text-23.2 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs xyz +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad screen distance "xyz"} +test text-23.3 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {100 200} update idletasks - list [lindex [.t2 bbox 1.2] 0] [lindex [.t2 bbox 1.4] 0] -} {100 200} -test text-21.4 {TkTextGetTabs procedure} { - .t2 configure -tabs {100 right 200 left 300 center 400 numeric} + list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0] +} -cleanup { + destroy .t +} -result {100 200} +test text-23.4 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {100 right 200 left 300 center 400 numeric} update idletasks - list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \ - [lindex [.t2 bbox 1.4] 0] \ - [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \ - [lindex [.t2 bbox 1.10] 0] -} {100 200 300 400} -test text-21.5 {TkTextGetTabs procedure} { - .t2 configure -tabs {105 r 205 l 305 c 405 n} + list [expr [lindex [.t bbox 1.2] 0] + [lindex [.t bbox 1.2] 2]] \ + [lindex [.t bbox 1.4] 0] \ + [expr [lindex [.t bbox 1.6] 0] + [lindex [.t bbox 1.6] 2]/2] \ + [lindex [.t bbox 1.10] 0] +} -cleanup { + destroy .t +} -result {100 200 300 400} +test text-23.5 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {105 r 205 l 305 c 405 n} update idletasks - list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \ - [lindex [.t2 bbox 1.4] 0] \ - [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \ - [lindex [.t2 bbox 1.10] 0] -} {105 205 305 405} -test text-21.6 {TkTextGetTabs procedure} { - list [catch {.t2 configure -tabs {100 left 200 lork}} msg] $msg -} {1 {bad tab alignment "lork": must be left, right, center, or numeric}} -test text-21.7 {TkTextGetTabs procedure} { - list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg -} {1 {bad screen distance "!44"}} - -deleteWindows -text .t -pack .t -.t insert 1.0 "One Line" -.t mark set insert 1.0 - -test text-22.1 {TextDumpCmd procedure, bad args} { - list [catch {.t dump} msg] $msg -} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}} -test text-22.2 {TextDumpCmd procedure, bad args} { - list [catch {.t dump -all} msg] $msg -} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}} -test text-22.3 {TextDumpCmd procedure, bad args} { - list [catch {.t dump -command} msg] $msg -} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}} -test text-22.4 {TextDumpCmd procedure, bad args} { - list [catch {.t dump -bogus} msg] $msg -} {1 {bad option "-bogus": must be -all, -command, -image, -mark, -tag, -text, or -window}} -test text-22.5 {TextDumpCmd procedure, bad args} { - list [catch {.t dump bogus} msg] $msg -} {1 {bad text index "bogus"}} -test text-22.6 {TextDumpCmd procedure, one index} { + list [expr [lindex [.t bbox 1.2] 0] + [lindex [.t bbox 1.2] 2]] \ + [lindex [.t bbox 1.4] 0] \ + [expr [lindex [.t bbox 1.6] 0] + [lindex [.t bbox 1.6] 2]/2] \ + [lindex [.t bbox 1.10] 0] +} -cleanup { + destroy .t +} -result {105 205 305 405} +test text-23.6 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {100 left 200 lork} +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad tab alignment "lork": must be left, right, center, or numeric} +test text-23.7 {TkTextGetTabs procedure} -setup { + text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + pack .t +} -body { + .t insert end "1\t2\t3\t4\t55.5" + .t configure -tabs {100 !44 200 lork} +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad screen distance "!44"} + + +test text-24.1 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump +} -cleanup { + destroy .t +} -returnCodes {error} -result {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?} +test text-24.2 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump -all +} -cleanup { + destroy .t +} -returnCodes {error} -result {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?} +test text-24.3 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump -command +} -cleanup { + destroy .t +} -returnCodes {error} -result {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?} +test text-24.4 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump -bogus +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad option "-bogus": must be -all, -command, -image, -mark, -tag, -text, or -window} +test text-24.5 {TextDumpCmd procedure, bad args} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 + .t dump bogus +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad text index "bogus"} +test text-24.6 {TextDumpCmd procedure, one index} -body { + pack [text .t] + .t insert 1.0 "One Line" .t dump -text 1.2 -} {text e 1.2} -test text-22.7 {TextDumpCmd procedure, two indices} { +} -cleanup { + destroy .t +} -result {text e 1.2} +test text-24.7 {TextDumpCmd procedure, two indices} -body { + pack [text .t] + .t insert 1.0 "One Line" .t dump -text 1.0 1.end -} {text {One Line} 1.0} -test text-22.8 {TextDumpCmd procedure, "end" index} { +} -cleanup { + destroy .t +} -result {text {One Line} 1.0} +test text-24.8 {TextDumpCmd procedure, "end" index} -body { + pack [text .t] + .t insert 1.0 "One Line" .t dump -text 1.end end -} {text { +} -cleanup { + destroy .t +} -result {text { } 1.8} -test text-22.9 {TextDumpCmd procedure, same indices} { +test text-24.9 {TextDumpCmd procedure, same indices} -body { + pack [text .t] + .t insert 1.0 "One Line" .t dump 1.5 1.5 -} {} -test text-22.10 {TextDumpCmd procedure, negative range} { +} -cleanup { + destroy .t +} -result {} +test text-24.10 {TextDumpCmd procedure, negative range} -body { + pack [text .t] + .t insert 1.0 "One Line" + .t mark set insert 1.0 .t dump 1.5 1.0 -} {} -.t delete 1.0 end -.t insert end "Line One\nLine Two\nLine Three\nLine Four" -.t mark set insert 1.0 -.t mark set current 1.0 -test text-22.11 {TextDumpCmd procedure, stop at begin-line} { +} -cleanup { + destroy .t +} -result {} +test text-24.11 {TextDumpCmd procedure, stop at begin-line} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" .t dump -text 1.0 2.0 -} {text {Line One +} -cleanup { + destroy .t +} -result {text {Line One } 1.0} -test text-22.12 {TextDumpCmd procedure, span multiple lines} { +test text-24.12 {TextDumpCmd procedure, span multiple lines} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" .t dump -text 1.5 3.end -} {text {One +} -cleanup { + destroy .t +} -result {text {One } 1.5 text {Line Two } 2.0 text {Line Three} 3.0} -.t tag add x 2.0 2.end -.t tag add y 1.0 end -.t mark set m 2.4 -.t mark set n 4.0 -.t mark set END end -test text-22.13 {TextDumpCmd procedure, tags only} { +test text-24.13 {TextDumpCmd procedure, tags only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t tag add x 2.0 2.end + .t tag add y 1.0 end .t dump -tag 2.1 2.8 -} {} -test text-22.14 {TextDumpCmd procedure, tags only} { +} -cleanup { + destroy .t +} -result {} +test text-24.14 {TextDumpCmd procedure, tags only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t tag add x 2.0 2.end + .t tag add y 1.0 end .t dump -tag 2.0 2.8 -} {tagon x 2.0} -test text-22.15 {TextDumpCmd procedure, tags only} { +} -cleanup { + destroy .t +} -result {tagon x 2.0} +test text-24.15 {TextDumpCmd procedure, tags only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t tag add x 2.0 2.end + .t tag add y 1.0 end .t dump -tag 1.0 4.end -} {tagon y 1.0 tagon x 2.0 tagoff x 2.8} -test text-22.16 {TextDumpCmd procedure, tags only} { +} -cleanup { + destroy .t +} -result {tagon y 1.0 tagon x 2.0 tagoff x 2.8} +test text-24.16 {TextDumpCmd procedure, tags only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t tag add x 2.0 2.end + .t tag add y 1.0 end .t dump -tag 1.0 end -} {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0} -.t mark set insert 1.0 -.t mark set current 1.0 -test text-22.17 {TextDumpCmd procedure, marks only} { +} -cleanup { + destroy .t +} -result {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0} +test text-24.17 {TextDumpCmd procedure, marks only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 + .t mark set n 4.0 + .t mark set END end .t dump -mark 1.1 1.8 -} {} -test text-22.18 {TextDumpCmd procedure, marks only} { +} -cleanup { + destroy .t +} -result {} +test text-24.18 {TextDumpCmd procedure, marks only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 + .t mark set n 4.0 + .t mark set END end .t dump -mark 2.0 2.8 -} {mark m 2.4} -test text-22.19 {TextDumpCmd procedure, marks only} { +} -cleanup { + destroy .t +} -result {mark m 2.4} +test text-24.19 {TextDumpCmd procedure, marks only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 + .t mark set n 4.0 + .t mark set END end .t dump -mark 1.1 4.end -} {mark m 2.4 mark n 4.0} -test text-22.20 {TextDumpCmd procedure, marks only} { +} -cleanup { + destroy .t +} -result {mark m 2.4 mark n 4.0} +test text-24.20 {TextDumpCmd procedure, marks only} -body { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 + .t mark set n 4.0 + .t mark set END end .t dump -mark 1.0 end -} {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0} -button .hello -text Hello -.t window create 3.end -window .hello -for {set i 0} {$i < 100} {incr i} { - .t insert end "-\n" -} -.t window create 100.0 -create { } -test text-22.21 {TextDumpCmd procedure, windows only} { +} -cleanup { + destroy .t +} -result {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0} +test text-24.21 {TextDumpCmd procedure, windows only} -setup { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + for {set i 0} {$i < 100} {incr i} {.t insert end "-\n"} + button .hello -text Hello +} -body { + .t window create 3.end -window .hello + .t window create 100.0 -create { } .t dump -window 1.0 5.0 -} {window .hello 3.10} -test text-22.22 {TextDumpCmd procedure, windows only} { +} -cleanup { + destroy .t +} -result {window .hello 3.10} +test text-24.22 {TextDumpCmd procedure, windows only} -setup { + pack [text .t] + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + for {set i 0} {$i < 100} {incr i} {.t insert end "-\n"} + button .hello -text Hello +} -body { + .t window create 3.end -window .hello + .t window create 100.0 -create { } .t dump -window 5.0 end -} {window {} 100.0} -.t delete 1.0 end -eval {.t mark unset} [.t mark names] -.t insert end "Line One\nLine Two\nLine Three\nLine Four" -.t mark set insert 1.0 -.t mark set current 1.0 -.t tag add x 2.0 2.end -.t mark set m 2.4 -proc Append {varName key value index} { - upvar #0 $varName x - lappend x $key $index $value -} -test text-22.23 {TextDumpCmd procedure, command script} { +} -cleanup { + destroy .t +} -result {window {} 100.0} +test text-24.23 {TextDumpCmd procedure, command script} -setup { set x {} + pack [text .t] + proc Append {varName key value index} { + upvar #0 $varName x + lappend x $key $index $value + } +} -body { + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t tag add x 2.0 2.end + .t mark set m 2.4 .t dump -command {Append x} -all 1.0 end - set x -} {mark 1.0 current mark 1.0 insert text 1.0 {Line One + return $x +} -cleanup { + destroy .t + rename Append {} +} -result {mark 1.0 current mark 1.0 insert text 1.0 {Line One } tagon 2.0 x text 2.0 Line mark 2.4 m text 2.4 { Two} tagoff 2.8 x text 2.8 { } text 3.0 {Line Three } text 4.0 {Line Four }} -test text-22.24 {TextDumpCmd procedure, command script} { +test text-24.24 {TextDumpCmd procedure, command script} -setup { set x {} + pack [text .t] + proc Append {varName key value index} { + upvar #0 $varName x + lappend x $key $index $value + } +} -body { + .t insert end "Line One\nLine Two\nLine Three\nLine Four" + .t mark set insert 1.0 + .t mark set current 1.0 + .t mark set m 2.4 .t dump -mark -command {Append x} 1.0 end - set x -} {mark 1.0 current mark 1.0 insert mark 2.4 m} -catch {unset x} -test text-22.25 {TextDumpCmd procedure, unicode characters} { - catch {destroy .t} + return $x +} -cleanup { + destroy .t + rename Append {} +} -result {mark 1.0 current mark 1.0 insert mark 2.4 m} +test text-24.25 {TextDumpCmd procedure, unicode characters} -body { text .t - .t delete 1.0 end .t insert 1.0 \xb1\xb1\xb1 .t dump -all 1.0 2.0 -} "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3" -test text-22.26 {TextDumpCmd procedure, unicode characters} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3" +test text-24.26 {TextDumpCmd procedure, unicode characters} -body { text .t .t delete 1.0 end .t insert 1.0 abc\xb1\xb1\xb1 .t dump -all 1.0 2.0 -} "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6" -test text-22.27 {TextDumpCmd procedure, peer present} -setup { +} -cleanup { destroy .t -} -body { +} -result "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6" +test text-24.27 {TextDumpCmd procedure, peer present} -body { text .t .t peer create .t.t .t dump -all 1.0 end @@ -3035,21 +5984,18 @@ test text-22.27 {TextDumpCmd procedure, peer present} -setup { destroy .t } -result "mark insert 1.0 mark current 1.0 text {\n} 1.0" -set l [interp hidden] -deleteWindows - -test text-23.1 {text widget vs hidden commands} { - catch {destroy .t} +test text-25.1 {text widget vs hidden commands} -body { text .t + set y [list {} [interp hidden]] interp hide {} .t destroy .t - list [winfo children .] [interp hidden] -} [list {} $l] + set x [list [winfo children .] [interp hidden]] + expr {$x eq $y} +} -result {1} -test text-24.1 {bug fix - 1642} { - catch {destroy .t} - text .t - pack .t + +test text-26.1 {bug fix - 1642} -body { + pack [text .t] .t insert end "line 1\n" .t insert end "line 2\n" .t insert end "line 3\n" @@ -3057,16 +6003,24 @@ test text-24.1 {bug fix - 1642} { .t insert end "line 5\n" tk::TextSetCursor .t 3.0 .t search -backward -regexp "\$" insert 1.0 -} {2.6} - -test text-25.1 {TextEditCmd procedure, argument parsing} { - list [catch {.t edit} msg] $msg -} {1 {wrong # args: should be ".t edit option ?arg arg ...?"}} -test text-25.2 {TextEditCmd procedure, argument parsing} { - list [catch {.t edit gorp} msg] $msg -} {1 {bad edit option "gorp": must be modified, redo, reset, separator, or undo}} -test text-25.3 {TextEditUndo procedure, undoing changes} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {2.6} + + +test text-27.1 {TextEditCmd procedure, argument parsing} -body { + pack [text .t] + .t edit +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t edit option ?arg ...?"} +test text-27.2 {TextEditCmd procedure, argument parsing} -body { + pack [text .t] + .t edit gorp +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad edit option "gorp": must be modified, redo, reset, separator, or undo} +test text-27.3 {TextEditUndo procedure, undoing changes} -body { text .t -undo 1 pack .t .t insert end "line 1\n" @@ -3074,9 +6028,10 @@ test text-25.3 {TextEditUndo procedure, undoing changes} { .t insert end "should be gone after undo\n" .t edit undo .t get 1.0 end -} "line\n\n" -test text-25.4 {TextEditRedo procedure, redoing changes} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result "line\n\n" +test text-27.4 {TextEditRedo procedure, redoing changes} -body { text .t -undo 1 pack .t .t insert end "line 1\n" @@ -3085,9 +6040,10 @@ test text-25.4 {TextEditRedo procedure, redoing changes} { .t edit undo .t edit redo .t get 1.0 end -} "line\nshould be back after redo\n\n" -test text-25.5 {TextEditUndo procedure, resetting stack} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result "line\nshould be back after redo\n\n" +test text-27.5 {TextEditUndo procedure, resetting stack} -body { text .t -undo 1 pack .t .t insert end "line 1\n" @@ -3095,10 +6051,11 @@ test text-25.5 {TextEditUndo procedure, resetting stack} { .t insert end "should be back after redo\n" .t edit reset catch {.t edit undo} msg - set msg -} "nothing to undo" -test text-25.6 {TextEditCmd procedure, insert separator} { - catch {destroy .t} + return $msg +} -cleanup { + destroy .t +} -result "nothing to undo" +test text-27.6 {TextEditCmd procedure, insert separator} -body { text .t -undo 1 pack .t .t insert end "line 1\n" @@ -3106,9 +6063,10 @@ test text-25.6 {TextEditCmd procedure, insert separator} { .t insert end "line 2\n" .t edit undo .t get 1.0 end -} "line 1\n\n" -test text-25.7 {-autoseparators configuration option} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result "line 1\n\n" +test text-27.7 {-autoseparators configuration option} -body { text .t -undo 1 -autoseparators 0 pack .t .t insert end "line 1\n" @@ -3116,36 +6074,41 @@ test text-25.7 {-autoseparators configuration option} { .t insert end "line 2\n" .t edit undo .t get 1.0 end -} "\n" -test text-25.8 {TextEditCmd procedure, modified flag} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result "\n" +test text-27.8 {TextEditCmd procedure, modified flag} -body { text .t pack .t .t insert end "line 1\n" .t edit modified -} {1} -test text-25.9 {TextEditCmd procedure, reset modified flag} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {1} +test text-27.9 {TextEditCmd procedure, reset modified flag} -body { text .t pack .t .t insert end "line 1\n" .t edit modified 0 .t edit modified -} {0} -test text-25.10 {TextEditCmd procedure, set modified flag} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {0} +test text-27.10 {TextEditCmd procedure, set modified flag} -body { text .t pack .t .t edit modified 1 .t edit modified -} {1} -test text-25.10.1 {TextEditCmd procedure, set modified flag repeat} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {1} +test text-27.11 {TextEditCmd procedure, set modified flag repeat} -setup { text .t pack .t set ::retval {} +} -body { bind .t <<Modified>> "lappend ::retval modified" - # Shouldn't require [update idle] to trigger event [Bug 1809538] +# Shouldn't require [update idle] to trigger event [Bug 1809538] lappend ::retval [.t edit modified] .t edit modified 1 update idletasks @@ -3153,50 +6116,54 @@ test text-25.10.1 {TextEditCmd procedure, set modified flag repeat} { .t edit modified 1 ; # binding should only fire once [Bug 1799782] update idletasks lappend ::retval [.t edit modified] -} {0 modified 1 1} -test text-25.11 {<<Modified>> virtual event} { +} -cleanup { + destroy .t +} -result {0 modified 1 1} +test text-27.12 {<<Modified>> virtual event} -body { set ::retval unmodified - catch {destroy .t} text .t -undo 1 pack .t bind .t <<Modified>> "set ::retval modified" update idletasks .t insert end "nothing special\n" - set ::retval -} {modified} -test text-25.11.1 {<<Modified>> virtual event - insert before Modified} { - set ::retval {} + return $::retval +} -cleanup { destroy .t +} -result {modified} +test text-27.13 {<<Modified>> virtual event - insert before Modified} -body { + set ::retval {} pack [text .t -undo 1] bind .t <<Modified>> { set ::retval [.t get 1.0 end-1c] } update idletasks .t insert end "nothing special" - set ::retval -} {nothing special} -test text-25.11.2 {<<Modified>> virtual event - delete before Modified} { - # Bug 1737288, make sure we delete chars before triggering <<Modified>> - set ::retval {} + return $::retval +} -cleanup { destroy .t +} -result {nothing special} +test text-27.14 {<<Modified>> virtual event - delete before Modified} -body { +# Bug 1737288, make sure we delete chars before triggering <<Modified>> + set ::retval {} pack [text .t -undo 1] bind .t <<Modified>> { set ::retval [.t get 1.0 end-1c] } .t insert end "nothing special" .t edit modified 0 .t delete 1.0 1.2 set ::retval -} {thing special} -test text-25.12 {<<Selection>> virtual event} { +} -cleanup { + destroy .t +} -result {thing special} +test text-27.15 {<<Selection>> virtual event} -body { set ::retval no_selection - catch {destroy .t} - text .t -undo 1 - pack .t + pack [text .t -undo 1] bind .t <<Selection>> "set ::retval selection_changed" update idletasks .t insert end "nothing special\n" .t tag add sel 1.0 1.1 set ::retval -} {selection_changed} -test text-25.13 {-maxundo configuration option} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {selection_changed} +test text-27.16 {-maxundo configuration option} -body { text .t -undo 1 -autoseparators 1 -maxundo 2 pack .t .t insert end "line 1\n" @@ -3206,17 +6173,20 @@ test text-25.13 {-maxundo configuration option} { catch {.t edit undo} catch {.t edit undo} .t get 1.0 end -} "line 1\n\n" -test text-25.15 {bug fix 1536735 - undo with empty text} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result "line 1\n\n" +test text-27.17 {bug fix 1536735 - undo with empty text} -body { text .t -undo 1 set r [.t edit modified] .t delete 1.0 lappend r [.t edit modified] lappend r [catch {.t edit undo}] lappend r [.t edit modified] -} {0 0 1 0} -test text-25.18 {patch 1469210 - inserting after undo} -setup { +} -cleanup { + destroy .t +} -result {0 0 1 0} +test text-27.18 {patch 1469210 - inserting after undo} -setup { destroy .t } -body { text .t -undo 1 @@ -3242,8 +6212,8 @@ test text-25.19 {patch 1669632 (i) - undo after <Control-1>} -setup { } -cleanup { destroy .t } -result WORLD -test text-25.20 {patch 1669632 (iv) - undo after <Control-backslash>} -setup { - destroy .t +test text-25.20 {patch 1669632 (iv) - undo after <<SelectNone>>} -setup { + destroy .top .top.t } -body { toplevel .top pack [text .top.t -undo 1] @@ -3254,7 +6224,7 @@ test text-25.20 {patch 1669632 (iv) - undo after <Control-backslash>} -setup { .top.t tag add sel 1.10 1.12 update focus -force .top.t - event generate .top.t <Control-backslash> + event generate .top.t <<SelectNone>> .top.t insert insert " WORLD " .top.t edit undo .top.t get 1.5 1.10 @@ -3289,7 +6259,7 @@ test text-25.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { update focus -force .top.t event generate .top.t <Delete> - event generate .top.t <Shift-Right> + event generate .top.t <<SelectNextChar>> event generate .top.t <<Clear>> event generate .top.t <Delete> event generate .top.t <<Undo>> @@ -3309,7 +6279,7 @@ test text-25.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { update focus -force .top.t event generate .top.t <Delete> - event generate .top.t <Shift-Right> + event generate .top.t <<SelectNextChar>> event generate .top.t <<Cut>> event generate .top.t <Delete> event generate .top.t <<Undo>> @@ -3318,246 +6288,275 @@ test text-25.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { destroy .top.t .top } -result "This A an example text" -test text-26.1 {bug fix - 624372, ControlUtfProc long lines} { - destroy .t +test text-28.1 {bug fix - 624372, ControlUtfProc long lines} -body { pack [text .t -wrap none] .t insert end [string repeat "\1" 500] -} {} - -test text-27.1 {tabs - must be positive and must be increasing} { +} -cleanup { destroy .t +} -result {} + + +test text-29.1 {tabs - must be positive and must be increasing} -body { pack [text .t -wrap none] - list [catch {.t configure -tabs {0}} msg] $msg -} {1 {tab stop "0" is not at a positive distance}} -test text-27.2 {tabs - must be positive and must be increasing} { + .t configure -tabs {0} +} -cleanup { destroy .t +} -returnCodes {error} -result {tab stop "0" is not at a positive distance} +test text-29.2 {tabs - must be positive and must be increasing} -body { pack [text .t -wrap none] - list [catch {.t configure -tabs {-5}} msg] $msg -} {1 {tab stop "-5" is not at a positive distance}} -test text-27.3 {tabs - must be positive and must be increasing} {knownBug} { - # This bug will be fixed in Tk 9.0, when we can allow a minor - # incompatibility with Tk 8.x + .t configure -tabs {-5} +} -cleanup { destroy .t +} -returnCodes {error} -result {tab stop "-5" is not at a positive distance} +test text-29.3 {tabs - must be positive and must be increasing} -constraints { + knownBug +} -body { +# This bug will be fixed in Tk 9.0, when we can allow a minor +# incompatibility with Tk 8.x pack [text .t -wrap none] - list [catch {.t configure -tabs {10c 5c}} msg] $msg -} {1 {tabs must be monotonically increasing, but "5c" is smaller than or equal to the previous tab}} -test text-27.4 {tabs - must be positive and must be increasing} { + .t configure -tabs {10c 5c} +} -cleanup { destroy .t +} -returnCodes {error} -result {tabs must be monotonically increasing, but "5c" is smaller than or equal to the previous tab} +test text-29.4 {tabs - must be positive and must be increasing} -body { pack [text .t -wrap none] .t insert end "a\tb\tc\td\te" catch {.t configure -tabs {10c 5c}} update ; update ; update - # This test must simply not go into an infinite loop to succeed +# This test must simply not go into an infinite loop to succeed + set result 1 +} -cleanup { + destroy .t +} -result {1} + + +test text-30.1 {repeated insert and scroll} -body { + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview moveto 1 + } +# This test must simply not crash to succeed + set result 1 +} -cleanup { + destroy .t +} -result {1} +test text-30.2 {repeated insert and scroll} -body { + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview scroll 1 pages + } +# This test must simply not crash to succeed + set result 1 +} -cleanup { + destroy .t +} -result {1} +test text-30.3 {repeated insert and scroll} -body { + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview scroll 100 pixels + } +# This test must simply not crash to succeed set result 1 -} {1} - -test text-28.0 {repeated insert and scroll} { - foreach subcmd { - {moveto 1} - {scroll 1 pages} - {scroll 100 pixels} - {scroll 10 units} - } { - destroy .t - pack [text .t] - for {set i 0} {$i < 30} {incr i} { - .t insert end "blabla\n" - eval .t yview $subcmd - } +} -cleanup { + destroy .t +} -result {1} +test text-30.4 {repeated insert and scroll} -body { + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview scroll 10 units } - # This test must simply not crash to succeed +# This test must simply not crash to succeed set result 1 -} {1} - -test text-29.0 {peer widgets} { - destroy .t .tt - toplevel .tt - pack [text .t] - pack [.t peer create .tt.t] - destroy .t .tt -} {} -test text-29.1 {peer widgets} { - destroy .t .t1 .t2 - toplevel .t1 - toplevel .t2 - pack [text .t] - pack [.t peer create .t1.t] - pack [.t peer create .t2.t] +} -cleanup { + destroy .t +} -result {1} + + +test text-31.1 {peer widgets} -body { + toplevel .top + pack [text .t] + pack [.t peer create .top.t] + destroy .t .top +} -result {} +test text-31.2 {peer widgets} -body { + toplevel .top1 + toplevel .top2 + pack [text .t] + pack [.t peer create .top1.t] + pack [.t peer create .top2.t] .t insert end "abcd\nabcd" update - destroy .t1 + destroy .top1 update .t insert end "abcd\nabcd" update - destroy .t .t2 + destroy .t .top2 update -} {} -test text-29.2 {peer widgets} { - destroy .t .t1 .t2 - toplevel .t1 - toplevel .t2 +} -result {} +test text-31.3 {peer widgets} -body { + toplevel .top1 + toplevel .top2 pack [text .t] - pack [.t peer create .t1.t] - pack [.t peer create .t2.t] + pack [.t peer create .top1.t] + pack [.t peer create .top2.t] .t insert end "abcd\nabcd" update destroy .t update - .t2.t insert end "abcd\nabcd" + .top2.t insert end "abcd\nabcd" update - destroy .t .t2 + destroy .t .top2 update -} {} -test text-29.3 {peer widgets} { - destroy .t .tt - toplevel .tt +} -result {} +test text-31.4 {peer widgets} -body { + toplevel .top pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .tt.t -start 5 -end 11] + pack [.t peer create .top.t -start 5 -end 11] update - destroy .t .tt -} {} -test text-29.4 {peer widgets} { - destroy .t .tt - toplevel .tt + destroy .t .top +} -result {} +test text-31.5 {peer widgets} -body { + toplevel .top pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .tt.t -start 5 -end 11] - pack [.tt.t peer create .tt.t2] - set res [list [.tt.t index end] [.tt.t2 index end]] + pack [.t peer create .top.t -start 5 -end 11] + pack [.top.t peer create .top.t2] + set res [list [.top.t index end] [.top.t2 index end]] update - destroy .t .tt - set res -} {7.0 7.0} -test text-29.4.1 {peer widgets} { - destroy .t .tt - toplevel .tt + return $res +} -cleanup { + destroy .t .top +} -result {7.0 7.0} +test text-31.6 {peer widgets} -body { + toplevel .top pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .tt.t -start 5 -end 11] - pack [.tt.t peer create .tt.t2 -start {} -end {}] - set res [list [.tt.t index end] [.tt.t2 index end]] + pack [.t peer create .top.t -start 5 -end 11] + pack [.top.t peer create .top.t2 -start {} -end {}] + set res [list [.top.t index end] [.top.t2 index end]] update - destroy .t .tt - set res -} {7.0 21.0} -test text-29.5 {peer widgets} { - destroy .t .tt - toplevel .tt + return $res +} -cleanup { + destroy .t .top +} -result {7.0 21.0} +test text-31.7 {peer widgets} -body { + toplevel .top pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .tt.t -start 5 -end 11] + pack [.t peer create .top.t -start 5 -end 11] update ; update - set p1 [.tt.t count -update -ypixels 1.0 end] + set p1 [.top.t count -update -ypixels 1.0 end] set p2 [.t count -update -ypixels 5.0 11.0] - if {$p1 == $p2} { - set res "ok" - } else { - set res "$p1 and $p2 not equal" - } - destroy .t .tt - set res -} {ok} -test text-29.6 {peer widgets} { - destroy .t .tt - toplevel .tt + expr {$p1 eq $p2} +} -cleanup { + destroy .t .top +} -result {1} +test text-31.8 {peer widgets} -body { + toplevel .top pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .tt.t -start 5 -end 11] + pack [.t peer create .top.t -start 5 -end 11] update ; update .t delete 3.0 6.0 - set res [.tt.t index end] - destroy .t .tt - set res -} {6.0} -test text-29.7 {peer widgets} { - destroy .t .tt - toplevel .tt + .top.t index end +} -cleanup { + destroy .t .top +} -result {6.0} +test text-31.9 {peer widgets} -body { + toplevel .top pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - pack [.t peer create .tt.t -start 5 -end 11] + pack [.t peer create .top.t -start 5 -end 11] update ; update .t delete 8.0 12.0 - set res [.tt.t index end] - destroy .t .tt - set res -} {4.0} -test text-29.8 {peer widgets} { - destroy .t .tt - toplevel .tt + .top.t index end +} -cleanup { + destroy .t .top +} -result {4.0} +test text-31.10 {peer widgets} -body { + toplevel .top pack [text .t] - for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" } - pack [.t peer create .tt.t -start 5 -end 11] + pack [.t peer create .top.t -start 5 -end 11] update ; update .t delete 3.0 13.0 - set res [.tt.t index end] - destroy .t .tt - set res -} {1.0} -test text-29.9 {peer widgets} { - destroy .t + .top.t index end +} -cleanup { + destroy .t .top +} -result {1.0} +test text-31.11 {peer widgets} -setup { pack [text .t] + set res {} +} -body { for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 1.0 end-1c - set res {} lappend res [.t tag ranges sel] .t configure -start 10 -end 20 lappend res [.t tag ranges sel] + return $res +} -cleanup { destroy .t - set res -} {{1.0 100.0} {1.0 11.0}} -test text-29.10 {peer widgets} { - destroy .t +} -result {{1.0 100.0} {1.0 11.0}} +test text-31.12 {peer widgets} -setup { pack [text .t] + set res {} +} -body { for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 1.0 end-1c - set res {} lappend res [.t tag ranges sel] .t configure -start 11 lappend res [.t tag ranges sel] + return $res +} -cleanup { destroy .t - set res -} {{1.0 100.0} {1.0 90.0}} -test text-29.11 {peer widgets} { - destroy .t +} -result {{1.0 100.0} {1.0 90.0}} +test text-31.13 {peer widgets} -setup { pack [text .t] + set res {} +} -body { for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 1.0 end-1c - set res {} lappend res [.t tag ranges sel] .t configure -end 90 lappend res [.t tag ranges sel] destroy .t - set res -} {{1.0 100.0} {1.0 90.0}} -test text-29.12 {peer widgets} { + return $res +} -cleanup { destroy .t +} -result {{1.0 100.0} {1.0 90.0}} +test text-31.14 {peer widgets} -setup { pack [text .t] + set res {} +} -body { for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 1.0 3.0 5.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 - set res {} lappend res [.t tag prevrange sel 1.0] .t configure -start 6 -end 12 lappend res [.t tag ranges sel] @@ -3567,17 +6566,18 @@ test text-29.12 {peer widgets} { lappend res "prev" [.t tag prevrange sel 1.0] \ [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \ [.t tag prevrange sel 4.0] + return $res +} -cleanup { destroy .t - set res -} {{} {1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}} -test text-29.13 {peer widgets} { - destroy .t +} -result {{} {1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}} +test text-31.15 {peer widgets} -setup { pack [text .t] + set res {} +} -body { for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 1.0 3.0 9.0 11.0 13.0 15.0 17.0 19.0 - set res {} .t configure -start 6 -end 12 lappend res [.t tag ranges sel] lappend res "next" [.t tag nextrange sel 4.0] \ @@ -3586,17 +6586,18 @@ test text-29.13 {peer widgets} { lappend res "prev" [.t tag prevrange sel 1.0] \ [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \ [.t tag prevrange sel 4.0] + return $res +} -cleanup { destroy .t - set res -} {{4.0 6.0} next {4.0 6.0} {} {} {} prev {} {} {} {}} -test text-29.14 {peer widgets} { - destroy .t +} -result {{4.0 6.0} next {4.0 6.0} {} {} {} prev {} {} {} {}} +test text-31.16 {peer widgets} -setup { pack [text .t] + set res {} +} -body { for {set i 1} {$i < 20} {incr i} { .t insert end "Line $i\n" } .t tag add sel 1.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 - set res {} .t configure -start 6 -end 12 lappend res [.t tag ranges sel] lappend res "next" [.t tag nextrange sel 4.0] \ @@ -3605,16 +6606,17 @@ test text-29.14 {peer widgets} { lappend res "prev" [.t tag prevrange sel 1.0] \ [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \ [.t tag prevrange sel 4.0] + return $res +} -cleanup { destroy .t - set res -} {{1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}} -test text-29.15 {peer widgets} { - destroy .t +} -result {{1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}} +test text-31.17 {peer widgets} -setup { pack [text .t] + set res {} +} -body { for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - set res {} .t tag add sel 1.0 11.0 lappend res [.t tag ranges sel] lappend res [catch {.t configure -start 15 -end 10}] @@ -3623,58 +6625,61 @@ test text-29.15 {peer widgets} { lappend res [.t tag ranges sel] .t configure -start {} -end {} lappend res [.t tag ranges sel] + return $res +} -cleanup { destroy .t - set res -} {{1.0 11.0} 1 {1.0 11.0} {1.0 6.0} {1.0 11.0}} -test text-29.16 {peer widgets} { - destroy .t +} -result {{1.0 11.0} 1 {1.0 11.0} {1.0 6.0} {1.0 11.0}} +test text-31.18 {peer widgets} -setup { pack [text .t] + set res {} +} -body { for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - set res {} .t tag add sel 1.0 11.0 lappend res [.t index sel.first] lappend res [.t index sel.last] + return $res +} -cleanup { destroy .t - set res -} {1.0 11.0} -test text-29.17 {peer widgets} { - destroy .t +} -result {1.0 11.0} +test text-31.19 {peer widgets} -body { pack [text .t] for {set i 1} {$i < 20} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - set res {} .t tag delete sel - set res [list [catch {.t index sel.first} msg] $msg] + .t index sel.first +} -cleanup { destroy .t - set res -} {1 {text doesn't contain any characters tagged with "sel"}} +} -returnCodes {error} -result {text doesn't contain any characters tagged with "sel"} -proc makeText {} { - set w .g - set font "Times 11" - destroy .g - toplevel .g - frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken - set t $w.f.text - text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ - -height 35 -wrap word -highlightthickness 0 -borderwidth 0 - pack $t -expand yes -fill both - scrollbar $w.scroll -command "$t yview" - pack $w.scroll -side right -fill y - pack $w.f -expand yes -fill both - $t tag configure center -justify center -spacing1 5m -spacing3 5m - $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \ - -spacing1 3m -spacing2 0 -spacing3 0 - for {set i 0} {$i < 40} {incr i} { - $t insert end "${i}word " - } - return $t -} -test text-30.1 {line heights on creation} { +test text-32.1 {line heights on creation} -setup { + text .t + proc makeText {} { + set w .g + set font "Times 11" + destroy .g + toplevel .g + frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken + set t $w.f.text + text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font \ + -width 70 -height 35 -wrap word -highlightthickness 0 \ + -borderwidth 0 + pack $t -expand yes -fill both + scrollbar $w.scroll -command "$t yview" + pack $w.scroll -side right -fill y + pack $w.f -expand yes -fill both + $t tag configure center -justify center -spacing1 5m -spacing3 5m + $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \ + -spacing1 3m -spacing2 0 -spacing3 0 + for {set i 0} {$i < 40} {incr i} { + $t insert end "${i}word " + } + return $t + } +} -body { set w [makeText] update ; after 1000 ; update set before [$w count -ypixels 1.0 2.0] @@ -3682,63 +6687,88 @@ test text-30.1 {line heights on creation} { update set after [$w count -ypixels 1.0 2.0] destroy .g - if {$before != $after} { - set res "Count changed: $before $after" - } else { - set res "ok" - } -} {ok} - -destroy .t -text .t -test text-31.1 {TextWidgetCmd procedure, "peer" option} { - list [catch {.t peer foo 1} msg] $msg -} {1 {bad peer option "foo": must be create or names}} -test text-31.2 {TextWidgetCmd procedure, "peer" option} { - list [catch {.t peer names foo} msg] $msg -} {1 {wrong # args: should be ".t peer names"}} -test text-31.3 {TextWidgetCmd procedure, "peer" option} { - list [catch {.t p names} msg] $msg -} {0 {}} -test text-31.4 {TextWidgetCmd procedure, "peer" option} { + expr {$before eq $after} +} -cleanup { + destroy .t +} -result {1} + + +test text-33.1 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { + .t peer foo 1 +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad peer option "foo": must be create or names} +test text-33.2 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { + .t peer names foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {wrong # args: should be ".t peer names"} +test text-33.3 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { + .t p names +} -cleanup { + destroy .t +} -returnCodes {ok} -result {} +test text-33.4 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { .t peer names -} {} -test text-31.5 {TextWidgetCmd procedure, "peer" option} { - list [catch {.t peer create foo} msg] $msg -} {1 {bad window path name "foo"}} -test text-31.6 {TextWidgetCmd procedure, "peer" option} { - .t peer create .t2 +} -cleanup { + destroy .t +} -result {} +test text-33.5 {TextWidgetCmd procedure, "peer" option} -setup { + text .t +} -body { + .t peer create foo +} -cleanup { + destroy .t +} -returnCodes {error} -result {bad window path name "foo"} +test text-33.6 {TextWidgetCmd procedure, "peer" option} -setup { + text .t set res {} +} -body { + .t peer create .t2 lappend res [.t peer names] lappend res [.t2 peer names] destroy .t2 lappend res [.t peer names] -} {.t2 .t {}} -test text-31.7 {peer widget -start, -end} { - set res [list [catch {.t configure -start 10 -end 5} msg] $msg] - .t configure -start {} -end {} - set res -} {0 {}} -test text-31.8 {peer widget -start, -end} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {.t2 .t {}} +test text-33.7 {peer widget -start, -end} -body { + text .t + set res [.t configure -start 10 -end 5] + return $res +} -cleanup { + destroy .t +} -returnCodes {2} -result {} +test text-33.8 {peer widget -start, -end} -body { + text .t for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } - list [catch {.t configure -start 10 -end 5} msg] $msg -} {1 {-startline must be less than or equal to -endline}} -test text-31.9 {peer widget -start, -end} { - .t delete 1.0 end + .t configure -start 10 -end 5 +} -cleanup { + destroy .t +} -returnCodes {error} -result {-startline must be less than or equal to -endline} +test text-33.9 {peer widget -start, -end} -body { + text .t for {set i 1} {$i < 100} {incr i} { .t insert end "Line $i\n" } - set res [list [catch {.t configure -start 5 -end 10} msg] $msg] - .t configure -start {} -end {} - set res -} {0 {}} -test text-31.10 {peer widget -start, -end} { - .t delete 1.0 end + .t configure -start 5 -end 10 +} -cleanup { + destroy .t +} -returnCodes {ok} -result {} +test text-33.10 {peer widget -start, -end} -body { + text .t for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } set res [.t index end] lappend res [catch {.t configure -start 5 -end 10 -tab foo}] @@ -3747,12 +6777,14 @@ test text-31.10 {peer widget -start, -end} { lappend res [.t index end] .t configure -start {} -end {} lappend res [.t index end] - set res -} {101.0 1 101.0 1 101.0 101.0} -test text-31.11 {peer widget -start, -end} { - .t delete 1.0 end + return $res +} -cleanup { + destroy .t +} -result {101.0 1 101.0 1 101.0 101.0} +test text-33.11 {peer widget -start, -end} -body { + text .t for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } set res [.t index end] lappend res [catch {.t configure -start 5 -end 15}] @@ -3761,16 +6793,19 @@ test text-31.11 {peer widget -start, -end} { lappend res [.t index end] .t configure -start {} -end {} lappend res [.t index end] - set res -} {101.0 0 11.0 0 31.0 101.0} + return $res +} -cleanup { + destroy .t +} -result {101.0 0 11.0 0 31.0 101.0} -test text-32.1 {peer widget -start, -end and selection} { - .t delete 1.0 end +test text-34.1 {peer widget -start, -end and selection} -setup { + text .t + set res {} +} -body { for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add sel 10.0 20.0 - set res {} lappend res [.t tag ranges sel] .t configure -start 5 -end 30 lappend res [.t tag ranges sel] @@ -3784,8 +6819,10 @@ test text-32.1 {peer widget -start, -end and selection} { lappend res [.t tag ranges sel] .t configure -start {} -end {} lappend res [.t tag ranges sel] - set res -} {{10.0 20.0} {6.0 16.0} {6.0 11.0} {1.0 6.0} {1.0 2.0} {} {10.0 20.0}} + return $res +} -cleanup { + destroy .t +} -result {{10.0 20.0} {6.0 16.0} {6.0 11.0} {1.0 6.0} {1.0 2.0} {} {10.0 20.0}} test text-32.2 {peer widget -start, -end and deletion (bug 1630262)} -setup { destroy .t .pt @@ -3878,45 +6915,52 @@ test text-32.4 {peer widget -start, -end and deletion (bug 1630262)} -setup { .t delete 3.0 18.0 lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] } -cleanup { - destroy .pt + destroy .pt .t } -result {5 11 8 10 5 8 6 8 22 27 38 44 55 60 57 57} -test text-33.1 {widget dump -command alters tags} { - .t delete 1.0 end - .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c - .t tag configure b -background red - proc Dumpy {key value index} { - #puts "KK: $key, $value" +test text-35.1 {widget dump -command alters tags} -setup { + proc Dumpy {key value index} { +#puts "KK: $key, $value" .t tag add $value [list $index linestart] [list $index lineend] } - .t dump -all -command Dumpy 1.0 end - set result "ok" -} {ok} -test text-33.2 {widget dump -command makes massive changes} { - .t delete 1.0 end + text .t +} -body { .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c .t tag configure b -background red + .t dump -all -command Dumpy 1.0 end + set result "ok" +} -cleanup { + destroy .t +} -result {ok} +test text-35.2 {widget dump -command makes massive changes} -setup { proc Dumpy {key value index} { - #puts "KK: $key, $value" +#puts "KK: $key, $value" .t delete 1.0 end } - .t dump -all -command Dumpy 1.0 end - set result "ok" -} {ok} -test text-33.3 {widget dump -command destroys widget} { - .t delete 1.0 end + text .t +} -body { .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c .t tag configure b -background red + .t dump -all -command Dumpy 1.0 end + set result "ok" +} -cleanup { + destroy .t +} -result {ok} +test text-35.3 {widget dump -command destroys widget} -setup { proc Dumpy {key value index} { - #puts "KK: $key, $value" - destroy .t +#puts "KK: $key, $value" + destroy .t } + text .t +} -body { + .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c + .t tag configure b -background red .t dump -all -command Dumpy 1.0 end set result "ok" -} {ok} +} -cleanup { + destroy .t +} -result {ok} -deleteWindows -option clear test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup { proc bgerror {m} {set ::my_error $m} @@ -3931,7 +6975,6 @@ test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup { } -cleanup { destroy .t-1 } -result {} - test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup { proc bgerror {m} {set ::my_error $m} set ::my_error {} @@ -3945,7 +6988,6 @@ test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup { } -cleanup { destroy $w } -result {} - test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup { proc bgerror {m} {set ::my_error $m} set ::my_error {} @@ -3959,7 +7001,11 @@ test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup { } -cleanup { destroy $w } -result {} - + # cleanup cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/textBTree.test b/tests/textBTree.test index 1eb7c75..ebd6c50 100644 --- a/tests/textBTree.test +++ b/tests/textBTree.test @@ -8,642 +8,848 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -catch {destroy .t} +proc setup {} { + .t delete 1.0 100000.0 + .t tag delete x y + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + .t tag add x 1.1 + .t tag add x 1.5 1.13 + .t tag add x 2.2 2.6 + .t tag add y 1.5 +} + +# setup procedure for tests 10.*, 11.*, 12.* +proc msetup {} { + .t delete 1.0 100000.0 + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + .t mark set m1 1.2 + .t mark set l1 1.2 + .t mark gravity l1 left + .t mark set next 1.6 + .t mark set x 1.6 + .t mark set m2 2.0 + .t mark set m3 2.100 + .t tag add x 1.3 1.8 +} + +# setup procedure for tests 16.*, 17.*, 18.9 +proc setupBig {} { + .t delete 1.0 end + .t tag delete x y + .t tag configure x -foreground blue + .t tag configure y -underline true + # Create a Btree with 2002 lines (2000 + already existing + phantom at end) + # This generates a level 3 node with 9 children + # Most level 2 nodes cover 216 lines and have 6 children, except the last + # level 2 node covers 274 lines and has 7 children. + # Most level 1 nodes cover 36 lines and have 6 children, except the + # rightmost node has 58 lines and 9 children. + # Level 2: 2002 = 8*216 + 274 + # Level 1: 2002 = 54*36 + 58 + # Level 0: 2002 = 332*6 + 10 + for {set i 0} {$i < 2000} {incr i} { + append x "Line $i abcd efgh ijkl\n" + } + .t insert insert $x + .t debug 1 +} + +# Widget used in tests 1.* - 13.* +destroy .t text .t .t debug on -test btree-1.1 {basic insertions} { +test btree-1.1 {basic insertions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3\n" -test btree-1.2 {basic insertions} { +} -result "Line 1\nLine 2\nLine 3\n" +test btree-1.2 {basic insertions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 1.3 XXX .t get 1.0 1000000.0 -} "LinXXXe 1\nLine 2\nLine 3\n" -test btree-1.3 {basic insertions} { +} -result "LinXXXe 1\nLine 2\nLine 3\n" +test btree-1.3 {basic insertions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 3.0 YYY .t get 1.0 1000000.0 -} "Line 1\nLine 2\nYYYLine 3\n" -test btree-1.4 {basic insertions} { +} -result "Line 1\nLine 2\nYYYLine 3\n" +test btree-1.4 {basic insertions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.1 X\nYY .t get 1.0 1000000.0 -} "Line 1\nLX\nYYine 2\nLine 3\n" -test btree-1.5 {basic insertions} { +} -result "Line 1\nLX\nYYine 2\nLine 3\n" +test btree-1.5 {basic insertions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.0 X\n\n\n .t get 1.0 1000000.0 -} "Line 1\nX\n\n\nLine 2\nLine 3\n" -test btree-1.6 {basic insertions} { +} -result "Line 1\nX\n\n\nLine 2\nLine 3\n" +test btree-1.6 {basic insertions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.6 X\n .t get 1.0 1000000.0 -} "Line 1\nLine 2X\n\nLine 3\n" -test btree-1.7 {insertion before start of text} { +} -result "Line 1\nLine 2X\n\nLine 3\n" +test btree-1.7 {insertion before start of text} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 0.4 XXX .t get 1.0 1000000.0 -} "XXXLine 1\nLine 2\nLine 3\n" -test btree-1.8 {insertion past end of text} { +} -result "XXXLine 1\nLine 2\nLine 3\n" +test btree-1.8 {insertion past end of text} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 100.0 ZZ .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3ZZ\n" -test btree-1.9 {insertion before start of line} { +} -result "Line 1\nLine 2\nLine 3ZZ\n" +test btree-1.9 {insertion before start of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.-3 Q .t get 1.0 1000000.0 -} "Line 1\nQLine 2\nLine 3\n" -test btree-1.10 {insertion past end of line} { +} -result "Line 1\nQLine 2\nLine 3\n" +test btree-1.10 {insertion past end of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 2.40 XYZZY .t get 1.0 1000000.0 -} "Line 1\nLine 2XYZZY\nLine 3\n" -test btree-1.11 {insertion past end of last line} { +} -result "Line 1\nLine 2XYZZY\nLine 3\n" +test btree-1.11 {insertion past end of last line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t insert 3.40 ABC .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3ABC\n" +} -result "Line 1\nLine 2\nLine 3ABC\n" + -test btree-2.1 {basic deletions} { +test btree-2.1 {basic deletions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.0 1.3 .t get 1.0 1000000.0 -} "e 1\nLine 2\nLine 3\n" -test btree-2.2 {basic deletions} { +} -result "e 1\nLine 2\nLine 3\n" +test btree-2.2 {basic deletions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 2.2 .t get 1.0 1000000.0 -} "Line 1\nLie 2\nLine 3\n" -test btree-2.3 {basic deletions} { +} -result "Line 1\nLie 2\nLine 3\n" +test btree-2.3 {basic deletions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 2.0 2.3 .t get 1.0 1000000.0 -} "Line 1\ne 2\nLine 3\n" -test btree-2.4 {deleting whole lines} { +} -result "Line 1\ne 2\nLine 3\n" +test btree-2.4 {deleting whole lines} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.2 3.0 .t get 1.0 1000000.0 -} "LiLine 3\n" -test btree-2.5 {deleting whole lines} { +} -result "LiLine 3\n" +test btree-2.5 {deleting whole lines} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\n\n\nLine 5" .t delete 1.0 5.2 .t get 1.0 1000000.0 -} "ne 5\n" -test btree-2.6 {deleting before start of file} { +} -result "ne 5\n" +test btree-2.6 {deleting before start of file} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 0.3 1.2 .t get 1.0 1000000.0 -} "ne 1\nLine 2\nLine 3\n" -test btree-2.7 {deleting after end of file} { +} -result "ne 1\nLine 2\nLine 3\n" +test btree-2.7 {deleting after end of file} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 10.3 .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3\n" -test btree-2.8 {deleting before start of line} { +} -result "Line 1\nLine 2\nLine 3\n" +test btree-2.8 {deleting before start of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.-1 3.3 .t get 1.0 1000000.0 -} "Line 1\nLine 2\ne 3\n" -test btree-2.9 {deleting before start of line} { +} -result "Line 1\nLine 2\ne 3\n" +test btree-2.9 {deleting before start of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.-1 1.0 .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3\n" -test btree-2.10 {deleting after end of line} { +} -result "Line 1\nLine 2\nLine 3\n" +test btree-2.10 {deleting after end of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.8 2.1 .t get 1.0 1000000.0 -} "Line 1ine 2\nLine 3\n" -test btree-2.11 {deleting after end of last line} { +} -result "Line 1ine 2\nLine 3\n" +test btree-2.11 {deleting after end of last line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.8 4.1 .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3\n" -test btree-2.12 {deleting before start of file} { +} -result "Line 1\nLine 2\nLine 3\n" +test btree-2.12 {deleting before start of file} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.8 0.0 .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3\n" -test btree-2.13 {deleting past end of file} { +} -result "Line 1\nLine 2\nLine 3\n" +test btree-2.13 {deleting past end of file} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.8 4.0 .t get 1.0 1000000.0 -} "Line 1\n" -test btree-2.14 {deleting with end before start of line} { +} -result "Line 1\n" +test btree-2.14 {deleting with end before start of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.3 2.-3 .t get 1.0 1000000.0 -} "LinLine 2\nLine 3\n" -test btree-2.15 {deleting past end of line} { +} -result "LinLine 2\nLine 3\n" +test btree-2.15 {deleting past end of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.3 1.9 .t get 1.0 1000000.0 -} "Lin\nLine 2\nLine 3\n" -test btree-2.16 {deleting past end of line} { +} -result "Lin\nLine 2\nLine 3\n" +test btree-2.16 {deleting past end of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.2 3.15 .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLi\n" -test btree-2.17 {deleting past end of line} { +} -result "Line 1\nLine 2\nLi\n" +test btree-2.17 {deleting past end of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.0 3.15 .t get 1.0 1000000.0 -} "Line 1\nLine 2\n\n" -test btree-2.18 {deleting past end of line} { +} -result "Line 1\nLine 2\n\n" +test btree-2.18 {deleting past end of line} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 1.0 3.15 .t get 1.0 1000000.0 -} "\n" -test btree-2.19 {deleting with negative range} { +} -result "\n" +test btree-2.19 {deleting with negative range} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.2 2.4 .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3\n" -test btree-2.20 {deleting with negative range} { +} -result "Line 1\nLine 2\nLine 3\n" +test btree-2.20 {deleting with negative range} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.2 3.1 .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3\n" -test btree-2.21 {deleting with negative range} { +} -result "Line 1\nLine 2\nLine 3\n" +test btree-2.21 {deleting with negative range} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" .t delete 3.2 3.2 .t get 1.0 1000000.0 -} "Line 1\nLine 2\nLine 3\n" +} -result "Line 1\nLine 2\nLine 3\n" -proc setup {} { - .t delete 1.0 100000.0 - .t tag delete x y - .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" - .t tag add x 1.1 - .t tag add x 1.5 1.13 - .t tag add x 2.2 2.6 - .t tag add y 1.5 -} -test btree-3.1 {inserting with tags} { +test btree-3.1 {inserting with tags} -body { setup .t insert 1.0 XXX list [.t tag ranges x] [.t tag ranges y] -} {{1.4 1.5 1.8 1.16 2.2 2.6} {1.8 1.9}} -test btree-3.2 {inserting with tags} { +} -result {{1.4 1.5 1.8 1.16 2.2 2.6} {1.8 1.9}} +test btree-3.2 {inserting with tags} -body { setup .t insert 1.15 YYY list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 1.5 1.13 2.2 2.6} {1.5 1.6}} -test btree-3.3 {inserting with tags} { +} -result {{1.1 1.2 1.5 1.13 2.2 2.6} {1.5 1.6}} +test btree-3.3 {inserting with tags} -body { setup .t insert 1.7 ZZZZ list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 1.5 1.17 2.2 2.6} {1.5 1.6}} -test btree-3.4 {inserting with tags} { +} -result {{1.1 1.2 1.5 1.17 2.2 2.6} {1.5 1.6}} +test btree-3.4 {inserting with tags} -body { setup .t insert 1.7 \n\n list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 1.5 3.6 4.2 4.6} {1.5 1.6}} -test btree-3.5 {inserting with tags} { +} -result {{1.1 1.2 1.5 3.6 4.2 4.6} {1.5 1.6}} +test btree-3.5 {inserting with tags} -body { setup .t insert 1.5 A\n list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 2.0 2.8 3.2 3.6} {2.0 2.1}} -test btree-3.6 {inserting with tags} { +} -result {{1.1 1.2 2.0 2.8 3.2 3.6} {2.0 2.1}} +test btree-3.6 {inserting with tags} -body { setup .t insert 1.13 A\n list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 1.5 1.13 3.2 3.6} {1.5 1.6}} +} -result {{1.1 1.2 1.5 1.13 3.2 3.6} {1.5 1.6}} + -test btree-4.1 {deleting with tags} { +test btree-4.1 {deleting with tags} -body { setup .t delete 1.6 1.9 list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}} -test btree-4.2 {deleting with tags} { +} -result {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}} +test btree-4.2 {deleting with tags} -body { setup .t delete 1.1 2.3 list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.4} {}} -test btree-4.3 {deleting with tags} { +} -result {{1.1 1.4} {}} +test btree-4.3 {deleting with tags} -body { setup .t delete 1.4 2.1 list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 1.5 1.9} {}} -test btree-4.4 {deleting with tags} { +} -result {{1.1 1.2 1.5 1.9} {}} +test btree-4.4 {deleting with tags} -body { setup .t delete 1.14 2.1 list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 1.5 1.13 1.15 1.19} {1.5 1.6}} -test btree-4.5 {deleting with tags} { +} -result {{1.1 1.2 1.5 1.13 1.15 1.19} {1.5 1.6}} +test btree-4.5 {deleting with tags} -body { setup .t delete 1.0 2.10 list [.t tag ranges x] [.t tag ranges y] -} {{} {}} -test btree-4.6 {deleting with tags} { +} -result {{} {}} +test btree-4.6 {deleting with tags} -body { setup .t delete 1.0 1.5 list [.t tag ranges x] [.t tag ranges y] -} {{1.0 1.8 2.2 2.6} {1.0 1.1}} -test btree-4.7 {deleting with tags} { +} -result {{1.0 1.8 2.2 2.6} {1.0 1.1}} +test btree-4.7 {deleting with tags} -body { setup .t delete 1.6 1.9 list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}} -test btree-4.8 {deleting with tags} { +} -result {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}} +test btree-4.8 {deleting with tags} -body { setup .t delete 1.5 1.13 list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 2.2 2.6} {}} +} -result {{1.1 1.2 2.2 2.6} {}} -set bigText1 {} -for {set i 0} {$i < 10} {incr i} { - append bigText1 "Line $i\n" -} -set bigText2 {} -for {set i 0} {$i < 200} {incr i} { - append bigText2 "Line $i\n" -} -test btree-5.1 {very large inserts, with tags} { + +test btree-5.1 {very large inserts, with tags} -setup { + set bigText1 {} + for {set i 0} {$i < 10} {incr i} { + append bigText1 "Line $i\n" + } +} -body { setup .t insert 1.0 $bigText1 list [.t tag ranges x] [.t tag ranges y] -} {{11.1 11.2 11.5 11.13 12.2 12.6} {11.5 11.6}} -test btree-5.2 {very large inserts, with tags} { +} -result {{11.1 11.2 11.5 11.13 12.2 12.6} {11.5 11.6}} +test btree-5.2 {very large inserts, with tags} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.2 $bigText2 list [.t tag ranges x] [.t tag ranges y] -} {{1.1 1.2 201.3 201.11 202.2 202.6} {201.3 201.4}} -test btree-5.3 {very large inserts, with tags} { +} -result {{1.1 1.2 201.3 201.11 202.2 202.6} {201.3 201.4}} +test btree-5.3 {very large inserts, with tags} -body { setup for {set i 0} {$i < 200} {incr i} { - .t insert 1.8 "longer line $i\n" + .t insert 1.8 "longer line $i\n" } - list [.t tag ranges x] [.t tag ranges y] [.t get 1.0 1.100] [.t get 198.0 198.100] -} {{1.1 1.2 1.5 201.5 202.2 202.6} {1.5 1.6} {Text forlonger line 199} {longer line 2}} + list [.t tag ranges x] [.t tag ranges y] [.t get 1.0 1.100] \ + [.t get 198.0 198.100] +} -result {{1.1 1.2 1.5 201.5 202.2 202.6} {1.5 1.6} {Text forlonger line 199} {longer line 2}} -test btree-6.1 {very large deletes, with tags} { + +test btree-6.1 {very large deletes, with tags} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.1 $bigText2 .t delete 1.2 201.2 list [.t tag ranges x] [.t tag ranges y] -} {{1.4 1.12 2.2 2.6} {1.4 1.5}} -test btree-6.2 {very large deletes, with tags} { +} -result {{1.4 1.12 2.2 2.6} {1.4 1.5}} +test btree-6.2 {very large deletes, with tags} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.1 $bigText2 for {set i 0} {$i < 200} {incr i} { - .t delete 1.2 2.2 + .t delete 1.2 2.2 } list [.t tag ranges x] [.t tag ranges y] -} {{1.4 1.12 2.2 2.6} {1.4 1.5}} -test btree-6.3 {very large deletes, with tags} { +} -result {{1.4 1.12 2.2 2.6} {1.4 1.5}} +test btree-6.3 {very large deletes, with tags} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.1 $bigText2 .t delete 2.3 10000.0 .t get 1.0 1000.0 -} {TLine 0 +} -result {TLine 0 Lin } -test btree-6.4 {very large deletes, with tags} { +test btree-6.4 {very large deletes, with tags} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.1 $bigText2 for {set i 0} {$i < 100} {incr i} { - .t delete 30.0 31.0 + .t delete 30.0 31.0 } list [.t tag ranges x] [.t tag ranges y] -} {{101.0 101.1 101.4 101.12 102.2 102.6} {101.4 101.5}} -test btree-6.5 {very large deletes, with tags} { +} -result {{101.0 101.1 101.4 101.12 102.2 102.6} {101.4 101.5}} +test btree-6.5 {very large deletes, with tags} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.1 $bigText2 for {set i 0} {$i < 100} {incr i} { - set j [expr $i+2] - set k [expr 1+2*$i] - .t tag add x $j.1 $j.3 - .t tag add y $k.1 $k.6 + set j [expr $i+2] + set k [expr 1+2*$i] + .t tag add x $j.1 $j.3 + .t tag add y $k.1 $k.6 } .t delete 2.0 200.0 list [.t tag ranges x] [.t tag ranges y] -} {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}} -test btree-6.6 {very large deletes, with tags} { +} -result {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}} +test btree-6.6 {very large deletes, with tags} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.1 $bigText2 for {set i 0} {$i < 100} {incr i} { - set j [expr $i+2] - set k [expr 1+2*$i] - .t tag add x $j.1 $j.3 - .t tag add y $k.1 $k.6 + set j [expr $i+2] + set k [expr 1+2*$i] + .t tag add x $j.1 $j.3 + .t tag add y $k.1 $k.6 } for {set i 199} {$i >= 2} {incr i -1} { - .t delete $i.0 [expr $i+1].0 + .t delete $i.0 [expr $i+1].0 } list [.t tag ranges x] [.t tag ranges y] -} {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}} - -.t delete 1.0 end -.t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" -set i 1 -foreach check { - {1.3 1.6 1.7 2.0 {1.3 1.6 1.7 2.0}} - {1.3 1.6 1.6 2.0 {1.3 2.0}} - {1.3 1.6 1.4 2.0 {1.3 2.0}} - {2.0 4.3 1.4 1.10 {1.4 1.10 2.0 4.3}} - {2.0 4.3 1.4 1.end {1.4 1.19 2.0 4.3}} - {2.0 4.3 1.4 2.0 {1.4 4.3}} - {2.0 4.3 1.4 3.0 {1.4 4.3}} - {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 4.2 {1.1 4.2}} - {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.3 4.2 {1.2 4.2}} - {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 3.0 {1.1 4.0}} - {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.2 3.0 {1.2 4.0}} -} { - test btree-7.$i {tag addition and removal} { - .t tag remove x 1.0 end - while {[llength $check] > 2} { - .t tag add x [lindex $check 0] [lindex $check 1] - set check [lrange $check 2 end] - } - .t tag ranges x - } [lindex $check [expr [llength $check]-1]] - incr i -} +} -result {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}} + + +test btree-7.1 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {1.3 1.6 1.7 2.0} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.3 1.6 1.7 2.0} +test btree-7.2 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {1.3 1.6 1.6 2.0} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.3 2.0} +test btree-7.3 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {1.3 1.6 1.4 2.0} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.3 2.0} +test btree-7.4 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {2.0 4.3 1.4 1.10} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.4 1.10 2.0 4.3} +test btree-7.5 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {2.0 4.3 1.4 1.end} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.4 1.19 2.0 4.3} +test btree-7.6 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {2.0 4.3 1.4 2.0} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.4 4.3} +test btree-7.7 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {2.0 4.3 1.4 3.0} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.4 4.3} +test btree-7.8 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 4.2} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.1 4.2} +test btree-7.9 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.3 4.2} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.2 4.2} +test btree-7.10 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 3.0} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.1 4.0} +test btree-7.11 {tag addition and removal} -setup { + .t delete 1.0 end + .t tag remove x 1.0 end +} -body { + .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" + set check {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.2 3.0} + while {[llength $check]} { + .t tag add x [lindex $check 0] [lindex $check 1] + set check [lrange $check 2 end] + } + .t tag ranges x +} -result {1.2 4.0} -test btree-8.1 {tag addition and removal, weird ranges} { + +test btree-8.1 {tag addition and removal, weird ranges} -body { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 0.0 1.3 .t tag ranges x -} {1.0 1.3} -test btree-8.2 {tag addition and removal, weird ranges} { +} -result {1.0 1.3} +test btree-8.2 {tag addition and removal, weird ranges} -body { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 1.40 2.4 .t tag ranges x -} {1.19 2.4} -test btree-8.3 {tag addition and removal, weird ranges} { +} -result {1.19 2.4} +test btree-8.3 {tag addition and removal, weird ranges} -body { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 4.40 4.41 .t tag ranges x -} {} -test btree-8.4 {tag addition and removal, weird ranges} { +} -result {} +test btree-8.4 {tag addition and removal, weird ranges} -body { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 5.1 5.2 .t tag ranges x -} {} -test btree-8.5 {tag addition and removal, weird ranges} { +} -result {} +test btree-8.5 {tag addition and removal, weird ranges} -body { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 1.1 9.0 .t tag ranges x -} {1.1 5.0} -test btree-8.6 {tag addition and removal, weird ranges} { +} -result {1.1 5.0} +test btree-8.6 {tag addition and removal, weird ranges} -body { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 1.1 1.90 .t tag ranges x -} {1.1 1.19} -test btree-8.7 {tag addition and removal, weird ranges} { +} -result {1.1 1.19} +test btree-8.7 {tag addition and removal, weird ranges} -body { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 1.1 4.90 .t tag ranges x -} {1.1 4.17} -test btree-8.8 {tag addition and removal, weird ranges} { +} -result {1.1 4.17} +test btree-8.8 {tag addition and removal, weird ranges} -body { .t delete 1.0 100000.0 .t tag delete x .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 3.0 3.0 .t tag ranges x -} {} +} -result {} + -test btree-9.1 {tag names} { +test btree-9.1 {tag names} -body { setup .t tag names -} {sel x y} -test btree-9.2 {tag names} { +} -result {sel x y} +test btree-9.2 {tag names} -body { setup .t tag add tag1 1.8 .t tag add tag2 1.8 .t tag add tag3 1.7 1.9 .t tag names 1.8 -} {x tag1 tag2 tag3} -test btree-9.3 {lots of tag names} { +} -result {x tag1 tag2 tag3} +test btree-9.3 {lots of tag names} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.2 $bigText2 foreach i {tag1 foo ThisOne {x space} q r s t} { - .t tag add $i 150.2 + .t tag add $i 150.2 } foreach i {u tagA tagB tagC and more {$} \{} { - .t tag add $i 150.1 150.3 + .t tag add $i 150.1 150.3 } .t tag names 150.2 -} {tag1 foo ThisOne {x space} q r s t u tagA tagB tagC and more {$} \{} -test btree-9.4 {lots of tag names} { +} -result {tag1 foo ThisOne {x space} q r s t u tagA tagB tagC and more {$} \{} +test btree-9.4 {lots of tag names} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.2 $bigText2 .t tag delete tag1 foo ThisOne more {x space} q r s t u .t tag delete tagA tagB tagC and {$} \{ more foreach i {tag1 foo ThisOne more {x space} q r s t} { - .t tag add $i 150.2 + .t tag add $i 150.2 } foreach i {foo ThisOne u tagA tagB tagC and more {$} \{} { - .t tag add $i 150.4 + .t tag add $i 150.4 } .t tag delete tag1 more q r tagA .t tag names 150.2 -} {foo ThisOne {x space} s t} +} -result {foo ThisOne {x space} s t} -proc msetup {} { - .t delete 1.0 100000.0 - .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" - .t mark set m1 1.2 - .t mark set l1 1.2 - .t mark gravity l1 left - .t mark set next 1.6 - .t mark set x 1.6 - .t mark set m2 2.0 - .t mark set m3 2.100 - .t tag add x 1.3 1.8 -} -test btree-10.1 {basic mark facilities} { + +test btree-10.1 {basic mark facilities} -body { msetup list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3] -} {{current insert l1 m1 m2 m3 next x} 1.2 2.0 2.11} -test btree-10.2 {basic mark facilities} { +} -result {{current insert l1 m1 m2 m3 next x} 1.2 2.0 2.11} +test btree-10.2 {basic mark facilities} -body { msetup .t mark unset m2 lsort [.t mark names] -} {current insert l1 m1 m3 next x} -test btree-10.3 {basic mark facilities} { +} -result {current insert l1 m1 m3 next x} +test btree-10.3 {basic mark facilities} -body { msetup .t mark set m2 1.8 list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3] -} {{current insert l1 m1 m2 m3 next x} 1.2 1.8 2.11} +} -result {{current insert l1 m1 m2 m3 next x} 1.2 1.8 2.11} -test btree-11.1 {marks and inserts} { + +test btree-11.1 {marks and inserts} -body { msetup .t insert 1.1 abcde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.7 1.7 1.11 1.11 2.0 2.11} -test btree-11.2 {marks and inserts} { +} -result {1.7 1.7 1.11 1.11 2.0 2.11} +test btree-11.2 {marks and inserts} -body { msetup .t insert 1.2 abcde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.7 1.11 1.11 2.0 2.11} -test btree-11.3 {marks and inserts} { +} -result {1.2 1.7 1.11 1.11 2.0 2.11} +test btree-11.3 {marks and inserts} -body { msetup .t insert 1.3 abcde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.2 1.11 1.11 2.0 2.11} -test btree-11.4 {marks and inserts} { +} -result {1.2 1.2 1.11 1.11 2.0 2.11} +test btree-11.4 {marks and inserts} -body { msetup .t insert 1.1 ab\n\ncde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {3.4 3.4 3.8 3.8 4.0 4.11} -test btree-11.5 {marks and inserts} { +} -result {3.4 3.4 3.8 3.8 4.0 4.11} +test btree-11.5 {marks and inserts} -body { msetup .t insert 1.4 ab\n\ncde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.2 3.5 3.5 4.0 4.11} -test btree-11.6 {marks and inserts} { +} -result {1.2 1.2 3.5 3.5 4.0 4.11} +test btree-11.6 {marks and inserts} -body { msetup .t insert 1.7 ab\n\ncde list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.2 1.6 1.6 4.0 4.11} +} -result {1.2 1.2 1.6 1.6 4.0 4.11} + -test btree-12.1 {marks and deletes} { +test btree-12.1 {marks and deletes} -body { msetup .t delete 1.3 1.5 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.2 1.4 1.4 2.0 2.11} -test btree-12.2 {marks and deletes} { +} -result {1.2 1.2 1.4 1.4 2.0 2.11} +test btree-12.2 {marks and deletes} -body { msetup .t delete 1.3 1.8 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.2 1.3 1.3 2.0 2.11} -test btree-12.3 {marks and deletes} { +} -result {1.2 1.2 1.3 1.3 2.0 2.11} +test btree-12.3 {marks and deletes} -body { msetup .t delete 1.2 1.8 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.2 1.2 1.2 2.0 2.11} -test btree-12.4 {marks and deletes} { +} -result {1.2 1.2 1.2 1.2 2.0 2.11} +test btree-12.4 {marks and deletes} -body { msetup .t delete 1.1 1.8 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.1 1.1 1.1 1.1 2.0 2.11} -test btree-12.5 {marks and deletes} { +} -result {1.1 1.1 1.1 1.1 2.0 2.11} +test btree-12.5 {marks and deletes} -body { msetup .t delete 1.5 3.1 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.2 1.5 1.5 1.5 1.5} -test btree-12.6 {marks and deletes} { +} -result {1.2 1.2 1.5 1.5 1.5 1.5} +test btree-12.6 {marks and deletes} -body { msetup .t mark set m2 4.5 .t delete 1.5 4.1 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.2 1.5 1.5 1.9 1.5} -test btree-12.7 {marks and deletes} { +} -result {1.2 1.2 1.5 1.5 1.9 1.5} +test btree-12.7 {marks and deletes} -body { msetup .t mark set m2 4.5 .t mark set m3 4.5 .t mark set m1 4.7 .t delete 1.5 4.1 list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] -} {1.2 1.11 1.5 1.5 1.9 1.9} +} -result {1.2 1.11 1.5 1.5 1.9 1.9} -destroy .t -text .t -test btree-13.1 {tag searching} { + +test btree-13.1 {tag searching} -setup { .t delete 1.0 100000.0 +} -body { .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag next x 2.2 2.1 -} {} -test btree-13.2 {tag searching} { +} -result {} +test btree-13.2 {tag searching} -setup { .t delete 1.0 100000.0 +} -body { .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.2 2.4 .t tag next x 2.2 2.3 -} {2.2 2.4} -test btree-13.3 {tag searching} { +} -result {2.2 2.4} +test btree-13.3 {tag searching} -setup { .t delete 1.0 100000.0 +} -body { .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.2 2.4 .t tag next x 2.3 2.6 -} {} -test btree-13.4 {tag searching} { +} -result {} +test btree-13.4 {tag searching} -setup { .t delete 1.0 100000.0 +} -body { .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.5 2.8 .t tag next x 2.1 2.6 -} {2.5 2.8} -test btree-13.5 {tag searching} { +} -result {2.5 2.8} +test btree-13.5 {tag searching} -setup { .t delete 1.0 100000.0 +} -body { .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.5 2.8 .t tag next x 2.1 2.5 -} {} -test btree-13.6 {tag searching} { +} -result {} +test btree-13.6 {tag searching} -setup { .t delete 1.0 100000.0 +} -body { .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.1 2.4 .t tag next x 2.5 2.8 -} {} -test btree-13.7 {tag searching} { +} -result {} +test btree-13.7 {tag searching} -setup { .t delete 1.0 100000.0 +} -body { .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info" .t tag add x 2.5 2.8 .t tag next x 2.1 2.4 -} {} -test btree-13.8 {tag searching} { +} -result {} +test btree-13.8 {tag searching} -setup { + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.2 $bigText2 .t tag add x 190.3 191.2 .t tag next x 3.5 -} {190.3 191.2} +} -result {190.3 191.2} +destroy .t + -test btree-14.1 {check tag presence} { +test btree-14.1 {check tag presence} -setup { + destroy .t + text .t + set bigText2 {} + for {set i 0} {$i < 200} {incr i} { + append bigText2 "Line $i\n" + } +} -body { setup .t insert 1.2 $bigText2 .t tag add x 3.5 3.7 @@ -656,15 +862,20 @@ test btree-14.1 {check tag presence} { .t tag add b 7.5 .t tag add b 140.3 for {set i 120} {$i < 160} {incr i} { - .t tag add c $i.4 + .t tag add c $i.4 } foreach i {a1 a2 a3 a4 a5 a6 a7 a8 a9 10 a11 a12 a13} { - .t tag add $i 122.2 + .t tag add $i 122.2 } .t tag add x 141.3 .t tag names 141.1 -} {x y z} -test btree-14.2 {TkTextIsElided} { +} -cleanup { + destroy .t +} -result {x y z} +test btree-14.2 {TkTextIsElided} -setup { + destroy .t + text .t +} -body { .t delete 1.0 end .t tag config hidden -elide 1 .t insert end "Line1\nLine2\nLine3\n" @@ -673,235 +884,363 @@ test btree-14.2 {TkTextIsElided} { # next line used to panic because of "Bad tag priority being toggled on" # (see bug [382da038c9]) .t index "2.0 - 1 display line linestart" -} {1.0} +} -cleanup { + destroy .t +} -result {1.0} -test btree-15.1 {rebalance with empty node} { - catch {destroy .t} +test btree-15.1 {rebalance with empty node} -setup { + destroy .t +} -body { text .t .t debug 1 .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23" .t delete 6.0 12.0 .t get 1.0 end -} "1\n2\n3\n4\n5\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23\n" +} -cleanup { + destroy .t +} -result "1\n2\n3\n4\n5\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23\n" -proc setupBig {} { - .t delete 1.0 end - .t tag delete x y - .t tag configure x -foreground blue - .t tag configure y -underline true - # Create a Btree with 2002 lines (2000 + already existing + phantom at end) - # This generates a level 3 node with 9 children - # Most level 2 nodes cover 216 lines and have 6 children, except the last - # level 2 node covers 274 lines and has 7 children. - # Most level 1 nodes cover 36 lines and have 6 children, except the - # rightmost node has 58 lines and 9 children. - # Level 2: 2002 = 8*216 + 274 - # Level 1: 2002 = 54*36 + 58 - # Level 0: 2002 = 332*6 + 10 - for {set i 0} {$i < 2000} {incr i} { - append x "Line $i abcd efgh ijkl\n" - } - .t insert insert $x - .t debug 1 -} -test btree-16.1 {add tag does not push root above level 0} { - catch {destroy .t} +test btree-16.1 {add tag does not push root above level 0} -setup { + destroy .t text .t +} -body { setupBig + .t debug 0 .t tag add x 1.1 1.10 .t tag add x 5.1 5.10 .t tag ranges x -} {1.1 1.10 5.1 5.10} -test btree-16.2 {add tag pushes root up to level 1 node} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {1.1 1.10 5.1 5.10} +test btree-16.2 {add tag pushes root up to level 1 node} -setup { + destroy .t text .t - .t debug 1 +} -body { setupBig .t tag add x 1.1 1.10 .t tag add x 8.1 8.10 .t tag ranges x -} {1.1 1.10 8.1 8.10} -test btree-16.3 {add tag pushes root up to level 2 node} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {1.1 1.10 8.1 8.10} +test btree-16.3 {add tag pushes root up to level 2 node} -setup { + destroy .t + text .t +} -body { + setupBig .t tag add x 8.1 9.10 .t tag add x 180.1 180.end .t tag ranges x -} {8.1 9.10 180.1 180.23} -test btree-16.4 {add tag pushes root up to level 3 node} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {8.1 9.10 180.1 180.23} +test btree-16.4 {add tag pushes root up to level 3 node} -setup { + destroy .t + text .t +} -body { + setupBig .t tag add y 1.1 2000.0 .t tag add x 1.1 8.10 .t tag add x 180.end 217.0 list [.t tag ranges x] [.t tag ranges y] -} {{1.1 8.10 180.23 217.0} {1.1 2000.0}} -test btree-16.5 {add tag doesn't push root up} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {{1.1 8.10 180.23 217.0} {1.1 2000.0}} +test btree-16.5 {add tag doesn't push root up} -setup { + destroy .t + text .t +} -body { + setupBig .t tag add x 1.1 8.10 .t tag add x 2000.0 2000.3 .t tag add x 180.end 217.0 .t tag ranges x -} {1.1 8.10 180.23 217.0 2000.0 2000.3} -test btree-16.6 {two node splits at once pushes root up} { - .t delete 1.0 end +} -cleanup { + destroy .t +} -result {1.1 8.10 180.23 217.0 2000.0 2000.3} +test btree-16.6 {two node splits at once pushes root up} -setup { + destroy .t + text .t +} -body { for {set i 1} {$i < 10} {incr i} { - .t insert end "Line $i\n" + .t insert end "Line $i\n" } .t tag add x 8.0 8.end .t tag add y 9.0 end set x {} for {} {$i < 50} {incr i} { - append x "Line $i\n" + append x "Line $i\n" } .t insert end $x y list [.t tag ranges x] [.t tag ranges y] -} {{8.0 8.6} {9.0 51.0}} +} -cleanup { + destroy .t +} -result {{8.0 8.6} {9.0 51.0}} # The following find bugs in the SearchStart procedures -test btree-16.7 {Partial tag remove from before first range} { - .t tag remove x 1.0 end +test btree-16.7 {Partial tag remove from before first range} -setup { + destroy .t + text .t + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i\n" + } +} -body { .t tag add x 2.0 2.6 .t tag remove x 1.0 2.0 .t tag ranges x -} {2.0 2.6} -test btree-16.8 {Partial tag remove from before first range} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {2.0 2.6} +test btree-16.8 {Partial tag remove from before first range} -setup { + destroy .t + text .t + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i\n" + } +} -body { .t tag add x 2.0 2.6 .t tag remove x 1.0 2.1 .t tag ranges x -} {2.1 2.6} -test btree-16.9 {Partial tag remove from before first range} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {2.1 2.6} +test btree-16.9 {Partial tag remove from before first range} -setup { + destroy .t + text .t + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i\n" + } +} -body { .t tag add x 2.0 2.6 .t tag remove x 1.0 2.3 .t tag ranges x -} {2.3 2.6} -test btree-16.10 {Partial tag remove from before first range} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {2.3 2.6} +test btree-16.10 {Partial tag remove from before first range} -setup { + destroy .t + text .t + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i\n" + } +} -body { .t tag add x 1.0 2.6 .t tag remove x 1.0 2.5 .t tag ranges x -} {2.5 2.6} -test btree-16.11 {StartSearchBack boundary case} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {2.5 2.6} +test btree-16.11 {StartSearchBack boundary case} -setup { + destroy .t + text .t + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i\n" + } +} -body { .t tag add x 1.3 1.4 .t tag prevr x 2.0 1.4 -} {} -test btree-16.12 {StartSearchBack boundary case} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {} +test btree-16.12 {StartSearchBack boundary case} -setup { + destroy .t + text .t + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i\n" + } +} -body { .t tag add x 1.3 1.4 .t tag prevr x 2.0 1.3 -} {1.3 1.4} -test btree-16.13 {StartSearchBack boundary case} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {1.3 1.4} +test btree-16.13 {StartSearchBack boundary case} -setup { + destroy .t + text .t + for {set i 1} {$i < 10} {incr i} { + .t insert end "Line $i\n" + } +} -body { .t tag add x 1.0 1.4 .t tag prevr x 1.3 -} {1.0 1.4} +} -cleanup { + destroy .t +} -result {1.0 1.4} -test btree-17.1 {remove tag does not push root down} { - catch {destroy .t} +test btree-17.1 {remove tag does not push root down} -setup { + destroy .t text .t +} -body { .t debug 0 setupBig .t tag add x 1.1 5.10 .t tag remove x 3.1 5.end .t tag ranges x -} {1.1 3.1} -test btree-17.2 {remove tag pushes root from level 1 to level 0} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {1.1 3.1} +test btree-17.2 {remove tag pushes root from level 1 to level 0} -setup { + destroy .t + text .t +} -body { + setupBig .t tag add x 1.1 8.10 .t tag remove x 3.1 end .t tag ranges x -} {1.1 3.1} -test btree-17.3 {remove tag pushes root from level 2 to level 1} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {1.1 3.1} +test btree-17.3 {remove tag pushes root from level 2 to level 1} -setup { + destroy .t + text .t +} -body { + setupBig .t tag add x 1.1 180.10 .t tag remove x 35.1 end .t tag ranges x -} {1.1 35.1} -test btree-17.4 {remove tag doesn't change level 2} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {1.1 35.1} +test btree-17.4 {remove tag doesn't change level 2} -setup { + destroy .t + text .t +} -body { + setupBig .t tag add x 1.1 180.10 .t tag remove x 35.1 180.0 .t tag ranges x -} {1.1 35.1 180.0 180.10} -test btree-17.5 {remove tag pushes root from level 3 to level 0} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {1.1 35.1 180.0 180.10} +test btree-17.5 {remove tag pushes root from level 3 to level 0} -setup { + destroy .t + text .t +} -body { + setupBig .t tag add x 1.1 1.10 .t tag add x 2000.1 2000.10 .t tag remove x 1.0 2000.0 .t tag ranges x -} {2000.1 2000.10} -test btree-17.6 {text deletion pushes root from level 3 to level 0} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {2000.1 2000.10} +test btree-17.6 {text deletion pushes root from level 3 to level 0} -setup { + destroy .t + text .t +} -body { + setupBig .t tag add x 1.1 1.10 .t tag add x 2000.1 2000.10 .t delete 1.0 "1000.0 lineend +1 char" .t tag ranges x -} {1000.1 1000.10} +} -cleanup { + destroy .t +} -result {1000.1 1000.10} -catch {destroy .t} -text .t -test btree-18.1 {tag search back, no tag} { + +test btree-18.1 {tag search back, no tag} -setup { + destroy .t + text .t +} -body { .t insert 1.0 "Line 1 abcd efgh ijkl\n" .t tag prev x 1.1 1.1 -} {} -test btree-18.2 {tag search back, start at existing range} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {} +test btree-18.2 {tag search back, start at existing range} -setup { + destroy .t + text .t +} -body { + .t insert 1.0 "Line 1 abcd efgh ijkl\n" .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 .t tag prev x 1.1 -} {} -test btree-18.3 {tag search back, end at existing range} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {} +test btree-18.3 {tag search back, end at existing range} -setup { + destroy .t + text .t +} -body { + .t insert 1.0 "Line 1 abcd efgh ijkl\n" .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 .t tag prev x 1.3 1.1 -} {1.1 1.4} -test btree-18.4 {tag search back, start within range} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {1.1 1.4} +test btree-18.4 {tag search back, start within range} -setup { + destroy .t + text .t +} -body { + .t insert 1.0 "Line 1 abcd efgh ijkl\n" .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 .t tag prev x 1.10 1.0 -} {1.8 1.11} -test btree-18.5 {tag search back, start at end of range} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {1.8 1.11} +test btree-18.5 {tag search back, start at end of range} -setup { + destroy .t + text .t +} -body { + .t insert 1.0 "Line 1 abcd efgh ijkl\n" .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 list [.t tag prev x 1.4 1.0] [.t tag prev x 1.11 1.0] -} {{1.1 1.4} {1.8 1.11}} -test btree-18.6 {tag search back, start beyond range, same level 0 node} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {{1.1 1.4} {1.8 1.11}} +test btree-18.6 {tag search back, start beyond range, same level 0 node} -setup { + destroy .t + text .t +} -body { + .t insert 1.0 "Line 1 abcd efgh ijkl\n" .t tag add x 1.1 1.4 .t tag add x 1.8 1.11 .t tag add x 1.16 .t tag prev x 3.0 -} {1.16 1.17} -test btree-18.7 {tag search back, outside any range} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {1.16 1.17} +test btree-18.7 {tag search back, outside any range} -setup { + destroy .t + text .t +} -body { + .t insert 1.0 "Line 1 abcd efgh ijkl\n" .t tag add x 1.1 1.4 .t tag add x 1.16 .t tag prev x 1.8 1.5 -} {} -test btree-18.8 {tag search back, start at start of node boundary} { +} -cleanup { + destroy .t +} -result {} +test btree-18.8 {tag search back, start at start of node boundary} -setup { + destroy .t + text .t +} -body { setupBig - .t tag remove x 1.0 end .t tag add x 2.5 2.8 .t tag prev x 19.0 -} {2.5 2.8} -test btree-18.9 {tag search back, large complex btree spans} { - .t tag remove x 1.0 end +} -cleanup { + destroy .t +} -result {2.5 2.8} +test btree-18.9 {tag search back, large complex btree spans} -setup { + destroy .t + text .t +} -body { + setupBig .t tag add x 1.3 1.end .t tag add x 200.0 220.0 .t tag add x 500.0 520.0 list [.t tag prev x end] [.t tag prev x 433.0] -} {{500.0 520.0} {200.0 220.0}} - -destroy .t +} -cleanup { + destroy .t +} -result {{500.0 520.0} {200.0 220.0}} # cleanup cleanupTests diff --git a/tests/textImage.test b/tests/textImage.test index 47ea298..4bb190c 100644 --- a/tests/textImage.test +++ b/tests/textImage.test @@ -7,351 +7,446 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +imageInit # One time setup. Create a font to insure the tests are font metric invariant. - -catch {destroy .t} +destroy .t font create test_font -family courier -size 14 text .t -font test_font destroy .t -test textImage-1.1 {basic argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image} msg] $msg -} {1 {wrong # args: should be ".t image option ?arg arg ...?"}} - -test textImage-1.2 {basic argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image c} msg] $msg -} {1 {ambiguous option "c": must be cget, configure, create, or names}} - -test textImage-1.3 {cget argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image cget} msg] $msg -} {1 {wrong # args: should be ".t image cget index option"}} - -test textImage-1.4 {cget argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image cget blurf -flurp} msg] $msg -} {1 {bad text index "blurf"}} - -test textImage-1.5 {cget argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image cget 1.1 -flurp} msg] $msg -} {1 {no embedded image at index "1.1"}} - -test textImage-1.6 {configure argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image configure } msg] $msg -} {1 {wrong # args: should be ".t image configure index ?option value ...?"}} - -test textImage-1.7 {configure argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image configure blurf } msg] $msg -} {1 {bad text index "blurf"}} - -test textImage-1.8 {configure argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image configure 1.1 } msg] $msg -} {1 {no embedded image at index "1.1"}} - -test textImage-1.9 {create argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image create} msg] $msg -} {1 {wrong # args: should be ".t image create index ?option value ...?"}} - -test textImage-1.10 {create argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image create blurf } msg] $msg -} {1 {bad text index "blurf"}} - -test textImage-1.11 {basic argument checking} { - catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image create 1000.1000 -image small} msg] $msg -} {0 small} - -test textImage-1.12 {names argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image names dates places} msg] $msg -} {1 {wrong # args: should be ".t image names"}} - - -test textImage-1.13 {names argument checking} { - catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - set result "" - lappend result [.t image names] - .t image create insert -image small - lappend result [.t image names] - .t image create insert -image small - lappend result [.t image names] - .t image create insert -image small -name little - lappend result [.t image names] -} {{} small {small#1 small} {small#1 small little}} - -test textImage-1.14 {basic argument checking} { - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image huh} msg] $msg -} {1 {bad option "huh": must be cget, configure, create, or names}} - -test textImage-1.15 {align argument checking} { - catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - list [catch {.t image create end -image small -align wrong} msg] $msg -} {1 {bad align "wrong": must be baseline, bottom, center, or top}} - -test textImage-1.16 {configure} { - catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - .t image create end -image small - .t image configure small -} {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}} - -test textImage-1.17 {basic cget options} { - catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - .t image create end -image small - set result "" - foreach i {align padx pady image name} { - lappend result $i:[.t image cget small -$i] - } - set result -} {align:center padx:0 pady:0 image:small name:} - -test textImage-1.18 {basic configure options} { - catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - image create photo large -width 50 -height 50 - large put green -to 0 0 50 50 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - .t image create end -image small - set result "" - foreach {option value} {align top padx 5 pady 7 image large name none} { - .t image configure small -$option $value - } - update - .t image configure small -} {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}} - -test textImage-1.19 {basic image naming} { - catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - .t image create end -image small - .t image create end -image small -name small - .t image create end -image small -name small#6342 - .t image create end -image small -name small - lsort [.t image names] -} {small small#1 small#6342 small#6343} - -test textImage-2.1 {debug} { - catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - .t debug 1 - .t insert end front - .t image create end -image small - .t insert end back - .t delete small - .t image names - .t debug 0 -} {} - -test textImage-3.1 {image change propagation} { - catch { - image create photo vary -width 5 -height 5 - small put red -to 0 0 4 4 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - .t image create end -image vary -align top - update - set result "" - lappend result base:[.t bbox vary] - foreach i {10 20 40} { - vary configure -width $i -height $i - update - lappend result $i:[.t bbox vary] - } - set result -} {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}} - -test textImage-3.2 {delayed image management, see also bug 1591493} { - catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - } - catch {destroy .t} - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 - pack .t - .t image create end -name test - update - set result "" - foreach {x1 y1 w1 h1} [.t bbox test] {} - lappend result [list $x1 $w1 $h1] - .t image configure test -image small -align top - update - foreach {x2 y2 w2 h2} [.t bbox test] {} - lappend result [list [expr {$x1==$x2}] [expr {$w2>0}] [expr {$h2>0}]] -} {{0 0 0} {1 1 1}} +test textImage-1.1 {basic argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image +} -cleanup { + destroy .t +} -returnCodes error -result {wrong # args: should be ".t image option ?arg ...?"} + +test textImage-1.2 {basic argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image c +} -cleanup { + destroy .t +} -returnCodes error -result {ambiguous option "c": must be cget, configure, create, or names} + +test textImage-1.3 {cget argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image cget +} -cleanup { + destroy .t +} -returnCodes error -result {wrong # args: should be ".t image cget index option"} + +test textImage-1.4 {cget argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image cget blurf -flurp +} -cleanup { + destroy .t +} -returnCodes error -result {bad text index "blurf"} + +test textImage-1.5 {cget argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image cget 1.1 -flurp +} -cleanup { + destroy .t +} -returnCodes error -result {no embedded image at index "1.1"} + +test textImage-1.6 {configure argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image configure +} -cleanup { + destroy .t +} -returnCodes error -result {wrong # args: should be ".t image configure index ?-option value ...?"} + +test textImage-1.7 {configure argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image configure blurf +} -cleanup { + destroy .t +} -returnCodes error -result {bad text index "blurf"} + +test textImage-1.8 {configure argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image configure 1.1 +} -cleanup { + destroy .t +} -returnCodes error -result {no embedded image at index "1.1"} + +test textImage-1.9 {create argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create +} -cleanup { + destroy .t +} -returnCodes error -result {wrong # args: should be ".t image create index ?-option value ...?"} + +test textImage-1.10 {create argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create blurf +} -cleanup { + destroy .t +} -returnCodes error -result {bad text index "blurf"} + +test textImage-1.11 {basic argument checking} -setup { + destroy .t +} -body { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create 1000.1000 -image small +} -cleanup { + destroy .t + image delete small +} -returnCodes ok -result {small} + +test textImage-1.12 {names argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image names dates places +} -cleanup { + destroy .t +} -returnCodes error -result {wrong # args: should be ".t image names"} + + +test textImage-1.13 {names argument checking} -setup { + destroy .t + set result "" +} -body { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + lappend result [.t image names] + .t image create insert -image small + lappend result [.t image names] + .t image create insert -image small + lappend result [lsort [.t image names]] + .t image create insert -image small -name little + lappend result [lsort [.t image names]] +} -cleanup { + destroy .t + image delete small +} -result {{} small {small small#1} {little small small#1}} + +test textImage-1.14 {basic argument checking} -setup { + destroy .t +} -body { + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image huh +} -cleanup { + destroy .t +} -returnCodes error -result {bad option "huh": must be cget, configure, create, or names} + +test textImage-1.15 {align argument checking} -setup { + destroy .t +} -body { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image small -align wrong +} -cleanup { + destroy .t + image delete small +} -returnCodes error -result {bad align "wrong": must be baseline, bottom, center, or top} + +test textImage-1.16 {configure} -setup { + destroy .t +} -body { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image small + .t image configure small +} -cleanup { + destroy .t + image delete small +} -result {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}} + +test textImage-1.17 {basic cget options} -setup { + destroy .t + set result "" +} -body { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image small + foreach i {align padx pady image name} { + lappend result $i:[.t image cget small -$i] + } + return $result +} -cleanup { + destroy .t + image delete small +} -result {align:center padx:0 pady:0 image:small name:} + +test textImage-1.18 {basic configure options} -setup { + destroy .t + set result "" +} -body { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + image create photo large -width 50 -height 50 + large put green -to 0 0 50 50 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image small + foreach {option value} {align top padx 5 pady 7 image large name none} { + .t image configure small -$option $value + } + update + .t image configure small +} -cleanup { + destroy .t + image delete small large +} -result {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}} + +test textImage-1.19 {basic image naming} -setup { + destroy .t +} -body { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image small + .t image create end -image small -name small + .t image create end -image small -name small#6342 + .t image create end -image small -name small + lsort [.t image names] +} -cleanup { + destroy .t + image delete small +} -result {small small#1 small#6342 small#6343} + +test textImage-2.1 {debug} -setup { + destroy .t +} -body { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t debug 1 + .t insert end front + .t image create end -image small + .t insert end back + .t delete small + .t image names + .t debug 0 +} -cleanup { + destroy .t + image delete small +} -result {} + + +test textImage-3.1 {image change propagation} -setup { + destroy .t + set result "" +} -body { + catch { + image create photo vary -width 5 -height 5 + vary put red -to 0 0 4 4 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image vary -align top + update + lappend result base:[.t bbox vary] + foreach i {10 20 40} { + vary configure -width $i -height $i + update + lappend result $i:[.t bbox vary] + } + return $result +} -cleanup { + destroy .t + image delete vary +} -result {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}} + +test textImage-3.2 {delayed image management, see also bug 1591493} -setup { + destroy .t + set result "" +} -body { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -name test + update + foreach {x1 y1 w1 h1} [.t bbox test] {} + lappend result [list $x1 $w1 $h1] + .t image configure test -image small -align top + update + foreach {x2 y2 w2 h2} [.t bbox test] {} + lappend result [list [expr {$x1==$x2}] [expr {$w2>0}] [expr {$h2>0}]] +} -cleanup { + destroy .t + image delete small +} -result {{0 0 0} {1 1 1}} + # some temporary random tests -test textImage-4.1 {alignment checking - except baseline} { +test textImage-4.1 {alignment checking - except baseline} -setup { + destroy .t + set result "" +} -body { catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - image create photo large -width 50 -height 50 - large put green -to 0 0 50 50 + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + image create photo large -width 50 -height 50 + large put green -to 0 0 50 50 } - catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small .t insert end test update - set result "" lappend result default:[.t bbox small] foreach i {top bottom center} { - .t image configure small -align $i - update - lappend result [.t image cget small -align]:[.t bbox small] + .t image configure small -align $i + update + lappend result [.t image cget small -align]:[.t bbox small] } - set result -} {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}} - -test textImage-4.2 {alignment checking - baseline} { + return $result +} -cleanup { + destroy .t + image delete small large +} -result {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}} + +test textImage-4.2 {alignment checking - baseline} -setup { + destroy .t + set result "" +} -body { catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - image create photo large -width 50 -height 50 - large put green -to 0 0 50 50 + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + image create photo large -width 50 -height 50 + large put green -to 0 0 50 50 } - catch {destroy .t} font create test_font2 -size 5 text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small -align baseline .t insert end test - set result "" # Sizes larger than 25 can be too big and lead to a negative 'norm', # at least on Windows XP with certain settings. foreach size {10 15 20 25} { - font configure test_font2 -size $size - array set Metrics [font metrics test_font2] - update - foreach {x y w h} [.t bbox small] {} - set norm [expr { - (([image height large] - $Metrics(-linespace))/2 - + $Metrics(-ascent) - [image height small] - $y) - }] - lappend result "$size $norm" + font configure test_font2 -size $size + array set Metrics [font metrics test_font2] + update + foreach {x y w h} [.t bbox small] {} + set norm [expr { + (([image height large] - $Metrics(-linespace))/2 + + $Metrics(-ascent) - [image height small] - $y) + }] + lappend result "$size $norm" } + return $result +} -cleanup { + destroy .t + image delete small large font delete test_font2 unset Metrics - set result -} {{10 0} {15 0} {20 0} {25 0}} +} -result {{10 0} {15 0} {20 0} {25 0}} -test textImage-4.3 {alignment and padding checking} {fonts} { +test textImage-4.3 {alignment and padding checking} -constraints { + fonts +} -setup { + destroy .t + set result "" +} -body { catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - image create photo large -width 50 -height 50 - large put green -to 0 0 50 50 + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + image create photo large -width 50 -height 50 + large put green -to 0 0 50 50 } - catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small -padx 5 -pady 10 .t insert end test update - set result "" lappend result default:[.t bbox small] foreach i {top bottom center baseline} { - .t image configure small -align $i - update - lappend result $i:[.t bbox small] + .t image configure small -align $i + update + lappend result $i:[.t bbox small] } - set result -} {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}} + return $result +} -cleanup { + destroy .t + image delete small large +} -result {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}} + -test textImage-5.0 {peer widget images} { +test textImage-5.1 {peer widget images} -setup { + destroy .t .tt +} -body { catch { - image create photo small -width 5 -height 5 - small put red -to 0 0 4 4 - image create photo large -width 50 -height 50 - large put green -to 0 0 50 50 + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + image create photo large -width 50 -height 50 + large put green -to 0 0 50 50 } - catch {destroy .t .tt} pack [text .t] toplevel .tt pack [.t peer create .tt.t] @@ -360,13 +455,19 @@ test textImage-5.0 {peer widget images} { .t insert end test update destroy .t .tt -} {} +} -cleanup { + image delete small large +} -result {} # cleanup -catch {destroy .t} -foreach image [image names] {image delete $image} +destroy .t font delete test_font +imageFinish # cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/textIndex.test b/tests/textIndex.test index e78e54b..83a249e 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -804,7 +804,7 @@ test textIndex-19.12 {Display lines} { } {2.20} test textIndex-19.13 {Display lines} { - destroy .t + destroy {*}[pack slaves .] text .txt -height 1 -wrap word -yscroll ".sbar set" -width 400 scrollbar .sbar -command ".txt yview" grid .txt .sbar -sticky news diff --git a/tests/textMark.test b/tests/textMark.test index 67b9ae5..edd0e92 100644 --- a/tests/textMark.test +++ b/tests/textMark.test @@ -6,30 +6,20 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands -catch {destroy .t} +destroy .t text .t -width 20 -height 10 -testConstraint haveCourier12 [expr {[catch { - .t configure -font {Courier 12} -}] == 0}] pack append . .t {top expand fill} update .t debug on wm geometry . {} +entry .t.e .t peer create .pt -# The statements below reset the main window; it's needed if the window -# manager is mwm to make mwm forget about a previous minimum size setting. - -wm withdraw . -wm minsize . 1 1 -wm positionfrom . user -wm deiconify . - -entry .t.e .t insert 1.0 "Line 1 abcdefghijklm 12345 @@ -37,105 +27,120 @@ Line 4 bOy GIrl .#@? x_yz !@#$% Line 7" + +# The statements below reset the main window; it's needed if the window +# manager is mwm to make mwm forget about a previous minimum size setting. -test textMark-1.1 {TkTextMarkCmd - missing option} haveCourier12 { - list [catch {.t mark} msg] $msg -} {1 {wrong # args: should be ".t mark option ?arg arg ...?"}} -test textMark-1.2 {TkTextMarkCmd - bogus option} haveCourier12 { - list [catch {.t mark gorp} msg] $msg -} {1 {bad mark option "gorp": must be gravity, names, next, previous, set, or unset}} -test textMark-1.3 {TkTextMarkCmd - "gravity" option} haveCourier12 { - list [catch {.t mark gravity foo} msg] $msg -} {1 {there is no mark named "foo"}} -test textMark-1.4 {TkTextMarkCmd - "gravity" option} haveCourier12 { - .t mark unset x +wm withdraw . +wm minsize . 1 1 +wm positionfrom . user +wm deiconify . + +test textMark-1.1 {TkTextMarkCmd - missing option} -returnCodes error -body { + .t mark +} -result {wrong # args: should be ".t mark option ?arg ...?"} +test textMark-1.2 {TkTextMarkCmd - bogus option} -returnCodes error -body { + .t mark gorp +} -match glob -result {bad mark option "gorp": must be *} +test textMark-1.3 {TkTextMarkCmd - "gravity" option} -returnCodes error -body { + .t mark gravity foo +} -result {there is no mark named "foo"} +test textMark-1.4 {TkTextMarkCmd - "gravity" option} -body { .t mark set x 1.3 .t insert 1.3 x list [.t mark gravity x] [.t index x] -} {right 1.4} -test textMark-1.5 {TkTextMarkCmd - "gravity" option} haveCourier12 { - .t mark unset x +} -result {right 1.4} +test textMark-1.5 {TkTextMarkCmd - "gravity" option} -body { .t mark set x 1.3 .t mark g x left .t insert 1.3 x list [.t mark gravity x] [.t index x] -} {left 1.3} -test textMark-1.6 {TkTextMarkCmd - "gravity" option} haveCourier12 { - .t mark unset x +} -result {left 1.3} +test textMark-1.6 {TkTextMarkCmd - "gravity" option} -body { .t mark set x 1.3 .t mark gravity x right .t insert 1.3 x list [.t mark gravity x] [.t index x] -} {right 1.4} -test textMark-1.7 {TkTextMarkCmd - "gravity" option} haveCourier12 { - list [catch {.t mark gravity x gorp} msg] $msg -} {1 {bad mark gravity "gorp": must be left or right}} -test textMark-1.8 {TkTextMarkCmd - "gravity" option} haveCourier12 { - list [catch {.t mark gravity} msg] $msg -} {1 {wrong # args: should be ".t mark gravity markName ?gravity?"}} +} -result {right 1.4} +test textMark-1.7 {TkTextMarkCmd - "gravity" option} -returnCodes error -body { + .t mark set x 1.3 + .t mark gravity x gorp +} -result {bad mark gravity "gorp": must be left or right} +test textMark-1.8 {TkTextMarkCmd - "gravity" option} -returnCodes error -body { + .t mark gravity +} -result {wrong # args: should be ".t mark gravity markName ?gravity?"} -test textMark-2.1 {TkTextMarkCmd - "names" option} haveCourier12 { - list [catch {.t mark names 2} msg] $msg -} {1 {wrong # args: should be ".t mark names"}} -.t mark unset x -test textMark-2.2 {TkTextMarkCmd - "names" option} haveCourier12 { +test textMark-2.1 {TkTextMarkCmd - "names" option} -body { + .t mark names 2 +} -returnCodes error -result {wrong # args: should be ".t mark names"} +test textMark-2.2 {TkTextMarkCmd - "names" option} -setup { + .t mark unset {*}[.t mark names] +} -body { lsort [.t mark na] -} {current insert} -test textMark-2.3 {TkTextMarkCmd - "names" option} haveCourier12 { +} -result {current insert} +test textMark-2.3 {TkTextMarkCmd - "names" option} -setup { + .t mark unset {*}[.t mark names] +} -body { .t mark set a 1.1 .t mark set "b c" 2.3 lsort [.t mark names] -} {a {b c} current insert} +} -result {a {b c} current insert} -test textMark-3.1 {TkTextMarkCmd - "set" option} haveCourier12 { - list [catch {.t mark set a} msg] $msg -} {1 {wrong # args: should be ".t mark set markName index"}} -test textMark-3.2 {TkTextMarkCmd - "set" option} haveCourier12 { - list [catch {.t mark s a b c} msg] $msg -} {1 {wrong # args: should be ".t mark set markName index"}} -test textMark-3.3 {TkTextMarkCmd - "set" option} haveCourier12 { - list [catch {.t mark set a @x} msg] $msg -} {1 {bad text index "@x"}} -test textMark-3.4 {TkTextMarkCmd - "set" option} haveCourier12 { +test textMark-3.1 {TkTextMarkCmd - "set" option} -returnCodes error -body { + .t mark set a +} -result {wrong # args: should be ".t mark set markName index"} +test textMark-3.2 {TkTextMarkCmd - "set" option} -returnCodes error -body { + .t mark s a b c +} -result {wrong # args: should be ".t mark set markName index"} +test textMark-3.3 {TkTextMarkCmd - "set" option} -body { + .t mark set a @x +} -returnCodes error -result {bad text index "@x"} +test textMark-3.4 {TkTextMarkCmd - "set" option} -body { .t mark set a 1.2 .t index a -} 1.2 -test textMark-3.5 {TkTextMarkCmd - "set" option} haveCourier12 { +} -result 1.2 +test textMark-3.5 {TkTextMarkCmd - "set" option} -body { .t mark set a end .t index a -} {8.0} +} -result {8.0} -test textMark-4.1 {TkTextMarkCmd - "unset" option} haveCourier12 { - list [catch {.t mark unset} msg] $msg -} {0 {}} -test textMark-4.2 {TkTextMarkCmd - "unset" option} haveCourier12 { +test textMark-4.1 {TkTextMarkCmd - "unset" option} -body { + .t mark unset +} -result {} +test textMark-4.2 {TkTextMarkCmd - "unset" option} -body { + .t mark set a 1.2 + .t mark set b 2.3 + .t mark unset a b + .t index a +} -returnCodes error -result {bad text index "a"} +test textMark-4.2.1 {TkTextMarkCmd - "unset" option} -body { .t mark set a 1.2 .t mark set b 2.3 .t mark unset a b - list [catch {.t index a} msg] $msg [catch {.t index b} msg2] $msg2 -} {1 {bad text index "a"} 1 {bad text index "b"}} -test textMark-4.3 {TkTextMarkCmd - "unset" option} haveCourier12 { + .t index b +} -returnCodes error -result {bad text index "b"} +test textMark-4.3 {TkTextMarkCmd - "unset" option} -body { .t mark set a 1.2 .t mark set b 2.3 .t mark set 49ers 3.1 - eval .t mark unset [.t mark names] + .t mark unset {*}[.t mark names] lsort [.t mark names] -} {current insert} +} -result {current insert} -test textMark-5.1 {TkTextMarkCmd - miscellaneous} haveCourier12 { - list [catch {.t mark} msg] $msg -} {1 {wrong # args: should be ".t mark option ?arg arg ...?"}} -test textMark-5.2 {TkTextMarkCmd - miscellaneous} haveCourier12 { - list [catch {.t mark foo} msg] $msg -} {1 {bad mark option "foo": must be gravity, names, next, previous, set, or unset}} +test textMark-5.1 {TkTextMarkCmd - miscellaneous} -returnCodes error -body { + .t mark +} -result {wrong # args: should be ".t mark option ?arg ...?"} +test textMark-5.2 {TkTextMarkCmd - miscellaneous} -returnCodes error -body { + .t mark foo +} -result {bad mark option "foo": must be gravity, names, next, previous, set, or unset} -test textMark-6.1 {TkTextMarkSegToIndex} haveCourier12 { +test textMark-6.1 {TkTextMarkSegToIndex} -body { .t mark set a 1.2 .t mark set b 1.2 .t mark set c 1.2 .t mark set d 1.4 list [.t index a] [.t index b] [.t index c ] [.t index d] -} {1.2 1.2 1.2 1.4} +} -result {1.2 1.2 1.2 1.4} test textMark-6.2 {TkTextMarkNameToIndex, with mark outside -startline/-endline range - bug 1630271} -body { .t mark set insert 1.0 .t configure -startline 2 @@ -178,45 +183,53 @@ test textMark-6.5 {insert and current marks in an empty peer - bug 3487407} -bod .t configure -startline {} -endline {} } -result {1.0} -catch {eval {.t mark unset} [.t mark names]} -test textMark-7.1 {MarkFindNext - invalid mark name} haveCourier12 { - catch {.t mark next bogus} x - set x -} {bad text index "bogus"} -test textMark-7.2 {MarkFindNext - marks at same location} haveCourier12 { +test textMark-7.1 {MarkFindNext - invalid mark name} -body { + .t mark next bogus +} -returnCodes error -result {bad text index "bogus"} +test textMark-7.2 {MarkFindNext - marks at same location} -body { .t mark set insert 2.0 .t mark set current 2.0 .t mark next current -} {insert} -test textMark-7.3 {MarkFindNext - numerical starting mark} haveCourier12 { +} -result {insert} +test textMark-7.3 {MarkFindNext - numerical starting mark} -body { .t mark set current 1.0 .t mark set insert 1.0 .t mark next 1.0 -} {insert} -test textMark-7.4 {MarkFindNext - mark on the same line} haveCourier12 { +} -result {insert} +test textMark-7.4 {MarkFindNext - mark on the same line} -setup { + .t mark unset {*}[.t mark names] +} -body { .t mark set current 1.0 .t mark set insert 1.1 .t mark next current -} {insert} -test textMark-7.5 {MarkFindNext - mark on the next line} haveCourier12 { +} -result {insert} +test textMark-7.5 {MarkFindNext - mark on the next line} -setup { + .t mark unset {*}[.t mark names] +} -body { .t mark set current 1.end .t mark set insert 2.0 .t mark next current -} {insert} -test textMark-7.6 {MarkFindNext - mark far away} haveCourier12 { +} -result {insert} +test textMark-7.6 {MarkFindNext - mark far away} -setup { + .t mark unset {*}[.t mark names] +} -body { .t mark set current 1.2 .t mark set insert 7.0 .t mark next current -} {insert} -test textMark-7.7 {MarkFindNext - mark on top of end} haveCourier12 { +} -result {insert} +test textMark-7.7 {MarkFindNext - mark on top of end} -setup { + .t mark unset {*}[.t mark names] +} -body { .t mark set current end .t mark next end -} {current} -test textMark-7.8 {MarkFindNext - no next mark} haveCourier12 { +} -result {current} +test textMark-7.8 {MarkFindNext - no next mark} -setup { + .t mark unset {*}[.t mark names] +} -body { .t mark set current 1.0 .t mark set insert 3.0 .t mark next insert -} {} +} -result {} test textMark-7.9 {MarkFindNext - mark set in a text widget and retrieved from a peer} -setup { .t mark unset {*}[.t mark names] } -body { @@ -224,20 +237,15 @@ test textMark-7.9 {MarkFindNext - mark set in a text widget and retrieved from a lsort [list [.pt mark next 1.0] [.pt mark next mymark] [.pt mark next insert]] } -result {current insert mymark} -test textMark-8.1 {MarkFindPrev - invalid mark name} -constraints haveCourier12 -setup { - .t mark unset {*}[.t mark names] -} -body { - catch {.t mark prev bogus} x - set x -} -result {bad text index "bogus"} -test textMark-8.2 {MarkFindPrev - marks at same location} -constraints haveCourier12 -setup { - .t mark unset {*}[.t mark names] -} -body { +test textMark-8.1 {MarkFindPrev - invalid mark name} -body { + .t mark prev bogus +} -returnCodes error -result {bad text index "bogus"} +test textMark-8.2 {MarkFindPrev - marks at same location} -body { .t mark set insert 2.0 .t mark set current 2.0 .t mark prev insert } -result {current} -test textMark-8.3 {MarkFindPrev - numerical starting mark} -constraints haveCourier12 -setup { +test textMark-8.3 {MarkFindPrev - numerical starting mark} -setup { .t mark unset {*}[.t mark names] } -body { .t mark set current 1.0 @@ -258,21 +266,21 @@ test textMark-8.5 {MarkFindPrev - mark on the previous line} -setup { .t mark set insert 2.0 .t mark prev insert } -result {current} -test textMark-8.6 {MarkFindPrev - mark far away} -constraints haveCourier12 -setup { +test textMark-8.6 {MarkFindPrev - mark far away} -setup { .t mark unset {*}[.t mark names] } -body { .t mark set current 1.2 .t mark set insert 7.0 .t mark prev insert } -result {current} -test textMark-8.7 {MarkFindPrev - mark on top of end} -constraints haveCourier12 -setup { +test textMark-8.7 {MarkFindPrev - mark on top of end} -setup { .t mark unset {*}[.t mark names] } -body { .t mark set insert 3.0 .t mark set current end .t mark prev end } -result {insert} -test textMark-8.8 {MarkFindPrev - no previous mark} -constraints haveCourier12 -setup { +test textMark-8.8 {MarkFindPrev - no previous mark} -setup { .t mark unset {*}[.t mark names] } -body { .t mark set current 1.0 @@ -285,10 +293,14 @@ test textMark-8.9 {MarkFindPrev - mark set in a text widget and retrieved from a .t mark set mymark 1.0 lsort [list [.pt mark prev end] [.pt mark prev current] [.pt mark prev insert]] } -result {current insert mymark} - -catch {destroy .t} -catch {destroy .pt} + +destroy .pt +destroy .t # cleanup cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/textTag.test b/tests/textTag.test index be31ebb..fed073a 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -6,19 +6,21 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -namespace import -force tcltest::test -catch {destroy .t} +destroy .t text .t -width 20 -height 10 testConstraint haveCourier12 [expr {[catch { .t configure -font {Courier 12} }] == 0}] + pack append . .t {top expand fill} update .t debug on + wm geometry . {} set bigFont {Helvetica 24} @@ -30,9 +32,6 @@ wm minsize . 1 1 wm positionfrom . user wm deiconify . -entry .t.e -.t.e insert 0 "Text" - .t insert 1.0 "Line 1 abcdefghijklm 12345 @@ -41,112 +40,370 @@ bOy GIrl .#@? x_yz !@#$% Line 7" +test textTag-1.1 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -background #012345 + .t tag cget x -background +} -cleanup { + .t tag configure x -background [lindex [.t tag configure x -background] 3] +} -result {#012345} +test textTag-1.2 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -background non-existent +} -cleanup { + .t tag configure x -background [lindex [.t tag configure x -background] 3] +} -returnCodes error -result {unknown color name "non-existent"} +test textTag-1.3 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -bgstipple gray50 + .t tag cget x -bgstipple +} -cleanup { + .t tag configure x -bgstipple [lindex [.t tag configure x -bgstipple] 3] +} -result {gray50} +test textTag-1.4 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -bgstipple badStipple +} -cleanup { + .t tag configure x -bgstipple [lindex [.t tag configure x -bgstipple] 3] +} -returnCodes error -result {bitmap "badStipple" not defined} +test textTag-1.5 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -borderwidth 2 + .t tag cget x -borderwidth +} -cleanup { + .t tag configure x -borderwidth [lindex [.t tag configure x -borderwidth] 3] +} -result {2} +test textTag-1.6 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -borderwidth 46q +} -cleanup { + .t tag configure x -borderwidth [lindex [.t tag configure x -borderwidth] 3] +} -returnCodes error -result {bad screen distance "46q"} +test textTag-1.7 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -fgstipple gray25 + .t tag cget x -fgstipple +} -cleanup { + .t tag configure x -fgstipple [lindex [.t tag configure x -fgstipple] 3] +} -result {gray25} +test textTag-1.8 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -fgstipple bogus +} -cleanup { + .t tag configure x -fgstipple [lindex [.t tag configure x -fgstipple] 3] +} -returnCodes error -result {bitmap "bogus" not defined} +test textTag-1.9 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -font fixed + .t tag cget x -font +} -cleanup { + .t tag configure x -font [lindex [.t tag configure x -font] 3] +} -result {fixed} +test textTag-1.10 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -foreground #001122 + .t tag cget x -foreground +} -cleanup { + .t tag configure x -foreground [lindex [.t tag configure x -foreground] 3] +} -result {#001122} +test textTag-1.11 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -foreground {silly color} +} -cleanup { + .t tag configure x -foreground [lindex [.t tag configure x -foreground] 3] +} -returnCodes error -result {unknown color name "silly color"} +test textTag-1.12 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -justify left + .t tag cget x -justify +} -cleanup { + .t tag configure x -justify [lindex [.t tag configure x -justify] 3] +} -result {left} +test textTag-1.13 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -justify middle +} -cleanup { + .t tag configure x -justify [lindex [.t tag configure x -justify] 3] +} -returnCodes error -result {bad justification "middle": must be left, right, or center} +test textTag-1.14 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -lmargin1 10 + .t tag cget x -lmargin1 +} -cleanup { + .t tag configure x -lmargin1 [lindex [.t tag configure x -lmargin1] 3] +} -result {10} +test textTag-1.15 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -lmargin1 bad +} -cleanup { + .t tag configure x -lmargin1 [lindex [.t tag configure x -lmargin1] 3] +} -returnCodes error -result {bad screen distance "bad"} +test textTag-1.16 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -lmargin2 10 + .t tag cget x -lmargin2 +} -cleanup { + .t tag configure x -lmargin2 [lindex [.t tag configure x -lmargin2] 3] +} -result {10} +test textTag-1.17 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -lmargin2 bad +} -cleanup { + .t tag configure x -lmargin2 [lindex [.t tag configure x -lmargin2] 3] +} -returnCodes error -result {bad screen distance "bad"} +test textTag-1.18 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -offset 2 + .t tag cget x -offset +} -cleanup { + .t tag configure x -offset [lindex [.t tag configure x -offset] 3] +} -result {2} +test textTag-1.19 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -offset 100xyz +} -cleanup { + .t tag configure x -offset [lindex [.t tag configure x -offset] 3] +} -returnCodes error -result {bad screen distance "100xyz"} +test textTag-1.20 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -overstrike on + .t tag cget x -overstrike +} -cleanup { + .t tag configure x -overstrike [lindex [.t tag configure x -overstrike] 3] +} -result {on} +test textTag-1.21 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -overstrike stupid +} -cleanup { + .t tag configure x -overstrike [lindex [.t tag configure x -overstrike] 3] +} -returnCodes error -result {expected boolean value but got "stupid"} +test textTag-1.22 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -relief raised + .t tag cget x -relief +} -cleanup { + .t tag configure x -relief [lindex [.t tag configure x -relief] 3] +} -result {raised} +test textTag-1.23 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -relief stupid +} -cleanup { + .t tag configure x -relief [lindex [.t tag configure x -relief] 3] +} -returnCodes error -result {bad relief "stupid": must be flat, groove, raised, ridge, solid, or sunken} +test textTag-1.24 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -rmargin 10 + .t tag cget x -rmargin +} -cleanup { + .t tag configure x -rmargin [lindex [.t tag configure x -rmargin] 3] +} -result {10} +test textTag-1.25 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -rmargin bad +} -cleanup { + .t tag configure x -rmargin [lindex [.t tag configure x -rmargin] 3] +} -returnCodes error -result {bad screen distance "bad"} +test textTag-1.26 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -spacing1 10 + .t tag cget x -spacing1 +} -cleanup { + .t tag configure x -spacing1 [lindex [.t tag configure x -spacing1] 3] +} -result {10} +test textTag-1.27 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -spacing1 bad +} -cleanup { + .t tag configure x -spacing1 [lindex [.t tag configure x -spacing1] 3] +} -returnCodes error -result {bad screen distance "bad"} +test textTag-1.28 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -spacing2 10 + .t tag cget x -spacing2 +} -cleanup { + .t tag configure x -spacing2 [lindex [.t tag configure x -spacing2] 3] +} -result {10} +test textTag-1.29 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -spacing2 bad +} -cleanup { + .t tag configure x -spacing2 [lindex [.t tag configure x -spacing2] 3] +} -returnCodes error -result {bad screen distance "bad"} +test textTag-1.30 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -spacing3 10 + .t tag cget x -spacing3 +} -cleanup { + .t tag configure x -spacing3 [lindex [.t tag configure x -spacing3] 3] +} -result {10} +test textTag-1.31 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -spacing3 bad +} -cleanup { + .t tag configure x -spacing3 [lindex [.t tag configure x -spacing3] 3] +} -returnCodes error -result {bad screen distance "bad"} +test textTag-1.32 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -tabs {10 20 30} + .t tag cget x -tabs +} -cleanup { + .t tag configure x -tabs [lindex [.t tag configure x -tabs] 3] +} -result {10 20 30} +test textTag-1.33 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -tabs {10 fork} +} -cleanup { + .t tag configure x -tabs [lindex [.t tag configure x -tabs] 3] +} -returnCodes error -result {bad tab alignment "fork": must be left, right, center, or numeric} +test textTag-1.34 {tag configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -underline no + .t tag cget x -underline +} -cleanup { + .t tag configure x -underline [lindex [.t tag configure x -underline] 3] +} -result {no} +test textTag-1.35 {configuration options} -constraints { + haveCourier12 +} -body { + .t tag configure x -underline stupid +} -cleanup { + .t tag configure x -underline [lindex [.t tag configure x -underline] 3] +} -returnCodes error -result {expected boolean value but got "stupid"} -set i 1 -foreach test { - {-background #012345 #012345 non-existent - {unknown color name "non-existent"}} - {-bgstipple gray50 gray50 badStipple - {bitmap "badStipple" not defined}} - {-borderwidth 2 2 46q - {bad screen distance "46q"}} - {-fgstipple gray25 gray25 bogus - {bitmap "bogus" not defined}} - {-font fixed fixed {} - {font "" doesn't exist}} - {-foreground #001122 #001122 {silly color} - {unknown color name "silly color"}} - {-justify left left middle - {bad justification "middle": must be left, right, or center}} - {-lmargin1 10 10 bad - {bad screen distance "bad"}} - {-lmargin2 10 10 bad - {bad screen distance "bad"}} - {-offset 2 2 100xyz - {bad screen distance "100xyz"}} - {-overstrike on on stupid - {expected boolean value but got "stupid"}} - {-relief raised raised stupid - {bad relief type "stupid": must be flat, groove, raised, ridge, solid, or sunken}} - {-rmargin 10 10 bad - {bad screen distance "bad"}} - {-spacing1 10 10 bad - {bad screen distance "bad"}} - {-spacing2 10 10 bad - {bad screen distance "bad"}} - {-spacing3 10 10 bad - {bad screen distance "bad"}} - {-tabs {10 20 30} {10 20 30} {10 fork} - {bad tab alignment "fork": must be left, right, center, or numeric}} - {-underline no no stupid - {expected boolean value but got "stupid"}} -} { - set name [lindex $test 0] - test textTag-1.$i {tag configuration options} haveCourier12 { - .t tag configure x $name [lindex $test 1] - .t tag cget x $name - } [lindex $test 2] - incr i - if {[lindex $test 3] != ""} { - test textTag-1.$i {configuration options} haveCourier12 { - list [catch {.t tag configure x $name [lindex $test 3]} msg] $msg - } [list 1 [lindex $test 4]] - } - .t tag configure x $name [lindex [.t tag configure x $name] 3] - incr i -} -test textTag-2.1 {TkTextTagCmd - "add" option} haveCourier12 { - list [catch {.t tag} msg] $msg -} {1 {wrong # args: should be ".t tag option ?arg arg ...?"}} -test textTag-2.2 {TkTextTagCmd - "add" option} haveCourier12 { - list [catch {.t tag gorp} msg] $msg -} {1 {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, prevrange, raise, ranges, or remove}} -test textTag-2.3 {TkTextTagCmd - "add" option} haveCourier12 { - list [catch {.t tag add foo} msg] $msg -} {1 {wrong # args: should be ".t tag add tagName index1 ?index2 index1 index2 ...?"}} -test textTag-2.4 {TkTextTagCmd - "add" option} haveCourier12 { - list [catch {.t tag add x gorp} msg] $msg -} {1 {bad text index "gorp"}} -test textTag-2.5 {TkTextTagCmd - "add" option} haveCourier12 { - list [catch {.t tag add x 1.2 gorp} msg] $msg -} {1 {bad text index "gorp"}} -test textTag-2.6 {TkTextTagCmd - "add" option} haveCourier12 { + +test textTag-2.1 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -body { + .t tag +} -returnCodes error -result {wrong # args: should be ".t tag option ?arg ...?"} +test textTag-2.2 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -body { + .t tag gorp +} -returnCodes error -result {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, prevrange, raise, ranges, or remove} +test textTag-2.3 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -body { + .t tag add foo +} -returnCodes error -result {wrong # args: should be ".t tag add tagName index1 ?index2 index1 index2 ...?"} +test textTag-2.4 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -body { + .t tag add x gorp +} -returnCodes error -result {bad text index "gorp"} +test textTag-2.5 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -body { + .t tag add x 1.2 gorp +} -returnCodes error -result {bad text index "gorp"} +test textTag-2.6 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -setup { + .t tag delete sel +} -body { .t tag add sel 3.2 3.4 .t tag add sel 3.2 3.0 .t tag ranges sel -} {3.2 3.4} -test textTag-2.7 {TkTextTagCmd - "add" option} haveCourier12 { +} -result {3.2 3.4} +test textTag-2.7 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { .t tag add x 1.0 1.end .t tag ranges x -} {1.0 1.6} -test textTag-2.8 {TkTextTagCmd - "add" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {1.0 1.6} +test textTag-2.8 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -setup { .t tag remove x 1.0 end +} -body { .t tag add x 1.2 .t tag ranges x -} {1.2 1.3} -test textTag-2.9 {TkTextTagCmd - "add" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {1.2 1.3} +test textTag-2.9 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -setup { + destroy .t.e +} -body { + entry .t.e + .t.e insert 0 "Text" .t.e select from 0 .t.e select to 4 .t tag add sel 3.2 3.4 selection get -} 34 -test textTag-2.11 {TkTextTagCmd - "add" option} haveCourier12 { +} -cleanup { + destroy .t.e +} -result 34 +test textTag-2.10 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -setup { + destroy .t.e +} -body { + entry .t.e + .t.e insert 0 "Text" .t.e select from 0 .t.e select to 4 .t configure -exportselection 0 .t tag add sel 3.2 3.4 selection get -} Text -test textTag-2.12 {TkTextTagCmd - "add" option} haveCourier12 { +} -cleanup { + destroy .t.e +} -result {Text} +test textTag-2.11 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -body { .t tag remove sel 1.0 end .t tag add sel 1.1 1.5 2.4 3.1 4.2 4.4 .t tag ranges sel -} {1.1 1.5 2.4 3.1 4.2 4.4} -test textTag-2.13 {TkTextTagCmd - "add" option} haveCourier12 { +} -result {1.1 1.5 2.4 3.1 4.2 4.4} +test textTag-2.12 {TkTextTagCmd - "add" option} -constraints { + haveCourier12 +} -body { .t tag remove sel 1.0 end .t tag add sel 1.1 1.5 2.4 .t tag ranges sel -} {1.1 1.5 2.4 2.5} +} -cleanup { + .t tag remove sel 1.0 end +} -result {1.1 1.5 2.4 2.5} test textTag-2.14 {tag add before -startline - Bug 1615425} haveCourier12 { text .tt for {set i 1} {$i <10} {incr i} { @@ -161,433 +418,924 @@ test textTag-2.14 {tag add before -startline - Bug 1615425} haveCourier12 { set res 1 } {1} -catch {.t tag delete x} -test textTag-3.1 {TkTextTagCmd - "bind" option} haveCourier12 { - list [catch {.t tag bind} msg] $msg -} {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}} -test textTag-3.2 {TkTextTagCmd - "bind" option} haveCourier12 { - list [catch {.t tag bind 1 2 3 4} msg] $msg -} {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}} -test textTag-3.3 {TkTextTagCmd - "bind" option} haveCourier12 { + +test textTag-3.1 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { + .t tag bind +} -returnCodes error -result {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"} +test textTag-3.2 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { + .t tag bind 1 2 3 4 +} -returnCodes error -result {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"} +test textTag-3.3 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { .t tag bind x <Enter> script1 .t tag bind x <Enter> -} script1 -test textTag-3.4 {TkTextTagCmd - "bind" option} haveCourier12 { - list [catch {.t tag bind x <Gorp> script2} msg] $msg -} {1 {bad event type or keysym "Gorp"}} -test textTag-3.5 {TkTextTagCmd - "bind" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {script1} +test textTag-3.4 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { + .t tag bind x <Gorp> script2 +} -returnCodes error -result {bad event type or keysym "Gorp"} +test textTag-3.5 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag bind x <Enter> script1 + .t tag bind x <FocusIn> script2 +} -cleanup { + .t tag delete x +} -returnCodes error -result {requested illegal events; only key, button, motion, enter, leave, and virtual events may be used} +test textTag-3.6 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag bind x <Enter> script1 - list [catch {.t tag bind x <FocusIn> script2} msg] $msg [.t tag bind x] -} {1 {requested illegal events; only key, button, motion, enter, leave, and virtual events may be used} <Enter>} -test textTag-3.6 {TkTextTagCmd - "bind" option} haveCourier12 { + catch {.t tag bind x <FocusIn> script2} + .t tag bind x +} -cleanup { + .t tag delete x +} -result {<Enter>} +test textTag-3.7 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag bind x <Enter> script1 .t tag bind x <Leave> script2 .t tag bind x a xyzzy list [lsort [.t tag bind x]] [.t tag bind x <Enter>] [.t tag bind x a] -} {{<Enter> <Leave> a} script1 xyzzy} -test textTag-3.7 {TkTextTagCmd - "bind" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {{<Enter> <Leave> a} script1 xyzzy} +test textTag-3.8 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag bind x <Enter> script1 .t tag bind x <Enter> +script2 .t tag bind x <Enter> -} {script1 +} -cleanup { + .t tag delete x +} -result {script1 script2} -test textTag-3.7a {TkTextTagCmd - "bind" option} haveCourier12 { - .t tag delete x - list [catch {.t tag bind x <Enter>} msg] $msg -} {0 {}} -test textTag-3.8 {TkTextTagCmd - "bind" option} haveCourier12 { - .t tag delete x - list [catch {.t tag bind x <} msg] $msg -} {1 {no event type or button # or keysym}} - -test textTag-4.1 {TkTextTagCmd - "cget" option} haveCourier12 { - list [catch {.t tag cget a} msg] $msg -} {1 {wrong # args: should be ".t tag cget tagName option"}} -test textTag-4.2 {TkTextTagCmd - "cget" option} haveCourier12 { - list [catch {.t tag cget a b c} msg] $msg -} {1 {wrong # args: should be ".t tag cget tagName option"}} -test textTag-4.3 {TkTextTagCmd - "cget" option} haveCourier12 { +test textTag-3.9 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag bind x <Enter> +} -cleanup { + .t tag delete x +} -returnCodes ok -result {} +test textTag-3.10 {TkTextTagCmd - "bind" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag bind x < +} -cleanup { + .t tag delete x +} -returnCodes error -result {no event type or button # or keysym} + + +test textTag-4.1 {TkTextTagCmd - "cget" option} -constraints { + haveCourier12 +} -body { + .t tag cget a +} -returnCodes error -result {wrong # args: should be ".t tag cget tagName option"} +test textTag-4.2 {TkTextTagCmd - "cget" option} -constraints { + haveCourier12 +} -body { + .t tag cget a b c +} -returnCodes error -result {wrong # args: should be ".t tag cget tagName option"} +test textTag-4.3 {TkTextTagCmd - "cget" option} -constraints { + haveCourier12 +} -body { .t tag delete foo - list [catch {.t tag cget foo bar} msg] $msg -} {1 {tag "foo" isn't defined in text widget}} -test textTag-4.4 {TkTextTagCmd - "cget" option} haveCourier12 { - list [catch {.t tag cget sel bogus} msg] $msg -} {1 {unknown option "bogus"}} -test textTag-4.5 {TkTextTagCmd - "cget" option} haveCourier12 { + .t tag cget foo bar +} -returnCodes error -result {tag "foo" isn't defined in text widget} +test textTag-4.4 {TkTextTagCmd - "cget" option} -constraints { + haveCourier12 +} -body { + .t tag cget sel bogus +} -returnCodes error -result {unknown option "bogus"} +test textTag-4.5 {TkTextTagCmd - "cget" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag configure x -background red - list [catch {.t tag cget x -background} msg] $msg -} {0 red} - -test textTag-5.1 {TkTextTagCmd - "configure" option} haveCourier12 { - list [catch {.t tag configure} msg] $msg -} {1 {wrong # args: should be ".t tag configure tagName ?option? ?value? ?option value ...?"}} -test textTag-5.2 {TkTextTagCmd - "configure" option} haveCourier12 { - list [catch {.t tag configure x -foo} msg] $msg -} {1 {unknown option "-foo"}} -test textTag-5.3 {TkTextTagCmd - "configure" option} haveCourier12 { - list [catch {.t tag configure x -background red -underline} msg] $msg -} {1 {value for "-underline" missing}} -test textTag-5.4 {TkTextTagCmd - "configure" option} haveCourier12 { + .t tag cget x -background +} -cleanup { + .t tag delete x +} -result {red} + + +test textTag-5.1 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag configure +} -returnCodes error -result {wrong # args: should be ".t tag configure tagName ?-option? ?value? ?-option value ...?"} +test textTag-5.2 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag configure x -foo +} -returnCodes error -result {unknown option "-foo"} +test textTag-5.3 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag configure x -background red -underline +} -cleanup { + .t tag delete x +} -returnCodes error -result {value for "-underline" missing} +test textTag-5.4 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag configure x -underline yes .t tag configure x -underline -} {-underline {} {} {} yes} -test textTag-5.5 {TkTextTagCmd - "configure" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {-underline {} {} {} yes} +test textTag-5.5 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag configure x -overstrike on .t tag cget x -overstrike -} {on} -test textTag-5.6 {TkTextTagCmd - "configure" option} haveCourier12 { - list [catch {.t tag configure x -overstrike foo} msg] $msg -} {1 {expected boolean value but got "foo"}} -test textTag-5.7 {TkTextTagCmd - "configure" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {on} +test textTag-5.6 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag configure x -overstrike foo +} -cleanup { + .t tag delete x +} -returnCodes error -result {expected boolean value but got "foo"} +test textTag-5.7 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag configure x -underline stupid +} -cleanup { .t tag delete x - list [catch {.t tag configure x -underline stupid} msg] $msg -} {1 {expected boolean value but got "stupid"}} -test textTag-5.8 {TkTextTagCmd - "configure" option} haveCourier12 { +} -returnCodes error -result {expected boolean value but got "stupid"} +test textTag-5.8 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag configure x -justify left .t tag configure x -justify -} {-justify {} {} {} left} -test textTag-5.9 {TkTextTagCmd - "configure" option} haveCourier12 { +} -cleanup { .t tag delete x - list [catch {.t tag configure x -justify bogus} msg] $msg -} {1 {bad justification "bogus": must be left, right, or center}} -test textTag-5.10 {TkTextTagCmd - "configure" option} haveCourier12 { +} -result {-justify {} {} {} left} +test textTag-5.9 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t tag delete x - list [catch {.t tag configure x -justify fill} msg] $msg -} {1 {bad justification "fill": must be left, right, or center}} -test textTag-5.11 {TkTextTagCmd - "configure" option} haveCourier12 { + .t tag configure x -justify bogus +} -cleanup { + .t tag delete x +} -returnCodes error -result {bad justification "bogus": must be left, right, or center} +test textTag-5.10 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag configure x -justify fill +} -cleanup { + .t tag delete x +} -returnCodes error -result {bad justification "fill": must be left, right, or center} +test textTag-5.11 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag configure x -offset 2 .t tag configure x -offset -} {-offset {} {} {} 2} -test textTag-5.12 {TkTextTagCmd - "configure" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {-offset {} {} {} 2} +test textTag-5.12 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag configure x -offset 1.0q +} -cleanup { .t tag delete x - list [catch {.t tag configure x -offset 1.0q} msg] $msg -} {1 {bad screen distance "1.0q"}} -test textTag-5.13 {TkTextTagCmd - "configure" option} haveCourier12 { +} -returnCodes error -result {bad screen distance "1.0q"} +test textTag-5.13 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag configure x -lmargin1 2 -lmargin2 4 -rmargin 5 list [.t tag configure x -lmargin1] [.t tag configure x -lmargin2] \ - [.t tag configure x -rmargin] -} {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5}} -test textTag-5.14 {TkTextTagCmd - "configure" option} haveCourier12 { + [.t tag configure x -rmargin] +} -cleanup { .t tag delete x - list [catch {.t tag configure x -lmargin1 2.0x} msg] $msg -} {1 {bad screen distance "2.0x"}} -test textTag-5.15 {TkTextTagCmd - "configure" option} haveCourier12 { +} -result {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5}} +test textTag-5.14 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t tag delete x - list [catch {.t tag configure x -lmargin2 gorp} msg] $msg -} {1 {bad screen distance "gorp"}} -test textTag-5.16 {TkTextTagCmd - "configure" option} haveCourier12 { + .t tag configure x -lmargin1 2.0x +} -cleanup { .t tag delete x - list [catch {.t tag configure x -rmargin 140.1.1} msg] $msg -} {1 {bad screen distance "140.1.1"}} +} -returnCodes error -result {bad screen distance "2.0x"} +test textTag-5.15 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag configure x -lmargin2 gorp +} -cleanup { + .t tag delete x +} -returnCodes error -result {bad screen distance "gorp"} +test textTag-5.16 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag configure x -rmargin 140.1.1 +} -cleanup { + .t tag delete x +} -returnCodes error -result {bad screen distance "140.1.1"} .t tag delete x -test textTag-5.17 {TkTextTagCmd - "configure" option} haveCourier12 { +test textTag-5.17 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag configure x -spacing1 2 -spacing2 4 -spacing3 6 list [.t tag configure x -spacing1] [.t tag configure x -spacing2] \ - [.t tag configure x -spacing3] -} {{-spacing1 {} {} {} 2} {-spacing2 {} {} {} 4} {-spacing3 {} {} {} 6}} -test textTag-5.18 {TkTextTagCmd - "configure" option} haveCourier12 { + [.t tag configure x -spacing3] +} -cleanup { + .t tag delete x +} -result {{-spacing1 {} {} {} 2} {-spacing2 {} {} {} 4} {-spacing3 {} {} {} 6}} +test textTag-5.18 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag configure x -spacing1 2.0x +} -cleanup { .t tag delete x - list [catch {.t tag configure x -spacing1 2.0x} msg] $msg -} {1 {bad screen distance "2.0x"}} -test textTag-5.19 {TkTextTagCmd - "configure" option} haveCourier12 { +} -returnCodes error -result {bad screen distance "2.0x"} +test textTag-5.19 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t tag delete x - list [catch {.t tag configure x -spacing1 lousy} msg] $msg -} {1 {bad screen distance "lousy"}} -test textTag-5.20 {TkTextTagCmd - "configure" option} haveCourier12 { + .t tag configure x -spacing1 lousy +} -cleanup { .t tag delete x - list [catch {.t tag configure x -spacing1 4.2.3} msg] $msg -} {1 {bad screen distance "4.2.3"}} -test textTag-5.21 {TkTextTagCmd - "configure" option} haveCourier12 { +} -returnCodes error -result {bad screen distance "lousy"} +test textTag-5.20 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { + .t tag delete x + .t tag configure x -spacing1 4.2.3 +} -cleanup { + .t tag delete x +} -returnCodes error -result {bad screen distance "4.2.3"} +test textTag-5.21 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t configure -selectborderwidth 2 -selectforeground blue \ - -selectbackground black + -selectbackground black .t tag configure sel -borderwidth 4 -foreground green -background yellow set x {} foreach i {-selectborderwidth -selectforeground -selectbackground} { - lappend x [lindex [.t configure $i] 4] + lappend x [lindex [.t configure $i] 4] } - set x -} {4 green yellow} -test textTag-5.22 {TkTextTagCmd - "configure" option} haveCourier12 { + return $x +} -result {4 green yellow} +test textTag-5.22 {TkTextTagCmd - "configure" option} -constraints { + haveCourier12 +} -body { .t configure -selectborderwidth 20 .t tag configure sel -borderwidth {} .t cget -selectborderwidth -} {} +} -result {} -test textTag-6.1 {TkTextTagCmd - "delete" option} haveCourier12 { - list [catch {.t tag delete} msg] $msg -} {1 {wrong # args: should be ".t tag delete tagName ?tagName ...?"}} -test textTag-6.2 {TkTextTagCmd - "delete" option} haveCourier12 { - list [catch {.t tag delete zork} msg] $msg -} {0 {}} -test textTag-6.3 {TkTextTagCmd - "delete" option} haveCourier12 { - .t tag delete x + +test textTag-6.1 {TkTextTagCmd - "delete" option} -constraints { + haveCourier12 +} -body { + .t tag delete +} -returnCodes error -result {wrong # args: should be ".t tag delete tagName ?tagName ...?"} +test textTag-6.2 {TkTextTagCmd - "delete" option} -constraints { + haveCourier12 +} -body { + .t tag delete zork +} -returnCodes ok -result {} +test textTag-6.3 {TkTextTagCmd - "delete" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] +} -body { .t tag config x -background black .t tag config y -foreground white .t tag config z -background black .t tag delete y z lsort [.t tag names] -} {sel x} -test textTag-6.4 {TkTextTagCmd - "delete" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {sel x} +test textTag-6.4 {TkTextTagCmd - "delete" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] +} -body { .t tag config x -background black .t tag config y -foreground white .t tag config z -background black eval .t tag delete [.t tag names] .t tag names -} {sel} -test textTag-6.5 {TkTextTagCmd - "delete" option} haveCourier12 { +} -result {sel} +test textTag-6.5 {TkTextTagCmd - "delete" option} -constraints { + haveCourier12 +} -body { .t tag bind x <Enter> foo .t tag delete x .t tag configure x -background black .t tag bind x -} {} +} -cleanup { + .t tag delete x +} -result {} + -proc tagsetup {} { - .t tag delete x y z a b c d +test textTag-7.1 {TkTextTagCmd - "lower" option} -constraints { + haveCourier12 +} -body { + .t tag lower +} -returnCodes error -result {wrong # args: should be ".t tag lower tagName ?belowThis?"} +test textTag-7.2 {TkTextTagCmd - "lower" option} -constraints { + haveCourier12 +} -body { + .t tag lower foo +} -returnCodes error -result {tag "foo" isn't defined in text widget} +test textTag-7.3 {TkTextTagCmd - "lower" option} -constraints { + haveCourier12 +} -body { + .t tag lower sel bar +} -returnCodes error -result {tag "bar" isn't defined in text widget} +test textTag-7.4 {TkTextTagCmd - "lower" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] .t tag remove sel 1.0 end foreach i {a b c d} { - .t tag configure $i -background black + .t tag configure $i -background black } -} -test textTag-7.1 {TkTextTagCmd - "lower" option} haveCourier12 { - list [catch {.t tag lower} msg] $msg -} {1 {wrong # args: should be ".t tag lower tagName ?belowThis?"}} -test textTag-7.2 {TkTextTagCmd - "lower" option} haveCourier12 { - list [catch {.t tag lower foo} msg] $msg -} {1 {tag "foo" isn't defined in text widget}} -test textTag-7.3 {TkTextTagCmd - "lower" option} haveCourier12 { - list [catch {.t tag lower sel bar} msg] $msg -} {1 {tag "bar" isn't defined in text widget}} -test textTag-7.4 {TkTextTagCmd - "lower" option} haveCourier12 { - tagsetup +} -body { .t tag lower c .t tag names -} {c sel a b d} -test textTag-7.5 {TkTextTagCmd - "lower" option} haveCourier12 { - tagsetup +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {c sel a b d} +test textTag-7.5 {TkTextTagCmd - "lower" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] + .t tag remove sel 1.0 end + foreach i {a b c d} { + .t tag configure $i -background black + } +} -body { .t tag lower d b .t tag names -} {sel a d b c} -test textTag-7.6 {TkTextTagCmd - "lower" option} haveCourier12 { - tagsetup +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {sel a d b c} +test textTag-7.6 {TkTextTagCmd - "lower" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] + .t tag remove sel 1.0 end + foreach i {a b c d} { + .t tag configure $i -background black + } +} -body { .t tag lower a c .t tag names -} {sel b a c d} +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {sel b a c d} -test textTag-8.1 {TkTextTagCmd - "names" option} haveCourier12 { - list [catch {.t tag names a b} msg] $msg -} {1 {wrong # args: should be ".t tag names ?index?"}} -test textTag-8.2 {TkTextTagCmd - "names" option} haveCourier12 { - tagsetup + +test textTag-8.1 {TkTextTagCmd - "names" option} -constraints { + haveCourier12 +} -body { + .t tag names a b +} -cleanup { + .t tag delete {*}[.t tag names] +} -returnCodes error -result {wrong # args: should be ".t tag names ?index?"} +test textTag-8.2 {TkTextTagCmd - "names" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] + .t tag remove sel 1.0 end + foreach i {a b c d} { + .t tag configure $i -background black + } +} -body { .t tag names -} {sel a b c d} -test textTag-8.3 {TkTextTagCmd - "names" option} haveCourier12 { - tagsetup +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {sel a b c d} +test textTag-8.3 {TkTextTagCmd - "names" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] + .t tag remove sel 1.0 end + foreach i {a b c d} { + .t tag configure $i -background black + } +} -body { .t tag add "a b" 2.1 2.6 .t tag add c 2.4 2.7 .t tag names 2.5 -} {c {a b}} - -.t tag delete x y z a b c d {a b} -.t tag add x 2.3 2.5 -.t tag add x 2.9 3.1 -.t tag add x 7.2 -test textTag-9.1 {TkTextTagCmd - "nextrange" option} haveCourier12 { - list [catch {.t tag nextrange x} msg] $msg -} {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}} -test textTag-9.2 {TkTextTagCmd - "nextrange" option} haveCourier12 { - list [catch {.t tag nextrange x 1 2 3} msg] $msg -} {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}} -test textTag-9.3 {TkTextTagCmd - "nextrange" option} haveCourier12 { - list [catch {.t tag nextrange foo 1.0} msg] $msg -} {0 {}} -test textTag-9.4 {TkTextTagCmd - "nextrange" option} haveCourier12 { - list [catch {.t tag nextrange x foo} msg] $msg -} {1 {bad text index "foo"}} -test textTag-9.5 {TkTextTagCmd - "nextrange" option} haveCourier12 { - list [catch {.t tag nextrange x 1.0 bar} msg] $msg -} {1 {bad text index "bar"}} -test textTag-9.6 {TkTextTagCmd - "nextrange" option} haveCourier12 { +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {c {a b}} + + +test textTag-9.1 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -body { + .t tag nextrange x +} -returnCodes error -result {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"} +test textTag-9.2 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -body { + .t tag nextrange x 1 2 3 +} -returnCodes error -result {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"} +test textTag-9.3 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -body { + .t tag nextrange foo 1.0 +} -returnCodes ok -result {} +test textTag-9.4 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag nextrange x foo +} -cleanup { + .t tag delete x +} -returnCodes error -result {bad text index "foo"} +test textTag-9.5 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 + .t tag nextrange x 1.0 bar +} -cleanup { + .t tag delete x +} -returnCodes error -result {bad text index "bar"} +test textTag-9.6 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag nextrange x 1.0 -} {2.3 2.5} -test textTag-9.7 {TkTextTagCmd - "nextrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.3 2.5} +test textTag-9.7 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag nextrange x 2.2 -} {2.3 2.5} -test textTag-9.8 {TkTextTagCmd - "nextrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.3 2.5} +test textTag-9.8 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag nextrange x 2.3 -} {2.3 2.5} -test textTag-9.9 {TkTextTagCmd - "nextrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.3 2.5} +test textTag-9.9 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag nextrange x 2.4 -} {2.9 3.1} -test textTag-9.10 {TkTextTagCmd - "nextrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.9 3.1} +test textTag-9.10 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag nextrange x 2.4 2.9 -} {} -test textTag-9.11 {TkTextTagCmd - "nextrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {} +test textTag-9.11 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag nextrange x 2.4 2.10 -} {2.9 3.1} -test textTag-9.12 {TkTextTagCmd - "nextrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.9 3.1} +test textTag-9.12 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag nextrange x 2.4 2.11 -} {2.9 3.1} -test textTag-9.13 {TkTextTagCmd - "nextrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.9 3.1} +test textTag-9.13 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag nextrange x 7.0 -} {7.2 7.3} -test textTag-9.14 {TkTextTagCmd - "nextrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {7.2 7.3} +test textTag-9.14 {TkTextTagCmd - "nextrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag nextrange x 7.3 -} {} - -test textTag-10.1 {TkTextTagCmd - "prevrange" option} haveCourier12 { - list [catch {.t tag prevrange x} msg] $msg -} {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}} -test textTag-10.2 {TkTextTagCmd - "prevrange" option} haveCourier12 { - list [catch {.t tag prevrange x 1 2 3} msg] $msg -} {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}} -test textTag-10.3 {TkTextTagCmd - "prevrange" option} haveCourier12 { - list [catch {.t tag prevrange foo end} msg] $msg -} {0 {}} -test textTag-10.4 {TkTextTagCmd - "prevrange" option} haveCourier12 { - list [catch {.t tag prevrange x foo} msg] $msg -} {1 {bad text index "foo"}} -test textTag-10.5 {TkTextTagCmd - "prevrange" option} haveCourier12 { - list [catch {.t tag prevrange x end bar} msg] $msg -} {1 {bad text index "bar"}} -test textTag-10.6 {TkTextTagCmd - "prevrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {} + + +test textTag-10.1 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -body { + .t tag prevrange x +} -returnCodes error -result {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"} +test textTag-10.2 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -body { + .t tag prevrange x 1 2 3 +} -returnCodes error -result {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"} +test textTag-10.3 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag prevrange foo end +} -cleanup { + .t tag delete x +} -returnCodes ok -result {} +test textTag-10.4 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 + .t tag prevrange x foo +} -cleanup { + .t tag delete x +} -returnCodes error -result {bad text index "foo"} +test textTag-10.5 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 + .t tag prevrange x end bar +} -cleanup { + .t tag delete x +} -returnCodes error -result {bad text index "bar"} +test textTag-10.6 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag prevrange x end -} {7.2 7.3} -test textTag-10.7 {TkTextTagCmd - "prevrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {7.2 7.3} +test textTag-10.7 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag prevrange x 2.4 -} {2.3 2.5} -test textTag-10.8 {TkTextTagCmd - "prevrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.3 2.5} +test textTag-10.8 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag prevrange x 2.5 -} {2.3 2.5} -test textTag-10.9 {TkTextTagCmd - "prevrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.3 2.5} +test textTag-10.9 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag prevrange x 2.9 -} {2.3 2.5} -test textTag-10.10 {TkTextTagCmd - "prevrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.3 2.5} +test textTag-10.10 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag prevrange x 2.9 2.6 -} {} -test textTag-10.11 {TkTextTagCmd - "prevrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {} +test textTag-10.11 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag prevrange x 2.9 2.5 -} {} -test textTag-10.12 {TkTextTagCmd - "prevrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {} +test textTag-10.12 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag prevrange x 2.9 2.3 -} {2.3 2.5} -test textTag-10.13 {TkTextTagCmd - "prevrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.3 2.5} +test textTag-10.13 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag prevrange x 7.0 -} {2.9 3.1} -test textTag-10.14 {TkTextTagCmd - "prevrange" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.9 3.1} +test textTag-10.14 {TkTextTagCmd - "prevrange" option} -constraints { + haveCourier12 +} -setup { + .t tag delete x +} -body { + .t tag add x 2.3 2.5 + .t tag add x 2.9 3.1 + .t tag add x 7.2 .t tag prevrange x 2.3 -} {} - -test textTag-11.1 {TkTextTagCmd - "raise" option} haveCourier12 { - list [catch {.t tag raise} msg] $msg -} {1 {wrong # args: should be ".t tag raise tagName ?aboveThis?"}} -test textTag-11.2 {TkTextTagCmd - "raise" option} haveCourier12 { - list [catch {.t tag raise foo} msg] $msg -} {1 {tag "foo" isn't defined in text widget}} -test textTag-11.3 {TkTextTagCmd - "raise" option} haveCourier12 { - list [catch {.t tag raise sel bar} msg] $msg -} {1 {tag "bar" isn't defined in text widget}} -test textTag-11.4 {TkTextTagCmd - "raise" option} haveCourier12 { - tagsetup +} -cleanup { + .t tag delete x +} -result {} + + +test textTag-11.1 {TkTextTagCmd - "raise" option} -constraints { + haveCourier12 +} -body { + .t tag raise +} -returnCodes error -result {wrong # args: should be ".t tag raise tagName ?aboveThis?"} +test textTag-11.2 {TkTextTagCmd - "raise" option} -constraints { + haveCourier12 +} -body { + .t tag raise foo +} -returnCodes error -result {tag "foo" isn't defined in text widget} +test textTag-11.3 {TkTextTagCmd - "raise" option} -constraints { + haveCourier12 +} -body { + .t tag raise sel bar +} -returnCodes error -result {tag "bar" isn't defined in text widget} +test textTag-11.4 {TkTextTagCmd - "raise" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] + .t tag remove sel 1.0 end + foreach i {a b c d} { + .t tag configure $i -background black + } +} -body { .t tag raise c .t tag names -} {sel a b d c} -test textTag-11.5 {TkTextTagCmd - "raise" option} haveCourier12 { - tagsetup +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {sel a b d c} +test textTag-11.5 {TkTextTagCmd - "raise" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] + .t tag remove sel 1.0 end + foreach i {a b c d} { + .t tag configure $i -background black + } +} -body { .t tag raise d b .t tag names -} {sel a b d c} -test textTag-11.6 {TkTextTagCmd - "raise" option} haveCourier12 { - tagsetup +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {sel a b d c} +test textTag-11.6 {TkTextTagCmd - "raise" option} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] + .t tag remove sel 1.0 end + foreach i {a b c d} { + .t tag configure $i -background black + } +} -body { .t tag raise a c .t tag names -} {sel b c a d} +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {sel b c a d} + -test textTag-12.1 {TkTextTagCmd - "ranges" option} haveCourier12 { - list [catch {.t tag ranges} msg] $msg -} {1 {wrong # args: should be ".t tag ranges tagName"}} -test textTag-12.2 {TkTextTagCmd - "ranges" option} haveCourier12 { +test textTag-12.1 {TkTextTagCmd - "ranges" option} -constraints { + haveCourier12 +} -body { + .t tag ranges +} -returnCodes error -result {wrong # args: should be ".t tag ranges tagName"} +test textTag-12.2 {TkTextTagCmd - "ranges" option} -constraints { + haveCourier12 +} -body { .t tag delete x .t tag ranges x -} {} -test textTag-12.3 {TkTextTagCmd - "ranges" option} haveCourier12 { +} -result {} +test textTag-12.3 {TkTextTagCmd - "ranges" option} -constraints { + haveCourier12 +} -setup { .t tag delete x +} -body { .t tag add x 2.2 .t tag add x 2.7 4.15 .t tag add x 5.2 5.5 .t tag ranges x -} {2.2 2.3 2.7 4.6 5.2 5.5} -test textTag-12.4 {TkTextTagCmd - "ranges" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.2 2.3 2.7 4.6 5.2 5.5} +test textTag-12.4 {TkTextTagCmd - "ranges" option} -constraints { + haveCourier12 +} -setup { .t tag delete x +} -body { .t tag add x 1.0 3.0 .t tag add x 4.0 end .t tag ranges x -} {1.0 3.0 4.0 8.0} +} -cleanup { + .t tag delete x +} -result {1.0 3.0 4.0 8.0} + -test textTag-13.1 {TkTextTagCmd - "remove" option} haveCourier12 { - list [catch {.t tag remove} msg] $msg -} {1 {wrong # args: should be ".t tag remove tagName index1 ?index2 index1 index2 ...?"}} -test textTag-13.2 {TkTextTagCmd - "remove" option} haveCourier12 { +test textTag-13.1 {TkTextTagCmd - "remove" option} -constraints { + haveCourier12 +} -body { + .t tag remove +} -returnCodes error -result {wrong # args: should be ".t tag remove tagName index1 ?index2 index1 index2 ...?"} +test textTag-13.2 {TkTextTagCmd - "remove" option} -constraints { + haveCourier12 +} -setup { .t tag delete x +} -body { .t tag add x 2.2 2.11 .t tag remove x 2.3 2.7 .t tag ranges x -} {2.2 2.3 2.7 2.11} -test textTag-13.3 {TkTextTagCmd - "remove" option} haveCourier12 { +} -cleanup { + .t tag delete x +} -result {2.2 2.3 2.7 2.11} +test textTag-13.3 {TkTextTagCmd - "remove" option} -constraints { + haveCourier12 +} -setup { + destroy .t.e +} -body { + entry .t.e + .t.e insert 0 "Text" .t configure -exportselection 1 .t tag remove sel 1.0 end .t tag add sel 2.4 3.3 .t.e select to 4 .t tag remove sel 2.7 3.1 selection get -} Text +} -cleanup { + destroy .t.e +} -result {Text} -.t tag delete x a b c d -test textTag-14.1 {SortTags} haveCourier12 { + +test textTag-14.1 {SortTags} -constraints haveCourier12 -setup { + .t tag delete a b c d +} -body { foreach i {a b c d} { - .t tag add $i 2.0 2.2 + .t tag add $i 2.0 2.2 } .t tag names 2.1 -} {a b c d} +} -cleanup { + .t tag delete a b c d +} -result {a b c d} .t tag delete a b c d -test textTag-14.2 {SortTags} haveCourier12 { +test textTag-14.2 {SortTags} -constraints haveCourier12 -setup { + .t tag delete a b c d +} -body { foreach i {a b c d} { - .t tag configure $i -background black + .t tag configure $i -background black } foreach i {d c b a} { - .t tag add $i 2.0 2.2 + .t tag add $i 2.0 2.2 } .t tag names 2.1 -} {a b c d} -.t tag delete x a b c d -test textTag-14.3 {SortTags} haveCourier12 { +} -cleanup { + .t tag delete a b c d +} -result {a b c d} +test textTag-14.3 {SortTags} -constraints haveCourier12 -setup { + .t tag delete {*}[.t tag names] +} -body { for {set i 0} {$i < 30} {incr i} { - .t tag add x$i 2.0 2.2 + .t tag add x$i 2.0 2.2 } .t tag names 2.1 -} {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29} -test textTag-14.4 {SortTags} haveCourier12 { +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29} +test textTag-14.4 {SortTags} -constraints haveCourier12 -setup { + .t tag delete {*}[.t tag names] +} -body { for {set i 0} {$i < 30} {incr i} { - .t tag configure x$i -background black + .t tag configure x$i -background black } for {set i 29} {$i >= 0} {incr i -1} { - .t tag add x$i 2.0 2.2 + .t tag add x$i 2.0 2.2 } .t tag names 2.1 -} {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29} +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29} + + -foreach tag [.t tag names] { - catch {.t tag delete $tag} -} set c [.t bbox 2.1] set x1 [expr [lindex $c 0] + [lindex $c 2]/2] set y1 [expr [lindex $c 1] + [lindex $c 3]/2] @@ -598,8 +1346,10 @@ set c [.t bbox 4.3] set x3 [expr [lindex $c 0] + [lindex $c 2]/2] set y3 [expr [lindex $c 1] + [lindex $c 3]/2] -test textTag-15.1 {TkTextBindProc} haveCourier12 { +test textTag-15.1 {TkTextBindProc} -constraints haveCourier12 -setup { + .t tag delete x y event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { bind .t <ButtonRelease> {lappend x up} .t tag bind x <ButtonRelease> {lappend x x-up} .t tag bind y <ButtonRelease> {lappend x y-up} @@ -615,13 +1365,16 @@ test textTag-15.1 {TkTextBindProc} haveCourier12 { event gen .t <Button> -x $x2 -y $y2 event gen .t <Motion> -x $x3 -y $y3 event gen .t <ButtonRelease> -x $x3 -y $y3 + return $x +} -cleanup { + .t tag delete x y bind .t <ButtonRelease> {} - set x -} {x-up up up y-up up} -test textTag-15.2 {TkTextBindProc} haveCourier12 { +} -result {x-up up up y-up up} + +test textTag-15.2 {TkTextBindProc} -constraints haveCourier12 -setup { + .t tag delete x y event generate {} <Motion> -warp 1 -x -1 -y -1; update - catch {.t tag delete x} - catch {.t tag delete y} +} -body { .t tag bind x <Enter> {lappend x x-enter} .t tag bind x <ButtonPress> {lappend x x-down} .t tag bind x <ButtonRelease> {lappend x x-up} @@ -641,11 +1394,15 @@ test textTag-15.2 {TkTextBindProc} haveCourier12 { event gen .t <Motion> -x $x3 -y $y3 -state 0x100 lappend x | event gen .t <ButtonRelease> -x $x3 -y $y3 - set x -} {x-enter | x-down | | x-up x-leave y-enter} -test textTag-15.3 {TkTextBindProc} haveCourier12 { - catch {.t tag delete x} - catch {.t tag delete y} + return $x +} -cleanup { + .t tag delete x y +} -result {x-enter | x-down | | x-up x-leave y-enter} + +test textTag-15.3 {TkTextBindProc} -constraints haveCourier12 -setup { + .t tag delete x y + event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { .t tag bind x <Enter> {lappend x x-enter} .t tag bind x <Any-ButtonPress-1> {lappend x x-down} .t tag bind x <Any-ButtonRelease-1> {lappend x x-up} @@ -669,15 +1426,18 @@ test textTag-15.3 {TkTextBindProc} haveCourier12 { event gen .t <ButtonRelease-1> -x $x3 -y $y3 -state 0x300 lappend x | event gen .t <ButtonRelease-2> -x $x3 -y $y3 -state 0x200 - set x -} {x-enter | x-down | | | x-up | x-leave y-enter} - -foreach tag [.t tag names] { - catch {.t tag delete $tag} -} -.t tag configure big -font $bigFont -test textTag-16.1 {TkTextPickCurrent procedure} haveCourier12 { + return $x +} -cleanup { + .t tag delete x y +} -result {x-enter | x-down | | | x-up | x-leave y-enter} + + +test textTag-16.1 {TkTextPickCurrent procedure} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1 set x [.t index current] event gen .t <Motion> -x $x2 -y $y2 @@ -692,25 +1452,36 @@ test textTag-16.1 {TkTextPickCurrent procedure} haveCourier12 { lappend x [.t index current] event gen .t <ButtonRelease-1> -state 0x100 -x $x3 -y $y3 lappend x [.t index current] -} {2.1 3.2 3.2 3.2 3.2 3.2 4.3} -test textTag-16.2 {TkTextPickCurrent procedure} haveCourier12 { +} -result {2.1 3.2 3.2 3.2 3.2 3.2 4.3} + +test textTag-16.2 {TkTextPickCurrent procedure} -constraints { + haveCourier12 +} -setup { + .t tag delete {*}[.t tag names] event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { + .t tag configure big -font $bigFont event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1 event gen .t <Motion> -x $x2 -y $y2 set x [.t index current] .t tag add big 3.0 update lappend x [.t index current] -} {3.2 3.1} -.t tag remove big 1.0 end -foreach i {a b c d} { - .t tag bind $i <Enter> "lappend x enter-$i" - .t tag bind $i <Leave> "lappend x leave-$i" -} -test textTag-16.3 {TkTextPickCurrent procedure} haveCourier12 { +} -cleanup { + .t tag delete big +} -result {3.2 3.1} + +test textTag-16.3 {TkTextPickCurrent procedure} -constraints { + haveCourier12 +} -setup { + foreach i {a b c d} { + .t tag remove $i 1.0 end + } event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { foreach i {a b c d} { - .t tag remove $i 1.0 end + .t tag bind $i <Enter> "lappend x enter-$i" + .t tag bind $i <Leave> "lappend x leave-$i" } .t tag lower b .t tag lower a @@ -724,12 +1495,22 @@ test textTag-16.3 {TkTextPickCurrent procedure} haveCourier12 { event gen .t <Motion> -x $x2 -y $y2 lappend x | event gen .t <Motion> -x $x3 -y $y3 - set x -} {enter-a enter-b | leave-b enter-c | leave-a leave-c} -test textTag-16.4 {TkTextPickCurrent procedure} haveCourier12 { + return $x +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {enter-a enter-b | leave-b enter-c | leave-a leave-c} + +test textTag-16.4 {TkTextPickCurrent procedure} -constraints { + haveCourier12 +} -setup { + foreach i {a b c d} { + .t tag remove $i 1.0 end + } event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { foreach i {a b c d} { - .t tag remove $i 1.0 end + .t tag bind $i <Enter> "lappend x enter-$i" + .t tag bind $i <Leave> "lappend x leave-$i" } .t tag lower b .t tag lower a @@ -742,59 +1523,86 @@ test textTag-16.4 {TkTextPickCurrent procedure} haveCourier12 { lappend x | .t tag lower c event gen .t <Motion> -x $x2 -y $y2 - set x -} {enter-a enter-b enter-c | leave-c leave-b} -foreach i {a b c d} { - .t tag delete $i -} -test textTag-16.5 {TkTextPickCurrent procedure} haveCourier12 { - event generate {} <Motion> -warp 1 -x -1 -y -1; update - foreach i {a b c d} { - .t tag remove $i 1.0 end + return $x +} -cleanup { + .t tag delete {*}[.t tag names] +} -result {enter-a enter-b enter-c | leave-c leave-b} + +test textTag-16.5 {TkTextPickCurrent procedure} -constraints { + haveCourier12 +} -setup { + foreach i {big a b c d} { + .t tag remove $i 1.0 end } + event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { + .t tag configure big -font $bigFont event gen .t <Motion> -x $x1 -y $y1 .t tag bind a <Enter> {.t tag add big 3.0 3.2} .t tag add a 3.2 event gen .t <Motion> -x $x2 -y $y2 .t index current -} {3.2} -test textTag-16.6 {TkTextPickCurrent procedure} haveCourier12 { - event generate {} <Motion> -warp 1 -x -1 -y -1; update - foreach i {a b c d} { - .t tag remove $i 1.0 end +} -cleanup { + .t tag delete a big +} -result {3.2} + +test textTag-16.6 {TkTextPickCurrent procedure} -constraints { + haveCourier12 +} -setup { + foreach i {big a b c d} { + .t tag remove $i 1.0 end } + event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { + .t tag configure big -font $bigFont event gen .t <Motion> -x $x1 -y $y1 .t tag bind a <Enter> {.t tag add big 3.0 3.2} .t tag add a 3.2 event gen .t <Motion> -x $x2 -y $y2 update .t index current -} {3.1} -test textTag-16.7 {TkTextPickCurrent procedure} haveCourier12 { - event generate {} <Motion> -warp 1 -x -1 -y -1; update - foreach i {a b c d} { - .t tag remove $i 1.0 end +} -cleanup { + .t tag delete a big +} -result {3.1} + +test textTag-16.7 {TkTextPickCurrent procedure} -constraints { + haveCourier12 +} -setup { + foreach i {big a b c d} { + .t tag remove $i 1.0 end } + event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { + .t tag configure big -font $bigFont + .t tag bind a <Enter> {.t tag add big 3.0 3.2} + .t tag add a 3.2 + event gen .t <Motion> -x $x1 -y $y1 .t tag bind a <Leave> {.t tag add big 3.0 3.2} .t tag add a 2.1 event gen .t <Motion> -x $x2 -y $y2 + update .t index current -} {3.1} +} -cleanup { + .t tag delete a big +} -result {3.1} + -test textTag-17.1 {insert procedure inserts tags} { +test textTag-17.1 {insert procedure inserts tags} -setup { .t delete 1.0 end +} -body { # Objectification of the text widget had a problem # with inserting tags when using 'end'. Check that # bug has been fixed. .t insert end abcd {x} \n {} efgh {y} \n {} .t dump -tag 1.0 end -} {tagon x 1.0 tagoff x 1.4 tagon y 2.0 tagoff y 2.4} +} -result {tagon x 1.0 tagoff x 1.4 tagon y 2.0 tagoff y 2.4} -catch {destroy .t} -test textTag-18.1 {TkTextPickCurrent tag bindings} { +test textTag-18.1 {TkTextPickCurrent tag bindings} -setup { + destroy .t event generate {} <Motion> -warp 1 -x -1 -y -1; update +} -body { text .t -width 30 -height 4 -relief sunken -borderwidth 10 \ -highlightthickness 10 -pady 2 pack .t @@ -815,10 +1623,12 @@ test textTag-18.1 {TkTextPickCurrent tag bindings} { event gen .t <Motion> -warp 1 -x 20 -y 20 ; update event gen .t <Motion> -warp 1 -x 10 -y 10 ; update event gen .t <Motion> -warp 1 -x 25 -y 25 ; update - set res -} {Enter {25 25 tag-Enter} {20 20 tag-Leave} {25 25 tag-Enter}} + return $res +} -cleanup { + destroy .t +} -result {Enter {25 25 tag-Enter} {20 20 tag-Leave} {25 25 tag-Enter}} -catch {destroy .t} +destroy .t # cleanup cleanupTests diff --git a/tests/textWind.test b/tests/textWind.test index 2e16f7b..27b7309 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -6,8 +6,9 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands # Create entries in the option database to be sure that geometry options @@ -17,26 +18,21 @@ option add *Text.borderWidth 2 option add *Text.highlightThickness 2 option add *Text.font {Courier -12} -set fixedFont {Courier -12} -# 15 on XP, 13 on Solaris 8 -set fixedHeight [font metrics $fixedFont -linespace] -# 7 on all platforms -set fixedWidth [font measure $fixedFont m] -# 12 on XP -set fixedAscent [font metrics $fixedFont -ascent] -set fixedDiff [expr {$fixedHeight - 13}] ;# 2 on XP - -catch {destroy .f} -catch {destroy .t} -catch {destroy .t2} +deleteWindows +# Widget used in tests 1.* - 16.* text .t -width 30 -height 6 -bd 2 -highlightthickness 2 pack append . .t {top expand fill} update .t debug on -wm geometry . {} + +# 15 on XP, 13 on Solaris 8 +set fixedHeight [font metrics {Courier -12} -linespace] +set fixedDiff [expr {$fixedHeight - 13}] ;# 2 on XP set color [expr {[winfo depth .t] > 1 ? "green" : "black"}] - + +wm geometry . {} + # The statements below reset the main window; it's needed if the window # manager is mwm to make mwm forget about a previous minimum size setting. @@ -45,206 +41,323 @@ wm minsize . 1 1 wm positionfrom . user wm deiconify . -test textWind-1.1 {basic tests of options} {fonts} { +# ---------------------------------------------------------------------- + +test textWind-1.1 {basic tests of options} -constraints fonts -setup { .t delete 1.0 end +} -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" frame .f -width 3 -height 3 -bg $color .t window create 2.2 -window .f update list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] \ - [.t window configure .f -window] -} {1 3x3+19+23 {19 23 3 3} {-window {} {} {} .f}} -test textWind-1.2 {basic tests of options} {fonts} { + [.t window configure .f -window] +} -result {1 3x3+19+23 {19 23 3 3} {-window {} {} {} .f}} +test textWind-1.2 {basic tests of options} -constraints fonts -setup { .t delete 1.0 end +} -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" frame .f -width 3 -height 3 -bg $color .t window create 2.2 -window .f -align top update list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] \ - [.t window configure .f -align] -} {1 3x3+19+18 {19 18 3 3} {-align {} {} center top}} -test textWind-1.3 {basic tests of options} { + [.t window configure .f -align] +} -result {1 3x3+19+18 {19 18 3 3} {-align {} {} center top}} +test textWind-1.3 {basic tests of options} -setup { .t delete 1.0 end +} -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" .t window create 2.2 -create "Test script" .t window configure 2.2 -create -} {-create {} {} {} {Test script}} -test textWind-1.4 {basic tests of options} {fonts} { +} -result {-create {} {} {} {Test script}} +test textWind-1.4 {basic tests of options} -constraints fonts -setup { .t delete 1.0 end +} -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" frame .f -width 10 -height 20 -bg $color .t window create 2.2 -window .f -padx 5 update list [winfo geom .f] [.t window configure .f -padx] [.t bbox 2.3] -} {10x20+24+18 {-padx {} {} 0 5} {39 21 7 13}} -test textWind-1.5 {basic tests of options} {fonts} { +} -result {10x20+24+18 {-padx {} {} 0 5} {39 21 7 13}} +test textWind-1.5 {basic tests of options} -constraints fonts -setup { .t delete 1.0 end +} -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" frame .f -width 10 -height 20 -bg $color .t window create 2.2 -window .f -pady 4 update list [winfo geom .f] [.t window configure .f -pady] [.t bbox 2.31] -} {10x20+19+22 {-pady {} {} 0 4} {19 46 7 13}} -test textWind-1.6 {basic tests of options} {fonts} { +} -result {10x20+19+22 {-pady {} {} 0 4} {19 46 7 13}} +test textWind-1.6 {basic tests of options} -constraints fonts -setup { .t delete 1.0 end +} -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" frame .f -width 5 -height 5 -bg $color .t window create 2.2 -window .f -stretch 1 update list [winfo geom .f] [.t window configure .f -stretch] -} {5x13+19+18 {-stretch {} {} 0 1}} +} -result {5x13+19+18 {-stretch {} {} 0 1}} + .t delete 1.0 end .t insert end "This is the first line" -frame .f -width 10 -height 6 -bg $color -.t window create 1.3 -window .f -padx 1 -pady 2 -test textWind-2.1 {TkTextWindowCmd procedure} { - list [catch {.t window} msg] $msg -} {1 {wrong # args: should be ".t window option ?arg arg ...?"}} -test textWind-2.2 {TkTextWindowCmd procedure, "cget" option} { - list [catch {.t window cget} msg] $msg -} {1 {wrong # args: should be ".t window cget index option"}} -test textWind-2.3 {TkTextWindowCmd procedure, "cget" option} { - list [catch {.t window cget a b c} msg] $msg -} {1 {wrong # args: should be ".t window cget index option"}} -test textWind-2.4 {TkTextWindowCmd procedure, "cget" option} { - list [catch {.t window cget gorp -padx} msg] $msg -} {1 {bad text index "gorp"}} -test textWind-2.5 {TkTextWindowCmd procedure, "cget" option} { - list [catch {.t window cget 1.2 -padx} msg] $msg -} {1 {no embedded window at index "1.2"}} -test textWind-2.6 {TkTextWindowCmd procedure, "cget" option} { - list [catch {.t window cget .f -bogus} msg] $msg -} {1 {unknown option "-bogus"}} -test textWind-2.7 {TkTextWindowCmd procedure, "cget" option} { - list [catch {.t window cget .f -pady} msg] $msg -} {0 2} -test textWind-2.8 {TkTextWindowCmd procedure} { - list [catch {.t window co} msg] $msg -} {1 {wrong # args: should be ".t window configure index ?option value ...?"}} -test textWind-2.9 {TkTextWindowCmd procedure} { - list [catch {.t window configure gorp} msg] $msg -} {1 {bad text index "gorp"}} -test textWind-2.10 {TkTextWindowCmd procedure} { - .t delete 1.0 end - list [catch {.t window configure 1.0} msg] $msg -} {1 {no embedded window at index "1.0"}} -test textWind-2.11 {TkTextWindowCmd procedure} { +test textWind-2.1 {TkTextWindowCmd procedure} -body { + .t window +} -returnCodes error -result {wrong # args: should be ".t window option ?arg ...?"} +test textWind-2.2 {TkTextWindowCmd procedure, "cget" option} -body { + .t window cget +} -returnCodes error -result {wrong # args: should be ".t window cget index option"} +test textWind-2.3 {TkTextWindowCmd procedure, "cget" option} -body { + .t window cget a b c +} -returnCodes error -result {wrong # args: should be ".t window cget index option"} +test textWind-2.4 {TkTextWindowCmd procedure, "cget" option} -body { + .t window cget gorp -padx +} -returnCodes error -result {bad text index "gorp"} +test textWind-2.5 {TkTextWindowCmd procedure, "cget" option} -body { + .t window cget 1.2 -padx +} -returnCodes error -result {no embedded window at index "1.2"} +test textWind-2.6 {TkTextWindowCmd procedure, "cget" option} -setup { + destroy .f +} -body { + frame .f -width 10 -height 6 -bg $color + .t window create 1.3 -window .f -padx 1 -pady 2 + .t window cget .f -bogus +} -cleanup { + destroy .f +} -returnCodes error -result {unknown option "-bogus"} +test textWind-2.7 {TkTextWindowCmd procedure, "cget" option} -setup { + destroy .f +} -body { + frame .f -width 10 -height 6 -bg $color + .t window create 1.3 -window .f -padx 1 -pady 2 + .t window cget .f -pady +} -cleanup { + destroy .f +} -returnCodes ok -result {2} +test textWind-2.8 {TkTextWindowCmd procedure} -body { + .t window co +} -returnCodes error -result {wrong # args: should be ".t window configure index ?-option value ...?"} +test textWind-2.9 {TkTextWindowCmd procedure} -body { + .t window configure gorp +} -returnCodes error -result {bad text index "gorp"} +test textWind-2.10 {TkTextWindowCmd procedure} -body { + .t delete 1.0 end + .t window configure 1.0 +} -returnCodes error -result {no embedded window at index "1.0"} +test textWind-2.11 {TkTextWindowCmd procedure} -setup { +# I kept this as it "influenced" the test case in previous releases + destroy .f + frame .f -width 10 -height 6 -bg $color + .t window create 1.3 -window .f -padx 1 -pady 2 .t delete 1.0 end +} -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" frame .f -width 10 -height 6 -bg $color .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo update - list [catch {.t window configure .f} msg] $msg -} {0 {{-align {} {} center baseline} {-create {} {} {} foo} {-padx {} {} 0 1} {-pady {} {} 0 2} {-stretch {} {} 0 0} {-window {} {} {} .f}}} -test textWind-2.12 {TkTextWindowCmd procedure} { + .t window configure .f +} -cleanup { + destroy .f +} -result {{-align {} {} center baseline} {-create {} {} {} foo} {-padx {} {} 0 1} {-pady {} {} 0 2} {-stretch {} {} 0 0} {-window {} {} {} .f}} +test textWind-2.12 {TkTextWindowCmd procedure} -setup { +# I kept this as it "influenced" the test case in previous releases + destroy .f + frame .f -width 10 -height 6 -bg $color + .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo .t delete 1.0 end +} -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" frame .f -width 10 -height 6 -bg $color .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo update list [.t window configure .f -padx 33] [.t window configure .f -padx] -} {{} {-padx {} {} 0 33}} -test textWind-2.13 {TkTextWindowCmd procedure} { +} -cleanup { + destroy .f +} -result {{} {-padx {} {} 0 33}} +test textWind-2.13 {TkTextWindowCmd procedure} -setup { +# I kept this as it "influenced" the test case in previous releases + destroy .f + frame .f -width 10 -height 6 -bg $color + .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo .t delete 1.0 end +} -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" frame .f -width 10 -height 6 -bg $color .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 update list [.t window configure .f -padx 14 -pady 15] \ - [.t window configure .f -padx] [.t window configure .f -pady] -} {{} {-padx {} {} 0 14} {-pady {} {} 0 15}} -test textWind-2.14 {TkTextWindowCmd procedure} { - list [catch {.t window create} msg] $msg -} {1 {wrong # args: should be ".t window create index ?option value ...?"}} -test textWind-2.15 {TkTextWindowCmd procedure} { - list [catch {.t window create gorp} msg] $msg -} {1 {bad text index "gorp"}} -test textWind-2.16 {TkTextWindowCmd procedure, don't insert after end} { + [.t window configure .f -padx] [.t window configure .f -pady] +} -cleanup { + destroy .f +} -result {{} {-padx {} {} 0 14} {-pady {} {} 0 15}} +test textWind-2.14 {TkTextWindowCmd procedure} -setup { + .t delete 1.0 end +} -body { + .t window create +} -returnCodes error -result {wrong # args: should be ".t window create index ?-option value ...?"} +test textWind-2.15 {TkTextWindowCmd procedure} -setup { + .t delete 1.0 end +} -body { + .t window create gorp +} -returnCodes error -result {bad text index "gorp"} +test textWind-2.16 {TkTextWindowCmd procedure, don't insert after end} -setup { +# I kept this as it "influenced" the test case in previous releases + destroy .f + frame .f -width 10 -height 6 -bg $color + .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 .t delete 1.0 end +} -body { .t insert end "Line 1\nLine 2" frame .f -width 20 -height 10 -bg $color .t window create end -window .f .t index .f -} {2.6} -test textWind-2.17 {TkTextWindowCmd procedure} { +} -result {2.6} +test textWind-2.17 {TkTextWindowCmd procedure} -setup { .t delete 1.0 end +} -body { list [catch {.t window create 1.0} msg] $msg [.t window configure 1.0] -} {0 {} {{-align {} {} center center} {-create {} {} {} {}} {-padx {} {} 0 0} {-pady {} {} 0 0} {-stretch {} {} 0 0} {-window {} {} {} {}}}} -test textWind-2.18 {TkTextWindowCmd procedure} { +} -result {0 {} {{-align {} {} center center} {-create {} {} {} {}} {-padx {} {} 0 0} {-pady {} {} 0 0} {-stretch {} {} 0 0} {-window {} {} {} {}}}} +test textWind-2.18 {TkTextWindowCmd procedure} -setup { +# I kept this as it "influenced" the test case in previous releases + destroy .f + frame .f -width 20 -height 10 -bg $color + .t window create end -window .f + .t delete 1.0 end +} -body { + frame .f -width 10 -height 6 -bg $color + .t window create 1.0 -window .f -gorp stupid +} -returnCodes error -result {unknown option "-gorp"} +test textWind-2.19 {TkTextWindowCmd procedure} -setup { +# I kept this as it "influenced" the test case in previous releases + destroy .f + frame .f -width 20 -height 10 -bg $color + .t window create end -window .f + .t delete 1.0 end +} -body { + frame .f -width 10 -height 6 -bg $color + catch {.t window create 1.0 -window .f -gorp stupid} + list [winfo exists .f] [.t index 1.end] [catch {.t index .f}] +} -result {0 1.0 1} +test textWind-2.20 {TkTextWindowCmd procedure} -setup { .t delete 1.0 end + destroy .f +} -body { frame .f -width 10 -height 6 -bg $color - list [catch {.t window create 1.0 -window .f -gorp stupid} msg] $msg \ - [winfo exists .f] [.t index 1.end] [catch {.t index .f}] -} {1 {unknown option "-gorp"} 0 1.0 1} -test textWind-2.19 {TkTextWindowCmd procedure} { + .t window create 1.0 -gorp -window .f stupid +} -returnCodes error -result {unknown option "-gorp"} +test textWind-2.21 {TkTextWindowCmd procedure} -setup { .t delete 1.0 end - catch {destroy .f} + destroy .f +} -body { frame .f -width 10 -height 6 -bg $color - list [catch {.t window create 1.0 -gorp -window .f stupid} msg] $msg \ - [winfo exists .f] [.t index 1.end] [catch {.t index .f}] -} {1 {unknown option "-gorp"} 1 1.0 1} -test textWind-2.20 {TkTextWindowCmd procedure} { - list [catch {.t window c} msg] $msg -} {1 {ambiguous window option "c": must be cget, configure, create, or names}} + catch {.t window create 1.0 -gorp -window .f stupid} + list [winfo exists .f] [.t index 1.end] [catch {.t index .f}] +} -result {1 1.0 1} +test textWind-2.22 {TkTextWindowCmd procedure} -setup { + .t delete 1.0 end +} -body { + .t window c +} -returnCodes error -result {ambiguous window option "c": must be cget, configure, create, or names} destroy .f -test textWind-2.21 {TkTextWindowCmd procedure, "names" option} { - list [catch {.t window names foo} msg] $msg -} {1 {wrong # args: should be ".t window names"}} -test textWind-2.22 {TkTextWindowCmd procedure, "names" option} { +test textWind-2.23 {TkTextWindowCmd procedure, "names" option} -setup { + .t delete 1.0 end +} -body { + .t window names foo +} -returnCodes error -result {wrong # args: should be ".t window names"} +test textWind-2.24 {TkTextWindowCmd procedure, "names" option} -setup { .t delete 1.0 end +} -body { .t window names -} {} -test textWind-2.23 {TkTextWindowCmd procedure, "names" option} { +} -result {} +test textWind-2.25 {TkTextWindowCmd procedure, "names" option} -setup { .t delete 1.0 end + destroy .f .f2 .t.f .t.f2 +} -body { foreach i {.f .f2 .t.f .t.f2} { - frame $i -width 20 -height 20 - .t window create end -window $i + frame $i -width 20 -height 20 + .t window create end -window $i } - set result [.t window names] + lsort [.t window names] +} -cleanup { destroy .f .f2 .t.f .t.f2 - lsort $result -} {.f .f2 .t.f .t.f2} +} -result {.f .f2 .t.f .t.f2} -test textWind-3.1 {EmbWinConfigure procedure} { - .t delete 1.0 end + +test textWind-3.1 {EmbWinConfigure procedure} -setup { + destroy .f +} -body { frame .f -width 10 -height 6 -bg $color .t window create 1.0 -window .f - list [catch {.t window configure 1.0 -foo bar} msg] $msg -} {1 {unknown option "-foo"}} -test textWind-3.2 {EmbWinConfigure procedure} {fonts} { - .t delete 1.0 end + .t window configure 1.0 -foo bar +} -cleanup { + destroy .f +} -returnCodes error -result {unknown option "-foo"} +test textWind-3.2 {EmbWinConfigure procedure} -constraints fonts -setup { + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 10 -height 20 -bg $color .t window create 1.3 -window .f update .t window configure 1.3 -window {} update - list [catch {.t index .f} msg] $msg [winfo ismapped .f] [.t bbox 1.4] -} {1 {bad text index ".f"} 0 {26 5 7 13}} -catch {destroy .f} -test textWind-3.3 {EmbWinConfigure procedure} {fonts} { - .t delete 1.0 end + .t index .f +} -cleanup { + destroy .f +} -returnCodes error -result {bad text index ".f"} +test textWind-3.3 {EmbWinConfigure procedure} -constraints fonts -setup { + destroy .f +} -body { + .t insert 1.0 "Some sample text" + frame .f -width 10 -height 20 -bg $color + .t window create 1.3 -window .f + update + .t window configure 1.3 -window {} + update + catch {.t index .f} + list [winfo ismapped .f] [.t bbox 1.4] +} -cleanup { + destroy .f +} -result {0 {26 5 7 13}} +test textWind-3.4 {EmbWinConfigure procedure} -constraints fonts -setup { + destroy .t.f +} -body { .t insert 1.0 "Some sample text" frame .t.f -width 10 -height 20 -bg $color .t window create 1.3 -window .t.f update .t window configure 1.3 -window {} update - list [catch {.t index .t.f} msg] $msg [winfo ismapped .t.f] [.t bbox 1.4] -} {1 {bad text index ".t.f"} 0 {26 5 7 13}} -catch {destroy .t.f} -test textWind-3.4 {EmbWinConfigure procedure} {fonts} { - .t delete 1.0 end + .t index .t.f +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad text index ".t.f"} +test textWind-3.5 {EmbWinConfigure procedure} -constraints fonts -setup { + destroy .t.f +} -body { + .t insert 1.0 "Some sample text" + frame .t.f -width 10 -height 20 -bg $color + .t window create 1.3 -window .t.f + update + .t window configure 1.3 -window {} + update + catch {.t index .t.f} + list [winfo ismapped .t.f] [.t bbox 1.4] +} -cleanup { + destroy .t.f +} -result {0 {26 5 7 13}} +test textWind-3.6 {EmbWinConfigure procedure} -constraints fonts -setup { + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 10 -height 20 -bg $color .t window create 1.3 @@ -252,89 +365,143 @@ test textWind-3.4 {EmbWinConfigure procedure} {fonts} { .t window configure 1.3 -window .f update list [catch {.t index .f} msg] $msg [winfo ismapped .f] [.t bbox 1.4] -} {0 1.3 1 {36 8 7 13}} -test textWind-3.5 {EmbWinConfigure procedure} { - .t delete 1.0 end +} -cleanup { + destroy .f +} -result {0 1.3 1 {36 8 7 13}} +test textWind-3.7 {EmbWinConfigure procedure} -setup { + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f frame .f.f -width 15 -height 20 -bg $color pack .f.f - list [catch {.t window create 1.3 -window .f.f} msg] $msg -} {1 {can't embed .f.f in .t}} -catch {destroy .f} -test textWind-3.6 {EmbWinConfigure procedure} { - .t delete 1.0 end + .t window create 1.3 -window .f.f +} -cleanup { + destroy .f +} -returnCodes error -result {can't embed .f.f in .t} +test textWind-3.8 {EmbWinConfigure procedure} -setup { + destroy .t2 +} -body { .t insert 1.0 "Some sample text" toplevel .t2 -width 20 -height 10 -bg $color .t window create 1.3 - list [catch {.t window configure 1.3 -window .t2} msg] $msg \ - [.t window configure 1.3 -window] -} {1 {can't embed .t2 in .t} {-window {} {} {} {}}} -catch {destroy .t2} -test textWind-3.7 {EmbWinConfigure procedure} { - .t delete 1.0 end + .t window configure 1.3 -window .t2 +} -cleanup { + destroy .t2 +} -returnCodes error -result {can't embed .t2 in .t} +test textWind-3.9 {EmbWinConfigure procedure} -setup { + destroy .t2 +} -body { + .t insert 1.0 "Some sample text" + toplevel .t2 -width 20 -height 10 -bg $color + .t window create 1.3 + catch {.t window configure 1.3 -window .t2} + .t window configure 1.3 -window +} -cleanup { + destroy .t2 +} -result {-window {} {} {} {}} +test textWind-3.10 {EmbWinConfigure procedure} -setup { + .t delete 1.0 end +} -body { .t insert 1.0 "Some sample text" .t window create 1.3 - list [catch {.t window configure 1.3 -window .t} msg] $msg -} {1 {can't embed .t in .t}} -test textWind-3.8 {EmbWinConfigure procedure} { + .t window configure 1.3 -window .t +} -returnCodes error -result {can't embed .t in .t} +test textWind-3.11 {EmbWinConfigure procedure} -setup { + .t delete 1.0 end +} -body { # This test checks for various errors when the text claims # a window away from itself. - .t delete 1.0 end .t insert 1.0 "Some sample text" button .t.b -text "Hello!" .t window create 1.4 -window .t.b .t window create 1.6 -window .t.b update .t index .t.b -} {1.6} +} -result {1.6} + .t delete 1.0 end frame .f -width 10 -height 20 -bg $color .t window create 1.0 -window .f -test textWind-4.1 {AlignParseProc and AlignPrintProc procedures} { +test textWind-4.1 {AlignParseProc and AlignPrintProc procedures} -body { .t window configure 1.0 -align baseline .t window configure 1.0 -align -} {-align {} {} center baseline} -test textWind-4.2 {AlignParseProc and AlignPrintProc procedures} { +} -result {-align {} {} center baseline} +test textWind-4.2 {AlignParseProc and AlignPrintProc procedures} -body { .t window configure 1.0 -align bottom .t window configure 1.0 -align -} {-align {} {} center bottom} -test textWind-4.3 {AlignParseProc and AlignPrintProc procedures} { +} -result {-align {} {} center bottom} +test textWind-4.3 {AlignParseProc and AlignPrintProc procedures} -body { .t window configure 1.0 -align center .t window configure 1.0 -align -} {-align {} {} center center} -test textWind-4.4 {AlignParseProc and AlignPrintProc procedures} { +} -result {-align {} {} center center} +test textWind-4.4 {AlignParseProc and AlignPrintProc procedures} -body { .t window configure 1.0 -align top .t window configure 1.0 -align -} {-align {} {} center top} -test textWind-4.5 {AlignParseProc and AlignPrintProc procedures} { +} -result {-align {} {} center top} +test textWind-4.5 {AlignParseProc and AlignPrintProc procedures} -body { + .t window configure 1.0 -align top + .t window configure 1.0 -align gorp +} -returnCodes error -result {bad align "gorp": must be baseline, bottom, center, or top} +test textWind-4.6 {AlignParseProc and AlignPrintProc procedures} -body { .t window configure 1.0 -align top - list [catch {.t window configure 1.0 -align gorp} msg] $msg \ - [.t window configure 1.0 -align] -} {1 {bad align "gorp": must be baseline, bottom, center, or top} {-align {} {} center top}} + catch {.t window configure 1.0 -align gorp} + .t window configure 1.0 -align +} -result {-align {} {} center top} + -test textWind-5.1 {EmbWinStructureProc procedure} {fonts} { +test textWind-5.1 {EmbWinStructureProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 10 -height 20 -bg $color .t window create 1.2 -window .f update destroy .f - list [catch {.t index .f} msg] $msg [.t bbox 1.2] [.t bbox 1.3] -} {1 {bad text index ".f"} {19 11 0 0} {19 5 7 13}} -test textWind-5.2 {EmbWinStructureProc procedure} {fonts} { + .t index .f +} -returnCodes error -result {bad text index ".f"} +test textWind-5.2 {EmbWinStructureProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { + .t insert 1.0 "Some sample text" + frame .f -width 10 -height 20 -bg $color + .t window create 1.2 -window .f + update + destroy .f + catch {.t index .f} + list [.t bbox 1.2] [.t bbox 1.3] +} -result {{19 11 0 0} {19 5 7 13}} +test textWind-5.3 {EmbWinStructureProc procedure} -constraints fonts -setup { + .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 10 -height 20 -bg $color .t window create 1.2 -align bottom .t window configure 1.2 -window .f update destroy .f - list [catch {.t index .f} msg] $msg [.t bbox 1.2] [.t bbox 1.3] -} {1 {bad text index ".f"} {19 18 0 0} {19 5 7 13}} -test textWind-5.3 {EmbWinStructureProc procedure} {fonts} { + .t index .f +} -returnCodes error -result {bad text index ".f"} +test textWind-5.4 {EmbWinStructureProc procedure} -constraints fonts -setup { + .t delete 1.0 end +} -body { + .t insert 1.0 "Some sample text" + frame .f -width 10 -height 20 -bg $color + .t window create 1.2 -align bottom + .t window configure 1.2 -window .f + update + destroy .f + catch {.t index .f} + list [.t bbox 1.2] [.t bbox 1.3] +} -result {{19 18 0 0} {19 5 7 13}} +test textWind-5.5 {EmbWinStructureProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" .t window create 1.2 -create {frame .f -width 10 -height 20 -bg $color} update @@ -342,21 +509,31 @@ test textWind-5.3 {EmbWinStructureProc procedure} {fonts} { destroy .f update list [catch {.t index .f} msg] $msg [.t bbox 1.2] [.t bbox 1.3] -} {0 1.2 {19 6 20 10} {39 5 7 13}} +} -result {0 1.2 {19 6 20 10} {39 5 7 13}} + -test textWind-6.1 {EmbWinRequestProc procedure} {fonts} { +test textWind-6.1 {EmbWinRequestProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f + set result {} +} -body { .t insert 1.0 "Some sample text" frame .f -width 10 -height 20 -bg $color .t window create 1.2 -window .f - set result {} lappend result [.t bbox 1.2] [.t bbox 1.3] .f configure -width 25 -height 30 lappend result [.t bbox 1.2] [.t bbox 1.3] -} {{19 5 10 20} {29 8 7 13} {19 5 25 30} {44 13 7 13}} +} -cleanup { + destroy .f +} -result {{19 5 10 20} {29 8 7 13} {19 5 25 30} {44 13 7 13}} -test textWind-7.1 {EmbWinLostSlaveProc procedure} {textfonts} { + +test textWind-7.1 {EmbWinLostSlaveProc procedure} -constraints { + textfonts +} -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 10 -height 20 -bg $color .t window create 1.2 -window .f @@ -364,9 +541,15 @@ test textWind-7.1 {EmbWinLostSlaveProc procedure} {textfonts} { place .f -in .t -x 100 -y 50 update list [winfo geom .f] [.t bbox 1.2] -} [list 10x20+105+55 [list 19 [expr {11+$fixedDiff/2}] 0 0]] -test textWind-7.2 {EmbWinLostSlaveProc procedure} {textfonts} { +} -cleanup { + destroy .f +} -result [list 10x20+105+55 [list 19 [expr {11+$fixedDiff/2}] 0 0]] +test textWind-7.2 {EmbWinLostSlaveProc procedure} -constraints { + textfonts +} -setup { .t delete 1.0 end + destroy .t.f +} -body { .t insert 1.0 "Some sample text" frame .t.f -width 10 -height 20 -bg $color .t window create 1.2 -window .t.f @@ -374,76 +557,124 @@ test textWind-7.2 {EmbWinLostSlaveProc procedure} {textfonts} { place .t.f -x 100 -y 50 update list [winfo geom .t.f] [.t bbox 1.2] -} [list 10x20+105+55 [list 19 [expr {11+$fixedDiff/2}] 0 0]] -catch {destroy .f} -catch {destroy .t.f} +} -cleanup { + destroy .t.f +} -result [list 10x20+105+55 [list 19 [expr {11+$fixedDiff/2}] 0 0]] -test textWind-8.1 {EmbWinDeleteProc procedure} {fonts} { + +test textWind-8.1 {EmbWinDeleteProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 10 -height 20 -bg $color .t window create 1.2 -window .f bind .f <Destroy> {set x destroyed} set x XXX .t delete 1.2 - list $x [.t bbox 1.2] [.t bbox 1.3] [catch {.t index .f} msg] $msg \ - [winfo exists .f] -} {destroyed {19 5 7 13} {26 5 7 13} 1 {bad text index ".f"} 0} + list $x [.t bbox 1.2] [.t bbox 1.3] [winfo exists .f] +} -result {destroyed {19 5 7 13} {26 5 7 13} 0} +test textWind-8.2 {EmbWinDeleteProc procedure} -constraints fonts -setup { + .t delete 1.0 end + destroy .f +} -body { + .t insert 1.0 "Some sample text" + frame .f -width 10 -height 20 -bg $color + .t window create 1.2 -window .f + bind .f <Destroy> {set x destroyed} + set x XXX + .t delete 1.2 + .t index .f +} -returnCodes error -result {bad text index ".f"} -test textWind-9.1 {EmbWinCleanupProc procedure} { + +test textWind-9.1 {EmbWinCleanupProc procedure} -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text\nA second line." frame .f -width 10 -height 20 -bg $color .t window create 2.3 -window .f .t delete 1.5 2.1 .t index .f -} 1.7 +} -cleanup { + destroy .f +} -result {1.7} -proc bgerror args { - global msg - set msg $args -} -test textWind-10.1 {EmbWinLayoutProc procedure} { +test textWind-10.1 {EmbWinLayoutProc procedure} -setup { .t delete 1.0 end - .t insert 1.0 "Some sample text" destroy .f +} -body { + .t insert 1.0 "Some sample text" .t window create 1.5 -create { - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -bg $color } update list [winfo exists .f] [winfo width .f] [winfo height .f] [.t index .f] -} {1 10 20 1.5} -test textWind-10.2 {EmbWinLayoutProc procedure, error in creating window} {fonts} { - .t delete 1.0 end +} -cleanup { + destroy .f +} -result {1 10 20 1.5} +test textWind-10.2 {EmbWinLayoutProc procedure, error in creating window} -constraints { + fonts +} -setup { + .t delete 1.0 end + proc bgerror args { + global msg + set msg $args + } +} -body { .t insert 1.0 "Some sample text" - .t window create 1.5 -create { - error "couldn't create window" + .t window create 1.5 -create { + error "couldn't create window" } set msg xyzzy update list $msg [.t bbox 1.5] -} {{{couldn't create window}} {40 11 0 0}} -test textWind-10.3 {EmbWinLayoutProc procedure, error in creating window} {fonts} { - .t delete 1.0 end +} -cleanup { + rename bgerror {} +} -result {{{couldn't create window}} {40 11 0 0}} +test textWind-10.3 {EmbWinLayoutProc procedure, error in creating window} -constraints { + fonts +} -setup { + .t delete 1.0 end + proc bgerror args { + global msg + set msg $args + } +} -body { .t insert 1.0 "Some sample text" .t window create 1.5 -create { - concat gorp + concat gorp } set msg xyzzy update list $msg [.t bbox 1.5] -} {{{bad window path name "gorp"}} {40 11 0 0}} -proc bgerror args { - global msg - if {[lsearch -exact $msg $args] == -1} { - lappend msg $args +} -cleanup { + rename bgerror {} +} -result {{{bad window path name "gorp"}} {40 11 0 0}} + .t delete 1.0 end + destroy .t.f + proc bgerror args { + global msg + if {[lsearch -exact $msg $args] == -1} { + lappend msg $args + } } -} -test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} {textfonts} { - .t delete 1.0 end + +test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} -constraints { + textfonts +} -setup { + .t delete 1.0 end + destroy .t.f + proc bgerror args { + global msg + if {[lsearch -exact $msg $args] == -1} { + lappend msg $args + } + } +} -body { .t insert 1.0 "Some sample text" - catch {destroy .t.f} set msg {} after idle { .t window create 1.5 -create { @@ -453,68 +684,116 @@ test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} {textf } set count 0 while {([llength $msg] < 2) && ($count < 100)} { - update ; incr count; .t bbox 1.5 ; after 10 + update + incr count + .t bbox 1.5 + after 10 } lappend msg [.t bbox 1.5] [winfo exists .t.f.f] -} [list {{can't embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0] 1] -test textWind-10.4.1 {EmbWinLayoutProc procedure, error in creating window} {textfonts} { - .t delete 1.0 end +} -cleanup { + destroy .t.f + rename bgerror {} +} -result [list {{can't embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0] 1] +test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} -constraints { + textfonts +} -setup { + .t delete 1.0 end + destroy .t.f + proc bgerror args { + global msg + if {[lsearch -exact $msg $args] == -1} { + lappend msg $args + } + } +} -body { .t insert 1.0 "Some sample text" - catch {destroy .t.f} .t window create 1.5 -create { - frame .t.f - frame .t.f.f -width 10 -height 20 -bg $color + frame .t.f + frame .t.f.f -width 10 -height 20 -bg $color } set msg {} update idletasks lappend msg [winfo exists .t.f.f] -} [list {{can't embed .t.f.f relative to .t}} 1] +} -cleanup { + destroy .t.f + rename bgerror {} +} -result {{{can't embed .t.f.f relative to .t}} 1} catch {destroy .t.f} -test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} {textfonts} { - .t delete 1.0 end +test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} -constraints { + textfonts +} -setup { + .t delete 1.0 end + proc bgerror args { + global msg + if {[lsearch -exact $msg $args] == -1} { + lappend msg $args + } + } +} -body { .t insert 1.0 "Some sample text" .t window create 1.5 -create { - concat .t + concat .t } set msg {} update lappend msg [.t bbox 1.5] -} [list {{can't embed .t relative to .t}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] -test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} {textfonts} { - .t delete 1.0 end +} -cleanup { + rename bgerror {} +} -result [list {{can't embed .t relative to .t}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] +test textWind-10.7 {EmbWinLayoutProc procedure, error in creating window} -constraints { + textfonts +} -setup { + .t delete 1.0 end + destroy .t2 + proc bgerror args { + global msg + if {[lsearch -exact $msg $args] == -1} { + lappend msg $args + } + } +} -body { .t insert 1.0 "Some sample text" - catch {destroy .t2} .t window create 1.5 -create { - toplevel .t2 -width 100 -height 150 - wm geom .t2 +0+0 - concat .t2 + toplevel .t2 -width 100 -height 150 + wm geom .t2 +0+0 + concat .t2 } set msg {} update lappend msg [.t bbox 1.5] -} [list {{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] -test textWind-10.6.1 {EmbWinLayoutProc procedure, error in creating window} { - .t delete 1.0 end +} -cleanup { + rename bgerror {} +} -result [list {{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] +test textWind-10.8 {EmbWinLayoutProc procedure, error in creating window} -setup { + .t delete 1.0 end + destroy .t2 + proc bgerror args { + global msg + if {[lsearch -exact $msg $args] == -1} { + lappend msg $args + } + } +} -body { .t insert 1.0 "Some sample text" - catch {destroy .t2} .t window create 1.5 -create { - toplevel .t2 -width 100 -height 150 - wm geom .t2 +0+0 - concat .t2 + toplevel .t2 -width 100 -height 150 + wm geom .t2 +0+0 + concat .t2 } set msg {} update set i 0 while {[llength $msg] == 1 && [incr i] < 200} { update } - set msg -} {{{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}}} + return $msg +} -cleanup { + destroy .t2 + rename bgerror {} +} -result {{{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}}} -proc bgerror args { - global msg - set msg $args -} -test textWind-10.7 {EmbWinLayoutProc procedure, steal window from self} { +test textWind-10.9 {EmbWinLayoutProc procedure, steal window from self} -setup { .t delete 1.0 end + destroy .t.b +} -body { .t insert 1.0 ABCDEFGHIJKLMNOP button .t.b -text "Hello!" .t window create 1.5 -window .t.b @@ -522,64 +801,104 @@ test textWind-10.7 {EmbWinLayoutProc procedure, steal window from self} { .t window create 1.3 -create {concat .t.b} update .t index .t.b -} {1.3} -catch {destroy .t2} -test textWind-10.8 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} { - .t configure -wrap char +} -cleanup { + destroy .t.b +} -result {1.3} +test textWind-10.10 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { + fonts +} -setup { .t delete 1.0 end + destroy .f +} -body { + .t configure -wrap char .t insert 1.0 "Some sample text" frame .f -width 125 -height 20 -bg $color -bd 2 -relief raised .t window create 1.12 -window .f list [.t bbox .f] [.t bbox 1.13] -} {{89 5 126 20} {5 25 7 13}} -test textWind-10.9 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} { - .t configure -wrap char +} -cleanup { + destroy .f +} -result {{89 5 126 20} {5 25 7 13}} +test textWind-10.11 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { + fonts +} -setup { .t delete 1.0 end + destroy .f +} -body { + .t configure -wrap char .t insert 1.0 "Some sample text" frame .f -width 126 -height 20 -bg $color -bd 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] -} {{89 5 126 20} {5 25 7 13}} -test textWind-10.10 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} { - .t configure -wrap char +} -cleanup { + destroy .f +} -result {{89 5 126 20} {5 25 7 13}} +test textWind-10.12 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { + fonts +} -setup { .t delete 1.0 end + destroy .f +} -body { + .t configure -wrap char .t insert 1.0 "Some sample text" frame .f -width 127 -height 20 -bg $color -bd 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] -} {{5 18 127 20} {132 21 7 13}} -test textWind-10.11 {EmbWinLayoutProc procedure, doesn't fit on line} { - .t configure -wrap none +} -cleanup { + destroy .f +} -result {{5 18 127 20} {132 21 7 13}} +test textWind-10.13 {EmbWinLayoutProc procedure, doesn't fit on line} -setup { .t delete 1.0 end + destroy .f +} -body { + .t configure -wrap none .t insert 1.0 "Some sample text" frame .f -width 130 -height 20 -bg $color -bd 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] -} {{89 5 126 20} {}} -test textWind-10.12 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} { - .t configure -wrap none +} -cleanup { + destroy .f +} -result {{89 5 126 20} {}} +test textWind-10.14 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { + fonts +} -setup { .t delete 1.0 end + destroy .f +} -body { + .t configure -wrap none .t insert 1.0 "Some sample text" frame .f -width 130 -height 220 -bg $color -bd 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] -} {{89 5 126 78} {}} -test textWind-10.13 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} { - .t configure -wrap char +} -cleanup { + destroy .f +} -result {{89 5 126 78} {}} +test textWind-10.15 {EmbWinLayoutProc procedure, doesn't fit on line} -constraints { + fonts +} -setup { .t delete 1.0 end + destroy .f +} -body { + .t configure -wrap char .t insert 1.0 "Some sample text" frame .f -width 250 -height 220 -bg $color -bd 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] -} {{5 18 210 65} {}} +} -cleanup { + destroy .f +} -result {{5 18 210 65} {}} + -test textWind-11.1 {EmbWinDisplayProc procedure, geometry transforms} { +test textWind-11.1 {EmbWinDisplayProc procedure, geometry transforms} -setup { .t delete 1.0 end + destroy .f + place forget .t + pack .t +} -body { .t insert 1.0 "Some sample text" pack forget .t place .t -x 30 -y 50 @@ -587,11 +906,16 @@ test textWind-11.1 {EmbWinDisplayProc procedure, geometry transforms} { .t window create 1.12 -window .f update winfo geom .f -} {30x20+119+55} -place forget .t -pack .t -test textWind-11.2 {EmbWinDisplayProc procedure, geometry transforms} { - .t delete 1.0 end +} -cleanup { + destroy .f + place forget .t +} -result {30x20+119+55} +test textWind-11.2 {EmbWinDisplayProc procedure, geometry transforms} -setup { + .t delete 1.0 end + destroy .t.f + place forget .t + pack .t +} -body { .t insert 1.0 "Some sample text" pack forget .t place .t -x 30 -y 50 @@ -599,11 +923,17 @@ test textWind-11.2 {EmbWinDisplayProc procedure, geometry transforms} { .t window create 1.12 -window .t.f update winfo geom .t.f -} {30x20+89+5} -place forget .t -pack .t -test textWind-11.3 {EmbWinDisplayProc procedure, configuration optimization} { +} -cleanup { + destroy .t.f + place forget .t + pack .t +} -result {30x20+89+5} +test textWind-11.3 {EmbWinDisplayProc procedure, configuration optimization} -setup { .t delete 1.0 end + destroy .f + place forget .t + pack .t +} -body { .t insert 1.0 "Some sample text" frame .f -width 30 -height 20 -bg $color .t window create 1.12 -window .f @@ -613,10 +943,18 @@ test textWind-11.3 {EmbWinDisplayProc procedure, configuration optimization} { .t delete 1.0 .t insert 1.0 "X" update - set x -} {no configures} -test textWind-11.4 {EmbWinDisplayProc procedure, horizontal scrolling} {fonts} { - .t delete 1.0 end + return $x +} -cleanup { + destroy .f + place forget .t + pack .t +} -result {no configures} +test textWind-11.4 {EmbWinDisplayProc procedure, horizontal scrolling} -constraints { + fonts +} -setup { + .t delete 1.0 end + destroy .f .f2 +} -body { .t insert 1.0 "xyzzy\nFirst window here: " .t configure -wrap none frame .f -width 30 -height 20 -bg $color @@ -629,9 +967,15 @@ test textWind-11.4 {EmbWinDisplayProc procedure, horizontal scrolling} {fonts} { .t xview scroll 5 units update list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] [winfo ismapped .f2] -} {1 30x20+103+18 {103 18 30 20} 0} -test textWind-11.5 {EmbWinDisplayProc procedure, horizontal scrolling} {fonts} { - .t delete 1.0 end +} -cleanup { + destroy .f .f2 +} -result {1 30x20+103+18 {103 18 30 20} 0} +test textWind-11.5 {EmbWinDisplayProc procedure, horizontal scrolling} -constraints { + fonts +} -setup { + .t delete 1.0 end + destroy .f .f2 +} -body { .t insert 1.0 "xyzzy\nFirst window here: " .t configure -wrap none frame .f -width 30 -height 20 -bg $color @@ -645,11 +989,16 @@ test textWind-11.5 {EmbWinDisplayProc procedure, horizontal scrolling} {fonts} { .t xview scroll 25 units update list [winfo ismapped .f] [winfo ismapped .f2] [winfo geom .f2] [.t bbox .f2] -} {0 1 40x10+119+23 {119 23 40 10}} +} -cleanup { + destroy .f .f2 +} -result {0 1 40x10+119+23 {119 23 40 10}} .t configure -wrap char -test textWind-12.1 {EmbWinUndisplayProc procedure, mapping/unmapping} { + +test textWind-12.1 {EmbWinUndisplayProc procedure, mapping/unmapping} -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 30 -height 20 -bg $color .t window create 1.2 -window .f @@ -669,74 +1018,114 @@ test textWind-12.1 {EmbWinUndisplayProc procedure, mapping/unmapping} { .t configure -wrap none .t insert 1.0 "Enough text to make the line run off-screen" update - set x -} {created mapped modified replaced unmapped mapped off-screen unmapped} + return $x +} -cleanup { + destroy .f +} -result {created mapped modified replaced unmapped mapped off-screen unmapped} + -test textWind-13.1 {EmbWinBboxProc procedure} { +test textWind-13.1 {EmbWinBboxProc procedure} -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 5 -height 5 -bg $color .t window create 1.2 -window .f -align top -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] -} {5x5+21+6 {21 6 5 5}} -test textWind-13.2 {EmbWinBboxProc procedure} {fonts} { +} -cleanup { + destroy .f +} -result {5x5+21+6 {21 6 5 5}} +test textWind-13.2 {EmbWinBboxProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 5 -height 5 -bg $color .t window create 1.2 -window .f -align center -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] -} {5x5+21+9 {21 9 5 5}} -test textWind-13.3 {EmbWinBboxProc procedure} {fonts} { +} -cleanup { + destroy .f +} -result {5x5+21+9 {21 9 5 5}} +test textWind-13.3 {EmbWinBboxProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 5 -height 5 -bg $color .t window create 1.2 -window .f -align baseline -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] -} {5x5+21+10 {21 10 5 5}} -test textWind-13.4 {EmbWinBboxProc procedure} {fonts} { +} -cleanup { + destroy .f +} -result {5x5+21+10 {21 10 5 5}} +test textWind-13.4 {EmbWinBboxProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 5 -height 5 -bg $color .t window create 1.2 -window .f -align bottom -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] -} {5x5+21+12 {21 12 5 5}} -test textWind-13.5 {EmbWinBboxProc procedure} {fonts} { +} -cleanup { + destroy .f +} -result {5x5+21+12 {21 12 5 5}} +test textWind-13.5 {EmbWinBboxProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 5 -height 5 -bg $color .t window create 1.2 -window .f -align top -padx 2 -pady 1 -stretch 1 update list [winfo geom .f] [.t bbox .f] -} {5x11+21+6 {21 6 5 11}} -test textWind-13.6 {EmbWinBboxProc procedure} {fonts} { +} -cleanup { + destroy .f +} -result {5x11+21+6 {21 6 5 11}} +test textWind-13.6 {EmbWinBboxProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 5 -height 5 -bg $color .t window create 1.2 -window .f -align center -padx 2 -pady 1 -stretch 1 update list [winfo geom .f] [.t bbox .f] -} {5x11+21+6 {21 6 5 11}} -test textWind-13.7 {EmbWinBboxProc procedure} {fonts} { +} -cleanup { + destroy .f +} -result {5x11+21+6 {21 6 5 11}} +test textWind-13.7 {EmbWinBboxProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 5 -height 5 -bg $color .t window create 1.2 -window .f -align baseline -padx 2 -pady 1 -stretch 1 update list [winfo geom .f] [.t bbox .f] -} {5x9+21+6 {21 6 5 9}} -test textWind-13.8 {EmbWinBboxProc procedure} {fonts} { +} -cleanup { + destroy .f +} -result {5x9+21+6 {21 6 5 9}} +test textWind-13.8 {EmbWinBboxProc procedure} -constraints fonts -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 5 -height 5 -bg $color .t window create 1.2 -window .f -align bottom -padx 2 -pady 1 -stretch 1 update list [winfo geom .f] [.t bbox .f] -} {5x11+21+6 {21 6 5 11}} -test textWind-13.9 {EmbWinBboxProc procedure, spacing options} {fonts} { +} -cleanup { + destroy .f +} -result {5x11+21+6 {21 6 5 11}} +test textWind-13.9 {EmbWinBboxProc procedure, spacing options} -constraints { + fonts +} -setup { + .t delete 1.0 end + destroy .f +} -body { .t configure -spacing1 5 -spacing3 2 .t delete 1.0 end .t insert 1.0 "Some sample text" @@ -744,11 +1133,15 @@ test textWind-13.9 {EmbWinBboxProc procedure, spacing options} {fonts} { .t window create 1.2 -window .f -align center -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] -} {5x5+21+14 {21 14 5 5}} -.t configure -spacing1 0 -spacing2 0 -spacing3 0 +} -cleanup { + destroy .f +} -result {5x5+21+14 {21 14 5 5}} + -test textWind-14.1 {EmbWinDelayedUnmap procedure} { +test textWind-14.1 {EmbWinDelayedUnmap procedure} -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 30 -height 20 -bg $color .t window create 1.2 -window .f @@ -760,11 +1153,14 @@ test textWind-14.1 {EmbWinDelayedUnmap procedure} { .t window configure .f -window {} lappend x updated update - set x -} {modified removed unmapped updated} -catch {destroy .f} -test textWind-14.2 {EmbWinDelayedUnmap procedure} { + return $x +} -cleanup { + destroy .f +} -result {modified removed unmapped updated} +test textWind-14.2 {EmbWinDelayedUnmap procedure} -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text" frame .f -width 30 -height 20 -bg $color .t window create 1.2 -window .f @@ -776,10 +1172,14 @@ test textWind-14.2 {EmbWinDelayedUnmap procedure} { .t delete .f lappend x updated update - set x -} {modified deleted updated} -test textWind-14.3 {EmbWinDelayedUnmap procedure} { + return $x +} -cleanup { + destroy .f +} -result {modified deleted updated} +test textWind-14.3 {EmbWinDelayedUnmap procedure} -setup { .t delete 1.0 end + destroy .f +} -body { .t insert 1.0 "Some sample text\nAnother line\n3\n4\n5\n6\n7\n8\n9" frame .f -width 30 -height 20 -bg $color .t window create 1.2 -window .f @@ -788,9 +1188,13 @@ test textWind-14.3 {EmbWinDelayedUnmap procedure} { set result [winfo ismapped .f] update ; after 10 list $result [winfo ismapped .f] -} {1 0} -test textWind-14.4 {EmbWinDelayedUnmap procedure} { +} -cleanup { + destroy .f +} -result {1 0} +test textWind-14.4 {EmbWinDelayedUnmap procedure} -setup { .t delete 1.0 end + destroy .t.f +} -body { .t insert 1.0 "Some sample text\nAnother line\n3\n4\n5\n6\n7\n8\n9" frame .t.f -width 30 -height 20 -bg $color .t window create 1.2 -window .t.f @@ -799,27 +1203,38 @@ test textWind-14.4 {EmbWinDelayedUnmap procedure} { set result [winfo ismapped .t.f] update list $result [winfo ismapped .t.f] -} {1 0} -catch {destroy .t.f} -catch {destroy .f} +} -cleanup { + destroy .t.f +} -result {1 0} -test textWind-15.1 {TkTextWindowIndex procedure} { - list [catch {.t index .foo} msg] $msg -} {1 {bad text index ".foo"}} -test textWind-15.2 {TkTextWindowIndex procedure} {fonts} { - .t configure -wrap none + +test textWind-15.1 {TkTextWindowIndex procedure} -setup { .t delete 1.0 end +} -body { + .t index .foo +} -returnCodes error -result {bad text index ".foo"} +test textWind-15.2 {TkTextWindowIndex procedure} -constraints fonts -setup { + .t delete 1.0 end + destroy .f +} -body { + .t configure -spacing1 0 -spacing2 0 -spacing3 0 \ + -wrap none .t insert 1.0 "Some sample text" frame .f -width 30 -height 20 -bg $color .t window create 1.6 -window .f .t tag add a 1.1 .t tag add a 1.3 list [.t index .f] [.t bbox 1.7] -} {1.6 {77 8 7 13}} +} -cleanup { + destroy .f +} -result {1.6 {77 8 7 13}} -test textWind-16.1 {EmbWinTextStructureProc procedure} { - .t configure -wrap none + +test textWind-16.1 {EmbWinTextStructureProc procedure} -setup { .t delete 1.0 end + destroy .f +} -body { + .t configure -wrap none .t insert 1.0 "Some sample text" frame .f -width 30 -height 20 -bg $color .t window create 1.6 -window .f @@ -827,11 +1242,15 @@ test textWind-16.1 {EmbWinTextStructureProc procedure} { pack forget .t update winfo ismapped .f -} 0 -pack .t -test textWind-16.2 {EmbWinTextStructureProc procedure} { - .t configure -wrap none - .t delete 1.0 end +} -cleanup { + pack .t +} -result 0 +test textWind-16.2 {EmbWinTextStructureProc procedure} -setup { + .t delete 1.0 end + destroy .f .f2 +} -body { + .t configure -spacing1 0 -spacing2 0 -spacing3 0 \ + -wrap none .t insert 1.0 "Some sample text" frame .f -width 30 -height 20 -bg $color .t window create 1.6 -window .f @@ -842,21 +1261,26 @@ test textWind-16.2 {EmbWinTextStructureProc procedure} { pack .f2 -before .t update lappend result [winfo geom .f] [.t bbox .f] -} {30x20+47+5 {47 5 30 20} 30x20+47+35 {47 5 30 20}} -catch {destroy .f2} -test textWind-16.3 {EmbWinTextStructureProc procedure} { - .t configure -wrap none +} -cleanup { + destroy .f .f2 +} -result {30x20+47+5 {47 5 30 20} 30x20+47+35 {47 5 30 20}} +test textWind-16.3 {EmbWinTextStructureProc procedure} -setup { .t delete 1.0 end +} -body { + .t configure -wrap none .t insert 1.0 "Some sample text" .t window create 1.6 update pack forget .t update -} {} -pack .t -test textWind-16.4 {EmbWinTextStructureProc procedure} { - .t configure -wrap none +} -cleanup { + pack .t +} -result {} +test textWind-16.4 {EmbWinTextStructureProc procedure} -setup { .t delete 1.0 end +} -body { + .t configure -spacing1 0 -spacing2 0 -spacing3 0 \ + -wrap none .t insert 1.0 "Some sample text" frame .t.f -width 30 -height 20 -bg $color .t window create 1.6 -window .t.f @@ -864,13 +1288,15 @@ test textWind-16.4 {EmbWinTextStructureProc procedure} { pack forget .t update list [winfo ismapped .t.f] [.t bbox .t.f] -} {1 {47 5 30 20}} -pack .t +} -cleanup { + pack .t +} -result {1 {47 5 30 20}} -test textWind-17.1 {peer widgets and embedded windows} { - catch {destroy .t .tt} + +test textWind-17.1 {peer widgets and embedded windows} -setup { + destroy .t .tt .f +} -body { pack [text .t] - .t delete 1.0 end .t insert end "Line 1" frame .f -width 20 -height 10 -bg blue .t window create 1.3 -window .f @@ -879,12 +1305,12 @@ test textWind-17.1 {peer widgets and embedded windows} { update ; update destroy .t .tt winfo exists .f -} {0} +} -result {0} -test textWind-17.2 {peer widgets and embedded windows} { - catch {destroy .t .f} +test textWind-17.2 {peer widgets and embedded windows} -setup { + destroy .t .f .tt +} -body { pack [text .t] - .t delete 1.0 end .t insert end "Line 1\nLine 2" frame .f -width 20 -height 10 -bg blue .t window create 1.4 -window .f @@ -895,10 +1321,11 @@ test textWind-17.2 {peer widgets and embedded windows} { .tt.t insert 1.0 "foo" update destroy .tt -} {} +} -result {} -test textWind-17.3 {peer widget and -create} { - catch {destroy .t} +test textWind-17.3 {peer widget and -create} -setup { + destroy .t .tt +} -body { pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" @@ -908,10 +1335,12 @@ test textWind-17.3 {peer widget and -create} { .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} update destroy .t .tt -} {} +} -result {} -test textWind-17.4 {peer widget deleted one window shouldn't delete others} { - catch {destroy .t .tt} +test textWind-17.4 {peer widget deleted one window shouldn't delete others} -setup { + destroy .t .tt + set res {} +} -body { pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" @@ -920,14 +1349,16 @@ test textWind-17.4 {peer widget deleted one window shouldn't delete others} { .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} update ; update destroy .tt - set res {} lappend res [.t get 1.2] update lappend res [.t get 1.2] -} {{} {}} +} -cleanup { + destroy .t +} -result {{} {}} -test textWind-17.5 {peer widget window configuration} { - catch {destroy .t .tt} +test textWind-17.5 {peer widget window configuration} -setup { + destroy .t .tt +} -body { pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" @@ -935,13 +1366,14 @@ test textWind-17.5 {peer widget window configuration} { pack [.t peer create .tt.t] .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} update ; update - set res [list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window]] + list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window] +} -cleanup { destroy .tt .t - set res -} {.t.f .tt.t.f} +} -result {.t.f .tt.t.f} -test textWind-17.6 {peer widget window configuration} { - catch {destroy .t .tt} +test textWind-17.6 {peer widget window configuration} -setup { + destroy .t .tt +} -body { pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" @@ -949,14 +1381,15 @@ test textWind-17.6 {peer widget window configuration} { pack [.t peer create .tt.t] .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} update ; update - set res [list [.t window configure 1.2 -window] \ - [.tt.t window configure 1.2 -window]] + list [.t window configure 1.2 -window] \ + [.tt.t window configure 1.2 -window] +} -cleanup { destroy .tt .t - set res -} {{-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} +} -result {{-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} -test textWind-17.7 {peer widget window configuration} { - catch {destroy .t .tt} +test textWind-17.7 {peer widget window configuration} -setup { + destroy .t .tt +} -body { pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" @@ -964,13 +1397,14 @@ test textWind-17.7 {peer widget window configuration} { pack [.t peer create .tt.t] .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] update ; update - set res [list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window]] + list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window] +} -cleanup { destroy .tt .t - set res -} {.t.f {}} +} -result {.t.f {}} -test textWind-17.8 {peer widget window configuration} { - catch {destroy .t .tt} +test textWind-17.8 {peer widget window configuration} -setup { + destroy .t .tt +} -body { pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" @@ -978,14 +1412,15 @@ test textWind-17.8 {peer widget window configuration} { pack [.t peer create .tt.t] .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] update ; update - set res [list [.t window configure 1.2 -window] \ - [.tt.t window configure 1.2 -window]] + list [.t window configure 1.2 -window] \ + [.tt.t window configure 1.2 -window] +} -cleanup { destroy .tt .t - set res -} {{-window {} {} {} .t.f} {-window {} {} {} {}}} +} -result {{-window {} {} {} .t.f} {-window {} {} {} {}}} -test textWind-17.8a {peer widget window configuration} { - catch {destroy .t .tt} +test textWind-17.9 {peer widget window configuration} -setup { + destroy .t .tt +} -body { pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" @@ -994,14 +1429,14 @@ test textWind-17.8a {peer widget window configuration} { .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] update ; update .tt.t window configure 1.2 -window [frame .tt.t.f -width 10 -height 20 -bg red] - set res [list [.t window configure 1.2 -window] \ - [.tt.t window configure 1.2 -window]] + list [.t window configure 1.2 -window] [.tt.t window configure 1.2 -window] +} -cleanup { destroy .tt .t - set res -} {{-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} +} -result {{-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} -test textWind-17.9 {peer widget window configuration} { - catch {destroy .t .tt} +test textWind-17.10 {peer widget window configuration} -setup { + destroy .t .tt +} -body { pack [text .t] .t delete 1.0 end .t insert 1.0 "Some sample text" @@ -1015,16 +1450,17 @@ test textWind-17.9 {peer widget window configuration} { .tt.t window configure 1.2 -window {} .t window configure 1.2 -window {} set res [list [.t window configure 1.2 -window] \ - [.tt.t window configure 1.2 -window]] + [.tt.t window configure 1.2 -window]] update lappend res [.t window configure 1.2 -window] \ - [.tt.t window configure 1.2 -window] + [.tt.t window configure 1.2 -window] +} -cleanup { destroy .tt .t - set res -} {{-window {} {} {} {}} {-window {} {} {} {}} {-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} +} -result {{-window {} {} {} {}} {-window {} {} {} {}} {-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}} -test textWind-18.1 {embedded window deletion triggered by a script bound to <Map>} { - catch {destroy .t .f} +test textWind-18.1 {embedded window deletion triggered by a script bound to <Map>} -setup { + catch {destroy .t .f .f2} +} -body { pack [text .t] for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} .t window create end -window [frame .f -background red -width 80 -height 80] @@ -1035,9 +1471,10 @@ test textWind-18.1 {embedded window deletion triggered by a script bound to <Map after 100 {.t yview end} tkwait visibility .f2 update -} {} +} -cleanup { + destroy .t .f .f2 +} -result {} -catch {destroy .t} option clear # cleanup diff --git a/tests/tk.test b/tests/tk.test index 02b4257..748a6cf 100644 --- a/tests/tk.test +++ b/tests/tk.test @@ -5,135 +5,147 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2002 ActiveState Corporation. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test -test tk-1.1 {tk command: general} \ - -body {tk} -returnCodes 1 \ - -result {wrong # args: should be "tk option ?arg?"} -test tk-1.2 {tk command: general} \ - -body {tk xyz} -returnCodes 1 \ - -result {bad option "xyz": must be appname, caret, scaling, useinputmethods, windowingsystem, or inactive} +test tk-1.1 {tk command: general} -body { + tk +} -returnCodes error -result {wrong # args: should be "tk subcommand ?arg ...?"} +test tk-1.2 {tk command: general} -body { + tk xyz +} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, scaling, useinputmethods, or windowingsystem} +# Value stored to restore default settings after 2.* tests set appname [tk appname] -test tk-2.1 {tk command: appname} { - list [catch {tk appname xyz abc} msg] $msg -} {1 {wrong # args: should be "tk appname ?newName?"}} -test tk-2.2 {tk command: appname} { +test tk-2.1 {tk command: appname} -body { + tk appname xyz abc +} -returnCodes error -result {wrong # args: should be "tk appname ?newName?"} +test tk-2.2 {tk command: appname} -body { tk appname foobazgarply -} {foobazgarply} -test tk-2.3 {tk command: appname} unix { +} -result {foobazgarply} +test tk-2.3 {tk command: appname} -constraints unix -body { tk appname bazfoogarply expr {[lsearch -exact [winfo interps] [tk appname]] >= 0} -} {1} -test tk-2.4 {tk command: appname} { - tk appname $appname -} $appname +} -result {1} +test tk-2.4 {tk command: appname} -body { + tk appname [tk appname] +} -result [tk appname] tk appname $appname +# Value stored to restore default settings after 3.* tests set scaling [tk scaling] -test tk-3.1 {tk command: scaling} { - list [catch {tk scaling -displayof} msg] $msg -} {1 {value for "-displayof" missing}} -test tk-3.2 {tk command: scaling: get current} { +test tk-3.1 {tk command: scaling} -body { + tk scaling -displayof +} -returnCodes error -result {value for "-displayof" missing} +test tk-3.2 {tk command: scaling: get current} -body { tk scaling 1 format %.2g [tk scaling] -} 1 -test tk-3.3 {tk command: scaling: get current} { +} -result 1 +test tk-3.3 {tk command: scaling: get current} -body { tk scaling -displayof . 1.25 format %.3g [tk scaling] -} 1.25 -test tk-3.4 {tk command: scaling: set new} { - list [catch {tk scaling xyz} msg] $msg -} {1 {expected floating-point number but got "xyz"}} -test tk-3.5 {tk command: scaling: set new} { - list [catch {tk scaling -displayof . xyz} msg] $msg -} {1 {expected floating-point number but got "xyz"}} -test tk-3.6 {tk command: scaling: set new} { +} -result 1.25 +test tk-3.4 {tk command: scaling: set new} -body { + tk scaling xyz +} -returnCodes error -result {expected floating-point number but got "xyz"} +test tk-3.5 {tk command: scaling: set new} -body { + tk scaling -displayof . xyz +} -returnCodes error -result {expected floating-point number but got "xyz"} +test tk-3.6 {tk command: scaling: set new} -body { tk scaling 1 format %.2g [tk scaling] -} 1 -test tk-3.7 {tk command: scaling: set new} { +} -result 1 +test tk-3.7 {tk command: scaling: set new} -body { tk scaling -displayof . 1.25 format %.3g [tk scaling] -} 1.25 -test tk-3.8 {tk command: scaling: negative} { +} -result 1.25 +test tk-3.8 {tk command: scaling: negative} -body { tk scaling -1 expr {[tk scaling] > 0} -} {1} -test tk-3.9 {tk command: scaling: too big} { +} -result {1} +test tk-3.9 {tk command: scaling: too big} -body { tk scaling 1000000 expr {[tk scaling] < 10000} -} {1} -test tk-3.10 {tk command: scaling: widthmm} { +} -result {1} +test tk-3.10 {tk command: scaling: widthmm} -body { tk scaling 1.25 - expr {int((25.4*[winfo screenwidth .])/(72*1.25)+0.5)-[winfo screenmmwidth .]} -} {0} -test tk-3.11 {tk command: scaling: heightmm} { + expr {int((25.4*[winfo screenwidth .])/(72*1.25) + 0.5) \ + - [winfo screenmmwidth .]} +} -result {0} +test tk-3.11 {tk command: scaling: heightmm} -body { tk scaling 1.25 - expr {int((25.4*[winfo screenheight .])/(72*1.25)+0.5)-[winfo screenmmheight .]} -} {0} + expr {int((25.4*[winfo screenheight .])/(72*1.25) + 0.5) \ + - [winfo screenmmheight .]} +} -result {0} tk scaling $scaling +# Value stored to restore default settings after 4.* tests set useim [tk useinputmethods] -test tk-4.1 {tk command: useinputmethods} { - list [catch {tk useinputmethods -displayof} msg] $msg -} {1 {value for "-displayof" missing}} -test tk-4.2 {tk command: useinputmethods: get current} { +test tk-4.1 {tk command: useinputmethods} -body { + tk useinputmethods -displayof +} -returnCodes error -result {value for "-displayof" missing} +test tk-4.2 {tk command: useinputmethods: get current} -body { + tk useinputmethods no +} -cleanup { + tk useinputmethods $useim +} -result 0 +test tk-4.3 {tk command: useinputmethods: get current} -body { tk useinputmethods no -} 0 -test tk-4.3 {tk command: useinputmethods: get current} { tk useinputmethods -displayof . -} 0 -test tk-4.4 {tk command: useinputmethods: set new} { - list [catch {tk useinputmethods xyz} msg] $msg -} {1 {expected boolean value but got "xyz"}} -test tk-4.5 {tk command: useinputmethods: set new} { - list [catch {tk useinputmethods -displayof . xyz} msg] $msg -} {1 {expected boolean value but got "xyz"}} -test tk-4.6 {tk command: useinputmethods: set new} unix { - # This isn't really a test, but more of a check... - # The answer is what was given, because we may be on a Unix - # system that doesn't have the XIM stuff +} -cleanup { + tk useinputmethods $useim +} -result 0 +test tk-4.4 {tk command: useinputmethods: set new} -body { + tk useinputmethods xyz +} -returnCodes error -result {expected boolean value but got "xyz"} +test tk-4.5 {tk command: useinputmethods: set new} -body { + tk useinputmethods -displayof . xyz +} -returnCodes error -result {expected boolean value but got "xyz"} +test tk-4.6 {tk command: useinputmethods: set new} -body { + # This isn't really a test, but more of a check... The answer is what was + # given, because we may be on a Unix system that doesn't have the XIM + # stuff if {[tk useinputmethods 1] == 0} { puts "this wish doesn't have XIM (X Input Methods) support" } - set useim -} $useim -test tk-4.7 {tk command: useinputmethods: set new} win { - # Mac and Windows don't have X Input Methods, so this should - # always return 0 + return $useim +} -result $useim +test tk-4.7 {tk command: useinputmethods: set new} -constraints win -body { + # Mac and Windows don't have X Input Methods, so this should always return + # 0 tk useinputmethods 1 -} 0 -tk useinputmethods $useim +} -cleanup { + tk useinputmethods $useim +} -result 0 -test tk-5.1 {tk caret} { - list [catch {tk caret} msg] $msg -} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}} -test tk-5.2 {tk caret} { - list [catch {tk caret bogus} msg] $msg -} {1 {bad window path name "bogus"}} -test tk-5.3 {tk caret} { - list [catch {tk caret . -foo} msg] $msg -} {1 {bad caret option "-foo": must be -x, -y, or -height}} -test tk-5.4 {tk caret} { - list [catch {tk caret . -x 0 -y} msg] $msg -} {1 {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}} -test tk-5.5 {tk caret} { - list [catch {tk caret . -x 10 -y 11 -h 12; tk caret .} msg] $msg -} {0 {-height 12 -x 10 -y 11}} -test tk-5.6 {tk caret} { - list [catch {tk caret . -x 20 -y 25 -h 30; tk caret . -hei} msg] $msg -} {0 30} +test tk-5.1 {tk caret} -body { + tk caret +} -returnCodes error -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"} +test tk-5.2 {tk caret} -body { + tk caret bogus +} -returnCodes error -result {bad window path name "bogus"} +test tk-5.3 {tk caret} -body { + tk caret . -foo +} -returnCodes error -result {bad caret option "-foo": must be -x, -y, or -height} +test tk-5.4 {tk caret} -body { + tk caret . -x 0 -y +} -returnCodes error -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"} +test tk-5.5 {tk caret} -body { + tk caret . -x 10 -y 11 -h 12; tk caret . +} -result {-height 12 -x 10 -y 11} +test tk-5.6 {tk caret} -body { + tk caret . -x 20 -y 25 -h 30; tk caret . -hei +} -result {30} # tk inactive test tk-6.1 {tk inactive} -body { string is integer [tk inactive] } -result 1 test tk-6.2 {tk inactive reset} -body { - catch {tk inactive reset} -} -result 0 + tk inactive reset +} -returnCodes ok -match glob -result * test tk-6.3 {tk inactive wrong argument} -body { tk inactive foo } -returnCodes 1 -result {bad option "foo": must be reset} @@ -148,16 +160,24 @@ test tk-6.5 {tk inactive} -body { expr {$i == -1 || ( $i > 90 && $i < 200 )} } -result 1 -# tk inactive in safe interpreters -safe::interpCreate foo -safe::loadTk foo test tk-7.1 {tk inactive in a safe interpreter} -body { +# tk inactive in safe interpreters + safe::interpCreate foo + safe::loadTk foo foo eval {tk inactive} +} -cleanup { + ::safe::interpDelete foo } -result -1 test tk-7.2 {tk inactive reset in a safe interpreter} -body { +# tk inactive in safe interpreters + safe::interpCreate foo + safe::loadTk foo foo eval {tk inactive reset} +} -cleanup { + ::safe::interpDelete foo } -returnCodes 1 -result {resetting the user inactivity timer is not allowed in a safe interpreter} -::safe::interpDelete foo + +# tests of [tk busy] in busy.test # cleanup cleanupTests diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test index d8bc65d..aa7e64a 100644 --- a/tests/ttk/treeview.test +++ b/tests/ttk/treeview.test @@ -405,7 +405,7 @@ test treeview-7.1 "move" -body { test treeview-7.2 "illegal move" -body { .tv move d d2 end -} -returnCodes 1 -result "Cannot insert d as a descendant of d2" +} -returnCodes 1 -result "Cannot insert d as descendant of d2" test treeview-7.3 "illegal move has no effect" -body { consistencyCheck .tv @@ -426,7 +426,7 @@ test treeview-7.5 "replace children - precondition" -body { test treeview-7.6 "Replace children - illegal move" -body { .tv children newnode.n1 [list newnode.n1 newnode.n2 newnode.n3] -} -returnCodes 1 -result "Cannot insert newnode.n1 as a descendant of newnode.n1" +} -returnCodes 1 -result "Cannot insert newnode.n1 as descendant of newnode.n1" consistencyCheck .tv diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test index def709e..e58b021 100644 --- a/tests/ttk/ttk.test +++ b/tests/ttk/ttk.test @@ -48,7 +48,7 @@ test ttk-6.4 "Destroy widget in configure" -setup { pack [ttk::checkbutton .b] set rc [catch { .b configure -variable OUCH } msg] list $rc $msg [winfo exists .b] [info commands .b] -} -result [list 1 "Widget has been destroyed" 0 {}] +} -result [list 1 "widget has been destroyed" 0 {}] test ttk-6.5 "Clean up -textvariable traces" -body { foreach class {ttk::button ttk::checkbutton ttk::radiobutton} { @@ -121,7 +121,7 @@ test ttk-construction-failure-2 "Destroy widget in constructor" -setup { [winfo exists .b] \ [info commands .b] \ ; -} -result [list 1 "Widget has been destroyed" 0 {}] +} -result [list 1 "widget has been destroyed" 0 {}] test ttk-selfdestruct-ok-1 "Intentional self-destruction" -body { # see #2298720 @@ -222,15 +222,11 @@ test ttk-2.8 "bug 3223850: button state disabled during click" -setup { foreach wc $widgetClasses { test ttk-coreoptions-$wc "$wc has all core options" -body { ttk::$wc .w - foreach option { - -class - -style - -cursor - -takefocus - } { + foreach option {-class -style -cursor -takefocus} { .w cget $option } - destroy .w + } -cleanup { + catch {destroy .w} } } diff --git a/tests/unixButton.test b/tests/unixButton.test index a51e259..137ef33 100644 --- a/tests/unixButton.test +++ b/tests/unixButton.test @@ -8,9 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test +imageInit # Create entries in the option database to be sure that geometry options # like border width have predictable values. @@ -32,19 +34,14 @@ option add *Radiobutton.font {Helvetica -12 bold} proc bogusTrace args { error "trace aborted" } -catch {unset value} -catch {unset value2} -eval image delete [image names] -label .l -text Label -button .b -text Button -checkbutton .c -text Checkbutton -radiobutton .r -text Radiobutton -pack .l .b .c .r -update -test unixbutton-1.1 {TkpComputeButtonGeometry procedure} {unix testImageType} { +test unixbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints { + unix testImageType +} -setup { deleteWindows + imageCleanup +} -body { image create test image1 image1 changed 0 0 0 0 60 40 label .b1 -image image1 -bd 4 -padx 0 -pady 2 @@ -54,12 +51,18 @@ test unixbutton-1.1 {TkpComputeButtonGeometry procedure} {unix testImageType} { pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {68 48 74 54 112 52 112 52} -test unixbutton-1.2 {TkpComputeButtonGeometry procedure} unix { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { deleteWindows + image delete image1 +} -result {68 48 74 54 112 52 112 52} +test unixbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints { + unix +} -setup { + deleteWindows +} -body { label .b1 -bitmap question -bd 3 -padx 0 -pady 2 button .b2 -bitmap question -bd 3 -padx 0 -pady 2 checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1 @@ -67,27 +70,37 @@ test unixbutton-1.2 {TkpComputeButtonGeometry procedure} unix { pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {23 33 29 39 54 37 54 37} -test unixbutton-1.3 {TkpComputeButtonGeometry procedure} unix { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { + deleteWindows +} -result {23 33 29 39 54 37 54 37} +test unixbutton-1.3 {TkpComputeButtonGeometry procedure} -constraints { + unix +} -setup { deleteWindows +} -body { label .b1 -bitmap question -bd 3 -highlightthickness 4 button .b2 -bitmap question -bd 3 -highlightthickness 0 checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \ - -indicatoron 0 + -indicatoron 0 radiobutton .b4 -bitmap question -bd 3 -highlightthickness 1 \ - -indicatoron false + -indicatoron false pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {31 41 25 35 25 35 25 35} -test unixbutton-1.4 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { deleteWindows +} -result {31 41 25 35 25 35 25 35} +test unixbutton-1.4 {TkpComputeButtonGeometry procedure} -constraints { + unix nonPortable fonts +} -setup { + deleteWindows +} -body { label .b1 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold} button .b2 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold} checkbutton .b3 -text Xagqpim -padx 1 -pady 1 -font {Helvetica -18 bold} @@ -95,26 +108,41 @@ test unixbutton-1.4 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {82 29 88 35 114 31 121 29} -test unixbutton-1.5 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { + deleteWindows +} -result {82 29 88 35 114 31 121 29} +test unixbutton-1.5 {TkpComputeButtonGeometry procedure} -constraints { + unix nonPortable fonts +} -setup { deleteWindows +} -body { label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0 pack .l1 update list [winfo reqwidth .l1] [winfo reqheight .l1] -} {136 88} -test unixbutton-1.6 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} { +} -cleanup { deleteWindows +} -result {136 88} +test unixbutton-1.6 {TkpComputeButtonGeometry procedure} -constraints { + unix nonPortable fonts +} -setup { + deleteWindows +} -body { label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0 pack .l1 update list [winfo reqwidth .l1] [winfo reqheight .l1] -} {231 46} -test unixbutton-1.7 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} { +} -cleanup { + deleteWindows +} -result {231 46} +test unixbutton-1.7 {TkpComputeButtonGeometry procedure} -constraints { + unix nonPortable fonts +} -setup { deleteWindows +} -body { label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5 checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2 @@ -122,73 +150,106 @@ test unixbutton-1.7 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {74 22 60 84 168 38 61 22} -test unixbutton-1.8 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { deleteWindows +} -result {74 22 60 84 168 38 61 22} +test unixbutton-1.8 {TkpComputeButtonGeometry procedure} -constraints { + unix nonPortable fonts +} -setup { + deleteWindows +} -body { label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \ - -highlightthickness 4 + -highlightthickness 4 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \ - -highlightthickness 0 + -highlightthickness 0 checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 \ - -highlightthickness 1 -indicatoron no + -highlightthickness 1 -indicatoron no radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {62 30 56 24 58 22 62 22} -test unixbutton-1.9 {TkpComputeButtonGeometry procedure} unix { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { + deleteWindows +} -result {62 30 56 24 58 22 62 22} +test unixbutton-1.9 {TkpComputeButtonGeometry procedure} -constraints { + unix +} -setup { deleteWindows +} -body { button .b2 -bitmap question -default active list [winfo reqwidth .b2] [winfo reqheight .b2] -} {37 47} -test unixbutton-1.10 {TkpComputeButtonGeometry procedure} unix { +} -cleanup { deleteWindows +} -result {37 47} +test unixbutton-1.10 {TkpComputeButtonGeometry procedure} -constraints { + unix +} -setup { + deleteWindows +} -body { button .b2 -bitmap question -default normal list [winfo reqwidth .b2] [winfo reqheight .b2] -} {37 47} -test unixbutton-1.11 {TkpComputeButtonGeometry procedure} unix { +} -cleanup { + deleteWindows +} -result {37 47} +test unixbutton-1.11 {TkpComputeButtonGeometry procedure} -constraints { + unix +} -setup { deleteWindows +} -body { button .b2 -bitmap question -default disabled list [winfo reqwidth .b2] [winfo reqheight .b2] -} {27 37} +} -cleanup { + deleteWindows +} -result {27 37} -test unixbutton-2.1 {disabled coloring check, bug 669595} unix { - # this was just a visual bug, but at least this shows the visual + +test unixbutton-2.1 {disabled coloring check, bug 669595} -constraints { + unix +} -setup { deleteWindows + catch {unset value} +} -body { + # this was just a visual bug, but at least this shows the visual set on 1 set off 0 label .l -text "The following widgets should\ - \nshow significant visible diffs\ - \nfor selected vs unselected." + \nshow significant visible diffs\ + \nfor selected vs unselected." checkbutton .cb0 -anchor w -state disabled \ - -text Unselected -variable off + -text Unselected -variable off checkbutton .cb1 -anchor w -state disabled \ - -text Selected -variable on + -text Selected -variable on checkbutton .cb2 -anchor w -state disabled \ - -text Unselected -variable off -disabledforeground "" + -text Unselected -variable off -disabledforeground "" checkbutton .cb3 -anchor w -state disabled \ - -text Selected -variable on -disabledforeground "" + -text Selected -variable on -disabledforeground "" radiobutton .rb0 -anchor w -state disabled \ - -text Unselected -variable off + -text Unselected -variable off radiobutton .rb1 -anchor w -state disabled \ - -text Selected -variable on -value 1 + -text Selected -variable on -value 1 radiobutton .rb2 -anchor w -state disabled \ - -text Unselected -variable off -disabledforeground "" + -text Unselected -variable off -disabledforeground "" radiobutton .rb3 -anchor w -state disabled \ - -text Selected -variable on -value 1 -disabledforeground "" + -text Selected -variable on -value 1 -disabledforeground "" pack .l .cb0 .cb1 .cb2 .cb3 .rb0 .rb1 .rb2 .rb3 -side top -fill x after 400 set on -} 1 +} -cleanup { + deleteWindows +} -result 1 -deleteWindows # cleanup +imageFinish cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test index 1e8f03b..8aaa3c4 100644 --- a/tests/unixEmbed.test +++ b/tests/unixEmbed.test @@ -6,9 +6,10 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test setupbg dobg {wm withdraw .} @@ -53,41 +54,53 @@ proc colorsFree {w {red 31} {green 245} {blue 192}} { && ([lindex $vals 2]/256 == $blue) } -test unixEmbed-1.1 {TkpUseWindow procedure, bad window identifier} unix { - catch {destroy .t} - list [catch {toplevel .t -use xyz} msg] $msg -} {1 {expected integer but got "xyz"}} -test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} unix { - catch {destroy .t} - list [catch {toplevel .t -use 47} msg] $msg -} {1 {couldn't create child of window "47"}} -test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {unix nonPortable} { - catch {destroy .t} - catch {destroy .x} +test unixEmbed-1.1 {TkpUseWindow procedure, bad window identifier} -constraints { + unix +} -setup { + deleteWindows +} -body { + toplevel .t -use xyz +} -returnCodes error -result {expected integer but got "xyz"} +test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} -constraints { + unix +} -setup { + deleteWindows +} -body { + toplevel .t -use 47 +} -returnCodes error -result {couldn't create child of window "47"} +test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} -constraints { + unix nonPortable +} -setup { + deleteWindows +} -body { toplevel .t -colormap new wm geometry .t +0+0 eatColors .t.t frame .t.f -container 1 toplevel .x -use [winfo id .t.f] - set result [colorsFree .x] - destroy .t - set result -} {0} -test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {unix nonPortable} { - catch {destroy .t} - catch {destroy .t2} - catch {destroy .x} + colorsFree .x +} -cleanup { + deleteWindows +} -result {0} +test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} -constraints { + unix nonPortable +} -setup { + deleteWindows +} -body { toplevel .t -container 1 -colormap new wm geometry .t +0+0 eatColors .t2 toplevel .x -use [winfo id .t] - set result [colorsFree .x] - destroy .t - set result -} {1} + colorsFree .x +} -cleanup { + deleteWindows +} -result {1} -test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} {unix testembed} { - deleteWindows +test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 frame .f2 -container 1 -width 200 -height 50 pack .f1 .f2 @@ -97,74 +110,103 @@ test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} {unix te toplevel .t -use $w list [testembed] [expr [lindex [lindex [testembed all] 0] 0] - $w] } -} {{{XXX {} {} .t}} 0} -test unixEmbed-1.6 {TkpUseWindow procedure, creating Container records} {unix testembed} { - deleteWindows +} -cleanup { + deleteWindows +} -result {{{XXX {} {} .t}} 0} +test unixEmbed-1.6 {TkpUseWindow procedure, creating Container records} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 frame .f2 -container 1 -width 200 -height 50 pack .f1 .f2 dobg "set w1 [winfo id .f1]" dobg "set w2 [winfo id .f2]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - toplevel .t2 -use $w2 - testembed - } -} {{XXX {} {} .t2} {XXX {} {} .t1}} -test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app} {unix testembed} { - deleteWindows + eval destroy [winfo child .] + toplevel .t1 -use $w1 + toplevel .t2 -use $w2 + testembed + } +} -cleanup { + deleteWindows +} -result {{XXX {} {} .t2} {XXX {} {} .t1}} +test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 frame .f2 -container 1 -width 200 -height 50 pack .f1 .f2 toplevel .t1 -use [winfo id .f1] toplevel .t2 -use [winfo id .f2] testembed -} {{XXX .f2 {} .t2} {XXX .f1 {} .t1}} +} -cleanup { + deleteWindows +} -result {{XXX .f2 {} .t2} {XXX .f1 {} .t1}} # Can't think of any way to test the procedures TkpMakeWindow, # TkpMakeContainer, or EmbedErrorProc. -test unixEmbed-2.1 {EmbeddedEventProc procedure} {unix testembed} { - deleteWindows + +test unixEmbed-2.1 {EmbeddedEventProc procedure} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - testembed + eval destroy [winfo child .] + toplevel .t1 -use $w1 + testembed } destroy .f1 update dobg { - testembed + testembed } -} {} -test unixEmbed-2.2 {EmbeddedEventProc procedure} {unix testembed} { - deleteWindows +} -cleanup { + deleteWindows +} -result {} +test unixEmbed-2.2 {EmbeddedEventProc procedure} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - testembed - destroy .t1 - testembed - } -} {} -test unixEmbed-2.3 {EmbeddedEventProc procedure} {unix testembed} { - deleteWindows + eval destroy [winfo child .] + toplevel .t1 -use $w1 + testembed + destroy .t1 + testembed + } +} -cleanup { + deleteWindows +} -result {} +test unixEmbed-2.3 {EmbeddedEventProc procedure} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 toplevel .t1 -use [winfo id .f1] update destroy .f1 testembed -} {} -test unixEmbed-2.4 {EmbeddedEventProc procedure} {unix testembed} { - deleteWindows +} -result {} +test unixEmbed-2.4 {EmbeddedEventProc procedure} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 toplevel .t1 -use [winfo id .f1] @@ -173,166 +215,221 @@ test unixEmbed-2.4 {EmbeddedEventProc procedure} {unix testembed} { set x [testembed] update list $x [testembed] -} {{{XXX .f1 {} {}}} {}} +} -cleanup { + deleteWindows +} -result {{{XXX .f1 {} {}}} {}} -test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} \ - {unix testembed nonPortable} { - deleteWindows + +test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} -constraints { + unix testembed nonPortable +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" set x [testembed] dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - wm withdraw .t1 + eval destroy [winfo child .] + toplevel .t1 -use $w1 + wm withdraw .t1 } list $x [testembed] -} {{{XXX .f1 {} {}}} {{XXX .f1 XXX {}}}} -test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {{{XXX .f1 {} {}}} {{XXX .f1 XXX {}}}} +test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} -constraints { + unix +} -setup { + deleteWindows +} -body { toplevel .t1 -container 1 wm geometry .t1 +0+0 toplevel .t2 -use [winfo id .t1] -bg red update wm geometry .t2 -} {200x200+0+0} -test unixEmbed-3.2a {ContainerEventProc procedure, disallow position changes} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {200x200+0+0} +test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 -bd 2 -relief raised - update - wm geometry .t1 +30+40 + eval destroy [winfo child .] + toplevel .t1 -use $w1 -bd 2 -relief raised + update + wm geometry .t1 +30+40 } update dobg { - wm geometry .t1 + wm geometry .t1 } -} {200x200+0+0} -test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {200x200+0+0} +test unixEmbed-3.4 {ContainerEventProc procedure, disallow position changes} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - update - wm geometry .t1 300x100+30+40 + eval destroy [winfo child .] + toplevel .t1 -use $w1 + update + wm geometry .t1 300x100+30+40 } update dobg { - wm geometry .t1 + wm geometry .t1 } -} {300x100+0+0} -test unixEmbed-3.4 {ContainerEventProc procedure, geometry requests} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {300x100+0+0} +test unixEmbed-3.5 {ContainerEventProc procedure, geometry requests} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 + eval destroy [winfo child .] + toplevel .t1 -use $w1 } update dobg { - .t1 configure -width 300 -height 80 + .t1 configure -width 300 -height 80 } update list [winfo width .f1] [winfo height .f1] [dobg {wm geometry .t1}] -} {300 80 300x80+0+0} -test unixEmbed-3.5 {ContainerEventProc procedure, map requests} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {300 80 300x80+0+0} +test unixEmbed-3.6 {ContainerEventProc procedure, map requests} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - set x unmapped - bind .t1 <Map> {set x mapped} + eval destroy [winfo child .] + toplevel .t1 -use $w1 + set x unmapped + bind .t1 <Map> {set x mapped} } update dobg { - after 100 - update - set x + after 100 + update + set x } -} {mapped} -test unixEmbed-3.6 {ContainerEventProc procedure, destroy events} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {mapped} +test unixEmbed-3.7 {ContainerEventProc procedure, destroy events} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" bind .f1 <Destroy> {set x dead} set x alive dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 + eval destroy [winfo child .] + toplevel .t1 -use $w1 } update dobg { - destroy .t1 + destroy .t1 } update list $x [winfo exists .f1] -} {dead 0} +} -cleanup { + deleteWindows +} -result {dead 0} -test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} unix { - deleteWindows + +test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 + eval destroy [winfo child .] + toplevel .t1 -use $w1 } update dobg { - .t1 configure -width 180 -height 100 + .t1 configure -width 180 -height 100 } update dobg { - winfo geometry .t1 + winfo geometry .t1 } -} {180x100+0+0} -test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} {unix testembed} { - deleteWindows +} -cleanup { + deleteWindows +} -result {180x100+0+0} +test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 + eval destroy [winfo child .] + toplevel .t1 -use $w1 } update set x [testembed] destroy .f1 list $x [testembed] -} {{{XXX .f1 XXX {}}} {}} +} -cleanup { + deleteWindows +} -result {{{XXX .f1 XXX {}}} {}} -test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} unix { - deleteWindows + +test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - bind .t1 <FocusIn> {lappend x "focus in %W"} - bind .t1 <FocusOut> {lappend x "focus out %W"} - set x {} + eval destroy [winfo child .] + toplevel .t1 -use $w1 + bind .t1 <FocusIn> {lappend x "focus in %W"} + bind .t1 <FocusOut> {lappend x "focus out %W"} + set x {} } focus -force .f1 update dobg {set x} -} {{focus in .t1}} -test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {{focus in .t1}} +test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" @@ -342,23 +439,28 @@ test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} unix { } update dobg { - after 200 {destroy .t1} + after 200 {destroy .t1} } after 400 focus -force .f1 update -} {} -test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {} +test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 - bind .t1 <FocusIn> {lappend x "focus in %W"} - bind .t1 <FocusOut> {lappend x "focus out %W"} - set x {} + eval destroy [winfo child .] + toplevel .t1 -use $w1 + bind .t1 <FocusIn> {lappend x "focus in %W"} + bind .t1 <FocusOut> {lappend x "focus out %W"} + set x {} } focus -force .f1 update @@ -366,79 +468,102 @@ test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} unix { focus . update list $x [dobg {update; set x}] -} {{{focus in .t1}} {{focus in .t1} {focus out .t1}}} +} -cleanup { + deleteWindows +} -result {{{focus in .t1}} {{focus in .t1} {focus out .t1}}} -test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} unix { - deleteWindows + +test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 + eval destroy [winfo child .] + toplevel .t1 -use $w1 } update dobg { - bind .t1 <Configure> {lappend x {configure .t1 %w %h}} - set x {} - .t1 configure -width 300 -height 120 - update - list $x [winfo geom .t1] + bind .t1 <Configure> {lappend x {configure .t1 %w %h}} + set x {} + .t1 configure -width 300 -height 120 + update + list $x [winfo geom .t1] } -} {{{configure .t1 300 120}} 300x120+0+0} -test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {{{configure .t1 300 120}} 300x120+0+0} +test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 place .f1 -width 200 -height 200 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 + eval destroy [winfo child .] + toplevel .t1 -use $w1 } after 300 {set x done} vwait x dobg { - bind .t1 <Configure> {lappend x {configure .t1 %w %h}} - set x {} - .t1 configure -width 300 -height 120 - update - list $x [winfo geom .t1] + bind .t1 <Configure> {lappend x {configure .t1 %w %h}} + set x {} + .t1 configure -width 300 -height 120 + update + list $x [winfo geom .t1] } -} {{{configure .t1 200 200}} 200x200+0+0} +} -cleanup { + deleteWindows +} -result {{{configure .t1 200 200}} 200x200+0+0} # Can't think up any tests for TkpGetOtherWindow procedure. -test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} unix { + +test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} -constraints { + unix +} -setup { + deleteWindows +} -body { deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 + eval destroy [winfo child .] + toplevel .t1 -use $w1 } focus -force . bind . <KeyPress> {lappend x {key %A %E}} set x {} set y [dobg { - update - bind .t1 <KeyPress> {lappend y {key %A}} - set y {} - event generate .t1 <KeyPress> -keysym a - set y + update + bind .t1 <KeyPress> {lappend y {key %A}} + set y {} + event generate .t1 <KeyPress> -keysym a + set y }] update - bind . <KeyPress> {} list $x $y -} {{{key a 1}} {}} -test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width} unix { - deleteWindows +} -cleanup { + deleteWindows + bind . <KeyPress> {} +} -result {{{key a 1}} {}} +test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 + eval destroy [winfo child .] + toplevel .t1 -use $w1 } update focus -force .f1 @@ -446,41 +571,49 @@ test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width bind . <KeyPress> {lappend x {key %A}} set x {} set y [dobg { - update - bind .t1 <KeyPress> {lappend y {key %A}} - set y {} - event generate .t1 <KeyPress> -keysym b - set y + update + bind .t1 <KeyPress> {lappend y {key %A}} + set y {} + event generate .t1 <KeyPress> -keysym b + set y }] update - bind . <KeyPress> {} list $x $y -} {{} {{key b}}} +} -cleanup { + deleteWindows + bind . <KeyPress> {} +} -result {{} {{key b}}} -test unixEmbed-8.1 {TkpClaimFocus procedure} unix { - deleteWindows + +test unixEmbed-8.1 {TkpClaimFocus procedure} -constraints unix -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 frame .f2 -width 200 -height 50 pack .f1 .f2 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken + eval destroy [winfo child .] + toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken } focus -force .f2 update list [dobg { - focus .t1 - set x [list [focus]] - update - after 500 - update - lappend x [focus] + focus .t1 + set x [list [focus]] + update + after 500 + update + lappend x [focus] }] [focus] -} {{{} .t1} .f1} -test unixEmbed-8.2 {TkpClaimFocus procedure} unix { +} -cleanup { + deleteWindows +} -result {{{} .t1} .f1} +test unixEmbed-8.2 {TkpClaimFocus procedure} -constraints unix -setup { + deleteWindows catch {interp delete child} deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 frame .f2 -width 200 -height 50 pack .f1 .f2 @@ -488,21 +621,27 @@ test unixEmbed-8.2 {TkpClaimFocus procedure} unix { child eval "set argv {-use [winfo id .f1]}" load {} Tk child child eval { - . configure -bd 2 -highlightthickness 2 -relief sunken + . configure -bd 2 -highlightthickness 2 -relief sunken } focus -force .f2 update list [child eval { - focus . - set x [list [focus]] - update - lappend x [focus] + focus . + set x [list [focus]] + update + lappend x [focus] }] [focus] -} {{{} .} .f1} +} -cleanup { + deleteWindows +} -result {{{} .} .f1} catch {interp delete child} -test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} {unix testembed} { - deleteWindows + +test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 frame .f2 -container 1 -width 200 -height 50 frame .f3 -container 1 -width 200 -height 50 @@ -511,28 +650,39 @@ test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} {unix testemb set x {} lappend x [testembed] foreach w {.f3 .f4 .f1 .f2} { - destroy $w - lappend x [testembed] + destroy $w + lappend x [testembed] } set x -} {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}} -test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} {unix testembed} { - deleteWindows +} -cleanup { + deleteWindows +} -result {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}} +test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} -constraints { + unix testembed +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 dobg "set w1 [winfo id .f1]" dobg { - eval destroy [winfo child .] - toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken - set x {} - lappend x [testembed] - destroy .t1 - lappend x [testembed] + eval destroy [winfo child .] + toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken + set x {} + lappend x [testembed] + destroy .t1 + lappend x [testembed] } -} {{{XXX {} {} .t1}} {}} +} -cleanup { + deleteWindows +} -result {{{XXX {} {} .t1}} {}} -test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix { - deleteWindows + +test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 toplevel .t1 -use [winfo id .f1] -width 150 -height 80 @@ -540,9 +690,14 @@ test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix wm geometry .t1 +40+50 update wm geometry .t1 -} {150x80+0+0} -test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix { - deleteWindows +} -cleanup { + deleteWindows +} -result {150x80+0+0} +test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -constraints { + unix +} -setup { + deleteWindows +} -body { frame .f1 -container 1 -width 200 -height 50 pack .f1 toplevel .t1 -use [winfo id .f1] -width 150 -height 80 @@ -550,10 +705,13 @@ test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix wm geometry .t1 70x300+10+20 update wm geometry .t1 -} {70x300+0+0} +} -cleanup { + deleteWindows +} -result {70x300+0+0} # cleanup deleteWindows cleanupbg cleanupTests return + diff --git a/tests/unixMenu.test b/tests/unixMenu.test index 802a7c2..3d655e4 100644 --- a/tests/unixMenu.test +++ b/tests/unixMenu.test @@ -7,474 +7,648 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test unixMenu-1.1 {TkpNewMenu - normal menu} unix { - catch {destroy .m1} - list [catch {menu .m1} msg] $msg [destroy .m1] -} {0 .m1 {}} -test unixMenu-1.2 {TkpNewMenu - help menu} unix { - catch {destroy .m1} + +test unixMenu-1.1 {TkpNewMenu - normal menu} -constraints unix -setup { + destroy .m1 +} -body { + list [menu .m1] [destroy .m1] +} -returnCodes ok -result {.m1 {}} +test unixMenu-1.2 {TkpNewMenu - help menu} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 . configure -menu .m1 .m1 add cascade -label Help -menu .m1.help - list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 .m1.help {} {}} + list [menu .m1.help] [. configure -menu ""] [destroy .m1] +} -returnCodes ok -result {.m1.help {} {}} + + +test unixMenu-2.1 {TkpDestroyMenu - nothing to do} -constraints unix -body {} -test unixMenu-2.1 {TkpDestroyMenu - nothing to do} {} {} -test unixMenu-3.1 {TkpDestroymenuEntry - nothing to do} {} {} -test unixMenu-4.1 {TkpConfigureMenuEntry - non-cascade entry} unix { - catch {destroy .m1} +test unixMenu-3.1 {TkpDestroymenuEntry - nothing to do} -constraints unix -body {} + + +test unixMenu-4.1 {TkpConfigureMenuEntry - non-cascade entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label test - list [catch {.m1 entryconfigure test -label foo} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-4.2 {TkpConfigureMenuEntry - cascade entry} unix { - catch {destroy .m1} + list [.m1 entryconfigure test -label foo] [destroy .m1] +} -returnCodes ok -result {{} {}} +test unixMenu-4.2 {TkpConfigureMenuEntry - cascade entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -menu .m2 -label test menu .m1.foo -tearoff 0 - list [catch {.m1 entryconfigure test -menu .m1.foo} msg] $msg [destroy .m1] -} {0 {} {}} + list [.m1 entryconfigure test -menu .m1.foo] [destroy .m1] +} -returnCodes ok -result {{} {}} + -test unixMenu-5.1 {TkpMenuNewEntry - nothing to do} {} {} +test unixMenu-5.1 {TkpMenuNewEntry - nothing to do} -constraints unix -body {} -test unixMenu-6.1 {TkpSetWindowMenuBar - null menu} unix { - catch {destroy .m1} + +test unixMenu-6.1 {TkpSetWindowMenuBar - null menu} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label foo . configure -menu .m1 - list [catch {. configure -menu ""} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-6.2 {TkpSetWindowMenuBar - menu} unix { - catch {destroy .m1} + list [. configure -menu ""] [destroy .m1] +} -returnCodes ok -result {{} {}} +test unixMenu-6.2 {TkpSetWindowMenuBar - menu} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label foo - list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} + list [. configure -menu .m1] [. configure -menu ""] [destroy .m1] +} -returnCodes ok -result {{} {} {}} + + +test unixMenu-7.1 {TkpSetMainMenubar - nothing to do} -constraints unix -body {} -test unixMenu-7.1 {TkpSetMainMenubar - nothing to do} {} {} -test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} unix { - catch {destroy .m1} +test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo -indicatoron 0 - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} unix { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} {unix testImageType} { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} -constraints { + unix testImageType +} -setup { + destroy .m1 catch {image delete image1} +} -body { menu .m1 image create test image1 .m1 add checkbutton -image image1 -label foo .m1 invoke foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1] -} {0 {} {}} -test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} unix { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -cleanup { + image delete image1 +} -returnCodes ok +test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -bitmap questhead -label foo .m1 invoke foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} unix { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo .m1 invoke foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} {unix testImageType} { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} -constraints { + unix testImageType +} -setup { + destroy .m1 catch {image delete image1} +} -body { menu .m1 image create test image1 .m1 add radiobutton -image image1 -label foo .m1 invoke foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] [image delete image1] -} {0 {} {}} -test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} unix { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 + image delete image1 +} -returnCodes ok +test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add radiobutton -bitmap questhead -label foo .m1 invoke foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} unix { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add radiobutton -label foo .m1 invoke foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} unix { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add radiobutton -label foo -hidemargin 1 .m1 invoke foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok -test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} unix { - catch {destroy .m1} + +test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} unix { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -accel "Ctrl+S" - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test unixMenu-9.3 {GetMenuAccelGeometry - null label} unix { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test unixMenu-9.3 {GetMenuAccelGeometry - null label} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok + -test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} unix { - catch {destroy .m1} +test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label foo . configure -menu .m1 .m1 activate 1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-10.2 {DrawMenuEntryBackground - active} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -returnCodes ok -result {{} {} {}} +test unixMenu-10.2 {DrawMenuEntryBackground - active} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] $tearoff activate 0 - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-10.3 {DrawMenuEntryBackground - non-active} unix { - catch {destroy .m1} + list [update] [destroy .m1] +} -returnCodes ok -result {{} {}} +test unixMenu-10.3 {DrawMenuEntryBackground - non-active} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} + list [update] [destroy .m1] +} -returnCodes ok -result {{} {}} + -test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} unix { - catch {destroy .m1} +test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -accel "Ctrl+U" . configure -menu .m1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} # drawArrow parameter is never false under Unix -test unixMenu-11.2 {DrawMenuEntryAccelerator - cascade entry} unix { - catch {destroy .m1} +test unixMenu-11.2 {DrawMenuEntryAccelerator - cascade entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label foo set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} unix { - catch {destroy .m1} + list [update] [destroy .m1] +} -result {{} {}} +test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -accel "Ctrl+U" set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} unix { - catch {destroy .m1} + list [update] [destroy .m1] +} -result {{} {}} +test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} + list [update] [destroy .m1] +} -result {{} {}} + -test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} unix { - catch {destroy .m1} +test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} unix { - catch {destroy .m1} + list [update] [destroy .m1] +} -result {{} {}} +test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo -indicatoron 0 set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} unix { - catch {destroy .m1} + list [update] [destroy .m1] +} -result {{} {}} +test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} unix { - catch {destroy .m1} + list [update] [destroy .m1] +} -result {{} {}} +test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} unix { - catch {destroy .m1} + list [update] [destroy .m1] +} -result {{} {}} +test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add radiobutton -label foo -indicatoron 0 set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} unix { - catch {destroy .m1} + list [update] [destroy .m1] +} -result {{} {}} +test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add radiobutton -label foo set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} -test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} unix { - catch {destroy .m1} + list [update] [destroy .m1] +} -result {{} {}} +test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add radiobutton -label foo .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} + list [update] [destroy .m1] +} -result {{} {}} + -test unixMenu-13.1 {DrawMenuSeparator - menubar case} unix { - catch {destroy .m1} +test unixMenu-13.1 {DrawMenuSeparator - menubar case} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator . configure -menu .m1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-13.2 {DrawMenuSepartor - normal menu} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-13.2 {DrawMenuSepartor - normal menu} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} + list [update] [destroy .m1] +} -result {{} {}} + -test unixMenu-14.1 {DrawMenuEntryLabel} unix { - catch {destroy .m1} +test unixMenu-14.1 {DrawMenuEntryLabel} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} + list [update] [destroy .m1] +} -result {{} {}} -test unixMenu-15.1 {DrawMenuUnderline - menubar} unix { - catch {destroy .m1} + +test unixMenu-15.1 {DrawMenuUnderline - menubar} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -underline 0 . configure -menu .m1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-15.2 {DrawMenuUnderline - no menubar} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-15.2 {DrawMenuUnderline - no menubar} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -underline 0 set tearoff [tk::TearOffMenu .m1 40 40] - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} + list [update] [destroy .m1] +} -result {{} {}} + -test unixMenu-16.1 {TkpPostMenu} unix { - catch {destroy .m1} +test unixMenu-16.1 {TkpPostMenu} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok -test unixMenu-17.1 {GetMenuSeparatorGeometry} unix { - catch {destroy .m1} + +test unixMenu-17.1 {GetMenuSeparatorGeometry} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok + -test unixMenu-18.1 {GetTearoffEntryGeometry} {unix nonUnixUserInteraction} { - catch {destroy .m1} +test unixMenu-18.1 {GetTearoffEntryGeometry} -constraints { + unix nonUnixUserInteraction +} -setup { + destroy .mb +} -body { menubutton .mb -text "test" -menu .mb.m menu .mb.m .mb.m add command -label test pack .mb raise . - list [catch {tk::MbPost .mb} msg] $msg [tk::MenuUnpost .mb.m] [destroy .mb] -} {0 {} {} {}} + list [tk::MbPost .mb] [tk::MenuUnpost .mb.m] [destroy .mb] +} -result {{} {} {}} + # Don't know how to reproduce the case where the tkwin has been deleted. -test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} unix { - catch {destroy .m1} + +test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 . configure -menu .m1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} # Don't know how to generate one width windows -test unixMenu-19.2 {TkpComputeMenubarGeometry - one entry} unix { - catch {destroy .m1} +test unixMenu-19.2 {TkpComputeMenubarGeometry - one entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label File . configure -menu .m1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.3 {TkpComputeMenubarGeometry - entry with different font} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.3 {TkpComputeMenubarGeometry - entry with different font} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -font "Courier 24" .m1 add cascade -label File -font "Helvetica 18" . configure -menu .m1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.4 {TkpComputeMenubarGeometry - separator} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.4 {TkpComputeMenubarGeometry - separator} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator . configure -menu .m1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.5 {TkpComputeMenubarGeometry - First entry} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.5 {TkpComputeMenubarGeometry - First entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label File . configure -menu .m1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.6 {TkpComputeMenubarGeometry - First entry too wide} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.6 {TkpComputeMenubarGeometry - First entry too wide} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label File -font "Times 72" . configure -menu .m1 wm geometry . 10x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.7 {TkpComputeMenubarGeometry - two entries fit} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.7 {TkpComputeMenubarGeometry - two entries fit} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label File .m1 add cascade -label Edit . configure -menu .m1 wm geometry . 200x200 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.8 {TkpComputeMenubarGeometry - two entries; 2nd don't fit} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.8 {TkpComputeMenubarGeometry - two entries; 2nd don't fit} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label File .m1 add cascade -label Edit -font "Times 72" . configure -menu .m1 wm geometry . 100x100 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.9 {TkpComputeMenubarGeometry - two entries; 1st dont fit} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.9 {TkpComputeMenubarGeometry - two entries; 1st dont fit} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label File -font "Times 72" .m1 add cascade -label Edit . configure -menu .m1 wm geometry . 100x100 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.10 {TkpComputeMenubarGeometry - two entries; neither fit} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.10 {TkpComputeMenubarGeometry - two entries; neither fit} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 -font "Times 72" .m1 add cascade -label File .m1 add cascade -label Edit . configure -menu .m1 wm geometry . 10x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} # ABC notation; capital A means first window fits, small a means it # does not. capital B menu means second window fist, etc. -test unixMenu-19.11 {TkpComputeMenubarGeometry - abc} unix { - catch {destroy .m1} +test unixMenu-19.11 {TkpComputeMenubarGeometry - abc} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 -font "Times 72" .m1 add cascade -label "aaaaa" .m1 add cascade -label "bbbbb" .m1 add cascade -label "ccccc" . configure -menu .m1 wm geometry . 10x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.12 {TkpComputeMenubarGeometry - abC} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.12 {TkpComputeMenubarGeometry - abC} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label "aaaaa" -font "Times 72" .m1 add cascade -label "bbbbb" -font "Times 72" .m1 add cascade -label "C" . configure -menu .m1 wm geometry . 10x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.13 {TkpComputeMenubarGeometry - aBc} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.13 {TkpComputeMenubarGeometry - aBc} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label "aaaaa" -font "Times 72" .m1 add cascade -label "B" .m1 add cascade -label "ccccc" -font "Times 72" . configure -menu .m1 wm geometry . 10x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.14 {TkpComputeMenubarGeometry - aBC} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.14 {TkpComputeMenubarGeometry - aBC} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label "aaaaa" -font "Times 72" .m1 add cascade -label "B" .m1 add cascade -label "C" . configure -menu .m1 wm geometry . 60x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.15 {TkpComputeMenubarGeometry - Abc} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.15 {TkpComputeMenubarGeometry - Abc} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label "A" .m1 add cascade -label "bbbbb" -font "Times 72" .m1 add cascade -label "ccccc" -font "Times 72" . configure -menu .m1 wm geometry . 60x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.16 {TkpComputeMenubarGeometry - AbC} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.16 {TkpComputeMenubarGeometry - AbC} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label "A" .m1 add cascade -label "bbbbb" -font "Times 72" .m1 add cascade -label "C" . configure -menu .m1 wm geometry . 60x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.17 {TkpComputeMenubarGeometry - ABc} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.17 {TkpComputeMenubarGeometry - ABc} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label "A" .m1 add cascade -label "B" .m1 add cascade -label "ccccc" -font "Times 72" . configure -menu .m1 wm geometry . 60x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.18 {TkpComputeMenubarGeometry - ABC} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.18 {TkpComputeMenubarGeometry - ABC} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label "A" .m1 add cascade -label "B" .m1 add cascade -label "C" . configure -menu .m1 wm geometry . 100x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.19 {TkpComputeMenubarGeometry - help menu in first position} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.19 {TkpComputeMenubarGeometry - help menu in first position} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label Help -menu .m1.help menu .m1.help -tearoff 0 @@ -484,10 +658,13 @@ test unixMenu-19.19 {TkpComputeMenubarGeometry - help menu in first position} un menu .m1.edit -tearoff 0 . configure -menu .m1 wm geometry . 100x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.20 {TkpComputeMenubarGeometry - help menu in middle} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.20 {TkpComputeMenubarGeometry - help menu in middle} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label Edit -menu .m1.edit menu .m1.edit -tearoff 0 @@ -497,10 +674,13 @@ test unixMenu-19.20 {TkpComputeMenubarGeometry - help menu in middle} unix { menu .m1.file -tearoff 0 . configure -menu .m1 wm geometry . 100x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.21 {TkpComputeMenubarGeometry - help menu in first position} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.21 {TkpComputeMenubarGeometry - help menu in first position} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label File -menu .m1.file menu .m1.file -tearoff 0 @@ -510,10 +690,13 @@ test unixMenu-19.21 {TkpComputeMenubarGeometry - help menu in first position} un menu .m1.help -tearoff 0 . configure -menu .m1 wm geometry . 100x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.22 {TkpComputeMenubarGeometry - help item fits} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.22 {TkpComputeMenubarGeometry - help item fits} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label File -menu .m1.file menu .m1.file -tearoff 0 @@ -521,10 +704,13 @@ test unixMenu-19.22 {TkpComputeMenubarGeometry - help item fits} unix { menu .m1.help -tearoff 0 . configure -menu .m1 wm geometry . 100x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.23 {TkpComputeMenubarGeometry - help item does not fit} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.23 {TkpComputeMenubarGeometry - help item does not fit} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label File -menu .m1.file menu .m1.file -tearoff 0 @@ -532,215 +718,283 @@ test unixMenu-19.23 {TkpComputeMenubarGeometry - help item does not fit} unix { menu .m1.help -tearoff 0 . configure -menu .m1 wm geometry . 100x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-19.24 {TkpComputeMenubarGeometry - help item only one} unix { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-19.24 {TkpComputeMenubarGeometry - help item only one} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label Help -menu .m1.help menu .m1.help -tearoff 0 . configure -menu .m1 wm geometry . 100x10 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} + -test unixMenu-20.1 {DrawTearoffEntry - menubar} unix { - catch {destroy .m1} +test unixMenu-20.1 {DrawTearoffEntry - menubar} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label File . configure -menu .m1 - list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test unixMenu-20.2 {DrawTearoffEntry - non-menubar} {unix nonUnixUserInteraction} { - catch {destroy .m1} + list [update] [. configure -menu ""] [destroy .m1] +} -result {{} {} {}} +test unixMenu-20.2 {DrawTearoffEntry - non-menubar} -constraints { + unix nonUnixUserInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo .m1 post 40 40 - list [catch {update} msg] $msg [destroy .m1] -} {0 {} {}} + list [update] [destroy .m1] +} -result {{} {}} -test unixMenu-21.1 {TkpInitializeMenuBindings - nothing to do} {} {} -test unixMenu-22.1 {SetHelpMenu - no menubars} unix { - catch {destroy .m1} +test unixMenu-21.1 {TkpInitializeMenuBindings - nothing to do} -constraints unix -body {} + + +test unixMenu-22.1 {SetHelpMenu - no menubars} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label test -menu .m1.test - list [catch {menu .m1.test} msg] $msg [destroy .m1] -} {0 .m1.test {}} + list [menu .m1.test] [destroy .m1] +} -result {.m1.test {}} # Don't know how to automate missing tkwins -test unixMenu-22.2 {SetHelpMenu - menubar but no help menu} unix { - catch {destroy .m1} +test unixMenu-22.2 {SetHelpMenu - menubar but no help menu} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 . configure -menu .m1 .m1 add cascade -label .m1.file - list [catch {menu .m1.file} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 .m1.file {} {}} -test unixMenu-22.3 {SetHelpMenu - menubar with help menu} unix { - catch {destroy .m1} + list [menu .m1.file] [. configure -menu ""] [destroy .m1] +} -result {.m1.file {} {}} +test unixMenu-22.3 {SetHelpMenu - menubar with help menu} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 . configure -menu .m1 .m1 add cascade -label .m1.help - list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 .m1.help {} {}} -test unixMenu-22.4 {SetHelpMenu - multiple menubars with same help menu} unix { - catch {destroy .m1} - catch {destroy .t2} + list [menu .m1.help] [. configure -menu ""] [destroy .m1] +} -result {.m1.help {} {}} +test unixMenu-22.4 {SetHelpMenu - multiple menubars with same help menu} -constraints { + unix +} -setup { + destroy .m1 .t2 +} -body { toplevel .t2 wm geometry .t2 +40+40 menu .m1 -tearoff 0 . configure -menu .m1 .t2 configure -menu .m1 .m1 add cascade -label .m1.help - list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .t2] -} {0 .m1.help {} {} {}} + list [menu .m1.help] [. configure -menu ""] [destroy .m1] [destroy .t2] +} -result {.m1.help {} {} {}} + -test unixMenu-23.1 {TkpDrawMenuEntry - gc for active and not strict motif} unix { - catch {destroy .m1} +test unixMenu-23.1 {TkpDrawMenuEntry - gc for active and not strict motif} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -activeforeground red set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.3 {TkpDrawMenuEntry - gc for active and strict motif} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.3 {TkpDrawMenuEntry - gc for active and strict motif} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 set tk_strictMotif 1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] -} {{} {} 0} -test unixMenu-23.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} unix { - catch {destroy .m1} +} -result {{} {} 0} +test unixMenu-23.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled -background red set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.7 {TkpDrawMenuEntry - gc for normal - custom entry} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.7 {TkpDrawMenuEntry - gc for normal - custom entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -foreground red set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.8 {TkpDrawMenuEntry - gc for normal} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.8 {TkpDrawMenuEntry - gc for normal} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.9 {TkpDrawMenuEntry - gc for indicator - custom entry} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.9 {TkpDrawMenuEntry - gc for indicator - custom entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo -selectcolor orange .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.10 {TkpDrawMenuEntry - gc for indicator} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.10 {TkpDrawMenuEntry - gc for indicator} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.11 {TkpDrawMenuEntry - border - custom entry} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.11 {TkpDrawMenuEntry - border - custom entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -activebackground green set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.12 {TkpDrawMenuEntry - border} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.12 {TkpDrawMenuEntry - border} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.13 {TkpDrawMenuEntry - active border - strict motif} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.13 {TkpDrawMenuEntry - active border - strict motif} -constraints { + unix +} -setup { + destroy .m1 +} -body { set tk_strictMotif 1 menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] -} {{} {} 0} -test unixMenu-23.14 {TkpDrawMenuEntry - active border - custom entry} unix { - catch {destroy .m1} +} -result {{} {} 0} +test unixMenu-23.14 {TkpDrawMenuEntry - active border - custom entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -activeforeground yellow set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.15 {TkpDrawMenuEntry - active border} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.15 {TkpDrawMenuEntry - active border} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.16 {TkpDrawMenuEntry - font - custom entry} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.16 {TkpDrawMenuEntry - font - custom entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -font "Helvectica 72" set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.17 {TkpDrawMenuEntry - font} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.17 {TkpDrawMenuEntry - font} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 -font "Courier 72" .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.18 {TkpDrawMenuEntry - separator} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.18 {TkpDrawMenuEntry - separator} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.19 {TkpDrawMenuEntry - standard} unix { - catch {destroy .mb} +} -result {{} {}} +test unixMenu-23.19 {TkpDrawMenuEntry - standard} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label File -menu .m1.file menu .m1.file @@ -748,140 +1002,192 @@ test unixMenu-23.20 {TkpDrawMenuEntry - disabled cascade item} unix { .m1 entryconfigure File -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.21 {TkpDrawMenuEntry - indicator} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.21 {TkpDrawMenuEntry - indicator} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label Foo .m1 invoke Foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label Foo -hidemargin 1 .m1 invoke Foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} +} -result {{} {}} -test unixMenu-24.1 {GetMenuLabelGeometry - image} {testImageType unix} { - catch {destroy .m1} + +test unixMenu-24.1 {GetMenuLabelGeometry - image} -constraints { + testImageType unix +} -setup { + destroy .m1 catch {image delete image1} +} -body { menu .m1 image create test image1 .m1 add command -image image1 list [update idletasks] [destroy .m1] [image delete image1] -} {{} {} {}} -test unixMenu-24.2 {GetMenuLabelGeometry - bitmap} unix { - catch {destroy .m1} +} -result {{} {} {}} +test unixMenu-24.2 {GetMenuLabelGeometry - bitmap} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -bitmap questhead list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-24.3 {GetMenuLabelGeometry - no text} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-24.3 {GetMenuLabelGeometry - no text} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-24.4 {GetMenuLabelGeometry - text} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-24.4 {GetMenuLabelGeometry - text} -constraints unix -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "This is a test." list [update idletasks] [destroy .m1] -} {{} {}} +} -result {{} {}} + -test unixMenu-25.1 {TkpComputeStandardMenuGeometry - no entries} unix { - catch {destroy .m1} +test unixMenu-25.1 {TkpComputeStandardMenuGeometry - no entries} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.2 {TkpComputeStandardMenuGeometry - one entry} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.2 {TkpComputeStandardMenuGeometry - one entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "one" list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.3 {TkpComputeStandardMenuGeometry - more than one entry} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.3 {TkpComputeStandardMenuGeometry - more than one entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "one" .m1 add command -label "two" list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.4 {TkpComputeStandardMenuGeometry - separator} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.4 {TkpComputeStandardMenuGeometry - separator} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unix nonUnixUserInteraction} { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} -constraints { + unix nonUnixUserInteraction +} -setup { + destroy .mb +} -body { menubutton .mb -text "test" -menu .mb.m menu .mb.m .mb.m add command -label test pack .mb catch {tk::MbPost .mb} list [update] [tk::MenuUnpost .mb.m] [destroy .mb] -} {{} {} {}} -test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} unix { - catch {destroy .m1} +} -result {{} {} {}} +test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.7 {TkpComputeStandardMenuGeometry - different font for entry} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.7 {TkpComputeStandardMenuGeometry - different font for entry} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -font "Helvetica 12" .m1 add command -label "test" -font "Courier 12" list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.8 {TkpComputeStandardMenuGeometry - second entry larger} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.8 {TkpComputeStandardMenuGeometry - second entry larger} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test test" list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.9 {TkpComputeStandardMenuGeometry - first entry larger} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.9 {TkpComputeStandardMenuGeometry - first entry larger} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test test" .m1 add command -label "test" list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.10 {TkpComputeStandardMenuGeometry - accelerator} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.10 {TkpComputeStandardMenuGeometry - accelerator} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" -accel "Ctrl+S" list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.11 {TkpComputeStandardMenuGeometry - second accel larger} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.11 {TkpComputeStandardMenuGeometry - second accel larger} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" -accel "1" .m1 add command -label "test" -accel "1 1" list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.12 {TkpComputeStandardMenuGeometry - second accel smaller} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.12 {TkpComputeStandardMenuGeometry - second accel smaller} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" -accel "1 1" .m1 add command -label "test" -accel "1" list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.13 {TkpComputeStandardMenuGeometry - indicator} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.13 {TkpComputeStandardMenuGeometry - indicator} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label test .m1 invoke 1 list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.14 {TkpComputeStandardMenuGeometry - second indicator less or equal } {unix testImageType} { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.14 {TkpComputeStandardMenuGeometry - second indicator less or equal } -constraints { + unix testImageType +} -setup { + destroy .m1 catch {image delete image1} +} -body { image create test image1 menu .m1 .m1 add checkbutton -image image1 @@ -889,10 +1195,13 @@ test unixMenu-25.14 {TkpComputeStandardMenuGeometry - second indicator less or e .m1 add checkbutton -label test .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] -} {{} {} {}} -test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unix testImageType} { - catch {destroy .m1} +} -result {{} {} {}} +test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger } -constraints { + unix testImageType +} -setup { + destroy .m1 catch {image delete image1} +} -body { image create test image1 menu .m1 .m1 add checkbutton -image image1 @@ -900,30 +1209,42 @@ test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger } .m1 add checkbutton -label test .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] -} {{} {} {}} -test unixMenu-25.16 {TkpComputeStandardMenuGeometry - zero sized menus} unix { - catch {destroy .m1} +} -result {{} {} {}} +test unixMenu-25.16 {TkpComputeStandardMenuGeometry - zero sized menus} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.17 {TkpComputeStandardMenuGeometry - first column bigger} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.17 {TkpComputeStandardMenuGeometry - first column bigger} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label one .m1 add command -label two .m1 add command -label three -columnbreak 1 list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.18 {TkpComputeStandardMenuGeometry - second column bigger} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.18 {TkpComputeStandardMenuGeometry - second column bigger} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label one .m1 add command -label two -columnbreak 1 .m1 add command -label three list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.19 {TkpComputeStandardMenuGeometry - three columns} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.19 {TkpComputeStandardMenuGeometry - three columns} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label one .m1 add command -label two -columnbreak 1 @@ -932,15 +1253,21 @@ test unixMenu-25.19 {TkpComputeStandardMenuGeometry - three columns} unix { .m1 add command -label five -columnbreak 1 .m1 add command -label six list [update idletasks] [destroy .m1] -} {{} {}} -test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} unix { - catch {destroy .m1} +} -result {{} {}} +test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} -constraints { + unix +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add checkbutton -label one -hidemargin 1 list [update idletasks] [destroy .m1] -} {{} {}} +} -result {{} {}} + + +test unixMenu-26.1 {TkpMenuInit - nothing to do} -constraints unix -body {} + -test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {} # cleanup deleteWindows diff --git a/tests/unixSelect.test b/tests/unixSelect.test index c3ed11d..53ae006 100644 --- a/tests/unixSelect.test +++ b/tests/unixSelect.test @@ -9,8 +9,9 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands global longValue selValue selInfo @@ -23,7 +24,7 @@ proc handler {type offset count} { lappend selInfo $type $offset $count set numBytes [expr {[string length $selValue] - $offset}] if {$numBytes <= 0} { - return "" + return "" } string range $selValue $offset [expr $numBytes+$offset] } @@ -31,18 +32,18 @@ proc handler {type offset count} { proc errIncrHandler {type offset count} { global selValue selInfo pass if {$offset == 4000} { - if {$pass == 0} { - # Just sizing the selection; don't do anything here. - set pass 1 - } else { - # Fetching the selection; wait long enough to cause a timeout. - after 6000 - } + if {$pass == 0} { + # Just sizing the selection; don't do anything here. + set pass 1 + } else { + # Fetching the selection; wait long enough to cause a timeout. + after 6000 + } } lappend selInfo $type $offset $count set numBytes [expr {[string length $selValue] - $offset}] if {$numBytes <= 0} { - return "" + return "" } string range $selValue $offset [expr $numBytes+$offset] } @@ -57,23 +58,23 @@ proc badHandler {path type offset count} { lappend selInfo $path $type $offset $count set numBytes [expr {[string length $selValue] - $offset}] if {$numBytes <= 0} { - return "" + return "" } string range $selValue $offset [expr $numBytes+$offset] } proc reallyBadHandler {path type offset count} { global selValue selInfo pass if {$offset == 4000} { - if {$pass == 0} { - set pass 1 - } else { - selection handle -type $type $path {} - } + if {$pass == 0} { + set pass 1 + } else { + selection handle -type $type $path {} + } } lappend selInfo $path $type $offset $count set numBytes [expr {[string length $selValue] - $offset}] if {$numBytes <= 0} { - return "" + return "" } string range $selValue $offset [expr $numBytes+$offset] } @@ -89,10 +90,10 @@ after 1500 proc setup {{path .f1} {display {}}} { catch {destroy $path} if {$display == {}} { - frame $path + frame $path } else { - toplevel $path -screen $display - wm geom $path +0+0 + toplevel $path -screen $display + wm geom $path +0+0 } selection own $path } @@ -104,255 +105,332 @@ foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} { append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j } -test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} unix { +# ---------------------------------------------------------------------- + +test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} -constraints { + unix +} -setup { + destroy .e setupbg - entry .e - pack .e +} -body { + pack [entry .e] update - .e insert 0 [encoding convertfrom identity \u00fcber] + .e insert 0 \u00fcber .e selection range 0 end - set result [dobg {string bytelength [selection get]}] + dobg {string length [selection get]} +} -cleanup { cleanupbg destroy .e - set result -} {5} -test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} unix { +} -result {4} + +test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 \u00fc\u0444 - .e selection range 0 end + pack [entry .e] + update + .e insert 0 \u00fc\u0444 + .e selection range 0 end } - set x [selection get] + selection get +} -cleanup { cleanupbg - list [string equal \u00fc? $x] \ - [string length $x] [string bytelength $x] -} {1 2 3} -test unixSelect-1.4 {TkSelGetSelection procedure: simple i18n text, iso2022} unix { +} -result \u00fc? + +test unixSelect-1.3 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints { + unix +} -setup { setupbg setup +} -body { selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ - {handler COMPOUND_TEXT} + {handler COMPOUND_TEXT} selection own . set selValue \u00fc\u0444 set selInfo {} set result [dobg { - set x [selection get -type COMPOUND_TEXT] - list [string equal \u00fc\u0444 $x] \ - [string length $x] [string bytelength $x] + set x [selection get -type COMPOUND_TEXT] + list [string equal \u00fc\u0444 $x] [string length $x] }] - cleanupbg lappend result $selInfo -} {1 2 4 {COMPOUND_TEXT 0 4000}} -test unixSelect-1.5 {TkSelGetSelection procedure: INCR i18n text, iso2022} unix { +} -cleanup { + cleanupbg +} -result {1 2 {COMPOUND_TEXT 0 4000}} +test unixSelect-1.4 {TkSelGetSelection procedure: INCR i18n text, iso2022} -constraints { + unix +} -setup { + setupbg + setup +} -body { # This test is subtle. The selection ends up getting fetched twice by # Tk: once to compute the length, and again to actually send the data. # The first time through, we don't convert the data to ISO2022, so the # buffer boundaries end up being different in the two passes. - - setupbg - setup selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ - {handler COMPOUND_TEXT} + {handler COMPOUND_TEXT} selection own . set selValue [string repeat x 3999]\u00fc\u0444[string repeat x 3999] set selInfo {} set result [dobg { - set x [selection get -type COMPOUND_TEXT] - list [string equal \ - [string repeat x 3999]\u00fc\u0444[string repeat x 3999] $x] \ - [string length $x] [string bytelength $x] + set x [selection get -type COMPOUND_TEXT] + list [string equal \ + [string repeat x 3999]\u00fc\u0444[string repeat x 3999] $x] \ + [string length $x] }] - cleanupbg lappend result $selInfo -} {1 8000 8002 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3999 COMPOUND_TEXT 7998 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}} -test unixSelect-1.6 {TkSelGetSelection procedure: simple i18n text, iso2022} unix { +} -cleanup { + cleanupbg +} -result {1 8000 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3999 COMPOUND_TEXT 7998 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}} + +test unixSelect-1.5 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints { + unix +} -setup { setupbg setup +} -body { selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ - {handler COMPOUND_TEXT} + {handler COMPOUND_TEXT} selection own . set selValue \u00fc\u0444 set selInfo {} set result [dobg { - set x [selection get -type COMPOUND_TEXT] - list [string equal \u00fc\u0444 $x] \ - [string length $x] [string bytelength $x] + set x [selection get -type COMPOUND_TEXT] + list [string equal \u00fc\u0444 $x] [string length $x] }] - cleanupbg lappend result $selInfo -} {1 2 4 {COMPOUND_TEXT 0 4000}} -test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} unix { +} -cleanup { + cleanupbg +} -result {1 2 {COMPOUND_TEXT 0 4000}} + +test unixSelect-1.6 {TkSelGetSelection procedure: INCR i18n text} -constraints { + unix +} -setup { setupbg - dobg "entry .e; pack .e; update - .e insert 0 \[encoding convertfrom identity \\u00fcber\]$longValue - .e selection range 0 end" - set result [string bytelength [selection get]] +} -body { + dobg [subst -nobackslashes {entry .e; pack .e; update + .e insert 0 \u00fcber$longValue + .e selection range 0 end}] + string length [selection get] +} -cleanup { cleanupbg - set result -} [expr {5 + [string bytelength $longValue]}] -test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} unix { +} -result [expr {4 + [string length $longValue]}] + +test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 [string repeat x 3999]\u00fc - .e selection range 0 end + pack [entry .e] + update + .e insert 0 [string repeat x 3999]\u00fc + .e selection range 0 end } - set x [selection get] + selection get +} -cleanup { cleanupbg - list [string equal [string repeat x 3999]\u00fc $x] \ - [string length $x] [string bytelength $x] -} {1 4000 4001} -test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} unix { +} -result [string repeat x 3999]\u00fc + +test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 \u00fc[string repeat x 3999] - .e selection range 0 end + pack [entry .e] + update + .e insert 0 \u00fc[string repeat x 3999] + .e selection range 0 end } - set x [selection get] + selection get +} -cleanup { cleanupbg - list [string equal \u00fc[string repeat x 3999] $x] \ - [string length $x] [string bytelength $x] -} {1 4000 4001} -test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text} unix { +} -result \u00fc[string repeat x 3999] + +test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000] - .e selection range 0 end + pack [entry .e] + update + .e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000] + .e selection range 0 end } - set x [selection get] + selection get +} -cleanup { cleanupbg - list [string equal [string repeat x 3999]\u00fc[string repeat x 4000] $x] \ - [string length $x] [string bytelength $x] -} {1 8000 8001} +} -result [string repeat x 3999]\u00fc[string repeat x 4000] # Now some tests to make sure that the right thing is done when # transferring UTF8 selections, to prevent [Bug 614650] and its ilk # from rearing its ugly head again. -test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { + +test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 [string repeat x 3999]\u00fc - .e selection range 0 end + pack [entry .e] + update + .e insert 0 [string repeat x 3999]\u00fc + .e selection range 0 end } - set x [selection get -type UTF8_STRING] + selection get -type UTF8_STRING +} -cleanup { cleanupbg - list [string equal [string repeat x 3999]\u00fc $x] \ - [string length $x] [string bytelength $x] -} {1 4000 4001} -test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { +} -result [string repeat x 3999]\u00fc + +test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 \u00fc[string repeat x 3999] - .e selection range 0 end + pack [entry .e] + update + .e insert 0 \u00fc[string repeat x 3999] + .e selection range 0 end } - set x [selection get -type UTF8_STRING] + selection get -type UTF8_STRING +} -cleanup { cleanupbg - list [string equal \u00fc[string repeat x 3999] $x] \ - [string length $x] [string bytelength $x] -} {1 4000 4001} -test unixSelect-1.13 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { +} -result \u00fc[string repeat x 3999] + +test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000] - .e selection range 0 end + pack [entry .e] + update + .e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000] + .e selection range 0 end } - set x [selection get -type UTF8_STRING] + selection get -type UTF8_STRING +} -cleanup { cleanupbg - list [string equal [string repeat x 3999]\u00fc[string repeat x 4000] $x] \ - [string length $x] [string bytelength $x] -} {1 8000 8001} -test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} unix { +} -result [string repeat x 3999]\u00fc[string repeat x 4000] + +test unixSelect-1.13 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints { + unix +} -setup { + destroy .e setupbg - entry .e - pack .e +} -body { + pack [entry .e] update - .e insert 0 [encoding convertfrom identity \u00fcber\u0444] + .e insert 0 \u00fcber\u0444 .e selection range 0 end - set result [dobg {string bytelength [selection get -type UTF8_STRING]}] - cleanupbg + dobg {string length [selection get -type UTF8_STRING]} +} -cleanup { destroy .e - set result -} {5} -test unixSelect-1.15 {TkSelGetSelection procedure: simple i18n text, utf-8} unix { + cleanupbg +} -result {5} + +test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 \u00fc\u0444 - .e selection range 0 end + pack [entry .e] + update + .e insert 0 \u00fc\u0444 + .e selection range 0 end } - set x [selection get -type UTF8_STRING] + selection get -type UTF8_STRING +} -cleanup { cleanupbg - list [string equal \u00fc\u0444 $x] \ - [string length $x] [string bytelength $x] -} {1 2 4} -test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { +} -result \u00fc\u0444 + +test unixSelect-1.15 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 [string repeat [string repeat \u00c4\u00e4 50]\n 21] - .e selection range 0 end + pack [entry .e] + update + .e insert 0 [string repeat [string repeat \u00c4\u00e4 50]\n 21] + .e selection range 0 end } - set x [selection get -type UTF8_STRING] + selection get -type UTF8_STRING +} -cleanup { cleanupbg - list [string equal [string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ - [string length $x] [string bytelength $x] -} {1 2121 4221} -test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { +} -result [string repeat [string repeat \u00c4\u00e4 50]\n 21] + +test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { + unix +} -setup { setupbg +} -body { dobg { - entry .e; pack .e; update - .e insert 0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21] - .e selection range 0 end + pack [entry .e] + update + .e insert 0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21] + .e selection range 0 end } - set x [selection get -type UTF8_STRING] + selection get -type UTF8_STRING +} -cleanup { cleanupbg - list [string equal i[string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ - [string length $x] [string bytelength $x] -} {1 2122 4222} -test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { +} -result i[string repeat [string repeat \u00c4\u00e4 50]\n 21] + +test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { + unix +} -setup { setupbg +} -body { dobg { - text .t; pack .t; update - .t insert 1.0 [string repeat [string repeat \u00c4\u00e4 50]\n 21] - # Has to be selected in a separate stage - .t tag add sel 1.0 21.end+1c + pack [text .t] + update + .t insert 1.0 [string repeat [string repeat \u00c4\u00e4 50]\n 21] + # Has to be selected in a separate stage + .t tag add sel 1.0 21.end+1c } after 10 - set x [selection get -type UTF8_STRING] + selection get -type UTF8_STRING +} -cleanup { cleanupbg - list [string equal [string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ - [string length $x] [string bytelength $x] -} {1 2121 4221} -test unixSelect-1.19 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { +} -result [string repeat [string repeat \u00c4\u00e4 50]\n 21] + +test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints { + unix +} -setup { setupbg +} -body { dobg { - text .t; pack .t; update - .t insert 1.0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21] - # Has to be selected in a separate stage - .t tag add sel 1.0 21.end+1c + pack [text .t] + update + .t insert 1.0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21] + # Has to be selected in a separate stage + .t tag add sel 1.0 21.end+1c } after 10 - set x [selection get -type UTF8_STRING] + selection get -type UTF8_STRING +} -cleanup { cleanupbg - list [string equal i[string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ - [string length $x] [string bytelength $x] -} {1 2122 4222} -test unixSelect-1.20 {Automatic UTF8_STRING support for selection handle} unix { +} -result i[string repeat [string repeat \u00c4\u00e4 50]\n 21] + +test unixSelect-1.19 {Automatic UTF8_STRING support for selection handle} -constraints { + unix +} -setup { + destroy .l +} -body { # See Bug #666346 "Selection handling crashes under KDE 3.0" - label .l + label .l selection handle .l [list handler STRING] set selValue "This is the selection value" selection own .l - set result [selection get -type UTF8_STRING] + selection get -type UTF8_STRING +} -cleanup { destroy .l - set result -} "This is the selection value" +} -result {This is the selection value} # cleanup cleanupTests diff --git a/tests/util.test b/tests/util.test index 86271c5..c1ec6a5 100644 --- a/tests/util.test +++ b/tests/util.test @@ -6,61 +6,63 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test listbox .l -width 20 -height 5 -relief sunken -bd 2 pack .l .l insert 0 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 update -test util-1.1 {Tk_GetScrollInfo procedure} { - list [catch {.l yview moveto a b} msg] $msg -} {1 {wrong # args: should be ".l yview moveto fraction"}} -test util-1.2 {Tk_GetScrollInfo procedure} { - list [catch {.l yview moveto xyz} msg] $msg -} {1 {expected floating-point number but got "xyz"}} -test util-1.3 {Tk_GetScrollInfo procedure} { +test util-1.1 {Tk_GetScrollInfo procedure} -body { + .l yview moveto a b +} -returnCodes error -result {wrong # args: should be ".l yview moveto fraction"} +test util-1.2 {Tk_GetScrollInfo procedure} -body { + .l yview moveto xyz +} -returnCodes error -result {expected floating-point number but got "xyz"} +test util-1.3 {Tk_GetScrollInfo procedure} -body { .l yview 0 .l yview moveto .5 .l yview -} {0.5 0.75} -test util-1.4 {Tk_GetScrollInfo procedure} { - list [catch {.l yview scroll a} msg] $msg -} {1 {wrong # args: should be ".l yview scroll number units|pages"}} -test util-1.5 {Tk_GetScrollInfo procedure} { - list [catch {.l yview scroll a b c} msg] $msg -} {1 {wrong # args: should be ".l yview scroll number units|pages"}} -test util-1.6 {Tk_GetScrollInfo procedure} { - list [catch {.l yview scroll xyz units} msg] $msg -} {1 {expected integer but got "xyz"}} -test util-1.7 {Tk_GetScrollInfo procedure} { +} -result {0.5 0.75} +test util-1.4 {Tk_GetScrollInfo procedure} -body { + .l yview scroll a +} -returnCodes error -result {wrong # args: should be ".l yview scroll number units|pages"} +test util-1.5 {Tk_GetScrollInfo procedure} -body { + .l yview scroll a b c +} -returnCodes error -result {wrong # args: should be ".l yview scroll number units|pages"} +test util-1.6 {Tk_GetScrollInfo procedure} -body { + .l yview scroll xyz units +} -returnCodes error -result {expected integer but got "xyz"} +test util-1.7 {Tk_GetScrollInfo procedure} -body { .l yview 0 .l yview scroll 2 pages .l nearest 0 -} {6} -test util-1.8 {Tk_GetScrollInfo procedure} { +} -result {6} +test util-1.8 {Tk_GetScrollInfo procedure} -body { .l yview 15 .l yview scroll -2 pages .l nearest 0 -} {9} -test util-1.9 {Tk_GetScrollInfo procedure} { +} -result {9} +test util-1.9 {Tk_GetScrollInfo procedure} -body { .l yview 0 .l yview scroll 2 units .l nearest 0 -} {2} -test util-1.10 {Tk_GetScrollInfo procedure} { +} -result {2} +test util-1.10 {Tk_GetScrollInfo procedure} -body { .l yview 15 .l yview scroll -2 units .l nearest 0 -} {13} -test util-1.11 {Tk_GetScrollInfo procedure} { - list [catch {.l yview scroll 3 zips} msg] $msg -} {1 {bad argument "zips": must be units or pages}} -test util-1.12 {Tk_GetScrollInfo procedure} { - list [catch {.l yview dropdead 3 times} msg] $msg -} {1 {unknown option "dropdead": must be moveto or scroll}} +} -result {13} +test util-1.11 {Tk_GetScrollInfo procedure} -body { + .l yview scroll 3 zips +} -returnCodes error -result {bad argument "zips": must be units or pages} +test util-1.12 {Tk_GetScrollInfo procedure} -body { + .l yview dropdead 3 times +} -returnCodes error -result {unknown option "dropdead": must be moveto or scroll} # cleanup cleanupTests return + diff --git a/tests/visual.test b/tests/visual.test index 1006e18..2f5c34a 100644 --- a/tests/visual.test +++ b/tests/visual.test @@ -7,8 +7,9 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands update @@ -18,7 +19,7 @@ update # use up all the slots in the colormap. # # Arguments: -# w - Name of toplevel window to create. +# w - Name of toplevel window to create. proc eatColors {w} { catch {destroy $w} @@ -27,12 +28,12 @@ proc eatColors {w} { canvas $w.c -width 400 -height 200 -bd 0 pack $w.c for {set y 0} {$y < 8} {incr y} { - for {set x 0} {$x < 40} {incr x} { - set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] - $w.c create rectangle [expr 10*$x] [expr 20*$y] \ - [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ - -fill $color - } + for {set x 0} {$x < 40} {incr x} { + set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] + $w.c create rectangle [expr 10*$x] [expr 20*$y] \ + [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ + -fill $color + } } update } @@ -43,14 +44,14 @@ proc eatColors {w} { # 0 otherwise. # # Arguments: -# w - Name of window in which to check. -# red, green, blue - Intensities to use in a trial color allocation -# to see if there are colormap entries free. +# w - Name of window in which to check. +# red, green, blue - Intensities to use in a trial color allocation +# to see if there are colormap entries free. proc colorsFree {w {red 31} {green 245} {blue 192}} { set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]] expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \ - && ([lindex $vals 2]/256 == $blue) + && ([lindex $vals 2]/256 == $blue) } # If more than one visual type is available for the screen, pick one @@ -61,233 +62,500 @@ set avail [winfo visualsavailable .] set other {} if {[llength $avail] > 1} { foreach visual $avail { - if {$visual != $default} { - set other $visual - break - } + if {$visual != $default} { + set other $visual + break + } } } testConstraint haveOtherVisual [expr {$other ne ""}] testConstraint havePseudocolorVisual [string match *pseudocolor* $avail] testConstraint haveMultipleVisuals [expr {[llength $avail] > 1}] -test visual-1.1 {Tk_GetVisual, copying from other window} { - list [catch {toplevel .t -visual .foo.bar} msg] $msg -} {1 {bad window path name ".foo.bar"}} -test visual-1.2 {Tk_GetVisual, copying from other window} {haveOtherVisual nonPortable} { - catch {destroy .t1} - catch {destroy .t2} +# ---------------------------------------------------------------------- + +test visual-1.1 {Tk_GetVisual, copying from other window} -body { + toplevel .t -visual .foo.bar +} -returnCodes error -result {bad window path name ".foo.bar"} +test visual-1.2 {Tk_GetVisual, copying from other window} -constraints { + haveOtherVisual nonPortable +} -setup { + deleteWindows +} -body { toplevel .t1 -width 250 -height 100 -visual $other wm geom .t1 +0+0 toplevel .t2 -width 200 -height 80 -visual .t1 wm geom .t2 +5+5 concat "[winfo visual .t2] [winfo depth .t2]" -} $other -test visual-1.3 {Tk_GetVisual, copying from other window} haveOtherVisual { - catch {destroy .t1} - catch {destroy .t2} +} -cleanup { + deleteWindows +} -result $other +test visual-1.3 {Tk_GetVisual, copying from other window} -constraints { + haveOtherVisual +} -setup { + deleteWindows +} -body { toplevel .t1 -width 250 -height 100 -visual $other wm geom .t1 +0+0 toplevel .t2 -width 200 -height 80 -visual . wm geom .t2 +5+5 concat "[winfo visual .t2] [winfo depth .t2]" -} $default +} -cleanup { + deleteWindows +} -result $default # Make sure reference count is incremented when copying visual (the # following test will cause the colormap to be freed prematurely if # the reference count isn't incremented). -test visual-1.4 {Tk_GetVisual, colormap reference count} haveOtherVisual { - catch {destroy .t1} - catch {destroy .t2} +test visual-1.4 {Tk_GetVisual, colormap reference count} -constraints { + haveOtherVisual +} -setup { + deleteWindows +} -body { toplevel .t1 -width 250 -height 100 -visual $other wm geom .t1 +0+0 - set result [list [catch {toplevel .t2 -gorp 80 -visual .t1} msg] $msg] + set result [toplevel .t2 -gorp 80 -visual .t1] update - set result -} {1 {unknown option "-gorp"}} -test visual-1.5 {Tk_GetVisual, default colormap} { - catch {destroy .t1} + return $result +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown option "-gorp"} +test visual-1.5 {Tk_GetVisual, default colormap} -setup { + deleteWindows +} -body { toplevel .t1 -width 250 -height 100 -visual default wm geometry .t1 +0+0 update concat "[winfo visual .t1] [winfo depth .t1]" -} $default +} -cleanup { + deleteWindows +} -result $default + + +test visual-2.1 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {truecolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {truecolor 24} +test visual-2.2 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {truecolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {truecolor 24} +test visual-2.3 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {truecolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {truecolor 24} +test visual-2.4 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {truecolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {truecolor 24} +test visual-2.5 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {truecolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {truecolor 24} +test visual-2.6 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {truecolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {truecolor 24} +test visual-2.7 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {truecolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {truecolor 24} +test visual-2.8 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {truecolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {truecolor 24} +test visual-2.9 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {directcolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {directcolor 24} +test visual-2.10 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {directcolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {directcolor 24} +test visual-2.11 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {directcolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {directcolor 24} +test visual-2.12 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {directcolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {directcolor 24} +test visual-2.13 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {directcolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {directcolor 24} +test visual-2.14 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {directcolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {directcolor 24} +test visual-2.15 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {directcolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {directcolor 24} +test visual-2.16 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {directcolor 24} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {directcolor 24} +test visual-2.17 {Tk_GetVisual, different visual types} -constraints { + nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual {truecolor 32} + wm geometry .t1 +0+0 + update + concat "[winfo visual .t1] [winfo depth .t1]" +} -cleanup { + deleteWindows +} -result {truecolor 32} -set i 1 -foreach visual $avail { - test visual-2.$i {Tk_GetVisual, different visual types} {nonPortable} { - catch {destroy .t1} - toplevel .t1 -width 250 -height 100 -visual $visual - wm geometry .t1 +0+0 - update - concat "[winfo visual .t1] [winfo depth .t1]" - } $visual - incr i -} -test visual-3.1 {Tk_GetVisual, parsing visual string} { - catch {destroy .t1} +test visual-3.1 {Tk_GetVisual, parsing visual string} -setup { + deleteWindows +} -body { toplevel .t1 -width 250 -height 100 \ - -visual "[winfo visual .][winfo depth .]" + -visual "[winfo visual .][winfo depth .]" wm geometry .t1 +0+0 update concat "[winfo visual .t1] [winfo depth .t1]" -} $default -test visual-3.2 {Tk_GetVisual, parsing visual string} { - catch {destroy .t1} - list [catch { - toplevel .t1 -width 250 -height 100 -visual goop20 - wm geometry .t1 +0+0 - } msg] $msg -} {1 {unknown or ambiguous visual name "goop20": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}} -test visual-3.3 {Tk_GetVisual, parsing visual string} { - catch {destroy .t1} - list [catch { - toplevel .t1 -width 250 -height 100 -visual d - wm geometry .t1 +0+0 - } msg] $msg -} {1 {unknown or ambiguous visual name "d": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}} -test visual-3.4 {Tk_GetVisual, parsing visual string} { - catch {destroy .t1} - list [catch { - toplevel .t1 -width 250 -height 100 -visual static - wm geometry .t1 +0+0 - } msg] $msg -} {1 {unknown or ambiguous visual name "static": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}} -test visual-3.5 {Tk_GetVisual, parsing visual string} { - catch {destroy .t1} - list [catch { - toplevel .t1 -width 250 -height 100 -visual "pseudocolor 48x" - wm geometry .t1 +0+0 - } msg] $msg -} {1 {expected integer but got "48x"}} +} -cleanup { + deleteWindows +} -result $default +test visual-3.2 {Tk_GetVisual, parsing visual string} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual goop20 + wm geometry .t1 +0+0 +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown or ambiguous visual name "goop20": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default} +test visual-3.3 {Tk_GetVisual, parsing visual string} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual d + wm geometry .t1 +0+0 +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown or ambiguous visual name "d": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default} +test visual-3.4 {Tk_GetVisual, parsing visual string} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual static + wm geometry .t1 +0+0 +} -cleanup { + deleteWindows +} -returnCodes error -result {unknown or ambiguous visual name "static": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default} +test visual-3.5 {Tk_GetVisual, parsing visual string} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual "pseudocolor 48x" + wm geometry .t1 +0+0 +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "48x"} -test visual-4.1 {Tk_GetVisual, numerical visual id} -setup { - catch {destroy .t1} - catch {destroy .t2} - catch {destroy .t3} + +test visual-4.1 {Tk_GetVisual, numerical visual id} -constraints { + haveOtherVisual nonPortable +} -setup { + deleteWindows toplevel .t1 -width 250 -height 100 -visual $other wm geom .t1 +0+0 toplevel .t2 -width 200 -height 80 -visual [winfo visual .] wm geom .t2 +5+5 toplevel .t3 -width 150 -height 250 -visual [winfo visual .t1] wm geom .t3 +10+10 -} -constraints {haveOtherVisual nonPortable} -body { +} -body { set v1 [list [winfo visualid .t2] [winfo visualid .t3]] set v2 [list [winfo visualid .] [winfo visualid .t1]] expr {$v1 eq $v2 ? "OK" : "[list $v1] ne [list $v2]"} -} -result OK -cleanup { - destroy .t1 .t2 .t3 -} -test visual-4.2 {Tk_GetVisual, numerical visual id} { - catch {destroy .t1} - list [catch {toplevel .t1 -visual 12xyz} msg] $msg -} {1 {bad X identifier for visual: "12xyz"}} -test visual-4.3 {Tk_GetVisual, numerical visual id} { - catch {destroy .t1} - list [catch {toplevel .t1 -visual 1291673} msg] $msg -} {1 {couldn't find an appropriate visual}} +} -cleanup { + deleteWindows +} -result OK +test visual-4.2 {Tk_GetVisual, numerical visual id} -setup { + deleteWindows +} -body { + toplevel .t1 -visual 12xyz +} -cleanup { + deleteWindows +} -returnCodes error -result {bad X identifier for visual: "12xyz"} +test visual-4.3 {Tk_GetVisual, numerical visual id} -setup { + deleteWindows +} -body { + toplevel .t1 -visual 1291673 +} -cleanup { + deleteWindows +} -returnCodes error -result {couldn't find an appropriate visual} + -test visual-5.1 {Tk_GetVisual, no matching visual} !havePseudocolorVisual { - catch {destroy .t1} - list [catch { - toplevel .t1 -width 250 -height 100 -visual "pseudocolor 8" - wm geometry .t1 +0+0 - } msg] $msg -} {1 {couldn't find an appropriate visual}} +test visual-5.1 {Tk_GetVisual, no matching visual} -constraints { + !havePseudocolorVisual +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 250 -height 100 -visual "pseudocolor 8" + wm geometry .t1 +0+0 +} -cleanup { + deleteWindows +} -returnCodes error -result {couldn't find an appropriate visual} -test visual-6.1 {Tk_GetVisual, no matching visual} {havePseudocolorVisual haveMultipleVisuals nonPortable} { - catch {destroy .t1} + +test visual-6.1 {Tk_GetVisual, no matching visual} -constraints { + havePseudocolorVisual haveMultipleVisuals nonPortable +} -setup { + deleteWindows +} -body { toplevel .t1 -width 250 -height 100 -visual "best" wm geometry .t1 +0+0 update winfo visual .t1 -} {pseudocolor} +} -cleanup { + deleteWindows +} -result {pseudocolor} + # These tests are non-portable due to variations in how many colors # are already in use on the screen. - -if {[testConstraint defaultPseudocolor8]} { +test visual-7.1 {Tk_GetColormap, "new"} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { eatColors .t1 -} -test visual-7.1 {Tk_GetColormap, "new"} {defaultPseudocolor8 nonPortable} { toplevel .t2 -width 30 -height 20 wm geom .t2 +0+0 update colorsFree .t2 -} {0} -test visual-7.2 {Tk_GetColormap, "new"} {defaultPseudocolor8 nonPortable} { - catch {destroy .t2} +} -cleanup { + deleteWindows +} -result {0} +test visual-7.2 {Tk_GetColormap, "new"} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { + eatColors .t1 toplevel .t2 -width 30 -height 20 -colormap new wm geom .t2 +0+0 update colorsFree .t2 -} {1} -test visual-7.3 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 nonPortable} { - catch {destroy .t2} +} -cleanup { + deleteWindows +} -result {1} +test visual-7.3 {Tk_GetColormap, copy from other window} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { + eatColors .t1 toplevel .t3 -width 400 -height 50 -colormap new wm geom .t3 +0+0 - catch {destroy .t2} toplevel .t2 -width 30 -height 20 -colormap .t3 wm geom .t2 +0+0 update destroy .t3 colorsFree .t2 -} {1} -test visual-7.4 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 nonPortable} { - catch {destroy .t2} +} -cleanup { + deleteWindows +} -result {1} +test visual-7.4 {Tk_GetColormap, copy from other window} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { + eatColors .t1 toplevel .t3 -width 400 -height 50 -colormap new wm geom .t3 +0+0 - catch {destroy .t2} toplevel .t2 -width 30 -height 20 -colormap . wm geom .t2 +0+0 update destroy .t3 colorsFree .t2 -} {0} -test visual-7.5 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 nonPortable} { - catch {destroy .t1} - list [catch { - toplevel .t1 -width 400 -height 50 -colormap .choke.lots - } msg] $msg -} {1 {bad window path name ".choke.lots"}} -test visual-7.6 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 haveOtherVisual nonPortable} { - catch {destroy .t1} - catch {destroy .t2} +} -cleanup { + deleteWindows +} -result {0} +test visual-7.5 {Tk_GetColormap, copy from other window} -constraints { + defaultPseudocolor8 nonPortable +} -setup { + deleteWindows +} -body { + toplevel .t1 -width 400 -height 50 -colormap .choke.lots +} -cleanup { + deleteWindows +} -returnCodes error -result {bad window path name ".choke.lots"} +test visual-7.6 {Tk_GetColormap, copy from other window} -constraints { + defaultPseudocolor8 haveOtherVisual nonPortable +} -setup { + deleteWindows +} -body { toplevel .t1 -width 300 -height 150 -visual $other wm geometry .t1 +0+0 - list [catch {toplevel .t2 -width 400 -height 50 -colormap .t1} msg] $msg -} {1 {can't use colormap for .t1: incompatible visuals}} -if {[testConstraint defaultPseudocolor8]} { - catch {destroy .t1} - catch {destroy .t2} -} + toplevel .t2 -width 400 -height 50 -colormap .t1 +} -cleanup { + deleteWindows +} -returnCodes error -result {can't use colormap for .t1: incompatible visuals} + -test visual-8.1 {Tk_FreeColormap procedure} { +test visual-8.1 {Tk_FreeColormap procedure} -setup { deleteWindows +} -body { toplevel .t1 -width 300 -height 180 -colormap new wm geometry .t1 +0+0 foreach i {.t2 .t3 .t4} { - toplevel $i -width 250 -height 150 -colormap .t1 - wm geometry $i +0+0 + toplevel $i -width 250 -height 150 -colormap .t1 + wm geometry $i +0+0 } destroy .t1 destroy .t3 destroy .t4 update -} {} -test visual-8.2 {Tk_FreeColormap procedure} haveOtherVisual { +} -cleanup { deleteWindows +} -result {} +test visual-8.2 {Tk_FreeColormap procedure} -constraints haveOtherVisual -setup { + deleteWindows +} -body { toplevel .t1 -width 300 -height 180 -visual $other wm geometry .t1 +0+0 foreach i {.t2 .t3 .t4} { - toplevel $i -width 250 -height 150 -visual $other - wm geometry $i +0+0 + toplevel $i -width 250 -height 150 -visual $other + wm geometry $i +0+0 } destroy .t2 destroy .t3 destroy .t4 update -} {} +} -cleanup { + deleteWindows +} -result {} + deleteWindows rename eatColors {} @@ -296,3 +564,7 @@ rename colorsFree {} # cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/visual_bb.test b/tests/visual_bb.test index 6b10f76..2b06d05 100644 --- a/tests/visual_bb.test +++ b/tests/visual_bb.test @@ -6,10 +6,12 @@ # at the window to make sure it appears as expected. Individual tests # are kept in separate ".tcl" files in this directory. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands + set auto_path ". $auto_path" wm title . "Visual Tests for Tk" @@ -21,8 +23,8 @@ proc runTest {file} { global testNum test "2.$testNum" "testing $file" {userInteraction} { - uplevel \#0 source [file join [testsDirectory] $file] - concat "" + uplevel \#0 source [file join [testsDirectory] $file] + concat "" } {} incr testNum } @@ -38,7 +40,9 @@ proc end {} { set ::EndOfVisualTests 1 } -test 1.1 "running visual tests" {userInteraction} { +# ---------------------------------------------------------------------- + +test 1.1 {running visual tests} -constraints userInteraction -body { #------------------------------------------------------- # The code below create the main window, consisting of a # menu bar and a message explaining the basic operation @@ -47,8 +51,8 @@ test 1.1 "running visual tests" {userInteraction} { frame .menu -relief raised -borderwidth 1 message .msg -font {Times 18} -relief raised -width 4i \ - -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit. Each menu entry invokes a test, which displays information on the screen. You can then verify visually that the information is being displayed in the correct way. The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets." - + -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit. Each menu entry invokes a test, which displays information on the screen. You can then verify visually that the information is being displayed in the correct way. The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets." + pack .menu -side top -fill x pack .msg -side bottom -expand yes -fill both @@ -60,40 +64,40 @@ test 1.1 "running visual tests" {userInteraction} { menubutton .menu.file -text "File" -menu .menu.file.m menu .menu.file.m .menu.file.m add command -label "Quit" -command end - + menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m menu .menu.group1.m .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl} .menu.group1.m add command -label "Beveled borders in text widgets" \ - -command {runTest bevel.tcl} + -command {runTest bevel.tcl} .menu.group1.m add command -label "Colormap management" \ - -command {runTest cmap.tcl} + -command {runTest cmap.tcl} .menu.group1.m add command -label "Label/button geometry" \ - -command {runTest butGeom.tcl} + -command {runTest butGeom.tcl} .menu.group1.m add command -label "Label/button colors" \ - -command {runTest butGeom2.tcl} - + -command {runTest butGeom2.tcl} + menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m menu .menu.ps.m .menu.ps.m add command -label "Rectangles and other graphics" \ - -command {runTest canvPsGrph.tcl} + -command {runTest canvPsGrph.tcl} .menu.ps.m add command -label "Text" \ - -command {runTest canvPsText.tcl} + -command {runTest canvPsText.tcl} .menu.ps.m add command -label "Bitmaps" \ - -command {runTest canvPsBmap.tcl} + -command {runTest canvPsBmap.tcl} .menu.ps.m add command -label "Images" \ - -command {runTest canvPsImg.tcl} + -command {runTest canvPsImg.tcl} .menu.ps.m add command -label "Arcs" \ - -command {runTest canvPsArc.tcl} - + -command {runTest canvPsArc.tcl} + pack .menu.file .menu.group1 .menu.ps -side left -padx 1m - + # Set up for keyboard-based menu traversal - + bind . <Any-FocusIn> { - if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} { - focus .menu - } + if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} { + focus .menu + } } tk_menuBar .menu .menu.file .menu.group1 .menu.ps @@ -103,7 +107,7 @@ test 1.1 "running visual tests" {userInteraction} { bind Canvas <1> {%W delete [%W find closest %x %y]} concat "" -} {} +} -result {} if {![testConstraint userInteraction]} { cleanupTests diff --git a/tests/winButton.test b/tests/winButton.test index 5bf6867..88b4345 100644 --- a/tests/winButton.test +++ b/tests/winButton.test @@ -8,77 +8,97 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands +imageInit proc bogusTrace args { error "trace aborted" } -catch {unset value} -catch {unset value2} option clear -eval image delete [image names] -if {[testConstraint testImageType]} { - image create test image1 -} -label .l -text Label -button .b -text Button -checkbutton .c -text Checkbutton -radiobutton .r -text Radiobutton -pack .l .b .c .r -update -test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType win} { +# ---------------------------------------------------------------------- + +test winbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints { + testImageType win nonPortable +} -setup { + # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen + # the smallest size (i.e. 8) is not available for "MS Sans Serif" font deleteWindows +} -body { image create test image1 image1 changed 0 0 0 0 60 40 label .b1 -image image1 -bd 4 -padx 0 -pady 2 button .b2 -image image1 -bd 4 -padx 0 -pady 2 - checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1 -font {{MS Sans Serif} 8} - radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0 -font {{MS Sans Serif} 8} + checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1 \ + -font {{MS Sans Serif} 8} + radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0 \ + -font {{MS Sans Serif} 8} pack .b1 .b2 .b3 .b4 update # with patch 463234 with native L&F enabled, this returns: # {68 48 70 50 88 50 88 50} list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {68 48 70 50 90 52 90 52} -test winbutton-1.2 {TkpComputeButtonGeometry procedure} win { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { deleteWindows + image delete image1 +} -result {68 48 70 50 90 52 90 52} + +test winbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints { + win nonPortable +} -setup { + # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen + # the smallest size (i.e. 8) is not available for "MS Sans Serif" font + deleteWindows +} -body { label .b1 -bitmap question -bd 3 -padx 0 -pady 2 button .b2 -bitmap question -bd 3 -padx 0 -pady 2 - checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1 -font {{MS Sans Serif} 8} - radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0 -font {{MS Sans Serif} 8} + checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1 \ + -font {{MS Sans Serif} 8} + radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0 \ + -font {{MS Sans Serif} 8} pack .b1 .b2 .b3 .b4 update # with patch 463234 with native L&F enabled, this returns: # {23 33 25 35 43 35 43 35} list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {23 33 25 35 45 37 45 37} -test winbutton-1.3 {TkpComputeButtonGeometry procedure} win { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { deleteWindows +} -result {23 33 25 35 45 37 45 37} + +test winbutton-1.3 {TkpComputeButtonGeometry procedure} -constraints win -setup { + deleteWindows +} -body { label .b1 -bitmap question -bd 3 -highlightthickness 4 button .b2 -bitmap question -bd 3 -highlightthickness 0 checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \ - -indicatoron 0 + -indicatoron 0 radiobutton .b4 -bitmap question -bd 3 -indicatoron false pack .b1 .b2 .b3 .b4 update # with patch 463234 with native L&F enabled, this returns: # {31 41 23 33 25 35 25 35} list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {31 41 23 33 27 37 27 37} -test winbutton-1.4 {TkpComputeButtonGeometry procedure} {win nonPortable} { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { + deleteWindows +} -result {31 41 23 33 27 37 27 37} + +test winbutton-1.4 {TkpComputeButtonGeometry procedure} -constraints { + win nonPortable +} -setup { deleteWindows +} -body { label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8} @@ -86,26 +106,46 @@ test winbutton-1.4 {TkpComputeButtonGeometry procedure} {win nonPortable} { pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {58 24 67 33 88 30 90 28} -test winbutton-1.5 {TkpComputeButtonGeometry procedure} {win nonPortable} { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { + deleteWindows +} -result {58 24 67 33 88 30 90 28} + +test winbutton-1.5 {TkpComputeButtonGeometry procedure} -constraints { + win nonPortable +} -setup { deleteWindows - label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0 +} -body { + label .l1 -wraplength 1.5i -padx 0 -pady 0 \ + -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." pack .l1 update list [winfo reqwidth .l1] [winfo reqheight .l1] -} {178 84} -test winbutton-1.6 {TkpComputeButtonGeometry procedure} {win nonPortable} { +} -cleanup { deleteWindows - label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0 +} -result {178 84} + +test winbutton-1.6 {TkpComputeButtonGeometry procedure} -constraints { + win nonPortable +} -setup { + deleteWindows +} -body { + label .l1 -padx 0 -pady 0 \ + -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." pack .l1 update list [winfo reqwidth .l1] [winfo reqheight .l1] -} {222 52} -test winbutton-1.7 {TkpComputeButtonGeometry procedure} {win nonPortable} { +} -cleanup { + deleteWindows +} -result {222 52} + +test winbutton-1.7 {TkpComputeButtonGeometry procedure} -constraints { + win nonPortable +} -setup { deleteWindows +} -body { label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5 checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2 @@ -113,33 +153,51 @@ test winbutton-1.7 {TkpComputeButtonGeometry procedure} {win nonPortable} { pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {74 24 67 97 174 46 64 28} -test winbutton-1.8 {TkpComputeButtonGeometry procedure} {win nonPortable} { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { + deleteWindows +} -result {74 24 67 97 174 46 64 28} + +test winbutton-1.8 {TkpComputeButtonGeometry procedure} -constraints { + win nonPortable +} -setup { deleteWindows +} -body { label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \ - -highlightthickness 4 + -highlightthickness 4 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \ - -highlightthickness 0 + -highlightthickness 0 checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 \ - -highlightthickness 1 -indicatoron no + -highlightthickness 1 -indicatoron no radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ - [winfo reqwidth .b2] [winfo reqheight .b2] \ - [winfo reqwidth .b3] [winfo reqheight .b3] \ - [winfo reqwidth .b4] [winfo reqheight .b4] -} {66 32 65 31 69 31 71 29} -test winbutton-1.9 {TkpComputeButtonGeometry procedure} win { + [winfo reqwidth .b2] [winfo reqheight .b2] \ + [winfo reqwidth .b3] [winfo reqheight .b3] \ + [winfo reqwidth .b4] [winfo reqheight .b4] +} -cleanup { deleteWindows +} -result {66 32 65 31 69 31 71 29} + +test winbutton-1.9 {TkpComputeButtonGeometry procedure} -constraints win -setup { + deleteWindows +} -body { button .b2 -bitmap question -default normal list [winfo reqwidth .b2] [winfo reqheight .b2] -} {23 33} +} -cleanup { + deleteWindows +} -result {23 33} # cleanup +imageFinish deleteWindows cleanupTests return + +# Local variables: +# mode: tcl +# End: + diff --git a/tests/winClipboard.test b/tests/winClipboard.test index ec84362..2a7ad73 100644 --- a/tests/winClipboard.test +++ b/tests/winClipboard.test @@ -10,67 +10,113 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test # Note that these tests may fail if another application is grabbing the # clipboard (e.g. an X server) -test winClipboard-1.1 {TkSelGetSelection} win { +test winClipboard-1.1 {TkSelGetSelection} -constraints win -setup { clipboard clear - catch {selection get -selection CLIPBOARD} msg - set msg -} {CLIPBOARD selection doesn't exist or form "STRING" not defined} -test winClipboard-1.2 {TkSelGetSelection} {win testclipboard} { +} -body { + selection get -selection CLIPBOARD +} -cleanup { clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "STRING" not defined} + +test winClipboard-1.2 {TkSelGetSelection} -constraints { + win testclipboard +} -setup { + clipboard clear +} -body { clipboard append {} - catch {selection get -selection CLIPBOARD} r1 - catch {testclipboard} r2 - list $r1 $r2 -} {{} {}} -test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {win testclipboard} { + list [selection get -selection CLIPBOARD] [testclipboard] +} -cleanup { + clipboard clear +} -result {{} {}} + +test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} -constraints { + win testclipboard +} -setup { clipboard clear +} -body { clipboard append abcd update - catch {selection get -selection CLIPBOARD} r1 - catch {testclipboard} r2 - list $r1 $r2 -} {abcd abcd} -test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {win testclipboard} { + list [selection get -selection CLIPBOARD] [testclipboard] +} -cleanup { clipboard clear +} -result {abcd abcd} + +test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} -constraints { + win testclipboard +} -setup { + clipboard clear +} -body { + set map [list "\r" "\\r" "\n" "\\n"] clipboard append "line 1\nline 2" - catch {selection get -selection CLIPBOARD} r1 - catch {testclipboard} r2 - list $r1 $r2 -} [list "line 1\nline 2" "line 1\r\nline 2"] -test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {win testclipboard} { + list [string map $map [selection get -selection CLIPBOARD]]\ + [string map $map [testclipboard]] +} -cleanup { + clipboard clear +} -result [list "line 1\\nline 2" "line 1\\nline 2"] + +test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} -constraints { + win testclipboard +} -setup { clipboard clear +} -body { + set map [list "\r" "\\r" "\n" "\\n"] clipboard append "line 1\u00c7\nline 2" - catch {selection get -selection CLIPBOARD} r1 - catch {testclipboard} r2 - list $r1 $r2 -} [list "line 1\u00c7\nline 2" [bytestring "line 1\u00c7\r\nline 2"]] + list [string map $map [selection get -selection CLIPBOARD]]\ + [string map $map [testclipboard]] +} -cleanup { + clipboard clear +} -result [list "line 1\u00c7\\nline 2" "line 1\u00c7\\nline 2"] + +test winClipboard-1.6 {TkSelGetSelection & TkWinClipboardRender} -constraints { + win testclipboard +} -setup { + clipboard clear +} -body { + clipboard append "\u043f\u0440\u0438\u0432\u0435\u0442 \u043c\u0438\u0444" + list [selection get -selection CLIPBOARD] [testclipboard] +} -cleanup { + clipboard clear +} -result [list "\u043f\u0440\u0438\u0432\u0435\u0442 \u043c\u0438\u0444"\ + "\u043f\u0440\u0438\u0432\u0435\u0442 \u043c\u0438\u0444"] -test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {win testclipboard} { +test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} -constraints { + win testclipboard +} -setup { clipboard clear +} -body { clipboard append -type OUR_ACTION "action data" clipboard append "string data" update - catch {selection get -selection CLIPBOARD -type OUR_ACTION} r1 - catch {testclipboard} r2 - list $r1 $r2 -} [list "action data" "string data"] -test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {win testclipboard} { + list [selection get -selection CLIPBOARD -type OUR_ACTION] [testclipboard] +} -cleanup { clipboard clear +} -result {{action data} {string data}} + +test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} -constraints { + win testclipboard +} -setup { + clipboard clear +} -body { clipboard append -type OUR_ACTION "new data" clipboard append "more data in string" update - catch {testclipboard} r1 - catch {selection get -selection CLIPBOARD -type OUR_ACTION} r2 - list $r1 $r2 -} [list "more data in string" "new data"] + list [testclipboard] [selection get -selection CLIPBOARD -type OUR_ACTION] +} -cleanup { + clipboard clear +} -result {{more data in string} {new data}} # cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/winDialog.test b/tests/winDialog.test index bb515af..c8c36bf 100644..100755 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -7,8 +7,9 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 1998-1999 ActiveState Corporation. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands if {[testConstraint testwinevent]} { @@ -21,9 +22,26 @@ testConstraint english [expr { && (([testwinlocale] & 0xff) == 9) }] +proc vista? {{prevista 0} {postvista 1}} { + lassign [split $::tcl_platform(osVersion) .] major + return [expr {$major >= 6 ? $postvista : $prevista}] +} + +# What directory to use in initialdir tests. Old code used to use +# c:/. However, on Vista/later that is a protected directory if you +# are not running privileged. Moreover, not everyone has a drive c: +# but not having a TEMP would break a lot Windows programs +proc initialdir {} { + # file join to return in Tcl canonical format (/ separator, not \) + #return [file join $::env(TEMP)] + return [tcltest::temporaryDirectory] +} + + proc start {arg} { set ::tk_dialog 0 set ::iter_after 0 + set ::dialogclass "#32770" after 1 $arg } @@ -31,20 +49,37 @@ proc start {arg} { proc then {cmd} { set ::command $cmd set ::dialogresult {} + set ::testfont {} - afterbody + # Do not make the delay too short. The newer Vista dialogs take + # time to come up. Even if the testforwindow returns true, the + # controls are not ready to accept messages + after 500 afterbody vwait ::dialogresult return $::dialogresult } proc afterbody {} { - if {$::tk_dialog == 0} { - if {[incr ::iter_after] > 30} { - set ::dialogresult ">30 iterations waiting on tk_dialog" - return - } - after 150 {afterbody} - return + # On Vista and later, using the new file dialogs we have to find + # the window using its title as tk_dialog will not be set at the C level + if {[vista?]} { + if {[catch {testfindwindow "" $::dialogclass} ::tk_dialog]} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } + after 150 {afterbody} + return + } + } else { + if {$::tk_dialog == 0} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } + after 150 {afterbody} + return + } } uplevel #0 {set dialogresult [eval $command]} } @@ -70,6 +105,12 @@ proc SetText {id text} { return [testwinevent $::tk_dialog $id WM_SETTEXT $text] } +proc ApplyFont {font} { + set ::testfont $font +} + +# ---------------------------------------------------------------------- + test winDialog-1.1 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { @@ -156,13 +197,15 @@ test winDialog-1.7 {Tk_ChooseColorObjCmd: -parent} -constraints { } -returnCodes error -match glob -result {bad window path name*} +test winDialog-2.1 {ColorDlgHookProc} -constraints {emptyTest nt} -body {} + test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints { nt testwinevent english } -body { start {tk_getOpenFile} then { - set x [GetText cancel] - Click cancel + set x [GetText cancel] + Click cancel } return $x } -result {Cancel} @@ -173,8 +216,8 @@ test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints { } -body { start {tk_getSaveFile} then { - set x [GetText cancel] - Click cancel + set x [GetText cancel] + Click cancel } return $x } -result {Cancel} @@ -184,7 +227,7 @@ test winDialog-5.1 {GetFileName: no arguments} -constraints { } -body { start {tk_getOpenFile -title Open} then { - Click cancel + Click cancel } } -result {0} test winDialog-5.2 {GetFileName: one argument} -constraints { @@ -195,9 +238,9 @@ test winDialog-5.2 {GetFileName: one argument} -constraints { test winDialog-5.3 {GetFileName: many arguments} -constraints { nt testwinevent } -body { - start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} + start {tk_getOpenFile -initialdir [initialdir] -parent . -title test -initialfile foo} then { - Click cancel + Click cancel } } -result {0} test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints { @@ -208,158 +251,520 @@ test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints { test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints { nt testwinevent } -body { - start {tk_getOpenFile -title bar} - then { - Click cancel - } + start {set x [tk_getOpenFile -title bar]} + set y [then { + Click cancel + }] + # Note this also tests fix for + # http://core.tcl.tk/tk/tktview/4a0451f5291b3c9168cc560747dae9264e1d2ef6 + # $x is expected to be empty + append x $y } -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 { - if {[catch {SetText 0x47C bar} msg]} { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.foo + +test winDialog-5.7.1 {GetFileName: extension {} } -constraints { + nt testwinevent +} -body { + start {set x [tk_getSaveFile -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar + +test winDialog-5.7.2 {GetFileName: extension {} Bug 47af31bd3ac6fbbb33cde1a5bab1e756ff2a6e00 } -constraints { + nt testwinevent +} -body { + start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar + +test winDialog-5.7.3 {GetFileName: extension {} Bug 47af31bd3ac6fbbb33cde1a5bab1e756ff2a6e00 } -constraints { + nt testwinevent +} -body { + start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar.c} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.c + +test winDialog-5.7.4 {GetFileName: extension {} } -constraints { + nt testwinevent +} -body { + # Although the docs do not explicitly mention, -filetypes seems to + # override -defaultextension + start {set x [tk_getSaveFile -filetypes {{C .c} {Tcl .tcl}} -defaultextension {foo} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { Click cancel } else { Click ok } } - return [string totitle $x]$msg + set x "[file tail $x]$msg" } -cleanup { unset msg -} -result [string totitle [file join [pwd] bar.foo]] +} -result bar.c + +test winDialog-5.7.5 {GetFileName: extension {} } -constraints { + nt testwinevent +} -body { + # Although the docs do not explicitly mention, -filetypes seems to + # override -defaultextension + start {set x [tk_getSaveFile -filetypes {{C .c} {Tcl .tcl}} -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.c + + +test winDialog-5.7.6 {GetFileName: All/extension } -constraints { + nt testwinevent +} -body { + # In 8.6.4 this combination resulted in bar.ext.ext which is bad + start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {ext} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.ext + +test winDialog-5.7.7 {tk_getOpenFile: -defaultextension} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 7 7.ext" [initialdir] + start {set x [tk_getOpenFile \ + -defaultextension ext \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 7 7" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 7 7.ext"] + +test winDialog-5.7.8 {tk_getOpenFile: -defaultextension} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 7 8.ext" [initialdir] + start {set x [tk_getOpenFile \ + -defaultextension ext \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 7 8.ext" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 7 8.ext"] + 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 { - if {[catch {SetText 0x47C bar} msg]} { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { Click cancel } else { Click ok } } - return [string totitle $x]$msg + set x "[file tail $x]$msg" } -cleanup { unset msg -} -result [string totitle [file join [pwd] bar.foo]] +} -result bar.foo test winDialog-5.9 {GetFileName: file types} -constraints { nt testwinevent } -body { -# case FILE_TYPES: - + # case FILE_TYPES: + start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} - then { - set x [GetText 0x470] - Click cancel + # XXX - currently disabled for vista style dialogs because the file + # types control has no control ID and we don't have a mechanism to + # locate it. + if {[vista?]} { + then { + Click cancel + } + return 1 + } else { + then { + set x [GetText 0x470] + Click cancel + } + return [string equal $x {foo files (*.foo)}] } - return $x -} -result {foo files (*.foo)} +} -result 1 test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints { nt } -body { -# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) +# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) tk_getSaveFile -filetypes {{"foo" .foo FOO}} } -returnCodes error -result {bad Macintosh file type "FOO"} -if {[info exists ::env(TEMP)]} { test winDialog-5.11 {GetFileName: initial directory} -constraints { nt testwinevent } -body { -# case FILE_INITDIR: - +# case FILE_INITDIR: + unset -nocomplain x start {set x [tk_getSaveFile \ - -initialdir [file normalize $::env(TEMP)] \ + -initialdir [initialdir] \ -initialfile "12x 455" -title Foo]} then { - Click ok + Click ok } return $x -} -result [file join [file normalize $::env(TEMP)] "12x 455"] -} +} -result [file join [initialdir] "12x 455"] + test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { -# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) +# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) tk_getOpenFile -initialdir ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} + +test winDialog-5.12.1 {tk_getSaveFile: initial directory: ~} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir ~ \ + -initialfile "5 12 1" -title Foo]} + then { + Click ok + } + return $x +} -result [file normalize [file join ~ "5 12 1"]] + +test winDialog-5.12.2 {tk_getSaveFile: initial directory: ~user} -constraints { + nt testwinevent +} -body { + + # Note: this test will fail on Tcl versions 8.6.4 and earlier due + # to a bug in file normalize for names of the form ~xxx that + # returns the wrong dir on Windows. In particular (in Win8 at + # least) it returned /users/Default instead of /users/USERNAME... + + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir ~$::tcl_platform(user) \ + -initialfile "5 12 2" -title Foo]} + then { + Click ok + } + return $x +} -result [file normalize [file join ~$::tcl_platform(user) "5 12 2"]] + +test winDialog-5.12.3 {tk_getSaveFile: initial directory: .} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set newdir [tcltest::makeDirectory "5 12 3"] + set cur [pwd] + try { + cd $newdir + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir . \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x [file join $newdir testfile] +} -result 1 + +test winDialog-5.12.4 {tk_getSaveFile: initial directory: unicode} -constraints { + nt testwinevent +} -body { + set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"] + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir $dir \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + string equal $x [file join $dir testfile] +} -result 1 + +test winDialog-5.12.5 {tk_getSaveFile: initial directory: nativename} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 12 5" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 12 5"] + +test winDialog-5.12.6 {tk_getSaveFile: initial directory: relative} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set dir [tcltest::makeDirectory "5 12 6"] + set cur [pwd] + try { + cd [file dirname $dir] + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir "5 12 6" \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x [file join $dir testfile] +} -result 1 + +test winDialog-5.12.7 {tk_getOpenFile: initial directory: ~} -constraints { + nt testwinevent +} -body { + set fn [file tail [lindex [glob -types f ~/*] 0]] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir ~ \ + -initialfile $fn -title Foo]} + then { + Click ok + } + string equal $x [file normalize [file join ~ $fn]] +} -result 1 + +test winDialog-5.12.8 {tk_getOpenFile: initial directory: .} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set newdir [tcltest::makeDirectory "5 12 8"] + set path [tcltest::makeFile "" "testfile" $newdir] + set cur [pwd] + try { + cd $newdir + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir . \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x $path +} -result 1 + +test winDialog-5.12.9 {tk_getOpenFile: initial directory: unicode} -constraints { + nt testwinevent +} -body { + set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"] + set path [tcltest::makeFile "" testfile $dir] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir $dir \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + string equal $x $path +} -result 1 + +test winDialog-5.12.10 {tk_getOpenFile: initial directory: nativename} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 12 10" [initialdir] + start {set x [tk_getOpenFile \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 12 10" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 12 10"] + +test winDialog-5.12.11 {tk_getOpenFile: initial directory: relative} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set dir [tcltest::makeDirectory "5 12 11"] + set path [tcltest::makeFile "" testfile $dir] + set cur [pwd] + try { + cd [file dirname $dir] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir [file tail $dir] \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x $path +} -result 1 + test winDialog-5.13 {GetFileName: initial file} -constraints { nt testwinevent } -body { -# case FILE_INITFILE: +# case FILE_INITFILE: start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} then { - Click ok + Click ok } - string totitle $x -} -result [string totitle [file join [pwd] "12x 456"]] + file tail $x +} -result "12x 456" test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints { nt } -body { -# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) +# 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] - } - then { - Click ok - } - list $dialogresult [string match "invalid filename *" $x] -} -result {1 1} +if {![vista?]} { + # XXX - disabled for Vista because the new dialogs allow long file + # names to be specified but force the user to change it. + 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] + } + then { + Click ok + } + list $dialogresult [string match "invalid filename *" $x] + } -result {1 1} +} test winDialog-5.16 {GetFileName: parent} -constraints { nt } -body { -# case FILE_PARENT: +# case FILE_PARENT: toplevel .t set x 0 start {tk_getOpenFile -parent .t -title Parent; set x 1} then { - destroy .t + destroy .t } return $x } -result {1} test winDialog-5.17 {GetFileName: title} -constraints { nt testwinevent } -body { -# case FILE_TITLE: - +# case FILE_TITLE: + start {tk_getOpenFile -title Narf} then { - Click cancel + Click cancel } } -result {0} -test winDialog-5.18 {GetFileName: no filter specified} -constraints { - nt testwinevent -} -body { -# if (ofn.lpstrFilter == NULL) +if {[vista?]} { + # In the newer file dialogs, the file type widget does not even exist + # if no file types specified + test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent + } -body { + # if (ofn.lpstrFilter == NULL) + start {tk_getOpenFile -title Filter} + then { + catch {set x [GetText 0x470]} y + Click cancel + } + return $y + } -result {Could not find control with id 1136} +} else { + test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent + } -body { + # if (ofn.lpstrFilter == NULL) - start {tk_getOpenFile -title Filter} - then { - set x [GetText 0x470] - Click cancel - } - return $x -} -result {All Files (*.*)} + start {tk_getOpenFile -title Filter} + then { + set x [GetText 0x470] + Click cancel + } + return $x + } -result {All Files (*.*)} +} test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints { nt } -setup { @@ -370,7 +775,7 @@ test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints { toplevel .t start {tk_getOpenFile -parent .t -title Open} then { - destroy .t + destroy .t } } -result {} test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints { @@ -382,42 +787,41 @@ test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints { update start {tk_getOpenFile -parent .t -title Open} then { - destroy .t + destroy .t } } -result {} test winDialog-5.21 {GetFileName: call GetOpenFileName} -constraints { nt testwinevent english } -body { -# winCode = GetOpenFileName(&ofn); - +# winCode = GetOpenFileName(&ofn); + start {tk_getOpenFile -title Open} then { - set x [GetText ok] - Click cancel + set x [GetText ok] + Click cancel } return $x } -result {&Open} test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints { nt testwinevent english } -body { -# winCode = GetSaveFileName(&ofn); +# winCode = GetSaveFileName(&ofn); start {tk_getSaveFile -title Save} then { - set x [GetText ok] - Click cancel + set x [GetText ok] + Click cancel } return $x } -result {&Save} -if {[info exists ::env(TEMP)]} { test winDialog-5.23 {GetFileName: convert \ to /} -constraints { nt testwinevent } -body { set msg {} start {set x [tk_getSaveFile -title Back]} then { - if {[catch {SetText 0x47C [file nativename \ - [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} { + if {[catch {SetText [vista? 0x47C 0x3e9] [file nativename \ + [file join [initialdir] "12x 457"]]} msg]} { Click cancel } else { Click ok @@ -426,8 +830,7 @@ test winDialog-5.23 {GetFileName: convert \ to /} -constraints { return $x$msg } -cleanup { unset msg -} -result [file join [file normalize $::env(TEMP)] "12x 457"] -} +} -result [file join [initialdir] "12x 457"] test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraints { nt } -body { @@ -435,7 +838,7 @@ test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraint start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0}}}}]} then { - Click cancel + Click cancel } return $x } -result {0} @@ -446,11 +849,21 @@ test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraint start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]} then { - Click cancel + Click cancel } return $x } -result {0} + +test winDialog-6.1 {MakeFilter} -constraints {emptyTest nt} -body {} + + +test winDialog-7.1 {Tk_MessageBoxObjCmd} -constraints {emptyTest nt} -body {} + + +test winDialog-8.1 {OFNHookProc} -constraints {emptyTest nt} -body {} + + ## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows ## because somehow the GetOpenFileName ends up a noop in the static ## build. @@ -458,10 +871,12 @@ test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraint test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} -constraints { nt testwinevent } -body { - start {tk_chooseDirectory} - then { - Click cancel - } + start {set x [tk_chooseDirectory]} + set y [then { + Click cancel + }] + # $x should be "" on a Cancel + append x $y } -result {0} test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints { nt @@ -472,10 +887,10 @@ test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints { nt testwinevent } -body { start { - tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test + tk_chooseDirectory -initialdir [initialdir] -mustexist 1 -parent . -title test } then { - Click cancel + Click cancel } } -result {0} test winDialog-9.4 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} -constraints { @@ -488,7 +903,7 @@ test winDialog-9.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} - } -body { start {tk_chooseDirectory -title bar} then { - Click cancel + Click cancel } } -result {0} test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} -constraints { @@ -499,23 +914,135 @@ test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} - test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints { nt testwinevent } -body { -# case DIR_INITIAL: +# case DIR_INITIAL: - start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} + start {set x [tk_chooseDirectory -initialdir [initialdir] -title Foo]} then { - Click ok + Click ok } string tolower [set x] -} -result {c:/} +} -result [string tolower [initialdir]] test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { -# if (Tcl_TranslateFileName(interp, string, -# &utfDirString) == NULL) - +# if (Tcl_TranslateFileName(interp, string, +# &utfDirString) == NULL) + tk_chooseDirectory -initialdir ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} + +test winDialog-10.1 {Tk_FontchooserObjCmd: no arguments} -constraints { + nt testwinevent +} -body { + start {tk fontchooser show} + list [then { + Click cancel + }] $::testfont +} -result {0 {}} +test winDialog-10.2 {Tk_FontchooserObjCmd: -initialfont} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command ApplyFont -font system + tk fontchooser show + } + list [then { + Click cancel + }] $::testfont +} -result {0 {}} +test winDialog-10.3 {Tk_FontchooserObjCmd: -initialfont} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command ApplyFont -font system + tk fontchooser show + } + list [then { + Click 1 + }] [expr {[llength $::testfont] ne {}}] +} -result {0 1} +test winDialog-10.4 {Tk_FontchooserObjCmd: -title} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command ApplyFont -title "tk test" + tk fontchooser show + } + list [then { + Click cancel + }] $::testfont +} -result {0 {}} +test winDialog-10.5 {Tk_FontchooserObjCmd: -parent} -constraints { + nt testwinevent +} -setup { + array set a {parent {}} +} -body { + start { + tk fontchooser configure -command ApplyFont -parent . + tk fontchooser show + } + then { + array set a [testgetwindowinfo $::tk_dialog] + Click cancel + } + list [expr {$a(parent) == [wm frame .]}] $::testfont +} -result {1 {}} +test winDialog-10.6 {Tk_FontchooserObjCmd: -apply} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command FooBarBaz + tk fontchooser show + } + then { + Click cancel + } +} -result 0 +test winDialog-10.7 {Tk_FontchooserObjCmd: -apply} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command ApplyFont -parent . + tk fontchooser show + } + list [then { + Click [expr {0x0402}] ;# value from XP + Click cancel + }] [expr {[llength $::testfont] > 0}] +} -result {0 1} +test winDialog-10.8 {Tk_FontchooserObjCmd: -title} -constraints { + nt testwinevent +} -setup { + array set a {text failed} +} -body { + start { + tk fontchooser configure -command ApplyFont -title "Hello" + tk fontchooser show + } + then { + array set a [testgetwindowinfo $::tk_dialog] + Click cancel + } + set a(text) +} -result "Hello" +test winDialog-10.9 {Tk_FontchooserObjCmd: -title} -constraints { + nt testwinevent +} -setup { + array set a {text failed} +} -body { + start { + tk fontchooser configure -command ApplyFont \ + -title "\u041f\u0440\u0438\u0432\u0435\u0442" + tk fontchooser show + } + then { + array set a [testgetwindowinfo $::tk_dialog] + Click cancel + } + set a(text) +} -result "\u041f\u0440\u0438\u0432\u0435\u0442" + if {[testConstraint testwinevent]} { catch {testwinevent debug 0} } @@ -527,3 +1054,4 @@ return # Local variables: # mode: tcl # End: + diff --git a/tests/winFont.test b/tests/winFont.test index c61d124..8039426 100644 --- a/tests/winFont.test +++ b/tests/winFont.test @@ -1,48 +1,28 @@ -# This file is a Tcl script to test out the procedures in tkWinFont.c. +# This file is a Tcl script to test out the procedures in tkWinFont.c. # It is organized in the standard fashion for Tcl tests. # # Many of these tests are visually oriented and cannot be checked # programmatically (such as "does an underlined font appear to be # underlined?"); these tests attempt to exercise the code in question, -# but there are no results that can be checked. +# but there are no results that can be checked. # # Copyright (c) 1996-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands -catch {destroy .b} -catch {font delete xyz} -toplevel .b -wm geometry .b +0+0 -update idletasks - -set courier {Courier 14} -set cx [font measure $courier 0] - -label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font systemfixed -pack .b.l -canvas .b.c -closeenough 0 - -set t [.b.c create text 0 0 -anchor nw -just left -font $courier] -pack .b.c -update - -set ax [winfo reqwidth .b.l] -set ay [winfo reqheight .b.l] -proc getsize {} { - update - return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" -} - -test winfont-1.1 {TkpGetNativeFont procedure: not native} win { - list [catch {font measure {} xyz} msg] $msg -} {1 {font "" doesn't exist}} -test winfont-1.2 {TkpGetNativeFont procedure: native} win { +test winfont-1.1 {TkpGetNativeFont procedure: not native} -constraints { + win +} -body { + catch {font delete xyz} + font measure {} xyz +} -returnCodes error -result {font "" doesn't exist} +test winfont-1.2 {TkpGetNativeFont procedure: native} -constraints win -body { font measure ansifixed 0 font measure ansi 0 font measure device 0 @@ -50,135 +30,363 @@ test winfont-1.2 {TkpGetNativeFont procedure: native} win { font measure systemfixed 0 font measure system 0 set x {} -} {} - -test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} win { - expr [font actual {-size -10} -size]>0 -} {1} -test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} win { - expr [font actual {-family Arial} -size]>0 -} {1} -test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} win { +} -result {} + + +test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} -constraints { + win +} -body { + expr {[font actual {-size -10} -size] > 0} +} -result {1} +test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} -constraints { + win +} -body { + expr {[font actual {-family Arial} -size] > 0} +} -result {1} +test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} -constraints { + win +} -body { font actual {-weight normal} -weight -} {normal} -test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} win { +} -result {normal} +test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} -constraints { + win +} -body { font actual {-weight bold} -weight -} {bold} -test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} win { +} -result {bold} +test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} -constraints { + win +} -body { catch {expr {[font actual {-size 10} -size]}} -} 0 -test winfont-2.6 {TkpGetFontFromAttributes procedure: family} win { +} -result 0 +test winfont-2.6 {TkpGetFontFromAttributes procedure: family} -constraints { + win +} -body { font actual {-family Arial} -family -} {Arial} -test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} win { +} -result {Arial} +test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} -constraints { + win +} -setup { set x {} +} -body { lappend x [font actual {-family "Times"} -family] lappend x [font actual {-family "New York"} -family] lappend x [font actual {-family "Times New Roman"} -family] -} {{Times New Roman} {Times New Roman} {Times New Roman}} -test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} win { +} -result {{Times New Roman} {Times New Roman} {Times New Roman}} +test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} -constraints { + win +} -setup { set x {} +} -body { lappend x [font actual {-family "Courier"} -family] lappend x [font actual {-family "Monaco"} -family] lappend x [font actual {-family "Courier New"} -family] -} {{Courier New} {Courier New} {Courier New}} -test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} win { +} -result {{Courier New} {Courier New} {Courier New}} +test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} -constraints { + win +} -setup { set x {} +} -body { lappend x [font actual {-family "Helvetica"} -family] lappend x [font actual {-family "Geneva"} -family] lappend x [font actual {-family "Arial"} -family] -} {Arial Arial Arial} -test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} win { +} -result {Arial Arial Arial} +test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} -constraints { + win +} -body { # No way to get it to fail! Any font name is acceptable. -} {} +} -result {} -test winfont-3.1 {TkpDeleteFont procedure} win { + +test winfont-3.1 {TkpDeleteFont procedure} -constraints win -body { + catch {font delete xyz} font actual {-family xyz} set x {} -} {} +} -result {} + -test winfont-4.1 {TkpGetFontFamilies procedure} win { +test winfont-4.1 {TkpGetFontFamilies procedure} -constraints win -body { font families set x {} -} {} - -test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} win { - .b.l config -wrap 0 -text "000000" - getsize -} "[expr $ax*6] $ay" -test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} win { - .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" - getsize -} "[expr $ax*256] $ay" -test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} win { - .b.l config -wrap [expr $ax*10] -text "00000000" - getsize -} "[expr $ax*8] $ay" -test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} win { - .b.l config -wrap [expr $ax*6] -text "00000000" - getsize -} "[expr $ax*6] [expr $ay*2]" -test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} win { - .b.c dchars $t 0 end - .b.c insert $t 0 "0000" - .b.c index $t @[expr int($cx*2.5)],1 -} {2} -test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} win { - .b.l config -text "000000" -wrap 1 - getsize -} "$ax [expr $ay*6]" -test winfont-5.7 {Tk_MeasureChars procedure: whole words} win { - .b.l config -wrap [expr $ax*8] -text "000000 0000" - getsize -} "[expr $ax*6] [expr $ay*2]" -test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} win { - .b.l config -wrap [expr $ax*12] -text "000000 0000000" - getsize -} "[expr $ax*7] [expr $ay*2]" -test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} win { - .b.l config -wrap [expr $ax*12] -text "000 00 00000" - getsize -} "[expr $ax*7] [expr $ay*2]" -test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} win { - .b.l config -wrap [expr $ax*12] -text "0000000000000000" - getsize -} "[expr $ax*12] [expr $ay*2]" -test winfont-5.11 {Tk_MeasureChars procedure: check for kerning} \ - {win nonPortable} { - set font [.b.l cget -font] - .b.l config -font {{MS Sans Serif} 8} -text "W" - set width [winfo reqwidth .b.l] - .b.l config -text "XaYoYaKaWx" +} -result {} + +destroy .t +toplevel .t +wm geometry .t +0+0 +update idletasks +label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font systemfixed +pack .t.l +canvas .t.c -closeenough 0 + +set courier {Courier 14} +set cx [font measure $courier 0] +set t [.t.c create text 0 0 -anchor nw -just left -font $courier] +pack .t.c +update + +set ax [winfo reqwidth .t.l] +set ay [winfo reqheight .t.l] +proc getsize {} { + update + return "[winfo reqwidth .t.l] [winfo reqheight .t.l]" +} + +test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} -constraints { + win +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + set ax [winfo reqwidth .t.l] + set ay [winfo reqheight .t.l] + + .t.l config -wrap 0 -text "000000" + list [expr {[winfo reqwidth .t.l] eq 6*$ax}] \ + [expr {[winfo reqheight .t.l] eq $ay}] +} -cleanup { + destroy .t.l +} -result {1 1} + +test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} -constraints { + win +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + set ax [winfo reqwidth .t.l] + set ay [winfo reqheight .t.l] + + .t.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" + list [expr {[winfo reqwidth .t.l] eq 256*$ax}] \ + [expr {[winfo reqheight .t.l] eq $ay}] +} -cleanup { + destroy .t.l +} -result {1 1} + +test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} -constraints { + win +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + set ax [winfo reqwidth .t.l] + set ay [winfo reqheight .t.l] + + .t.l config -wrap [expr $ax*10] -text "00000000" + list [expr {[winfo reqwidth .t.l] eq 8*$ax}] \ + [expr {[winfo reqheight .t.l] eq $ay}] +} -cleanup { + destroy .t.l +} -result {1 1} + +test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} -constraints { + win +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + set ax [winfo reqwidth .t.l] + set ay [winfo reqheight .t.l] + + .t.l config -wrap [expr $ax*6] -text "00000000" + list [expr {[winfo reqwidth .t.l] eq 6*$ax}] \ + [expr {[winfo reqheight .t.l] eq 2*$ay}] +} -cleanup { + destroy .t.l +} -result {1 1} + +test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} -constraints { + win +} -setup { + destroy .t.c +} -body { + canvas .t.c -closeenough 0 + set t [.t.c create text 0 0 -anchor nw -just left -font $courier] + pack .t.c + update + + .t.c dchars $t 0 end + .t.c insert $t 0 "0000" + .t.c index $t @[expr int($cx*2.5)],1 +} -cleanup { + destroy .t.c +} -result {2} + +test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} -constraints { + win +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + set ax [winfo reqwidth .t.l] + set ay [winfo reqheight .t.l] + + .t.l config -text "000000" -wrap 1 + list [expr {[winfo reqwidth .t.l] eq $ax}] \ + [expr {[winfo reqheight .t.l] eq 6*$ay}] +} -cleanup { + destroy .t.l +} -result {1 1} + +test winfont-5.7 {Tk_MeasureChars procedure: whole words} -constraints { + win +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + set ax [winfo reqwidth .t.l] + set ay [winfo reqheight .t.l] + + .t.l config -wrap [expr $ax*8] -text "000000 0000" + list [expr {[winfo reqwidth .t.l] eq 6*$ax}] \ + [expr {[winfo reqheight .t.l] eq 2*$ay}] +} -cleanup { + destroy .t.l +} -result {1 1} + +test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} -constraints { + win +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + set ax [winfo reqwidth .t.l] + set ay [winfo reqheight .t.l] + + .t.l config -wrap [expr $ax*12] -text "000000 0000000" + list [expr {[winfo reqwidth .t.l] eq 7*$ax}] \ + [expr {[winfo reqheight .t.l] eq 2*$ay}] +} -cleanup { + destroy .t.l +} -result {1 1} + +test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} -constraints { + win +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + set ax [winfo reqwidth .t.l] + set ay [winfo reqheight .t.l] + + .t.l config -wrap [expr $ax*12] -text "000 00 00000" + list [expr {[winfo reqwidth .t.l] eq 7*$ax}] \ + [expr {[winfo reqheight .t.l] eq 2*$ay}] +} -cleanup { + destroy .t.l +} -result {1 1} + +test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} -constraints { + win +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + set ax [winfo reqwidth .t.l] + set ay [winfo reqheight .t.l] + + .t.l config -wrap [expr $ax*12] -text "0000000000000000" + list [expr {[winfo reqwidth .t.l] eq 12*$ax}] \ + [expr {[winfo reqheight .t.l] eq 2*$ay}] +} -cleanup { + destroy .t.l +} -result {1 1} + +test winfont-5.11 {Tk_MeasureChars procedure: check for kerning} -constraints { + win nonPortable +} -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + + set font [.t.l cget -font] + .t.l config -font {{MS Sans Serif} 8} -text "W" + set width [winfo reqwidth .t.l] + .t.l config -text "XaYoYaKaWx" set x [lindex [getsize] 0] - .b.l config -font $font + .t.l config -font $font expr $x < ($width*10) -} 1 +} -cleanup { + destroy .t.l +} -result {1} -test winfont-6.1 {Tk_DrawChars procedure: loop test} win { - .b.l config -text "a" + +test winfont-6.1 {Tk_DrawChars procedure: loop test} -constraints win -setup { + destroy .t.l +} -body { + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font systemfixed + pack .t.l + update + .t.l config -text "a" update -} {} +} -cleanup { + destroy .t.l +} -result {} + -test winfont-7.1 {AllocFont procedure: use old font} win { +test winfont-7.1 {AllocFont procedure: use old font} -constraints win -setup { + destroy .c +} -setup { + catch {font delete xyz} +} -body { font create xyz - catch {destroy .c} button .c -font xyz font configure xyz -family times update destroy .c font delete xyz -} {} -test winfont-7.2 {AllocFont procedure: extract info from logfont} win { +} -result {} +test winfont-7.2 {AllocFont procedure: extract info from logfont} -constraints { + win +} -body { font actual {arial 10 bold italic underline overstrike} -} {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1} -test winfont-7.3 {AllocFont procedure: extract info from textmetric} win { +} -result {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1} +test winfont-7.3 {AllocFont procedure: extract info from textmetric} -constraints { + win +} -body { font metric {arial 10 bold italic underline overstrike} -fixed -} {0} -test winfont-7.4 {AllocFont procedure: extract info from textmetric} win { +} -result {0} +test winfont-7.4 {AllocFont procedure: extract info from textmetric} -constraints { + win +} -body { font metric systemfixed -fixed -} {1} +} -result {1} # cleanup -destroy .b cleanupTests return + +# Local variables: +# mode: tcl +# End: + diff --git a/tests/winMenu.test b/tests/winMenu.test index 7240bf5..ce2069f 100644 --- a/tests/winMenu.test +++ b/tests/winMenu.test @@ -7,140 +7,183 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands -test winMenu-1.1 {GetNewID} win { - catch {destroy .m1} - list [catch {menu .m1} msg] $msg [destroy .m1] -} {0 .m1 {}} +test winMenu-1.1 {GetNewID} -constraints win -setup { + destroy .m1 +} -body { + menu .m1 +} -cleanup { + destroy .m1 +} -returnCodes ok -result {.m1} +test winMenu-1.2 {GetNewID} -constraints win -setup { + destroy .m1 +} -body { + menu .m1 + destroy .m1 +} -result {} + + # Basically impossible to test menu IDs wrapping. -test winMenu-2.1 {FreeID} win { - catch {destroy .m1} +test winMenu-2.1 {FreeID} -constraints win -setup { + destroy .m1 +} -body { menu .m1 - list [catch {destroy .m1} msg] $msg -} {0 {}} + destroy .m1 +} -returnCodes ok -test winMenu-3.1 {TkpNewMenu} win { - catch {destroy .m1} + +test winMenu-3.1 {TkpNewMenu} -constraints win -setup { + destroy .m1 +} -body { list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2 -} {0 .m1 0 {}} -test winMenu-3.2 {TkpNewMenu} win { - catch {destroy .m1} +} -result {0 .m1 0 {}} +test winMenu-3.2 {TkpNewMenu} -constraints win -setup { + destroy .m1 +} -body { . configure -menu "" menu .m1 .m1 add command -label "foo" list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2 -} {0 {} {} 0 {}} +} -result {0 {} {} 0 {}} + -test winMenu-4.1 {TkpDestroyMenu} win { - catch {destroy .m1} +test winMenu-4.1 {TkpDestroyMenu} -constraints win -setup { + destroy .m1 +} -body { menu .m1 - list [catch {destroy .m1} msg] $msg -} {0 {}} -test winMenu-4.2 {TkpDestroyMenu - help menu} win { - catch {destroy .m1} + destroy .m1 +} -returnCodes ok +test winMenu-4.2 {TkpDestroyMenu - help menu} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -menu .m1.system . configure -menu .m1 list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} +} -result {0 {} {} {}} + -test winMenu-5.1 {TkpDestroyMenuEntry} win { - catch {destroy .m1} +test winMenu-5.1 {TkpDestroyMenuEntry} -constraints win -setup { + destroy .m1 +} -body { . configure -menu "" menu .m1 .m1 add command -label "test" update idletasks list [catch {.m1 delete 1} msg] $msg [destroy .m1] -} {0 {} {}} +} -result {0 {} {}} -test winMenu-6.1 {GetEntryText} win { - catch {destroy .m1} + +test winMenu-6.1 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { list [catch {menu .m1} msg] $msg [destroy .m1] -} {0 .m1 {}} -test winMenu-6.2 {GetEntryText} {testImageType win} { - catch {destroy .m1} +} -result {0 .m1 {}} +test winMenu-6.2 {GetEntryText} -constraints { + testImageType win +} -setup { + destroy .m1 +} -body { catch {image delete image1} menu .m1 image create test image1 list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1] -} {0 {} {} {}} -test winMenu-6.3 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {} {}} +test winMenu-6.3 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.4 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.4 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.5 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.5 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.6 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.6 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "This string has one & in it"} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.7 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.7 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "The & should be underlined." -underline 4} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.8 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.8 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "The * should be underlined." -underline 4} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.9 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.9 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "foo" -accel "bar"} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.10 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.10 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "This string has one & in it" -accel "bar"} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.11 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.11 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.12 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.12 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.13 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.13 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "foo" -accel "&bar"} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.14 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.14 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "This string has one & in it" -accel "&bar"} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.15 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.15 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-6.16 {GetEntryText} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-6.16 {GetEntryText} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1] -} {0 {} {}} +} -result {0 {} {}} -test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} win { - catch {destroy .m1} +test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -menu .m1.system menu .m1.system @@ -148,103 +191,140 @@ test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} win { update idletasks .m1.system add command -label bar list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} win { - catch {destroy .m1} +} -result {0 {} {} {}} +test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label Hello update idletasks .m1 add command -label foo list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.3 {ReconfigureWindowsMenu - zero items} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.3 {ReconfigureWindowsMenu - zero items} -constraints win -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label Hello .m1 delete Hello list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.4 {ReconfigureWindowsMenu - one item} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.4 {ReconfigureWindowsMenu - one item} -constraints win -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.5 {ReconfigureWindowsMenu - two items} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.5 {ReconfigureWindowsMenu - two items} -constraints win -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label One .m1 add command -label Two list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.6 {ReconfigureWindowsMenu - separator item} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.6 {ReconfigureWindowsMenu - separator item} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add separator list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label Hello -state disabled list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add checkbutton -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add radiobutton -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add checkbutton -label Hello .m1 invoke Hello list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add radiobutton -label Hello .m1 invoke Hello list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-7.14 {ReconfigureWindowsMenu - cascade} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-7.14 {ReconfigureWindowsMenu - cascade} -constraints win -setup { + destroy .m1 +} -body { catch {destroy .m2} menu .m1 -tearoff 0 menu .m2 .m1 add cascade -menu .m2 -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] [destroy .m2] -} {0 {} {} {}} -test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} win { - catch {destroy .m1} +} -result {0 {} {} {}} +test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -menu .m1.file menu .m1.file -tearoff 0 . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} win { - catch {destroy .m1} +} -result {0 {} {} {}} +test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -menu .m1.system menu .m1.system -tearoff 0 @@ -252,17 +332,23 @@ test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} win { update idletasks .m1.system add command -label Hello list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} win { - catch {destroy .m1} +} -result {0 {} {} {}} +test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -menu .m1.system menu .m1.system -tearoff 0 . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} win { - catch {destroy .m1} +} -result {0 {} {} {}} +test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add cascade -menu .m1.system menu .m1.system -tearoff 0 @@ -270,521 +356,717 @@ test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} win update idletasks . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} -test winMenu-7.19 {ReconfigureWindowsMenu - column break} win { - catch {destroy .m1} +} -result {0 {} {} {}} +test winMenu-7.19 {ReconfigureWindowsMenu - column break} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label one .m1 add command -label two -columnbreak 1 list [catch {update idletasks} msg] $msg [destroy .m1] -} {0 {} {}} +} -result {0 {} {}} + #Don't know how to generate nested post menus -test winMenu-8.1 {TkpPostMenu} win { - catch {destroy .m1} + +test winMenu-8.1 {TkpPostMenu} -constraints win -setup { + destroy .m1 +} -body { menu .m1 -postcommand "blork" - list [catch {.m1 post 40 40} msg] $msg [destroy .m1] -} {1 {invalid command name "blork"} {}} -test winMenu-8.2 {TkpPostMenu} win { - catch {destroy .m1} + .m1 post 40 40 +} -returnCodes error -result {invalid command name "blork"} +test winMenu-8.2 {TkpPostMenu} -constraints win -setup { + destroy .m1 +} -body { + menu .m1 -postcommand "blork" + .m1 post 40 40 + destroy .m1 +} -returnCodes error -result {invalid command name "blork"} +test winMenu-8.3 {TkpPostMenu} -constraints win -setup { + destroy .m1 +} -body { menu .m1 -postcommand "destroy .m1" list [.m1 post 40 40] [winfo exists .m1] -} {{} 0} -test winMenu-8.3 {TkpPostMenu - popup menu} {win userInteraction} { - catch {destroy .m1} +} -result {{} 0} +test winMenu-8.4 {TkpPostMenu - popup menu} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "winMenu-8.3: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] -} {{} {}} -test winMenu-8.4 {TkpPostMenu - menu button} {win userInteraction} { - catch {destroy .mb} +} -result {{} {}} +test winMenu-8.5 {TkpPostMenu - menu button} -constraints { + win userInteraction +} -setup { + destroy .mb +} -body { menubutton .mb -text test -menu .mb.menu menu .mb.menu .mb.menu add command -label "winMenu-8.4 - Hit ESCAPE." pack .mb - list [tk::MbPost .mb] [destroy .m1] -} {{} {}} -test winMenu-8.5 {TkpPostMenu - update not pending} {win userInteraction} { - catch {destroy .m1} + list [tk::MbPost .mb] [destroy .mb] +} -result {{} {}} +test winMenu-8.6 {TkpPostMenu - update not pending} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "winMenu-8.5 - Hit ESCAPE." update idletasks list [catch {.m1 post 40 40} msg] $msg [destroy .m1] -} {0 {} {}} +} -result {0 {} {}} -test winMenu-9.1 {TkpMenuNewEntry} win { - catch {destroy .m1} + +test winMenu-9.1 {TkpMenuNewEntry} -constraints win -setup { + destroy .m1 +} -body { menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] -} {0 {} {}} +} -result {0 {} {}} + -test winMenu-10.1 {TkwinMenuProc} {win userInteraction} { - catch {destroy .m1} +test winMenu-10.1 {TkwinMenuProc} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "winMenu-10.1: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] -} {{} {}} +} -result {{} {}} + # Can't generate a WM_INITMENU without a Tk menu yet. -test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {win userInteraction} { - catch {destroy .m1} + +test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 -postcommand "set foo test" .m1 add command -label "winMenu-11.1: Hit ESCAPE." list [.m1 post 40 40] [set foo] [unset foo] [destroy .m1] -} {test test {} {}} -test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {win userInteraction} { - catch {destroy .m1} +} -result {test test {} {}} +test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { catch {unset foo} menu .m1 .m1 add checkbutton -variable foo -label "winMenu-11.2: Please select this menu item." list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1] -} {{} {} 1 {} {}} -test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} {win userInteraction} { - catch {destroy .m1} +} -result {{} {} 1 {} {}} +test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { catch {unset foo} proc bgerror {args} { - global foo errorInfo - set foo [list $args $errorInfo] + global foo errorInfo + set foo [list $args $errorInfo] } menu .m1 .m1 add command -command {error 1} -label "winMenu-11.2: Please select this menu item." list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1] -} {{} {} {1 {1 +} -result {{} {} {1 {1 while executing "error 1" (menu invoke)}} {} {}} + # Can't test WM_MENUCHAR -test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {win userInteraction} { - catch {destroy .m1} + +test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "winMenu-11.3: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] -} {{} {}} -test winMenu-11.5 {TkWinHandleMenuEvent - WM_MEASUREITEM} {win userInteraction} { - catch {destroy .m1} +} -result {{} {}} +test winMenu-11.5 {TkWinHandleMenuEvent - WM_MEASUREITEM} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label "winMenu-11.4: Hit ESCAPE" -hidemargin 1 list [.m1 post 40 40] [destroy .m1] -} {{} {}} -test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM} {win userInteraction} { - catch {destroy .m1} +} -result {{} {}} +test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "winMenu-11.5: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] -} {{} {}} -test winMenu-11.7 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} \ - {win userInteraction} { - catch {destroy .m1} +} -result {{} {}} +test winMenu-11.7 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "winMenu-11.6: Hit ESCAPE." -state disabled list [.m1 post 40 40] [destroy .m1] -} {{} {}} -test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} \ - {win userInteraction} { - catch {destroy .m1} +} -result {{} {}} +test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label "winMenu-11.7: Hit ESCAPE" update idletasks list [catch {.m1 post 40 40} msg] $msg [destroy .m1] -} {0 {} {}} +} -result {0 {} {}} -test winMenu-12.1 {TkpSetWindowMenuBar} win { - catch {destroy .m1} + +test winMenu-12.1 {TkpSetWindowMenuBar} -constraints win -setup { + destroy .m1 +} -body { . configure -menu "" menu .m1 .m1 add command -label foo list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2 -} {0 {} {} 0 {}} -test winMenu-12.2 {TkpSetWindowMenuBar} win { - catch {destroy .m1} +} -result {0 {} {} 0 {}} +test winMenu-12.2 {TkpSetWindowMenuBar} -constraints win -setup { + destroy .m1 +} -body { . configure -menu "" menu .m1 .m1 add command -label foo . configure -menu .m1 list [catch {. configure -menu ""} msg] $msg [catch {destroy .m1} msg2] $msg2 -} {0 {} 0 {}} -test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} win { - catch {destroy .m1} +} -result {0 {} 0 {}} +test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} -constraints { + win +} -setup { + destroy .m1 +} -body { . configure -menu "" menu .m1 -tearoff 0 .m1 add command -label foo update idletasks list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] -} {0 {} {} {}} +} -result {0 {} {} {}} + + +test winMenu-13.1 {TkpSetMainMenubar - nothing to do} -constraints { + emptyTest win +} -body {} -test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {emptyTest win} {} {} -test winMenu-14.1 {GetMenuIndicatorGeometry} win { - catch {destroy .m1} +test winMenu-14.1 {GetMenuIndicatorGeometry} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test winMenu-14.2 {GetMenuIndicatorGeometry} win { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test winMenu-14.2 {GetMenuIndicatorGeometry} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo -hidemargin 1 - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok -test winMenu-15.1 {GetMenuAccelGeometry} win { - catch {destroy .m1} + +test winMenu-15.1 {GetMenuAccelGeometry} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label foo -accel Ctrl+U - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test winMenu-15.2 {GetMenuAccelGeometry} win { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test winMenu-15.2 {GetMenuAccelGeometry} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} -test winMenu-15.3 {GetMenuAccelGeometry} win { - catch {destroy .m1} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok +test winMenu-15.3 {GetMenuAccelGeometry} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -accel "Ctrl+U" - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok + -test winMenu-16.1 {GetTearoffEntryGeometry} {win userInteraction} { - catch {destroy .m1} +test winMenu-16.1 {GetTearoffEntryGeometry} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "winMenu-19.1: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] -} {{} {}} +} -result {{} {}} -test winMenu-17.1 {GetMenuSeparatorGeometry} win { - catch {destroy .m1} + +test winMenu-17.1 {GetMenuSeparatorGeometry} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator - list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] -} {0 {}} + tk::TearOffMenu .m1 40 40 + destroy .m1 +} -returnCodes ok + # Currently, the only callers to DrawWindowsSystemBitmap want things # centered vertically, and either centered or right aligned horizontally. -test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} win { - catch {destroy .m1} +test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo .m1 invoke foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} +} -result {{} {}} + -test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} \ - win { - catch {destroy .m1} +test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-19.2 {DrawMenuEntryIndicator - not selected} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-19.2 {DrawMenuEntryIndicator - not selected} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo .m1 invoke foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add radiobutton -label foo .m1 invoke foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-19.5 {DrawMenuEntryIndicator - disabled} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-19.5 {DrawMenuEntryIndicator - disabled} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo .m1 invoke foo .m1 entryconfigure foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo -indicatoron 0 .m1 invoke foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} +} -result {{} {}} -test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} win { - catch {destroy .m1} + +test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} -constraints win -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground red .m1 add command -label foo -accel "Ctrl+U" -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -accel "Ctrl+U" set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground "" .m1 add command -label foo -accel "Ctrl+U" -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} \ - {win userInteraction} { - catch {destroy .m1} +} -result {{} {}} +test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label "winMenu-23.5: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] -} {{} {}} +} -result {{} {}} + -test winMenu-21.1 {DrawMenuSeparator} win { - catch {destroy .m1} +test winMenu-21.1 {DrawMenuSeparator} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} +} -result {{} {}} + -test winMenu-22.1 {DrawMenuUnderline} win { - catch {destroy .m1} +test winMenu-22.1 {DrawMenuUnderline} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -underline 0 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} +} -result {{} {}} -test winMenu-23.1 {Don't know how to test MenuKeyBindProc} \ - {win emptyTest} {} {} -test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} \ - {win emptyTest} {} {} -test winMenu-25.1 {DrawMenuEntryLabel - normal} win { - catch {destroy .m1} +test winMenu-23.1 {Don't know how to test MenuKeyBindProc} -constraints { + win emptyTest +} -body {} + + +test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} -constraints { + win emptyTest +} -body {} + + +test winMenu-25.1 {DrawMenuEntryLabel - normal} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground red .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} +} -result {{} {}} + -test winMenu-26.1 {TkpComputeMenubarGeometry} win { - catch {destroy .m1} +test winMenu-26.1 {TkpComputeMenubarGeometry} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label File list [. configure -menu .m1] [. configure -menu ""] [destroy .m1] -} {{} {} {}} +} -result {{} {} {}} -test winMenu-27.1 {DrawTearoffEntry} {win userInteraction} { - catch {destroy .m1} + +test winMenu-27.1 {DrawTearoffEntry} -constraints { + win userInteraction +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "winMenu-24.4: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] -} {{} {}} +} -result {{} {}} + -test winMenu-28.1 {TkpConfigureMenuEntry - update pending} win { - catch {destroy .m1} +test winMenu-28.1 {TkpConfigureMenuEntry - update pending} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label Hello list [catch {.m1 add command -label Two} msg] $msg [destroy .m1] -} {0 {} {}} -test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} win { - catch {destroy .m1} +} -result {0 {} {}} +test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label One update idletasks list [catch {.m1 add command -label Two} msg] $msg [destroy .m1] -} {0 {} {}} +} -result {0 {} {}} + -test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} win { - catch {destroy .m1} +test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -activeforeground red set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 set tk_strictMotif 1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] -} {{} {} 0} -test winMenu-29.4 \ - {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} \ - win { - catch {destroy .m1} +} -result {{} {} 0} +test winMenu-29.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled -background red set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -foreground red set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo -selectcolor orange .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label foo .m1 invoke 1 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -activebackground green set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test winMenu-29.12 {TkpDrawMenuEntry - border} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.12 {TkpDrawMenuEntry - border} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} -constraints { + win +} -setup { + destroy .m1 +} -body { set tk_strictMotif 1 menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] -} {{} {} 0} -test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} win { - catch {destroy .m1} +} -result {{} {} 0} +test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -activeforeground yellow set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test winMenu-29.15 {TkpDrawMenuEntry - active border} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.15 {TkpDrawMenuEntry - active border} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] .m1 entryconfigure 1 -state active list [update] [destroy .m1] -} {{} {}} -test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo -font "Helvectica 72" set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.17 {TkpDrawMenuEntry - font} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.17 {TkpDrawMenuEntry - font} -constraints win -setup { + destroy .m1 +} -body { menu .m1 -font "Courier 72" .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.18 {TkpDrawMenuEntry - separator} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.18 {TkpDrawMenuEntry - separator} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.19 {TkpDrawMenuEntry - standard} win { - catch {destroy .mb} +} -result {{} {}} +test winMenu-29.19 {TkpDrawMenuEntry - standard} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add cascade -label File -menu .m1.file menu .m1.file @@ -792,160 +1074,211 @@ test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} win { .m1 entryconfigure File -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.21 {TkpDrawMenuEntry - indicator} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.21 {TkpDrawMenuEntry - indicator} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label winMenu-31.20 .m1 invoke winMenu-31.20 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-29.22 {TkpDrawMenuEntry - indicator} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-29.22 {TkpDrawMenuEntry - indicator} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label winMenu-31.21 -hidemargin 1 .m1 invoke winMenu-31.21 set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} +} -result {{} {}} -test winMenu-30.1 {GetMenuLabelGeometry - image} {testImageType win} { - catch {destroy .m1} + +test winMenu-30.1 {GetMenuLabelGeometry - image} -constraints { + testImageType win +} -setup { + destroy .m1 catch {image delete image1} +} -body { menu .m1 image create test image1 .m1 add command -image image1 list [update idletasks] [destroy .m1] [image delete image1] -} {{} {} {}} -test winMenu-30.2 {GetMenuLabelGeometry - bitmap} win { - catch {destroy .m1} +} -result {{} {} {}} +test winMenu-30.2 {GetMenuLabelGeometry - bitmap} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -bitmap questhead list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-30.3 {GetMenuLabelGeometry - no text} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-30.3 {GetMenuLabelGeometry - no text} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-30.4 {GetMenuLabelGeometry - text} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-30.4 {GetMenuLabelGeometry - text} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "This is a test." list [update idletasks] [destroy .m1] -} {{} {}} +} -result {{} {}} + -test winMenu-31.1 {DrawMenuEntryBackground} win { - catch {destroy .m1} +test winMenu-31.1 {DrawMenuEntryBackground} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] -} {{} {}} -test winMenu-31.2 {DrawMenuEntryBackground} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-31.2 {DrawMenuEntryBackground} -constraints win -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] $tearoff activate 0 list [update] [destroy .m1] -} {{} {}} +} -result {{} {}} -test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} win { - catch {destroy .m1} + +test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "one" list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "one" .m1 add command -label "two" list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add separator list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unix nonUnixUserInteraction} { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} -constraints { + unix nonUnixUserInteraction +} -setup { + destroy .mb +} -body { menubutton .mb -text "test" -menu .mb.m menu .mb.m .mb.m add command -label test pack .mb catch {tk::MbPost .mb} list [update] [destroy .mb] -} {{} {}} -test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} \ - win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} \ - win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -font "Helvetica 12" .m1 add command -label "test" -font "Courier 12" list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" .m1 add command -label "test test" list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test test" .m1 add command -label "test" list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" -accel "Ctrl+S" list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" -accel "1" .m1 add command -label "test" -accel "1 1" list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label "test" -accel "1 1" .m1 add command -label "test" -accel "1" list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add checkbutton -label test .m1 invoke 1 list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.14 \ - {TkpComputeStandardMenuGeometry - second indicator less or equal} \ - {testImageType win} { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.14 {TkpComputeStandardMenuGeometry - second indicator less or equal} -constraints { + testImageType win +} -setup { + destroy .m1 catch {image delete image1} +} -body { image create test image1 menu .m1 .m1 add checkbutton -image image1 @@ -953,11 +1286,13 @@ test winMenu-32.14 \ .m1 add checkbutton -label test .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] -} {{} {} {}} -test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \ - {testImageType unix} { - catch {destroy .m1} +} -result {{} {} {}} +test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} -constraints { + testImageType unix +} -setup { + destroy .m1 catch {image delete image1} +} -body { image create test image1 menu .m1 .m1 add checkbutton -image image1 @@ -965,31 +1300,42 @@ test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \ .m1 add checkbutton -label test .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] -} {{} {} {}} -test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} win { - catch {destroy .m1} +} -result {{} {} {}} +test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 .m1 add command -label one .m1 add command -label two .m1 add command -label three -columnbreak 1 list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} \ - win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label one .m1 add command -label two -columnbreak 1 .m1 add command -label three list [update idletasks] [destroy .m1] -} {{} {}} -test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} win { - catch {destroy .m1} +} -result {{} {}} +test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} -constraints { + win +} -setup { + destroy .m1 +} -body { menu .m1 -tearoff 0 .m1 add command -label one .m1 add command -label two -columnbreak 1 @@ -997,19 +1343,22 @@ test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} win { .m1 add command -label four .m1 add command -label five -columnbreak 1 .m1 add command -label six - list [update idletasks] [destroy .m1] -} {{} {}} + list [update idletasks] [destroy .m1] +} -result {{} {}} + -test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} win { - catch {destroy .t2} - catch {destroy .m1} +test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} -constraints { + win +} -setup { + destroy .m1 .t2 +} -body { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 list [update idletasks] [destroy .t2] -} {{} {}} -test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} win { - catch {destroy .t2} - catch {destroy .m1} +} -result {{} {}} +test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} -constraints win -setup { + destroy .m1 .t2 +} -body { menu .m1 menu .m1.system .m1 add cascade -menu .m1.system @@ -1018,11 +1367,19 @@ test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} win { toplevel .t2 -menu .m1 wm geometry .t2 +0+0 list [update idletasks] [destroy .m1] [destroy .t2] -} {{} {} {}} +} -result {{} {} {}} + -test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest win} {} {} +test winMenu-34.1 {TkpMenuInit called at boot time} -constraints { + emptyTest win +} -body {} # cleanup deleteWindows cleanupTests return + +# Local variables: +# mode: tcl +# End: + diff --git a/tests/winMsgbox.test b/tests/winMsgbox.test index f467896..0181103 100644 --- a/tests/winMsgbox.test +++ b/tests/winMsgbox.test @@ -2,8 +2,9 @@ # # Copyright (c) 2007 Pat Thoyts <patthoyts@users.sourceforge.net> -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands testConstraint getwindowinfo [expr {[llength [info command ::testgetwindowinfo]] > 0}] @@ -38,7 +39,7 @@ proc GetWindowInfo {title button} { # ------------------------------------------------------------------------- -test winMsgbox-1.0 {tk_messageBox ok} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.1 {tk_messageBox ok} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -49,7 +50,7 @@ test winMsgbox-1.0 {tk_messageBox ok} -constraints {win getwindowinfo} -setup { wm deiconify . } -result {ok} -test winMsgbox-1.1 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.2 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -60,7 +61,7 @@ test winMsgbox-1.1 {tk_messageBox okcancel} -constraints {win getwindowinfo} -se wm deiconify . } -result {ok} -test winMsgbox-1.2 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.3 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -71,7 +72,7 @@ test winMsgbox-1.2 {tk_messageBox okcancel} -constraints {win getwindowinfo} -se wm deiconify . } -result {cancel} -test winMsgbox-1.3 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.4 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -82,7 +83,7 @@ test winMsgbox-1.3 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup wm deiconify . } -result {yes} -test winMsgbox-1.4 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.5 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -93,7 +94,7 @@ test winMsgbox-1.4 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup wm deiconify . } -result {no} -test winMsgbox-1.5 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.6 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -104,7 +105,7 @@ test winMsgbox-1.5 {tk_messageBox abortretryignore} -constraints {win getwindowi wm deiconify . } -result {abort} -test winMsgbox-1.6 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.7 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -115,7 +116,7 @@ test winMsgbox-1.6 {tk_messageBox abortretryignore} -constraints {win getwindowi wm deiconify . } -result {retry} -test winMsgbox-1.7 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.8 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -126,7 +127,7 @@ test winMsgbox-1.7 {tk_messageBox abortretryignore} -constraints {win getwindowi wm deiconify . } -result {ignore} -test winMsgbox-1.8 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.9 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -137,7 +138,7 @@ test winMsgbox-1.8 {tk_messageBox retrycancel} -constraints {win getwindowinfo} wm deiconify . } -result {retry} -test winMsgbox-1.9 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.10 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -148,7 +149,7 @@ test winMsgbox-1.9 {tk_messageBox retrycancel} -constraints {win getwindowinfo} wm deiconify . } -result {cancel} -test winMsgbox-1.10 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.11 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -159,7 +160,7 @@ test winMsgbox-1.10 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} wm deiconify . } -result {yes} -test winMsgbox-1.11 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.12 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -170,7 +171,7 @@ test winMsgbox-1.11 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} wm deiconify . } -result {no} -test winMsgbox-1.12 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup { +test winMsgbox-1.13 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup { wm iconify . } -body { global windowInfo @@ -183,7 +184,7 @@ test winMsgbox-1.12 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} # ------------------------------------------------------------------------- -test winMsgbox-2.0 {tk_messageBox message} -constraints {win getwindowinfo} -setup { +test winMsgbox-2.1 {tk_messageBox message} -constraints {win getwindowinfo} -setup { wm iconify . unset -nocomplain info } -body { @@ -198,7 +199,7 @@ test winMsgbox-2.0 {tk_messageBox message} -constraints {win getwindowinfo} -set wm deiconify . } -result [list ok "message"] -test winMsgbox-2.1 {tk_messageBox message (long)} -constraints { +test winMsgbox-2.2 {tk_messageBox message (long)} -constraints { win getwindowinfo } -setup { wm iconify . @@ -215,7 +216,7 @@ test winMsgbox-2.1 {tk_messageBox message (long)} -constraints { wm deiconify . } -result [list ok [string repeat Ab 80]] -test winMsgbox-2.2 {tk_messageBox message (unicode)} -constraints { +test winMsgbox-2.3 {tk_messageBox message (unicode)} -constraints { win getwindowinfo } -setup { wm iconify . @@ -232,7 +233,7 @@ test winMsgbox-2.2 {tk_messageBox message (unicode)} -constraints { wm deiconify . } -result [list ok "\u041f\u043e\u0438\u0441\u043a\u0020\u0441\u0442\u0440\u0430\u043d\u0438\u0446"] -test winMsgbox-2.3 {tk_messageBox message (empty)} -constraints { +test winMsgbox-2.4 {tk_messageBox message (empty)} -constraints { win getwindowinfo } -setup { wm iconify . @@ -248,7 +249,9 @@ test winMsgbox-2.3 {tk_messageBox message (empty)} -constraints { wm deiconify . } -result [list ok ""] -test winMsgbox-3.0 {tk_messageBox detail (sourceforge bug #1692927)} -constraints { +# ------------------------------------------------------------------------- + +test winMsgbox-3.1 {tk_messageBox detail (sourceforge bug #1692927)} -constraints { win getwindowinfo } -setup { wm iconify . @@ -265,7 +268,7 @@ test winMsgbox-3.0 {tk_messageBox detail (sourceforge bug #1692927)} -constraint wm deiconify . } -result [list ok "Hello\n\nPleased to meet you"] -test winMsgbox-3.1 {tk_messageBox detail (unicode)} -constraints { +test winMsgbox-3.2 {tk_messageBox detail (unicode)} -constraints { win getwindowinfo } -setup { wm iconify . diff --git a/tests/winSend.test b/tests/winSend.test index cd130fb..0f3baf8 100644 --- a/tests/winSend.test +++ b/tests/winSend.test @@ -96,7 +96,7 @@ test winSend-1.6 {Tk_SetAppName - safe interps} winSend { test winSend-2.1 {Tk_SendObjCmd - # of args} winSend { list [catch {send tktest} msg] $msg -} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}} +} {1 {wrong # args: should be "send ?-option value ...? interpName arg ?arg ...?"}} test winSend-2.1a {Tk_SendObjCmd: arguments} winSend { list [catch {send -bogus tktest} msg] $msg } {1 {bad option "-bogus": must be -async, -displayof, or --}} diff --git a/tests/winWm.test b/tests/winWm.test index 933d09e..ad4988d 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -9,37 +9,26 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands -# Measure the height of a single menu line - -toplevel .t -frame .t.f -width 100 -height 50 -pack .t.f -menu .t.m -.t.m add command -label "thisisreallylong" -.t configure -menu .t.m -wm geometry .t -0-0 -update -set menuheight [winfo y .t] -.t.m add command -label "thisisreallylong" -wm geometry .t -0-0 -update -set menuheight [expr {$menuheight - [winfo y .t]}] -destroy .t -test winWm-1.1 {TkWmMapWindow} win { +test winWm-1.1 {TkWmMapWindow} -constraints win -setup { + destroy .t +} -body { toplevel .t wm override .t 1 wm geometry .t +0+0 update - set result [list [winfo rootx .t] [winfo rooty .t]] + list [winfo rootx .t] [winfo rooty .t] +} -cleanup { destroy .t - set result -} {0 0} -test winWm-1.2 {TkWmMapWindow} win { +} -result {0 0} +test winWm-1.2 {TkWmMapWindow} -constraints win -setup { + destroy .t +} -body { toplevel .t wm transient .t . update @@ -47,40 +36,47 @@ test winWm-1.2 {TkWmMapWindow} win { update wm deiconify . update - catch {wm iconify .t} msg + wm iconify .t +} -cleanup { destroy .t - set msg -} {can't iconify ".t": it is a transient} -test winWm-1.3 {TkWmMapWindow} win { +} -returnCodes error -result {can't iconify ".t": it is a transient} +test winWm-1.3 {TkWmMapWindow} -constraints win -setup { + destroy .t +} -body { toplevel .t update toplevel .t2 update - set result [expr {[winfo x .t] != [winfo x .t2]}] + expr {[winfo x .t] != [winfo x .t2]} +} -cleanup { destroy .t .t2 - set result -} 1 -test winWm-1.4 {TkWmMapWindow} win { +} -result 1 +test winWm-1.4 {TkWmMapWindow} -constraints win -setup { + destroy .t +} -body { toplevel .t wm geometry .t +10+10 update toplevel .t2 wm geometry .t2 +40+10 update - set result [list [winfo x .t] [winfo x .t2]] + list [winfo x .t] [winfo x .t2] +} -cleanup { destroy .t .t2 - set result -} {10 40} -test winWm-1.5 {TkWmMapWindow} win { +} -result {10 40} +test winWm-1.5 {TkWmMapWindow} -constraints win -setup { + destroy .t +} -body { toplevel .t wm iconify .t update - set result [wm state .t] - destroy .t - set result -} iconic + wm state .t +} -result {iconic} + -test winWm-2.1 {TkpWmSetState} win { +test winWm-2.1 {TkpWmSetState} -constraints win -setup { + destroy .t +} -body { toplevel .t wm geometry .t 150x50+10+10 update @@ -91,10 +87,12 @@ test winWm-2.1 {TkpWmSetState} win { wm deiconify .t update lappend result [wm state .t] +} -cleanup { + destroy .t +} -result {normal iconic normal} +test winWm-2.2 {TkpWmSetState} -constraints win -setup { destroy .t - set result -} {normal iconic normal} -test winWm-2.2 {TkpWmSetState} win { +} -body { toplevel .t wm geometry .t 150x50+10+10 update @@ -106,12 +104,14 @@ test winWm-2.2 {TkpWmSetState} win { update lappend result [wm state .t] wm deiconify .t - update + update lappend result [wm state .t] +} -cleanup { + destroy .t +} -result {normal withdrawn iconic normal} +test winWm-2.3 {TkpWmSetState} -constraints win -setup { destroy .t - set result -} {normal withdrawn iconic normal} -test winWm-2.3 {TkpWmSetState} win { +} -body { toplevel .t wm geometry .t 150x50+10+10 update @@ -123,13 +123,15 @@ test winWm-2.3 {TkpWmSetState} win { update lappend result [wm state .t] wm state .t normal - update + update lappend result [wm state .t] +} -cleanup { + destroy .t +} -result {normal withdrawn iconic normal} +test winWm-2.4 {TkpWmSetState} -constraints win -setup { destroy .t - set result -} {normal withdrawn iconic normal} -test winWm-2.4 {TkpWmSetState} win { set result {} +} -body { toplevel .t wm geometry .t 150x50+10+10 update @@ -143,11 +145,16 @@ test winWm-2.4 {TkpWmSetState} win { wm deiconify .t update lappend result [list [wm state .t] [wm geometry .t]] +} -cleanup { destroy .t - set result -} {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}} +} -result {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}} + -test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win { +test winWm-3.1 {ConfigureTopLevel: window geometry propagation} -constraints { + win +} -setup { + destroy .t +} -body { toplevel .t wm geometry .t +0+0 button .t.b @@ -161,13 +168,30 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win { update pack .t.b update - set x [expr {$x == [winfo x .t.b]}] + expr {$x == [winfo x .t.b]} +} -cleanup { + destroy .t +} -result 1 + + +test winWm-4.1 {ConfigureTopLevel: menu resizing} -constraints win -setup { + destroy .t +} -body { + toplevel .t + frame .t.f -width 100 -height 50 + pack .t.f + menu .t.m + .t.m add command -label "thisisreallylong" + .t configure -menu .t.m + wm geometry .t -0-0 + update + set menuheight [winfo y .t] + .t.m add command -label "thisisreallylong" + wm geometry .t -0-0 + update + set menuheight [expr {$menuheight - [winfo y .t]}] destroy .t - set x -} 1 -test winWm-4.1 {ConfigureTopLevel: menu resizing} win { - set result {} toplevel .t frame .t.f -width 150 -height 50 -background red pack .t.f @@ -178,18 +202,21 @@ test winWm-4.1 {ConfigureTopLevel: menu resizing} win { .t.m add command -label foo .t configure -menu .t.m update - set result [expr {$y - [winfo y .t]}] + expr {$y - [winfo y .t] eq $menuheight + 1} +} -cleanup { destroy .t - set result -} [expr {$menuheight + 1}] +} -result 1 + # This test works on 8.0p2 but has not worked on anything since 8.2. # It would be very strange to have a windows application increase the size # of the clientarea when a menu wraps so I believe this test to be wrong. # Original result was {50 50 50} new result may depend on the default menu # font -test winWm-5.1 {UpdateGeometryInfo: menu resizing} win { +test winWm-5.1 {UpdateGeometryInfo: menu resizing} -constraints win -setup { + destroy .t set result {} +} -body { toplevel .t frame .t.f -width 150 -height 50 -background red pack .t.f @@ -204,11 +231,12 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} win { .t.m add command -label "thisisreallylong" update lappend result [winfo height .t] +} -cleanup { + destroy .t +} -result {50 50 31} +test winWm-5.2 {UpdateGeometryInfo: menu resizing} -constraints win -setup { destroy .t - - set result -} {50 50 31} -test winWm-5.2 {UpdateGeometryInfo: menu resizing} win { +} -body { set result {} toplevel .t frame .t.f -width 150 -height 50 -background red @@ -226,29 +254,41 @@ test winWm-5.2 {UpdateGeometryInfo: menu resizing} win { lappend result [winfo height .t] lappend result [expr {$y - [winfo rooty .t]}] destroy .t - set result -} {50 50 0} + return $result +} -cleanup { + destroy .t +} -result {50 50 0} -test winWm-6.1 {wm attributes} win { +test winWm-6.1 {wm attributes} -constraints win -setup { destroy .t +} -body { toplevel .t wm attributes .t -} {-alpha 1.0 -transparentcolor {} -disabled 0 -fullscreen 0 -toolwindow 0 -topmost 0} -test winWm-6.2 {wm attributes} win { +} -cleanup { destroy .t +} -result {-alpha 1.0 -transparentcolor {} -disabled 0 -fullscreen 0 -toolwindow 0 -topmost 0} +test winWm-6.2 {wm attributes} -constraints win -setup { + destroy .t +} -body { toplevel .t wm attributes .t -disabled -} {0} -test winWm-6.3 {wm attributes} win { - # This isn't quite the correct error message yet, but it works. +} -cleanup { destroy .t +} -result {0} +test winWm-6.3 {wm attributes} -constraints win -setup { + destroy .t +} -body { + # This isn't quite the correct error message yet, but it works. toplevel .t - list [catch {wm attributes .t -foo} msg] $msg -} {1 {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}} + wm attributes .t -foo +} -cleanup { + destroy .t +} -returnCodes error -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"} -test winWm-6.4 {wm attributes -alpha} win { - # Expect this to return all 1.0 {} on pre-2K/XP +test winWm-6.4 {wm attributes -alpha} -constraints win -setup { destroy .t +} -body { + # Expect this to return all 1.0 {} on pre-2K/XP toplevel .t set res [wm attributes .t -alpha] # we don't return on set yet @@ -258,72 +298,94 @@ test winWm-6.4 {wm attributes -alpha} win { lappend res [wm attributes .t -alpha] lappend res [wm attributes .t -alpha 100] lappend res [wm attributes .t -alpha] - set res -} {1.0 {} 0.5 {} 0.0 {} 1.0} + return $res +} -cleanup { + destroy .t +} -result {1.0 {} 0.5 {} 0.0 {} 1.0} -test winWm-6.5 {wm attributes -alpha} win { +test winWm-6.5 {wm attributes -alpha} -constraints win -setup { destroy .t +} -body { toplevel .t - list [catch {wm attributes .t -alpha foo} msg] $msg -} {1 {expected floating-point number but got "foo"}} + wm attributes .t -alpha foo +} -cleanup { + destroy .t +} -returnCodes error -result {expected floating-point number but got "foo"} -test winWm-6.6 {wm attributes -alpha} win { - # This test is just to show off -alpha +test winWm-6.6 {wm attributes -alpha} -constraints win -setup { destroy .t +} -body { + # This test is just to show off -alpha toplevel .t wm attributes .t -alpha 0.2 pack [label .t.l -text "Alpha Toplevel" -font "Helvetica 18 bold"] tk::PlaceWindow .t center update if {$::tcl_platform(osVersion) >= 5.0} { - for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} { - wm attributes .t -alpha $i - update idle - after 20 - } - for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} { - wm attributes .t -alpha $i - update idle - after 20 - } + for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} { + wm attributes .t -alpha $i + update idle + after 20 + } + for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} { + wm attributes .t -alpha $i + update idle + after 20 } -} {} + } +} -cleanup { + destroy .t +} -result {} -test winWm-6.7 {wm attributes -transparentcolor} win { - # Expect this to return all "" on pre-2K/XP +test winWm-6.7 {wm attributes -transparentcolor} -constraints win -setup { destroy .t - toplevel .t set res {} +} -body { + # Expect this to return all "" on pre-2K/XP + toplevel .t lappend res [wm attributes .t -transparentcolor] # we don't return on set yet lappend res [wm attributes .t -trans black] lappend res [wm attributes .t -trans] lappend res [wm attributes .t -trans "#FFFFFF"] lappend res [wm attributes .t -trans] +} -cleanup { destroy .t - set res -} [list {} {} black {} "#FFFFFF"] +} -result [list {} {} black {} "#FFFFFF"] -test winWm-6.8 {wm attributes -transparentcolor} win { +test winWm-6.8 {wm attributes -transparentcolor} -constraints win -setup { + destroy .t +} -body { destroy .t toplevel .t - list [catch {wm attributes .t -tr foo} msg] $msg -} {1 {unknown color name "foo"}} + wm attributes .t -tr foo +} -cleanup { + destroy .t +} -returnCodes error -result {unknown color name "foo"} -test winWm-7.1 {deiconify on an unmapped toplevel\ - will raise the window and set the focus} win { + +test winWm-7.1 {deiconify on an unmapped toplevel will raise \ + the window and set the focus} -constraints { + win +} -setup { destroy .t +} -body { toplevel .t lower .t focus -force . wm deiconify .t update list [wm stackorder .t isabove .] [focus] -} {1 .t} +} -cleanup { + destroy .t +} -result {1 .t} test winWm-7.2 {deiconify on an already mapped toplevel\ - will raise the window and set the focus} win { + will raise the window and set the focus} -constraints { + win +} -setup { destroy .t +} -body { toplevel .t lower .t update @@ -331,9 +393,13 @@ test winWm-7.2 {deiconify on an already mapped toplevel\ wm deiconify .t update list [wm stackorder .t isabove .] [focus] -} {1 .t} +} -cleanup { + destroy .t +} -result {1 .t} -test winWm-7.3 {UpdateWrapper must maintain Z order} win { +test winWm-7.3 {UpdateWrapper must maintain Z order} -constraints win -setup { + destroy .t +} -body { destroy .t toplevel .t lower .t @@ -342,10 +408,13 @@ test winWm-7.3 {UpdateWrapper must maintain Z order} win { wm resizable .t 0 0 update list $res [wm stackorder .t isbelow .] -} {1 1} +} -cleanup { + destroy .t +} -result {1 1} -test winWm-7.4 {UpdateWrapper must maintain focus} win { +test winWm-7.4 {UpdateWrapper must maintain focus} -constraints win -setup { destroy .t +} -body { toplevel .t focus -force .t update @@ -353,20 +422,26 @@ test winWm-7.4 {UpdateWrapper must maintain focus} win { wm resizable .t 0 0 update list $res [focus] -} {.t .t} +} -cleanup { + destroy .t +} -result {.t .t} -test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} win { - list [catch {wm iconph .} msg] $msg -} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}} -test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} win { + +test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} -constraints win -body { + wm iconph . +} -returnCodes error -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"} +test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} -constraints win -setup { destroy .t +} -body { toplevel .t image create photo blank16 -width 16 -height 16 image create photo blank32 -width 32 -height 32 # This should just make blank icons for the window wm iconphoto .t blank16 blank32 image delete blank16 blank32 -} {} +} -cleanup { + destroy .t +} -result {} test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constraints win -setup { proc winwm90click {w} { @@ -396,7 +471,6 @@ test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constrai pack [button $w.b -text "Do dialog" -command [list winwm90proc2 $w]] bind $w.b <Map> {bind %W <Map> {}; after idle {winwm90click %W}} } - destroy .t global winwm90done set winwm90done wait toplevel .t @@ -411,7 +485,7 @@ test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constrai rename winwm90$cmd {} } destroy .tx .t .sd -} -result {ok} +} -result {ok} test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win -setup { proc winwm91click {w} { @@ -465,7 +539,7 @@ test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -setup frame .t.f -background blue -height 200 -width 200 frame .t.f.x -background red -height 100 -width 100 } -body { - pack .t.f.x + pack .t.f.x pack .t.f lappend aid [after 2000 {set ::winwm92 timeout}] [after 100 { wm manage .t.f @@ -488,7 +562,7 @@ test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -setup set winwm92 } -cleanup { destroy .t.f.x .t.f .t - unset -nocomplain winwm92 aid + unset -nocomplain winwm92 aid id } -result ok destroy .t @@ -500,3 +574,4 @@ return # Local variables: # mode: tcl # End: + diff --git a/tests/window.test b/tests/window.test index 2c8f19d..fea695a 100644 --- a/tests/window.test +++ b/tests/window.test @@ -5,42 +5,48 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands -testConstraint unthreaded [expr { - (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded)) -}] -namespace import -force ::tk::test::loadTkCommand +namespace import ::tk::test::loadTkCommand update # XXX This file is woefully incomplete. Right now it only tests # a few parts of a few procedures in tkWindow.c -test window-1.1 {Tk_CreateWindowFromPath procedure, parent dead} { +# ---------------------------------------------------------------------- + +test window-1.1 {Tk_CreateWindowFromPath procedure, parent dead} -setup { + destroy .t +} -body { proc bgerror msg { - global x errorInfo - set x [list $msg $errorInfo] + global x errorInfo + set x [list $msg $errorInfo] } + set x unchanged - catch {destroy .t} frame .t -width 100 -height 50 place .t -x 10 -y 10 bind .t <Destroy> {button .t.b -text hello; pack .t.b} update destroy .t update - rename bgerror {} set x -} {{can't create window: parent has been destroyed} {can't create window: parent has been destroyed +} -cleanup { + rename bgerror {} +} -result {{can't create window: parent has been destroyed} {can't create window: parent has been destroyed while executing "button .t.b -text hello" (command bound to event)}} + # Most of the tests below don't produce meaningful results; they # will simply dump core if there are bugs. -test window-2.1 {Tk_DestroyWindow procedure, destroy handler deletes parent} { +test window-2.1 {Tk_DestroyWindow procedure, destroy handler deletes parent} -setup { + destroy .t +} -body { toplevel .t -width 300 -height 200 wm geometry .t +0+0 frame .t.f -width 200 -height 200 -relief raised -bd 2 @@ -50,8 +56,10 @@ test window-2.1 {Tk_DestroyWindow procedure, destroy handler deletes parent} { bind .t.f <Destroy> {destroy .t} update destroy .t.f -} {} -test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} { +} -result {} +test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} -setup { + destroy .t +} -body { toplevel .t -width 300 -height 200 wm geometry .t +0+0 frame .t.f -width 200 -height 200 -relief raised -bd 2 @@ -61,8 +69,10 @@ test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} { bind .t.f.f <Destroy> {destroy .t} update destroy .t.f -} {} -test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} { +} -result {} +test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} -setup { + destroy .f +} -body { frame .f -width 80 -height 120 -relief raised -bd 2 place .f -relx 0.5 -rely 0.5 -anchor center toplevel .f.t -width 300 -height 200 @@ -73,10 +83,11 @@ test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} { place .f.t.f.f -relx 1 -rely 1 -anchor se update destroy .f -} {} +} -result {} -test window-2.4 {Tk_DestroyWindow, cleanup half dead window at exit} \ - unixOrWin { +test window-2.4 {Tk_DestroyWindow, cleanup half dead window at exit} -constraints { + unixOrWin +} -body { set code [loadTkCommand] append code { update @@ -85,16 +96,17 @@ test window-2.4 {Tk_DestroyWindow, cleanup half dead window at exit} \ } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { - set error 1 + set error 1 } else { - set error 0 + set error 0 } removeFile script list $error $msg -} {0 {}} +} -result {0 {}} -test window-2.5 {Tk_DestroyWindow, cleanup half dead windows at exit} \ - unixOrWin { +test window-2.5 {Tk_DestroyWindow, cleanup half dead windows at exit} -constraints { + unixOrWin +} -body { set code [loadTkCommand] append code { toplevel .t @@ -104,16 +116,17 @@ test window-2.5 {Tk_DestroyWindow, cleanup half dead windows at exit} \ } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { - set error 1 + set error 1 } else { - set error 0 + set error 0 } removeFile script list $error $msg -} {0 {}} +} -result {0 {}} -test window-2.6 {Tk_DestroyWindow, cleanup half dead windows at exit} \ - unixOrWin { +test window-2.6 {Tk_DestroyWindow, cleanup half dead windows at exit} -constraints { + unixOrWin +} -body { set code [loadTkCommand] append code { toplevel .t @@ -123,16 +136,17 @@ test window-2.6 {Tk_DestroyWindow, cleanup half dead windows at exit} \ } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { - set error 1 + set error 1 } else { - set error 0 + set error 0 } removeFile script list $error $msg -} {0 {}} +} -result {0 {}} -test window-2.7 {Tk_DestroyWindow, cleanup half dead windows at exit} \ - unixOrWin { +test window-2.7 {Tk_DestroyWindow, cleanup half dead windows at exit} -constraints { + unixOrWin +} -body { set code [loadTkCommand] append code { toplevel .t @@ -143,16 +157,17 @@ test window-2.7 {Tk_DestroyWindow, cleanup half dead windows at exit} \ } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { - set error 1 + set error 1 } else { - set error 0 + set error 0 } removeFile script list $error $msg -} {0 {}} +} -result {0 {}} -test window-2.8 {Tk_DestroyWindow, cleanup half dead windows at exit} \ - unixOrWin { +test window-2.8 {Tk_DestroyWindow, cleanup half dead windows at exit} -constraints { + unixOrWin +} -body { set code [loadTkCommand] append code { toplevel .t1 @@ -166,17 +181,17 @@ test window-2.8 {Tk_DestroyWindow, cleanup half dead windows at exit} \ } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { - set error 1 + set error 1 } else { - set error 0 + set error 0 } removeFile script list $error $msg -} {0 {}} +} -result {0 {}} -# window-2.9 deadlocks threaded Tk [Bug 1715716] -test window-2.9 {Tk_DestroyWindow, Destroy bindings - evaluated after exit} {unixOrWin unthreaded} { +test window-2.9 {Tk_DestroyWindow, Destroy bindings evaluated after exit} -constraints { + unixOrWin +} -body { set code [loadTkCommand] append code { toplevel .t1 @@ -188,17 +203,18 @@ test window-2.9 {Tk_DestroyWindow, Destroy bindings } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { - set error 1 + set error 1 } else { - set error 0 + set error 0 } removeFile script list $error $msg -} {0 {Destroy .t2 +} -result {0 {Destroy .t2 Destroy .t1}} -test window-2.10 {Tk_DestroyWindow, Destroy binding - evaluated once} unixOrWin { +test window-2.10 {Tk_DestroyWindow, Destroy binding evaluated once} -constraints { + unixOrWin +} -body { set code [loadTkCommand] append code { update @@ -211,16 +227,17 @@ test window-2.10 {Tk_DestroyWindow, Destroy binding } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { - set error 1 + set error 1 } else { - set error 0 + set error 0 } removeFile script list $error $msg -} {0 {Destroy .}} +} -result {0 {Destroy .}} -test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} \ - unixOrWin { +test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} -constraints { + unixOrWin +} -body { set code [loadTkCommand] append code { toplevel .t1 @@ -238,17 +255,20 @@ test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} \ } set script [makeFile $code script] if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { - set error 1 + set error 1 } else { - set error 0 + set error 0 } removeFile script list $error $msg -} {0 YES} +} -result {0 YES} -test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ - {unix testmenubar} { - catch {destroy .t} + +test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints { + unix testmenubar +} -setup { + destroy .t +} -body { toplevel .t -width 300 -height 200 wm geometry .t +0+0 pack [entry .t.e] @@ -256,10 +276,14 @@ test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ testmenubar window .t .t.f update # If stacking order isn't handle properly, generates an X error. -} {} -test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} \ - {unix testmenubar} { - catch {destroy .t} +} -cleanup { + destroy .t +} -result {} +test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints { + unix testmenubar +} -setup { + destroy .t +} -body { toplevel .t -width 300 -height 200 wm geometry .t +0+0 pack [entry .t.e] @@ -270,23 +294,39 @@ test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} \ testmenubar window .t .t.f update # If stacking order isn't handled properly, generates an X error. -} {} +} -cleanup { + destroy .t +} -result {} + -test window-4.1 {Tk_NameToWindow procedure} {testmenubar} { - catch {destroy .t} - list [catch {winfo geometry .t} msg] $msg -} {1 {bad window path name ".t"}} -test window-4.2 {Tk_NameToWindow procedure} {testmenubar} { - catch {destroy .t} +test window-4.1 {Tk_NameToWindow procedure} -constraints { + testmenubar +} -setup { + destroy .t +} -body { + winfo geometry .t +} -cleanup { + destroy .t +} -returnCodes error -result {bad window path name ".t"} +test window-4.2 {Tk_NameToWindow procedure} -constraints { + testmenubar +} -setup { + destroy .t +} -body { frame .t -width 100 -height 50 place .t -x 10 -y 10 update - list [catch {winfo geometry .t} msg] $msg -} {0 100x50+10+10} + winfo geometry .t +} -cleanup { + destroy .t +} -returnCodes ok -result {100x50+10+10} + -test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ - {unix testmenubar} { - catch {destroy .t} +test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints { + unix testmenubar +} -setup { + destroy .t +} -body { toplevel .t -width 300 -height 200 wm geometry .t +0+0 pack [entry .t.e] @@ -297,8 +337,15 @@ test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ lower .t.e2 .t.f update # If stacking order isn't handled properly, generates an X error. -} {} +} -cleanup { + destroy .t +} -result {} + # cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/winfo.test b/tests/winfo.test index 4ce87eb..14c2838 100644 --- a/tests/winfo.test +++ b/tests/winfo.test @@ -6,8 +6,9 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands # eatColors -- @@ -15,22 +16,22 @@ tcltest::loadTestedCommands # use up all the slots in the colormap. # # Arguments: -# w - Name of toplevel window to create. -# options - Options for w, such as "-colormap new". +# w - Name of toplevel window to create. +# options - Options for w, such as "-colormap new". proc eatColors {w {options ""}} { - catch {destroy $w} + destroy $w eval toplevel $w $options wm geom $w +0+0 canvas $w.c -width 400 -height 200 -bd 0 pack $w.c for {set y 0} {$y < 8} {incr y} { - for {set x 0} {$x < 40} {incr x} { - set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] - $w.c create rectangle [expr 10*$x] [expr 20*$y] \ - [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ - -fill $color - } + for {set x 0} {$x < 40} {incr x} { + set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] + $w.c create rectangle [expr 10*$x] [expr 20*$y] \ + [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ + -fill $color + } } update } @@ -38,57 +39,69 @@ proc eatColors {w {options ""}} { # XXX - This test file is woefully incomplete. At present, only a # few of the winfo options are tested. -test winfo-1.1 {"winfo atom" command} { - list [catch {winfo atom} msg] $msg -} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}} -test winfo-1.2 {"winfo atom" command} { - list [catch {winfo atom a b} msg] $msg -} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}} -test winfo-1.3 {"winfo atom" command} { - list [catch {winfo atom a b c d} msg] $msg -} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}} -test winfo-1.4 {"winfo atom" command} { - list [catch {winfo atom -displayof geek foo} msg] $msg -} {1 {bad window path name "geek"}} -test winfo-1.5 {"winfo atom" command} { +# ---------------------------------------------------------------------- + +test winfo-1.1 {"winfo atom" command} -body { + winfo atom +} -returnCodes error -result {wrong # args: should be "winfo atom ?-displayof window? name"} +test winfo-1.2 {"winfo atom" command} -body { + winfo atom a b +} -returnCodes error -result {wrong # args: should be "winfo atom ?-displayof window? name"} +test winfo-1.3 {"winfo atom" command} -body { + winfo atom a b c d +} -returnCodes error -result {wrong # args: should be "winfo atom ?-displayof window? name"} +test winfo-1.4 {"winfo atom" command} -body { + winfo atom -displayof geek foo +} -returnCodes error -result {bad window path name "geek"} +test winfo-1.5 {"winfo atom" command} -body { winfo atom PRIMARY -} 1 -test winfo-1.6 {"winfo atom" command} { +} -result 1 +test winfo-1.6 {"winfo atom" command} -body { winfo atom -displayof . PRIMARY -} 1 - -test winfo-2.1 {"winfo atomname" command} { - list [catch {winfo atomname} msg] $msg -} {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}} -test winfo-2.2 {"winfo atomname" command} { - list [catch {winfo atomname a b} msg] $msg -} {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}} -test winfo-2.3 {"winfo atomname" command} { - list [catch {winfo atomname a b c d} msg] $msg -} {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}} -test winfo-2.4 {"winfo atomname" command} { - list [catch {winfo atomname -displayof geek foo} msg] $msg -} {1 {bad window path name "geek"}} -test winfo-2.5 {"winfo atomname" command} { - list [catch {winfo atomname 44215} msg] $msg -} {1 {no atom exists with id "44215"}} -test winfo-2.6 {"winfo atomname" command} { +} -result 1 + + +test winfo-2.1 {"winfo atomname" command} -body { + winfo atomname +} -returnCodes error -result {wrong # args: should be "winfo atomname ?-displayof window? id"} +test winfo-2.2 {"winfo atomname" command} -body { + winfo atomname a b +} -returnCodes error -result {wrong # args: should be "winfo atomname ?-displayof window? id"} +test winfo-2.3 {"winfo atomname" command} -body { + winfo atomname a b c d +} -returnCodes error -result {wrong # args: should be "winfo atomname ?-displayof window? id"} +test winfo-2.4 {"winfo atomname" command} -body { + winfo atomname -displayof geek foo +} -returnCodes error -result {bad window path name "geek"} +test winfo-2.5 {"winfo atomname" command} -body { + winfo atomname 44215 +} -returnCodes error -result {no atom exists with id "44215"} +test winfo-2.6 {"winfo atomname" command} -body { winfo atomname 2 -} SECONDARY -test winfo-2.7 {"winfo atom" command} { +} -result SECONDARY +test winfo-2.7 {"winfo atom" command} -body { winfo atomname -displayof . 2 -} SECONDARY - -test winfo-3.1 {"winfo colormapfull" command} defaultPseudocolor8 { - list [catch {winfo colormapfull} msg] $msg -} {1 {wrong # args: should be "winfo colormapfull window"}} -test winfo-3.2 {"winfo colormapfull" command} defaultPseudocolor8 { - list [catch {winfo colormapfull a b} msg] $msg -} {1 {wrong # args: should be "winfo colormapfull window"}} -test winfo-3.3 {"winfo colormapfull" command} defaultPseudocolor8 { - list [catch {winfo colormapfull foo} msg] $msg -} {1 {bad window path name "foo"}} -test winfo-3.4 {"winfo colormapfull" command} {unix defaultPseudocolor8} { +} -result SECONDARY + + +test winfo-3.1 {"winfo colormapfull" command} -constraints { + defaultPseudocolor8 +} -body { + winfo colormapfull +} -returnCodes error -result {wrong # args: should be "winfo colormapfull window"} +test winfo-3.2 {"winfo colormapfull" command} -constraints { + defaultPseudocolor8 +} -body { + winfo colormapfull a b +} -returnCodes error -result {wrong # args: should be "winfo colormapfull window"} +test winfo-3.3 {"winfo colormapfull" command} -constraints { + defaultPseudocolor8 +} -body { + winfo colormapfull foo +} -returnCodes error -result {bad window path name "foo"} +test winfo-3.4 {"winfo colormapfull" command} -constraints { + unix defaultPseudocolor8 +} -body { eatColors .t {-colormap new} set result [list [winfo colormapfull .] [winfo colormapfull .t]] .t.c delete 34 @@ -99,69 +112,103 @@ test winfo-3.4 {"winfo colormapfull" command} {unix defaultPseudocolor8} { lappend result [winfo colormapfull .t] destroy .t.c lappend result [winfo colormapfull .t] -} {0 1 0 0 1 0} -catch {destroy .t} - -toplevel .t -width 550 -height 400 -frame .t.f -width 80 -height 60 -bd 2 -relief raised -place .t.f -x 50 -y 50 -wm geom .t +0+0 -update -test winfo-4.1 {"winfo containing" command} { - list [catch {winfo containing 22} msg] $msg -} {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}} -test winfo-4.2 {"winfo containing" command} { - list [catch {winfo containing a b c} msg] $msg -} {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}} -test winfo-4.3 {"winfo containing" command} { - list [catch {winfo containing a b c d e} msg] $msg -} {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}} -test winfo-4.4 {"winfo containing" command} { - list [catch {winfo containing -displayof geek 25 30} msg] $msg -} {1 {bad window path name "geek"}} -test winfo-4.5 {"winfo containing" command} { +} -cleanup { + destroy .t +} -result {0 1 0 0 1 0} + + + +test winfo-4.1 {"winfo containing" command} -body { + winfo containing 22 +} -returnCodes error -result {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"} +test winfo-4.2 {"winfo containing" command} -body { + winfo containing a b c +} -returnCodes error -result {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"} +test winfo-4.3 {"winfo containing" command} -body { + winfo containing a b c d e +} -returnCodes error -result {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"} +test winfo-4.4 {"winfo containing" command} -body { + winfo containing -displayof geek 25 30 +} -returnCodes error -result {bad window path name "geek"} +test winfo-4.5 {"winfo containing" command} -body { +} -setup { + destroy .t +} -body { + toplevel .t -width 550 -height 400 + frame .t.f -width 80 -height 60 -bd 2 -relief raised + place .t.f -x 50 -y 50 + wm geom .t +0+0 + update + raise .t winfo containing [winfo rootx .t.f] [winfo rooty .t.f] -} .t.f -test winfo-4.6 {"winfo containing" command} {nonPortable} { +} -cleanup { + destroy .t +} -result .t.f +test winfo-4.6 {"winfo containing" command} -constraints { + nonPortable +} -setup { + destroy .t +} -body { + toplevel .t -width 550 -height 400 + frame .t.f -width 80 -height 60 -bd 2 -relief raised + place .t.f -x 50 -y 50 + wm geom .t +0+0 + update + winfo containing [expr [winfo rootx .t.f]-1] [expr [winfo rooty .t.f]-1] -} .t -test winfo-4.7 {"winfo containing" command} { +} -cleanup { + destroy .t +} -result .t +test winfo-4.7 {"winfo containing" command} -setup { + destroy .t +} -body { + toplevel .t -width 550 -height 400 + frame .t.f -width 80 -height 60 -bd 2 -relief raised + place .t.f -x 50 -y 50 + wm geom .t +0+0 + update + set x [winfo containing -display .t.f [expr [winfo rootx .t]+600] \ - [expr [winfo rooty .t.f]+450]] + [expr [winfo rooty .t.f]+450]] expr {($x == ".") || ($x == "")} -} {1} -destroy .t - -test winfo-5.1 {"winfo interps" command} { - list [catch {winfo interps a} msg] $msg -} {1 {wrong # args: should be "winfo interps ?-displayof window?"}} -test winfo-5.2 {"winfo interps" command} { - list [catch {winfo interps a b c} msg] $msg -} {1 {wrong # args: should be "winfo interps ?-displayof window?"}} -test winfo-5.3 {"winfo interps" command} { - list [catch {winfo interps -displayof geek} msg] $msg -} {1 {bad window path name "geek"}} -test winfo-5.4 {"winfo interps" command} unix { - expr [lsearch -exact [winfo interps] [tk appname]] >= 0 -} {1} -test winfo-5.5 {"winfo interps" command} unix { - expr [lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0 -} {1} - -test winfo-6.1 {"winfo exists" command} { - list [catch {winfo exists} msg] $msg -} {1 {wrong # args: should be "winfo exists window"}} -test winfo-6.2 {"winfo exists" command} { - list [catch {winfo exists a b} msg] $msg -} {1 {wrong # args: should be "winfo exists window"}} -test winfo-6.3 {"winfo exists" command} { +} -cleanup { + destroy .t +} -result {1} + + +test winfo-5.1 {"winfo interps" command} -body { + winfo interps a +} -returnCodes error -result {wrong # args: should be "winfo interps ?-displayof window?"} +test winfo-5.2 {"winfo interps" command} -body { + winfo interps a b c +} -returnCodes error -result {wrong # args: should be "winfo interps ?-displayof window?"} +test winfo-5.3 {"winfo interps" command} -body { + winfo interps -displayof geek +} -returnCodes error -result {bad window path name "geek"} +test winfo-5.4 {"winfo interps" command} -constraints unix -body { + expr {[lsearch -exact [winfo interps] [tk appname]] >= 0} +} -result {1} +test winfo-5.5 {"winfo interps" command} -constraints unix -body { + expr {[lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0} +} -result {1} + + +test winfo-6.1 {"winfo exists" command} -body { + winfo exists +} -returnCodes error -result {wrong # args: should be "winfo exists window"} +test winfo-6.2 {"winfo exists" command} -body { + winfo exists a b +} -returnCodes error -result {wrong # args: should be "winfo exists window"} +test winfo-6.3 {"winfo exists" command} -body { winfo exists gorp -} {0} -test winfo-6.4 {"winfo exists" command} { +} -result {0} +test winfo-6.4 {"winfo exists" command} -body { winfo exists . -} {1} -test winfo-6.5 {"winfo exists" command} { +} -result {1} +test winfo-6.5 {"winfo exists" command} -setup { + destroy .b +} -body { button .b -text "Test button" set x [winfo exists .b] pack .b @@ -169,78 +216,113 @@ test winfo-6.5 {"winfo exists" command} { bind .b <Destroy> {lappend x [winfo exists .x]} destroy .b lappend x [winfo exists .x] -} {1 0 0} - -catch {destroy .b} -button .b -text "Help" -update -test winfo-7.1 {"winfo pathname" command} { - list [catch {winfo pathname} msg] $msg -} {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}} -test winfo-7.2 {"winfo pathname" command} { - list [catch {winfo pathname a b} msg] $msg -} {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}} -test winfo-7.3 {"winfo pathname" command} { - list [catch {winfo pathname a b c d} msg] $msg -} {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}} -test winfo-7.4 {"winfo pathname" command} { - list [catch {winfo pathname -displayof geek 25} msg] $msg -} {1 {bad window path name "geek"}} -test winfo-7.5 {"winfo pathname" command} { - list [catch {winfo pathname xyz} msg] $msg -} {1 {expected integer but got "xyz"}} -test winfo-7.6 {"winfo pathname" command} { - list [catch {winfo pathname 224} msg] $msg -} {1 {window id "224" doesn't exist in this application}} -test winfo-7.7 {"winfo pathname" command} { +} -result {1 0 0} + + +test winfo-7.1 {"winfo pathname" command} -body { + winfo pathname +} -returnCodes error -result {wrong # args: should be "winfo pathname ?-displayof window? id"} +test winfo-7.2 {"winfo pathname" command} -body { + winfo pathname a b +} -returnCodes error -result {wrong # args: should be "winfo pathname ?-displayof window? id"} +test winfo-7.3 {"winfo pathname" command} -body { + winfo pathname a b c d +} -returnCodes error -result {wrong # args: should be "winfo pathname ?-displayof window? id"} +test winfo-7.4 {"winfo pathname" command} -body { + winfo pathname -displayof geek 25 +} -returnCodes error -result {bad window path name "geek"} +test winfo-7.5 {"winfo pathname" command} -body { + winfo pathname xyz +} -returnCodes error -result {expected integer but got "xyz"} +test winfo-7.6 {"winfo pathname" command} -body { + winfo pathname 224 +} -returnCodes error -result {window id "224" doesn't exist in this application} +test winfo-7.7 {"winfo pathname" command} -setup { + destroy .b + button .b -text "Help" + update +} -body { winfo pathname -displayof .b [winfo id .] -} {.} -test winfo-7.8 {"winfo pathname" command} {unix testwrapper} { +} -cleanup { + destroy .b +} -result {.} +test winfo-7.8 {"winfo pathname" command} -constraints { + unix testwrapper +} -body { winfo pathname [testwrapper .] -} {} +} -result {} -test winfo-8.1 {"winfo pointerx" command} { + +test winfo-8.1 {"winfo pointerx" command} -setup { + destroy .b + button .b -text "Help" + update +} -body { + catch [winfo pointerx .b] +} -body { catch [winfo pointerx .b] -} 1 -test winfo-8.2 {"winfo pointery" command} { +} -result 1 +test winfo-8.2 {"winfo pointery" command} -setup { + destroy .b + button .b -text "Help" + update +} -body { catch [winfo pointery .b] -} 1 -test winfo-8.3 {"winfo pointerxy" command} { +} -body { + catch [winfo pointerx .b] +} -result 1 +test winfo-8.3 {"winfo pointerxy" command} -setup { + destroy .b + button .b -text "Help" + update +} -body { catch [winfo pointerxy .b] -} 1 - -test winfo-9.1 {"winfo viewable" command} { - list [catch {winfo viewable} msg] $msg -} {1 {wrong # args: should be "winfo viewable window"}} -test winfo-9.2 {"winfo viewable" command} { - list [catch {winfo viewable foo} msg] $msg -} {1 {bad window path name "foo"}} -test winfo-9.3 {"winfo viewable" command} { +} -body { + catch [winfo pointerx .b] +} -result 1 + + +test winfo-9.1 {"winfo viewable" command} -body { + winfo viewable +} -returnCodes error -result {wrong # args: should be "winfo viewable window"} +test winfo-9.2 {"winfo viewable" command} -body { + winfo viewable foo +} -returnCodes error -result {bad window path name "foo"} +test winfo-9.3 {"winfo viewable" command} -body { winfo viewable . -} {1} -test winfo-9.4 {"winfo viewable" command} { +} -result {1} +test winfo-9.4 {"winfo viewable" command} -body { wm iconify . winfo viewable . -} {0} -wm deiconify . -test winfo-9.5 {"winfo viewable" command} { +} -cleanup { + wm deiconify . +} -result {0} +test winfo-9.5 {"winfo viewable" command} -setup { + deleteWindows +} -body { frame .f1 -width 100 -height 100 -relief raised -bd 2 place .f1 -x 0 -y 0 frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 place .f1.f2 -x 0 -y 0 update list [winfo viewable .f1] [winfo viewable .f1.f2] -} {1 1} -test winfo-9.6 {"winfo viewable" command} { +} -cleanup { + deleteWindows +} -result {1 1} +test winfo-9.6 {"winfo viewable" command} -setup { deleteWindows +} -body { frame .f1 -width 100 -height 100 -relief raised -bd 2 frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 place .f1.f2 -x 0 -y 0 update list [winfo viewable .f1] [winfo viewable .f1.f2] -} {0 0} -test winfo-9.7 {"winfo viewable" command} { +} -cleanup { + deleteWindows +} -result {0 0} +test winfo-9.7 {"winfo viewable" command} -setup { deleteWindows +} -body { frame .f1 -width 100 -height 100 -relief raised -bd 2 place .f1 -x 0 -y 0 frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 @@ -248,121 +330,156 @@ test winfo-9.7 {"winfo viewable" command} { update wm iconify . list [winfo viewable .f1] [winfo viewable .f1.f2] -} {0 0} -wm deiconify . -deleteWindows +} -cleanup { + wm deiconify . + deleteWindows +} -result {0 0} -test winfo-10.1 {"winfo visualid" command} { - list [catch {winfo visualid} msg] $msg -} {1 {wrong # args: should be "winfo visualid window"}} -test winfo-10.2 {"winfo visualid" command} { - list [catch {winfo visualid gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test winfo-10.3 {"winfo visualid" command} { - expr 2+[winfo visualid .]-[winfo visualid .] -} {2} - -test winfo-11.1 {"winfo visualid" command} { - list [catch {winfo visualsavailable} msg] $msg -} {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}} -test winfo-11.2 {"winfo visualid" command} { - list [catch {winfo visualsavailable gorp} msg] $msg -} {1 {bad window path name "gorp"}} -test winfo-11.3 {"winfo visualid" command} { - list [catch {winfo visualsavailable . includeids foo} msg] $msg -} {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}} -test winfo-11.4 {"winfo visualid" command} { + +test winfo-10.1 {"winfo visualid" command} -body { + winfo visualid +} -returnCodes error -result {wrong # args: should be "winfo visualid window"} +test winfo-10.2 {"winfo visualid" command} -body { + winfo visualid gorp +} -returnCodes error -result {bad window path name "gorp"} +test winfo-10.3 {"winfo visualid" command} -body { + expr {2 + [winfo visualid .] - [winfo visualid .]} +} -result {2} + + +test winfo-11.1 {"winfo visualid" command} -body { + winfo visualsavailable +} -returnCodes error -result {wrong # args: should be "winfo visualsavailable window ?includeids?"} +test winfo-11.2 {"winfo visualid" command} -body { + winfo visualsavailable gorp +} -returnCodes error -result {bad window path name "gorp"} +test winfo-11.3 {"winfo visualid" command} -body { + winfo visualsavailable . includeids foo +} -returnCodes error -result {wrong # args: should be "winfo visualsavailable window ?includeids?"} +test winfo-11.4 {"winfo visualid" command} -body { llength [lindex [winfo visualsa .] 0] -} {2} -test winfo-11.5 {"winfo visualid" command} { +} -result {2} +test winfo-11.5 {"winfo visualid" command} -body { llength [lindex [winfo visualsa . includeids] 0] -} {3} -test winfo-11.6 {"winfo visualid" command} { +} -result {3} +test winfo-11.6 {"winfo visualid" command} -body { set x [lindex [lindex [winfo visualsa . includeids] 0] 2] expr $x + 2 - $x -} {2} +} -result {2} + + +test winfo-12.1 {GetDisplayOf procedure} -body { + winfo atom - foo x +} -returnCodes error -result {wrong # args: should be "winfo atom ?-displayof window? name"} +test winfo-12.2 {GetDisplayOf procedure} -body { + winfo atom -d bad_window x +} -returnCodes error -result {bad window path name "bad_window"} -test winfo-12.1 {GetDisplayOf procedure} { - list [catch {winfo atom - foo x} msg] $msg -} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}} -test winfo-12.2 {GetDisplayOf procedure} { - list [catch {winfo atom -d bad_window x} msg] $msg -} {1 {bad window path name "bad_window"}} # Some embedding tests -# +# +test winfo-13.1 {root coordinates of embedded toplevel} -setup { + deleteWindows +} -body { + frame .con -container 1 + pack .con -expand yes -fill both + toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + button .emb.b + pack .emb.b -expand yes -fill both + update + + list rootx [expr {[winfo rootx .emb] == [winfo rootx .con]}] \ + rooty [expr {[winfo rooty .emb] == [winfo rooty .con]}] +} -cleanup { + deleteWindows +} -result {rootx 1 rooty 1} -proc MakeEmbed {} { +test winfo-13.2 {destroying embedded toplevel} -setup { + deleteWindows +} -body { frame .con -container 1 pack .con -expand yes -fill both toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 button .emb.b pack .emb.b -expand yes -fill both update -} -test winfo-13.1 {root coordinates of embedded toplevel} { - MakeEmbed - set z [expr [winfo rootx .emb] == [winfo rootx .con] && \ - [winfo rooty .emb] == [winfo rooty .con]] - destroy .emb - destroy .con - set z -} {1} -test winfo-13.2 {destroying embedded toplevel} { + destroy .emb update - expr [winfo exists .emb.b] || [winfo exists .con] -} 0 + list embedded [winfo exists .emb.b] container [winfo exists .con] +} -cleanup { + deleteWindows +} -result {embedded 0 container 1} -deleteWindows +test winfo-13.3 {destroying container window} -setup { + deleteWindows +} -body { + frame .con -container 1 + pack .con -expand yes -fill both + toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + button .emb.b + pack .emb.b -expand yes -fill both + update -test winfo-13.3 {destroying container window} { - MakeEmbed destroy .con update - set z [expr [winfo exists .emb.b] || [winfo exists .emb]] - catch {destroy .emb} - catch {destroy .con} - set z -} 0 + list child [winfo exists .emb.b] parent [winfo exists .emb] +} -cleanup { + deleteWindows +} -result {child 0 parent 0} -deleteWindows +test winfo-13.4 {[winfo containing] with embedded windows} -setup { + deleteWindows +} -body { + frame .con -container 1 + pack .con -expand yes -fill both + toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + button .emb.b + pack .emb.b -expand yes -fill both + update -test winfo-13.4 {[winfo containing] with embedded windows} { - MakeEmbed button .b pack .b -expand yes -fill both update + string compare .emb.b \ + [winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] +} -cleanup { + deleteWindows +} -result 0 - set z [string compare \ - [winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] .emb.b] - catch {destroy .con} - catch {destroy .emb} - set z -} 0 -test winfo-14.1 {usage} { - list [catch {winfo ismapped} msg] $msg -} {1 {wrong # args: should be "winfo ismapped window"}} +test winfo-14.1 {usage} -body { + winfo ismapped +} -returnCodes error -result {wrong # args: should be "winfo ismapped window"} -test winfo-14.2 {usage} { - list [catch {winfo ismapped . .} msg] $msg -} {1 {wrong # args: should be "winfo ismapped window"}} +test winfo-14.2 {usage} -body { + winfo ismapped . . +} -returnCodes error -result {wrong # args: should be "winfo ismapped window"} -test winfo-14.3 {initially unmapped} { - catch {destroy .t} +test winfo-14.3 {initially unmapped} -setup { + destroy .t +} -body { toplevel .t winfo ismapped .t -} 0 +} -cleanup { + destroy .t +} -result 0 -test winfo-14.4 {mapped at idle time} { - catch {destroy .t} +test winfo-14.4 {mapped at idle time} -setup { + destroy .t +} -body { toplevel .t update idletasks winfo ismapped .t -} 1 +} -cleanup { + destroy .t +} -result 1 deleteWindows # cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/tests/wm.test b/tests/wm.test index 15526e7..1aa0779 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -641,16 +641,16 @@ test wm-geometry-1.3 {usage} -returnCodes error -body { wm geometry . bogus } -result {bad geometry specifier "bogus"} -test wm-geometry-2.1 {setting values} -setup { - set result {} -} -body { +test wm-geometry-2.1 {setting values} -body { wm geometry .t 150x150+50+50 update - lappend result [wm geometry .t] + set result [wm geometry .t] wm geometry .t {} update - lappend result [string equal [wm geometry .t] "150x150+50+50"] -} -result [list 150x150+50+50 0] + return [list $result [string equal [wm geometry .t] $result]] +} -cleanup { + unset result +} -match glob -result [list 150x150+*+* 0] ### wm grid ### @@ -1354,6 +1354,7 @@ test wm-stackorder-2.3 {stacking order} -body { toplevel .t ; update toplevel .t2 ; update raise . + raiseDelay raise .t2 raiseDelay wm stackorder . @@ -1704,6 +1705,7 @@ test wm-transient-4.1 {transient toplevel is withdrawn test wm-transient-4.2 {already mapped transient toplevel is withdrawn if master is iconic} -body { toplevel .master + raiseDelay wm iconify .master update toplevel .subject diff --git a/tests/xmfbox.test b/tests/xmfbox.test index b60bf48..f50329c 100644 --- a/tests/xmfbox.test +++ b/tests/xmfbox.test @@ -1,4 +1,4 @@ -# xmfbox.test -- +# xmfbox.test -- # # This file is a Tcl script to test the file dialog that's used # when the tk_strictMotif flag is set. Because the file dialog @@ -10,89 +10,104 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands set testPWD [pwd] -catch {unset foo} - catch {unset data foo} proc cleanup {} { global testPWD set err0 [catch { - cd $testPWD + cd $testPWD } msg0] set err1 [catch { - if [file exists ./~nosuchuser1] { - file delete ./~nosuchuser1 - } + if [file exists ./~nosuchuser1] { + file delete ./~nosuchuser1 + } } msg1] set err2 [catch { - if [file exists ./~nosuchuser2] { - file delete ./~nosuchuser2 - } + if [file exists ./~nosuchuser2] { + file delete ./~nosuchuser2 + } } msg2] set err3 [catch { - if [file exists ./~nosuchuser3] { - file delete ./~nosuchuser3 - } + if [file exists ./~nosuchuser3] { + file delete ./~nosuchuser3 + } } msg3] set err4 [catch { - if [file exists ./~nosuchuser4] { - file delete ./~nosuchuser4 - } + if [file exists ./~nosuchuser4] { + file delete ./~nosuchuser4 + } } msg4] if {$err0 || $err1 || $err2 || $err3 || $err4} { - error [list $msg0 $msg1 $msg2 $msg3 $msg4] + error [list $msg0 $msg1 $msg2 $msg3 $msg4] } catch {unset foo} - catch {destroy .foo} + destroy .foo } -test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} unix { +# ---------------------------------------------------------------------- + +test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} -constraints { + unix +} -setup { catch {unset foo} +} -body { set x [tk::MotifFDialog_Create foo open {-parent .}] - catch {destroy $x} - set x -} .foo +} -cleanup { + destroy $x +} -result {.foo} -test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} unix { +test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} -constraints { + unix +} -setup { catch {unset foo} + deleteWindows +} -body { toplevel .bar wm geometry .bar +0+0 set x [tk::MotifFDialog_Create foo open {-parent .bar}] - catch {destroy $x} - catch {destroy .bar} - set x -} .bar.foo +} -cleanup { + destroy $x + destroy .bar +} -result {.bar.foo} -test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} unix { + +test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} -constraints { + unix +} -body { cleanup file mkdir ./~nosuchuser1 set x [tk::MotifFDialog_Create foo open {}] $::tk::dialog::file::foo(fEnt) delete 0 end $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1 set kk [tk::MotifFDialog_InterpFilter $x] -} [list $testPWD/~nosuchuser1 *] +} -result "$testPWD/~nosuchuser1 *" -test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} unix { +test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} -constraints { + unix +} -body { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] $::tk::dialog::file::foo(fEnt) delete 0 end $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1 set kk [tk::MotifFDialog_InterpFilter $x] -} [list $testPWD ./~nosuchuser1] +} -result "$testPWD ./~nosuchuser1" -test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} unix { +test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} -constraints { + unix +} -body { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] @@ -101,17 +116,21 @@ test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} unix { tk::MotifFDialog_InterpFilter $x tk::MotifFDialog_Update $x $::tk::dialog::file::foo(fList) get end -} ~nosuchuser1 +} -result {~nosuchuser1} -test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} unix { +test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} -constraints { + unix +} -body { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1] expr {$i >= 0} -} 1 +} -result 1 -test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} unix { +test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} -constraints { + unix +} -body { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] @@ -120,9 +139,11 @@ test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} unix { $::tk::dialog::file::foo(fList) selection set $i tk::MotifFDialog_BrowseFList $x $::tk::dialog::file::foo(sEnt) get -} $testPWD/~nosuchuser1 +} -result "$testPWD/~nosuchuser1" -test xmfbox-2.6 {tk::MotifFDialog_ActivateFList, ~ in file names} unix { +test xmfbox-2.6 {tk::MotifFDialog_ActivateFList, ~ in file names} -constraints { + unix +} -body { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] @@ -133,9 +154,13 @@ test xmfbox-2.6 {tk::MotifFDialog_ActivateFList, ~ in file names} unix { tk::MotifFDialog_ActivateFList $x list $::tk::dialog::file::foo(selectPath) \ $::tk::dialog::file::foo(selectFile) $tk::Priv(selectFilePath) -} [list $testPWD ~nosuchuser1 $testPWD/~nosuchuser1] +} -result "$testPWD ~nosuchuser1 $testPWD/~nosuchuser1" # cleanup cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: diff --git a/unix/Makefile.in b/unix/Makefile.in index 83e6667..96f1408 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -8,6 +8,7 @@ # 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@ @@ -49,7 +50,7 @@ INSTALL_ROOT = $(DESTDIR) TK_LIBRARY = @TK_LIBRARY@ # Path to use at runtime to refer to LIB_INSTALL_DIR: -LIB_RUNTIME_DIR = $(libdir) +LIB_RUNTIME_DIR = @LIB_RUNTIME_DIR@ # Directory in which to install the program wish: BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir) @@ -229,7 +230,7 @@ INSTALL_DATA_DIR = ${INSTALL} -d -m 755 # libraries. See configure.in for a description of what it means. # The value of the symbol is normally set by the configure script. -SHLIB_CFLAGS = @SHLIB_CFLAGS@ +SHLIB_CFLAGS = @SHLIB_CFLAGS@ -DBUILD_tk # To enable support for stubs in Tcl. STUB_LIB_FILE = @TK_STUB_LIB_FILE@ @@ -284,6 +285,12 @@ LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@ # support for embedded libraries on Darwin / Mac OS X DYLIB_INSTALL_DIR = ${LIB_RUNTIME_DIR} +# support for building the Aqua resource file +TK_RSRC_FILE = @TK_RSRC_FILE@ +WISH_RSRC_FILE = @WISH_RSRC_FILE@ +REZ = @REZ@ +REZ_SWITCHES = @REZ_FLAGS@ -i $(GENERIC_DIR) -i $(TCL_GENERIC_DIR) + # support for Xft: XFT_CFLAGS = @XFT_CFLAGS@ XFT_LIBS = @XFT_LIBS@ @@ -326,7 +333,7 @@ CC_SWITCHES_NO_STUBS = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS} \ ${NO_DEPRECATED_FLAGS} @EXTRA_CC_SWITCHES@ -CC_SWITCHES = $(CC_SWITCHES_NO_STUBS) ${TCL_STUB_FLAGS} +CC_SWITCHES = $(CC_SWITCHES_NO_STUBS) @TCL_STUB_FLAGS@ APP_CC_SWITCHES = $(CC_SWITCHES_NO_STUBS) @EXTRA_APP_CC_SWITCHES@ @@ -348,7 +355,8 @@ CANV_OBJS = tkCanvas.o tkCanvArc.o tkCanvBmap.o tkCanvImg.o \ tkCanvLine.o tkCanvPoly.o tkCanvPs.o tkCanvText.o \ tkCanvUtil.o tkCanvWind.o tkRectOval.o tkTrig.o -IMAGE_OBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPPM.o tkImgPhoto.o +IMAGE_OBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPNG.o tkImgPPM.o \ + tkImgPhoto.o tkImgPhInstance.o TEXT_OBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \ tkTextMark.o tkTextTag.o tkTextWind.o @@ -357,7 +365,8 @@ TEXT_OBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \ # FONT_OBJS = @UNIX_FONT_OBJS@ -GENERIC_OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o \ +GENERIC_OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkBusy.o \ + tkClipboard.o \ tkCmds.o tkColor.o tkConfig.o tkConsole.o tkCursor.o tkError.o \ tkEvent.o tkFocus.o tkFont.o tkGet.o tkGC.o tkGeometry.o tkGrab.o \ tkGrid.o tkMain.o tkObj.o tkOldConfig.o tkOption.o tkPack.o tkPlace.o \ @@ -372,7 +381,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 @@ -411,7 +420,8 @@ TTK_DECLS = \ GENERIC_SRCS = \ $(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \ $(GENERIC_DIR)/tkAtom.c $(GENERIC_DIR)/tkBind.c \ - $(GENERIC_DIR)/tkBitmap.c $(GENERIC_DIR)/tkClipboard.c \ + $(GENERIC_DIR)/tkBitmap.c $(GENERIC_DIR)/tkBusy.c \ + $(GENERIC_DIR)/tkClipboard.c \ $(GENERIC_DIR)/tkCmds.c $(GENERIC_DIR)/tkColor.c \ $(GENERIC_DIR)/tkConfig.c $(GENERIC_DIR)/tkCursor.c \ $(GENERIC_DIR)/tkError.c $(GENERIC_DIR)/tkEvent.c \ @@ -438,15 +448,16 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tkCanvWind.c $(GENERIC_DIR)/tkRectOval.c \ $(GENERIC_DIR)/tkTrig.c $(GENERIC_DIR)/tkImage.c \ $(GENERIC_DIR)/tkImgBmap.c $(GENERIC_DIR)/tkImgGIF.c \ - $(GENERIC_DIR)/tkImgPPM.c \ - $(GENERIC_DIR)/tkImgPhoto.c $(GENERIC_DIR)/tkText.c \ + $(GENERIC_DIR)/tkImgPNG.c $(GENERIC_DIR)/tkImgPPM.c \ + $(GENERIC_DIR)/tkImgPhoto.c $(GENERIC_DIR)/tkImgPhInstance.c \ + $(GENERIC_DIR)/tkText.c \ $(GENERIC_DIR)/tkTextBTree.c $(GENERIC_DIR)/tkTextDisp.c \ $(GENERIC_DIR)/tkTextImage.c \ $(GENERIC_DIR)/tkTextIndex.c $(GENERIC_DIR)/tkTextMark.c \ $(GENERIC_DIR)/tkTextTag.c $(GENERIC_DIR)/tkTextWind.c \ $(GENERIC_DIR)/tkOldConfig.c $(GENERIC_DIR)/tkOldTest.c \ $(GENERIC_DIR)/tkSquare.c $(GENERIC_DIR)/tkTest.c \ - $(GENERIC_DIR)/tkStubInit.c $(GENERIC_DIR)/tkStubLib.c + $(GENERIC_DIR)/tkStubInit.c TTK_SRCS = \ $(TTK_DIR)/ttkBlink.c \ @@ -524,6 +535,12 @@ AQUA_SRCS = \ SRCS = $(GENERIC_SRCS) $(@TK_WINDOWINGSYSTEM@_SRCS) @PLAT_SRCS@ +AQUA_RESOURCES = \ + $(MAC_OSX_DIR)/tkAboutDlg.r $(MAC_OSX_DIR)/tkMacOSXCursors.r \ + $(MAC_OSX_DIR)/tkMacOSXXCursors.r + +AQUA_WISH_RESOURCES = $(MAC_OSX_DIR)/tkMacOSXAETE.r + AQUA_HDRS = $(MAC_OSX_DIR)/tkMacOSX.h $(GENERIC_DIR)/tkIntXlibDecls.h AQUA_XLIB_HDRS = $(XLIB_DIR)/X11/*.h $(XLIB_DIR)/xbytes.h @@ -576,6 +593,17 @@ ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} rm -f $@ @MAKE_STUB_LIB@ +# Build Aqua resource files +${TK_RSRC_FILE}: $(AQUA_RESOURCES) + rm -f $@ + if test "$(REZ)" != ""; then \ + $(REZ) -o $@ $(REZ_SWITCHES) $(AQUA_RESOURCES); fi + +${WISH_RSRC_FILE}: $(AQUA_WISH_RESOURCES) + rm -f $@ + if test "$(REZ)" != ""; then \ + $(REZ) -o $@ $(REZ_SWITCHES) $(AQUA_WISH_RESOURCES); fi + # Make target which outputs the list of the .o contained in the Tk lib # usefull to build a single big shared library containing Tcl/Tk and other # extensions. used for the Tcl Plugin. -- dl @@ -599,18 +627,18 @@ ${WISH_EXE}: $(TK_STUB_LIB_FILE) $(WISH_OBJS) $(TK_LIB_FILE) @APP_RSRC_FILE@ $(TKTEST_EXE): $(TKTEST_OBJS) $(TK_LIB_FILE) $(MAKE) tktest-real LIB_RUNTIME_DIR="`pwd`:$(TCL_BIN_DIR)" -tktest-real: - ${CC} ${CFLAGS} ${LDFLAGS} $(TKTEST_OBJS) @TK_BUILD_LIB_SPEC@ \ +tktest-real: ${TK_STUB_LIB_FILE} + ${CC} ${CFLAGS} ${LDFLAGS} $(TKTEST_OBJS) ${TK_STUB_LIB_FILE} ${TCL_STUB_LIB_SPEC} @TK_BUILD_LIB_SPEC@ \ $(WISH_LIBS) $(CC_SEARCH_FLAGS) -o $(TKTEST_EXE) -# FIXME: This xttest rule seems to be broken in a number of ways. -# It should use CC_SEARCH_FLAGS, it does not include the shared -# lib location logic from tktest, and it is not clear where this -# test.o object file comes from. -xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE) - ${CC} ${CFLAGS} ${LDFLAGS} test.o tkTest.o tkSquare.o \ - @TK_BUILD_LIB_SPEC@ \ - $(WISH_LIBS) $(LD_SEARCH_FLAGS) -lXt -o xttest +# # FIXME: This xttest rule seems to be broken in a number of ways. It should +# # use CC_SEARCH_FLAGS, it does not include the shared lib location logic from +# # tktest, and it is not clear where this test.o object file comes from. +# +# xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE) ${TK_STUB_LIB_FILE} +# ${CC} ${CFLAGS} ${LDFLAGS} test.o tkTest.o tkSquare.o \ +# @TK_BUILD_LIB_SPEC@ ${TK_STUB_LIB_FILE} ${TCL_STUB_LIB_SPEC} \ +# $(WISH_LIBS) $(LD_SEARCH_FLAGS) -lXt -o xttest # Note, in the target below TCL_LIBRARY needs to be set or else # "make test" won't work in the case where the compilation directory @@ -681,10 +709,6 @@ install-strip: INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \ INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}" -# Note: before running ranlib below, must cd to target directory because -# some ranlibs write to current directory, and this might not always be -# possible (e.g. if installing as root). - install-binaries: $(TK_STUB_LIB_FILE) $(TK_LIB_FILE) ${WISH_EXE} @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" \ "$(PKG_INSTALL_DIR)" "$(CONFIG_INSTALL_DIR)" ; \ @@ -699,7 +723,7 @@ install-binaries: $(TK_STUB_LIB_FILE) $(TK_LIB_FILE) ${WISH_EXE} echo "Creating package index $(PKG_INDEX)"; \ rm -f "$(PKG_INDEX)"; \ (\ - echo "if {[catch {package present Tcl 8.5.0}]} return";\ + echo "if {[catch {package present Tcl 8.6.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 normalize [file join \$$dir $${relative}$(TK_LIB_FILE)]] Tk]";\ @@ -879,7 +903,7 @@ clean: distclean: clean rm -rf Makefile config.status config.cache config.log tkConfig.sh \ - $(PACKAGE).* prototype tkConfig.h *.plist Tk.framework tk.pc + tkConfig.h *.plist Tk.framework tk.pc depend: makedepend -- $(DEPEND_SWITCHES) -- $(SRCS) @@ -922,6 +946,9 @@ tkBind.o: $(GENERIC_DIR)/tkBind.c tkBitmap.o: $(GENERIC_DIR)/tkBitmap.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBitmap.c +tkBusy.o: $(GENERIC_DIR)/tkBusy.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBusy.c + tkClipboard.o: $(GENERIC_DIR)/tkClipboard.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkClipboard.c @@ -1081,12 +1108,18 @@ tkImgBmap.o: $(GENERIC_DIR)/tkImgBmap.c tkImgGIF.o: $(GENERIC_DIR)/tkImgGIF.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgGIF.c +tkImgPNG.o: $(GENERIC_DIR)/tkImgPNG.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPNG.c + tkImgPPM.o: $(GENERIC_DIR)/tkImgPPM.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPPM.c -tkImgPhoto.o: $(GENERIC_DIR)/tkImgPhoto.c +tkImgPhoto.o: $(GENERIC_DIR)/tkImgPhoto.c $(GENERIC_DIR)/tkImgPhoto.h $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPhoto.c +tkImgPhInstance.o: $(GENERIC_DIR)/tkImgPhInstance.c $(GENERIC_DIR)/tkImgPhoto.h + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPhInstance.c + tkOldTest.o: $(GENERIC_DIR)/tkOldTest.c $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tkOldTest.c @@ -1556,17 +1589,17 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tkConfig.h.in $(UNIX_DIR)/tk.pc.in $(M $(MAC_OSX_DIR)/*.sdef $(MAC_OSX_DIR)/configure \ $(DISTDIR)/macosx cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx - mkdir $(DISTDIR)/macosx/Wish.xcode - cp -p $(MAC_OSX_DIR)/Wish.xcode/project.pbxproj \ - $(MAC_OSX_DIR)/Wish.xcode/default.pbxuser \ - $(DISTDIR)/macosx/Wish.xcode - mkdir $(DISTDIR)/macosx/Wish.xcodeproj - cp -p $(MAC_OSX_DIR)/Wish.xcodeproj/project.pbxproj \ - $(MAC_OSX_DIR)/Wish.xcodeproj/default.pbxuser \ - $(DISTDIR)/macosx/Wish.xcodeproj + mkdir $(DISTDIR)/macosx/Tk.xcode + cp -p $(MAC_OSX_DIR)/Tk.xcode/project.pbxproj \ + $(MAC_OSX_DIR)/Tk.xcode/default.pbxuser \ + $(DISTDIR)/macosx/Tk.xcode + mkdir $(DISTDIR)/macosx/Tk.xcodeproj + cp -p $(MAC_OSX_DIR)/Tk.xcodeproj/project.pbxproj \ + $(MAC_OSX_DIR)/Tk.xcodeproj/default.pbxuser \ + $(DISTDIR)/macosx/Tk.xcodeproj mkdir $(DISTDIR)/compat cp -p $(TOP_DIR)/license.terms $(TCLDIR)/compat/unistd.h \ - $(TCLDIR)/compat/stdlib.h $(TCLDIR)/compat/limits.h \ + $(TCLDIR)/compat/stdlib.h \ $(DISTDIR)/compat mkdir $(DISTDIR)/xlib cp -p $(XLIB_DIR)/*.[ch] $(DISTDIR)/xlib @@ -1652,88 +1685,6 @@ BUILD_HTML = \ --srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS) # -# Targets to build Solaris package of the distribution for the current -# architecture. To build stream packages for both sun4 and i86pc -# architectures: -# -# On the sun4 machine, execute the following: -# make distclean; ./configure -# make DISTDIR=<distdir> package -# -# Once the build is complete, execute the following on the i86pc -# machine: -# make DISTDIR=<distdir> package-quick -# -# <distdir> is the absolute path to a directory where the build should -# take place. These steps will generate the $(PACKAGE).sun4 and -# $(PACKAGE).i86pc stream packages. It is important that the packages be -# built in this fashion in order to ensure that the architecture -# independent files are exactly the same, including timestamps, in -# both packages. -# - -PACKAGE=SCRPtk - -package: dist package-config package-common package-binaries package-generate -package-quick: package-config package-binaries package-generate - -# -# Configure for the current architecture in the dist directory. -# -package-config: - mkdir -p $(DISTDIR)/unix/`arch` - cd $(DISTDIR)/unix/`arch`; \ - ../configure --prefix=/opt/SUNWtcl/$(TCLVERSION) \ - --exec_prefix=/opt/SUNWtcl/$(TCLVERSION)/`arch` \ - --with-tcl=$(DISTDIR)/../tcl$(TCLVERSION)/unix/`arch` \ - --enable-shared - mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION) - mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch` - -# -# Build and install the architecture independent files in the dist directory. -# - -package-common: - cd $(DISTDIR)/unix/`arch`;\ - $(MAKE); \ - $(MAKE) install-libraries install-doc \ - prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION) \ - exec_prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch` - mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin - sed -e "s/TCLVERSION/$(TCLVERSION)/g" \ - -e "s/TKVERSION/$(VERSION)/g" < $(UNIX_DIR)/wish.sh \ - > $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin/wish$(VERSION) - chmod 755 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin/wish$(VERSION) - -# -# Build and install the architecture specific files in the dist directory. -# - -package-binaries: - cd $(DISTDIR)/unix/`arch`; \ - $(MAKE); \ - $(MAKE) install-binaries prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION) \ - exec_prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch` - -# -# Generate a package from the installed files in the dist directory for the -# current architecture. -# - -package-generate: - pkgproto $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin=bin \ - $(DISTDIR)/SUNWtcl/$(TCLVERSION)/include=include \ - $(DISTDIR)/SUNWtcl/$(TCLVERSION)/lib=lib \ - $(DISTDIR)/SUNWtcl/$(TCLVERSION)/man=man \ - $(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`=`arch` \ - | $(TCL_EXE) $(TCLDIR)/unix/mkProto.tcl $(TCLVERSION) \ - $(UNIX_DIR) > prototype - pkgmk -o -d . -f prototype -a `arch` - pkgtrans -s . $(PACKAGE).`arch` $(PACKAGE) - rm -rf $(PACKAGE) - -# # The list of all the targets that do not correspond to real files. This stops # 'make' from getting confused when someone makes an error in a rule. # diff --git a/unix/configure b/unix/configure index 1be3cb8..8f9a4ac 100755 --- a/unix/configure +++ b/unix/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.59 for tk 8.5. +# Generated by GNU Autoconf 2.59 for tk 8.6. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation @@ -267,8 +267,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='tk' PACKAGE_TARNAME='tk' -PACKAGE_VERSION='8.5' -PACKAGE_STRING='tk 8.5' +PACKAGE_VERSION='8.6' +PACKAGE_STRING='tk 8.6' PACKAGE_BUGREPORT='' # Factoring default headers for most tests. @@ -308,7 +308,7 @@ ac_includes_default="\ # include <unistd.h> #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_VERSION TCL_PATCH_LEVEL TCL_BIN_DIR TCL_SRC_DIR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCLSH_PROG BUILD_TCLSH MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR ac_ct_AR TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT LIBOBJS XFT_CFLAGS XFT_LIBS UNIX_FONT_OBJS TK_VERSION TK_MAJOR_VERSION TK_MINOR_VERSION TK_PATCH_LEVEL TK_YEAR TK_LIB_FILE TK_LIB_FLAG TK_LIB_SPEC TK_STUB_LIB_FILE TK_STUB_LIB_FLAG TK_STUB_LIB_SPEC TK_STUB_LIB_PATH TK_INCLUDE_SPEC TK_BUILD_STUB_LIB_SPEC TK_BUILD_STUB_LIB_PATH TK_SRC_DIR TK_SHARED_BUILD LD_LIBRARY_PATH_VAR TK_BUILD_LIB_SPEC TCL_STUB_FLAGS XINCLUDES XLIBSW LOCALES TK_WINDOWINGSYSTEM TK_PKG_DIR TK_LIBRARY LIB_RUNTIME_DIR PRIVATE_INCLUDE_DIR HTML_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_WISH_LIBS CFBUNDLELOCALIZATIONS TK_RSRC_FILE WISH_RSRC_FILE LIB_RSRC_FILE APP_RSRC_FILE REZ REZ_FLAGS LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_VERSION TCL_PATCH_LEVEL TCL_BIN_DIR TCL_SRC_DIR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCLSH_PROG BUILD_TCLSH MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT XFT_CFLAGS XFT_LIBS UNIX_FONT_OBJS TK_VERSION TK_MAJOR_VERSION TK_MINOR_VERSION TK_PATCH_LEVEL TK_YEAR TK_LIB_FILE TK_LIB_FLAG TK_LIB_SPEC TK_STUB_LIB_FILE TK_STUB_LIB_FLAG TK_STUB_LIB_SPEC TK_STUB_LIB_PATH TK_INCLUDE_SPEC TK_BUILD_STUB_LIB_SPEC TK_BUILD_STUB_LIB_PATH TK_SRC_DIR TK_SHARED_BUILD LD_LIBRARY_PATH_VAR TK_BUILD_LIB_SPEC TCL_STUB_FLAGS XINCLUDES XLIBSW LOCALES TK_WINDOWINGSYSTEM TK_PKG_DIR TK_LIBRARY LIB_RUNTIME_DIR PRIVATE_INCLUDE_DIR HTML_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_WISH_LIBS CFBUNDLELOCALIZATIONS TK_RSRC_FILE WISH_RSRC_FILE LIB_RSRC_FILE APP_RSRC_FILE REZ REZ_FLAGS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -777,7 +777,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tk 8.5 to adapt to many kinds of systems. +\`configure' configures tk 8.6 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -838,7 +838,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tk 8.5:";; + short | recursive ) echo "Configuration of tk 8.6:";; esac cat <<\_ACEOF @@ -852,7 +852,7 @@ Optional Features: use STRING as a suffix to manpage file names (default: no, tk if enabled without specifying STRING) - --enable-threads build with threads (default: off) + --enable-threads build with threads (default: on) --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (default: off) --enable-64bit-vis enable 64bit Sparc VIS support (default: off) @@ -981,7 +981,7 @@ fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF -tk configure 8.5 +tk configure 8.6 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. @@ -995,7 +995,7 @@ cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tk $as_me 8.5, which was +It was created by tk $as_me 8.6, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ @@ -1335,10 +1335,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -TK_VERSION=8.5 +TK_VERSION=8.6 TK_MAJOR_VERSION=8 -TK_MINOR_VERSION=5 -TK_PATCH_LEVEL=".18" +TK_MINOR_VERSION=6 +TK_PATCH_LEVEL=".4" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -1449,9 +1449,9 @@ echo "$as_me: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" > `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/unix/tclConfig.sh" ; then - ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" - break - fi + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi done fi @@ -1541,13 +1541,18 @@ echo "${ECHO_T}could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6 -if test "${TCL_VERSION}" != "${TK_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;} +if test "${TCL_MAJOR_VERSION}" -ne 8 ; then + { { echo "$as_me:$LINENO: error: ${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.6+ +Found config for Tcl ${TCL_VERSION}" >&5 +echo "$as_me: error: ${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.6+ +Found config for Tcl ${TCL_VERSION}" >&2;} + { (exit 1); exit 1; }; } +fi +if test "${TCL_MINOR_VERSION}" -lt 6 ; then + { { echo "$as_me:$LINENO: error: ${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.6+ +Found config for Tcl ${TCL_VERSION}" >&5 +echo "$as_me: error: ${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.6+ +Found config for Tcl ${TCL_VERSION}" >&2;} { (exit 1); exit 1; }; } fi @@ -2615,8 +2620,82 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -# limits header checks must come early to prevent -# an autoconf bug that throws errors on configure +echo "$as_me:$LINENO: checking for inline" >&5 +echo $ECHO_N "checking for inline... $ECHO_C" >&6 +if test "${ac_cv_c_inline+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_c_inline=no +for ac_kw in inline __inline__ __inline; do + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifndef __cplusplus +typedef int foo_t; +static $ac_kw foo_t static_foo () {return 0; } +$ac_kw foo_t foo () {return 0; } +#endif + +_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_c_inline=$ac_kw; break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +done + +fi +echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5 +echo "${ECHO_T}$ac_cv_c_inline" >&6 + + +case $ac_cv_c_inline in + inline | yes) ;; + *) + case $ac_cv_c_inline in + no) ac_val=;; + *) ac_val=$ac_cv_c_inline;; + esac + cat >>confdefs.h <<_ACEOF +#ifndef __cplusplus +#define inline $ac_val +#endif +_ACEOF + ;; +esac + + +#-------------------------------------------------------------------- +# Supply a substitute for stdlib.h if it doesn't define strtol, +# strtoul, or strtod (which it doesn't in some versions of SunOS). +#-------------------------------------------------------------------- ac_ext=c ac_cpp='$CPP $CPPFLAGS' @@ -3106,164 +3185,6 @@ fi done -if test "${ac_cv_header_limits_h+set}" = set; then - echo "$as_me:$LINENO: checking for limits.h" >&5 -echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 -if test "${ac_cv_header_limits_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -fi -echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 -echo "${ECHO_T}$ac_cv_header_limits_h" >&6 -else - # Is the header compilable? -echo "$as_me:$LINENO: checking limits.h usability" >&5 -echo $ECHO_N "checking limits.h usability... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -$ac_includes_default -#include <limits.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_header_compiler=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_header_compiler=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 -echo "${ECHO_T}$ac_header_compiler" >&6 - -# Is the header present? -echo "$as_me:$LINENO: checking limits.h presence" >&5 -echo $ECHO_N "checking limits.h presence... $ECHO_C" >&6 -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <limits.h> -_ACEOF -if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 - (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then - if test -s conftest.err; then - ac_cpp_err=$ac_c_preproc_warn_flag - ac_cpp_err=$ac_cpp_err$ac_c_werror_flag - else - ac_cpp_err= - fi -else - ac_cpp_err=yes -fi -if test -z "$ac_cpp_err"; then - ac_header_preproc=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_header_preproc=no -fi -rm -f conftest.err conftest.$ac_ext -echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 -echo "${ECHO_T}$ac_header_preproc" >&6 - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in - yes:no: ) - { echo "$as_me:$LINENO: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&5 -echo "$as_me: WARNING: limits.h: accepted by the compiler, rejected by the preprocessor!" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the compiler's result" >&5 -echo "$as_me: WARNING: limits.h: proceeding with the compiler's result" >&2;} - ac_header_preproc=yes - ;; - no:yes:* ) - { echo "$as_me:$LINENO: WARNING: limits.h: present but cannot be compiled" >&5 -echo "$as_me: WARNING: limits.h: present but cannot be compiled" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: check for missing prerequisite headers?" >&5 -echo "$as_me: WARNING: limits.h: check for missing prerequisite headers?" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: see the Autoconf documentation" >&5 -echo "$as_me: WARNING: limits.h: see the Autoconf documentation" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&5 -echo "$as_me: WARNING: limits.h: section \"Present But Cannot Be Compiled\"" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: proceeding with the preprocessor's result" >&5 -echo "$as_me: WARNING: limits.h: proceeding with the preprocessor's result" >&2;} - { echo "$as_me:$LINENO: WARNING: limits.h: in the future, the compiler will take precedence" >&5 -echo "$as_me: WARNING: limits.h: in the future, the compiler will take precedence" >&2;} - ( - cat <<\_ASBOX -## ----------------------------- ## -## Report this to the tk lists. ## -## ----------------------------- ## -_ASBOX - ) | - sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac -echo "$as_me:$LINENO: checking for limits.h" >&5 -echo $ECHO_N "checking for limits.h... $ECHO_C" >&6 -if test "${ac_cv_header_limits_h+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_cv_header_limits_h=$ac_header_preproc -fi -echo "$as_me:$LINENO: result: $ac_cv_header_limits_h" >&5 -echo "${ECHO_T}$ac_cv_header_limits_h" >&6 - -fi -if test $ac_cv_header_limits_h = yes; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_LIMITS_H 1 -_ACEOF - -else - -cat >>confdefs.h <<\_ACEOF -#define NO_LIMITS_H 1 -_ACEOF - -fi - - - -#-------------------------------------------------------------------- -# Supply a substitute for stdlib.h if it doesn't define strtol, -# strtoul, or strtod (which it doesn't in some versions of SunOS). -#-------------------------------------------------------------------- - if test "${ac_cv_header_stdlib_h+set}" = set; then echo "$as_me:$LINENO: checking for stdlib.h" >&5 echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6 @@ -3544,7 +3465,7 @@ if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else - tcl_ok=no + tcl_ok=yes fi; if test "${TCL_THREADS}" = 1; then @@ -4064,384 +3985,6 @@ _ACEOF fi done - echo "$as_me:$LINENO: checking for pthread_attr_get_np" >&5 -echo $ECHO_N "checking for pthread_attr_get_np... $ECHO_C" >&6 -if test "${ac_cv_func_pthread_attr_get_np+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. */ -/* Define pthread_attr_get_np to an innocuous variant, in case <limits.h> declares pthread_attr_get_np. - For example, HP-UX 11i <limits.h> declares gettimeofday. */ -#define pthread_attr_get_np innocuous_pthread_attr_get_np - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char pthread_attr_get_np (); below. - Prefer <limits.h> to <assert.h> if __STDC__ is defined, since - <limits.h> exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include <limits.h> -#else -# include <assert.h> -#endif - -#undef pthread_attr_get_np - -/* 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 pthread_attr_get_np (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_pthread_attr_get_np) || defined (__stub___pthread_attr_get_np) -choke me -#else -char (*f) () = pthread_attr_get_np; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != pthread_attr_get_np; - ; - 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_func_pthread_attr_get_np=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_pthread_attr_get_np=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_pthread_attr_get_np" >&5 -echo "${ECHO_T}$ac_cv_func_pthread_attr_get_np" >&6 -if test $ac_cv_func_pthread_attr_get_np = yes; then - tcl_ok=yes -else - tcl_ok=no -fi - - if test $tcl_ok = yes ; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_PTHREAD_ATTR_GET_NP 1 -_ACEOF - - echo "$as_me:$LINENO: checking for pthread_attr_get_np declaration" >&5 -echo $ECHO_N "checking for pthread_attr_get_np declaration... $ECHO_C" >&6 -if test "${tcl_cv_grep_pthread_attr_get_np+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 <pthread.h> - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "pthread_attr_get_np" >/dev/null 2>&1; then - tcl_cv_grep_pthread_attr_get_np=present -else - tcl_cv_grep_pthread_attr_get_np=missing -fi -rm -f conftest* - -fi -echo "$as_me:$LINENO: result: $tcl_cv_grep_pthread_attr_get_np" >&5 -echo "${ECHO_T}$tcl_cv_grep_pthread_attr_get_np" >&6 - if test $tcl_cv_grep_pthread_attr_get_np = missing ; then - -cat >>confdefs.h <<\_ACEOF -#define ATTRGETNP_NOT_DECLARED 1 -_ACEOF - - fi - else - echo "$as_me:$LINENO: checking for pthread_getattr_np" >&5 -echo $ECHO_N "checking for pthread_getattr_np... $ECHO_C" >&6 -if test "${ac_cv_func_pthread_getattr_np+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. */ -/* Define pthread_getattr_np to an innocuous variant, in case <limits.h> declares pthread_getattr_np. - For example, HP-UX 11i <limits.h> declares gettimeofday. */ -#define pthread_getattr_np innocuous_pthread_getattr_np - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char pthread_getattr_np (); below. - Prefer <limits.h> to <assert.h> if __STDC__ is defined, since - <limits.h> exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include <limits.h> -#else -# include <assert.h> -#endif - -#undef pthread_getattr_np - -/* 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 pthread_getattr_np (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_pthread_getattr_np) || defined (__stub___pthread_getattr_np) -choke me -#else -char (*f) () = pthread_getattr_np; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != pthread_getattr_np; - ; - 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_func_pthread_getattr_np=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_pthread_getattr_np=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_pthread_getattr_np" >&5 -echo "${ECHO_T}$ac_cv_func_pthread_getattr_np" >&6 -if test $ac_cv_func_pthread_getattr_np = yes; then - tcl_ok=yes -else - tcl_ok=no -fi - - if test $tcl_ok = yes ; then - -cat >>confdefs.h <<\_ACEOF -#define HAVE_PTHREAD_GETATTR_NP 1 -_ACEOF - - echo "$as_me:$LINENO: checking for pthread_getattr_np declaration" >&5 -echo $ECHO_N "checking for pthread_getattr_np declaration... $ECHO_C" >&6 -if test "${tcl_cv_grep_pthread_getattr_np+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 <pthread.h> - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "pthread_getattr_np" >/dev/null 2>&1; then - tcl_cv_grep_pthread_getattr_np=present -else - tcl_cv_grep_pthread_getattr_np=missing -fi -rm -f conftest* - -fi -echo "$as_me:$LINENO: result: $tcl_cv_grep_pthread_getattr_np" >&5 -echo "${ECHO_T}$tcl_cv_grep_pthread_getattr_np" >&6 - if test $tcl_cv_grep_pthread_getattr_np = missing ; then - -cat >>confdefs.h <<\_ACEOF -#define GETATTRNP_NOT_DECLARED 1 -_ACEOF - - fi - fi - fi - if test $tcl_ok = no; then - # Darwin thread stacksize API - -for ac_func in pthread_get_stacksize_np -do -as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` -echo "$as_me:$LINENO: checking for $ac_func" >&5 -echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 -if eval "test \"\${$as_ac_var+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. */ -/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func. - For example, HP-UX 11i <limits.h> declares gettimeofday. */ -#define $ac_func innocuous_$ac_func - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func (); below. - Prefer <limits.h> to <assert.h> if __STDC__ is defined, since - <limits.h> exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include <limits.h> -#else -# include <assert.h> -#endif - -#undef $ac_func - -/* 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 $ac_func (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -char (*f) () = $ac_func; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != $ac_func; - ; - 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 - eval "$as_ac_var=yes" -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -eval "$as_ac_var=no" -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 -echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 -if test `eval echo '${'$as_ac_var'}'` = yes; then - cat >>confdefs.h <<_ACEOF -#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - fi LIBS=$ac_saved_libs else TCL_THREADS=0 @@ -4463,8 +4006,8 @@ echo "${ECHO_T}yes (threaded core)" >&6 echo "${ECHO_T}yes" >&6 fi else - echo "$as_me:$LINENO: result: no (default)" >&5 -echo "${ECHO_T}no (default)" >&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi @@ -4698,6 +4241,11 @@ cat >>confdefs.h <<\_ACEOF _ACEOF +cat >>confdefs.h <<\_ACEOF +#define HAVE_HIDDEN 1 +_ACEOF + + fi @@ -4827,10 +4375,6 @@ fi # Require ranlib early so we can override it in special cases below. - if test x"${SHLIB_VERSION}" = x; then - SHLIB_VERSION="1.0" -fi - @@ -4849,13 +4393,16 @@ fi ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g - CFLAGS_OPTIMIZE=-O if test "$GCC" = yes; then + CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall" else - CFLAGS_WARNING="" + + CFLAGS_OPTIMIZE=-O + CFLAGS_WARNING="" + fi if test -n "$ac_tool_prefix"; then @@ -4942,6 +4489,10 @@ fi PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" + if test x"${SHLIB_VERSION}" = x; then + SHLIB_VERSION="1.0" +fi + case $system in AIX-*) if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then @@ -5138,7 +4689,9 @@ fi SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" - DL_OBJS="tclLoadDl.o tclWinError.o" + DL_OBJS="tclLoadDl.o" + PLAT_OBJS='${CYGWIN_OBJS}' + PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" @@ -5422,6 +4975,10 @@ fi SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} +else + + CFLAGS="$CFLAGS -z" + fi @@ -5554,6 +5111,14 @@ fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" + case $LIBOBJS in + "mkstemp.$ac_objext" | \ + *" mkstemp.$ac_objext" | \ + "mkstemp.$ac_objext "* | \ + *" mkstemp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; +esac + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' @@ -5567,6 +5132,14 @@ fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" + case $LIBOBJS in + "mkstemp.$ac_objext" | \ + *" mkstemp.$ac_objext" | \ + "mkstemp.$ac_objext "* | \ + *" mkstemp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; +esac + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' @@ -5600,6 +5173,14 @@ fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" + case $LIBOBJS in + "mkstemp.$ac_objext" | \ + *" mkstemp.$ac_objext" | \ + "mkstemp.$ac_objext "* | \ + *" mkstemp.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; +esac + if test $doRpath = yes; then CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' @@ -6706,7 +6287,7 @@ else arch=`isainfo` echo "$as_me:$LINENO: checking whether to use -lsunmath for fp rounding control" >&5 echo $ECHO_N "checking whether to use -lsunmath for fp rounding control... $ECHO_C" >&6 - if test "$arch" = "amd64 i386"; then + if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 @@ -6905,7 +6486,7 @@ else fi case $system in - SunOS-5.[1-9][0-9]*) + SunOS-5.[1-9][0-9]*|SunOS-5.[7-9]) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; @@ -7068,6 +6649,17 @@ fi fi + if test "$tcl_cv_cc_visibility_hidden" != yes; then + + +cat >>confdefs.h <<\_ACEOF +#define MODULE_SCOPE extern +_ACEOF + + +fi + + if test "$SHARED_LIB_SUFFIX" = ""; then SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}' @@ -7103,15 +6695,14 @@ else if test "$RANLIB" = ""; then MAKE_LIB='$(STLIB_LD) $@ ${OBJS}' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' else MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))' fi + INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' fi @@ -7120,15 +6711,14 @@ fi if test "$RANLIB" = ""; then MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}' - INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' else MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@' - INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))' fi + INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if @@ -8304,7 +7894,7 @@ esac # search path to reflect this. #------------------------------------------------------------------------ -LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}' +LIB_RUNTIME_DIR='$(libdir)' if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib" @@ -10979,6 +10569,79 @@ _ACEOF fi #-------------------------------------------------------------------- +# Check whether XKeycodeToKeysym is deprecated in X11 headers. +#-------------------------------------------------------------------- + +if test $tk_aqua = no && test "$GCC" = yes; then + echo "$as_me:$LINENO: checking whether XKeycodeToKeysym is deprecated" >&5 +echo $ECHO_N "checking whether XKeycodeToKeysym is deprecated... $ECHO_C" >&6 + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS -Werror" + 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> + +int +main () +{ + + XKeycodeToKeysym(0,0,0); + + ; + 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 + + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 + +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + +cat >>confdefs.h <<\_ACEOF +#define XKEYCODETOKEYSYM_IS_DEPRECATED 1 +_ACEOF + + +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$tk_oldCFlags +fi + +#-------------------------------------------------------------------- # XXX Do this last. # It might modify XLIBSW which could affect other tests. # @@ -11505,14 +11168,14 @@ _ACEOF HTML_DIR="${libdir}/Resources/Documentation/Reference/Tk" EXTRA_INSTALL="install-private-headers html-tk" EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TkTOC.html' - EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tk-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' - EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' + EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tk-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' + EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' if test $tk_aqua = yes; then - EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Images to $(LIB_INSTALL_DIR)/Resources" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)/Resources"; done' - EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing wish$(VERSION) script to $(INSTALL_ROOT)/'"${bindir}"'" && mkdir -p "$(INSTALL_ROOT)/'"${bindir}"'" && printf > "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)" "#!/bin/sh\n\"\$$(dirname \$$0)'"`eval d="${bindir}"; echo "$d" | sed -e 's#/[^/][^/]*#/..#g'`"'$(bindir)/Wish\" \"\$$@\"" && chmod +x "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)"' + EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Images to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)/Resources"; done' + EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing wish$(VERSION) script to $(INSTALL_ROOT)/'"${bindir}"'/" && $(INSTALL_DATA_DIR) "$(INSTALL_ROOT)/'"${bindir}"'" && printf > "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)" "#!/bin/sh\n\"\$$(dirname \$$0)'"`eval d="${bindir}"; echo "$d" | sed -e 's#/[^/][^/]*#/..#g'`"'$(bindir)/Wish\" \"\$$@\"" && chmod +x "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)"' bindir="${libdir}/Resources/Wish.app/Contents/MacOS" EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Info.plist to $(BIN_INSTALL_DIR)/.." && $(INSTALL_DATA) Wish-Info.plist "$(BIN_INSTALL_DIR)/../Info.plist" && mv -f "$(BIN_INSTALL_DIR)/wish$(VERSION)" "$(BIN_INSTALL_DIR)/Wish"' - EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.icns to $(BIN_INSTALL_DIR)/../Resources" && mkdir -p "$(BIN_INSTALL_DIR)/../Resources"' + EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.icns to $(BIN_INSTALL_DIR)/../Resources" && $(INSTALL_DATA_DIR) "$(BIN_INSTALL_DIR)/../Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && $(INSTALL_DATA) "$(MAC_OSX_DIR)/Tk.icns" "$(BIN_INSTALL_DIR)/../Resources/Wish.icns"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.sdef to $(BIN_INSTALL_DIR)/../Resources" && $(INSTALL_DATA) "$(MAC_OSX_DIR)/Wish.sdef" "$(BIN_INSTALL_DIR)/../Resources"' fi @@ -11524,7 +11187,7 @@ _ACEOF EXTRA_CC_SWITCHES="$EXTRA_CC_SWITCHES"' -DTK_FRAMEWORK_VERSION=\"$(VERSION)\"' else if test $tk_aqua = yes; then - EXTRA_INSTALL_BINARIES='@echo "Installing Images to $(LIB_INSTALL_DIR)/" && mkdir -p "$(LIB_INSTALL_DIR)" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)"; done' + EXTRA_INSTALL_BINARIES='@echo "Installing Images to $(LIB_INSTALL_DIR)/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)"; done' fi # libdir must be a fully qualified path and not ${exec_prefix}/lib eval libdir="$libdir" @@ -12018,7 +11681,7 @@ _ASBOX } >&5 cat >&5 <<_CSEOF -This file was extended by tk $as_me 8.5, which was +This file was extended by tk $as_me 8.6, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -12076,7 +11739,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -tk config.status 8.5 +tk config.status 8.6 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" @@ -12302,6 +11965,7 @@ s,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@AR@,$AR,;t t s,@ac_ct_AR@,$ac_ct_AR,;t t +s,@LIBOBJS@,$LIBOBJS,;t t s,@TCL_LIBS@,$TCL_LIBS,;t t s,@DL_LIBS@,$DL_LIBS,;t t s,@DL_OBJS@,$DL_OBJS,;t t @@ -12329,7 +11993,6 @@ s,@DLL_INSTALL_DIR@,$DLL_INSTALL_DIR,;t t s,@INSTALL_STUB_LIB@,$INSTALL_STUB_LIB,;t t s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t -s,@LIBOBJS@,$LIBOBJS,;t t s,@XFT_CFLAGS@,$XFT_CFLAGS,;t t s,@XFT_LIBS@,$XFT_LIBS,;t t s,@UNIX_FONT_OBJS@,$UNIX_FONT_OBJS,;t t diff --git a/unix/configure.in b/unix/configure.in index bab5d8a..5a18d46 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tk installation dnl to configure the system for the local environment. -AC_INIT([tk],[8.5]) +AC_INIT([tk],[8.6]) AC_PREREQ(2.59) dnl This is only used when included from macosx/configure.ac @@ -22,10 +22,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ #endif /* _TKCONFIG */]) ]) -TK_VERSION=8.5 +TK_VERSION=8.6 TK_MAJOR_VERSION=8 -TK_MINOR_VERSION=5 -TK_PATCH_LEVEL=".18" +TK_MINOR_VERSION=6 +TK_PATCH_LEVEL=".4" VERSION=${TK_VERSION} LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" @@ -36,10 +36,13 @@ LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv" SC_PATH_TCLCONFIG SC_LOAD_TCLCONFIG -if test "${TCL_VERSION}" != "${TK_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}.]) +if test "${TCL_MAJOR_VERSION}" -ne 8 ; then + AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.6+ +Found config for Tcl ${TCL_VERSION}]) +fi +if test "${TCL_MINOR_VERSION}" -lt 6 ; then + AC_MSG_ERROR([${PACKAGE_NAME} ${PACKAGE_VERSION} requires Tcl 8.6+ +Found config for Tcl ${TCL_VERSION}]) fi SC_PROG_TCLSH @@ -76,12 +79,7 @@ if test "${CFLAGS+set}" != "set" ; then fi AC_PROG_CC - -# limits header checks must come early to prevent -# an autoconf bug that throws errors on configure -AC_CHECK_HEADER(limits.h, - [AC_DEFINE(HAVE_LIMITS_H, 1, [Do we have <limits.h>?])], - [AC_DEFINE(NO_LIMITS_H, 1, [Do we have <limits.h>?])]) +AC_C_INLINE #-------------------------------------------------------------------- # Supply a substitute for stdlib.h if it doesn't define strtol, @@ -152,7 +150,7 @@ AC_C_BIGENDIAN # search path to reflect this. #------------------------------------------------------------------------ -LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}' +LIB_RUNTIME_DIR='$(libdir)' if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib" @@ -575,6 +573,27 @@ if test $tk_aqua = no; then fi #-------------------------------------------------------------------- +# Check whether XKeycodeToKeysym is deprecated in X11 headers. +#-------------------------------------------------------------------- + +if test $tk_aqua = no && test "$GCC" = yes; then + AC_MSG_CHECKING([whether XKeycodeToKeysym is deprecated]) + tk_oldCFlags=$CFLAGS + CFLAGS="$CFLAGS -Werror" + AC_TRY_LINK([ + #include <X11/Xlib.h> + ], [ + XKeycodeToKeysym(0,0,0); + ], [ + AC_MSG_RESULT([no]) + ], [ + AC_MSG_RESULT([yes]) + AC_DEFINE(XKEYCODETOKEYSYM_IS_DEPRECATED, 1, [Is XKeycodeToKeysym deprecated?]) + ]) + CFLAGS=$tk_oldCFlags +fi + +#-------------------------------------------------------------------- # XXX Do this last. # It might modify XLIBSW which could affect other tests. # @@ -709,14 +728,14 @@ if test "$FRAMEWORK_BUILD" = "1" ; then HTML_DIR="${libdir}/Resources/Documentation/Reference/Tk" EXTRA_INSTALL="install-private-headers html-tk" EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TkTOC.html' - EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tk-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' - EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' + EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tk-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"' + EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"' if test $tk_aqua = yes; then - EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Images to $(LIB_INSTALL_DIR)/Resources" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)/Resources"; done' - EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing wish$(VERSION) script to $(INSTALL_ROOT)/'"${bindir}"'" && mkdir -p "$(INSTALL_ROOT)/'"${bindir}"'" && printf > "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)" "#!/bin/sh\n\"\$$(dirname \$$0)'"`eval d="${bindir}"; echo "$d" | sed -e 's#/[^/][^/]*#/..#g'`"'$(bindir)/Wish\" \"\$$@\"" && chmod +x "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)"' + EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Images to $(LIB_INSTALL_DIR)/Resources/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/Resources" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)/Resources"; done' + EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing wish$(VERSION) script to $(INSTALL_ROOT)/'"${bindir}"'/" && $(INSTALL_DATA_DIR) "$(INSTALL_ROOT)/'"${bindir}"'" && printf > "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)" "#!/bin/sh\n\"\$$(dirname \$$0)'"`eval d="${bindir}"; echo "$d" | sed -e 's#/[^/][^/]*#/..#g'`"'$(bindir)/Wish\" \"\$$@\"" && chmod +x "$(INSTALL_ROOT)/'"${bindir}"'/wish$(VERSION)"' bindir="${libdir}/Resources/Wish.app/Contents/MacOS" EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Info.plist to $(BIN_INSTALL_DIR)/.." && $(INSTALL_DATA) Wish-Info.plist "$(BIN_INSTALL_DIR)/../Info.plist" && mv -f "$(BIN_INSTALL_DIR)/wish$(VERSION)" "$(BIN_INSTALL_DIR)/Wish"' - EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.icns to $(BIN_INSTALL_DIR)/../Resources" && mkdir -p "$(BIN_INSTALL_DIR)/../Resources"' + EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.icns to $(BIN_INSTALL_DIR)/../Resources" && $(INSTALL_DATA_DIR) "$(BIN_INSTALL_DIR)/../Resources"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && $(INSTALL_DATA) "$(MAC_OSX_DIR)/Tk.icns" "$(BIN_INSTALL_DIR)/../Resources/Wish.icns"' EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing Wish.sdef to $(BIN_INSTALL_DIR)/../Resources" && $(INSTALL_DATA) "$(MAC_OSX_DIR)/Wish.sdef" "$(BIN_INSTALL_DIR)/../Resources"' fi @@ -728,7 +747,7 @@ if test "$FRAMEWORK_BUILD" = "1" ; then EXTRA_CC_SWITCHES="$EXTRA_CC_SWITCHES"' -DTK_FRAMEWORK_VERSION=\"$(VERSION)\"' else if test $tk_aqua = yes; then - EXTRA_INSTALL_BINARIES='@echo "Installing Images to $(LIB_INSTALL_DIR)/" && mkdir -p "$(LIB_INSTALL_DIR)" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)"; done' + EXTRA_INSTALL_BINARIES='@echo "Installing Images to $(LIB_INSTALL_DIR)/" && $(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)" && for i in Tk.tiff Tk.icns; do $(INSTALL_DATA) "$(MAC_OSX_DIR)/$$i" "$(LIB_INSTALL_DIR)"; done' fi # libdir must be a fully qualified path and not ${exec_prefix}/lib eval libdir="$libdir" diff --git a/unix/install-sh b/unix/install-sh index 7c34c3f..7c34c3f 100755..100644 --- a/unix/install-sh +++ b/unix/install-sh diff --git a/unix/installManPage b/unix/installManPage index 6bdccf0..4d615bf 100755 --- a/unix/installManPage +++ b/unix/installManPage @@ -59,9 +59,7 @@ test -z "$SymOrLoc" && SymOrLoc="$Dir/" # backticks which doesn't pass backslashes literally. # Names=`sed -n ' -# Look for a line, that starts with .SH NAME -# optionally allow NAME to be surrounded -# by quotes. +# Look for a line that starts with .SH NAME /^\.SH NAME/{ # Read next line n @@ -71,6 +69,9 @@ Names=`sed -n ' s/\\\ //g # Delete from \- to the end of line s/ \\\-.*// +# Convert all non-space non-alphanum sequences +# to single underscores. + s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g # print the result and exit p;q }' $ManPage` diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 3005321..41b94ef 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -111,9 +111,9 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ `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/unix/tclConfig.sh" ; then - ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" - break - fi + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi done fi ]) @@ -271,11 +271,10 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Results: # -# Subst the following vars: +# Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE -# #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ @@ -439,11 +438,11 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ # extension can't assume that an executable Tcl shell exists at # build time. # -# Arguments +# Arguments: # none # -# Results -# Subst's the following values: +# Results: +# Substitutes the following vars: # TCLSH_PROG #------------------------------------------------------------------------ @@ -484,11 +483,11 @@ AC_DEFUN([SC_PROG_TCLSH], [ # when running tests from an extension build directory. It is not # correct to use the TCLSH_PROG in cases like this. # -# Arguments +# Arguments: # none # -# Results -# Subst's the following values: +# Results: +# Substitutes the following values: # BUILD_TCLSH #------------------------------------------------------------------------ @@ -618,8 +617,8 @@ AC_DEFUN([SC_ENABLE_FRAMEWORK], [ AC_DEFUN([SC_ENABLE_THREADS], [ AC_ARG_ENABLE(threads, AC_HELP_STRING([--enable-threads], - [build with threads (default: off)]), - [tcl_ok=$enableval], [tcl_ok=no]) + [build with threads (default: on)]), + [tcl_ok=$enableval], [tcl_ok=yes]) if test "${TCL_THREADS}" = 1; then tcl_threaded_core=1; @@ -680,39 +679,6 @@ AC_DEFUN([SC_ENABLE_THREADS], [ ac_saved_libs=$LIBS LIBS="$LIBS $THREADS_LIBS" AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork) - AC_CHECK_FUNC(pthread_attr_get_np,tcl_ok=yes,tcl_ok=no) - if test $tcl_ok = yes ; then - AC_DEFINE(HAVE_PTHREAD_ATTR_GET_NP, 1, - [Do we want a BSD-like thread-attribute interface?]) - AC_CACHE_CHECK([for pthread_attr_get_np declaration], - tcl_cv_grep_pthread_attr_get_np, [ - AC_EGREP_HEADER(pthread_attr_get_np, pthread.h, - tcl_cv_grep_pthread_attr_get_np=present, - tcl_cv_grep_pthread_attr_get_np=missing)]) - if test $tcl_cv_grep_pthread_attr_get_np = missing ; then - AC_DEFINE(ATTRGETNP_NOT_DECLARED, 1, - [Is pthread_attr_get_np() declared in <pthread.h>?]) - fi - else - AC_CHECK_FUNC(pthread_getattr_np,tcl_ok=yes,tcl_ok=no) - if test $tcl_ok = yes ; then - AC_DEFINE(HAVE_PTHREAD_GETATTR_NP, 1, - [Do we want a Linux-like thread-attribute interface?]) - AC_CACHE_CHECK([for pthread_getattr_np declaration], - tcl_cv_grep_pthread_getattr_np, [ - AC_EGREP_HEADER(pthread_getattr_np, pthread.h, - tcl_cv_grep_pthread_getattr_np=present, - tcl_cv_grep_pthread_getattr_np=missing)]) - if test $tcl_cv_grep_pthread_getattr_np = missing ; then - AC_DEFINE(GETATTRNP_NOT_DECLARED, 1, - [Is pthread_getattr_np declared in <pthread.h>?]) - fi - fi - fi - if test $tcl_ok = no; then - # Darwin thread stacksize API - AC_CHECK_FUNCS(pthread_get_stacksize_np) - fi LIBS=$ac_saved_libs else TCL_THREADS=0 @@ -727,7 +693,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [ AC_MSG_RESULT([yes]) fi else - AC_MSG_RESULT([no (default)]) + AC_MSG_RESULT([no]) fi AC_SUBST(TCL_THREADS) @@ -823,7 +789,6 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ # # Defines the following vars: # HAVE_LANGINFO Triggers use of nl_langinfo if defined. -# #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_LANGINFO], [ @@ -1088,6 +1053,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_DEFINE(MODULE_SCOPE, [extern __attribute__((__visibility__("hidden")))], [Compiler support for module scope symbols]) + AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols]) ]) # Step 0.d: Disable -rpath support? @@ -1110,7 +1076,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no) # Require ranlib early so we can override it in special cases below. - AS_IF([test x"${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"]) AC_REQUIRE([AC_PROG_RANLIB]) @@ -1129,16 +1094,20 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ECHO_VERSION='`echo ${VERSION}`' TCL_LIB_VERSIONS_OK=ok CFLAGS_DEBUG=-g - CFLAGS_OPTIMIZE=-O AS_IF([test "$GCC" = yes], [ + CFLAGS_OPTIMIZE=-O2 CFLAGS_WARNING="-Wall" - ], [CFLAGS_WARNING=""]) + ], [ + CFLAGS_OPTIMIZE=-O + CFLAGS_WARNING="" + ]) AC_CHECK_TOOL(AR, ar) STLIB_LD='${AR} cr' LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" PLAT_OBJS="" PLAT_SRCS="" LDAIX_SRC="" + AS_IF([test x"${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"]) case $system in AIX-*) AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [ @@ -1240,7 +1209,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_CFLAGS="" SHLIB_LD='${CC} -shared' SHLIB_SUFFIX=".dll" - DL_OBJS="tclLoadDl.o tclWinError.o" + DL_OBJS="tclLoadDl.o" + PLAT_OBJS='${CYGWIN_OBJS}' + PLAT_SRCS='${CYGWIN_SRCS}' DL_LIBS="-ldl" CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" @@ -1318,6 +1289,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AS_IF([test "$GCC" = yes], [ SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ], [ + CFLAGS="$CFLAGS -z" ]) # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc @@ -1365,6 +1338,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" + AC_LIBOBJ(mkstemp) AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) @@ -1375,6 +1349,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" + AC_LIBOBJ(mkstemp) AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) @@ -1400,6 +1375,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" DL_LIBS="" + AC_LIBOBJ(mkstemp) AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) @@ -1943,7 +1919,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AS_IF([test "$GCC" = yes],[use_sunmath=no],[ arch=`isainfo` AC_MSG_CHECKING([whether to use -lsunmath for fp rounding control]) - AS_IF([test "$arch" = "amd64 i386"], [ + AS_IF([test "$arch" = "amd64 i386" -o "$arch" = "i386"], [ AC_MSG_RESULT([yes]) MATH_LIBS="-lsunmath $MATH_LIBS" AC_CHECK_HEADER(sunmath.h) @@ -1976,7 +1952,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ], [ AS_IF([test "$use_sunmath" = yes], [textmode=textoff],[textmode=text]) case $system in - SunOS-5.[[1-9]][[0-9]]*) + SunOS-5.[[1-9]][[0-9]]*|SunOS-5.[[7-9]]) SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; @@ -2059,6 +2035,11 @@ dnl # preprocessing tests use only CPPFLAGS. *) SHLIB_CFLAGS="-fPIC" ;; esac]) + AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ + AC_DEFINE(MODULE_SCOPE, [extern], + [No Compiler support for module scope symbols]) + ]) + AS_IF([test "$SHARED_LIB_SUFFIX" = ""], [ SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}']) AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [ @@ -2079,21 +2060,19 @@ dnl # preprocessing tests use only CPPFLAGS. AS_IF([test "$RANLIB" = ""], [ MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' ], [ MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@' - INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))' ]) + INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' ]) # Stub lib does not depend on shared/static configuration AS_IF([test "$RANLIB" = ""], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS}' - INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' ], [ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS} ; ${RANLIB} [$]@' - INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))' ]) + INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' # Define TCL_LIBS now that we know what DL_LIBS is. # The trick here is that we don't want to change the value of TCL_LIBS if @@ -2160,124 +2139,6 @@ dnl # preprocessing tests use only CPPFLAGS. ]) #-------------------------------------------------------------------- -# SC_SERIAL_PORT -# -# Determine which interface to use to talk to the serial port. -# Note that #include lines must begin in leftmost column for -# some compilers to recognize them as preprocessor directives, -# and some build environments have stdin not pointing at a -# pseudo-terminal (usually /dev/null instead.) -# -# Arguments: -# none -# -# Results: -# -# Defines only one of the following vars: -# HAVE_SYS_MODEM_H -# USE_TERMIOS -# USE_TERMIO -# USE_SGTTY -# -#-------------------------------------------------------------------- - -AC_DEFUN([SC_SERIAL_PORT], [ - AC_CHECK_HEADERS(sys/modem.h) - AC_CACHE_CHECK([termios vs. termio vs. sgtty], tcl_cv_api_serial, [ - AC_TRY_RUN([ -#include <termios.h> - -int main() { - struct termios t; - if (tcgetattr(0, &t) == 0) { - cfsetospeed(&t, 0); - t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; -}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - if test $tcl_cv_api_serial = no ; then - AC_TRY_RUN([ -#include <termio.h> - -int main() { - struct termio t; - if (ioctl(0, TCGETA, &t) == 0) { - t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; -}], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - fi - if test $tcl_cv_api_serial = no ; then - AC_TRY_RUN([ -#include <sgtty.h> - -int main() { - struct sgttyb t; - if (ioctl(0, TIOCGETP, &t) == 0) { - t.sg_ospeed = 0; - t.sg_flags |= ODDP | EVENP | RAW; - return 0; - } - return 1; -}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - fi - if test $tcl_cv_api_serial = no ; then - AC_TRY_RUN([ -#include <termios.h> -#include <errno.h> - -int main() { - struct termios t; - if (tcgetattr(0, &t) == 0 - || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { - cfsetospeed(&t, 0); - t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; -}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - fi - if test $tcl_cv_api_serial = no; then - AC_TRY_RUN([ -#include <termio.h> -#include <errno.h> - -int main() { - struct termio t; - if (ioctl(0, TCGETA, &t) == 0 - || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { - t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; - return 0; - } - return 1; - }], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) - fi - if test $tcl_cv_api_serial = no; then - AC_TRY_RUN([ -#include <sgtty.h> -#include <errno.h> - -int main() { - struct sgttyb t; - if (ioctl(0, TIOCGETP, &t) == 0 - || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { - t.sg_ospeed = 0; - t.sg_flags |= ODDP | EVENP | RAW; - return 0; - } - return 1; -}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=none, tcl_cv_api_serial=none) - fi]) - case $tcl_cv_api_serial in - termios) AC_DEFINE(USE_TERMIOS, 1, [Use the termios API for serial lines]);; - termio) AC_DEFINE(USE_TERMIO, 1, [Use the termio API for serial lines]);; - sgtty) AC_DEFINE(USE_SGTTY, 1, [Use the sgtty API for serial lines]);; - esac -]) - -#-------------------------------------------------------------------- # SC_MISSING_POSIX_HEADERS # # Supply substitutes for missing POSIX header files. Special @@ -2295,7 +2156,6 @@ int main() { # Defines some of the following vars: # NO_DIRENT_H # NO_VALUES_H -# HAVE_LIMITS_H or NO_LIMITS_H # NO_STDLIB_H # NO_STRING_H # NO_SYS_WAIT_H @@ -2335,9 +2195,6 @@ closedir(d); AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H, 1, [Do we have <float.h>?])]) AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have <values.h>?])]) - AC_CHECK_HEADER(limits.h, - [AC_DEFINE(HAVE_LIMITS_H, 1, [Do we have <limits.h>?])], - [AC_DEFINE(NO_LIMITS_H, 1, [Do we have <limits.h>?])]) AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0) AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0) AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0) @@ -2476,11 +2333,6 @@ AC_DEFUN([SC_BLOCKING_STYLE], [ SC_CONFIG_SYSTEM AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) case $system in - # There used to be code here to use FIONBIO under AIX. However, it - # was reported that FIONBIO doesn't work under AIX 3.2.5. Since - # using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO - # code (JO, 5/31/97). - OSF*) AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?]) AC_MSG_RESULT([FIONBIO]) @@ -3022,37 +2874,6 @@ AC_DEFUN([SC_TCL_GETHOSTBYNAME_R], [AC_CHECK_FUNC(gethostbyname_r, [ ])]) #-------------------------------------------------------------------- -# SC_TCL_GETADDRINFO -# -# Check if we have 'getaddrinfo' -# -# Arguments: -# None -# -# Results: -# Might define the following vars: -# HAVE_GETADDRINFO -# -#-------------------------------------------------------------------- - -AC_DEFUN([SC_TCL_GETADDRINFO], [AC_CHECK_FUNC(getaddrinfo, [ - AC_CACHE_CHECK([for working getaddrinfo], tcl_cv_api_getaddrinfo, [ - AC_TRY_COMPILE([ - #include <netdb.h> - ], [ - const char *name, *port; - struct addrinfo *aiPtr, hints; - (void)getaddrinfo(name,port, &hints, &aiPtr); - (void)freeaddrinfo(aiPtr); - ], tcl_cv_api_getaddrinfo=yes, tcl_cv_getaddrinfo=no)]) - tcl_ok=$tcl_cv_api_getaddrinfo - if test "$tcl_ok" = yes; then - AC_DEFINE(HAVE_GETADDRINFO, 1, - [Define to 1 if getaddrinfo is available.]) - fi -])]) - -#-------------------------------------------------------------------- # SC_TCL_GETPWUID_R # # Check if we have MT-safe variant of getpwuid() and if yes, @@ -3292,6 +3113,26 @@ AC_DEFUN([SC_TCL_GETGRNAM_R], [AC_CHECK_FUNC(getgrnam_r, [ fi ])]) +AC_DEFUN([SC_TCL_IPV6],[ + NEED_FAKE_RFC2553=0 + AC_CHECK_FUNCS(getnameinfo getaddrinfo freeaddrinfo gai_strerror,,[NEED_FAKE_RFC2553=1]) + AC_CHECK_TYPES([ + struct addrinfo, + struct in6_addr, + struct sockaddr_in6, + struct sockaddr_storage],,[NEED_FAKE_RFC2553=1],[[ +#include <sys/types.h> +#include <sys/socket.h> +#include <netinet/in.h> +#include <netdb.h> +]]) +if test "x$NEED_FAKE_RFC2553" = "x1"; then + AC_DEFINE([NEED_FAKE_RFC2553], 1, + [Use compat implementation of getaddrinfo() and friends]) + AC_LIBOBJ([fake-rfc2553]) + AC_CHECK_FUNC(strlcpy) +fi +]) # Local Variables: # mode: autoconf # End: diff --git a/unix/tk.pc.in b/unix/tk.pc.in index a632bc8..68f2130 100644 --- a/unix/tk.pc.in +++ b/unix/tk.pc.in @@ -9,7 +9,7 @@ Name: The Tk Toolkit Description: Tk is a cross-platform graphical user interface toolkit, the standard GUI not only for Tcl, but for many other dynamic languages as well. URL: http://www.tcl.tk/ Version: @TK_VERSION@@TK_PATCH_LEVEL@ -Requires: tcl >= 8.5 -Libs: -L${libdir} @TK_LIB_FLAG@ +Requires: tcl >= 8.6 +Libs: -L${libdir} @TK_LIB_FLAG@ @TK_STUB_LIB_FLAG@ Libs.private: @XFT_LIBS@ @XLIBSW@ Cflags: -I${includedir} diff --git a/unix/tk.spec b/unix/tk.spec index fd51c52..af982f7 100644 --- a/unix/tk.spec +++ b/unix/tk.spec @@ -4,15 +4,15 @@ Name: tk Summary: Tk graphical toolkit for the Tcl scripting language. -Version: 8.5.18 +Version: 8.6.4 Release: 2 License: BSD Group: Development/Languages Source: http://prdownloads.sourceforge.net/tcl/tk%{version}-src.tar.gz URL: http://www.tcl.tk/ Buildroot: /var/tmp/%{name}%{version} -Buildrequires: XFree86-devel tcl >= 8.5.0 -Requires: tcl >= 8.5.0 +Buildrequires: XFree86-devel tcl >= %version +Requires: tcl >= %version %description The Tcl (Tool Command Language) provides a powerful platform for diff --git a/unix/tkAppInit.c b/unix/tkAppInit.c index 422b9e1..13bcdde 100644 --- a/unix/tkAppInit.c +++ b/unix/tkAppInit.c @@ -1,22 +1,53 @@ /* * tkAppInit.c -- * - * Provides a default version of the Tcl_AppInit procedure for use in - * wish and similar Tk-based applications. + * Provides a default version of the main program and Tcl_AppInit + * procedure for wish and other Tk-based applications. * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#undef BUILD_tk +#undef STATIC_BUILD #include "tk.h" -#include "locale.h" #ifdef TK_TEST -extern int Tktest_Init(Tcl_Interp *interp); +extern Tcl_PackageInitProc Tktest_Init; #endif /* TK_TEST */ + +/* + * The following #if block allows you to change the AppInit function by using + * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The + * #if checks for that #define and uses Tcl_AppInit if it doesn't exist. + */ + +#ifndef TK_LOCAL_APPINIT +#define TK_LOCAL_APPINIT Tcl_AppInit +#endif +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif +MODULE_SCOPE int TK_LOCAL_APPINIT(Tcl_Interp *); +MODULE_SCOPE int main(int, char **); + +/* + * The following #if block allows you to change how Tcl finds the startup + * script, prime the library or encoding paths, fiddle with the argv, etc., + * without needing to rewrite Tk_Main() + */ + +#ifdef TK_LOCAL_MAIN_HOOK +MODULE_SCOPE int TK_LOCAL_MAIN_HOOK(int *argc, char ***argv); +#endif + +/* Make sure the stubbed variants of those are never used. */ +#undef Tcl_ObjSetVar2 +#undef Tcl_NewStringObj /* *---------------------------------------------------------------------- @@ -30,7 +61,7 @@ extern int Tktest_Init(Tcl_Interp *interp); * either. * * Side effects: - * Whatever the application does. + * Just about anything, since from here we call arbitrary Tcl code. * *---------------------------------------------------------------------- */ @@ -40,26 +71,7 @@ main( int argc, /* Number of command-line arguments. */ char **argv) /* Values of command-line arguments. */ { - /* - * The following #if block allows you to change the AppInit function by - * using a #define of TCL_LOCAL_APPINIT instead of rewriting this entire - * file. The #if checks for that #define and uses Tcl_AppInit if it - * doesn't exist. - */ - -#ifndef TK_LOCAL_APPINIT -#define TK_LOCAL_APPINIT Tcl_AppInit -#endif - extern int TK_LOCAL_APPINIT (Tcl_Interp *interp); - - /* - * The following #if block allows you to change how Tcl finds the startup - * script, prime the library or encoding paths, fiddle with the argv, - * etc., without needing to rewrite Tk_Main() - */ - #ifdef TK_LOCAL_MAIN_HOOK - extern int TK_LOCAL_MAIN_HOOK (int *argc, char ***argv); TK_LOCAL_MAIN_HOOK(&argc, &argv); #endif @@ -90,19 +102,20 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { - if (Tcl_Init(interp) == TCL_ERROR) { + if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } + if (Tk_Init(interp) == TCL_ERROR) { return TCL_ERROR; } Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); + #ifdef TK_TEST if (Tktest_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tktest", Tktest_Init, - (Tcl_PackageInitProc *) NULL); + Tcl_StaticPackage(interp, "Tktest", Tktest_Init, 0); #endif /* TK_TEST */ /* @@ -113,11 +126,12 @@ Tcl_AppInit( * return TCL_ERROR; * } * - * where "Mod" is the name of the module. + * where "Mod" is the name of the module. (Dynamically-loadable packages + * should have the same entry-point name.) */ /* - * Call Tcl_CreateCommand for application-specific commands, if they + * Call Tcl_CreateObjCommand for application-specific commands, if they * weren't already created by the init procedures called above. */ @@ -125,10 +139,11 @@ Tcl_AppInit( * Specify a user-specific startup file to invoke if the application is * run interactively. Typically the startup file is "~/.apprc" where "app" * is the name of the application. If this line is deleted then no user- - * -specific startup file will be run under any conditions. + * specific startup file will be run under any conditions. */ - Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/.wishrc", -1), TCL_GLOBAL_ONLY); return TCL_OK; } diff --git a/unix/tkConfig.h.in b/unix/tkConfig.h.in index 918f9c2..4fd7726 100644 --- a/unix/tkConfig.h.in +++ b/unix/tkConfig.h.in @@ -4,12 +4,6 @@ #ifndef _TKCONFIG #define _TKCONFIG -/* Is pthread_attr_get_np() declared in <pthread.h>? */ -#undef ATTRGETNP_NOT_DECLARED - -/* Is pthread_getattr_np declared in <pthread.h>? */ -#undef GETATTRNP_NOT_DECLARED - /* Define to 1 if you have the <AvailabilityMacros.h> header file. */ #undef HAVE_AVAILABILITYMACROS_H @@ -19,6 +13,9 @@ /* Do we have access to Darwin CoreFoundation.framework? */ #undef HAVE_COREFOUNDATION +/* Compiler support for module scope symbols */ +#undef HAVE_HIDDEN + /* Do we have the intptr_t type? */ #undef HAVE_INTPTR_T @@ -28,9 +25,6 @@ /* Define to 1 if you have the `Xft' library (-lXft). */ #undef HAVE_LIBXFT -/* Do we have <limits.h>? */ -#undef HAVE_LIMITS_H - /* Define to 1 if you have the `lseek64' function. */ #undef HAVE_LSEEK64 @@ -43,18 +37,9 @@ /* Define to 1 if you have the `pthread_atfork' function. */ #undef HAVE_PTHREAD_ATFORK -/* Do we want a BSD-like thread-attribute interface? */ -#undef HAVE_PTHREAD_ATTR_GET_NP - /* Define to 1 if you have the `pthread_attr_setstacksize' function. */ #undef HAVE_PTHREAD_ATTR_SETSTACKSIZE -/* Do we want a Linux-like thread-attribute interface? */ -#undef HAVE_PTHREAD_GETATTR_NP - -/* Define to 1 if you have the `pthread_get_stacksize_np' function. */ -#undef HAVE_PTHREAD_GET_STACKSIZE_NP - /* Does struct password have a pw_gecos field? */ #undef HAVE_PW_GECOS @@ -115,7 +100,7 @@ /* Are we building TkAqua? */ #undef MAC_OSX_TK -/* Compiler support for module scope symbols */ +/* No Compiler support for module scope symbols */ #undef MODULE_SCOPE /* Is no debugging enabled? */ @@ -127,9 +112,6 @@ /* Do we have fd_set? */ #undef NO_FD_SET -/* Do we have <limits.h>? */ -#undef NO_LIMITS_H - /* Do we have <stdlib.h>? */ #undef NO_STDLIB_H @@ -197,6 +179,9 @@ first (like Motorola and SPARC, unlike Intel and VAX). */ #undef WORDS_BIGENDIAN +/* Is XKeycodeToKeysym deprecated? */ +#undef XKEYCODETOKEYSYM_IS_DEPRECATED + /* Are Darwin SUSv3 extensions available? */ #undef _DARWIN_C_SOURCE @@ -235,6 +220,12 @@ /* Define to `int' if <sys/types.h> doesn't define. */ #undef gid_t +/* Define to `__inline__' or `__inline' if that's what the C compiler + calls it, or to nothing if 'inline' is not supported under any name. */ +#ifndef __cplusplus +#undef inline +#endif + /* Signed integer type wide enough to hold a pointer. */ #undef intptr_t diff --git a/unix/tkUnix.c b/unix/tkUnix.c index 3fa7387..c6fff82 100644 --- a/unix/tkUnix.c +++ b/unix/tkUnix.c @@ -13,7 +13,14 @@ #include "tkInt.h" #ifdef HAVE_XSS -#include <X11/extensions/scrnsaver.h> +# include <X11/extensions/scrnsaver.h> +# ifdef __APPLE__ +/* Support for weak-linked libXss. */ +# define HaveXSSLibrary() (XScreenSaverQueryInfo != NULL) +# else +/* Other platforms always link libXss. */ +# define HaveXSSLibrary() (1) +# endif #endif /* @@ -26,7 +33,7 @@ * server" command. * * Results: - * None. + * Sets the interpreter result. * * Side effects: * None. @@ -41,14 +48,11 @@ TkGetServerInfo( Tk_Window tkwin) /* Token for window; this selects a particular * display and server. */ { - char buffer[8 + TCL_INTEGER_SPACE * 2]; - char buffer2[TCL_INTEGER_SPACE]; - - sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)), - ProtocolRevision(Tk_Display(tkwin))); - sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin))); - Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)), - buffer2, (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("X%dR%d %s %d", + ProtocolVersion(Tk_Display(tkwin)), + ProtocolRevision(Tk_Display(tkwin)), + ServerVendor(Tk_Display(tkwin)), + VendorRelease(Tk_Display(tkwin)))); } /* @@ -69,11 +73,11 @@ TkGetServerInfo( *---------------------------------------------------------------------- */ -CONST char * +const char * TkGetDefaultScreenName( Tcl_Interp *interp, /* Interp used to find environment * variables. */ - CONST char *screenName) /* Screen name from command line, or NULL. */ + const char *screenName) /* Screen name from command line, or NULL. */ { if ((screenName == NULL) || (screenName[0] == '\0')) { screenName = Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY); @@ -207,13 +211,9 @@ Tk_GetUserInactiveTime( * on some buggy versions of XFree86. */ - if ( -#ifdef __APPLE__ - XScreenSaverQueryInfo != NULL && /* Support for weak-linked libXss. */ -#endif - XScreenSaverQueryExtension(dpy, &eventBase, &errorBase) && - XScreenSaverQueryVersion(dpy, &major, &minor)) { - + if (HaveXSSLibrary() + && XScreenSaverQueryExtension(dpy, &eventBase, &errorBase) + && XScreenSaverQueryVersion(dpy, &major, &minor)) { XScreenSaverInfo *info = XScreenSaverAllocInfo(); if (info == NULL) { diff --git a/unix/tkUnix3d.c b/unix/tkUnix3d.c index 417866b..038d4e1 100644 --- a/unix/tkUnix3d.c +++ b/unix/tkUnix3d.c @@ -13,7 +13,7 @@ #include "tkInt.h" #include "tk3d.h" -#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) +#if !(defined(_WIN32) || defined(MAC_OSX_TK)) #include "tkUnixInt.h" #endif @@ -46,7 +46,8 @@ typedef struct { TkBorder * TkpGetBorder(void) { - UnixBorder *borderPtr = (UnixBorder *) ckalloc(sizeof(UnixBorder)); + UnixBorder *borderPtr = ckalloc(sizeof(UnixBorder)); + borderPtr->solidGC = None; return (TkBorder *) borderPtr; } @@ -377,7 +378,7 @@ TkpGetShadows( */ /* - * Compute the dark shadow color + * Compute the dark shadow color. */ r = (int) borderPtr->bgColorPtr->red; @@ -395,7 +396,7 @@ TkpGetShadows( } /* - * Allocate the dark shadow color and its GC + * Allocate the dark shadow color and its GC. */ borderPtr->darkColorPtr = Tk_GetColorByValue(tkwin, &darkColor); @@ -403,7 +404,7 @@ TkpGetShadows( borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues); /* - * Compute the light shadow color + * Compute the light shadow color. */ if (g > MAX_INTENSITY*0.95) { @@ -431,9 +432,9 @@ TkpGetShadows( lightColor.blue = (tmp1 > tmp2) ? tmp1 : tmp2; } - /* - * Allocate the light shadow color and its GC - */ + /* + * Allocate the light shadow color and its GC. + */ borderPtr->lightColorPtr = Tk_GetColorByValue(tkwin, &lightColor); gcValues.foreground = borderPtr->lightColorPtr->pixel; diff --git a/unix/tkUnixButton.c b/unix/tkUnixButton.c index 2101fda..1aeefac 100644 --- a/unix/tkUnixButton.c +++ b/unix/tkUnixButton.c @@ -35,9 +35,11 @@ typedef struct UnixButton { * The class function table for the button widgets. */ -Tk_ClassProcs tkpButtonProcs = { +const Tk_ClassProcs tkpButtonProcs = { sizeof(Tk_ClassProcs), /* size */ TkButtonWorldChanged, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -55,7 +57,7 @@ Tk_ClassProcs tkpButtonProcs = { */ /* XPM */ -static char *button_images[] = { +static const char *const button_images[] = { /* width height ncolors chars_per_pixel */ "52 26 7 1", /* colors */ @@ -279,7 +281,7 @@ TkpDrawCheckIndicator( for (iy=0 ; iy<dim ; iy++) { for (ix=0 ; ix<dim ; ix++) { XPutPixel(img, ix, iy, - imgColors[button_images[imgstart+iy][imgsel+ix] - 'A'] ); + imgColors[button_images[imgstart+iy][imgsel+ix] - 'A']); } } @@ -293,9 +295,9 @@ TkpDrawCheckIndicator( copyGC = Tk_GetGC(tkwin, 0, &gcValues); XPutImage(display, pixmap, copyGC, img, 0, 0, 0, 0, - (unsigned int)dim, (unsigned int)dim); + (unsigned)dim, (unsigned)dim); XCopyArea(display, pixmap, d, copyGC, 0, 0, - (unsigned int)dim, (unsigned int)dim, x, y); + (unsigned)dim, (unsigned)dim, x, y); /* * Tidy up. @@ -326,7 +328,8 @@ TkButton * TkpCreateButton( Tk_Window tkwin) { - UnixButton *butPtr = (UnixButton *) ckalloc(sizeof(UnixButton)); + UnixButton *butPtr = ckalloc(sizeof(UnixButton)); + return (TkButton *) butPtr; } diff --git a/unix/tkUnixColor.c b/unix/tkUnixColor.c index 9474c95..43500ad 100644 --- a/unix/tkUnixColor.c +++ b/unix/tkUnixColor.c @@ -10,7 +10,7 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tkInt.h" +#include "tkUnixInt.h" #include "tkColor.h" /* @@ -137,16 +137,23 @@ TkpGetColor( XColor screen; if (((*name - 'A') & 0xdf) < sizeof(tkWebColors)/sizeof(tkWebColors[0])) { - const char *p = tkWebColors[((*name - 'A') & 0x1f)]; - if (p) { - const char *q = name; - while (!((*p - *(++q)) & 0xdf)) { - if (!*p++) { - name = p; - goto gotWebColor; + if (!((name[0] - 'G') & 0xdf) && !((name[1] - 'R') & 0xdf) + && !((name[2] - 'A') & 0xdb) && !((name[3] - 'Y') & 0xdf) + && !name[4]) { + name = "#808080808080"; + goto gotWebColor; + } else { + const char *p = tkWebColors[((*name - 'A') & 0x1f)]; + if (p) { + const char *q = name; + while (!((*p - *(++q)) & 0xdf)) { + if (!*p++) { + name = p; + goto gotWebColor; + } } } - } + } } if (strlen(name) > 99) { /* Don't bother to parse this. [Bug 2809525]*/ @@ -178,7 +185,7 @@ TkpGetColor( } } - tkColPtr = (TkColor *) ckalloc(sizeof(TkColor)); + tkColPtr = ckalloc(sizeof(TkColor)); tkColPtr->color = color; return tkColPtr; @@ -213,7 +220,7 @@ TkpGetColorByValue( { Display *display = Tk_Display(tkwin); Colormap colormap = Tk_Colormap(tkwin); - TkColor *tkColPtr = (TkColor *) ckalloc(sizeof(TkColor)); + TkColor *tkColPtr = ckalloc(sizeof(TkColor)); tkColPtr->color.red = colorPtr->red; tkColPtr->color.green = colorPtr->green; @@ -271,7 +278,7 @@ FindClosestColor( for (stressPtr = dispPtr->stressPtr; ; stressPtr = stressPtr->nextPtr) { if (stressPtr == NULL) { - stressPtr = (TkStressedCmap *) ckalloc(sizeof(TkStressedCmap)); + stressPtr = ckalloc(sizeof(TkStressedCmap)); stressPtr->colormap = colormap; template.visualid = XVisualIDFromVisual(Tk_Visual(tkwin)); @@ -283,8 +290,8 @@ FindClosestColor( stressPtr->numColors = visInfoPtr->colormap_size; XFree((char *) visInfoPtr); - stressPtr->colorPtr = (XColor *) ckalloc((unsigned) - (stressPtr->numColors * sizeof(XColor))); + stressPtr->colorPtr = + ckalloc(stressPtr->numColors * sizeof(XColor)); for (i = 0; i < stressPtr->numColors; i++) { stressPtr->colorPtr[i].pixel = (unsigned long) i; } @@ -392,8 +399,8 @@ DeleteStressedCmap( } else { prevPtr->nextPtr = stressPtr->nextPtr; } - ckfree((char *) stressPtr->colorPtr); - ckfree((char *) stressPtr); + ckfree(stressPtr->colorPtr); + ckfree(stressPtr); return; } } @@ -433,6 +440,7 @@ TkpCmapStressed( return 0; } + /* * Local Variables: * mode: c diff --git a/unix/tkUnixConfig.c b/unix/tkUnixConfig.c index 0b3af03..3584494 100644 --- a/unix/tkUnixConfig.c +++ b/unix/tkUnixConfig.c @@ -35,8 +35,8 @@ Tcl_Obj * TkpGetSystemDefault( Tk_Window tkwin, /* A window to use. */ - CONST char *dbName, /* The option database name. */ - CONST char *className) /* The name of the option class. */ + const char *dbName, /* The option database name. */ + const char *className) /* The name of the option class. */ { return NULL; } diff --git a/unix/tkUnixCursor.c b/unix/tkUnixCursor.c index 1ab238e..5266bde 100644 --- a/unix/tkUnixCursor.c +++ b/unix/tkUnixCursor.c @@ -28,8 +28,8 @@ typedef struct { * the official cursor font: */ -static struct CursorName { - CONST char *name; +static const struct CursorName { + const char *name; unsigned int shape; } cursorNames[] = { {"X_cursor", XC_X_cursor}, @@ -159,9 +159,9 @@ static struct CursorName { #endif /* DEFINE_MYARROW_CURSOR */ -static struct TkCursorName { - char *name; - char *data; +static const struct TkCursorName { + const char *name; + const char *data; char *mask; } tkCursorNames[] = { {"none", CURSOR_NONE_DATA, NULL}, @@ -180,8 +180,8 @@ static struct TkCursorName { #endif static Cursor CreateCursorFromTableOrFile(Tcl_Interp *interp, - Tk_Window tkwin, int argc, CONST char **argv, - struct TkCursorName *tkCursorPtr); + Tk_Window tkwin, int argc, const char **argv, + const struct TkCursorName *tkCursorPtr); /* *---------------------------------------------------------------------- @@ -211,10 +211,10 @@ TkGetCursorByName( TkUnixCursor *cursorPtr = NULL; Cursor cursor = None; int argc; - CONST char **argv = NULL; + const char **argv = NULL; Display *display = Tk_Display(tkwin); int inTkTable = 0; - struct TkCursorName* tkCursorPtr = NULL; + const struct TkCursorName *tkCursorPtr = NULL; if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) { return NULL; @@ -245,7 +245,7 @@ TkGetCursorByName( if ((argv[0][0] != '@') && !inTkTable) { XColor fg, bg; unsigned int maskIndex; - register struct CursorName *namePtr; + register const struct CursorName *namePtr; TkDisplay *dispPtr; /* @@ -275,8 +275,9 @@ TkGetCursorByName( bg.red = bg.green = bg.blue = 65535; } else { if (TkParseColor(display, Tk_Colormap(tkwin), argv[1], &fg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", argv[1], - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", argv[1])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } if (argc == 2) { @@ -284,8 +285,9 @@ TkGetCursorByName( maskIndex = namePtr->shape; } else if (TkParseColor(display, Tk_Colormap(tkwin), argv[2], &bg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", argv[2], - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", argv[2])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } } @@ -293,7 +295,9 @@ TkGetCursorByName( if (dispPtr->cursorFont == None) { dispPtr->cursorFont = XLoadFont(display, CURSORFONT); if (dispPtr->cursorFont == None) { - Tcl_SetResult(interp, "couldn't load cursor font", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't load cursor font", -1)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "FONT", NULL); goto cleanup; } } @@ -306,8 +310,10 @@ TkGetCursorByName( */ if (!inTkTable && Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get cursor from a file in", - " a safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get cursor from a file in a safe interpreter", + -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "CURSOR_FILE", NULL); cursorPtr = NULL; goto cleanup; } @@ -332,25 +338,26 @@ TkGetCursorByName( } if (cursor != None) { - cursorPtr = (TkUnixCursor *) ckalloc(sizeof(TkUnixCursor)); + cursorPtr = ckalloc(sizeof(TkUnixCursor)); cursorPtr->info.cursor = (Tk_Cursor) cursor; cursorPtr->display = display; } cleanup: if (argv != NULL) { - ckfree((char *) argv); + ckfree(argv); } return (TkCursor *) cursorPtr; badString: if (argv) { - ckfree((char *) argv); + ckfree(argv); } - Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad cursor spec \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL); return NULL; } - + /* *---------------------------------------------------------------------- * @@ -375,8 +382,8 @@ CreateCursorFromTableOrFile( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ Tk_Window tkwin, /* Window in which cursor will be used. */ int argc, - CONST char **argv, /* Cursor spec parsed into elements. */ - struct TkCursorName *tkCursorPtr) + const char **argv, /* Cursor spec parsed into elements. */ + const struct TkCursorName *tkCursorPtr) /* Non-NULL when cursor is defined in Tk * table. */ { @@ -386,8 +393,8 @@ CreateCursorFromTableOrFile( int xHot = -1, yHot = -1; int dummy1, dummy2; XColor fg, bg; - CONST char *fgColor; - CONST char *bgColor; + const char *fgColor; + const char *bgColor; int inTkTable = (tkCursorPtr != NULL); Display *display = Tk_Display(tkwin); @@ -419,8 +426,9 @@ CreateCursorFromTableOrFile( data = TkGetBitmapData(NULL, tkCursorPtr->data, NULL, &width, &height, &xHot, &yHot); if (data == NULL) { - Tcl_AppendResult(interp, "error reading bitmap data for \"", - argv[0], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading bitmap data for \"%s\"", argv[0])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "BITMAP_DATA", NULL); goto cleanup; } @@ -428,22 +436,24 @@ CreateCursorFromTableOrFile( ckfree(data); } else { if (TkReadBitmapFile(display, drawable, &argv[0][1], - (unsigned int *) &width, (unsigned int *) &height, + (unsigned *) &width, (unsigned *) &height, &source, &xHot, &yHot) != BitmapSuccess) { - Tcl_AppendResult(interp, "cleanup reading bitmap file \"", - &argv[0][1], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cleanup reading bitmap file \"%s\"", &argv[0][1])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "BITMAP_FILE", NULL); goto cleanup; } } if ((xHot < 0) || (yHot < 0) || (xHot >= width) || (yHot >= height)) { if (inTkTable) { - Tcl_AppendResult(interp, "bad hot spot in bitmap data for \"", - argv[0], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad hot spot in bitmap data for \"%s\"", argv[0])); } else { - Tcl_AppendResult(interp, "bad hot spot in bitmap file \"", - &argv[0][1], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad hot spot in bitmap file \"%s\"", &argv[0][1])); } + Tcl_SetErrorCode(interp, "TK", "CURSOR", "HOTSPOT", NULL); goto cleanup; } @@ -457,8 +467,9 @@ CreateCursorFromTableOrFile( } else if (argc == 2) { fgColor = argv[1]; if (TkParseColor(display, Tk_Colormap(tkwin), fgColor, &fg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", - fgColor, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", fgColor)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } if (inTkTable) { @@ -476,13 +487,15 @@ CreateCursorFromTableOrFile( bgColor = argv[3]; } if (TkParseColor(display, Tk_Colormap(tkwin), fgColor, &fg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", - fgColor, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", fgColor)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } if (TkParseColor(display, Tk_Colormap(tkwin), bgColor, &bg) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", - bgColor, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", bgColor)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "COLOR", NULL); goto cleanup; } } @@ -511,8 +524,9 @@ CreateCursorFromTableOrFile( data = TkGetBitmapData(NULL, tkCursorPtr->mask, NULL, &maskWidth, &maskHeight, &dummy1, &dummy2); if (data == NULL) { - Tcl_AppendResult(interp, "error reading bitmap mask data for \"", - argv[0], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading bitmap mask data for \"%s\"", argv[0])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "MASK_DATA", NULL); goto cleanup; } @@ -524,15 +538,17 @@ CreateCursorFromTableOrFile( if (TkReadBitmapFile(display, drawable, argv[1], (unsigned int *) &maskWidth, (unsigned int *) &maskHeight, &mask, &dummy1, &dummy2) != BitmapSuccess) { - Tcl_AppendResult(interp, "cleanup reading bitmap file \"", - argv[1], "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cleanup reading bitmap file \"%s\"", argv[1])); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "MASK_FILE", NULL); goto cleanup; } } if ((maskWidth != width) || (maskHeight != height)) { - Tcl_SetResult(interp, "source and mask bitmaps have different sizes", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "source and mask bitmaps have different sizes", -1)); + Tcl_SetErrorCode(interp, "TK", "CURSOR", "SIZE_MATCH", NULL); goto cleanup; } @@ -568,8 +584,8 @@ CreateCursorFromTableOrFile( TkCursor * TkCreateCursorFromData( Tk_Window tkwin, /* Window in which cursor will be used. */ - CONST char *source, /* Bitmap data for cursor shape. */ - CONST char *mask, /* Bitmap data for cursor mask. */ + const char *source, /* Bitmap data for cursor shape. */ + const char *mask, /* Bitmap data for cursor mask. */ int width, int height, /* Dimensions of cursor. */ int xHot, int yHot, /* Location of hot-spot in cursor. */ XColor fgColor, /* Foreground color for cursor. */ @@ -592,7 +608,7 @@ TkCreateCursorFromData( Tk_FreePixmap(display, maskPixmap); if (cursor != None) { - cursorPtr = (TkUnixCursor *) ckalloc(sizeof(TkUnixCursor)); + cursorPtr = ckalloc(sizeof(TkUnixCursor)); cursorPtr->info.cursor = (Tk_Cursor) cursor; cursorPtr->display = display; } diff --git a/unix/tkUnixDefault.h b/unix/tkUnixDefault.h index a8ecdc1..d214aa5 100644 --- a/unix/tkUnixDefault.h +++ b/unix/tkUnixDefault.h @@ -64,7 +64,7 @@ #define DEF_BUTTON_HIGHLIGHT BLACK #define DEF_LABEL_HIGHLIGHT_WIDTH "0" #define DEF_BUTTON_HIGHLIGHT_WIDTH "1" -#define DEF_BUTTON_IMAGE (char *) NULL +#define DEF_BUTTON_IMAGE ((char *) NULL) #define DEF_BUTTON_INDICATOR "1" #define DEF_BUTTON_JUSTIFY "center" #define DEF_BUTTON_OFF_VALUE "0" @@ -81,10 +81,10 @@ #define DEF_BUTTON_REPEAT_INTERVAL "0" #define DEF_BUTTON_SELECT_COLOR CHECK_INDICATOR #define DEF_BUTTON_SELECT_MONO BLACK -#define DEF_BUTTON_SELECT_IMAGE (char *) NULL +#define DEF_BUTTON_SELECT_IMAGE ((char *) NULL) #define DEF_BUTTON_STATE "normal" #define DEF_LABEL_TAKE_FOCUS "0" -#define DEF_BUTTON_TAKE_FOCUS (char *) NULL +#define DEF_BUTTON_TAKE_FOCUS ((char *) NULL) #define DEF_BUTTON_TEXT "" #define DEF_BUTTON_TEXT_VARIABLE "" #define DEF_BUTTON_UNDERLINE "-1" @@ -122,7 +122,7 @@ #define DEF_CANVAS_SELECT_BD_MONO "0" #define DEF_CANVAS_SELECT_FG_COLOR BLACK #define DEF_CANVAS_SELECT_FG_MONO WHITE -#define DEF_CANVAS_TAKE_FOCUS (char *) NULL +#define DEF_CANVAS_TAKE_FOCUS ((char *) NULL) #define DEF_CANVAS_WIDTH "10c" #define DEF_CANVAS_X_SCROLL_CMD "" #define DEF_CANVAS_X_SCROLL_INCREMENT "0" @@ -163,9 +163,9 @@ #define DEF_ENTRY_SELECT_BD_MONO "0" #define DEF_ENTRY_SELECT_FG_COLOR BLACK #define DEF_ENTRY_SELECT_FG_MONO WHITE -#define DEF_ENTRY_SHOW (char *) NULL +#define DEF_ENTRY_SHOW ((char *) NULL) #define DEF_ENTRY_STATE "normal" -#define DEF_ENTRY_TAKE_FOCUS (char *) NULL +#define DEF_ENTRY_TAKE_FOCUS ((char *) NULL) #define DEF_ENTRY_TEXT_VARIABLE "" #define DEF_ENTRY_WIDTH "20" @@ -232,36 +232,36 @@ #define DEF_LISTBOX_SELECT_MODE "browse" #define DEF_LISTBOX_SET_GRID "0" #define DEF_LISTBOX_STATE "normal" -#define DEF_LISTBOX_TAKE_FOCUS (char *) NULL +#define DEF_LISTBOX_TAKE_FOCUS ((char *) NULL) #define DEF_LISTBOX_WIDTH "20" /* * Defaults for individual entries of menus: */ -#define DEF_MENU_ENTRY_ACTIVE_BG (char *) NULL -#define DEF_MENU_ENTRY_ACTIVE_FG (char *) NULL -#define DEF_MENU_ENTRY_ACCELERATOR (char *) NULL -#define DEF_MENU_ENTRY_BG (char *) NULL +#define DEF_MENU_ENTRY_ACTIVE_BG ((char *) NULL) +#define DEF_MENU_ENTRY_ACTIVE_FG ((char *) NULL) +#define DEF_MENU_ENTRY_ACCELERATOR ((char *) NULL) +#define DEF_MENU_ENTRY_BG ((char *) NULL) #define DEF_MENU_ENTRY_BITMAP None #define DEF_MENU_ENTRY_COLUMN_BREAK "0" -#define DEF_MENU_ENTRY_COMMAND (char *) NULL +#define DEF_MENU_ENTRY_COMMAND ((char *) NULL) #define DEF_MENU_ENTRY_COMPOUND "none" -#define DEF_MENU_ENTRY_FG (char *) NULL -#define DEF_MENU_ENTRY_FONT (char *) NULL +#define DEF_MENU_ENTRY_FG ((char *) NULL) +#define DEF_MENU_ENTRY_FONT ((char *) NULL) #define DEF_MENU_ENTRY_HIDE_MARGIN "0" -#define DEF_MENU_ENTRY_IMAGE (char *) NULL +#define DEF_MENU_ENTRY_IMAGE ((char *) NULL) #define DEF_MENU_ENTRY_INDICATOR "1" -#define DEF_MENU_ENTRY_LABEL (char *) NULL -#define DEF_MENU_ENTRY_MENU (char *) NULL +#define DEF_MENU_ENTRY_LABEL ((char *) NULL) +#define DEF_MENU_ENTRY_MENU ((char *) NULL) #define DEF_MENU_ENTRY_OFF_VALUE "0" #define DEF_MENU_ENTRY_ON_VALUE "1" -#define DEF_MENU_ENTRY_SELECT_IMAGE (char *) NULL +#define DEF_MENU_ENTRY_SELECT_IMAGE ((char *) NULL) #define DEF_MENU_ENTRY_STATE "normal" -#define DEF_MENU_ENTRY_VALUE (char *) NULL -#define DEF_MENU_ENTRY_CHECK_VARIABLE (char *) NULL +#define DEF_MENU_ENTRY_VALUE ((char *) NULL) +#define DEF_MENU_ENTRY_CHECK_VARIABLE ((char *) NULL) #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" -#define DEF_MENU_ENTRY_SELECT (char *) NULL +#define DEF_MENU_ENTRY_SELECT ((char *) NULL) #define DEF_MENU_ENTRY_UNDERLINE "-1" /* @@ -287,7 +287,7 @@ #define DEF_MENU_SELECT_MONO BLACK #define DEF_MENU_TAKE_FOCUS "0" #define DEF_MENU_TEAROFF "1" -#define DEF_MENU_TEAROFF_CMD (char *) NULL +#define DEF_MENU_TEAROFF_CMD ((char *) NULL) #define DEF_MENU_TITLE "" #define DEF_MENU_TYPE "normal" @@ -315,7 +315,7 @@ #define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO #define DEF_MENUBUTTON_HIGHLIGHT BLACK #define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0" -#define DEF_MENUBUTTON_IMAGE (char *) NULL +#define DEF_MENUBUTTON_IMAGE ((char *) NULL) #define DEF_MENUBUTTON_INDICATOR "0" #define DEF_MENUBUTTON_JUSTIFY "center" #define DEF_MENUBUTTON_MENU "" @@ -416,7 +416,7 @@ #define DEF_SCALE_LENGTH "100" #define DEF_SCALE_ORIENT "vertical" #define DEF_SCALE_RELIEF "flat" -#define DEF_SCALE_REPEAT_DELAY "300" +#define DEF_SCALE_REPEAT_DELAY "300" #define DEF_SCALE_REPEAT_INTERVAL "100" #define DEF_SCALE_RESOLUTION "1" #define DEF_SCALE_TROUGH_COLOR TROUGH @@ -425,7 +425,7 @@ #define DEF_SCALE_SLIDER_LENGTH "30" #define DEF_SCALE_SLIDER_RELIEF "raised" #define DEF_SCALE_STATE "normal" -#define DEF_SCALE_TAKE_FOCUS (char *) NULL +#define DEF_SCALE_TAKE_FOCUS ((char *) NULL) #define DEF_SCALE_TICK_INTERVAL "0" #define DEF_SCALE_TO "100" #define DEF_SCALE_VARIABLE "" @@ -452,7 +452,7 @@ #define DEF_SCROLLBAR_RELIEF "sunken" #define DEF_SCROLLBAR_REPEAT_DELAY "300" #define DEF_SCROLLBAR_REPEAT_INTERVAL "100" -#define DEF_SCROLLBAR_TAKE_FOCUS (char *) NULL +#define DEF_SCROLLBAR_TAKE_FOCUS ((char *) NULL) #define DEF_SCROLLBAR_TROUGH_COLOR TROUGH #define DEF_SCROLLBAR_TROUGH_MONO WHITE #define DEF_SCROLLBAR_WIDTH "11" @@ -479,8 +479,9 @@ #define DEF_TEXT_INSERT_BD_MONO "0" #define DEF_TEXT_INSERT_OFF_TIME "300" #define DEF_TEXT_INSERT_ON_TIME "600" +#define DEF_TEXT_INSERT_UNFOCUSSED "none" #define DEF_TEXT_INSERT_WIDTH "2" -#define DEF_TEXT_MAX_UNDO "0" +#define DEF_TEXT_MAX_UNDO "0" #define DEF_TEXT_PADX "1" #define DEF_TEXT_PADY "1" #define DEF_TEXT_RELIEF "sunken" @@ -499,8 +500,8 @@ #define DEF_TEXT_STATE "normal" #define DEF_TEXT_TABS "" #define DEF_TEXT_TABSTYLE "tabular" -#define DEF_TEXT_TAKE_FOCUS (char *) NULL -#define DEF_TEXT_UNDO "0" +#define DEF_TEXT_TAKE_FOCUS ((char *) NULL) +#define DEF_TEXT_UNDO "0" #define DEF_TEXT_WIDTH "80" #define DEF_TEXT_WRAP "char" #define DEF_TEXT_XSCROLL_COMMAND "" @@ -522,4 +523,10 @@ #define DEF_TOPLEVEL_SCREEN "" #define DEF_TOPLEVEL_USE "" +/* + * Defaults for busy windows: + */ + +#define DEF_BUSY_CURSOR "watch" + #endif /* _TKUNIXDEFAULT */ diff --git a/unix/tkUnixDialog.c b/unix/tkUnixDialog.c index 2b86ca6..afe443f 100644 --- a/unix/tkUnixDialog.c +++ b/unix/tkUnixDialog.c @@ -39,21 +39,21 @@ EvalObjv( Tcl_Interp *interp, /* Current interpreter. */ char *cmdName, /* Name of the TCL command to call */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST *objv) /* Arguments. */ + Tcl_Obj *const *objv) /* Arguments. */ { Tcl_Obj *cmdObj, **objs; int result; cmdObj = Tcl_NewStringObj(cmdName, -1); Tcl_IncrRefCount(cmdObj); - objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * (unsigned)(objc+1)); + objs = ckalloc(sizeof(Tcl_Obj *) * (objc+1)); objs[0] = cmdObj; memcpy(objs+1, objv, sizeof(Tcl_Obj *) * (unsigned)objc); result = Tcl_EvalObjv(interp, objc+1, objs, 0); Tcl_DecrRefCount(cmdObj); - ckfree((char *) objs); + ckfree(objs); return result; } @@ -82,7 +82,7 @@ Tk_ChooseColorObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST *objv) /* Arguments. */ + Tcl_Obj *const *objv) /* Arguments. */ { return EvalObjv(interp, "tk::ColorDialog", objc-1, objv+1); } @@ -111,9 +111,9 @@ Tk_GetOpenFileObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST *objv) /* Arguments. */ + Tcl_Obj *const *objv) /* Arguments. */ { - Tk_Window tkwin = (Tk_Window)clientData; + Tk_Window tkwin = clientData; if (Tk_StrictMotif(tkwin)) { return EvalObjv(interp, "tk::MotifOpenFDialog", objc-1, objv+1); @@ -143,9 +143,9 @@ Tk_GetSaveFileObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST *objv) /* Arguments. */ + Tcl_Obj *const *objv) /* Arguments. */ { - Tk_Window tkwin = (Tk_Window)clientData; + Tk_Window tkwin = clientData; if (Tk_StrictMotif(tkwin)) { return EvalObjv(interp, "tk::MotifSaveFDialog", objc-1, objv+1); @@ -177,7 +177,7 @@ Tk_MessageBoxCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST *objv) /* Arguments. */ + Tcl_Obj *const *objv) /* Arguments. */ { return EvalObjv(interp, "tk::MessageBox", objc-1, objv+1); } diff --git a/unix/tkUnixDraw.c b/unix/tkUnixDraw.c index c0d4d7f..acc0565 100644 --- a/unix/tkUnixDraw.c +++ b/unix/tkUnixDraw.c @@ -11,7 +11,7 @@ #include "tkInt.h" -#if !defined(__WIN32__) +#ifndef _WIN32 #include "tkUnixInt.h" #endif @@ -32,7 +32,7 @@ typedef struct ScrollInfo { * Forward declarations for functions declared later in this file: */ -static Tk_RestrictAction ScrollRestrictProc(ClientData arg, XEvent *eventPtr); +static Tk_RestrictProc ScrollRestrictProc; /* *---------------------------------------------------------------------- @@ -63,8 +63,8 @@ TkScrollWindow( int dx, int dy, /* Distance rectangle should be moved. */ TkRegion damageRgn) /* Region to accumulate damage in. */ { - Tk_RestrictProc *oldProc; - ClientData oldArg, dummy; + Tk_RestrictProc *prevProc; + ClientData prevArg; ScrollInfo info; XCopyArea(Tk_Display(tkwin), Tk_WindowId(tkwin), Tk_WindowId(tkwin), gc, @@ -84,12 +84,11 @@ TkScrollWindow( */ TkpSync(info.display); - oldProc = Tk_RestrictEvents(ScrollRestrictProc, (ClientData) &info, - &oldArg); + prevProc = Tk_RestrictEvents(ScrollRestrictProc, &info, &prevArg); while (!info.done) { Tcl_ServiceEvent(TCL_WINDOW_EVENTS); } - Tk_RestrictEvents(oldProc, oldArg, &dummy); + Tk_RestrictEvents(prevProc, prevArg, &prevArg); if (XEmptyRegion((Region) damageRgn)) { return 0; diff --git a/unix/tkUnixEmbed.c b/unix/tkUnixEmbed.c index 119bc67..b170ad0 100644 --- a/unix/tkUnixEmbed.c +++ b/unix/tkUnixEmbed.c @@ -4,7 +4,7 @@ * This file contains platform-specific functions for UNIX to provide * basic operations needed for application embedding (where one * application can use as its main window an internal window from some - * other application). + * other application). Also includes code to support busy windows. * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * @@ -13,6 +13,7 @@ */ #include "tkUnixInt.h" +#include "tkBusy.h" /* * One of the following structures exists for each container in this @@ -95,7 +96,7 @@ TkpUseWindow( * string is bogus. */ Tk_Window tkwin, /* Tk window that does not yet have an * associated X window. */ - CONST char *string) /* String identifying an X window to use for + const char *string) /* String identifying an X window to use for * tkwin; must be an integer value. */ { TkWindow *winPtr = (TkWindow *) tkwin; @@ -105,12 +106,13 @@ TkpUseWindow( Tk_ErrorHandler handler; Container *containerPtr; XWindowAttributes parentAtts; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->window != None) { - Tcl_AppendResult(interp, - "can't modify container after widget is created", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't modify container after widget is created", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL); return TCL_ERROR; } if (TkpScanWindowId(interp, string, &parent) != TCL_OK) { @@ -118,12 +120,12 @@ TkpUseWindow( } usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, parent); - if (usePtr != NULL) { - if (!(usePtr->flags & TK_CONTAINER)) { - Tcl_AppendResult(interp, "window \"", usePtr->pathName, - "\" doesn't have -container option set", NULL); - return TCL_ERROR; - } + if (usePtr != NULL && !(usePtr->flags & TK_CONTAINER)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" doesn't have -container option set", + usePtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL); + return TCL_ERROR; } /* @@ -135,7 +137,7 @@ TkpUseWindow( anyError = 0; handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, - EmbedErrorProc, (ClientData) &anyError); + EmbedErrorProc, &anyError); if (!XGetWindowAttributes(winPtr->display, parent, &parentAtts)) { anyError = 1; } @@ -143,8 +145,9 @@ TkpUseWindow( Tk_DeleteErrorHandler(handler); if (anyError) { if (interp != NULL) { - Tcl_AppendResult(interp, "couldn't create child of window \"", - string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't create child of window \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "NO_TARGET", NULL); } return TCL_ERROR; } @@ -157,7 +160,7 @@ TkpUseWindow( */ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc, - (ClientData) winPtr); + winPtr); /* * Save information about the container and the embedded window in a @@ -175,7 +178,7 @@ TkpUseWindow( } } if (containerPtr == NULL) { - containerPtr = (Container *) ckalloc(sizeof(Container)); + containerPtr = ckalloc(sizeof(Container)); containerPtr->parent = parent; containerPtr->parentRoot = parentAtts.root; containerPtr->parentPtr = NULL; @@ -213,7 +216,7 @@ TkpMakeWindow( * the window is to be created. */ { Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->flags & TK_EMBEDDED) { @@ -269,7 +272,7 @@ TkpMakeContainer( { TkWindow *winPtr = (TkWindow *) tkwin; Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -278,7 +281,7 @@ TkpMakeContainer( */ Tk_MakeWindowExist(tkwin); - containerPtr = (Container *) ckalloc(sizeof(Container)); + containerPtr = ckalloc(sizeof(Container)); containerPtr->parent = Tk_WindowId(tkwin); containerPtr->parentRoot = RootWindowOfScreen(Tk_Screen(tkwin)); containerPtr->parentPtr = winPtr; @@ -299,11 +302,11 @@ TkpMakeContainer( XSelectInput(winPtr->display, winPtr->window, winPtr->atts.event_mask); Tk_CreateEventHandler(tkwin, SubstructureNotifyMask|SubstructureRedirectMask, - ContainerEventProc, (ClientData) winPtr); + ContainerEventProc, winPtr); Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbedStructureProc, - (ClientData) containerPtr); + containerPtr); Tk_CreateEventHandler(tkwin, FocusChangeMask, EmbedFocusProc, - (ClientData) containerPtr); + containerPtr); } /* @@ -329,7 +332,7 @@ EmbedErrorProc( XErrorEvent *errEventPtr) /* Points to information about error (not * used). */ { - int *iPtr = (int *) clientData; + int *iPtr = clientData; *iPtr = 1; return 0; @@ -359,7 +362,7 @@ EmbeddedEventProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { - TkWindow *winPtr = (TkWindow *) clientData; + TkWindow *winPtr = clientData; if (eventPtr->type == DestroyNotify) { EmbedWindowDeleted(winPtr); @@ -391,10 +394,10 @@ ContainerEventProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { - TkWindow *winPtr = (TkWindow *) clientData; + TkWindow *winPtr = clientData; Container *containerPtr; Tk_ErrorHandler errHandler; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -404,7 +407,7 @@ ContainerEventProc( */ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1, - -1, -1, NULL, (ClientData) NULL); + -1, -1, NULL, NULL); /* * Find the Container structure associated with the parent window. @@ -496,7 +499,7 @@ EmbedStructureProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { - Container *containerPtr = (Container *) clientData; + Container *containerPtr = clientData; Tk_ErrorHandler errHandler; if (eventPtr->type == ConfigureNotify) { @@ -507,7 +510,7 @@ EmbedStructureProc( */ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1, - -1, -1, NULL, (ClientData) NULL); + -1, -1, NULL, NULL); XMoveResizeWindow(eventPtr->xconfigure.display, containerPtr->wrapper, 0, 0, (unsigned) Tk_Width((Tk_Window) containerPtr->parentPtr), @@ -543,7 +546,7 @@ EmbedFocusProc( ClientData clientData, /* Token for container window. */ XEvent *eventPtr) /* ResizeRequest event. */ { - Container *containerPtr = (Container *) clientData; + Container *containerPtr = clientData; Tk_ErrorHandler errHandler; Display *display; @@ -558,7 +561,7 @@ EmbedFocusProc( if (containerPtr->wrapper != None) { errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1, - -1, -1, NULL, (ClientData) NULL); + -1, -1, NULL, NULL); XSetInputFocus(display, containerPtr->wrapper, RevertToParent, CurrentTime); Tk_DeleteErrorHandler(errHandler); @@ -701,7 +704,7 @@ TkpGetOtherWindow( * window. */ { Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (containerPtr = tsdPtr->firstContainerPtr; @@ -747,7 +750,7 @@ TkpRedirectKeyEvent( { Container *containerPtr; Window saved; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -819,7 +822,7 @@ TkpClaimFocus( { XEvent event; Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!(topLevelPtr->flags & TK_EMBEDDED)) { @@ -863,17 +866,17 @@ int TkpTestembedCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { int all; Container *containerPtr; Tcl_DString dString; char buffer[50]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if ((argc > 1) && (strcmp(argv[1], "all") == 0)) { + if ((objc > 1) && (strcmp(Tcl_GetString(objv[1]), "all") == 0)) { all = 1; } else { all = 0; @@ -940,7 +943,7 @@ EmbedWindowDeleted( * deleted. */ { Container *containerPtr, *prevPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -971,7 +974,7 @@ EmbedWindowDeleted( } else { prevPtr->nextPtr = containerPtr->nextPtr; } - ckfree((char *) containerPtr); + ckfree(containerPtr); } } @@ -998,7 +1001,7 @@ TkUnixContainerId( TkWindow *winPtr) /* Tk's structure for an embedded window. */ { Container *containerPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); for (containerPtr = tsdPtr->firstContainerPtr; @@ -1012,6 +1015,168 @@ TkUnixContainerId( } /* + *---------------------------------------------------------------------- + * + * TkpShowBusyWindow -- + * + * Makes a busy window "appear". + * + * Results: + * None. + * + * Side effects: + * Arranges for the busy window to start intercepting events and the + * cursor to change to the configured "hey, I'm busy!" setting. + * + *---------------------------------------------------------------------- + */ + +void +TkpShowBusyWindow( + TkBusy busy) +{ + Busy *busyPtr = (Busy *) busy; + + if (busyPtr->tkBusy != NULL) { + Tk_MapWindow(busyPtr->tkBusy); + + /* + * Always raise the busy window just in case new sibling windows have + * been created in the meantime. Can't use Tk_RestackWindow because it + * doesn't work under Win32. + */ + + XRaiseWindow(Tk_Display(busyPtr->tkBusy), + Tk_WindowId(busyPtr->tkBusy)); + } +} + +/* + *---------------------------------------------------------------------- + * + * TkpHideBusyWindow -- + * + * Makes a busy window "disappear". + * + * Results: + * None. + * + * Side effects: + * Arranges for the busy window to stop intercepting events, and the + * cursor to change back to its normal setting. + * + *---------------------------------------------------------------------- + */ + +void +TkpHideBusyWindow( + TkBusy busy) +{ + Busy *busyPtr = (Busy *) busy; + + if (busyPtr->tkBusy != NULL) { + Tk_UnmapWindow(busyPtr->tkBusy); + } +} + +/* + *---------------------------------------------------------------------- + * + * TkpMakeTransparentWindowExist -- + * + * Construct the platform-specific resources for a transparent window. + * + * Results: + * None. + * + * Side effects: + * Moves the specified window in the stacking order. + * + *---------------------------------------------------------------------- + */ + +void +TkpMakeTransparentWindowExist( + Tk_Window tkwin, /* Token for window. */ + Window parent) /* Parent window. */ +{ + TkWindow *winPtr = (TkWindow *) tkwin; + long int mask = CWDontPropagate | CWEventMask; + + /* + * Ignore the important events while the window is mapped. + */ + +#define USER_EVENTS \ + (EnterWindowMask | LeaveWindowMask | KeyPressMask | KeyReleaseMask | \ + ButtonPressMask | ButtonReleaseMask | PointerMotionMask) +#define PROP_EVENTS \ + (KeyPressMask | KeyReleaseMask | ButtonPressMask | \ + ButtonReleaseMask | PointerMotionMask) + + winPtr->atts.do_not_propagate_mask = PROP_EVENTS; + winPtr->atts.event_mask = USER_EVENTS; + winPtr->changes.border_width = 0; + winPtr->depth = 0; + + winPtr->window = XCreateWindow(winPtr->display, parent, + winPtr->changes.x, winPtr->changes.y, + (unsigned) winPtr->changes.width, /* width */ + (unsigned) winPtr->changes.height, /* height */ + (unsigned) winPtr->changes.border_width, /* border_width */ + winPtr->depth, InputOnly, winPtr->visual, mask, &winPtr->atts); +} + +/* + *---------------------------------------------------------------------- + * + * TkpCreateBusy -- + * + * Construct the platform-specific parts of a busy window. Note that this + * postpones the actual creation of the window resource until later. + * + * Results: + * None. + * + * Side effects: + * Sets up part of the busy window structure. + * + *---------------------------------------------------------------------- + */ + +void +TkpCreateBusy( + Tk_FakeWin *winPtr, + Tk_Window tkRef, + Window *parentPtr, + Tk_Window tkParent, + TkBusy busy) +{ + Window root, parent, *dummy; + unsigned int count; + + if (winPtr->flags & TK_REPARENTED) { + /* + * This works around a bug in the implementation of menubars for + * non-MacIntosh window systems (Win32 and X11). Tk doesn't reset the + * pointers to the parent window when the menu is reparented (since + * winPtr->parentPtr points to the wrong window). We get around this + * by determining the parent via the native API calls. + */ + + if (XQueryTree(Tk_Display(tkRef), Tk_WindowId(tkRef), &root, + &parent, &dummy, &count) > 0) { + XFree(dummy); + *parentPtr = parent; + } else { + *parentPtr = None; + } + } else { + *parentPtr = Tk_WindowId(tkParent); + } +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/unix/tkUnixEvent.c b/unix/tkUnixEvent.c index eb83474..f3beb16 100644 --- a/unix/tkUnixEvent.c +++ b/unix/tkUnixEvent.c @@ -118,7 +118,7 @@ DisplayExitHandler( TkDisplay * TkpOpenDisplay( - CONST char *displayNameStr) + const char *displayNameStr) { TkDisplay *dispPtr; Display *display; @@ -128,6 +128,27 @@ TkpOpenDisplay( int minor = 0; int reason = 0; unsigned int use_xkb = 0; + /* Disabled, until we have a better test. See [Bug 3613668] */ +#if 0 && defined(XKEYCODETOKEYSYM_IS_DEPRECATED) && defined(TCL_THREADS) + static int xinited = 0; + static Tcl_Mutex xinitMutex = NULL; + + if (!xinited) { + Tcl_MutexLock(&xinitMutex); + if (!xinited) { + /* Necessary for threaded apps, of no consequence otherwise */ + /* need only be called once, but must be called before *any* */ + /* Xlib call is made. If xinitMutex is still NULL after the */ + /* Tcl_MutexLock call, Tcl was compiled without threads so */ + /* we cannot use XInitThreads() either. */ + if (xinitMutex != NULL){ + XInitThreads(); + } + xinited = 1; + } + Tcl_MutexUnlock(&xinitMutex); + } +#endif /* ** Bug [3607830]: Before using Xkb, it must be initialized and confirmed @@ -152,7 +173,7 @@ TkpOpenDisplay( if (display == NULL) { return NULL; } - dispPtr = (TkDisplay *) ckalloc(sizeof(TkDisplay)); + dispPtr = ckalloc(sizeof(TkDisplay)); memset(dispPtr, 0, sizeof(TkDisplay)); dispPtr->display = display; dispPtr->flags |= use_xkb; @@ -160,7 +181,7 @@ TkpOpenDisplay( OpenIM(dispPtr); #endif Tcl_CreateFileHandler(ConnectionNumber(display), TCL_READABLE, - DisplayFileProc, (ClientData) dispPtr); + DisplayFileProc, dispPtr); return dispPtr; } @@ -186,8 +207,6 @@ TkpCloseDisplay( { TkSendCleanup(dispPtr); - TkFreeXId(dispPtr); - TkWmCleanup(dispPtr); #ifdef TK_USE_INPUT_METHODS @@ -236,7 +255,7 @@ TkClipCleanup( dispPtr->windowAtom); Tk_DestroyWindow(dispPtr->clipWindow); - Tcl_Release((ClientData) dispPtr->clipWindow); + Tcl_Release(dispPtr->clipWindow); dispPtr->clipWindow = NULL; } } @@ -312,6 +331,9 @@ TransferXEventsToTcl( int type; XEvent x; TkKeyEvent k; +#ifdef GenericEvent + xGenericEvent xge; +#endif } event; Window w; TkDisplay *dispPtr = NULL; @@ -329,6 +351,12 @@ TransferXEventsToTcl( while (QLength(display) > 0) { XNextEvent(display, &event.x); +#ifdef GenericEvent + if (event.type == GenericEvent) { + Tcl_Panic("Wild GenericEvent; panic! (extension=%d,evtype=%d)", + event.xge.extension, event.xge.evtype); + } +#endif w = None; if (event.type == KeyPress || event.type == KeyRelease) { for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) { @@ -577,7 +605,7 @@ TkUnixDoOneXEvent( index = fd/(NBBY*sizeof(fd_mask)); bit = ((fd_mask)1) << (fd%(NBBY*sizeof(fd_mask))); if ((readMask[index] & bit) || (QLength(dispPtr->display) > 0)) { - DisplayFileProc((ClientData)dispPtr, TCL_READABLE); + DisplayFileProc(dispPtr, TCL_READABLE); } } if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) { @@ -720,6 +748,22 @@ error: } #endif /* TK_USE_INPUT_METHODS */ +void +TkpWarpPointer( + TkDisplay *dispPtr) +{ + Window w; /* Which window to warp relative to. */ + + if (dispPtr->warpWindow != NULL) { + w = Tk_WindowId(dispPtr->warpWindow); + } else { + w = RootWindow(dispPtr->display, + Tk_ScreenNumber(dispPtr->warpMainwin)); + } + XWarpPointer(dispPtr->display, None, w, 0, 0, 0, 0, + (int) dispPtr->warpX, (int) dispPtr->warpY); +} + /* * Local Variables: * mode: c diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c index 897770b..a4998aa 100644 --- a/unix/tkUnixFont.c +++ b/unix/tkUnixFont.c @@ -19,7 +19,7 @@ * The preferred font encodings. */ -static CONST char *encodingList[] = { +static const char *const encodingList[] = { "iso8859-1", "jis0208", "jis0212", NULL }; @@ -137,9 +137,9 @@ typedef struct UnixFont { */ typedef struct EncodingAlias { - char *realName; /* The real name of the encoding to load if + const char *realName; /* The real name of the encoding to load if * the provided name matched the pattern. */ - char *aliasPattern; /* Pattern for encoding name, of the form that + const char *aliasPattern; /* Pattern for encoding name, of the form that * is acceptable to Tcl_StringMatch. */ } EncodingAlias; @@ -205,31 +205,31 @@ static void FontPkgCleanup(ClientData clientData); static FontFamily * AllocFontFamily(Display *display, XFontStruct *fontStructPtr, int base); static SubFont * CanUseFallback(UnixFont *fontPtr, - CONST char *fallbackName, int ch, + const char *fallbackName, int ch, SubFont **fixSubFontPtrPtr); static SubFont * CanUseFallbackWithAliases(UnixFont *fontPtr, - char *fallbackName, int ch, + const char *fallbackName, int ch, Tcl_DString *nameTriedPtr, SubFont **fixSubFontPtrPtr); -static int ControlUtfProc(ClientData clientData, CONST char *src, +static int ControlUtfProc(ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState*statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static XFontStruct * CreateClosestFont(Tk_Window tkwin, - CONST TkFontAttributes *faPtr, - CONST TkXLFDAttributes *xaPtr); + const TkFontAttributes *faPtr, + const TkXLFDAttributes *xaPtr); static SubFont * FindSubFontForChar(UnixFont *fontPtr, int ch, SubFont **fixSubFontPtrPtr); static void FontMapInsert(SubFont *subFontPtr, int ch); static void FontMapLoadPage(SubFont *subFontPtr, int row); static int FontMapLookup(SubFont *subFontPtr, int ch); static void FreeFontFamily(FontFamily *afPtr); -static CONST char * GetEncodingAlias(CONST char *name); +static const char * GetEncodingAlias(const char *name); static int GetFontAttributes(Display *display, XFontStruct *fontStructPtr, FontAttributes *faPtr); static XFontStruct * GetScreenFont(Display *display, FontAttributes *wantPtr, char **nameList, - int bestIdx[], unsigned int bestScore[]); + int bestIdx[], unsigned bestScore[]); static XFontStruct * GetSystemFont(Display *display); static int IdentifySymbolEncodings(FontAttributes *faPtr); static void InitFont(Tk_Window tkwin, XFontStruct *fontStructPtr, @@ -237,21 +237,21 @@ static void InitFont(Tk_Window tkwin, XFontStruct *fontStructPtr, static void InitSubFont(Display *display, XFontStruct *fontStructPtr, int base, SubFont *subFontPtr); -static char ** ListFonts(Display *display, CONST char *faceName, +static char ** ListFonts(Display *display, const char *faceName, int *numNamesPtr); -static char ** ListFontOrAlias(Display *display, CONST char*faceName, +static char ** ListFontOrAlias(Display *display, const char*faceName, int *numNamesPtr); -static unsigned int RankAttributes(FontAttributes *wantPtr, +static unsigned RankAttributes(FontAttributes *wantPtr, FontAttributes *gotPtr); static void ReleaseFont(UnixFont *fontPtr); static void ReleaseSubFont(Display *display, SubFont *subFontPtr); -static int SeenName(CONST char *name, Tcl_DString *dsPtr); +static int SeenName(const char *name, Tcl_DString *dsPtr); #ifndef WORDS_BIGENDIAN -static int Ucs2beToUtfProc(ClientData clientData, CONST char*src, +static int Ucs2beToUtfProc(ClientData clientData, const char*src, int srcLen, int flags, Tcl_EncodingState*statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); -static int UtfToUcs2beProc(ClientData clientData, CONST char*src, +static int UtfToUcs2beProc(ClientData clientData, const char*src, int srcLen, int flags, Tcl_EncodingState*statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); @@ -279,7 +279,7 @@ static void FontPkgCleanup( ClientData clientData) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->controlFamily.encoding != NULL) { @@ -318,7 +318,7 @@ void TkpFontPkgInit( TkMainInfo *mainPtr) /* The application being created. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_EncodingType type; SubFont dummy; @@ -380,7 +380,7 @@ TkpFontPkgInit( static int ControlUtfProc( ClientData clientData, /* Not used. */ - CONST char *src, /* Source string in UTF-8. */ + const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state @@ -404,7 +404,7 @@ ControlUtfProc( * correspond to the bytes stored in the * output buffer. */ { - CONST char *srcStart, *srcEnd; + const char *srcStart, *srcEnd; char *dstStart, *dstEnd; Tcl_UniChar ch; int result; @@ -473,7 +473,7 @@ ControlUtfProc( static int Ucs2beToUtfProc( ClientData clientData, /* Not used. */ - CONST char *src, /* Source string in Unicode. */ + const char *src, /* Source string in Unicode. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state @@ -497,7 +497,7 @@ Ucs2beToUtfProc( * correspond to the bytes stored in the * output buffer. */ { - CONST char *srcStart, *srcEnd; + const char *srcStart, *srcEnd; char *dstEnd, *dstStart; int result, numChars; @@ -556,7 +556,7 @@ static int UtfToUcs2beProc( ClientData clientData, /* TableEncodingData that specifies * encoding. */ - CONST char *src, /* Source string in UTF-8. */ + const char *src, /* Source string in UTF-8. */ int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Place for conversion routine to store state @@ -580,14 +580,14 @@ UtfToUcs2beProc( * correspond to the bytes stored in the * output buffer. */ { - CONST char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; + const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd; int result, numChars; Tcl_UniChar ch; srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - if ((flags & TCL_ENCODING_END) == 0) { + if (!(flags & TCL_ENCODING_END)) { srcClose -= TCL_UTF_MAX; } @@ -656,12 +656,12 @@ UtfToUcs2beProc( TkFont * TkpGetNativeFont( Tk_Window tkwin, /* For display where font will be used. */ - CONST char *name) /* Platform-specific font name. */ + const char *name) /* Platform-specific font name. */ { UnixFont *fontPtr; XFontStruct *fontStructPtr; FontAttributes fa; - CONST char *p; + const char *p; int hasSpace, dashes, hasWild; /* @@ -719,7 +719,7 @@ TkpGetNativeFont( } fontStructPtr = CreateClosestFont(tkwin, &fa.fa, &fa.xa); } - fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont)); + fontPtr = ckalloc(sizeof(UnixFont)); InitFont(tkwin, fontStructPtr, fontPtr); return (TkFont *) fontPtr; @@ -763,7 +763,7 @@ TkpGetFontFromAttributes( * will be released. If NULL, a new TkFont * structure is allocated. */ Tk_Window tkwin, /* For display where font will be used. */ - CONST TkFontAttributes *faPtr) + const TkFontAttributes *faPtr) /* Set of attributes to match. */ { UnixFont *fontPtr; @@ -775,7 +775,7 @@ TkpGetFontFromAttributes( fontPtr = (UnixFont *) tkFontPtr; if (fontPtr == NULL) { - fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont)); + fontPtr = ckalloc(sizeof(UnixFont)); } else { ReleaseFont(fontPtr); } @@ -845,8 +845,6 @@ TkpGetFontFamilies( Tcl_HashSearch search; Tcl_Obj *resultPtr, *strPtr; - resultPtr = Tcl_GetObjResult(interp); - Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS); nameList = ListFonts(Tk_Display(tkwin), "*", &numNames); for (i = 0; i < numNames; i++) { @@ -874,11 +872,13 @@ TkpGetFontFamilies( XFreeFontNames(nameList); hPtr = Tcl_FirstHashEntry(&familyTable, &search); + resultPtr = Tcl_NewObj(); while (hPtr != NULL) { strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&familyTable, hPtr), -1); Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); hPtr = Tcl_NextHashEntry(&search); } + Tcl_SetObjResult(interp, resultPtr); Tcl_DeleteHashTable(&familyTable); } @@ -911,7 +911,7 @@ TkpGetSubFonts( UnixFont *fontPtr; FontFamily *familyPtr; - resultPtr = Tcl_GetObjResult(interp); + resultPtr = Tcl_NewObj(); fontPtr = (UnixFont *) tkfont; for (i = 0; i < fontPtr->numSubFonts; i++) { familyPtr = fontPtr->subFontArray[i].familyPtr; @@ -922,6 +922,7 @@ TkpGetSubFonts( listPtr = Tcl_NewListObj(3, objv); Tcl_ListObjAppendElement(NULL, resultPtr, listPtr); } + Tcl_SetObjResult(interp, resultPtr); } /* @@ -958,6 +959,7 @@ TkpGetFontAttrsForChar( SubFont *thisSubFontPtr = FindSubFontForChar(fontPtr, c, &lastSubFontPtr); /* Pointer to the subfont to use for the given * character */ + GetFontAttributes(Tk_Display(tkwin), thisSubFontPtr->fontStructPtr, &atts); *faPtr = atts.fa; } @@ -986,7 +988,7 @@ TkpGetFontAttrsForChar( int Tk_MeasureChars( Tk_Font tkfont, /* Font in which characters will be drawn. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ int numBytes, /* Maximum number of bytes to consider from * source string. */ @@ -1025,7 +1027,7 @@ Tk_MeasureChars( curX = 0; curByte = 0; } else if (maxLength < 0) { - CONST char *p, *end, *next; + const char *p, *end, *next; Tcl_UniChar ch; SubFont *thisSubFontPtr; FontFamily *familyPtr; @@ -1078,11 +1080,11 @@ Tk_MeasureChars( Tcl_DStringFree(&runString); curByte = numBytes; } else { - CONST char *p, *end, *next, *term; + const char *p, *end, *next, *term; int newX, termX, sawNonSpace, dstWrote; Tcl_UniChar ch; FontFamily *familyPtr; - char buf[16]; + XChar2b buf[8]; /* * How many chars will fit in the space allotted? This first version @@ -1104,14 +1106,14 @@ Tk_MeasureChars( } else { lastSubFontPtr = FindSubFontForChar(fontPtr, ch, NULL); familyPtr = lastSubFontPtr->familyPtr; - Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p, - 0, NULL, buf, sizeof(buf), NULL, &dstWrote, NULL); + Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p, 0, NULL, + (char *)&buf[0].byte1, sizeof(buf), NULL, &dstWrote, NULL); if (familyPtr->isTwoByteFont) { newX += XTextWidth16(lastSubFontPtr->fontStructPtr, - (XChar2b *) buf, dstWrote >> 1); + buf, dstWrote >> 1); } else { - newX += XTextWidth(lastSubFontPtr->fontStructPtr, buf, - dstWrote); + newX += XTextWidth(lastSubFontPtr->fontStructPtr, + (char *)&buf[0].byte1, dstWrote); } } if (newX > maxLength) { @@ -1200,7 +1202,7 @@ Tk_MeasureChars( int TkpMeasureCharsInContext( Tk_Font tkfont, /* Font in which characters will be drawn. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ int numBytes, /* Maximum number of bytes to consider from * source string in all. */ @@ -1253,7 +1255,7 @@ Tk_DrawChars( GC gc, /* Graphics context for drawing characters. */ Tk_Font tkfont, /* Font in which characters will be drawn; * must be the same as font used in GC. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. All Tk meta-characters * (tabs, control characters, and newlines) * should be stripped out of the string that @@ -1264,22 +1266,20 @@ Tk_DrawChars( int x, int y) /* Coordinates at which to place origin of * string when drawing. */ { - UnixFont *fontPtr; + UnixFont *fontPtr = (UnixFont *) tkfont; SubFont *thisSubFontPtr, *lastSubFontPtr; Tcl_DString runString; - CONST char *p, *end, *next; + const char *p, *end, *next; int xStart, needWidth, window_width, do_width; Tcl_UniChar ch; FontFamily *familyPtr; #ifdef TK_DRAW_CHAR_XWINDOW_CHECK int rx, ry; - unsigned int width, height, border_width, depth; + unsigned width, height, border_width, depth; Drawable root; #endif - fontPtr = (UnixFont *) tkfont; lastSubFontPtr = &fontPtr->subFontArray[0]; - xStart = x; #ifdef TK_DRAW_CHAR_XWINDOW_CHECK @@ -1392,7 +1392,7 @@ TkpDrawCharsInContext( GC gc, /* Graphics context for drawing characters. */ Tk_Font tkfont, /* Font in which characters will be drawn; * must be the same as font used in GC. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. All Tk meta-characters * (tabs, control characters, and newlines) * should be stripped out of the string that @@ -1441,9 +1441,9 @@ TkpDrawCharsInContext( static XFontStruct * CreateClosestFont( Tk_Window tkwin, /* For display where font will be used. */ - CONST TkFontAttributes *faPtr, + const TkFontAttributes *faPtr, /* Set of generic attributes to match. */ - CONST TkXLFDAttributes *xaPtr) + const TkXLFDAttributes *xaPtr) /* Set of X-specific attributes to match. */ { FontAttributes want; @@ -1451,7 +1451,7 @@ CreateClosestFont( int numNames, nameIdx, bestIdx[2]; Display *display; XFontStruct *fontStructPtr; - unsigned int bestScore[2]; + unsigned bestScore[2]; want.fa = *faPtr; want.xa = *xaPtr; @@ -1481,9 +1481,9 @@ CreateClosestFont( nameList = ListFontOrAlias(display, want.fa.family, &numNames); if (numNames == 0) { - char ***fontFallbacks; + const char *const *const *fontFallbacks; int i, j; - char *fallback; + const char *fallback; fontFallbacks = TkFontGetFallbacks(); for (i = 0; fontFallbacks[i] != NULL; i++) { @@ -1513,12 +1513,12 @@ CreateClosestFont( found: bestIdx[0] = -1; bestIdx[1] = -1; - bestScore[0] = (unsigned int) -1; - bestScore[1] = (unsigned int) -1; + bestScore[0] = (unsigned) -1; + bestScore[1] = (unsigned) -1; for (nameIdx = 0; nameIdx < numNames; nameIdx++) { FontAttributes got; int scalable; - unsigned int score; + unsigned score; if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) { continue; @@ -1574,7 +1574,7 @@ InitFont( UnixFont *fontPtr) /* Filled with information constructed from * the above arguments. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); unsigned long value; int minHi, maxHi, minLo, maxLo, fixed, width, limit, i, n; @@ -1648,7 +1648,7 @@ InitFont( pageMap = fontPtr->subFontArray[0].fontMap[0]; for (i = 0; i < 256; i++) { if ((minHi > 0) || (i < minLo) || (i > maxLo) - || (((pageMap[i>>3] >> (i&7)) & 1) == 0)) { + || !((pageMap[i>>3] >> (i&7)) & 1)) { n = 0; } else if (fontStructPtr->per_char == NULL) { n = fontStructPtr->max_bounds.width; @@ -1727,7 +1727,7 @@ ReleaseFont( ReleaseSubFont(fontPtr->display, &fontPtr->subFontArray[i]); } if (fontPtr->subFontArray != fontPtr->staticSubFonts) { - ckfree((char *) fontPtr->subFontArray); + ckfree(fontPtr->subFontArray); } } @@ -1827,7 +1827,7 @@ AllocFontFamily( FontFamily *familyPtr; FontAttributes fa; Tcl_Encoding encoding; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); GetFontAttributes(display, fontStructPtr, &fa); @@ -1844,7 +1844,7 @@ AllocFontFamily( } } - familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily)); + familyPtr = ckalloc(sizeof(FontFamily)); memset(familyPtr, 0, sizeof(FontFamily)); familyPtr->nextPtr = tsdPtr->fontFamilyList; tsdPtr->fontFamilyList = familyPtr; @@ -1901,7 +1901,7 @@ FreeFontFamily( FontFamily *familyPtr) /* The FontFamily to delete. */ { FontFamily **familyPtrPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); int i; @@ -1931,7 +1931,7 @@ FreeFontFamily( familyPtrPtr = &(*familyPtrPtr)->nextPtr; } - ckfree((char *) familyPtr); + ckfree(familyPtr); } /* @@ -1967,7 +1967,11 @@ FindSubFontForChar( { int i, j, k, numNames; Tk_Uid faceName; - char *fallback, **aliases, **nameList, **anyFallbacks, ***fontFallbacks; + const char *fallback; + const char *const *aliases; + char **nameList; + const char *const *anyFallbacks; + const char *const *const *fontFallbacks; SubFont *subFontPtr; Tcl_DString ds; @@ -2204,10 +2208,10 @@ FontMapLoadPage( Tcl_Encoding encoding; XFontStruct *fontStructPtr; XCharStruct *widths; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8); + subFontPtr->fontMap[row] = ckalloc(FONTMAP_BITSPERPAGE / 8); memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8); if (subFontPtr->familyPtr == &tsdPtr->controlFamily) { @@ -2285,7 +2289,7 @@ static SubFont * CanUseFallbackWithAliases( UnixFont *fontPtr, /* The font object that will own the new * screen font. */ - char *faceName, /* Desired face name for new screen font. */ + const char *faceName, /* Desired face name for new screen font. */ int ch, /* The Unicode character that the new screen * font must be able to display. */ Tcl_DString *nameTriedPtr, /* Records face names that have already been @@ -2296,7 +2300,7 @@ CanUseFallbackWithAliases( * reallocate our subfont table. */ { SubFont *subFontPtr; - char **aliases; + const char *const *aliases; int i; if (SeenName(faceName, nameTriedPtr) == 0) { @@ -2341,11 +2345,11 @@ CanUseFallbackWithAliases( static int SeenName( - CONST char *name, /* The name to check. */ + const char *name, /* The name to check. */ Tcl_DString *dsPtr) /* Contains names that have already been * seen. */ { - CONST char *seen, *end; + const char *seen, *end; seen = Tcl_DStringValue(dsPtr); end = seen + Tcl_DStringLength(dsPtr); @@ -2355,7 +2359,7 @@ SeenName( } seen += strlen(seen) + 1; } - Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1)); + Tcl_DStringAppend(dsPtr, name, (int) (strlen(name) + 1)); return 0; } @@ -2390,7 +2394,7 @@ static SubFont * CanUseFallback( UnixFont *fontPtr, /* The font object that will own the new * screen font. */ - CONST char *faceName, /* Desired face name for new screen font. */ + const char *faceName, /* Desired face name for new screen font. */ int ch, /* The Unicode character that the new screen * font must be able to display. */ SubFont **fixSubFontPtrPtr) /* Subfont reference to fix up if we @@ -2398,9 +2402,11 @@ CanUseFallback( { int i, nameIdx, numNames, srcLen, numEncodings, bestIdx[2]; Tk_Uid hateFoundry; - CONST char *charset, *hateCharset; - unsigned int bestScore[2]; - char **nameList, **nameListOrig, src[TCL_UTF_MAX]; + const char *charset, *hateCharset; + unsigned bestScore[2]; + char **nameList; + char **nameListOrig; + char src[TCL_UTF_MAX]; FontAttributes want, got; Display *display; SubFont subFont; @@ -2448,13 +2454,13 @@ CanUseFallback( retry: bestIdx[0] = -1; bestIdx[1] = -1; - bestScore[0] = (unsigned int) -1; - bestScore[1] = (unsigned int) -1; + bestScore[0] = (unsigned) -1; + bestScore[1] = (unsigned) -1; for (nameIdx = 0; nameIdx < numNames; nameIdx++) { Tcl_Encoding encoding; char dst[16]; int scalable, srcRead, dstWrote; - unsigned int score; + unsigned score; if (nameList[nameIdx] == NULL) { continue; @@ -2537,7 +2543,7 @@ CanUseFallback( * make a copy. */ - nameList = (char **) ckalloc(numNames * sizeof(char *)); + nameList = ckalloc(numNames * sizeof(char *)); memcpy(nameList, nameListOrig, numNames * sizeof(char *)); } nameList[nameIdx] = NULL; @@ -2555,7 +2561,7 @@ CanUseFallback( if (fontStructPtr == NULL) { if (nameList != nameListOrig) { - ckfree((char *) nameList); + ckfree(nameList); } XFreeFontNames(nameListOrig); return NULL; @@ -2575,16 +2581,15 @@ CanUseFallback( goto retry; } if (nameList != nameListOrig) { - ckfree((char *) nameList); + ckfree(nameList); } XFreeFontNames(nameListOrig); if (fontPtr->numSubFonts >= SUBFONT_SPACE) { SubFont *newPtr; - newPtr = (SubFont *) - ckalloc(sizeof(SubFont) * (fontPtr->numSubFonts + 1)); - memcpy((char *) newPtr, fontPtr->subFontArray, + newPtr = ckalloc(sizeof(SubFont) * (fontPtr->numSubFonts + 1)); + memcpy(newPtr, fontPtr->subFontArray, fontPtr->numSubFonts * sizeof(SubFont)); if (fixSubFontPtrPtr != NULL) { register SubFont *fixSubFontPtr = *fixSubFontPtrPtr; @@ -2595,7 +2600,7 @@ CanUseFallback( } } if (fontPtr->subFontArray != fontPtr->staticSubFonts) { - ckfree((char *) fontPtr->subFontArray); + ckfree(fontPtr->subFontArray); } fontPtr->subFontArray = newPtr; } @@ -2622,12 +2627,12 @@ CanUseFallback( *--------------------------------------------------------------------------- */ -static unsigned int +static unsigned RankAttributes( FontAttributes *wantPtr, /* The desired attributes. */ FontAttributes *gotPtr) /* The attributes we have to live with. */ { - unsigned int penalty; + unsigned penalty; penalty = 0; if (gotPtr->xa.foundry != wantPtr->xa.foundry) { @@ -2674,7 +2679,7 @@ RankAttributes( } if (gotPtr->xa.charset != wantPtr->xa.charset) { int i; - CONST char *gotAlias, *wantAlias; + const char *gotAlias, *wantAlias; penalty += 65000; gotAlias = GetEncodingAlias(gotPtr->xa.charset); @@ -2719,7 +2724,7 @@ GetScreenFont( char **nameList, /* Array of XLFDs. */ int bestIdx[2], /* Indices into above array for XLFD of best * bitmapped and best scalable font. */ - unsigned int bestScore[2]) /* Scores of best bitmapped and best scalable + unsigned bestScore[2]) /* Scores of best bitmapped and best scalable * font. XLFD corresponding to lowest score * will be constructed. */ { @@ -2888,7 +2893,7 @@ GetFontAttributes( static char ** ListFonts( Display *display, /* Display to query. */ - CONST char *faceName, /* Desired face name, or "*" for all. */ + const char *faceName, /* Desired face name, or "*" for all. */ int *numNamesPtr) /* Filled with length of returned array, or 0 * if no names were found. */ { @@ -2901,11 +2906,12 @@ ListFonts( static char ** ListFontOrAlias( Display *display, /* Display to query. */ - CONST char *faceName, /* Desired face name, or "*" for all. */ + const char *faceName, /* Desired face name, or "*" for all. */ int *numNamesPtr) /* Filled with length of returned array, or 0 * if no names were found. */ { - char **nameList, **aliases; + char **nameList; + const char *const *aliases; int i; nameList = ListFonts(display, faceName, numNamesPtr); @@ -2954,7 +2960,8 @@ IdentifySymbolEncodings( FontAttributes *faPtr) { int i, j; - char **aliases, **symbolClass; + const char *const *aliases; + const char *const *symbolClass; symbolClass = TkFontGetSymbolClass(); for (i = 0; symbolClass[i] != NULL; i++) { @@ -2993,14 +3000,14 @@ IdentifySymbolEncodings( *--------------------------------------------------------------------------- */ -static CONST char * +static const char * GetEncodingAlias( - CONST char *name) /* The name to look up. */ + const char *name) /* The name to look up. */ { EncodingAlias *aliasPtr; for (aliasPtr = encodingAliases; aliasPtr->aliasPattern != NULL; ) { - if (Tcl_StringMatch((char *) name, aliasPtr->aliasPattern)) { + if (Tcl_StringMatch(name, aliasPtr->aliasPattern)) { return aliasPtr->realName; } aliasPtr++; @@ -3009,6 +3016,305 @@ GetEncodingAlias( } /* + *--------------------------------------------------------------------------- + * + * TkDrawAngledChars -- + * + * Draw some characters at an angle. This is awkward here because we have + * no reliable way of drawing any characters at an angle in classic X11; + * we have to draw on a Pixmap which is converted to an XImage (from + * helper function GetImageOfText), rotate the image (hokey code!) onto + * another XImage (from helper function InitDestImage), and then use the + * rotated image as a mask when drawing. This is pretty awful; improved + * versions are welcomed! + * + * Results: + * None. + * + * Side effects: + * Target drawable is updated. + * + *--------------------------------------------------------------------------- + */ + +static inline XImage * +GetImageOfText( + Display *display, /* Display on which to draw. */ + Drawable drawable, /* Window or pixmap in which to draw. */ + Tk_Font tkfont, /* Font in which characters will be drawn. */ + const char *source, /* UTF-8 string to be displayed. Need not be + * '\0' terminated. All Tk meta-characters + * (tabs, control characters, and newlines) + * should be stripped out of the string that + * is passed to this function. If they are not + * stripped out, they will be displayed as + * regular printing characters. */ + int numBytes, /* Number of bytes in string. */ + int *realWidthPtr, int *realHeightPtr) +{ + int width, height; + TkFont *fontPtr = (TkFont *) tkfont; + Pixmap bitmap; + GC bitmapGC; + XGCValues values; + XImage *image; + + (void) Tk_MeasureChars(tkfont, source, numBytes, -1, 0, &width); + height = fontPtr->fm.ascent + fontPtr->fm.descent; + + bitmap = Tk_GetPixmap(display, drawable, width, height, 1); + values.graphics_exposures = False; + values.foreground = BlackPixel(display, DefaultScreen(display)); + bitmapGC = XCreateGC(display, bitmap, GCGraphicsExposures|GCForeground, + &values); + XFillRectangle(display, bitmap, bitmapGC, 0, 0, width, height); + + values.font = Tk_FontId(tkfont); + values.foreground = WhitePixel(display, DefaultScreen(display)); + values.background = BlackPixel(display, DefaultScreen(display)); + XChangeGC(display, bitmapGC, GCFont|GCForeground|GCBackground, &values); + Tk_DrawChars(display, bitmap, bitmapGC, tkfont, source, numBytes, 0, + fontPtr->fm.ascent); + XFreeGC(display, bitmapGC); + + image = XGetImage(display, bitmap, 0, 0, width, height, AllPlanes, + ZPixmap); + Tk_FreePixmap(display, bitmap); + + *realWidthPtr = width; + *realHeightPtr = height; + return image; +} + +static inline XImage * +InitDestImage( + Display *display, + Drawable drawable, + int width, + int height, + Pixmap *bitmapPtr) +{ + Pixmap bitmap; + XImage *image; + GC bitmapGC; + XGCValues values; + + bitmap = Tk_GetPixmap(display, drawable, width, height, 1); + values.graphics_exposures = False; + values.foreground = BlackPixel(display, DefaultScreen(display)); + bitmapGC = XCreateGC(display, bitmap, GCGraphicsExposures|GCForeground, + &values); + XFillRectangle(display, bitmap, bitmapGC, 0, 0, width, height); + XFreeGC(display, bitmapGC); + + image = XGetImage(display, bitmap, 0, 0, width, height, AllPlanes, + ZPixmap); + *bitmapPtr = bitmap; + return image; +} + +void +TkDrawAngledChars( + Display *display, /* Display on which to draw. */ + Drawable drawable, /* Window or pixmap in which to draw. */ + GC gc, /* Graphics context for drawing characters. */ + Tk_Font tkfont, /* Font in which characters will be drawn; + * must be the same as font used in GC. */ + const char *source, /* UTF-8 string to be displayed. Need not be + * '\0' terminated. All Tk meta-characters + * (tabs, control characters, and newlines) + * should be stripped out of the string that + * is passed to this function. If they are not + * stripped out, they will be displayed as + * regular printing characters. */ + int numBytes, /* Number of bytes in string. */ + double x, double y, + double angle) +{ + if (angle == 0.0) { + Tk_DrawChars(display, drawable, gc, tkfont, source, numBytes, x, y); + } else { + double sinA = sin(angle * PI/180.0), cosA = cos(angle * PI/180.0); + int bufHeight, bufWidth, srcWidth, srcHeight, i, j, dx, dy; + Pixmap buf; + XImage *srcImage = GetImageOfText(display, drawable, tkfont, source, + numBytes, &srcWidth, &srcHeight); + XImage *dstImage; + enum {Q0=1,R1,Q1,R2,Q2,R3,Q3} quadrant; + GC bwgc, cpgc; + XGCValues values; + int ascent = ((TkFont *) tkfont)->fm.ascent; + + /* + * First, work out what quadrant we are operating in. We also handle + * the rectilinear rotations as special cases. Conceptually, there's + * also R0 (angle == 0.0) but that has been already handled as a + * special case above. + * + * R1 + * Q1 | Q0 + * | + * R2 ----+---- R0 + * | + * Q2 | Q3 + * R3 + */ + + if (angle < 90.0) { + quadrant = Q0; + } else if (angle == 90.0) { + quadrant = R1; + } else if (angle < 180.0) { + quadrant = Q1; + } else if (angle == 180.0) { + quadrant = R2; + } else if (angle < 270.0) { + quadrant = Q2; + } else if (angle == 270.0) { + quadrant = R3; + } else { + quadrant = Q3; + } + + if (srcImage == NULL) { + return; + } + bufWidth = srcWidth*fabs(cosA) + srcHeight*fabs(sinA); + bufHeight = srcHeight*fabs(cosA) + srcWidth*fabs(sinA); + dstImage = InitDestImage(display, drawable, bufWidth,bufHeight, &buf); + if (dstImage == NULL) { + Tk_FreePixmap(display, buf); + XDestroyImage(srcImage); + return; + } + + /* + * Do the rotation, setting or resetting pixels in the destination + * image dependent on whether the corresponding pixel (after rotation + * to source image space) is set. + */ + + for (i=0 ; i<srcWidth ; i++) { + for (j=0 ; j<srcHeight ; j++) { + switch (quadrant) { + case Q0: + dx = ROUND16(i*cosA + j*sinA); + dy = ROUND16(j*cosA + (srcWidth - i)*sinA); + break; + case R1: + dx = j; + dy = srcWidth - i; + break; + case Q1: + dx = ROUND16((i - srcWidth)*cosA + j*sinA); + dy = ROUND16((srcWidth-i)*sinA + (j-srcHeight)*cosA); + break; + case R2: + dx = srcWidth - i; + dy = srcHeight - j; + break; + case Q2: + dx = ROUND16((i-srcWidth)*cosA + (j-srcHeight)*sinA); + dy = ROUND16((j - srcHeight)*cosA - i*sinA); + break; + case R3: + dx = srcHeight - j; + dy = i; + break; + default: + dx = ROUND16(i*cosA + (j - srcHeight)*sinA); + dy = ROUND16(j*cosA - i*sinA); + } + + if (dx < 0 || dy < 0 || dx >= bufWidth || dy >= bufHeight) { + continue; + } + XPutPixel(dstImage, dx, dy, + XGetPixel(dstImage,dx,dy) | XGetPixel(srcImage,i,j)); + } + } + XDestroyImage(srcImage); + + /* + * Schlep the data back to the Xserver. + */ + + values.function = GXcopy; + values.foreground = WhitePixel(display, DefaultScreen(display)); + values.background = BlackPixel(display, DefaultScreen(display)); + bwgc = XCreateGC(display, buf, GCFunction|GCForeground|GCBackground, + &values); + XPutImage(display, buf, bwgc, dstImage, 0,0, 0,0, bufWidth,bufHeight); + XFreeGC(display, bwgc); + XDestroyImage(dstImage); + + /* + * Calculate where we want to draw the text. + */ + + switch (quadrant) { + case Q0: + dx = x; + dy = y - srcWidth*sinA; + break; + case R1: + dx = x; + dy = y - srcWidth; + break; + case Q1: + dx = x + srcWidth*cosA; + dy = y + srcHeight*cosA - srcWidth*sinA; + break; + case R2: + dx = x - srcWidth; + dy = y - srcHeight; + break; + case Q2: + dx = x + srcWidth*cosA + srcHeight*sinA; + dy = y + srcHeight*cosA; + break; + case R3: + dx = x - srcHeight; + dy = y; + break; + default: + dx = x + srcHeight*sinA; + dy = y; + } + + /* + * Apply a correction to deal with the fact that we aren't told to + * draw from our top-left corner but rather from the left-end of our + * baseline. + */ + + dx -= ascent*sinA; + dy -= ascent*cosA; + + /* + * Transfer the text to the screen. This is done by using it as a mask + * and then drawing through that mask with the original drawing color. + */ + + values.function = GXcopy; + values.fill_style = FillSolid; + values.clip_mask = buf; + values.clip_x_origin = dx; + values.clip_y_origin = dy; + cpgc = XCreateGC(display, drawable, + GCFunction|GCFillStyle|GCClipMask|GCClipXOrigin|GCClipYOrigin, + &values); + XCopyGC(display, gc, GCForeground, cpgc); + XFillRectangle(display, drawable, cpgc, dx, dy, bufWidth, + bufHeight); + XFreeGC(display, cpgc); + + Tk_FreePixmap(display, buf); + return; + } +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/unix/tkUnixInit.c b/unix/tkUnixInit.c index 1cc90a5..b0aa2fa 100644 --- a/unix/tkUnixInit.c +++ b/unix/tkUnixInit.c @@ -67,9 +67,9 @@ TkpGetAppName( Tcl_Interp *interp, Tcl_DString *namePtr) /* A previously initialized Tcl_DString. */ { - CONST char *p, *name; + const char *p, *name; - name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); + name = Tcl_GetVar2(interp, "argv0", NULL, TCL_GLOBAL_ONLY); if ((name == NULL) || (*name == 0)) { name = "tk"; } else { @@ -100,10 +100,11 @@ TkpGetAppName( void TkpDisplayWarning( - CONST char *msg, /* Message to be displayed. */ - CONST char *title) /* Title of warning. */ + const char *msg, /* Message to be displayed. */ + const char *title) /* Title of warning. */ { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); + if (errChannel) { Tcl_WriteChars(errChannel, title, -1); Tcl_WriteChars(errChannel, ": ", 2); @@ -143,7 +144,7 @@ GetLibraryPath( "com.tcltk.tklibrary", TK_FRAMEWORK_VERSION, 0, PATH_MAX, tkLibPath); if (tkLibPath[0] != '\0') { - Tcl_SetVar(interp, "tk_library", tkLibPath, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tk_library", NULL, tkLibPath, TCL_GLOBAL_ONLY); } return foundInFramework; #else diff --git a/unix/tkUnixKey.c b/unix/tkUnixKey.c index 40cc779..23c4aa4 100644 --- a/unix/tkUnixKey.c +++ b/unix/tkUnixKey.c @@ -37,7 +37,7 @@ * Tk_SetCaretPos -- * * This enables correct placement of the XIM caret. This is called by - * widgets to indicate their cursor placement. This is currently only + * widgets to indicate their cursor placement. This is currently only * used for over-the-spot XIM. * *---------------------------------------------------------------------- @@ -53,11 +53,10 @@ Tk_SetCaretPos( TkWindow *winPtr = (TkWindow *) tkwin; TkDisplay *dispPtr = winPtr->dispPtr; - if ( dispPtr->caret.winPtr == winPtr - && dispPtr->caret.x == x - && dispPtr->caret.y == y - && dispPtr->caret.height == height) - { + if ((dispPtr->caret.winPtr == winPtr) + && (dispPtr->caret.x == x) + && (dispPtr->caret.y == y) + && (dispPtr->caret.height == height)) { return; } @@ -66,22 +65,21 @@ Tk_SetCaretPos( dispPtr->caret.y = y; dispPtr->caret.height = height; -#ifdef TK_USE_INPUT_METHODS /* * Adjust the XIM caret position. */ - if ( (dispPtr->flags & TK_DISPLAY_USE_IM) - && (dispPtr->inputStyle & XIMPreeditPosition) - && (winPtr->inputContext != NULL) ) - { + +#ifdef TK_USE_INPUT_METHODS + if ((dispPtr->flags & TK_DISPLAY_USE_IM) + && (dispPtr->inputStyle & XIMPreeditPosition) + && (winPtr->inputContext != NULL)) { XVaNestedList preedit_attr; XPoint spot; spot.x = dispPtr->caret.x; spot.y = dispPtr->caret.y + dispPtr->caret.height; preedit_attr = XVaCreateNestedList(0, XNSpotLocation, &spot, NULL); - XSetICValues(winPtr->inputContext, - XNPreeditAttributes, preedit_attr, + XSetICValues(winPtr->inputContext, XNPreeditAttributes, preedit_attr, NULL); XFree(preedit_attr); } @@ -106,7 +104,7 @@ Tk_SetCaretPos( *---------------------------------------------------------------------- */ -char * +const char * TkpGetString( TkWindow *winPtr, /* Window where event occurred */ XEvent *eventPtr, /* X keyboard event. */ @@ -130,8 +128,7 @@ TkpGetString( #ifdef TK_USE_INPUT_METHODS if ((winPtr->dispPtr->flags & TK_DISPLAY_USE_IM) && (winPtr->inputContext != NULL) - && (eventPtr->type == KeyPress)) - { + && (eventPtr->type == KeyPress)) { Status status; #if X_HAVE_UTF8_STRING @@ -140,7 +137,11 @@ TkpGetString( Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr), &kePtr->keysym, &status); - if (status == XBufferOverflow) { /* Expand buffer and try again */ + if (status == XBufferOverflow) { + /* + * Expand buffer and try again. + */ + Tcl_DStringSetLength(dsPtr, len); len = Xutf8LookupString(winPtr->inputContext, &eventPtr->xkey, Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr), @@ -157,7 +158,6 @@ TkpGetString( Tcl_DStringInit(&buf); Tcl_DStringSetLength(&buf, TCL_DSTRING_STATIC_SIZE-1); - len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf), &kePtr->keysym, &status); @@ -174,7 +174,6 @@ TkpGetString( if ((status != XLookupChars) && (status != XLookupBoth)) { len = 0; } - Tcl_DStringSetLength(&buf, len); Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buf), len, dsPtr); Tcl_DStringFree(&buf); @@ -218,7 +217,7 @@ TkpGetString( * from having to reenter the XIM engine. [Bug 1373712] */ - kePtr->charValuePtr = ckalloc((unsigned) len + 1); + kePtr->charValuePtr = ckalloc(len + 1); kePtr->charValueLen = len; memcpy(kePtr->charValuePtr, Tcl_DStringValue(dsPtr), (unsigned) len + 1); return Tcl_DStringValue(dsPtr); @@ -434,7 +433,7 @@ TkpInitKeymapInfo( dispPtr->metaModMask = 0; dispPtr->altModMask = 0; codePtr = modMapPtr->modifiermap; - max = 8*modMapPtr->max_keypermod; + max = 8 * modMapPtr->max_keypermod; for (i = 0; i < max; i++, codePtr++) { if (*codePtr == 0) { continue; @@ -456,12 +455,11 @@ TkpInitKeymapInfo( */ if (dispPtr->modKeyCodes != NULL) { - ckfree((char *) dispPtr->modKeyCodes); + ckfree(dispPtr->modKeyCodes); } dispPtr->numModKeyCodes = 0; arraySize = KEYCODE_ARRAY_SIZE; - dispPtr->modKeyCodes = (KeyCode *) - ckalloc((unsigned) (KEYCODE_ARRAY_SIZE * sizeof(KeyCode))); + dispPtr->modKeyCodes = ckalloc(KEYCODE_ARRAY_SIZE * sizeof(KeyCode)); for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) { if (*codePtr == 0) { continue; @@ -473,23 +471,26 @@ TkpInitKeymapInfo( for (j = 0; j < dispPtr->numModKeyCodes; j++) { if (dispPtr->modKeyCodes[j] == *codePtr) { + /* + * 'continue' the outer loop. + */ + goto nextModCode; } } if (dispPtr->numModKeyCodes >= arraySize) { - KeyCode *new; + KeyCode *newCodes; /* * Ran out of space in the array; grow it. */ arraySize *= 2; - new = (KeyCode *) - ckalloc((unsigned) (arraySize * sizeof(KeyCode))); - memcpy(new, dispPtr->modKeyCodes, - (dispPtr->numModKeyCodes * sizeof(KeyCode))); - ckfree((char *) dispPtr->modKeyCodes); - dispPtr->modKeyCodes = new; + newCodes = ckalloc(arraySize * sizeof(KeyCode)); + memcpy(newCodes, dispPtr->modKeyCodes, + dispPtr->numModKeyCodes * sizeof(KeyCode)); + ckfree(dispPtr->modKeyCodes); + dispPtr->modKeyCodes = newCodes; } dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr; dispPtr->numModKeyCodes++; diff --git a/unix/tkUnixMenu.c b/unix/tkUnixMenu.c index eceb5b2..bc1bd2e 100644 --- a/unix/tkUnixMenu.c +++ b/unix/tkUnixMenu.c @@ -51,7 +51,7 @@ MODULE_SCOPE void TkpDrawCheckIndicator(Tk_Window tkwin, static void SetHelpMenu(TkMenu *menuPtr); static void DrawMenuEntryAccelerator(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, - Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, + Tk_Font tkfont, const Tk_FontMetrics *fmPtr, Tk_3DBorder activeBorder, int x, int y, int width, int height, int drawArrow); static void DrawMenuEntryBackground(TkMenu *menuPtr, @@ -62,42 +62,42 @@ static void DrawMenuEntryIndicator(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, Tk_3DBorder border, XColor *indicatorColor, XColor *disableColor, Tk_Font tkfont, - CONST Tk_FontMetrics *fmPtr, int x, int y, + const Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void DrawMenuEntryLabel(TkMenu * menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, - Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, + Tk_Font tkfont, const Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void DrawMenuSeparator(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, - Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, + Tk_Font tkfont, const Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void DrawTearoffEntry(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, - Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, + Tk_Font tkfont, const Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void DrawMenuUnderline(TkMenu *menuPtr, TkMenuEntry *mePtr, Drawable d, GC gc, - Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, + Tk_Font tkfont, const Tk_FontMetrics *fmPtr, int x, int y, int width, int height); static void GetMenuAccelGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, - CONST Tk_FontMetrics *fmPtr, int *widthPtr, + const Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); static void GetMenuLabelGeometry(TkMenuEntry *mePtr, - Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, + Tk_Font tkfont, const Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); static void GetMenuIndicatorGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, - CONST Tk_FontMetrics *fmPtr, + const Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); static void GetMenuSeparatorGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, - CONST Tk_FontMetrics *fmPtr, + const Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); static void GetTearoffEntryGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, - CONST Tk_FontMetrics *fmPtr, int *widthPtr, + const Tk_FontMetrics *fmPtr, int *widthPtr, int *heightPtr); /* @@ -294,7 +294,7 @@ void TkpSetMainMenubar( Tcl_Interp *interp, Tk_Window tkwin, - char *menuName) + const char *menuName) { /* * Nothing to do. @@ -324,10 +324,12 @@ GetMenuIndicatorGeometry( TkMenu *menuPtr, /* The menu we are drawing. */ TkMenuEntry *mePtr, /* The entry we are interested in. */ Tk_Font tkfont, /* The precalculated font */ - CONST Tk_FontMetrics *fmPtr,/* The precalculated metrics */ + const Tk_FontMetrics *fmPtr,/* The precalculated metrics */ int *widthPtr, /* The resulting width */ int *heightPtr) /* The resulting height */ { + int borderWidth; + if ((mePtr->type == CHECK_BUTTON_ENTRY) || (mePtr->type == RADIO_BUTTON_ENTRY)) { if (!mePtr->hideMargin && mePtr->indicatorOn) { @@ -352,23 +354,18 @@ GetMenuIndicatorGeometry( } } } else { - int borderWidth; - - Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, - menuPtr->borderWidthPtr, &borderWidth); + Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, + &borderWidth); *heightPtr = 0; *widthPtr = borderWidth; } } else { - int borderWidth; - Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr, &borderWidth); - *heightPtr = 0; - *widthPtr = borderWidth; + *heightPtr = 0; + *widthPtr = borderWidth; } } - /* *---------------------------------------------------------------------- @@ -391,18 +388,17 @@ GetMenuAccelGeometry( TkMenu *menuPtr, /* The menu was are drawing */ TkMenuEntry *mePtr, /* The entry we are getting the geometry for */ Tk_Font tkfont, /* The precalculated font */ - CONST Tk_FontMetrics *fmPtr,/* The precalculated font metrics */ + const Tk_FontMetrics *fmPtr,/* The precalculated font metrics */ int *widthPtr, /* The width of the acclerator area */ int *heightPtr) /* The height of the accelerator area */ { *heightPtr = fmPtr->linespace; if (mePtr->type == CASCADE_ENTRY) { *widthPtr = 2 * CASCADE_ARROW_WIDTH; - } else if ((menuPtr->menuType != MENUBAR) - && (mePtr->accelPtr != NULL)) { - char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); + } else if ((menuPtr->menuType != MENUBAR) && (mePtr->accelPtr != NULL)) { + const char *accel = Tcl_GetString(mePtr->accelPtr); - *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength); + *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength); } else { *widthPtr = 0; } @@ -483,7 +479,7 @@ DrawMenuEntryAccelerator( Drawable d, /* The drawable we are drawing into */ GC gc, /* The precalculated gc to draw with */ Tk_Font tkfont, /* The precalculated font */ - CONST Tk_FontMetrics *fmPtr,/* The precalculated metrics */ + const Tk_FontMetrics *fmPtr,/* The precalculated metrics */ Tk_3DBorder activeBorder, /* The border for an active item */ int x, /* Left coordinate of entry rect */ int y, /* Top coordinate of entry rect */ @@ -508,7 +504,7 @@ DrawMenuEntryAccelerator( &activeBorderWidth); if ((mePtr->type == CASCADE_ENTRY) && drawArrow) { points[0].x = x + width - borderWidth - activeBorderWidth - - CASCADE_ARROW_WIDTH; + - CASCADE_ARROW_WIDTH; points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2; points[1].x = points[0].x; points[1].y = points[0].y + CASCADE_ARROW_HEIGHT; @@ -519,9 +515,9 @@ DrawMenuEntryAccelerator( (menuPtr->postedCascade == mePtr) ? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED); } else if (mePtr->accelPtr != NULL) { - char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL); + const char *accel = Tcl_GetString(mePtr->accelPtr); int left = x + mePtr->labelWidth + activeBorderWidth - + mePtr->indicatorSpace; + + mePtr->indicatorSpace; if (menuPtr->menuType == MENUBAR) { left += 5; @@ -557,7 +553,7 @@ DrawMenuEntryIndicator( XColor *indicatorColor, /* The color to draw indicators with */ XColor *disableColor, /* The color use use when disabled */ Tk_Font tkfont, /* The font to draw with */ - CONST Tk_FontMetrics *fmPtr,/* The font metrics of the font */ + const Tk_FontMetrics *fmPtr,/* The font metrics of the font */ int x, /* The left of the entry rect */ int y, /* The top of the entry rect */ int width, /* Width of menu entry */ @@ -629,7 +625,7 @@ DrawMenuSeparator( Drawable d, /* The drawable we are using */ GC gc, /* The gc to draw into */ Tk_Font tkfont, /* The font to draw with */ - CONST Tk_FontMetrics *fmPtr,/* The font metrics from the font */ + const Tk_FontMetrics *fmPtr,/* The font metrics from the font */ int x, int y, int width, int height) { @@ -672,7 +668,7 @@ DrawMenuEntryLabel( Drawable d, /* What we are drawing into. */ GC gc, /* The gc we are drawing into.*/ Tk_Font tkfont, /* The precalculated font. */ - CONST Tk_FontMetrics *fmPtr,/* The precalculated font metrics. */ + const Tk_FontMetrics *fmPtr,/* The precalculated font metrics. */ int x, /* Left edge. */ int y, /* Top edge. */ int width, /* width of entry. */ @@ -701,12 +697,14 @@ DrawMenuEntryLabel( haveImage = 1; } else if (mePtr->bitmapPtr != NULL) { Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, &imageWidth, &imageHeight); haveImage = 1; } if (!haveImage || (mePtr->compound != COMPOUND_NONE)) { if (mePtr->labelLength > 0) { - char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + const char *label = Tcl_GetString(mePtr->labelPtr); + textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength); textHeight = fmPtr->linespace; haveText = 1; @@ -719,6 +717,7 @@ DrawMenuEntryLabel( if (haveImage && haveText) { int fullWidth = (imageWidth > textWidth ? imageWidth : textWidth); + switch ((enum compound) mePtr->compound) { case COMPOUND_TOP: textXOffset = (fullWidth - textWidth)/2; @@ -801,7 +800,7 @@ DrawMenuEntryLabel( int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2; if (mePtr->labelLength > 0) { - char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + const char *label = Tcl_GetString(mePtr->labelPtr); Tk_DrawChars(menuPtr->display, d, gc, tkfont, label, mePtr->labelLength, leftEdge + textXOffset, @@ -849,7 +848,7 @@ DrawMenuUnderline( Drawable d, /* What we are drawing into */ GC gc, /* The gc to draw into */ Tk_Font tkfont, /* The precalculated font */ - CONST Tk_FontMetrics *fmPtr,/* The precalculated font metrics */ + const Tk_FontMetrics *fmPtr,/* The precalculated font metrics */ int x, int y, int width, int height) { @@ -863,9 +862,9 @@ DrawMenuUnderline( Tcl_GetUnicodeFromObj(mePtr->labelPtr, &len); if (mePtr->underline < len) { int activeBorderWidth, leftEdge; - CONST char *label, *start, *end; + const char *label, *start, *end; - label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + label = Tcl_GetString(mePtr->labelPtr); start = Tcl_UtfAtIndex(label, mePtr->underline); end = Tcl_UtfNext(start); @@ -929,7 +928,7 @@ GetMenuSeparatorGeometry( TkMenu *menuPtr, /* The menu we are measuring */ TkMenuEntry *mePtr, /* The entry we are measuring */ Tk_Font tkfont, /* The precalculated font */ - CONST Tk_FontMetrics *fmPtr,/* The precalcualted font metrics */ + const Tk_FontMetrics *fmPtr,/* The precalcualted font metrics */ int *widthPtr, /* The resulting width */ int *heightPtr) /* The resulting height */ { @@ -958,7 +957,7 @@ GetTearoffEntryGeometry( TkMenu *menuPtr, /* The menu we are drawing */ TkMenuEntry *mePtr, /* The entry we are measuring */ Tk_Font tkfont, /* The precalculated font */ - CONST Tk_FontMetrics *fmPtr,/* The precalculated font metrics */ + const Tk_FontMetrics *fmPtr,/* The precalculated font metrics */ int *widthPtr, /* The resulting width */ int *heightPtr) /* The resulting height */ { @@ -1074,7 +1073,6 @@ TkpComputeMenubarGeometry( if (mePtr->entryFlags & ENTRY_HELP_MENU) { helpMenuIndex = i; } else if (x + mePtr->width + borderWidth > maxWindowWidth) { - if (i == lastRowBreak) { mePtr->y = y; mePtr->x = x; @@ -1085,7 +1083,7 @@ TkpComputeMenubarGeometry( x = borderWidth; for (j = lastRowBreak; j < i; j++) { menuPtr->entries[j]->y = y + currentRowHeight - - menuPtr->entries[j]->height; + - menuPtr->entries[j]->height; menuPtr->entries[j]->x = x; x += menuPtr->entries[j]->width; } @@ -1179,7 +1177,7 @@ DrawTearoffEntry( Drawable d, /* The drawable we are drawing into */ GC gc, /* The gc we are drawing with */ Tk_Font tkfont, /* The font we are drawing with */ - CONST Tk_FontMetrics *fmPtr,/* The metrics we are drawing with */ + const Tk_FontMetrics *fmPtr,/* The metrics we are drawing with */ int x, int y, int width, int height) { @@ -1259,7 +1257,7 @@ TkpInitializeMenuBindings( static void SetHelpMenu( - TkMenu *menuPtr) /* The menu we are checking */ + TkMenu *menuPtr) /* The menu we are checking */ { TkMenuEntry *cascadeEntryPtr; int useMotifHelp = 0; @@ -1317,25 +1315,25 @@ SetHelpMenu( void TkpDrawMenuEntry( - TkMenuEntry *mePtr, /* The entry to draw */ - Drawable d, /* What to draw into */ - Tk_Font tkfont, /* Precalculated font for menu */ - CONST Tk_FontMetrics *menuMetricsPtr, - /* Precalculated metrics for menu */ - int x, /* X-coordinate of topleft of entry */ - int y, /* Y-coordinate of topleft of entry */ - int width, /* Width of the entry rectangle */ - int height, /* Height of the current rectangle */ - int strictMotif, /* Boolean flag */ - int drawArrow) /* Whether or not to draw the cascade - * arrow for cascade items. Only applies - * to Windows. */ + TkMenuEntry *mePtr, /* The entry to draw */ + Drawable d, /* What to draw into */ + Tk_Font tkfont, /* Precalculated font for menu */ + const Tk_FontMetrics *menuMetricsPtr, + /* Precalculated metrics for menu */ + int x, /* X-coordinate of topleft of entry */ + int y, /* Y-coordinate of topleft of entry */ + int width, /* Width of the entry rectangle */ + int height, /* Height of the current rectangle */ + int strictMotif, /* Boolean flag */ + int drawArrow) /* Whether or not to draw the cascade arrow + * for cascade items. Only applies to + * Windows. */ { GC gc, indicatorGC; XColor *indicatorColor, *disableColor = NULL; TkMenu *menuPtr = mePtr->menuPtr; Tk_3DBorder bgBorder, activeBorder; - CONST Tk_FontMetrics *fmPtr; + const Tk_FontMetrics *fmPtr; Tk_FontMetrics entryMetrics; int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0; int adjustedY = y + padY; @@ -1358,7 +1356,7 @@ TkpDrawMenuEntry( cascadeEntryPtr != NULL; cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) { if (cascadeEntryPtr->namePtr != NULL) { - char *name = Tcl_GetString(cascadeEntryPtr->namePtr); + const char *name = Tcl_GetString(cascadeEntryPtr->namePtr); if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) { if (cascadeEntryPtr->state == ENTRY_DISABLED) { @@ -1470,7 +1468,7 @@ static void GetMenuLabelGeometry( TkMenuEntry *mePtr, /* The entry we are computing */ Tk_Font tkfont, /* The precalculated font */ - CONST Tk_FontMetrics *fmPtr,/* The precalculated metrics */ + const Tk_FontMetrics *fmPtr,/* The precalculated metrics */ int *widthPtr, /* The resulting width of the label portion */ int *heightPtr) /* The resulting height of the label * portion */ @@ -1483,6 +1481,7 @@ GetMenuLabelGeometry( haveImage = 1; } else if (mePtr->bitmapPtr != NULL) { Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr); haveImage = 1; } else { @@ -1501,9 +1500,9 @@ GetMenuLabelGeometry( if (mePtr->labelPtr != NULL) { int textWidth; - char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); - textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength); + const char *label = Tcl_GetString(mePtr->labelPtr); + textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength); if ((mePtr->compound != COMPOUND_NONE) && haveImage) { switch ((enum compound) mePtr->compound) { case COMPOUND_TOP: @@ -1686,8 +1685,8 @@ TkpComputeStandardMenuGeometry( accelWidth = width; } - GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, - fmPtr, &width, &height); + GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr, + &width, &height); if (height > mePtr->height) { mePtr->height = height; } @@ -1700,7 +1699,7 @@ TkpComputeStandardMenuGeometry( mePtr->height += 2 * activeBorderWidth + MENU_DIVIDER_HEIGHT; } - mePtr->y = y; + mePtr->y = y; y += mePtr->height; if (y > windowHeight) { windowHeight = y; @@ -1759,7 +1758,7 @@ TkpComputeStandardMenuGeometry( void TkpMenuNotifyToplevelCreate( Tcl_Interp *interp, /* The interp the menu lives in. */ - char *menuName) /* The name of the menu to reconfigure. */ + const char *menuName) /* The name of the menu to reconfigure. */ { /* * Nothing to do. diff --git a/unix/tkUnixMenubu.c b/unix/tkUnixMenubu.c index 48d3fb9..ad71b7b 100644 --- a/unix/tkUnixMenubu.c +++ b/unix/tkUnixMenubu.c @@ -13,17 +13,6 @@ #include "tkInt.h" #include "tkMenubutton.h" -/* - * The structure below defines menubutton class behavior by means of functions - * that can be invoked from generic window code. - */ - -Tk_ClassProcs tkpMenubuttonClass = { - sizeof(Tk_ClassProcs), /* size */ - TkMenuButtonWorldChanged, /* worldChangedProc */ - NULL, - NULL -}; /* *---------------------------------------------------------------------- @@ -45,7 +34,7 @@ TkMenuButton * TkpCreateMenuButton( Tk_Window tkwin) { - return (TkMenuButton *)ckalloc(sizeof(TkMenuButton)); + return ckalloc(sizeof(TkMenuButton)); } /* diff --git a/unix/tkUnixPort.h b/unix/tkUnixPort.h index d122c8c..dbd5e09 100644 --- a/unix/tkUnixPort.h +++ b/unix/tkUnixPort.h @@ -17,29 +17,10 @@ #define __UNIX__ 1 -/* - * Macro to use instead of "void" for arguments that must have - * type "void *" in ANSI C; maps them to type "char *" in - * non-ANSI systems. This macro may be used in some of the include - * files below, which is why it is defined here. - */ - -#ifndef VOID -# ifdef __STDC__ -# define VOID void -# else -# define VOID char -# endif -#endif - #include <stdio.h> #include <ctype.h> #include <fcntl.h> -#ifndef NO_LIMITS_H -# include <limits.h> -#else -# include "../compat/limits.h" -#endif +#include <limits.h> #include <math.h> #include <pwd.h> #ifdef NO_STDLIB_H @@ -208,15 +189,4 @@ sprintf((buf), "%#08lx", (unsigned long) (w)) #endif -/* - * The following declaration is used to get access to a private Tcl interface - * that is needed for portability reasons. - * - * Disabled for now to determined whether we really still need this. - -#ifndef _TCLINT -#include <tclInt.h> -#endif - */ - #endif /* _UNIXPORT */ diff --git a/unix/tkUnixRFont.c b/unix/tkUnixRFont.c index fd0b556..ab2ed4a 100644 --- a/unix/tkUnixRFont.c +++ b/unix/tkUnixRFont.c @@ -16,8 +16,10 @@ typedef struct { XftFont *ftFont; + XftFont *ft0Font; FcPattern *source; FcCharSet *charset; + double angle; } UnixFtFace; typedef struct { @@ -69,13 +71,15 @@ TkpFontPkgInit( static XftFont * GetFont( UnixFtFont *fontPtr, - FcChar32 ucs4) + FcChar32 ucs4, + double angle) { int i; if (ucs4) { for (i = 0; i < fontPtr->nfaces; i++) { FcCharSet *charset = fontPtr->faces[i].charset; + if (charset && FcCharSetHasChar(charset, ucs4)) { break; } @@ -86,34 +90,61 @@ GetFont( } else { i = 0; } - if (!fontPtr->faces[i].ftFont) { - FcPattern *pat = FcFontRenderPrepare(0, - fontPtr->pattern, fontPtr->faces[i].source); - XftFont *ftFont = XftFontOpenPattern(fontPtr->display, pat); + if ((angle == 0.0 && !fontPtr->faces[i].ft0Font) || (angle != 0.0 && + (!fontPtr->faces[i].ftFont || fontPtr->faces[i].angle != angle))){ + FcPattern *pat = FcFontRenderPrepare(0, fontPtr->pattern, + fontPtr->faces[i].source); + double s = sin(angle*PI/180.0), c = cos(angle*PI/180.0); + FcMatrix mat; + XftFont *ftFont; + /* + * Initialize the matrix manually so this can compile with HP-UX cc + * (which does not allow non-constant structure initializers). [Bug + * 2978410] + */ + + mat.xx = mat.yy = c; + mat.xy = -(mat.yx = s); + + if (angle != 0.0) { + FcPatternAddMatrix(pat, FC_MATRIX, &mat); + } + ftFont = XftFontOpenPattern(fontPtr->display, pat); if (!ftFont) { /* - * The previous call to XftFontOpenPattern() should not fail, - * but sometimes does anyway. Usual cause appears to be - * a misconfigured fontconfig installation; see [Bug 1090382]. - * Try a fallback: + * The previous call to XftFontOpenPattern() should not fail, but + * sometimes does anyway. Usual cause appears to be a + * misconfigured fontconfig installation; see [Bug 1090382]. Try a + * fallback: */ + ftFont = XftFontOpen(fontPtr->display, fontPtr->screen, - FC_FAMILY, FcTypeString, "sans", - FC_SIZE, FcTypeDouble, 12.0, - NULL); + FC_FAMILY, FcTypeString, "sans", + FC_SIZE, FcTypeDouble, 12.0, + FC_MATRIX, FcTypeMatrix, &mat, + NULL); } if (!ftFont) { /* - * The previous call should definitely not fail. - * Impossible to proceed at this point. + * The previous call should definitely not fail. Impossible to + * proceed at this point. */ - Tcl_Panic("Cannot find a usable font."); + + Tcl_Panic("Cannot find a usable font"); } - fontPtr->faces[i].ftFont = ftFont; + if (angle == 0.0) { + fontPtr->faces[i].ft0Font = ftFont; + } else { + if (fontPtr->faces[i].ftFont) { + XftFontClose(fontPtr->display, fontPtr->faces[i].ftFont); + } + fontPtr->faces[i].ftFont = ftFont; + fontPtr->faces[i].angle = angle; + } } - return fontPtr->faces[i].ftFont; + return (angle==0.0? fontPtr->faces[i].ft0Font : fontPtr->faces[i].ftFont); } /* @@ -128,14 +159,15 @@ GetTkFontAttributes( XftFont *ftFont, TkFontAttributes *faPtr) { - char *family = "Unknown", **familyPtr = &family; + const char *family = "Unknown"; + const char *const *familyPtr = &family; int weight, slant, size, pxsize; double ptsize; - (void)XftPatternGetString(ftFont->pattern, XFT_FAMILY, 0, familyPtr); + (void) XftPatternGetString(ftFont->pattern, XFT_FAMILY, 0, familyPtr); if (XftPatternGetDouble(ftFont->pattern, XFT_SIZE, 0, &ptsize) == XftResultMatch) { - size = (int)ptsize; + size = (int) ptsize; } else if (XftPatternGetInteger(ftFont->pattern, XFT_PIXEL_SIZE, 0, &pxsize) == XftResultMatch) { size = -pxsize; @@ -171,7 +203,8 @@ GetTkFontAttributes( * Fill in TkFontMetrics from an XftFont. */ -static void GetTkFontMetrics( +static void +GetTkFontMetrics( XftFont *ftFont, TkFontMetrics *fmPtr) { @@ -212,10 +245,10 @@ InitFont( FcCharSet *charset; FcResult result; XftFont *ftFont; - int i; + int i, iWidth; if (!fontPtr) { - fontPtr = (UnixFtFont *) ckalloc(sizeof(UnixFtFont)); + fontPtr = ckalloc(sizeof(UnixFtFont)); } FcConfigSubstitute(0, pattern, FcMatchPattern); @@ -227,13 +260,13 @@ InitFont( set = FcFontSort(0, pattern, FcTrue, NULL, &result); if (!set) { - ckfree((char *)fontPtr); + ckfree(fontPtr); return NULL; } fontPtr->fontset = set; fontPtr->pattern = pattern; - fontPtr->faces = (UnixFtFace *) ckalloc(set->nfont * sizeof(UnixFtFace)); + fontPtr->faces = ckalloc(set->nfont * sizeof(UnixFtFace)); fontPtr->nfaces = set->nfont; /* @@ -242,6 +275,7 @@ InitFont( for (i = 0; i < set->nfont; i++) { fontPtr->faces[i].ftFont = 0; + fontPtr->faces[i].ft0Font = 0; fontPtr->faces[i].source = set->fonts[i]; if (FcPatternGetCharSet(set->fonts[i], FC_CHARSET, 0, &charset) == FcResultMatch) { @@ -249,6 +283,7 @@ InitFont( } else { fontPtr->faces[i].charset = 0; } + fontPtr->faces[i].angle = 0.0; } fontPtr->display = Tk_Display(tkwin); @@ -263,7 +298,8 @@ InitFont( /* * Fill in platform-specific fields of TkFont. */ - ftFont = GetFont(fontPtr, 0); + + ftFont = GetFont(fontPtr, 0, 0.0); fontPtr->font.fid = XLoadFont(Tk_Display(tkwin), "fixed"); GetTkFontAttributes(ftFont, &fontPtr->font.fa); GetTkFontMetrics(ftFont, &fontPtr->font.fm); @@ -289,7 +325,6 @@ InitFont( { TkFont *fPtr = &fontPtr->font; - int iWidth; fPtr->underlinePos = fPtr->fm.descent / 2; Tk_MeasureChars((Tk_Font) fPtr, "I", 1, -1, 0, &iWidth); @@ -315,19 +350,22 @@ FinishedWithFont( { Display *display = fontPtr->display; int i; - Tk_ErrorHandler handler = Tk_CreateErrorHandler(display, -1, -1, -1, NULL, - (ClientData) NULL); + Tk_ErrorHandler handler = + Tk_CreateErrorHandler(display, -1, -1, -1, NULL, NULL); for (i = 0; i < fontPtr->nfaces; i++) { if (fontPtr->faces[i].ftFont) { XftFontClose(fontPtr->display, fontPtr->faces[i].ftFont); } + if (fontPtr->faces[i].ft0Font) { + XftFontClose(fontPtr->display, fontPtr->faces[i].ft0Font); + } if (fontPtr->faces[i].charset) { FcCharSetDestroy(fontPtr->faces[i].charset); } } if (fontPtr->faces) { - ckfree((char *)fontPtr->faces); + ckfree(fontPtr->faces); } if (fontPtr->pattern) { FcPatternDestroy(fontPtr->pattern); @@ -347,7 +385,7 @@ FinishedWithFont( TkFont * TkpGetNativeFont( Tk_Window tkwin, /* For display where font will be used. */ - CONST char *name) /* Platform-specific font name. */ + const char *name) /* Platform-specific font name. */ { UnixFtFont *fontPtr; FcPattern *pattern; @@ -382,7 +420,7 @@ TkpGetFontFromAttributes( * will be released. If NULL, a new TkFont * structure is allocated. */ Tk_Window tkwin, /* For display where font will be used. */ - CONST TkFontAttributes *faPtr) + const TkFontAttributes *faPtr) /* Set of attributes to match. */ { XftPattern *pattern; @@ -492,14 +530,15 @@ TkpGetFontFamilies( resultPtr = Tcl_NewListObj(0, NULL); list = XftListFonts(Tk_Display(tkwin), Tk_ScreenNumber(tkwin), - (char*)0, /* pattern elements */ - XFT_FAMILY, (char*)0); /* fields */ + (char *) 0, /* pattern elements */ + XFT_FAMILY, (char*) 0); /* fields */ for (i = 0; i < list->nfont; i++) { char *family, **familyPtr = &family; + if (XftPatternGetString(list->fonts[i], XFT_FAMILY, 0, familyPtr) - == XftResultMatch) - { + == XftResultMatch) { Tcl_Obj *strPtr = Tcl_NewStringObj(family, -1); + Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } } @@ -529,9 +568,12 @@ TkpGetSubFonts( Tcl_Obj *objv[3], *listPtr, *resultPtr; UnixFtFont *fontPtr = (UnixFtFont *) tkfont; FcPattern *pattern; - char *family = "Unknown", **familyPtr = &family; - char *foundry = "Unknown", **foundryPtr = &foundry; - char *encoding = "Unknown", **encodingPtr = &encoding; + const char *family = "Unknown"; + const char *const *familyPtr = &family; + const char *foundry = "Unknown"; + const char *const *foundryPtr = &foundry; + const char *encoding = "Unknown"; + const char *const *encodingPtr = &encoding; int i; resultPtr = Tcl_NewListObj(0, NULL); @@ -574,7 +616,7 @@ TkpGetFontAttrsForChar( /* Structure describing the logical font */ FcChar32 ucs4 = (FcChar32) c; /* UCS-4 character to map */ - XftFont *ftFont = GetFont(fontPtr, ucs4); + XftFont *ftFont = GetFont(fontPtr, ucs4, 0.0); /* Actual font used to render the character */ GetTkFontAttributes(ftFont, faPtr); @@ -585,7 +627,7 @@ TkpGetFontAttrsForChar( int Tk_MeasureChars( Tk_Font tkfont, /* Font in which characters will be drawn. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ int numBytes, /* Maximum number of bytes to consider from * source string. */ @@ -623,7 +665,7 @@ Tk_MeasureChars( Tcl_UniChar unichar; clen = Tcl_UtfToUniChar(source, &unichar); - c = (FcChar32)unichar; + c = (FcChar32) unichar; if (clen <= 0) { /* @@ -649,7 +691,7 @@ Tk_MeasureChars( #if DEBUG_FONTSEL string[len++] = (char) c; #endif /* DEBUG_FONTSEL */ - ftFont = GetFont(fontPtr, c); + ftFont = GetFont(fontPtr, c, 0.0); XftTextExtents32(fontPtr->display, ftFont, &c, 1, &extents); @@ -681,7 +723,7 @@ Tk_MeasureChars( int TkpMeasureCharsInContext( Tk_Font tkfont, - CONST char *source, + const char *source, int numBytes, int rangeStart, int rangeLength, @@ -704,7 +746,7 @@ Tk_DrawChars( GC gc, /* Graphics context for drawing characters. */ Tk_Font tkfont, /* Font in which characters will be drawn; * must be the same as font used in GC. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. All Tk meta-characters * (tabs, control characters, and newlines) * should be stripped out of the string that @@ -733,8 +775,8 @@ Tk_DrawChars( DefaultVisual(display, fontPtr->screen), DefaultColormap(display, fontPtr->screen)); } else { - Tk_ErrorHandler handler = Tk_CreateErrorHandler(display, -1, -1, -1, - NULL, (ClientData) NULL); + Tk_ErrorHandler handler = + Tk_CreateErrorHandler(display, -1, -1, -1, NULL, NULL); XftDrawChange(fontPtr->ftDraw, drawable); Tk_DeleteErrorHandler(handler); @@ -769,7 +811,7 @@ Tk_DrawChars( source += clen; numBytes -= clen; - ftFont = GetFont(fontPtr, c); + ftFont = GetFont(fontPtr, c, 0.0); if (ftFont) { specs[nspec].font = ftFont; specs[nspec].glyph = XftCharIndex(fontPtr->display, ftFont, c); @@ -790,11 +832,11 @@ Tk_DrawChars( if (nspec) { XftDrawGlyphFontSpec(fontPtr->ftDraw, &fontPtr->color, specs, nspec); } + + doUnderlineStrikeout: if (tsdPtr->clipRegion != None) { XftDrawSetClip(fontPtr->ftDraw, None); } - - doUnderlineStrikeout: if (fontPtr->font.fa.underline != 0) { XFillRectangle(display, drawable, gc, xStart, y + fontPtr->font.underlinePos, (unsigned) (x - xStart), @@ -807,8 +849,280 @@ Tk_DrawChars( (unsigned) fontPtr->font.underlineHeight); } } + +/* + *--------------------------------------------------------------------------- + * + * TkDrawAngledChars -- + * + * Draw some characters at an angle. This would be simple code, except + * Xft has bugs with cumulative errors in character positioning which are + * caused by trying to perform all calculations internally with integers. + * So we have to do the work ourselves with floating-point math. + * + * Results: + * None. + * + * Side effects: + * Target drawable is updated. + * + *--------------------------------------------------------------------------- + */ void +TkDrawAngledChars( + Display *display, /* Display on which to draw. */ + Drawable drawable, /* Window or pixmap in which to draw. */ + GC gc, /* Graphics context for drawing characters. */ + Tk_Font tkfont, /* Font in which characters will be drawn; + * must be the same as font used in GC. */ + const char *source, /* UTF-8 string to be displayed. Need not be + * '\0' terminated. All Tk meta-characters + * (tabs, control characters, and newlines) + * should be stripped out of the string that + * is passed to this function. If they are not + * stripped out, they will be displayed as + * regular printing characters. */ + int numBytes, /* Number of bytes in string. */ + double x, double y, /* Coordinates at which to place origin of + * string when drawing. */ + double angle) /* What angle to put text at, in degrees. */ +{ + const int maxCoord = 0x7FFF;/* Xft coordinates are 16 bit values */ + const int minCoord = -1000; /* Should be good enough... */ + UnixFtFont *fontPtr = (UnixFtFont *) tkfont; + XGCValues values; + XColor xcolor; + int xStart = x, yStart = y; + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); +#ifdef XFT_HAS_FIXED_ROTATED_PLACEMENT + int clen, nglyph; + FT_UInt glyphs[NUM_SPEC]; + XGlyphInfo metrics; + XftFont *currentFtFont; + int originX, originY; + + if (fontPtr->ftDraw == 0) { +#if DEBUG_FONTSEL + printf("Switch to drawable 0x%x\n", drawable); +#endif /* DEBUG_FONTSEL */ + fontPtr->ftDraw = XftDrawCreate(display, drawable, + DefaultVisual(display, fontPtr->screen), + DefaultColormap(display, fontPtr->screen)); + } else { + Tk_ErrorHandler handler = + Tk_CreateErrorHandler(display, -1, -1, -1, NULL, NULL); + + XftDrawChange(fontPtr->ftDraw, drawable); + Tk_DeleteErrorHandler(handler); + } + + XGetGCValues(display, gc, GCForeground, &values); + if (values.foreground != fontPtr->color.pixel) { + xcolor.pixel = values.foreground; + XQueryColor(display, DefaultColormap(display, fontPtr->screen), + &xcolor); + fontPtr->color.color.red = xcolor.red; + fontPtr->color.color.green = xcolor.green; + fontPtr->color.color.blue = xcolor.blue; + fontPtr->color.color.alpha = 0xffff; + fontPtr->color.pixel = values.foreground; + } + if (tsdPtr->clipRegion != None) { + XftDrawSetClip(fontPtr->ftDraw, tsdPtr->clipRegion); + } + + nglyph = 0; + currentFtFont = NULL; + originX = originY = 0; /* lint */ + + while (numBytes > 0 && x <= maxCoord && x >= minCoord && y <= maxCoord + && y >= minCoord) { + XftFont *ftFont; + FcChar32 c; + + clen = FcUtf8ToUcs4((FcChar8 *) source, &c, numBytes); + if (clen <= 0) { + /* + * This should not happen, but it can. + */ + + goto doUnderlineStrikeout; + } + source += clen; + numBytes -= clen; + + ftFont = GetFont(fontPtr, c, angle); + if (!ftFont) { + continue; + } + + if (ftFont != currentFtFont || nglyph == NUM_SPEC) { + if (nglyph) { + /* + * We pass multiple glyphs at once to enable the code to + * perform better rendering of sub-pixel inter-glyph spacing. + * If only the current Xft implementation could make use of + * this information... but we'll be ready when it does! + */ + + XftDrawGlyphs(fontPtr->ftDraw, &fontPtr->color, currentFtFont, + originX, originY, glyphs, nglyph); + } + originX = ROUND16(x); + originY = ROUND16(y); + if (nglyph) { + XftGlyphExtents(fontPtr->display, currentFtFont, glyphs, + nglyph, &metrics); + nglyph = 0; + x += metrics.xOff; + y += metrics.yOff; + } + currentFtFont = ftFont; + } + glyphs[nglyph++] = XftCharIndex(fontPtr->display, ftFont, c); + } + if (nglyph) { + XftDrawGlyphs(fontPtr->ftDraw, &fontPtr->color, currentFtFont, + originX, originY, glyphs, nglyph); + } +#else /* !XFT_HAS_FIXED_ROTATED_PLACEMENT */ + int clen, nspec; + XftGlyphFontSpec specs[NUM_SPEC]; + XGlyphInfo metrics; + double sinA = sin(angle * PI/180.0), cosA = cos(angle * PI/180.0); + + if (fontPtr->ftDraw == 0) { +#if DEBUG_FONTSEL + printf("Switch to drawable 0x%x\n", drawable); +#endif /* DEBUG_FONTSEL */ + fontPtr->ftDraw = XftDrawCreate(display, drawable, + DefaultVisual(display, fontPtr->screen), + DefaultColormap(display, fontPtr->screen)); + } else { + Tk_ErrorHandler handler = + Tk_CreateErrorHandler(display, -1, -1, -1, NULL, NULL); + + XftDrawChange(fontPtr->ftDraw, drawable); + Tk_DeleteErrorHandler(handler); + } + XGetGCValues(display, gc, GCForeground, &values); + if (values.foreground != fontPtr->color.pixel) { + xcolor.pixel = values.foreground; + XQueryColor(display, DefaultColormap(display, fontPtr->screen), + &xcolor); + fontPtr->color.color.red = xcolor.red; + fontPtr->color.color.green = xcolor.green; + fontPtr->color.color.blue = xcolor.blue; + fontPtr->color.color.alpha = 0xffff; + fontPtr->color.pixel = values.foreground; + } + if (tsdPtr->clipRegion != None) { + XftDrawSetClip(fontPtr->ftDraw, tsdPtr->clipRegion); + } + nspec = 0; + while (numBytes > 0 && x <= maxCoord && x >= minCoord + && y <= maxCoord && y >= minCoord) { + XftFont *ftFont, *ft0Font; + FcChar32 c; + + clen = FcUtf8ToUcs4((FcChar8 *) source, &c, numBytes); + if (clen <= 0) { + /* + * This should not happen, but it can. + */ + + goto doUnderlineStrikeout; + } + source += clen; + numBytes -= clen; + + ftFont = GetFont(fontPtr, c, angle); + ft0Font = GetFont(fontPtr, c, 0.0); + if (ftFont && ft0Font) { + specs[nspec].font = ftFont; + specs[nspec].glyph = XftCharIndex(fontPtr->display, ftFont, c); + specs[nspec].x = ROUND16(x); + specs[nspec].y = ROUND16(y); + XftGlyphExtents(fontPtr->display, ft0Font, &specs[nspec].glyph, 1, + &metrics); + x += metrics.xOff*cosA + metrics.yOff*sinA; + y += metrics.yOff*cosA - metrics.xOff*sinA; + nspec++; + if (nspec == NUM_SPEC) { + XftDrawGlyphFontSpec(fontPtr->ftDraw, &fontPtr->color, + specs, nspec); + nspec = 0; + } + } + } + if (nspec) { + XftDrawGlyphFontSpec(fontPtr->ftDraw, &fontPtr->color, specs, nspec); + } +#endif /* XFT_HAS_FIXED_ROTATED_PLACEMENT */ + + doUnderlineStrikeout: + if (tsdPtr->clipRegion != None) { + XftDrawSetClip(fontPtr->ftDraw, None); + } + if (fontPtr->font.fa.underline || fontPtr->font.fa.overstrike) { + XPoint points[5]; + double width = (x - xStart) * cosA + (yStart - y) * sinA; + double barHeight = fontPtr->font.underlineHeight; + double dy = fontPtr->font.underlinePos; + + if (fontPtr->font.fa.underline != 0) { + if (fontPtr->font.underlineHeight == 1) { + dy++; + } + points[0].x = xStart + ROUND16(dy*sinA); + points[0].y = yStart + ROUND16(dy*cosA); + points[1].x = xStart + ROUND16(dy*sinA + width*cosA); + points[1].y = yStart + ROUND16(dy*cosA - width*sinA); + if (fontPtr->font.underlineHeight == 1) { + XDrawLines(display, drawable, gc, points, 2, CoordModeOrigin); + } else { + points[2].x = xStart + ROUND16(dy*sinA + width*cosA + + barHeight*sinA); + points[2].y = yStart + ROUND16(dy*cosA - width*sinA + + barHeight*cosA); + points[3].x = xStart + ROUND16(dy*sinA + barHeight*sinA); + points[3].y = yStart + ROUND16(dy*cosA + barHeight*cosA); + points[4].x = points[0].x; + points[4].y = points[0].y; + XFillPolygon(display, drawable, gc, points, 5, Complex, + CoordModeOrigin); + XDrawLines(display, drawable, gc, points, 5, CoordModeOrigin); + } + } + if (fontPtr->font.fa.overstrike != 0) { + dy = -fontPtr->font.fm.descent + - (fontPtr->font.fm.ascent) / 10; + points[0].x = xStart + ROUND16(dy*sinA); + points[0].y = yStart + ROUND16(dy*cosA); + points[1].x = xStart + ROUND16(dy*sinA + width*cosA); + points[1].y = yStart + ROUND16(dy*cosA - width*sinA); + if (fontPtr->font.underlineHeight == 1) { + XDrawLines(display, drawable, gc, points, 2, CoordModeOrigin); + } else { + points[2].x = xStart + ROUND16(dy*sinA + width*cosA + + barHeight*sinA); + points[2].y = yStart + ROUND16(dy*cosA - width*sinA + + barHeight*cosA); + points[3].x = xStart + ROUND16(dy*sinA + barHeight*sinA); + points[3].y = yStart + ROUND16(dy*cosA + barHeight*cosA); + points[4].x = points[0].x; + points[4].y = points[0].y; + XFillPolygon(display, drawable, gc, points, 5, Complex, + CoordModeOrigin); + XDrawLines(display, drawable, gc, points, 5, CoordModeOrigin); + } + } + } +} + +void TkUnixSetXftClipRegion( TkRegion clipRegion) /* The clipping region to install. */ { @@ -817,3 +1131,10 @@ TkUnixSetXftClipRegion( tsdPtr->clipRegion = (Region) clipRegion; } + +/* + * Local Variables: + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/unix/tkUnixScale.c b/unix/tkUnixScale.c index 71f9ea8..c348037 100644 --- a/unix/tkUnixScale.c +++ b/unix/tkUnixScale.c @@ -46,7 +46,7 @@ TkScale * TkpCreateScale( Tk_Window tkwin) { - return (TkScale *) ckalloc(sizeof(TkScale)); + return ckalloc(sizeof(TkScale)); } /* @@ -71,7 +71,7 @@ void TkpDestroyScale( TkScale *scalePtr) { - Tcl_EventuallyFree((ClientData) scalePtr, TCL_DYNAMIC); + Tcl_EventuallyFree(scalePtr, TCL_DYNAMIC); } /* @@ -537,6 +537,7 @@ TkpDisplayScale( int result; char string[TCL_DOUBLE_SPACE]; XRectangle drawnArea; + Tcl_DString buf; scalePtr->flags &= ~REDRAW_PENDING; if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) { @@ -547,24 +548,28 @@ TkpDisplayScale( * Invoke the scale's command if needed. */ - Tcl_Preserve((ClientData) scalePtr); + Tcl_Preserve(scalePtr); if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) { - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); sprintf(string, scalePtr->format, scalePtr->value); - result = Tcl_VarEval(interp, scalePtr->command, " ", string, - (char *) NULL); + Tcl_DStringInit(&buf); + Tcl_DStringAppend(&buf, scalePtr->command, -1); + Tcl_DStringAppend(&buf, " ", -1); + Tcl_DStringAppend(&buf, string, -1); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + Tcl_DStringFree(&buf); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (command executed by scale)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } scalePtr->flags &= ~INVOKE_COMMAND; if (scalePtr->flags & SCALE_DELETED) { - Tcl_Release((ClientData) scalePtr); + Tcl_Release(scalePtr); return; } - Tcl_Release((ClientData) scalePtr); + Tcl_Release(scalePtr); #ifndef TK_NO_DOUBLE_BUFFERING /* diff --git a/unix/tkUnixScrlbr.c b/unix/tkUnixScrlbr.c index 1e70925..0507211 100644 --- a/unix/tkUnixScrlbr.c +++ b/unix/tkUnixScrlbr.c @@ -36,8 +36,11 @@ typedef struct UnixScrollbar { * variable is declared at this scope. */ -Tk_ClassProcs tkpScrollbarProcs = { - sizeof(Tk_ClassProcs) /* size */ +const Tk_ClassProcs tkpScrollbarProcs = { + sizeof(Tk_ClassProcs), /* size */ + NULL, /* worldChangedProc */ + NULL, /* createProc */ + NULL /* modalProc */ }; /* @@ -60,13 +63,14 @@ TkScrollbar * TkpCreateScrollbar( Tk_Window tkwin) { - UnixScrollbar *scrollPtr = (UnixScrollbar *)ckalloc(sizeof(UnixScrollbar)); + UnixScrollbar *scrollPtr = ckalloc(sizeof(UnixScrollbar)); + scrollPtr->troughGC = None; scrollPtr->copyGC = None; Tk_CreateEventHandler(tkwin, ExposureMask|StructureNotifyMask|FocusChangeMask, - TkScrollbarEventProc, (ClientData) scrollPtr); + TkScrollbarEventProc, scrollPtr); return (TkScrollbar *) scrollPtr; } @@ -301,14 +305,13 @@ TkpComputeScrollbarGeometry( * grabbed with the mouse). */ - if (scrollPtr->sliderFirst > (fieldLength - MIN_SLIDER_LENGTH)) { + if (scrollPtr->sliderFirst > fieldLength - MIN_SLIDER_LENGTH) { scrollPtr->sliderFirst = fieldLength - MIN_SLIDER_LENGTH; } if (scrollPtr->sliderFirst < 0) { scrollPtr->sliderFirst = 0; } - if (scrollPtr->sliderLast < (scrollPtr->sliderFirst - + MIN_SLIDER_LENGTH)) { + if (scrollPtr->sliderLast < scrollPtr->sliderFirst + MIN_SLIDER_LENGTH) { scrollPtr->sliderLast = scrollPtr->sliderFirst + MIN_SLIDER_LENGTH; } if (scrollPtr->sliderLast > fieldLength) { @@ -404,8 +407,8 @@ TkpConfigureScrollbar( unixScrollPtr->troughGC = new; if (unixScrollPtr->copyGC == None) { gcValues.graphics_exposures = False; - unixScrollPtr->copyGC = Tk_GetGC(scrollPtr->tkwin, GCGraphicsExposures, - &gcValues); + unixScrollPtr->copyGC = Tk_GetGC(scrollPtr->tkwin, + GCGraphicsExposures, &gcValues); } } @@ -434,6 +437,7 @@ TkpScrollbarPosition( int x, int y) /* Coordinates within scrollPtr's window. */ { int length, width, tmp; + register const int inset = scrollPtr->inset; if (scrollPtr->vertical) { length = Tk_Height(scrollPtr->tkwin); @@ -446,8 +450,7 @@ TkpScrollbarPosition( width = Tk_Height(scrollPtr->tkwin); } - if ((x < scrollPtr->inset) || (x >= (width - scrollPtr->inset)) - || (y < scrollPtr->inset) || (y >= (length - scrollPtr->inset))) { + if (x<inset || x>=width-inset || y<inset || y>=length-inset) { return OUTSIDE; } @@ -456,7 +459,7 @@ TkpScrollbarPosition( * TkpDisplayScrollbar. Be sure to keep the two consistent. */ - if (y < (scrollPtr->inset + scrollPtr->arrowLength)) { + if (y < inset + scrollPtr->arrowLength) { return TOP_ARROW; } if (y < scrollPtr->sliderFirst) { @@ -465,7 +468,7 @@ TkpScrollbarPosition( if (y < scrollPtr->sliderLast) { return SLIDER; } - if (y >= (length - (scrollPtr->arrowLength + scrollPtr->inset))) { + if (y >= length - (scrollPtr->arrowLength + inset)) { return BOTTOM_ARROW; } return BOTTOM_GAP; diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c index 060fdd1..4bb462e 100644 --- a/unix/tkUnixSelect.c +++ b/unix/tkUnixSelect.c @@ -183,7 +183,7 @@ TkSelGetSelection( */ retr.timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc, - (ClientData) &retr); + &retr); while (retr.result == -1) { Tcl_DoOneEvent(0); } @@ -243,7 +243,7 @@ TkSelPropProc( long buffer[TK_SEL_WORDS_AT_ONCE]; TkDisplay *dispPtr = TkGetDisplay(eventPtr->xany.display); Tk_ErrorHandler errorHandler; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -326,7 +326,7 @@ TkSelPropProc( length = strlen(incrPtr->converts[i].buffer); strcpy((char *)buffer, incrPtr->converts[i].buffer); - numItems = (*selPtr->proc)(selPtr->clientData, + numItems = selPtr->proc(selPtr->clientData, incrPtr->converts[i].offset, ((char *) buffer) + length, TK_SEL_BYTES_AT_ONCE - length); @@ -552,12 +552,12 @@ TkSelEventProc( break; } if (eventPtr->xselection.property == None) { - Tcl_SetResult(retrPtr->interp, NULL, TCL_STATIC); - Tcl_AppendResult(retrPtr->interp, + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", Tk_GetAtomName(tkwin, retrPtr->selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, retrPtr->target), - "\" not defined", NULL); + Tk_GetAtomName(tkwin, retrPtr->target))); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", + "NONE", NULL); retrPtr->result = TCL_ERROR; return; } @@ -574,8 +574,9 @@ TkSelEventProc( return; } if (bytesAfter != 0) { - Tcl_SetResult(retrPtr->interp, "selection property too large", - TCL_STATIC); + Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj( + "selection property too large", -1)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "SIZE",NULL); retrPtr->result = TCL_ERROR; XFree(propInfo); return; @@ -583,18 +584,18 @@ TkSelEventProc( if ((type == XA_STRING) || (type == dispPtr->textAtom) || (type == dispPtr->compoundTextAtom)) { Tcl_Encoding encoding; - if (format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - sprintf(buf, + if (format != 8) { + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( "bad format for string selection: wanted \"8\", got \"%d\"", - format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; return; } interp = retrPtr->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); /* * Convert the X selection data into UTF before passing it to the @@ -617,10 +618,10 @@ TkSelEventProc( Tcl_FreeEncoding(encoding); } - retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, - interp, Tcl_DStringValue(&ds)); + retrPtr->result = retrPtr->proc(retrPtr->clientData, interp, + Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } else if (type == dispPtr->utf8Atom) { /* * The X selection data is in UTF-8 format already. We can't @@ -631,25 +632,24 @@ TkSelEventProc( char *propData = propInfo; if (format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( "bad format for string selection: wanted \"8\", got \"%d\"", - format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; return; } if (propInfo[numItems] != '\0') { - propData = ckalloc((size_t) numItems + 1); + propData = ckalloc(numItems + 1); strcpy(propData, propInfo); propData[numItems] = '\0'; } - retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, + retrPtr->result = retrPtr->proc(retrPtr->clientData, retrPtr->interp, propData); if (propData != propInfo) { - ckfree((char *) propData); + ckfree(propData); } } else if (type == dispPtr->incrAtom) { @@ -661,23 +661,23 @@ TkSelEventProc( retrPtr->idleTime = 0; Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc, - (ClientData) retrPtr); + retrPtr); XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin), retrPtr->property); while (retrPtr->result == -1) { Tcl_DoOneEvent(0); } Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc, - (ClientData) retrPtr); + retrPtr); } else { Tcl_DString ds; if (format != 32 && format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad format for selection: wanted \"32\" or " - "\"8\", got \"%d\"", format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( + "bad format for selection: wanted \"32\" or " + "\"8\", got \"%d\"", format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; return; } @@ -690,10 +690,10 @@ TkSelEventProc( (Tk_Window) winPtr, &ds); } interp = retrPtr->interp; - Tcl_Preserve((ClientData) interp); - retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, + Tcl_Preserve(interp); + retrPtr->result = retrPtr->proc(retrPtr->clientData, interp, Tcl_DStringValue(&ds)); - Tcl_Release((ClientData) interp); + Tcl_Release(interp); Tcl_DStringFree(&ds); } XFree(propInfo); @@ -735,7 +735,7 @@ static void SelTimeoutProc( ClientData clientData) /* Information about retrieval in progress. */ { - register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData; + register TkSelRetrievalInfo *retrPtr = clientData; /* * Make sure that the retrieval is still in progress. Then see how long @@ -753,8 +753,9 @@ SelTimeoutProc( * selection return. */ - Tcl_SetResult(retrPtr->interp, "selection owner didn't respond", - TCL_STATIC); + Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj( + "selection owner didn't respond", -1)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "IGNORED", NULL); retrPtr->result = TCL_ERROR; } else { retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc, @@ -791,7 +792,10 @@ ConvertSelection( register XSelectionRequestEvent *eventPtr) /* Event describing request. */ { - XSelectionEvent reply; /* Used to notify requestor that selection + union { + XSelectionEvent xsel; + XEvent ev; + } reply; /* Used to notify requestor that selection * info is ready. */ int multiple; /* Non-zero means a MULTIPLE request is being * handled. */ @@ -802,7 +806,7 @@ ConvertSelection( Tk_ErrorHandler errorHandler; TkSelectionInfo *infoPtr; TkSelInProgress ip; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1, @@ -812,18 +816,18 @@ ConvertSelection( * Initialize the reply event. */ - reply.type = SelectionNotify; - reply.serial = 0; - reply.send_event = True; - reply.display = eventPtr->display; - reply.requestor = eventPtr->requestor; - reply.selection = eventPtr->selection; - reply.target = eventPtr->target; - reply.property = eventPtr->property; - if (reply.property == None) { - reply.property = reply.target; + reply.xsel.type = SelectionNotify; + reply.xsel.serial = 0; + reply.xsel.send_event = True; + reply.xsel.display = eventPtr->display; + reply.xsel.requestor = eventPtr->requestor; + reply.xsel.selection = eventPtr->selection; + reply.xsel.target = eventPtr->target; + reply.xsel.property = eventPtr->property; + if (reply.xsel.property == None) { + reply.xsel.property = reply.xsel.target; } - reply.time = eventPtr->time; + reply.xsel.time = eventPtr->time; for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { @@ -846,8 +850,8 @@ ConvertSelection( incr.selection = eventPtr->selection; if (eventPtr->target != winPtr->dispPtr->multipleAtom) { multiple = 0; - singleInfo[0] = reply.target; - singleInfo[1] = reply.property; + singleInfo[0] = reply.xsel.target; + singleInfo[1] = reply.xsel.property; incr.multAtoms = singleInfo; incr.numConversions = 1; } else { @@ -871,7 +875,7 @@ ConvertSelection( } goto refuse; } - incr.numConversions /= 2; /* Two atoms per conversion. */ + incr.numConversions /= 2; /* Two atoms per conversion. */ } /* @@ -881,8 +885,7 @@ ConvertSelection( * below). */ - incr.converts = (ConvertInfo *) - ckalloc((unsigned) incr.numConversions * sizeof(ConvertInfo)); + incr.converts = ckalloc(incr.numConversions * sizeof(ConvertInfo)); incr.numIncrs = 0; for (i = 0; i < incr.numConversions; i++) { Atom target, property, type; @@ -922,8 +925,8 @@ ConvertSelection( ip.nextPtr = TkSelGetInProgress(); TkSelSetInProgress(&ip); type = selPtr->format; - numItems = (*selPtr->proc)(selPtr->clientData, 0, - (char *) buffer, TK_SEL_BYTES_AT_ONCE); + numItems = selPtr->proc(selPtr->clientData, 0, (char *) buffer, + TK_SEL_BYTES_AT_ONCE); TkSelSetInProgress(ip.nextPtr); if ((ip.selPtr == NULL) || (numItems < 0)) { incr.multAtoms[2*i + 1] = None; @@ -956,7 +959,7 @@ ConvertSelection( propPtr = (char *) buffer; format = 32; incr.converts[i].offset = 0; - XChangeProperty(reply.display, reply.requestor, + XChangeProperty(reply.xsel.display, reply.xsel.requestor, property, type, format, PropModeReplace, (unsigned char *) propPtr, numItems); } else if (type == winPtr->dispPtr->utf8Atom) { @@ -965,8 +968,9 @@ ConvertSelection( * allows us to pass our utf-8 information untouched. */ - XChangeProperty(reply.display, reply.requestor, property, type, 8, - PropModeReplace, (unsigned char *) buffer, numItems); + XChangeProperty(reply.xsel.display, reply.xsel.requestor, + property, type, 8, PropModeReplace, + (unsigned char *) buffer, numItems); } else if ((type == XA_STRING) || (type == winPtr->dispPtr->compoundTextAtom)) { Tcl_DString ds; @@ -984,8 +988,9 @@ ConvertSelection( encoding = Tcl_GetEncoding(NULL, "iso2022"); } Tcl_UtfToExternalDString(encoding, (char *) buffer, -1, &ds); - XChangeProperty(reply.display, reply.requestor, property, type, 8, - PropModeReplace, (unsigned char *) Tcl_DStringValue(&ds), + XChangeProperty(reply.xsel.display, reply.xsel.requestor, + property, type, 8, PropModeReplace, + (unsigned char *) Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); if (encoding) { Tcl_FreeEncoding(encoding); @@ -998,9 +1003,9 @@ ConvertSelection( goto refuse; } format = 32; - XChangeProperty(reply.display, reply.requestor, property, type, - format, PropModeReplace, (unsigned char *) propPtr, - numItems); + XChangeProperty(reply.xsel.display, reply.xsel.requestor, + property, type, format, PropModeReplace, + (unsigned char *) propPtr, numItems); ckfree(propPtr); } } @@ -1012,18 +1017,18 @@ ConvertSelection( */ if (incr.numIncrs > 0) { - XSelectInput(reply.display, reply.requestor, PropertyChangeMask); - incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, - (ClientData) &incr); + XSelectInput(reply.xsel.display, reply.xsel.requestor, + PropertyChangeMask); + incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, &incr); incr.idleTime = 0; - incr.reqWindow = reply.requestor; + incr.reqWindow = reply.xsel.requestor; incr.time = infoPtr->time; incr.nextPtr = tsdPtr->pendingIncrs; tsdPtr->pendingIncrs = &incr; } if (multiple) { - XChangeProperty(reply.display, reply.requestor, reply.property, - XA_ATOM, 32, PropModeReplace, + XChangeProperty(reply.xsel.display, reply.xsel.requestor, + reply.xsel.property, XA_ATOM, 32, PropModeReplace, (unsigned char *) incr.multAtoms, (int) incr.numConversions*2); } else { @@ -1032,9 +1037,9 @@ ConvertSelection( * to None if there was an error in conversion. */ - reply.property = incr.multAtoms[1]; + reply.xsel.property = incr.multAtoms[1]; } - XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply); + XSendEvent(reply.xsel.display, reply.xsel.requestor, False, 0, &reply.ev); Tk_DeleteErrorHandler(errorHandler); /* @@ -1051,8 +1056,8 @@ ConvertSelection( } Tcl_DeleteTimerHandler(incr.timeout); errorHandler = Tk_CreateErrorHandler(winPtr->display, - -1, -1,-1, (int (*)()) NULL, NULL); - XSelectInput(reply.display, reply.requestor, 0L); + -1, -1, -1, (int (*)()) NULL, NULL); + XSelectInput(reply.xsel.display, reply.xsel.requestor, 0L); Tk_DeleteErrorHandler(errorHandler); if (tsdPtr->pendingIncrs == &incr) { tsdPtr->pendingIncrs = incr.nextPtr; @@ -1071,7 +1076,7 @@ ConvertSelection( * All done. Cleanup and return. */ - ckfree((char *) incr.converts); + ckfree(incr.converts); if (multiple) { XFree((char *) incr.multAtoms); } @@ -1082,8 +1087,8 @@ ConvertSelection( */ refuse: - reply.property = None; - XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply); + reply.xsel.property = None; + XSendEvent(reply.xsel.display, reply.xsel.requestor, False, 0, &reply.ev); Tk_DeleteErrorHandler(errorHandler); return; } @@ -1113,7 +1118,7 @@ SelRcvIncrProc( ClientData clientData, /* Information about retrieval. */ register XEvent *eventPtr) /* X PropertyChange event. */ { - register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData; + register TkSelRetrievalInfo *retrPtr = clientData; char *propInfo, **propInfoPtr = &propInfo; Atom type; int format, result; @@ -1134,8 +1139,9 @@ SelRcvIncrProc( return; } if (bytesAfter != 0) { - Tcl_SetResult(retrPtr->interp, "selection property too large", - TCL_STATIC); + Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj( + "selection property too large", -1)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "SIZE", NULL); retrPtr->result = TCL_ERROR; goto done; } @@ -1149,17 +1155,16 @@ SelRcvIncrProc( Tcl_DString *dstPtr, temp; if (format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( "bad format for string selection: wanted \"8\", got \"%d\"", - format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; goto done; } interp = retrPtr->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); if (type == retrPtr->winPtr->dispPtr->compoundTextAtom) { encoding = Tcl_GetEncoding(NULL, "iso2022"); @@ -1190,7 +1195,7 @@ SelRcvIncrProc( */ retrPtr->result = TCL_OK; - Tcl_Release((ClientData) interp); + Tcl_Release(interp); goto done; } else { src = propInfo; @@ -1231,9 +1236,9 @@ SelRcvIncrProc( } Tcl_DStringSetLength(dstPtr, soFar); - result = (*retrPtr->proc)(retrPtr->clientData, interp, + result = retrPtr->proc(retrPtr->clientData, interp, Tcl_DStringValue(dstPtr)); - Tcl_Release((ClientData) interp); + Tcl_Release(interp); /* * Copy any unused data into the destination buffer so we can pick it @@ -1256,11 +1261,11 @@ SelRcvIncrProc( Tcl_DString ds; if (format != 32 && format != 8) { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad format for selection: wanted \"32\" or " - "\"8\", got \"%d\"", format); - Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf( + "bad format for selection: wanted \"32\" or " + "\"8\", got \"%d\"", format)); + Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT", + NULL); retrPtr->result = TCL_ERROR; goto done; } @@ -1273,10 +1278,10 @@ SelRcvIncrProc( (Tk_Window) retrPtr->winPtr, &ds); } interp = retrPtr->interp; - Tcl_Preserve((ClientData) interp); - result = (*retrPtr->proc)(retrPtr->clientData, interp, + Tcl_Preserve(interp); + result = retrPtr->proc(retrPtr->clientData, interp, Tcl_DStringValue(&ds)); - Tcl_Release((ClientData) interp); + Tcl_Release(interp); Tcl_DStringFree(&ds); if (result != TCL_OK) { retrPtr->result = result; @@ -1322,7 +1327,7 @@ SelectionSize( TkSelSetInProgress(&ip); do { - chunkSize = (*selPtr->proc)(selPtr->clientData, size, (char *) buffer, + chunkSize = selPtr->proc(selPtr->clientData, size, (char *) buffer, TK_SEL_BYTES_AT_ONCE); if (ip.selPtr == NULL) { size = 0; @@ -1361,14 +1366,14 @@ IncrTimeoutProc( * retrieval for which we are selection * owner. */ { - register IncrInfo *incrPtr = (IncrInfo *) clientData; + register IncrInfo *incrPtr = clientData; incrPtr->idleTime++; if (incrPtr->idleTime >= 5) { incrPtr->numIncrs = 0; } else { incrPtr->timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, - (ClientData) incrPtr); + incrPtr); } } @@ -1422,7 +1427,7 @@ SelCvtToX( if (Tcl_SplitList(NULL, string, &numFields, &field) != TCL_OK) { return NULL; } - propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long)); + propPtr = ckalloc(numFields * sizeof(long)); /* * Convert the fields one-by-one. @@ -1447,7 +1452,7 @@ SelCvtToX( * Release the parsed list. */ - ckfree((char *) field); + ckfree(field); *numLongsPtr = i; return propPtr; } diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c index 3fb745e..bbbdd77 100644 --- a/unix/tkUnixSend.c +++ b/unix/tkUnixSend.c @@ -77,7 +77,7 @@ typedef struct NameRegistry { typedef struct PendingCommand { int serial; /* Serial number expected in result. */ TkDisplay *dispPtr; /* Display being used for communication. */ - CONST char *target; /* Name of interpreter command is being sent + const char *target; /* Name of interpreter command is being sent * to. */ Window commWindow; /* Target's communication window. */ Tcl_Interp *interp; /* Interpreter from which the send was @@ -210,19 +210,18 @@ static void AppendPropCarefully(Display *display, int length, PendingCommand *pendingPtr); static void DeleteProc(ClientData clientData); static void RegAddName(NameRegistry *regPtr, - CONST char *name, Window commWindow); + const char *name, Window commWindow); static void RegClose(NameRegistry *regPtr); -static void RegDeleteName(NameRegistry *regPtr, CONST char *name); -static Window RegFindName(NameRegistry *regPtr, CONST char *name); +static void RegDeleteName(NameRegistry *regPtr, const char *name); +static Window RegFindName(NameRegistry *regPtr, const char *name); static NameRegistry * RegOpen(Tcl_Interp *interp, TkDisplay *dispPtr, int lock); static void SendEventProc(ClientData clientData, XEvent *eventPtr); static int SendInit(Tcl_Interp *interp, TkDisplay *dispPtr); -static Tk_RestrictAction SendRestrictProc(ClientData clientData, - XEvent *eventPtr); +static Tk_RestrictProc SendRestrictProc; static int ServerSecure(TkDisplay *dispPtr); static void UpdateCommWindow(TkDisplay *dispPtr); -static int ValidateName(TkDisplay *dispPtr, CONST char *name, +static int ValidateName(TkDisplay *dispPtr, const char *name, Window commWindow, int oldOK); /* @@ -267,7 +266,7 @@ RegOpen( SendInit(interp, dispPtr); } - regPtr = (NameRegistry *) ckalloc(sizeof(NameRegistry)); + regPtr = ckalloc(sizeof(NameRegistry)); regPtr->dispPtr = dispPtr; regPtr->locked = 0; regPtr->modified = 0; @@ -347,7 +346,7 @@ static Window RegFindName( NameRegistry *regPtr, /* Pointer to a registry opened with a * previous call to RegOpen. */ - CONST char *name) /* Name of an application. */ + const char *name) /* Name of an application. */ { char *p; @@ -358,7 +357,7 @@ RegFindName( p++; } if ((*p != 0) && (strcmp(name, p+1) == 0)) { - unsigned int id; + unsigned id; if (sscanf(entry, "%x", &id) == 1) { /* @@ -400,7 +399,7 @@ static void RegDeleteName( NameRegistry *regPtr, /* Pointer to a registry opened with a * previous call to RegOpen. */ - CONST char *name) /* Name of an application. */ + const char *name) /* Name of an application. */ { char *p; @@ -462,7 +461,7 @@ static void RegAddName( NameRegistry *regPtr, /* Pointer to a registry opened with a * previous call to RegOpen. */ - CONST char *name, /* Name of an application. The caller must + const char *name, /* Name of an application. The caller must * ensure that this name isn't already * registered. */ Window commWindow) /* X identifier for comm. window of @@ -471,10 +470,10 @@ RegAddName( char id[30], *newProp; int idLength, newBytes; - sprintf(id, "%x ", (unsigned int) commWindow); + sprintf(id, "%x ", (unsigned) commWindow); idLength = strlen(id); newBytes = idLength + strlen(name) + 1; - newProp = ckalloc((unsigned) (regPtr->propLength + newBytes)); + newProp = ckalloc(regPtr->propLength + newBytes); strcpy(newProp, id); strcpy(newProp+idLength, name); if (regPtr->property != NULL) { @@ -548,7 +547,7 @@ RegClose( ckfree(regPtr->property); } } - ckfree((char *) regPtr); + ckfree(regPtr); } /* @@ -573,7 +572,7 @@ static int ValidateName( TkDisplay *dispPtr, /* Display for which to perform the * validation. */ - CONST char *name, /* The name of an application. */ + const char *name, /* The name of an application. */ Window commWindow, /* X identifier for the application's comm. * window. */ int oldOK) /* Non-zero means that we should consider an @@ -586,7 +585,7 @@ ValidateName( Atom actualType; char *property, **propertyPtr = &property; Tk_ErrorHandler handler; - CONST char **argv; + const char **argv; property = NULL; @@ -634,7 +633,7 @@ ValidateName( break; } } - ckfree((char *) argv); + ckfree(argv); } } else { result = 0; @@ -743,7 +742,7 @@ ServerSecure( * the side of safety. */ - goto insecure; + secure = 0; #endif /* FamilyServerInterpreted */ } if (addrPtr != NULL) { @@ -754,7 +753,7 @@ ServerSecure( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Tk_SetAppName -- * @@ -775,15 +774,15 @@ ServerSecure( * registration will be removed automatically if the interpreter is * deleted or the "send" command is removed. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ -CONST char * +const char * Tk_SetAppName( Tk_Window tkwin, /* Token for any window in the application to * be named: it is just used to identify the * application and the display. */ - CONST char *name) /* The name that will be used to refer to the + const char *name) /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ { @@ -793,10 +792,10 @@ Tk_SetAppName( TkDisplay *dispPtr = winPtr->dispPtr; NameRegistry *regPtr; Tcl_Interp *interp; - CONST char *actualName; + const char *actualName; Tcl_DString dString; int offset, i; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); interp = winPtr->mainPtr->interp; @@ -818,14 +817,13 @@ Tk_SetAppName( * the "send" command to the interpreter. */ - riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); + riPtr = ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; riPtr->dispPtr = winPtr->dispPtr; riPtr->nextPtr = tsdPtr->interpListPtr; tsdPtr->interpListPtr = riPtr; riPtr->name = NULL; - Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr, - DeleteProc); + Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "send", "send"); } @@ -903,7 +901,7 @@ Tk_SetAppName( RegAddName(regPtr, actualName, Tk_WindowId(dispPtr->commTkwin)); RegClose(regPtr); - riPtr->name = (char *) ckalloc((unsigned) (strlen(actualName) + 1)); + riPtr->name = ckalloc(strlen(actualName) + 1); strcpy(riPtr->name, actualName); if (actualName != name) { Tcl_DStringFree(&dString); @@ -916,7 +914,7 @@ Tk_SetAppName( /* *-------------------------------------------------------------- * - * Tk_SendCmd -- + * Tk_SendObjCmd -- * * This function is invoked to process the "send" Tcl command. See the * user documentation for details on what it does. @@ -931,27 +929,32 @@ Tk_SetAppName( */ int -Tk_SendCmd( +Tk_SendObjCmd( ClientData clientData, /* Information about sender (only dispPtr * field is used). */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { + enum { + SEND_ASYNC, SEND_DISPLAYOF, SEND_LAST + }; + static const char *const sendOptions[] = { + "-async", "-displayof", "--", NULL + }; TkWindow *winPtr; Window commWindow; PendingCommand pending; register RegisteredInterp *riPtr; - CONST char *destName; - int result, c, async, i, firstArg; - size_t length; - Tk_RestrictProc *prevRestrictProc; + const char *destName; + int result, index, async, i, firstArg; + Tk_RestrictProc *prevProc; ClientData prevArg; TkDisplay *dispPtr; Tcl_Time timeout; NameRegistry *regPtr; Tcl_DString request; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_Interp *localInterp; /* Used when the interpreter to send the * command to is within the same process. */ @@ -965,39 +968,31 @@ Tk_SendCmd( if (winPtr == NULL) { return TCL_ERROR; } - for (i = 1; i < (argc-1); ) { - if (argv[i][0] != '-') { + for (i = 1; i < objc; i++) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], sendOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { break; } - c = argv[i][1]; - length = strlen(argv[i]); - if ((c == 'a') && (strncmp(argv[i], "-async", length) == 0)) { - async = 1; - i++; - } else if ((c == 'd') && (strncmp(argv[i], "-displayof", - length) == 0)) { - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[i+1], + if (index == SEND_ASYNC) { + ++async; + } else if (index == SEND_DISPLAYOF) { + winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[++i]), (Tk_Window) winPtr); if (winPtr == NULL) { return TCL_ERROR; } - i += 2; - } else if (strcmp(argv[i], "--") == 0) { + } else if (index == SEND_LAST) { i++; break; - } else { - Tcl_AppendResult(interp, "bad option \"", argv[i], - "\": must be -async, -displayof, or --", NULL); - return TCL_ERROR; } } - if (argc < (i+2)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ?options? interpName arg ?arg ...?\"", NULL); + if (objc < (i+2)) { + Tcl_WrongNumArgs(interp, 1, objv, + "?-option value ...? interpName arg ?arg ...?"); return TCL_ERROR; } - destName = argv[i]; + destName = Tcl_GetString(objv[i]); firstArg = i+1; dispPtr = winPtr->dispPtr; @@ -1018,17 +1013,17 @@ Tk_SendCmd( || (strcmp(riPtr->name, destName) != 0)) { continue; } - Tcl_Preserve((ClientData) riPtr); + Tcl_Preserve(riPtr); localInterp = riPtr->interp; - Tcl_Preserve((ClientData) localInterp); - if (firstArg == (argc-1)) { - result = Tcl_EvalEx(localInterp, argv[firstArg], -1, TCL_EVAL_GLOBAL); + Tcl_Preserve(localInterp); + if (firstArg == (objc-1)) { + result = Tcl_EvalEx(localInterp, Tcl_GetString(objv[firstArg]), -1, TCL_EVAL_GLOBAL); } else { Tcl_DStringInit(&request); - Tcl_DStringAppend(&request, argv[firstArg], -1); - for (i = firstArg+1; i < argc; i++) { + Tcl_DStringAppend(&request, Tcl_GetString(objv[firstArg]), -1); + for (i = firstArg+1; i < objc; i++) { Tcl_DStringAppend(&request, " ", 1); - Tcl_DStringAppend(&request, argv[i], -1); + Tcl_DStringAppend(&request, Tcl_GetString(objv[i]), -1); } result = Tcl_EvalEx(localInterp, Tcl_DStringValue(&request), -1, TCL_EVAL_GLOBAL); Tcl_DStringFree(&request); @@ -1056,8 +1051,8 @@ Tk_SendCmd( Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp)); Tcl_ResetResult(localInterp); } - Tcl_Release((ClientData) riPtr); - Tcl_Release((ClientData) localInterp); + Tcl_Release(riPtr); + Tcl_Release(localInterp); return result; } @@ -1069,7 +1064,10 @@ Tk_SendCmd( commWindow = RegFindName(regPtr, destName); RegClose(regPtr); if (commWindow == None) { - Tcl_AppendResult(interp, "no application named \"",destName,"\"",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no application named \"%s\"", destName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "APPLICATION", destName, + NULL); return TCL_ERROR; } @@ -1086,16 +1084,16 @@ Tk_SendCmd( char buffer[TCL_INTEGER_SPACE * 2]; sprintf(buffer, "%x %d", - (unsigned int) Tk_WindowId(dispPtr->commTkwin), + (unsigned) Tk_WindowId(dispPtr->commTkwin), localData.sendSerial); Tcl_DStringAppend(&request, "\0-r ", 4); Tcl_DStringAppend(&request, buffer, -1); } Tcl_DStringAppend(&request, "\0-s ", 4); - Tcl_DStringAppend(&request, argv[firstArg], -1); - for (i = firstArg+1; i < argc; i++) { + Tcl_DStringAppend(&request, Tcl_GetString(objv[firstArg]), -1); + for (i = firstArg+1; i < objc; i++) { Tcl_DStringAppend(&request, " ", 1); - Tcl_DStringAppend(&request, argv[i], -1); + Tcl_DStringAppend(&request, Tcl_GetString(objv[i]), -1); } (void) AppendPropCarefully(dispPtr->display, commWindow, dispPtr->commProperty, Tcl_DStringValue(&request), @@ -1137,7 +1135,7 @@ Tk_SendCmd( * other events in the application. */ - prevRestrictProc = Tk_RestrictEvents(SendRestrictProc, NULL, &prevArg); + prevProc = Tk_RestrictEvents(SendRestrictProc, NULL, &prevArg); Tcl_GetTime(&timeout); timeout.sec += 2; while (!pending.gotResponse) { @@ -1150,7 +1148,7 @@ Tk_SendCmd( if (!ValidateName(pending.dispPtr, pending.target, pending.commWindow, 0)) { - char *msg; + const char *msg; if (ValidateName(pending.dispPtr, pending.target, pending.commWindow, 1)) { @@ -1159,7 +1157,7 @@ Tk_SendCmd( msg = "target application died"; } pending.code = TCL_ERROR; - pending.result = (char *) ckalloc((unsigned) (strlen(msg) + 1)); + pending.result = ckalloc(strlen(msg) + 1); strcpy(pending.result, msg); pending.gotResponse = 1; } else { @@ -1168,7 +1166,7 @@ Tk_SendCmd( } } } - (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg); + Tk_RestrictEvents(prevProc, prevArg, &prevArg); /* * Unregister the information about the pending command and return the @@ -1192,12 +1190,11 @@ Tk_SendCmd( ckfree(pending.errorInfo); } if (pending.errorCode != NULL) { - Tcl_Obj *errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1); - - Tcl_SetObjErrorCode(interp, errorObjPtr); + Tcl_SetObjErrorCode(interp, Tcl_NewStringObj(pending.errorCode, -1)); ckfree(pending.errorCode); } - Tcl_SetResult(interp, pending.result, TCL_DYNAMIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(pending.result, -1)); + ckfree(pending.result); return pending.code; } @@ -1229,6 +1226,7 @@ TkGetInterpNames( { TkWindow *winPtr = (TkWindow *) tkwin; NameRegistry *regPtr; + Tcl_Obj *resultObj = Tcl_NewObj(); char *p; /* @@ -1240,9 +1238,9 @@ TkGetInterpNames( for (p=regPtr->property ; p-regPtr->property<(int)regPtr->propLength ;) { char *entry = p, *entryName; Window commWindow; - unsigned int id; + unsigned id; - if (sscanf(p, "%x",(unsigned int *) &id) != 1) { + if (sscanf(p, "%x", (unsigned *) &id) != 1) { commWindow = None; } else { commWindow = id; @@ -1263,7 +1261,8 @@ TkGetInterpNames( * The application still exists; add its name to the result. */ - Tcl_AppendElement(interp, entryName); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(entryName, -1)); } else { int count; @@ -1286,6 +1285,7 @@ TkGetInterpNames( } } RegClose(regPtr); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -1312,9 +1312,9 @@ TkSendCleanup( { if (dispPtr->commTkwin != NULL) { Tk_DeleteEventHandler(dispPtr->commTkwin, PropertyChangeMask, - SendEventProc, (ClientData) dispPtr); + SendEventProc, dispPtr); Tk_DestroyWindow(dispPtr->commTkwin); - Tcl_Release((ClientData) dispPtr->commTkwin); + Tcl_Release(dispPtr->commTkwin); dispPtr->commTkwin = NULL; } } @@ -1352,14 +1352,15 @@ SendInit( dispPtr->commTkwin = (Tk_Window) TkAllocWindow(dispPtr, DefaultScreen(dispPtr->display), NULL); - Tcl_Preserve((ClientData) dispPtr->commTkwin); - ((TkWindow *) dispPtr->commTkwin)->flags |=TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; + Tcl_Preserve(dispPtr->commTkwin); + ((TkWindow *) dispPtr->commTkwin)->flags |= + TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; TkWmNewWindow((TkWindow *) dispPtr->commTkwin); atts.override_redirect = True; Tk_ChangeWindowAttributes(dispPtr->commTkwin, CWOverrideRedirect, &atts); Tk_CreateEventHandler(dispPtr->commTkwin, PropertyChangeMask, - SendEventProc, (ClientData) dispPtr); + SendEventProc, dispPtr); Tk_MakeWindowExist(dispPtr->commTkwin); /* @@ -1400,14 +1401,14 @@ SendEventProc( ClientData clientData, /* Display information. */ XEvent *eventPtr) /* Information about event. */ { - TkDisplay *dispPtr = (TkDisplay *) clientData; + TkDisplay *dispPtr = clientData; char *propInfo, **propInfoPtr = &propInfo; - register char *p; + const char *p; int result, actualFormat; unsigned long numItems, bytesAfter; Atom actualType; Tcl_Interp *remoteInterp; /* Interp in which to execute the command. */ - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if ((eventPtr->xproperty.atom != dispPtr->commProperty) @@ -1457,7 +1458,8 @@ SendEventProc( if ((*p == 'c') && (p[1] == 0)) { Window commWindow; - char *interpName, *script, *serial, *end; + const char *interpName, *script, *serial; + char *end; Tcl_DString reply; RegisteredInterp *riPtr; @@ -1546,7 +1548,7 @@ SendEventProc( break; } } - Tcl_Preserve((ClientData) riPtr); + Tcl_Preserve(riPtr); /* * We must protect the interpreter because the script may enter @@ -1554,7 +1556,7 @@ SendEventProc( */ remoteInterp = riPtr->interp; - Tcl_Preserve((ClientData) remoteInterp); + Tcl_Preserve(remoteInterp); result = Tcl_EvalEx(remoteInterp, script, -1, TCL_EVAL_GLOBAL); @@ -1566,10 +1568,10 @@ SendEventProc( */ if (commWindow != None) { - Tcl_DStringAppend(&reply, Tcl_GetStringResult(remoteInterp), + Tcl_DStringAppend(&reply, Tcl_GetString(Tcl_GetObjResult(remoteInterp)), -1); if (result == TCL_ERROR) { - CONST char *varValue; + const char *varValue; varValue = Tcl_GetVar2(remoteInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY); @@ -1585,8 +1587,8 @@ SendEventProc( } } } - Tcl_Release((ClientData) remoteInterp); - Tcl_Release((ClientData) riPtr); + Tcl_Release(remoteInterp); + Tcl_Release(riPtr); /* * Return the result to the sender if a commWindow was specified @@ -1612,7 +1614,7 @@ SendEventProc( } } else if ((*p == 'r') && (p[1] == 0)) { int serial, code, gotSerial; - char *errorInfo, *errorCode, *resultString; + const char *errorInfo, *errorCode, *resultString; PendingCommand *pcPtr; /* @@ -1678,19 +1680,16 @@ SendEventProc( } pcPtr->code = code; if (resultString != NULL) { - pcPtr->result = (char *) ckalloc((unsigned) - (strlen(resultString) + 1)); + pcPtr->result = ckalloc(strlen(resultString) + 1); strcpy(pcPtr->result, resultString); } if (code == TCL_ERROR) { if (errorInfo != NULL) { - pcPtr->errorInfo = (char *) ckalloc((unsigned) - (strlen(errorInfo) + 1)); + pcPtr->errorInfo = ckalloc(strlen(errorInfo) + 1); strcpy(pcPtr->errorInfo, errorInfo); } if (errorCode != NULL) { - pcPtr->errorCode = (char *) ckalloc((unsigned) - (strlen(errorCode) + 1)); + pcPtr->errorCode = ckalloc(strlen(errorCode) + 1); strcpy(pcPtr->errorCode, errorCode); } } @@ -1746,7 +1745,7 @@ AppendPropCarefully( Tk_ErrorHandler handler; handler = Tk_CreateErrorHandler(display, -1, -1, -1, AppendErrorProc, - (ClientData) pendingPtr); + pendingPtr); XChangeProperty(display, window, property, XA_STRING, 8, PropModeAppend, (unsigned char *) value, length); Tk_DeleteErrorHandler(handler); @@ -1763,9 +1762,9 @@ AppendErrorProc( ClientData clientData, /* Command to mark complete, or NULL. */ XErrorEvent *errorPtr) /* Information about error. */ { - PendingCommand *pendingPtr = (PendingCommand *) clientData; + PendingCommand *pendingPtr = clientData; register PendingCommand *pcPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (pendingPtr == NULL) { @@ -1779,8 +1778,7 @@ AppendErrorProc( for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL; pcPtr = pcPtr->nextPtr) { if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) { - pcPtr->result = (char *) ckalloc((unsigned) - (strlen(pcPtr->target) + 50)); + pcPtr->result = ckalloc(strlen(pcPtr->target) + 50); sprintf(pcPtr->result, "no application named \"%s\"", pcPtr->target); pcPtr->code = TCL_ERROR; @@ -1813,10 +1811,10 @@ DeleteProc( ClientData clientData) /* Info about registration, passed as * ClientData. */ { - RegisteredInterp *riPtr = (RegisteredInterp *) clientData; + RegisteredInterp *riPtr = clientData; register RegisteredInterp *riPtr2; NameRegistry *regPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1); @@ -1834,10 +1832,10 @@ DeleteProc( } } } - ckfree((char *) riPtr->name); + ckfree(riPtr->name); riPtr->interp = NULL; UpdateCommWindow(riPtr->dispPtr); - Tcl_EventuallyFree((ClientData) riPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(riPtr, TCL_DYNAMIC); } /* @@ -1905,7 +1903,7 @@ UpdateCommWindow( { Tcl_DString names; RegisteredInterp *riPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_DStringInit(&names); @@ -1943,44 +1941,55 @@ int TkpTestsendCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { - TkWindow *winPtr = (TkWindow *) clientData; - - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " option ?arg ...?\"", NULL); + enum { + TESTSEND_BOGUS, TESTSEND_PROP, TESTSEND_SERIAL + }; + static const char *const testsendOptions[] = { + "bogus", "prop", "serial", NULL + }; + TkWindow *winPtr = clientData; + int index; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, + "option ?arg ...?"); return TCL_ERROR; } - if (strcmp(argv[1], "bogus") == 0) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], testsendOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + if (index == TESTSEND_BOGUS) { XChangeProperty(winPtr->dispPtr->display, RootWindow(winPtr->dispPtr->display, 0), winPtr->dispPtr->registryProperty, XA_INTEGER, 32, PropModeReplace, (unsigned char *) "This is bogus information", 6); - } else if (strcmp(argv[1], "prop") == 0) { + } else if (index == TESTSEND_PROP) { int result, actualFormat; unsigned long length, bytesAfter; Atom actualType, propName; char *property, **propertyPtr = &property, *p, *end; Window w; - if ((argc != 4) && (argc != 5)) { - Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0], - " prop window name ?value ?\"", NULL); + if ((objc != 4) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 1, objv, + "prop window name ?value ?"); return TCL_ERROR; } - if (strcmp(argv[2], "root") == 0) { + if (strcmp(Tcl_GetString(objv[2]), "root") == 0) { w = RootWindow(winPtr->dispPtr->display, 0); - } else if (strcmp(argv[2], "comm") == 0) { + } else if (strcmp(Tcl_GetString(objv[2]), "comm") == 0) { w = Tk_WindowId(winPtr->dispPtr->commTkwin); } else { - w = strtoul(argv[2], &end, 0); + w = strtoul(Tcl_GetString(objv[2]), &end, 0); } - propName = Tk_InternAtom((Tk_Window) winPtr, argv[3]); - if (argc == 4) { + propName = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); + if (objc == 4) { property = NULL; result = XGetWindowProperty(winPtr->dispPtr->display, w, propName, 0, 100000, False, XA_STRING, &actualType, &actualFormat, @@ -1992,19 +2001,19 @@ TkpTestsendCmd( *p = '\n'; } } - Tcl_SetResult(interp, property, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(property, -1)); } if (property != NULL) { XFree(property); } - } else if (argv[4][0] == 0) { + } else if (Tcl_GetString(objv[4])[0] == 0) { XDeleteProperty(winPtr->dispPtr->display, w, propName); } else { Tcl_DString tmp; Tcl_DStringInit(&tmp); - for (p = Tcl_DStringAppend(&tmp, argv[4], - (int) strlen(argv[4])); *p != 0; p++) { + for (p = Tcl_DStringAppend(&tmp, Tcl_GetString(objv[4]), + (int) strlen(Tcl_GetString(objv[4]))); *p != 0; p++) { if (*p == '\n') { *p = 0; } @@ -2015,15 +2024,8 @@ TkpTestsendCmd( p-Tcl_DStringValue(&tmp)); Tcl_DStringFree(&tmp); } - } else if (strcmp(argv[1], "serial") == 0) { - char buf[TCL_INTEGER_SPACE]; - - sprintf(buf, "%d", localData.sendSerial+1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be bogus, prop, or serial", NULL); - return TCL_ERROR; + } else if (index == TESTSEND_SERIAL) { + Tcl_SetObjResult(interp, Tcl_NewIntObj(localData.sendSerial+1)); } return TCL_OK; } diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 904065b..612270c 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -28,7 +28,7 @@ typedef struct ProtocolHandler { * same top-level window, or NULL for end of * list. */ Tcl_Interp *interp; /* Interpreter in which to invoke command. */ - char command[4]; /* Tcl command to invoke when a client message + char command[1]; /* Tcl command to invoke when a client message * for this protocol arrives. The actual size * of the structure varies to accommodate the * needs of the actual command. THIS MUST BE @@ -36,16 +36,17 @@ typedef struct ProtocolHandler { } ProtocolHandler; #define HANDLER_SIZE(cmdLength) \ - ((unsigned) (sizeof(ProtocolHandler) - 3 + cmdLength)) + ((unsigned) ((Tk_Offset(ProtocolHandler, command) + 1) + cmdLength)) /* * Data for [wm attributes] command: */ + typedef struct { - double alpha; /* Transparency; 0.0=transparent, 1.0=opaque */ - int topmost; /* Flag: true=>stay-on-top */ - int zoomed; /* Flag: true=>maximized */ - int fullscreen; /* Flag: true=>fullscreen */ + double alpha; /* Transparency; 0.0=transparent, 1.0=opaque */ + int topmost; /* Flag: true=>stay-on-top */ + int zoomed; /* Flag: true=>maximized */ + int fullscreen; /* Flag: true=>fullscreen */ } WmAttributes; typedef enum { @@ -53,7 +54,7 @@ typedef enum { WMATT_TYPE, _WMATT_LAST_ATTRIBUTE } WmAttribute; -static const char *WmAttributeNames[] = { +static const char *const WmAttributeNames[] = { "-alpha", "-topmost", "-zoomed", "-fullscreen", "-type", NULL }; @@ -205,7 +206,7 @@ typedef struct TkWmInfo { ProtocolHandler *protPtr; /* First in list of protocol handlers for this * window (NULL means none). */ int cmdArgc; /* Number of elements in cmdArgv below. */ - CONST char **cmdArgv; /* Array of strings to store in the WM_COMMAND + const char **cmdArgv; /* Array of strings to store in the WM_COMMAND * property. NULL means nothing available. */ char *clientMachine; /* String to store in WM_CLIENT_MACHINE * property, or NULL. */ @@ -277,6 +278,22 @@ typedef struct TkWmInfo { #define WM_WITHDRAWN 0x4000 /* + * Wrapper for XGetWindowProperty and XChangeProperty to make them a *bit* + * less verbose. + */ + +#define GetWindowProperty(wrapperPtr, atom, length, type, typePtr, formatPtr, numItemsPtr, bytesAfterPtr, itemsPtr) \ + (XGetWindowProperty((wrapperPtr)->display, (wrapperPtr)->window, \ + (atom), 0, (long) (length), False, (type), \ + (typePtr), (formatPtr), (numItemsPtr), (bytesAfterPtr), \ + (unsigned char **) (itemsPtr)) == Success) +#define SetWindowProperty(wrapperPtr, atomName, type, width, data, length) \ + XChangeProperty((wrapperPtr)->display, (wrapperPtr)->window, \ + Tk_InternAtom((Tk_Window) wrapperPtr, (atomName)), \ + (type), (width), PropModeReplace, (unsigned char *) (data), \ + (int) (length)) + +/* * This module keeps a list of all top-level windows, primarily to simplify * the job of Tk_CoordsToWindow. The list is called firstWmPtr and is stored * in the TkDisplay structure. @@ -289,17 +306,18 @@ typedef struct TkWmInfo { static void TopLevelReqProc(ClientData dummy, Tk_Window tkwin); static void RemapWindows(TkWindow *winPtr, TkWindow *parentPtr); -static void MenubarReqProc(ClientData clientData, Tk_Window tkwin); +static void MenubarReqProc(ClientData clientData, + Tk_Window tkwin); static const Tk_GeomMgr wmMgrType = { - "wm", /* name */ - TopLevelReqProc, /* requestProc */ - NULL, /* lostSlaveProc */ + "wm", /* name */ + TopLevelReqProc, /* requestProc */ + NULL, /* lostSlaveProc */ }; static const Tk_GeomMgr menubarMgrType = { - "menubar", /* name */ - MenubarReqProc, /* requestProc */ - NULL, /* lostSlaveProc */ + "menubar", /* name */ + MenubarReqProc, /* requestProc */ + NULL, /* lostSlaveProc */ }; /* @@ -328,7 +346,7 @@ static void GetMaxSize(WmInfo *wmPtr, int *maxWidthPtr, int *maxHeightPtr); static void MenubarDestroyProc(ClientData clientData, XEvent *eventPtr); -static int ParseGeometry(Tcl_Interp *interp, char *string, +static int ParseGeometry(Tcl_Interp *interp, const char *string, TkWindow *winPtr); static void ReparentEvent(WmInfo *wmPtr, XReparentEvent *eventPtr); static void PropertyEvent(WmInfo *wmPtr, XPropertyEvent *eventPtr); @@ -355,108 +373,107 @@ static void WaitForConfigureNotify(TkWindow *winPtr, static int WaitForEvent(Display *display, WmInfo *wmInfoPtr, int type, XEvent *eventPtr); static void WaitForMapNotify(TkWindow *winPtr, int mapped); -static Tk_RestrictAction - WaitRestrictProc(ClientData clientData, - XEvent *eventPtr); +static Tk_RestrictProc WaitRestrictProc; static void WrapperEventProc(ClientData clientData, XEvent *eventPtr); -static void WmWaitMapProc(ClientData clientData, XEvent *eventPtr); +static void WmWaitMapProc(ClientData clientData, + XEvent *eventPtr); static int WmAspectCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmAttributesCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmClientCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -static int WmColormapwindowsCmd(Tk_Window tkwin, TkWindow *winPtr, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +static int WmColormapwindowsCmd(Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int WmCommandCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmDeiconifyCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmFocusmodelCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmForgetCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmFrameCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmGeometryCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmGridCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmGroupCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmIconbitmapCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmIconifyCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmIconmaskCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmIconnameCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmIconphotoCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmIconpositionCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmIconwindowCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmManageCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmMaxsizeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmMinsizeCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -static int WmOverrideredirectCmd(Tk_Window tkwin,TkWindow *winPtr, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); +static int WmOverrideredirectCmd(Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int WmPositionfromCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmProtocolCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmResizableCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmSizefromCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmStackorderCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmStateCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmTitleCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmTransientCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int WmWithdrawCmd(Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static void WmUpdateGeom(WmInfo *wmPtr, TkWindow *winPtr); /* @@ -495,7 +512,7 @@ void TkWmCleanup( ckfree(wmPtr->iconName); } if (wmPtr->iconDataPtr != NULL) { - ckfree((char *) wmPtr->iconDataPtr); + ckfree(wmPtr->iconDataPtr); } if (wmPtr->leaderName != NULL) { ckfree(wmPtr->leaderName); @@ -507,22 +524,21 @@ void TkWmCleanup( Tk_DestroyWindow((Tk_Window) wmPtr->wrapperPtr); } while (wmPtr->protPtr != NULL) { - ProtocolHandler *protPtr; + ProtocolHandler *protPtr = wmPtr->protPtr; - protPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr->nextPtr; - Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(protPtr, TCL_DYNAMIC); } if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + ckfree(wmPtr->cmdArgv); } if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); + ckfree(wmPtr->clientMachine); } - ckfree((char *) wmPtr); + ckfree(wmPtr); } if (dispPtr->iconDataPtr != NULL) { - ckfree((char *) dispPtr->iconDataPtr); + ckfree(dispPtr->iconDataPtr); dispPtr->iconDataPtr = NULL; } } @@ -551,7 +567,7 @@ TkWmNewWindow( register WmInfo *wmPtr; TkDisplay *dispPtr = winPtr->dispPtr; - wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo)); + wmPtr = ckalloc(sizeof(WmInfo)); memset(wmPtr, 0, sizeof(WmInfo)); wmPtr->winPtr = winPtr; wmPtr->reparent = None; @@ -569,6 +585,7 @@ TkWmNewWindow( /* * Initialize attributes. */ + wmPtr->attributes.alpha = 1.0; wmPtr->attributes.topmost = 0; wmPtr->attributes.zoomed = 0; @@ -611,7 +628,7 @@ TkWmNewWindow( * window manager. */ - Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, (ClientData) 0); + Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, NULL); } /* @@ -697,10 +714,9 @@ TkWmMapWindow( if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1, &textProp) != 0) { unsigned long pid = (unsigned long) getpid(); - Atom atom; - XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window, - &textProp); + XSetWMClientMachine(winPtr->display, + wmPtr->wrapperPtr->window, &textProp); XFree((char *) textProp.value); /* @@ -710,10 +726,8 @@ TkWmMapWindow( * _NET_WM_PID requires that to be set too. */ - atom = Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_PID"); - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - atom, XA_CARDINAL, 32, PropModeReplace, - (unsigned char *) &pid, 1); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_PID", + XA_CARDINAL, 32, &pid, 1); } Tcl_DStringFree(&ds); } @@ -728,16 +742,16 @@ TkWmMapWindow( */ if (wmPtr->flags & WM_UPDATE_PENDING) { - Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); } - UpdateGeometryInfo((ClientData) winPtr); + UpdateGeometryInfo(winPtr); return; } wmPtr->flags |= WM_ABOUT_TO_MAP; if (wmPtr->flags & WM_UPDATE_PENDING) { - Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); } - UpdateGeometryInfo((ClientData) winPtr); + UpdateGeometryInfo(winPtr); wmPtr->flags &= ~WM_ABOUT_TO_MAP; /* @@ -840,7 +854,7 @@ TkWmDeadWindow( ckfree(wmPtr->iconName); } if (wmPtr->iconDataPtr != NULL) { - ckfree((char *) wmPtr->iconDataPtr); + ckfree(wmPtr->iconDataPtr); } if (wmPtr->hints.flags & IconPixmapHint) { Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap); @@ -879,20 +893,19 @@ TkWmDeadWindow( Tk_DestroyWindow((Tk_Window) wmPtr->wrapperPtr); } while (wmPtr->protPtr != NULL) { - ProtocolHandler *protPtr; + ProtocolHandler *protPtr = wmPtr->protPtr; - protPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr->nextPtr; - Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(protPtr, TCL_DYNAMIC); } if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + ckfree(wmPtr->cmdArgv); } if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); + ckfree(wmPtr->clientMachine); } if (wmPtr->flags & WM_UPDATE_PENDING) { - Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); } /* @@ -904,8 +917,7 @@ TkWmDeadWindow( if (wmPtr2->masterPtr == winPtr) { wmPtr->numTransients--; Tk_DeleteEventHandler((Tk_Window) wmPtr2->masterPtr, - StructureNotifyMask, - WmWaitMapProc, (ClientData) wmPtr2->winPtr); + StructureNotifyMask, WmWaitMapProc, wmPtr2->winPtr); wmPtr2->masterPtr = NULL; if (!(wmPtr2->flags & WM_NEVER_MAPPED)) { XDeleteProperty(winPtr->display, wmPtr2->wrapperPtr->window, @@ -932,10 +944,10 @@ TkWmDeadWindow( wmPtr2->numTransients--; } Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, - StructureNotifyMask, WmWaitMapProc, (ClientData) winPtr); + StructureNotifyMask, WmWaitMapProc, winPtr); wmPtr->masterPtr = NULL; } - ckfree((char *) wmPtr); + ckfree(wmPtr); winPtr->wmInfoPtr = NULL; } @@ -999,32 +1011,30 @@ Tk_WmObjCmd( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; - static CONST char *optionStrings[] = { + Tk_Window tkwin = clientData; + static const char *const optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", - "command", "deiconify", "focusmodel", "forget", "frame", - "geometry", "grid", "group", "iconbitmap", - "iconify", "iconmask", "iconname", - "iconphoto", "iconposition", - "iconwindow", "manage", "maxsize", "minsize", "overrideredirect", - "positionfrom", "protocol", "resizable", "sizefrom", - "stackorder", "state", "title", "transient", - "withdraw", NULL }; + "command", "deiconify", "focusmodel", "forget", + "frame", "geometry", "grid", "group", "iconbitmap", + "iconify", "iconmask", "iconname", "iconphoto", + "iconposition", "iconwindow", "manage", "maxsize", + "minsize", "overrideredirect", "positionfrom", + "protocol", "resizable", "sizefrom", "stackorder", + "state", "title", "transient", "withdraw", NULL }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, - WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME, - WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP, - WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, - WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, - WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, - WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, - WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, - WMOPT_WITHDRAW }; - int index; - int length; - char *argv1; + WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, + WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, + WMOPT_ICONBITMAP, + WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, + WMOPT_ICONPOSITION, WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, + WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, + WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER, + WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, WMOPT_WITHDRAW }; + int index, length; + const char *argv1; TkWindow *winPtr; Tk_Window targetWin; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; @@ -1039,14 +1049,14 @@ Tk_WmObjCmd( if ((argv1[0] == 't') && (strncmp(argv1, "tracing", (size_t) length) == 0) && (length >= 3)) { int wmTracing; + if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); return TCL_ERROR; } if (objc == 2) { - Tcl_SetResult(interp, - ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + dispPtr->flags & TK_DISPLAY_WM_TRACING)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { @@ -1060,8 +1070,8 @@ Tk_WmObjCmd( return TCL_OK; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1075,8 +1085,10 @@ Tk_WmObjCmd( winPtr = (TkWindow *) targetWin; if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -1174,7 +1186,7 @@ WmAspectCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int numer1, denom1, numer2, denom2; @@ -1186,12 +1198,13 @@ WmAspectCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, - wmPtr->minAspect.y, wmPtr->maxAspect.x, - wmPtr->maxAspect.y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->minAspect.x); + results[1] = Tcl_NewIntObj(wmPtr->minAspect.y); + results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x); + results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1206,8 +1219,9 @@ WmAspectCmd( } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - Tcl_SetResult(interp, "aspect number can't be <= 0", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "aspect number can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ASPECT", NULL); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -1245,6 +1259,7 @@ WmSetAttribute( Tcl_Obj *value) /* New value */ { WmInfo *wmPtr = winPtr->wmInfoPtr; + switch (attribute) { case WMATT_ALPHA: { unsigned long opacity; /* 0=transparent, 0xFFFFFFFF=opaque */ @@ -1265,29 +1280,26 @@ WmSetAttribute( } opacity = 0xFFFFFFFFul * wmPtr->reqState.alpha; - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_WINDOW_OPACITY"), - XA_CARDINAL, 32, PropModeReplace, - (unsigned char *)&opacity, 1L); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_WINDOW_OPACITY", + XA_CARDINAL, 32, &opacity, 1L); wmPtr->attributes.alpha = wmPtr->reqState.alpha; break; } case WMATT_TOPMOST: - if (TCL_OK != Tcl_GetBooleanFromObj(interp, value, - &wmPtr->reqState.topmost)) { + if (Tcl_GetBooleanFromObj(interp, value, + &wmPtr->reqState.topmost) != TCL_OK) { return TCL_ERROR; } - SetNetWmState(winPtr, "_NET_WM_STATE_ABOVE", - wmPtr->reqState.topmost); + SetNetWmState(winPtr, "_NET_WM_STATE_ABOVE", wmPtr->reqState.topmost); break; case WMATT_TYPE: if (TCL_OK != SetNetWmType(winPtr, value)) return TCL_ERROR; break; case WMATT_ZOOMED: - if (TCL_OK != Tcl_GetBooleanFromObj(interp, value, - &wmPtr->reqState.zoomed)) { + if (Tcl_GetBooleanFromObj(interp, value, + &wmPtr->reqState.zoomed) != TCL_OK) { return TCL_ERROR; } SetNetWmState(winPtr, "_NET_WM_STATE_MAXIMIZED_VERT", @@ -1296,8 +1308,8 @@ WmSetAttribute( wmPtr->reqState.zoomed); break; case WMATT_FULLSCREEN: - if (TCL_OK != Tcl_GetBooleanFromObj(interp, value, - &wmPtr->reqState.fullscreen)) { + if (Tcl_GetBooleanFromObj(interp, value, + &wmPtr->reqState.fullscreen) != TCL_OK) { return TCL_ERROR; } SetNetWmState(winPtr, "_NET_WM_STATE_FULLSCREEN", @@ -1377,7 +1389,7 @@ WmAttributesCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int attribute = 0; @@ -1393,8 +1405,8 @@ WmAttributesCmd( Tcl_SetObjResult(interp, result); return TCL_OK; } else if (objc == 4) { /* wm attributes $win -attribute */ - if (Tcl_GetIndexFromObj(interp, objv[3], WmAttributeNames, - "attribute", 0, &attribute) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], WmAttributeNames, + sizeof(char *), "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, WmGetAttribute(winPtr, attribute)); @@ -1403,8 +1415,8 @@ WmAttributesCmd( int i; for (i = 3; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], WmAttributeNames, - "attribute", 0, &attribute) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], WmAttributeNames, + sizeof(char *), "attribute", 0, &attribute) != TCL_OK) { return TCL_ERROR; } if (WmSetAttribute(winPtr,interp,attribute,objv[i+1]) != TCL_OK) { @@ -1441,10 +1453,10 @@ WmClientCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; + const char *argv3; int length; if ((objc != 3) && (objc != 4)) { @@ -1453,14 +1465,15 @@ WmClientCmd( } if (objc == 3) { if (wmPtr->clientMachine != NULL) { - Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->clientMachine, -1)); } return TCL_OK; } argv3 = Tcl_GetStringFromObj(objv[3], &length); if (argv3[0] == 0) { if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); + ckfree(wmPtr->clientMachine); wmPtr->clientMachine = NULL; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, @@ -1471,9 +1484,9 @@ WmClientCmd( return TCL_OK; } if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); + ckfree(wmPtr->clientMachine); } - wmPtr->clientMachine = ckalloc((unsigned) length + 1); + wmPtr->clientMachine = ckalloc(length + 1); strcpy(wmPtr->clientMachine, argv3); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XTextProperty textProp; @@ -1495,10 +1508,8 @@ WmClientCmd( * be set too. */ - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_PID"), - XA_CARDINAL,32, PropModeReplace, (unsigned char *) &pid, - 1); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_PID", XA_CARDINAL, + 32, &pid, 1); } Tcl_DStringFree(&ds); } @@ -1528,14 +1539,13 @@ WmColormapwindowsCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window *cmapList; TkWindow *winPtr2; int count, i, windowObjc, gotToplevel; - Tcl_Obj **windowObjv; - char buffer[20]; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -1550,36 +1560,38 @@ WmColormapwindowsCmd( wmPtr->wrapperPtr->window, &cmapList, &count) == 0) { return TCL_OK; } + resultObj = Tcl_NewObj(); for (i = 0; i < count; i++) { if ((i == (count-1)) && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } - winPtr2 = (TkWindow *) Tk_IdToWindow(winPtr->display, - cmapList[i]); + winPtr2 = (TkWindow *) + Tk_IdToWindow(winPtr->display, cmapList[i]); if (winPtr2 == NULL) { - sprintf(buffer, "0x%lx", cmapList[i]); - Tcl_AppendElement(interp, buffer); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_ObjPrintf("0x%lx", cmapList[i])); } else { - Tcl_AppendElement(interp, winPtr2->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj(winPtr2->pathName, -1)); } } XFree((char *) cmapList); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) != TCL_OK) { return TCL_ERROR; } - cmapList = (Window *) ckalloc((unsigned) - (windowObjc+1) * sizeof(Window)); + cmapList = ckalloc((windowObjc+1) * sizeof(Window)); gotToplevel = 0; for (i = 0; i < windowObjc; i++) { Tk_Window mapWin; if (TkGetWindowFromObj(interp, tkwin, windowObjv[i], &mapWin) != TCL_OK) { - ckfree((char *) cmapList); + ckfree(cmapList); return TCL_ERROR; } winPtr2 = (TkWindow *) mapWin; @@ -1601,7 +1613,7 @@ WmColormapwindowsCmd( wmPtr->flags |= WM_COLORMAPS_EXPLICIT; XSetWMColormapWindows(winPtr->display, wmPtr->wrapperPtr->window, cmapList, windowObjc); - ckfree((char *) cmapList); + ckfree(cmapList); return TCL_OK; } @@ -1628,12 +1640,12 @@ WmCommandCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; + const char *argv3; int cmdArgc; - CONST char **cmdArgv; + const char **cmdArgv; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?value?"); @@ -1641,16 +1653,17 @@ WmCommandCmd( } if (objc == 3) { if (wmPtr->cmdArgv != NULL) { - Tcl_SetResult(interp, - Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), - TCL_DYNAMIC); + char *arg = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); + + Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, -1)); + ckfree(arg); } return TCL_OK; } argv3 = Tcl_GetString(objv[3]); if (argv3[0] == 0) { if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + ckfree(wmPtr->cmdArgv); wmPtr->cmdArgv = NULL; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, @@ -1663,7 +1676,7 @@ WmCommandCmd( return TCL_ERROR; } if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + ckfree(wmPtr->cmdArgv); } wmPtr->cmdArgc = cmdArgc; wmPtr->cmdArgv = cmdArgv; @@ -1696,7 +1709,7 @@ WmDeiconifyCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; @@ -1705,13 +1718,17 @@ WmDeiconifyCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, - ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } wmPtr->flags &= ~WM_WITHDRAWN; @@ -1742,10 +1759,10 @@ WmFocusmodelCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "active", "passive", NULL }; enum options { OPT_ACTIVE, OPT_PASSIVE }; @@ -1756,13 +1773,13 @@ WmFocusmodelCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->hints.input ? "passive" : "active", -1)); return TCL_OK; } - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_ACTIVE) { @@ -1779,8 +1796,8 @@ WmFocusmodelCmd( * * WmForgetCmd -- * - * This procedure is invoked to process the "wm forget" Tcl command. - * See the user documentation for details on what it does. + * This procedure is invoked to process the "wm forget" Tcl command. See + * the user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -1792,12 +1809,12 @@ WmFocusmodelCmd( */ static int -WmForgetCmd(tkwin, winPtr, interp, objc, objv) - Tk_Window tkwin; /* Main window of the application. */ - TkWindow *winPtr; /* Toplevel or Frame to work with */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +WmForgetCmd( + Tk_Window tkwin, /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel or Frame to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register Tk_Window frameWin = (Tk_Window) winPtr; @@ -1805,13 +1822,19 @@ WmForgetCmd(tkwin, winPtr, interp, objc, objv) TkFocusJoin(winPtr); Tk_UnmapWindow(frameWin); TkWmDeadWindow(winPtr); - winPtr->flags &= ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); + winPtr->flags &= + ~(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED); RemapWindows(winPtr, winPtr->parentPtr); - /* flags (above) must be cleared before calling */ - /* TkMapTopFrame (below) */ + + /* + * Flags (above) must be cleared before calling TkMapTopFrame (below). + */ + TkMapTopFrame(frameWin); } else { - /* Already not managed by wm - ignore it */ + /* + * Already not managed by wm - ignore it. + */ } return TCL_OK; } @@ -1839,11 +1862,10 @@ WmFrameCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Window window; - char buf[TCL_INTEGER_SPACE]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -1853,8 +1875,7 @@ WmFrameCmd( if (window == None) { window = Tk_WindowId((Tk_Window) winPtr); } - sprintf(buf, "0x%x", (unsigned int) window); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", (unsigned) window)); return TCL_OK; } @@ -1881,20 +1902,18 @@ WmGeometryCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; char xSign, ySign; int width, height; - char *argv3; + const char *argv3; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?"); return TCL_ERROR; } if (objc == 3) { - char buf[16 + TCL_INTEGER_SPACE * 4]; - xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { @@ -1906,9 +1925,8 @@ WmGeometryCmd( width = winPtr->changes.width; height = winPtr->changes.height; } - sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x, - ySign, wmPtr->y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d%c%d%c%d", + width, height, xSign, wmPtr->x, ySign, wmPtr->y)); return TCL_OK; } argv3 = Tcl_GetString(objv[3]); @@ -1944,7 +1962,7 @@ WmGridCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int reqWidth, reqHeight, widthInc, heightInc; @@ -1956,12 +1974,13 @@ WmGridCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth); + results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight); + results[2] = Tcl_NewIntObj(wmPtr->widthInc); + results[3] = Tcl_NewIntObj(wmPtr->heightInc); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -1988,19 +2007,27 @@ WmGridCmd( return TCL_ERROR; } if (reqWidth < 0) { - Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "baseWidth can't be < 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (reqHeight < 0) { - Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "baseHeight can't be < 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (widthInc <= 0) { - Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widthInc can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (heightInc <= 0) { - Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "heightInc can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, @@ -2034,12 +2061,12 @@ WmGroupCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Tk_Window tkwin2; WmInfo *wmPtr2; - char *argv3; + const char *argv3; int length; if ((objc != 3) && (objc != 4)) { @@ -2048,7 +2075,7 @@ WmGroupCmd( } if (objc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->leaderName, -1)); } return TCL_OK; } @@ -2080,7 +2107,7 @@ WmGroupCmd( } wmPtr->hints.window_group = Tk_WindowId(wmPtr2->wrapperPtr); wmPtr->hints.flags |= WindowGroupHint; - wmPtr->leaderName = ckalloc((unsigned) length + 1); + wmPtr->leaderName = ckalloc(length + 1); strcpy(wmPtr->leaderName, argv3); } UpdateHints(winPtr); @@ -2110,11 +2137,11 @@ WmIconbitmapCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Pixmap pixmap; - char *argv3; + const char *argv3; if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); @@ -2122,9 +2149,9 @@ WmIconbitmapCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPixmapHint) { - Tcl_SetResult(interp, (char *) - Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tk_NameOfBitmap(winPtr->display, + wmPtr->hints.icon_pixmap), -1)); } return TCL_OK; } @@ -2170,37 +2197,47 @@ WmIconifyCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; + if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT", + NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL); return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an icon for %s", + winPtr->pathName, Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } if (TkpWmSetState(winPtr, IconicState) == 0) { - Tcl_SetResult(interp, - "couldn't send iconify message to window manager", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't send iconify message to window manager", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } return TCL_OK; @@ -2229,11 +2266,11 @@ WmIconmaskCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Pixmap pixmap; - char *argv3; + const char *argv3; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); @@ -2241,9 +2278,9 @@ WmIconmaskCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - Tcl_SetResult(interp, (char *) + Tcl_SetObjResult(interp, Tcl_NewStringObj( Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), - TCL_STATIC); + -1)); } return TCL_OK; } @@ -2288,10 +2325,10 @@ WmIconnameCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; + const char *argv3; int length; if (objc > 4) { @@ -2299,16 +2336,16 @@ WmIconnameCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, - ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), - TCL_STATIC); + if (wmPtr->iconName != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->iconName, -1)); + } return TCL_OK; } else { if (wmPtr->iconName != NULL) { - ckfree((char *) wmPtr->iconName); + ckfree(wmPtr->iconName); } argv3 = Tcl_GetStringFromObj(objv[3], &length); - wmPtr->iconName = ckalloc((unsigned) length + 1); + wmPtr->iconName = ckalloc(length + 1); strcpy(wmPtr->iconName, argv3); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { UpdateTitle(winPtr); @@ -2340,7 +2377,7 @@ WmIconphotoCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Tk_PhotoHandle photo; @@ -2370,8 +2407,10 @@ WmIconphotoCmd( for (i = 3 + isDefault; i < objc; i++) { photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { - Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]), - "\" as iconphoto: not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as iconphoto: not a photo image", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL); return TCL_ERROR; } Tk_PhotoGetSize(photo, &width, &height); @@ -2391,8 +2430,7 @@ WmIconphotoCmd( * defines CARD32 arrays to use. [Bug 2902814] */ - iconPropertyData = (unsigned long *) - attemptckalloc(sizeof(unsigned long) * size); + iconPropertyData = attemptckalloc(sizeof(unsigned long) * size); if (iconPropertyData == NULL) { return TCL_ERROR; } @@ -2422,14 +2460,12 @@ WmIconphotoCmd( * A, low byte being B. The first two cardinals are width, height. * Data is in rows, left to right and top to bottom. The data will be * endian-swapped going to the server if necessary. [Bug 2830420] + * + * The image data will be encoded in the iconPropertyData array. */ - /* - * Encode the image data in the iconPropertyData array. - */ - - iconPropertyData[index++] = (unsigned) width; - iconPropertyData[index++] = (unsigned) height; + iconPropertyData[index++] = (unsigned long) width; + iconPropertyData[index++] = (unsigned long) height; for (y = 0; y < height; y++) { for (x = 0; x < width; x++) { register unsigned char *pixelPtr = @@ -2445,12 +2481,12 @@ WmIconphotoCmd( } } if (wmPtr->iconDataPtr != NULL) { - ckfree((char *) wmPtr->iconDataPtr); + ckfree(wmPtr->iconDataPtr); wmPtr->iconDataPtr = NULL; } if (isDefault) { if (winPtr->dispPtr->iconDataPtr != NULL) { - ckfree((char *) winPtr->dispPtr->iconDataPtr); + ckfree(winPtr->dispPtr->iconDataPtr); } winPtr->dispPtr->iconDataPtr = (unsigned char *) iconPropertyData; winPtr->dispPtr->iconDataSize = size; @@ -2487,7 +2523,7 @@ WmIconpositionCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int x, y; @@ -2498,19 +2534,19 @@ WmIconpositionCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x); + results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } return TCL_OK; } - if (*Tcl_GetString(objv[3]) == '\0') { + if (Tcl_GetString(objv[3])[0] == '\0') { wmPtr->hints.flags &= ~IconPositionHint; } else { if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) - || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){ + || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) { return TCL_ERROR; } wmPtr->hints.icon_x = x; @@ -2544,7 +2580,7 @@ WmIconwindowCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; Tk_Window tkwin2; @@ -2557,7 +2593,7 @@ WmIconwindowCmd( } if (objc == 3) { if (wmPtr->icon != NULL) { - Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon)); } return TCL_OK; } @@ -2584,19 +2620,23 @@ WmIconwindowCmd( return TCL_ERROR; } if (!Tk_IsTopLevel(tkwin2)) { - Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), - " as icon window: not at top level", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as icon window: not at top level", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "INNER", NULL); return TCL_ERROR; } wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, Tcl_GetString(objv[3]), - " is already an icon for ", Tk_PathName(wmPtr2->iconFor), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is already an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "ICON", NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr; + wmPtr3->iconFor = NULL; wmPtr3->withdrawn = 1; wmPtr3->hints.initial_state = WithdrawnState; @@ -2624,9 +2664,10 @@ WmIconwindowCmd( if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(wmPtr2->wrapperPtr), Tk_ScreenNumber(tkwin2)) == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't send withdraw message to window manager", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } WaitForMapNotify((TkWindow *) tkwin2, 0); @@ -2641,8 +2682,8 @@ WmIconwindowCmd( * * WmManageCmd -- * - * This procedure is invoked to process the "wm manage" Tcl command. - * See the user documentation for details on what it does. + * This procedure is invoked to process the "wm manage" Tcl command. See + * the user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -2654,26 +2695,28 @@ WmIconwindowCmd( */ static int -WmManageCmd(tkwin, winPtr, interp, objc, objv) - Tk_Window tkwin; /* Main window of the application. */ - TkWindow *winPtr; /* Toplevel or Frame to work with */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +WmManageCmd( + Tk_Window tkwin, /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel or Frame to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register Tk_Window frameWin = (Tk_Window) winPtr; register WmInfo *wmPtr = winPtr->wmInfoPtr; if (!Tk_IsTopLevel(frameWin)) { if (!Tk_IsManageable(frameWin)) { - Tcl_AppendResult(interp, "window \"", - Tk_PathName(frameWin), "\" is not manageable: must be " - "a frame, labelframe or toplevel", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not manageable: must be a frame," + " labelframe or toplevel", Tk_PathName(frameWin))); + Tcl_SetErrorCode(interp, "TK", "WM", "MANAGE", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); Tk_UnmapWindow(frameWin); - winPtr->flags |= TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; + winPtr->flags |= + TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; if (wmPtr == NULL) { TkWmNewWindow(winPtr); TkWmMapWindow(winPtr); @@ -2682,11 +2725,16 @@ WmManageCmd(tkwin, winPtr, interp, objc, objv) wmPtr = winPtr->wmInfoPtr; winPtr->flags &= ~TK_MAPPED; RemapWindows(winPtr, wmPtr->wrapperPtr); - /* flags (above) must be set before calling */ - /* TkMapTopFrame (below) */ - TkMapTopFrame (frameWin); + + /* + * Flags (above) must be set before calling TkMapTopFrame (below). + */ + + TkMapTopFrame(frameWin); } else if (Tk_IsTopLevel(frameWin)) { - /* Already managed by wm - ignore it */ + /* + * Already managed by wm - ignore it. + */ } return TCL_OK; } @@ -2714,7 +2762,7 @@ WmMaxsizeCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; @@ -2724,11 +2772,12 @@ WmMaxsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMaxSize(wmPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -2772,7 +2821,7 @@ WmMinsizeCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; @@ -2782,10 +2831,11 @@ WmMinsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->minWidth); + results[1] = Tcl_NewIntObj(wmPtr->minHeight); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -2822,7 +2872,7 @@ WmOverrideredirectCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int boolean, curValue; XSetWindowAttributes atts; @@ -2833,7 +2883,7 @@ WmOverrideredirectCmd( } curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect; if (objc == 3) { - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(curValue)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) { @@ -2880,10 +2930,10 @@ WmPositionfromCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "program", "user", NULL }; enum options { OPT_PROGRAM, OPT_USER }; @@ -2894,18 +2944,21 @@ WmPositionfromCmd( return TCL_ERROR; } if (objc == 3) { + const char *sourceStr = ""; + if (wmPtr->sizeHintsFlags & USPosition) { - Tcl_SetResult(interp, "user", TCL_STATIC); + sourceStr = "user"; } else if (wmPtr->sizeHintsFlags & PPosition) { - Tcl_SetResult(interp, "program", TCL_STATIC); + sourceStr = "program"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1)); return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~(USPosition|PPosition); } else { - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_USER) { @@ -2944,12 +2997,12 @@ WmProtocolCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; register ProtocolHandler *protPtr, *prevPtr; Atom protocol; - char *cmd; + const char *cmd; int cmdLength; if ((objc < 3) || (objc > 5)) { @@ -2961,11 +3014,14 @@ WmProtocolCmd( * Return a list of all defined protocols for the window. */ + Tcl_Obj *resultObj = Tcl_NewObj(); + for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol),-1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); @@ -2977,7 +3033,8 @@ WmProtocolCmd( for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - Tcl_SetResult(interp, protPtr->command, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(protPtr->command, -1)); return TCL_OK; } } @@ -2989,8 +3046,9 @@ WmProtocolCmd( */ if (strcmp(Tcl_GetString(objv[3]), "_NET_WM_PING") == 0) { - Tcl_SetResult(interp, "may not alter handling of that protocol", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "may not alter handling of that protocol", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "PROTOCOL", "RESERVED", NULL); return TCL_ERROR; } @@ -3007,13 +3065,13 @@ WmProtocolCmd( } else { prevPtr->nextPtr = protPtr->nextPtr; } - Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(protPtr, TCL_DYNAMIC); break; } } cmd = Tcl_GetStringFromObj(objv[4], &cmdLength); if (cmdLength > 0) { - protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength)); + protPtr = ckalloc(HANDLER_SIZE(cmdLength)); protPtr->protocol = protocol; protPtr->nextPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr; @@ -3049,7 +3107,7 @@ WmResizableCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; int width, height; @@ -3059,12 +3117,11 @@ WmResizableCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", - (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE)); + results[1] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) @@ -3109,10 +3166,10 @@ WmSizefromCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "program", "user", NULL }; enum options { OPT_PROGRAM, OPT_USER }; @@ -3123,19 +3180,22 @@ WmSizefromCmd( return TCL_ERROR; } if (objc == 3) { + const char *sourceStr = ""; + if (wmPtr->sizeHintsFlags & USSize) { - Tcl_SetResult(interp, "user", TCL_STATIC); + sourceStr = "user"; } else if (wmPtr->sizeHintsFlags & PSize) { - Tcl_SetResult(interp, "program", TCL_STATIC); + sourceStr = "program"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1)); return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~(USSize|PSize); } else { - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_USER) { @@ -3174,10 +3234,10 @@ WmStackorderCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { TkWindow **windows, **window_ptr; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "isabove", "isbelow", NULL }; enum options { OPT_ISABOVE, OPT_ISBELOW }; @@ -3191,11 +3251,15 @@ WmStackorderCmd( if (objc == 3) { windows = TkWmStackorderToplevel(winPtr); if (windows != NULL) { + Tcl_Obj *resultObj = Tcl_NewObj(); + /* ASSERT: true [Bug 1789819]*/ for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + Tcl_NewStringObj((*window_ptr)->pathName, -1)); } - ckfree((char *) windows); + ckfree(windows); + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } } else { @@ -3209,20 +3273,24 @@ WmStackorderCmd( winPtr2 = (TkWindow *) relWin; if (!Tk_IsTopLevel(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", + winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "TOPLEVEL", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } @@ -3232,25 +3300,26 @@ WmStackorderCmd( */ windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); - if (windows == NULL) { - Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "TkWmStackorderToplevel failed", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; - } else { - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) { - index1 = (window_ptr - windows); - } - if (*window_ptr == winPtr2) { - index2 = (window_ptr - windows); - } + } + + for (window_ptr = windows; *window_ptr ; window_ptr++) { + if (*window_ptr == winPtr) { + index1 = (window_ptr - windows); + } + if (*window_ptr == winPtr2) { + index2 = (window_ptr - windows); } - /* ASSERT: index1 != -1 && index2 != -2 [Bug 1789819] */ - ckfree((char *) windows); } + /* ASSERT: index1 != -1 && index2 != -2 [Bug 1789819] */ + ckfree(windows); - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_ISABOVE) { @@ -3258,7 +3327,7 @@ WmStackorderCmd( } else { /* OPT_ISBELOW */ result = index1 < index2; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), result); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } return TCL_OK; @@ -3287,10 +3356,10 @@ WmStateCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - static CONST char *optionStrings[] = { + static const char *const optionStrings[] = { "normal", "iconic", "withdrawn", NULL }; enum options { OPT_NORMAL, OPT_ICONIC, OPT_WITHDRAWN }; @@ -3302,14 +3371,15 @@ WmStateCmd( } if (objc == 4) { if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't change state of ", - Tcl_GetString(objv[2]), ": it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -3318,42 +3388,53 @@ WmStateCmd( (void) TkpWmSetState(winPtr, NormalState); } else if (index == OPT_ICONIC) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", + "OVERRIDE_REDIRECT", NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "TRANSIENT", + NULL); return TCL_ERROR; } if (TkpWmSetState(winPtr, IconicState) == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't send iconify message to window manager", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } else { /* OPT_WITHDRAWN */ wmPtr->flags |= WM_WITHDRAWN; if (TkpWmSetState(winPtr, WithdrawnState) == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't send withdraw message to window manager", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } } else { + const char *state; + if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); + state = "icon"; } else if (wmPtr->withdrawn) { - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); + state = "withdrawn"; } else if (Tk_IsMapped((Tk_Window) winPtr) || ((wmPtr->flags & WM_NEVER_MAPPED) && (wmPtr->hints.initial_state == NormalState))) { - Tcl_SetResult(interp, "normal", TCL_STATIC); + state = "normal"; } else { - Tcl_SetResult(interp, "iconic", TCL_STATIC); + state = "iconic"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(state, -1)); } return TCL_OK; } @@ -3381,10 +3462,10 @@ WmTitleCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; + const char *argv3; int length; if (objc > 4) { @@ -3392,16 +3473,17 @@ WmTitleCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (char *) - ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), - TCL_STATIC); - return TCL_OK; + if (wmPtr->title) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->title, -1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewStringObj(winPtr->nameUid, -1)); + } } else { if (wmPtr->title != NULL) { - ckfree((char *) wmPtr->title); + ckfree(wmPtr->title); } argv3 = Tcl_GetStringFromObj(objv[3], &length); - wmPtr->title = ckalloc((unsigned) length + 1); + wmPtr->title = ckalloc(length + 1); strcpy(wmPtr->title, argv3); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { @@ -3434,7 +3516,7 @@ WmTransientCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; TkWindow *masterPtr = wmPtr->masterPtr; @@ -3446,7 +3528,7 @@ WmTransientCmd( } if (objc == 3) { if (masterPtr != NULL) { - Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) masterPtr)); } return TCL_OK; } @@ -3459,7 +3541,7 @@ WmTransientCmd( masterPtr->wmInfoPtr->numTransients--; Tk_DeleteEventHandler((Tk_Window) masterPtr, StructureNotifyMask, - WmWaitMapProc, (ClientData) winPtr); + WmWaitMapProc, winPtr); /* * FIXME: Need a call like Win32's UpdateWrapper() so we can @@ -3486,9 +3568,10 @@ WmTransientCmd( Tk_MakeWindowExist((Tk_Window) masterPtr); if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]), - "\" a transient: it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a transient: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } @@ -3498,15 +3581,17 @@ WmTransientCmd( } if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]), - "\" a master: it is an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a master: it is an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } if (masterPtr == winPtr) { - Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), - "\" its own master", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" its own master", Tk_PathName(winPtr))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL); return TCL_ERROR; } else if (masterPtr != wmPtr->masterPtr) { /* @@ -3518,13 +3603,12 @@ WmTransientCmd( if (wmPtr->masterPtr != NULL) { wmPtr->masterPtr->wmInfoPtr->numTransients--; Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, - StructureNotifyMask, - WmWaitMapProc, (ClientData) winPtr); + StructureNotifyMask, WmWaitMapProc, winPtr); } masterPtr->wmInfoPtr->numTransients++; Tk_CreateEventHandler((Tk_Window) masterPtr, - StructureNotifyMask, WmWaitMapProc, (ClientData) winPtr); + StructureNotifyMask, WmWaitMapProc, winPtr); wmPtr->masterPtr = masterPtr; } @@ -3532,9 +3616,10 @@ WmTransientCmd( if (!(wmPtr->flags & WM_NEVER_MAPPED)) { if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) { if (TkpWmSetState(winPtr, WithdrawnState) == 0) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't send withdraw message to window manager", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } else { @@ -3544,7 +3629,7 @@ WmTransientCmd( wmPtr->masterPtr->wmInfoPtr->wrapperPtr->window); } else { XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "WM_TRANSIENT_FOR")); + Tk_InternAtom((Tk_Window) winPtr,"WM_TRANSIENT_FOR")); } } } @@ -3574,7 +3659,7 @@ WmWithdrawCmd( TkWindow *winPtr, /* Toplevel to work with */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; @@ -3583,15 +3668,17 @@ WmWithdrawCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't withdraw %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL); return TCL_ERROR; } wmPtr->flags |= WM_WITHDRAWN; if (TkpWmSetState(winPtr, WithdrawnState) == 0) { - Tcl_SetResult(interp, - "couldn't send withdraw message to window manager", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't send withdraw message to window manager", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } return TCL_OK; @@ -3608,7 +3695,7 @@ WmUpdateGeom( TkWindow *winPtr) { if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } @@ -3623,7 +3710,7 @@ WmWaitMapProc( ClientData clientData, /* Pointer to window. */ XEvent *eventPtr) /* Information about event. */ { - TkWindow *winPtr = (TkWindow *) clientData; + TkWindow *winPtr = clientData; TkWindow *masterPtr = winPtr->wmInfoPtr->masterPtr; if (masterPtr == NULL) { @@ -3750,7 +3837,7 @@ Tk_SetGrid( wmPtr->sizeHintsFlags |= PBaseSize|PResizeInc; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } @@ -3818,7 +3905,7 @@ Tk_UnsetGrid( wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } @@ -4043,9 +4130,11 @@ ReparentEvent( Atom actualType; int actualFormat; unsigned long numItems, bytesAfter; - unsigned int dummy; + unsigned dummy; Tk_ErrorHandler handler; TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; + Atom WM_ROOT = Tk_InternAtom((Tk_Window) wrapperPtr, "__WM_ROOT"); + Atom SWM_ROOT = Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"); /* * Identify the root window for wrapperPtr. This is tricky because of @@ -4059,15 +4148,11 @@ ReparentEvent( wmPtr->vRoot = None; handler = Tk_CreateErrorHandler(wrapperPtr->display, -1,-1,-1, NULL,NULL); vrPtrPtr = &virtualRootPtr; /* Silence GCC warning */ - if (((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window, - Tk_InternAtom((Tk_Window) wrapperPtr, "__WM_ROOT"), 0, (long) 1, - False, XA_WINDOW, &actualType, &actualFormat, &numItems, - &bytesAfter, (unsigned char **) vrPtrPtr) == Success) + if ((GetWindowProperty(wrapperPtr, WM_ROOT, 1, XA_WINDOW, + &actualType, &actualFormat, &numItems, &bytesAfter, vrPtrPtr) && (actualType == XA_WINDOW)) - || ((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window, - Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"), 0, (long) 1, - False, XA_WINDOW, &actualType, &actualFormat, &numItems, - &bytesAfter, (unsigned char **) vrPtrPtr) == Success) + || (GetWindowProperty(wrapperPtr, SWM_ROOT, 1, XA_WINDOW, + &actualType, &actualFormat, &numItems, &bytesAfter, vrPtrPtr) && (actualType == XA_WINDOW))) { if ((actualFormat == 32) && (numItems == 1)) { vRoot = wmPtr->vRoot = *virtualRootPtr; @@ -4083,7 +4168,7 @@ ReparentEvent( if (dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("ReparentEvent: %s (%p) reparented to 0x%x, vRoot = 0x%x\n", wmPtr->winPtr->pathName, wmPtr->winPtr, - (unsigned int) reparentEventPtr->parent, (unsigned int) vRoot); + (unsigned) reparentEventPtr->parent, (unsigned) vRoot); } /* @@ -4170,7 +4255,7 @@ ComputeReparentGeometry( { TkWindow *wrapperPtr = wmPtr->wrapperPtr; int width, height, bd; - unsigned int dummy; + unsigned dummy; int xOffset, yOffset, x, y; Window dummy2; Status status; @@ -4181,8 +4266,8 @@ ComputeReparentGeometry( (void) XTranslateCoordinates(wrapperPtr->display, wrapperPtr->window, wmPtr->reparent, 0, 0, &xOffset, &yOffset, &dummy2); status = XGetGeometry(wrapperPtr->display, wmPtr->reparent, - &dummy2, &x, &y, (unsigned int *) &width, - (unsigned int *) &height, (unsigned int *) &bd, &dummy); + &dummy2, &x, &y, (unsigned *) &width, (unsigned *) &height, + (unsigned *) &bd, &dummy); Tk_DeleteErrorHandler(handler); if (status == 0) { /* @@ -4279,11 +4364,9 @@ PropertyEvent( unsigned char *propertyValue = 0; long maxLength = 1024; - if (XGetWindowProperty( - wrapperPtr->display, wrapperPtr->window, _NET_WM_STATE, - 0l, maxLength, False, XA_ATOM, + if (GetWindowProperty(wrapperPtr, _NET_WM_STATE, maxLength, XA_ATOM, &actualType, &actualFormat, &numItems, &bytesAfter, - &propertyValue) == Success) { + &propertyValue)) { CheckNetWmState(wmPtr, (Atom *) propertyValue, (int) numItems); XFree(propertyValue); } @@ -4308,15 +4391,15 @@ PropertyEvent( *---------------------------------------------------------------------- */ -static const unsigned int WrapperEventMask = - (StructureNotifyMask | PropertyChangeMask); +static const unsigned WrapperEventMask = + (StructureNotifyMask | PropertyChangeMask); static void WrapperEventProc( ClientData clientData, /* Information about toplevel window. */ XEvent *eventPtr) /* Event that just happened. */ { - WmInfo *wmPtr = (WmInfo *) clientData; + WmInfo *wmPtr = clientData; XEvent mapEvent; TkDisplay *dispPtr = wmPtr->winPtr->dispPtr; @@ -4403,10 +4486,11 @@ TopLevelReqProc( Tk_Window tkwin) /* Information about window. */ { TkWindow *winPtr = (TkWindow *) tkwin; - WmInfo *wmPtr; + WmInfo *wmPtr = winPtr->wmInfoPtr; - if ((wmPtr = winPtr->wmInfoPtr) == NULL) + if (wmPtr == NULL) { return; + } if ((wmPtr->width >= 0) && (wmPtr->height >= 0)) { /* @@ -4426,7 +4510,7 @@ TopLevelReqProc( wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } @@ -4465,7 +4549,7 @@ static void UpdateGeometryInfo( ClientData clientData) /* Pointer to the window's record. */ { - register TkWindow *winPtr = (TkWindow *) clientData; + register TkWindow *winPtr = clientData; register WmInfo *wmPtr = winPtr->wmInfoPtr; int x, y, width, height, min, max; unsigned long serial; @@ -4583,7 +4667,7 @@ UpdateGeometryInfo( if (((width != winPtr->changes.width) || (height != winPtr->changes.height)) && (wmPtr->gridWin == NULL) - && ((wmPtr->sizeHintsFlags & (PMinSize|PMaxSize)) == 0)) { + && !(wmPtr->sizeHintsFlags & (PMinSize|PMaxSize))) { wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) { @@ -4594,7 +4678,7 @@ UpdateGeometryInfo( * Reconfigure the wrapper if it isn't already configured correctly. A few * tricky points: * - * 1. If the window is embeddedand the container is also in this process, + * 1. If the window is embedded and the container is also in this process, * don't actually reconfigure the window; just pass the desired size on * to the container. Also, zero out any position information, since * embedded windows are not allowed to move. @@ -4635,7 +4719,7 @@ UpdateGeometryInfo( height += wmPtr->menuHeight; if (wmPtr->flags & WM_MOVE_PENDING) { if ((x + wmPtr->xInParent == winPtr->changes.x) && - (y + wmPtr->yInParent + wmPtr->menuHeight == winPtr->changes.y) + (y+wmPtr->yInParent+wmPtr->menuHeight == winPtr->changes.y) && (width == wmPtr->wrapperPtr->changes.width) && (height == wmPtr->wrapperPtr->changes.height)) { /* @@ -4841,10 +4925,8 @@ UpdateTitle( Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_NAME"), - XA_UTF8_STRING, 8, PropModeReplace, - (const unsigned char *) string, (signed int) strlen(string)); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_NAME", XA_UTF8_STRING, 8, + string, strlen(string)); /* * Set icon name: @@ -4856,11 +4938,8 @@ UpdateTitle( Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_ICON_NAME"), - XA_UTF8_STRING, 8, PropModeReplace, - (const unsigned char *) wmPtr->iconName, - (signed int) strlen(wmPtr->iconName)); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_ICON_NAME", + XA_UTF8_STRING, 8, wmPtr->iconName, strlen(wmPtr->iconName)); } } @@ -4891,14 +4970,8 @@ UpdatePhotoIcon( size = winPtr->dispPtr->iconDataSize; } if (data != NULL) { - /* - * Set icon: - */ - - XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_ICON"), - XA_CARDINAL, 32, PropModeReplace, - (unsigned char *) data, size); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_ICON", XA_CARDINAL, 32, + data, size); } } @@ -5039,11 +5112,10 @@ UpdateNetWmState( atoms[numAtoms++] = Tk_InternAtom(tkwin, "_NET_WM_STATE_FULLSCREEN"); } - XChangeProperty(Tk_Display(tkwin), wmPtr->wrapperPtr->window, - Tk_InternAtom(tkwin, "_NET_WM_STATE"), XA_ATOM, 32, - PropModeReplace, (unsigned char *) atoms, numAtoms); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_STATE", XA_ATOM, 32, atoms, + numAtoms); } - + /* *---------------------------------------------------------------------- * @@ -5158,8 +5230,8 @@ WaitForEvent( XEvent *eventPtr) /* Place to store event. */ { WaitRestrictInfo info; - Tk_RestrictProc *oldRestrictProc; - ClientData oldRestrictData; + Tk_RestrictProc *prevProc; + ClientData prevArg; Tcl_Time timeout; /* @@ -5173,8 +5245,7 @@ WaitForEvent( info.type = type; info.eventPtr = eventPtr; info.foundEvent = 0; - oldRestrictProc = Tk_RestrictEvents(WaitRestrictProc, (ClientData) &info, - &oldRestrictData); + prevProc = Tk_RestrictEvents(WaitRestrictProc, &info, &prevArg); Tcl_GetTime(&timeout); timeout.sec += 2; @@ -5184,8 +5255,7 @@ WaitForEvent( break; } } - (void) Tk_RestrictEvents(oldRestrictProc, oldRestrictData, - &oldRestrictData); + Tk_RestrictEvents(prevProc, prevArg, &prevArg); if (info.foundEvent) { return TCL_OK; } @@ -5218,7 +5288,7 @@ WaitRestrictProc( ClientData clientData, /* Pointer to WaitRestrictInfo structure. */ XEvent *eventPtr) /* Event that is about to be handled. */ { - WaitRestrictInfo *infoPtr = (WaitRestrictInfo *) clientData; + WaitRestrictInfo *infoPtr = clientData; if (eventPtr->type == ReparentNotify) { return TK_PROCESS_EVENT; @@ -5343,25 +5413,26 @@ UpdateHints( * * SetNetWmType -- * - * Set the extended window manager hints for a toplevel window - * to the types provided. The specification states that this - * may be a list of window types in preferred order. To permit - * for future type definitions, the set of names is unconstrained - * and names are converted to upper-case and appended to - * "_NET_WM_WINDOW_TYPE_" before being converted to an Atom. + * Set the extended window manager hints for a toplevel window to the + * types provided. The specification states that this may be a list of + * window types in preferred order. To permit for future type + * definitions, the set of names is unconstrained and names are converted + * to upper-case and appended to "_NET_WM_WINDOW_TYPE_" before being + * converted to an Atom. * *---------------------------------------------------------------------- */ static int -SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr) +SetNetWmType( + TkWindow *winPtr, + Tcl_Obj *typePtr) { - Atom typeAtom, *atoms = NULL; + Atom *atoms = NULL; WmInfo *wmPtr; - TkWindow *wrapperPtr; Tcl_Obj **objv; int objc, n; - Tk_Window tkwin = (Tk_Window)winPtr; + Tk_Window tkwin = (Tk_Window) winPtr; Tcl_Interp *interp = Tk_Interp(tkwin); if (TCL_OK != Tcl_ListObjGetElements(interp, typePtr, &objc, &objv)) { @@ -5373,13 +5444,14 @@ SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr) } if (objc > 0) { - atoms = (Atom *)ckalloc(sizeof(Atom) * objc); + atoms = ckalloc(sizeof(Atom) * objc); } for (n = 0; n < objc; ++n) { Tcl_DString ds, dsName; int len; char *name = Tcl_GetStringFromObj(objv[n], &len); + Tcl_UtfToUpper(name); Tcl_UtfToExternalDString(NULL, name, len, &dsName); Tcl_DStringInit(&ds); @@ -5395,13 +5467,11 @@ SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr) if (wmPtr->wrapperPtr == NULL) { CreateWrapper(wmPtr); } - wrapperPtr = wmPtr->wrapperPtr; - typeAtom = Tk_InternAtom(tkwin, "_NET_WM_WINDOW_TYPE"); - XChangeProperty(Tk_Display(tkwin), wrapperPtr->window, typeAtom, - XA_ATOM, 32, PropModeReplace, (unsigned char *) atoms, objc); + SetWindowProperty(wmPtr->wrapperPtr, "_NET_WM_WINDOW_TYPE", XA_ATOM, 32, + atoms, objc); - ckfree((char *)atoms); + ckfree(atoms); return TCL_OK; } @@ -5410,22 +5480,22 @@ SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr) * * GetNetWmType -- * - * Read the extended window manager type hint from a window - * and return as a list of names suitable for use with - * SetNetWmType. + * Read the extended window manager type hint from a window and return as + * a list of names suitable for use with SetNetWmType. * *---------------------------------------------------------------------- */ static Tcl_Obj * -GetNetWmType(TkWindow *winPtr) +GetNetWmType( + TkWindow *winPtr) { Atom typeAtom, actualType, *atoms; int actualFormat; unsigned long n, count, bytesAfter; unsigned char *propertyValue = NULL; long maxLength = 1024; - Tk_Window tkwin = (Tk_Window)winPtr; + Tk_Window tkwin = (Tk_Window) winPtr; TkWindow *wrapperPtr; Tcl_Obj *typePtr; Tcl_Interp *interp; @@ -5440,13 +5510,12 @@ GetNetWmType(TkWindow *winPtr) wrapperPtr = winPtr->wmInfoPtr->wrapperPtr; typeAtom = Tk_InternAtom(tkwin, "_NET_WM_WINDOW_TYPE"); - if (Success == XGetWindowProperty(wrapperPtr->display, - wrapperPtr->window, typeAtom, 0L, maxLength, False, - XA_ATOM, &actualType, &actualFormat, &count, - &bytesAfter, &propertyValue)) { - atoms = (Atom *)propertyValue; + if (GetWindowProperty(wrapperPtr, typeAtom, maxLength, XA_ATOM, + &actualType, &actualFormat, &count, &bytesAfter, &propertyValue)){ + atoms = (Atom *) propertyValue; for (n = 0; n < count; ++n) { const char *name = Tk_GetAtomName(tkwin, atoms[n]); + if (strncmp("_NET_WM_WINDOW_TYPE_", name, 20) == 0) { Tcl_ExternalToUtfDString(NULL, name+20, -1, &ds); Tcl_UtfToLower(Tcl_DStringValue(&ds)); @@ -5483,7 +5552,7 @@ GetNetWmType(TkWindow *winPtr) static int ParseGeometry( Tcl_Interp *interp, /* Used for error reporting. */ - char *string, /* String containing new geometry. Has the + const char *string, /* String containing new geometry. Has the * standard form "=wxh+x+y". */ TkWindow *winPtr) /* Pointer to top-level window whose geometry * is to be changed. */ @@ -5491,7 +5560,7 @@ ParseGeometry( register WmInfo *wmPtr = winPtr->wmInfoPtr; int x, y, width, height, flags; char *end; - register char *p = string; + register const char *p = string; /* * The leading "=" is optional. @@ -5564,7 +5633,7 @@ ParseGeometry( * them. */ - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; flags |= WM_UPDATE_SIZE_HINTS; } @@ -5584,13 +5653,15 @@ ParseGeometry( wmPtr->flags = flags; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } return TCL_OK; error: - Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad geometry specifier \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GEOMETRY", NULL); return TCL_ERROR; } @@ -5916,7 +5987,7 @@ UpdateVRootGeometry( { TkWindow *winPtr = wmPtr->winPtr; int bd; - unsigned int dummy; + unsigned dummy; Window dummy2; Status status; Tk_ErrorHandler handler; @@ -5942,8 +6013,8 @@ UpdateVRootGeometry( handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, NULL, NULL); status = XGetGeometry(winPtr->display, wmPtr->vRoot, &dummy2, &wmPtr->vRootX, &wmPtr->vRootY, - (unsigned int *) &wmPtr->vRootWidth, - (unsigned int *) &wmPtr->vRootHeight, (unsigned int *) &bd, + (unsigned *) &wmPtr->vRootWidth, + (unsigned *) &wmPtr->vRootHeight, (unsigned *) &bd, &dummy); if (winPtr->dispPtr->flags & TK_DISPLAY_WM_TRACING) { printf("UpdateVRootGeometry: x = %d, y = %d, width = %d, ", @@ -6061,7 +6132,7 @@ Tk_MoveToplevelWindow( wmPtr->y = y; wmPtr->flags |= WM_MOVE_PENDING; wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y); - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; } @@ -6074,9 +6145,9 @@ Tk_MoveToplevelWindow( if (!(wmPtr->flags & WM_NEVER_MAPPED)) { if (wmPtr->flags & WM_UPDATE_PENDING) { - Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); } - UpdateGeometryInfo((ClientData) winPtr); + UpdateGeometryInfo(winPtr); } } @@ -6119,7 +6190,7 @@ UpdateWmProtocols( protPtr = protPtr->nextPtr, count++) { /* Empty loop body; we're just counting the handlers. */ } - arrayPtr = (Atom *) ckalloc((unsigned) count * sizeof(Atom)); + arrayPtr = ckalloc(count * sizeof(Atom)); deleteWindowAtom = Tk_InternAtom((Tk_Window) wmPtr->winPtr, "WM_DELETE_WINDOW"); pingAtom = Tk_InternAtom((Tk_Window) wmPtr->winPtr, "_NET_WM_PING"); @@ -6132,11 +6203,9 @@ UpdateWmProtocols( *(atomPtr++) = protPtr->protocol; } } - XChangeProperty(wmPtr->winPtr->display, wmPtr->wrapperPtr->window, - Tk_InternAtom((Tk_Window) wmPtr->winPtr, "WM_PROTOCOLS"), - XA_ATOM, 32, PropModeReplace, (unsigned char *) arrayPtr, - atomPtr-arrayPtr); - ckfree((char *) arrayPtr); + SetWindowProperty(wmPtr->wrapperPtr, "WM_PROTOCOLS", XA_ATOM, 32, + arrayPtr, atomPtr-arrayPtr); + ckfree(arrayPtr); } /* @@ -6166,7 +6235,7 @@ TkWmProtocolEventProc( register ProtocolHandler *protPtr; Atom protocol; int result; - CONST char *protocolName; + const char *protocolName; Tcl_Interp *interp; protocol = (Atom) eventPtr->xclient.data.l[0]; @@ -6203,19 +6272,18 @@ TkWmProtocolEventProc( for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protocol == protPtr->protocol) { - Tcl_Preserve((ClientData) protPtr); + Tcl_Preserve(protPtr); interp = protPtr->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL); if (result != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n (command for \""); - Tcl_AddErrorInfo(interp, protocolName); - Tcl_AddErrorInfo(interp, - "\" window manager protocol)"); - Tcl_BackgroundError(interp); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (command for \"%s\" window manager protocol)", + protocolName)); + Tcl_BackgroundException(interp, result); } - Tcl_Release((ClientData) interp); - Tcl_Release((ClientData) protPtr); + Tcl_Release(interp); + Tcl_Release(protPtr); return; } } @@ -6300,7 +6368,7 @@ TkWmStackorderToplevel( { Window dummy1, dummy2, vRoot; Window *children; - unsigned int numChildren, i; + unsigned numChildren, i; TkWindow *childWinPtr, **windows, **window_ptr; Tcl_HashTable table; Tcl_HashEntry *hPtr; @@ -6313,8 +6381,7 @@ TkWmStackorderToplevel( Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS); TkWmStackorderToplevelWrapperMap(parentPtr, parentPtr->display, &table); - window_ptr = windows = (TkWindow **) - ckalloc((table.numEntries+1) * sizeof(TkWindow *)); + window_ptr = windows = ckalloc((table.numEntries+1) * sizeof(TkWindow *)); /* * Special cases: If zero or one toplevels were mapped there is no need to @@ -6327,7 +6394,7 @@ TkWmStackorderToplevel( goto done; case 1: hPtr = Tcl_FirstHashEntry(&table, &search); - windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr); + windows[0] = Tcl_GetHashValue(hPtr); windows[1] = NULL; goto done; } @@ -6339,19 +6406,22 @@ TkWmStackorderToplevel( if (XQueryTree(parentPtr->display, vRoot, &dummy1, &dummy2, &children, &numChildren) == 0) { - ckfree((char *) windows); + ckfree(windows); windows = NULL; } else { for (i = 0; i < numChildren; i++) { hPtr = Tcl_FindHashEntry(&table, (char *) children[i]); if (hPtr != NULL) { - childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr); + childWinPtr = Tcl_GetHashValue(hPtr); *window_ptr++ = childWinPtr; } } - /* ASSERT: window_ptr - windows == table.numEntries + + /* + * ASSERT: window_ptr - windows == table.numEntries * (#matched toplevel windows == #children) [Bug 1789819] */ + *window_ptr = NULL; if (numChildren) { XFree((char *) children); @@ -6389,7 +6459,7 @@ TkWmRestackToplevel( * below *all* siblings. */ { XWindowChanges changes; - unsigned int mask; + unsigned mask; TkWindow *wrapperPtr; memset(&changes, 0, sizeof(XWindowChanges)); @@ -6515,7 +6585,7 @@ TkWmAddToColormapWindows( * add the toplevel itself as the last element of the list. */ - newPtr = (Window *) ckalloc((unsigned) (count+2) * sizeof(Window)); + newPtr = ckalloc((count+2) * sizeof(Window)); for (i = 0; i < count; i++) { newPtr[i] = oldPtr[i]; } @@ -6526,7 +6596,7 @@ TkWmAddToColormapWindows( newPtr[count] = topPtr->window; XSetWMColormapWindows(topPtr->display, wrapperPtr->window, newPtr, count+1); - ckfree((char *) newPtr); + ckfree(newPtr); if (oldPtr != NULL) { XFree((char *) oldPtr); } @@ -6656,7 +6726,7 @@ TkGetPointerCoords( WmInfo *wmPtr; Window w, root, child; int rootX, rootY; - unsigned int mask; + unsigned mask; wmPtr = winPtr->wmInfoPtr; @@ -6772,8 +6842,8 @@ TkSetTransientFor(Tk_Window tkwin, Tk_Window parent) * * TkpMakeMenuWindow -- * - * Configure the window to be either a pull-down (or pop-up) menu, or as - * a toplevel (torn-off) menu or palette. + * Configure the window to be either a pull-down menu, a pop-up menu, or + * as a toplevel (torn-off) menu or palette. * * Results: * None. @@ -6787,11 +6857,14 @@ TkSetTransientFor(Tk_Window tkwin, Tk_Window parent) void TkpMakeMenuWindow( Tk_Window tkwin, /* New window. */ - int transient) /* 1 means menu is only posted briefly as a - * popup or pulldown or cascade. 0 means menu - * is always visible, e.g. as a torn-off menu. + int typeFlag) /* TK_MAKE_MENU_DROPDOWN means menu is only + * posted briefly as a pulldown or cascade, + * TK_MAKE_MENU_POPUP means it is a popup. + * TK_MAKE_MENU_TEAROFF means menu is always + * visible, e.g. as a torn-off menu. * Determines whether save_under and - * override_redirect should be set. */ + * override_redirect should be set, plus how + * to flag it for the window manager. */ { WmInfo *wmPtr; XSetWindowAttributes atts; @@ -6806,15 +6879,19 @@ TkpMakeMenuWindow( CreateWrapper(wmPtr); } wrapperPtr = wmPtr->wrapperPtr; - if (transient) { - atts.override_redirect = True; - atts.save_under = True; - typeObj = Tcl_NewStringObj("dropdown_menu", -1); - } else { + if (typeFlag == TK_MAKE_MENU_TEAROFF) { atts.override_redirect = False; atts.save_under = False; typeObj = Tcl_NewStringObj("menu", -1); - TkSetTransientFor(tkwin, None); + TkSetTransientFor(tkwin, NULL); + } else { + atts.override_redirect = True; + atts.save_under = True; + if (typeFlag == TK_MAKE_MENU_DROPDOWN) { + typeObj = Tcl_NewStringObj("dropdown_menu", -1); + } else { + typeObj = Tcl_NewStringObj("popup_menu", -1); + } } SetNetWmType((TkWindow *)tkwin, typeObj); @@ -6927,7 +7004,7 @@ CreateWrapper( */ Tk_CreateEventHandler((Tk_Window) wmPtr->wrapperPtr, - WrapperEventMask, WrapperEventProc, (ClientData) wmPtr); + WrapperEventMask, WrapperEventProc, wmPtr); } /* @@ -6996,9 +7073,13 @@ TkUnixSetMenubar( Tk_Window parent; TkWindow *menubarPtr = (TkWindow *) menubar; - /* Could be a Frame (i.e. not a toplevel) */ - if (wmPtr == NULL) + /* + * Could be a Frame (i.e. not a toplevel). + */ + + if (wmPtr == NULL) { return; + } if (wmPtr->menubar != NULL) { /* @@ -7020,7 +7101,7 @@ TkUnixSetMenubar( Tk_WindowId(wmPtr->menubar), Tk_WindowId(parent), 0, 0); } Tk_DeleteEventHandler(wmPtr->menubar, StructureNotifyMask, - MenubarDestroyProc, (ClientData) wmPtr->menubar); + MenubarDestroyProc, wmPtr->menubar); Tk_ManageGeometry(wmPtr->menubar, NULL, NULL); } @@ -7046,14 +7127,14 @@ TkUnixSetMenubar( menubarPtr->wmInfoPtr = wmPtr; Tk_MoveResizeWindow(menubar, 0, 0, Tk_Width(tkwin), wmPtr->menuHeight); Tk_MapWindow(menubar); - Tk_CreateEventHandler(menubar, StructureNotifyMask, MenubarDestroyProc, - (ClientData) menubar); - Tk_ManageGeometry(menubar, &menubarMgrType, (ClientData) wmPtr); + Tk_CreateEventHandler(menubar, StructureNotifyMask, + MenubarDestroyProc, menubar); + Tk_ManageGeometry(menubar, &menubarMgrType, wmPtr); menubarPtr->flags |= TK_REPARENTED; } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) tkwin); + Tcl_DoWhenIdle(UpdateGeometryInfo, tkwin); wmPtr->flags |= WM_UPDATE_PENDING; } } @@ -7092,7 +7173,7 @@ MenubarDestroyProc( wmPtr->menuHeight = 0; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) wmPtr->winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, wmPtr->winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } @@ -7120,7 +7201,7 @@ MenubarReqProc( * for tkwin's toplevel. */ Tk_Window tkwin) /* Handle for menubar window. */ { - WmInfo *wmPtr = (WmInfo *) clientData; + WmInfo *wmPtr = clientData; wmPtr->menuHeight = Tk_ReqHeight(tkwin); if (wmPtr->menuHeight <= 0) { @@ -7128,7 +7209,7 @@ MenubarReqProc( } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) wmPtr->winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, wmPtr->winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } @@ -7202,8 +7283,8 @@ UpdateCommand( * entire DString is done. */ - cmdArgv = (char **) ckalloc(sizeof(char *) * wmPtr->cmdArgc); - offsets = (int *) ckalloc(sizeof(int) * wmPtr->cmdArgc); + cmdArgv = ckalloc(sizeof(char *) * wmPtr->cmdArgc); + offsets = ckalloc(sizeof(int) * wmPtr->cmdArgc); Tcl_DStringInit(&cmds); for (i = 0; i < wmPtr->cmdArgc; i++) { Tcl_UtfToExternalDString(NULL, wmPtr->cmdArgv[i], -1, &ds); @@ -7220,8 +7301,8 @@ UpdateCommand( XSetCommand(winPtr->display, wmPtr->wrapperPtr->window, cmdArgv, wmPtr->cmdArgc); Tcl_DStringFree(&cmds); - ckfree((char *) cmdArgv); - ckfree((char *) offsets); + ckfree(cmdArgv); + ckfree(offsets); } /* @@ -7294,22 +7375,21 @@ TkpWmSetState( * * RemapWindows * - * Adjust parent/child relation ships of - * the given window hierarchy. + * Adjust parent/child relationships of the given window hierarchy. * * Results: - * none + * None * * Side effects: - * keeps windowing system (X11) happy + * Keeps windowing system (X11) happy * *---------------------------------------------------------------------- */ static void -RemapWindows(winPtr, parentPtr) - TkWindow *winPtr; - TkWindow *parentPtr; +RemapWindows( + TkWindow *winPtr, + TkWindow *parentPtr) { XWindowAttributes win_attr; @@ -7317,7 +7397,7 @@ RemapWindows(winPtr, parentPtr) XGetWindowAttributes(winPtr->display, winPtr->window, &win_attr); if (parentPtr == NULL) { XReparentWindow(winPtr->display, winPtr->window, - XRootWindow(winPtr->display, winPtr->screenNum), + XRootWindow(winPtr->display, winPtr->screenNum), win_attr.x, win_attr.y); } else if (parentPtr->window) { XReparentWindow(parentPtr->display, winPtr->window, diff --git a/unix/tkUnixXId.c b/unix/tkUnixXId.c index 444be30..668f228 100644 --- a/unix/tkUnixXId.c +++ b/unix/tkUnixXId.c @@ -1,15 +1,6 @@ /* * tkUnixXId.c -- * - * This file provides a replacement function for the default X resource - * allocator (_XAllocID). The problem with the default allocator is that - * it never re-uses ids, which causes long-lived applications to crash - * when X resource identifiers wrap around. The replacement functions in - * this file re-use old identifiers to prevent this problem. - * - * The code in this file is based on similar implementations by - * George C. Kaplan and Michael Hoegeman. - * * Copyright (c) 1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * @@ -17,170 +8,8 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -/* - * The definition below is needed on some systems so that we can access the - * resource_alloc field of Display structures in order to replace the resource - * allocator. - */ - -#define XLIB_ILLEGAL_ACCESS 1 - #include "tkUnixInt.h" -/* - * A structure of the following type is used to hold one or more available - * resource identifiers. There is a list of these structures for each display. - */ - -#define IDS_PER_STACK 10 -typedef struct TkIdStack { - XID ids[IDS_PER_STACK]; /* Array of free identifiers. */ - int numUsed; /* Indicates how many of the entries in ids - * are currently in use. */ - TkDisplay *dispPtr; /* Display to which ids belong. */ - struct TkIdStack *nextPtr; /* Next bunch of free identifiers for the same - * display. */ -} TkIdStack; - -/* - * Forward declarations for functions defined in this file: - */ - -static XID AllocXId(Display *display); -static Tk_RestrictAction CheckRestrictProc(ClientData clientData, - XEvent *eventPtr); -static void WindowIdCleanup(ClientData clientData); -static void WindowIdCleanup2(ClientData clientData); - -/* - *---------------------------------------------------------------------- - * - * TkInitXId -- - * - * This function is called to initialize the id allocator for a given - * display. - * - * Results: - * None. - * - * Side effects: - * The official allocator for the display is set up to be AllocXId. - * - *---------------------------------------------------------------------- - */ - -void -TkInitXId( - TkDisplay *dispPtr) /* Tk's information about the display. */ -{ - dispPtr->idStackPtr = NULL; - dispPtr->defaultAllocProc = (XID (*) (Display *display)) - dispPtr->display->resource_alloc; - dispPtr->display->resource_alloc = AllocXId; - dispPtr->windowStackPtr = NULL; - dispPtr->idCleanupScheduled = (Tcl_TimerToken) 0; -} - -/* - *---------------------------------------------------------------------- - * - * TkFreeXId -- - * - * This function is called to free resources for the id allocator for a - * given display. - * - * Results: - * None. - * - * Side effects: - * Frees the id and window stack pools. - * - *---------------------------------------------------------------------- - */ - -void -TkFreeXId( - TkDisplay *dispPtr) /* Tk's information about the display. */ -{ - TkIdStack *stackPtr, *freePtr; - - if (dispPtr->idCleanupScheduled) { - Tcl_DeleteTimerHandler(dispPtr->idCleanupScheduled); - } - - for (stackPtr = dispPtr->idStackPtr; stackPtr != NULL; ) { - freePtr = stackPtr; - stackPtr = stackPtr->nextPtr; - ckfree((char *) freePtr); - } - dispPtr->idStackPtr = NULL; - - for (stackPtr = dispPtr->windowStackPtr; stackPtr != NULL; ) { - freePtr = stackPtr; - stackPtr = stackPtr->nextPtr; - ckfree((char *) freePtr); - } - dispPtr->windowStackPtr = NULL; -} - -/* - *---------------------------------------------------------------------- - * - * AllocXId -- - * - * This function is invoked by Xlib as the resource allocator for a - * display. - * - * Results: - * The return value is an X resource identifier that isn't currently in - * use. - * - * Side effects: - * The identifier is removed from the stack of free identifiers, if it - * was previously on the stack. - * - *---------------------------------------------------------------------- - */ - -static XID -AllocXId( - Display *display) /* Display for which to allocate. */ -{ - TkDisplay *dispPtr; - TkIdStack *stackPtr; - - /* - * Find Tk's information about the display. - */ - - dispPtr = TkGetDisplay(display); - - /* - * If the topmost chunk on the stack is empty then free it. Then check for - * a free id on the stack and return it if it exists. - */ - - stackPtr = dispPtr->idStackPtr; - if (stackPtr != NULL) { - while (stackPtr->numUsed == 0) { - dispPtr->idStackPtr = stackPtr->nextPtr; - ckfree((char *) stackPtr); - stackPtr = dispPtr->idStackPtr; - if (stackPtr == NULL) { - goto defAlloc; - } - } - stackPtr->numUsed--; - return stackPtr->ids[stackPtr->numUsed]; - } - - /* - * No free ids in the stack: just get one from the default allocator. - */ - - defAlloc: - return (*dispPtr->defaultAllocProc)(display); -} /* *---------------------------------------------------------------------- @@ -205,268 +34,15 @@ Tk_FreeXId( Display *display, /* Display for which xid was allocated. */ XID xid) /* Identifier that is no longer in use. */ { - TkDisplay *dispPtr; - TkIdStack *stackPtr; - - /* - * Find Tk's information about the display. - */ - - dispPtr = TkGetDisplay(display); - - /* - * Add a new chunk to the stack if the current chunk is full. - */ - - stackPtr = dispPtr->idStackPtr; - if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) { - stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack)); - stackPtr->numUsed = 0; - stackPtr->dispPtr = dispPtr; - stackPtr->nextPtr = dispPtr->idStackPtr; - dispPtr->idStackPtr = stackPtr; - } - - /* - * Add the id to the current chunk. - */ - - stackPtr->ids[stackPtr->numUsed] = xid; - stackPtr->numUsed++; -} - -/* - *---------------------------------------------------------------------- - * - * TkFreeWindowId -- - * - * This function is invoked instead of TkFreeXId for window ids. See - * below for the reason why. - * - * Results: - * None. - * - * Side effects: - * The id given by w will eventually be freed, so that it can be reused - * for other resources. - * - * Design: - * Freeing window ids is very tricky because there could still be events - * pending for a window in the event queue (or even in the server) at the - * time the window is destroyed. If the window id were to get reused - * immediately for another window, old events could "drop in" on the new - * window, causing unexpected behavior. - * - * Thus we have to wait to re-use a window id until we know that there - * are no events left for it. Right now this is done in two steps. First, - * we wait until we know that the server has seen the XDestroyWindow - * request, so we can be sure that it won't generate more events for the - * window and that any existing events are in our queue. Second, we make - * sure that there are no events whatsoever in our queue (this is - * conservative but safe). - * - * The first step is done by remembering the request id of the - * XDestroyWindow request and using LastKnownRequestProcessed to see what - * events the server has processed. If multiple windows get destroyed at - * about the same time, we just remember the most recent request number - * for any of them (again, conservative but safe). - * - * There are a few other complications as well. When Tk destroys a - * sub-tree of windows, it only issues a single XDestroyWindow call, at - * the very end for the root of the subtree. We can't free any of the - * window ids until the final XDestroyWindow call. To make sure that this - * happens, we have to keep track of deletions in progress, hence the - * need for the "destroyCount" field of the display. - * - * One final problem. Some servers, like Sun X11/News servers still seem - * to have problems with ids getting reused too quickly. I'm not - * completely sure why this is a problem, but delaying the recycling of - * ids appears to eliminate it. Therefore, we wait an additional few - * seconds, even after "the coast is clear" before reusing the ids. - * - *---------------------------------------------------------------------- - */ - -void -TkFreeWindowId( - TkDisplay *dispPtr, /* Display that w belongs to. */ - Window w) /* X identifier for window on dispPtr. */ -{ - TkIdStack *stackPtr; - - /* - * Put the window id on a separate stack of window ids, rather than the - * main stack, so it won't get reused right away. Add a new chunk to the - * stack if the current chunk is full. - */ - - stackPtr = dispPtr->windowStackPtr; - if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) { - stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack)); - stackPtr->numUsed = 0; - stackPtr->dispPtr = dispPtr; - stackPtr->nextPtr = dispPtr->windowStackPtr; - dispPtr->windowStackPtr = stackPtr; - } - - /* - * Add the id to the current chunk. - */ - - stackPtr->ids[stackPtr->numUsed] = w; - stackPtr->numUsed++; - - /* - * Schedule a call to WindowIdCleanup if one isn't already scheduled. - */ - - if (!dispPtr->idCleanupScheduled) { - dispPtr->idCleanupScheduled = Tcl_CreateTimerHandler(100, - WindowIdCleanup, (ClientData) dispPtr); - } -} - -/* - *---------------------------------------------------------------------- - * - * WindowIdCleanup -- - * - * See if we can now free up all the accumulated ids of deleted windows. - * - * Results: - * None. - * - * Side effects: - * If it's safe to move the window ids back to the main free list, we - * schedule this to happen after a few mores seconds of delay. If it's - * not safe to move them yet, a timer handler gets invoked to try again - * later. - * - *---------------------------------------------------------------------- - */ - -static void -WindowIdCleanup( - ClientData clientData) /* Pointer to TkDisplay for display */ -{ - TkDisplay *dispPtr = (TkDisplay *) clientData; - int anyEvents, delta; - Tk_RestrictProc *oldProc; - ClientData oldData; - static Tcl_Time timeout = {0, 0}; - - dispPtr->idCleanupScheduled = (Tcl_TimerToken) 0; - - /* - * See if it's safe to recycle the window ids. It's safe if: - * (a) no deletions are in progress. - * (b) the server has seen all of the requests up to the last - * XDestroyWindow request. - * (c) there are no events in the event queue; the only way to test for - * this right now is to create a restrict proc that will filter the - * events, then call Tcl_DoOneEvent to see if the function gets - * invoked. - */ - - if (dispPtr->destroyCount > 0) { - goto tryAgain; - } - delta = LastKnownRequestProcessed(dispPtr->display) - - dispPtr->lastDestroyRequest; - if (delta < 0) { - XSync(dispPtr->display, False); - } - anyEvents = 0; - oldProc = Tk_RestrictEvents(CheckRestrictProc, (ClientData) &anyEvents, - &oldData); - TkUnixDoOneXEvent(&timeout); - Tk_RestrictEvents(oldProc, oldData, &oldData); - if (anyEvents) { - goto tryAgain; - } - - /* - * These ids look safe to recycle, but we still need to delay a bit more - * (see comments for TkFreeWindowId). Schedule the final freeing. - */ - - if (dispPtr->windowStackPtr != NULL) { - Tcl_CreateTimerHandler(5000, WindowIdCleanup2, - (ClientData) dispPtr->windowStackPtr); - dispPtr->windowStackPtr = NULL; - } - return; - /* - * It's still not safe to free up the ids. Try again a bit later. + * This does nothing, because the XC-MISC extension takes care of + * freeing XIDs for us. It has been a standard X11 extension for + * about 15 years as of 2008. Keith Packard and another X.org + * developer suggested that we remove the previous code that used: + * #define XLIB_ILLEGAL_ACCESS. */ - - tryAgain: - dispPtr->idCleanupScheduled = Tcl_CreateTimerHandler(500, - WindowIdCleanup, (ClientData) dispPtr); } - -/* - *---------------------------------------------------------------------- - * - * WindowIdCleanup2 -- - * - * This function is the last one in the chain that recycles window ids. - * It takes all of the ids indicated by its argument and adds them back - * to the main id free list. - * - * Results: - * None. - * - * Side effects: - * Window ids get added to the main free list for their display. - * - *---------------------------------------------------------------------- - */ - -static void -WindowIdCleanup2( - ClientData clientData) /* Pointer to TkIdStack list. */ -{ - TkIdStack *stackPtr = (TkIdStack *) clientData; - TkIdStack *lastPtr; - lastPtr = stackPtr; - while (lastPtr->nextPtr != NULL) { - lastPtr = lastPtr->nextPtr; - } - lastPtr->nextPtr = stackPtr->dispPtr->idStackPtr; - stackPtr->dispPtr->idStackPtr = stackPtr; -} - -/* - *---------------------------------------------------------------------- - * - * CheckRestrictProc -- - * - * This function is a restrict function, called by Tcl_DoOneEvent to - * filter X events. All it does is to set a flag to indicate that there - * are X events present. - * - * Results: - * Sets the integer pointed to by the argument, then returns - * TK_DEFER_EVENT. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static Tk_RestrictAction -CheckRestrictProc( - ClientData clientData, /* Pointer to flag to set. */ - XEvent *eventPtr) /* Event to filter; not used. */ -{ - int *flag = (int *) clientData; - *flag = 1; - return TK_DEFER_EVENT; -} /* *---------------------------------------------------------------------- @@ -522,44 +98,7 @@ Tk_FreePixmap( XFreePixmap(display, pixmap); Tk_FreeXId(display, (XID) pixmap); } - -/* - *---------------------------------------------------------------------- - * - * TkpWindowWasRecentlyDeleted -- - * - * Checks whether the window was recently deleted. This is called by the - * generic error handler to detect asynchronous notification of errors - * due to operations by Tk on a window that was already deleted by the - * server. - * - * Results: - * 1 if the window was deleted recently, 0 otherwise. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TkpWindowWasRecentlyDeleted( - Window win, /* The window to check for. */ - TkDisplay *dispPtr) /* The window belongs to this display. */ -{ - TkIdStack *stackPtr; - int i; - for (stackPtr = dispPtr->windowStackPtr; stackPtr != NULL; - stackPtr = stackPtr->nextPtr) { - for (i = 0; i < stackPtr->numUsed; i++) { - if ((Window) stackPtr->ids[i] == win) { - return 1; - } - } - } - return 0; -} /* *---------------------------------------------------------------------- @@ -583,7 +122,7 @@ TkpWindowWasRecentlyDeleted( int TkpScanWindowId( Tcl_Interp *interp, - CONST char *string, + const char *string, Window *idPtr) { int code; diff --git a/win/Makefile.in b/win/Makefile.in index 1d18b60..7b1766d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -4,6 +4,8 @@ # "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@ @@ -132,6 +134,8 @@ EXESUFFIX = @EXESUFFIX@ TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@ TK_LIB_FILE = @TK_LIB_FILE@ TK_DLL_FILE = @TK_DLL_FILE@ +TEST_DLL_FILE = tktest$(VER)${DLLSUFFIX} +TEST_LIB_FILE = @LIBPREFIX@tktest$(VER)${LIBSUFFIX} SHARED_LIBRARIES = $(TK_DLL_FILE) $(TK_STUB_LIB_FILE) STATIC_LIBRARIES = $(TK_LIB_FILE) @@ -160,18 +164,12 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@ LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ 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 = -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED - # To change the compiler switches, for example to change from optimization to # debugging symbols, change the following line: #CFLAGS = $(CFLAGS_DEBUG) #CFLAGS = $(CFLAGS_OPTIMIZE) #CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE) -CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ $(NO_DEPRECATED_FLAGS) +CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE # Special compiler flags to use when building man2tcl on Windows. MAN2TCLFLAGS = @MAN2TCLFLAGS@ @@ -205,6 +203,12 @@ COPY = cp BUILD_TCLSH = @BUILD_TCLSH@ +# 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 = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED + # TCL_EXE is the name of a tclsh executable that is available *BEFORE* # running make for the first time. Certain build targets (make genstubs) # need it to be available on the PATH. This executable should *NOT* be @@ -215,14 +219,12 @@ TCL_EXE = @TCLSH_PROG@ CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ -I"${GENERIC_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ -I"${XLIB_DIR_NATIVE}" -I"${BITMAP_DIR_NATIVE}" \ --I"${TCL_GENERIC_NATIVE}" -I"${TCL_PLATFORM_NATIVE}" ${AC_FLAGS} +-I"${TCL_GENERIC_NATIVE}" -I"${TCL_PLATFORM_NATIVE}" \ +${AC_FLAGS} $(NO_DEPRECATED_FLAGS) -DUSE_TCL_STUBS CC_OBJNAME = @CC_OBJNAME@ CC_EXENAME = @CC_EXENAME@ -STUB_CC_SWITCHES = ${CC_SWITCHES} -DUSE_TCL_STUBS -CON_CC_SWITCHES = ${CC_SWITCHES} -DCONSOLE - # Tk used to let the configure script choose which program to use # for installing, but there are just too many different versions of # "install" around; better to use the install-sh script that comes @@ -236,7 +238,6 @@ WISH_OBJS = \ winMain.$(OBJEXT) TKTEST_OBJS = \ - testMain.$(OBJEXT) \ tkSquare.$(OBJEXT) \ tkTest.$(OBJEXT) \ tkOldTest.$(OBJEXT) \ @@ -284,6 +285,7 @@ TK_OBJS = \ tkAtom.$(OBJEXT) \ tkBind.$(OBJEXT) \ tkBitmap.$(OBJEXT) \ + tkBusy.$(OBJEXT) \ tkButton.$(OBJEXT) \ tkCanvArc.$(OBJEXT) \ tkCanvBmap.$(OBJEXT) \ @@ -315,12 +317,15 @@ TK_OBJS = \ tkImage.$(OBJEXT) \ tkImgBmap.$(OBJEXT) \ tkImgGIF.$(OBJEXT) \ + tkImgPNG.$(OBJEXT) \ tkImgPPM.$(OBJEXT) \ tkImgPhoto.$(OBJEXT) \ + tkImgPhInstance.$(OBJEXT) \ tkImgUtil.$(OBJEXT) \ tkListbox.$(OBJEXT) \ tkMacWinMenu.$(OBJEXT) \ tkMain.$(OBJEXT) \ + tkMain2.$(OBJEXT) \ tkMenu.$(OBJEXT) \ tkMenubutton.$(OBJEXT) \ tkMenuDraw.$(OBJEXT) \ @@ -432,15 +437,15 @@ $(MAN2TCL): $(TCL_SRC_DIR)/tools/man2tcl.c test: test-classic test-ttk -test-classic: binaries $(TKTEST) $(CAT32) +test-classic: binaries $(TKTEST) $(TEST_DLL_FILE) $(CAT32) $(SHELL_ENV) ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" \ $(TESTFLAGS) | ./$(CAT32) -test-ttk: binaries $(TKTEST) $(CAT32) +test-ttk: binaries $(TKTEST) $(TEST_DLL_FILE) $(CAT32) $(SHELL_ENV) ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/ttk/all.tcl" \ $(TESTFLAGS) | ./$(CAT32) -runtest: binaries $(TKTEST) +runtest: binaries $(TKTEST) $(TEST_DLL_FILE) $(SHELL_ENV) ./$(TKTEST) $(TESTFLAGS) $(SCRIPT) # This target can be used to run wish from the build directory @@ -481,7 +486,7 @@ install-binaries: binaries @echo "Creating package index $(PKG_INDEX)"; @$(RM) $(PKG_INDEX); @(\ - echo "if {[catch {package present Tcl 8.5.0}]} return";\ + echo "if {[catch {package present Tcl 8.6.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 normalize [file join \$$dir .. .. bin libtk$(VERSION).dll]] Tk]";\ @@ -605,19 +610,23 @@ install-private-headers: libraries $(INSTALL_DATA) $$i $(PRIVATE_INCLUDE_INSTALL_DIR); \ done; -$(WISH): $(WISH_OBJS) $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) wish.$(RES) - $(CC) $(CFLAGS) $(WISH_OBJS) $(TCL_LIB_FILE) $(TK_LIB_FILE) $(LIBS) \ +$(WISH): $(WISH_OBJS) @LIBRARIES@ $(TK_STUB_LIB_FILE) wish.$(RES) + $(CC) $(CFLAGS) $(WISH_OBJS) $(TK_LIB_FILE) \ + $(TK_STUB_LIB_FILE) $(TCL_LIB_FILE) $(LIBS) \ wish.$(RES) $(CC_EXENAME) $(LDFLAGS_WINDOW) @VC_MANIFEST_EMBED_EXE@ tktest: $(TKTEST) -$(TKTEST): $(TKTEST_OBJS) $(TK_LIB_FILE) wish.$(RES) - $(CC) $(CFLAGS) $(TKTEST_OBJS) $(TCL_LIB_FILE) \ - $(TK_LIB_FILE) $(LIBS) \ +$(TKTEST): testMain.$(OBJEXT) $(TEST_DLL_FILE) @LIBRARIES@ $(TK_STUB_LIB_FILE) wish.$(RES) + $(CC) $(CFLAGS) testMain.$(OBJEXT) $(TEST_LIB_FILE) $(TK_LIB_FILE) \ + $(TK_STUB_LIB_FILE) $(TCL_LIB_FILE) $(LIBS) \ wish.$(RES) $(CC_EXENAME) $(LDFLAGS_WINDOW) @VC_MANIFEST_EMBED_EXE@ +${TEST_DLL_FILE}: ${TKTEST_OBJS} ${TK_STUB_LIB_FILE} + @MAKE_DLL@ ${TKTEST_OBJS} $(TK_STUB_LIB_FILE) $(SHLIB_LD_LIBS) + # Msys make requires this next rule for some reason. $(TCL_SRC_DIR)/win/cat.c: @@ -665,6 +674,9 @@ tkWinTest.$(OBJEXT): tkWinTest.c tkSquare.$(OBJEXT): tkSquare.c $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME) +tkMain2.$(OBJEXT): tkMain.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tk -DTK_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) + # Extra dependency info tkConsole.$(OBJEXT): configure Makefile tkMain.$(OBJEXT): configure Makefile @@ -680,10 +692,10 @@ tkWindow.$(OBJEXT): configure Makefile # Implicit rule for all object files that will end up in the Tk library %.$(OBJEXT): %.c - $(CC) -c $(STUB_CC_SWITCHES) -DBUILD_tk -DBUILD_ttk @DEPARG@ $(CC_OBJNAME) + $(CC) -c $(CC_SWITCHES) -DBUILD_tk -DBUILD_ttk @DEPARG@ $(CC_OBJNAME) .rc.$(RES): - $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(TCL_PLATFORM_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@ + $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@ depend: @@ -1,4 +1,4 @@ -Tk 8.5 for Windows +Tk 8.6 for Windows Originally by Scott Stanton while at Sun Microsystems Labs diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat index 9cdf0d9..8f6803b 100755 --- a/win/buildall.vc.bat +++ b/win/buildall.vc.bat @@ -63,15 +63,15 @@ if "%TCLDIR%" == "" set TCLDIR=..\..\tcl :: Build the normal stuff along with the help file.
::
-set OPTS=threads
-if not %SYMBOLS%.==. set OPTS=symbols,threads
-nmake -nologo -f makefile.vc release OPTS=%OPTS% %1
+set OPTS=none
+if not %SYMBOLS%.==. set OPTS=symbols
+nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1
if errorlevel 1 goto error
:: Build the static core and shell.
::
-set OPTS=static,msvcrt,threads
-if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads
+set OPTS=static,msvcrt
+if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error
@@ -93,7 +93,7 @@ echo usage: echo %0 : builds Tk for all build types (do this first)
echo %0 install : installs all the release builds (do this second)
echo %0 symbols : builds Tk for all debugging build types
-echo %0 symbols install : install all the debug builds
+echo %0 symbols install : install all the debug builds.
echo.
goto out
diff --git a/win/configure b/win/configure index 71f3f27..18efa23 100755 --- a/win/configure +++ b/win/configure @@ -309,7 +309,7 @@ ac_includes_default="\ # include <unistd.h> #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS TCL_VERSION TCL_BIN_DIR TCL_SRC_DIR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_DEFS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING MAN2TCLFLAGS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE BUILD_TCLSH TCLSH_PROG TK_WIN_VERSION MACHINE TK_VERSION TK_MAJOR_VERSION TK_MINOR_VERSION TK_PATCH_LEVEL TK_DBGX TK_LIB_FILE TK_DLL_FILE TK_STUB_LIB_FILE TK_STUB_LIB_FLAG TK_BUILD_STUB_LIB_SPEC TK_SRC_DIR TK_BIN_DIR TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_DBGX CFG_TK_SHARED_LIB_SUFFIX CFG_TK_UNSHARED_LIB_SUFFIX CFG_TK_EXPORT_FILE_SUFFIX TK_SHARED_BUILD DEPARG EXTRA_CFLAGS STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES TK_RES RES LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TK_LIB_FLAG TK_LIB_SPEC TK_BUILD_LIB_SPEC TK_STUB_LIB_SPEC TK_STUB_LIB_PATH TK_BUILD_STUB_LIB_PATH TK_CC_SEARCH_FLAGS TK_LD_SEARCH_FLAGS LIBOBJS LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS TCL_VERSION TCL_BIN_DIR TCL_SRC_DIR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_DEFS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING MAN2TCLFLAGS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE BUILD_TCLSH TCLSH_PROG TK_WIN_VERSION MACHINE TK_VERSION TK_MAJOR_VERSION TK_MINOR_VERSION TK_PATCH_LEVEL TK_DBGX TK_LIB_FILE TK_DLL_FILE TK_STUB_LIB_FILE TK_STUB_LIB_FLAG TK_BUILD_STUB_LIB_SPEC TK_SRC_DIR TK_BIN_DIR TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_DBGX CFG_TK_SHARED_LIB_SUFFIX CFG_TK_UNSHARED_LIB_SUFFIX CFG_TK_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW TK_RES STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TK_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TK_LIB_FLAG TK_LIB_SPEC TK_BUILD_LIB_SPEC TK_STUB_LIB_SPEC TK_STUB_LIB_PATH TK_BUILD_STUB_LIB_PATH TK_CC_SEARCH_FLAGS TK_LD_SEARCH_FLAGS RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -840,7 +840,7 @@ if test -n "$ac_init_help"; then Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --enable-threads build with threads (default: off) + --enable-threads build with threads (default: on) --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) --enable-wince enable Win/CE support (where applicable) @@ -1309,10 +1309,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TK_VERSION=8.5 +TK_VERSION=8.6 TK_MAJOR_VERSION=8 -TK_MINOR_VERSION=5 -TK_PATCH_LEVEL=".18" +TK_MINOR_VERSION=6 +TK_PATCH_LEVEL=".4" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ @@ -3048,12 +3048,12 @@ if test "${enable_threads+set}" = set; then enableval="$enable_threads" tcl_ok=$enableval else - tcl_ok=no + tcl_ok=yes fi; if test "$tcl_ok" = "yes"; then - echo "$as_me:$LINENO: result: yes" >&5 -echo "${ECHO_T}yes" >&6 + echo "$as_me:$LINENO: result: yes (default)" >&5 +echo "${ECHO_T}yes (default)" >&6 TCL_THREADS=1 cat >>confdefs.h <<\_ACEOF #define TCL_THREADS 1 @@ -3067,8 +3067,8 @@ _ACEOF else TCL_THREADS=0 - echo "$as_me:$LINENO: result: no (default)" >&5 -echo "${ECHO_T}no (default)" >&6 + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 fi @@ -3284,6 +3284,25 @@ echo "${ECHO_T}could not find ${TCL_BIN_DIR}/tclConfig.sh" >&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 + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called @@ -3408,6 +3427,11 @@ echo "${ECHO_T}$CELIB_DIR" >&6 # Set some defaults (may get changed below) EXTRA_CFLAGS="" +cat >>confdefs.h <<\_ACEOF +#define MODULE_SCOPE extern +_ACEOF + + # Extract the first word of "cygpath", so it can be a program name with args. set dummy cygpath; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 @@ -3465,7 +3489,7 @@ cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #ifndef __WIN32__ + #ifndef _WIN32 #error cross-compiler #endif @@ -3588,7 +3612,7 @@ cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ - #ifdef __WIN32__ + #ifdef _WIN32 #error win32 #endif @@ -3639,14 +3663,80 @@ echo "${ECHO_T}$ac_cv_win32" >&6 echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;} { (exit 1); exit 1; }; } fi + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" + echo "$as_me:$LINENO: checking for working -municode linker flag" >&5 +echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6 +if test "${ac_cv_municode+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 <windows.h> + int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} + +int +main () +{ + + ; + 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_municode=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_municode=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi +echo "$as_me:$LINENO: result: $ac_cv_municode" >&5 +echo "${ECHO_T}$ac_cv_municode" >&6 + CFLAGS=$hold_cflags + if test "$ac_cv_municode" = "yes" ; then + extra_ldflags="$extra_ldflags -municode" + else + extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" + fi fi echo "$as_me:$LINENO: checking compiler flags" >&5 echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 if test "${GCC}" = "yes" ; then SHLIB_LD="" - SHLIB_LD_LIBS="" - LIBS="-lws2_32" + SHLIB_LD_LIBS='${LIBS}' + LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' @@ -3666,9 +3756,6 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 echo "$as_me:$LINENO: result: using static flags" >&5 echo "${ECHO_T}using static flags" >&6 runtime= - MAKE_DLL="echo " - LIBSUFFIX="s\${DBGX}.a" - LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else @@ -3686,29 +3773,29 @@ echo "$as_me: error: ${CC} does not support the -shared option. fi runtime= - # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. - SHLIB_LD='${CC} -shared' - SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ - -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" - LIBSUFFIX="\${DBGX}.a" - LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi + # Link with gcc since ld does not link to default libs like + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS='${LIBS}' + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" + LIBSUFFIX="\${DBGX}.a" + LIBFLAGSUFFIX="\${DBGX}" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall" + CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= @@ -3809,24 +3896,16 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 echo "$as_me:$LINENO: result: using static flags" >&5 echo "${ECHO_T}using static flags" >&6 runtime=-MT - MAKE_DLL="echo " - LIBSUFFIX="s\${DBGX}.lib" - LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" - SHLIB_LD_LIBS="" else # dynamic echo "$as_me:$LINENO: result: using shared flags" >&5 echo "${ECHO_T}using shared flags" >&6 runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" - LIBSUFFIX="\${DBGX}.lib" - LIBFLAGSUFFIX="\${DBGX}" - EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" - SHLIB_LD_LIBS='${LIBS}' + EXESUFFIX="\${DBGX}.exe" case "x`echo \${VisualStudioVersion}`" in x1[4-9]*) lflags="${lflags} -nodefaultlib:libucrt.lib" @@ -3835,9 +3914,12 @@ echo "${ECHO_T}using shared flags" >&6 ;; esac fi + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" + LIBSUFFIX="\${DBGX}.lib" + LIBFLAGSUFFIX="\${DBGX}" # This is a 2-stage check to make sure we have the 64-bit SDK # We have to know where the SDK is installed. @@ -3866,7 +3948,7 @@ echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK" >&2;} echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 fi - LIBS="user32.lib advapi32.lib ws2_32.lib" + LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib" case "x`echo \${VisualStudioVersion}`" in x1[4-9]*) @@ -4073,6 +4155,7 @@ _ACEOF fi SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" + SHLIB_LD_LIBS='${LIBS}' # link -lib only works when -lib is the first arg STLIB_LD="${LINKBIN} -lib ${lflags}" RC_OUT=-fo @@ -4688,6 +4771,63 @@ echo "$as_me: xpnative theme will be unavailable" >&6;} fi +echo "$as_me:$LINENO: checking for vssym32.h" >&5 +echo $ECHO_N "checking for vssym32.h... $ECHO_C" >&6 +if test "${ac_cv_header_vssym32_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 <windows.h> +#include <uxtheme.h> + +#include <vssym32.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_vssym32_h=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_header_vssym32_h=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_header_vssym32_h" >&5 +echo "${ECHO_T}$ac_cv_header_vssym32_h" >&6 +if test $ac_cv_header_vssym32_h = yes; then + cat >>confdefs.h <<\_ACEOF +#define HAVE_VSSYM32_H 1 +_ACEOF + +fi + + #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols @@ -4981,6 +5121,8 @@ TK_WIN_VERSION="$TK_VERSION.$TK_RELEASE_LEVEL.`echo $TK_PATCH_LEVEL | tr -d ab.` +# win/tcl.m4 doesn't set (LDFLAGS) + @@ -5016,11 +5158,15 @@ TK_WIN_VERSION="$TK_VERSION.$TK_RELEASE_LEVEL.`echo $TK_PATCH_LEVEL | tr -d ab.` +# undefined at this point for win + + + + -# undefined at this point for win @@ -5722,27 +5868,21 @@ s,@TCL_DBGX@,$TCL_DBGX,;t t s,@CFG_TK_SHARED_LIB_SUFFIX@,$CFG_TK_SHARED_LIB_SUFFIX,;t t s,@CFG_TK_UNSHARED_LIB_SUFFIX@,$CFG_TK_UNSHARED_LIB_SUFFIX,;t t s,@CFG_TK_EXPORT_FILE_SUFFIX@,$CFG_TK_EXPORT_FILE_SUFFIX,;t t -s,@TK_SHARED_BUILD@,$TK_SHARED_BUILD,;t t -s,@DEPARG@,$DEPARG,;t t s,@EXTRA_CFLAGS@,$EXTRA_CFLAGS,;t t -s,@STLIB_LD@,$STLIB_LD,;t t -s,@SHLIB_LD@,$SHLIB_LD,;t t -s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t -s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t -s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t +s,@DEPARG@,$DEPARG,;t t s,@CC_OBJNAME@,$CC_OBJNAME,;t t s,@CC_EXENAME@,$CC_EXENAME,;t t s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t s,@LDFLAGS_CONSOLE@,$LDFLAGS_CONSOLE,;t t s,@LDFLAGS_WINDOW@,$LDFLAGS_WINDOW,;t t -s,@RC_OUT@,$RC_OUT,;t t -s,@RC_TYPE@,$RC_TYPE,;t t -s,@RC_INCLUDE@,$RC_INCLUDE,;t t -s,@RC_DEFINE@,$RC_DEFINE,;t t -s,@RC_DEFINES@,$RC_DEFINES,;t t s,@TK_RES@,$TK_RES,;t t -s,@RES@,$RES,;t t +s,@STLIB_LD@,$STLIB_LD,;t t +s,@SHLIB_LD@,$SHLIB_LD,;t t +s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t +s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t +s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t +s,@TK_SHARED_BUILD@,$TK_SHARED_BUILD,;t t s,@LIBS_GUI@,$LIBS_GUI,;t t s,@DLLSUFFIX@,$DLLSUFFIX,;t t s,@LIBPREFIX@,$LIBPREFIX,;t t @@ -5762,6 +5902,12 @@ s,@TK_STUB_LIB_PATH@,$TK_STUB_LIB_PATH,;t t s,@TK_BUILD_STUB_LIB_PATH@,$TK_BUILD_STUB_LIB_PATH,;t t s,@TK_CC_SEARCH_FLAGS@,$TK_CC_SEARCH_FLAGS,;t t s,@TK_LD_SEARCH_FLAGS@,$TK_LD_SEARCH_FLAGS,;t t +s,@RC_OUT@,$RC_OUT,;t t +s,@RC_TYPE@,$RC_TYPE,;t t +s,@RC_INCLUDE@,$RC_INCLUDE,;t t +s,@RC_DEFINE@,$RC_DEFINE,;t t +s,@RC_DEFINES@,$RC_DEFINES,;t t +s,@RES@,$RES,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF diff --git a/win/configure.in b/win/configure.in index 4634bb6..709b97f 100644 --- a/win/configure.in +++ b/win/configure.in @@ -11,10 +11,10 @@ AC_PREREQ(2.59) # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TK_VERSION=8.5 +TK_VERSION=8.6 TK_MAJOR_VERSION=8 -TK_MINOR_VERSION=5 -TK_PATCH_LEVEL=".18" +TK_MINOR_VERSION=6 +TK_PATCH_LEVEL=".4" VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION #------------------------------------------------------------------------ @@ -81,6 +81,17 @@ 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 + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called @@ -115,6 +126,9 @@ fi AC_CHECK_HEADER([uxtheme.h], [AC_DEFINE(HAVE_UXTHEME_H)], [AC_MSG_NOTICE([xpnative theme will be unavailable])], [#include <windows.h>]) +AC_CHECK_HEADER([vssym32.h], [AC_DEFINE(HAVE_VSSYM32_H)], [], + [#include <windows.h> +#include <uxtheme.h>]) #-------------------------------------------------------------------- # Set the default compiler switches based on the --enable-symbols @@ -229,25 +243,22 @@ AC_SUBST(TCL_VERSION) AC_SUBST(TCL_MAJOR_VERSION) AC_SUBST(TCL_MINOR_VERSION) AC_SUBST(TCL_PATCH_LEVEL) + AC_SUBST(TCL_SRC_DIR) AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_DBGX) AC_SUBST(CFG_TK_SHARED_LIB_SUFFIX) AC_SUBST(CFG_TK_UNSHARED_LIB_SUFFIX) AC_SUBST(CFG_TK_EXPORT_FILE_SUFFIX) -AC_SUBST(TK_SHARED_BUILD) -AC_SUBST(CYGPATH) -AC_SUBST(DEPARG) AC_SUBST(CFLAGS_DEFAULT) AC_SUBST(EXTRA_CFLAGS) -AC_SUBST(STLIB_LD) -AC_SUBST(SHLIB_LD) -AC_SUBST(SHLIB_LD_LIBS) -AC_SUBST(SHLIB_CFLAGS) -AC_SUBST(SHLIB_SUFFIX) +AC_SUBST(CYGPATH) +AC_SUBST(DEPARG) AC_SUBST(CC_OBJNAME) AC_SUBST(CC_EXENAME) + +# win/tcl.m4 doesn't set (LDFLAGS) AC_SUBST(LDFLAGS_DEFAULT) AC_SUBST(LDFLAGS_DEBUG) AC_SUBST(LDFLAGS_OPTIMIZE) @@ -255,14 +266,15 @@ AC_SUBST(LDFLAGS_CONSOLE) AC_SUBST(LDFLAGS_WINDOW) AC_SUBST(AR) AC_SUBST(RANLIB) -AC_SUBST(RC) -AC_SUBST(RC_OUT) -AC_SUBST(RC_TYPE) -AC_SUBST(RC_INCLUDE) -AC_SUBST(RC_DEFINE) -AC_SUBST(RC_DEFINES) AC_SUBST(TK_RES) -AC_SUBST(RES) + +AC_SUBST(STLIB_LD) +AC_SUBST(SHLIB_LD) +AC_SUBST(SHLIB_LD_LIBS) +AC_SUBST(SHLIB_CFLAGS) +AC_SUBST(SHLIB_SUFFIX) +AC_SUBST(TK_SHARED_BUILD) + AC_SUBST(LIBS) AC_SUBST(LIBS_GUI) AC_SUBST(DLLSUFFIX) @@ -287,7 +299,15 @@ AC_SUBST(TK_BUILD_STUB_LIB_PATH) AC_SUBST(TK_CC_SEARCH_FLAGS) AC_SUBST(TK_LD_SEARCH_FLAGS) -AC_OUTPUT([Makefile tkConfig.sh wish.exe.manifest]) +AC_SUBST(RC) +AC_SUBST(RC_OUT) +AC_SUBST(RC_TYPE) +AC_SUBST(RC_INCLUDE) +AC_SUBST(RC_DEFINE) +AC_SUBST(RC_DEFINES) +AC_SUBST(RES) + +AC_OUTPUT(Makefile tkConfig.sh wish.exe.manifest) dnl Local Variables: dnl mode: autoconf; diff --git a/win/makefile.bc b/win/makefile.bc index 5a22c95..d98dfd7 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -161,6 +161,7 @@ TKOBJS = \ $(TMPDIR)\tkAtom.obj \
$(TMPDIR)\tkBind.obj \
$(TMPDIR)\tkBitmap.obj \
+ $(TMPDIR)\tkBusy.obj \
$(TMPDIR)\tkButton.obj \
$(TMPDIR)\tkCanvArc.obj \
$(TMPDIR)\tkCanvBmap.obj \
@@ -194,6 +195,7 @@ TKOBJS = \ $(TMPDIR)\tkImgGIF.obj \
$(TMPDIR)\tkImgPPM.obj \
$(TMPDIR)\tkImgPhoto.obj \
+ $(TMPDIR)\tkImgPhInstance.obj \
$(TMPDIR)\tkImgUtil.obj \
$(TMPDIR)\tkListbox.obj \
$(TMPDIR)\tkMacWinMenu.obj \
@@ -241,7 +243,7 @@ RCDIR = $(WINDIR)\rc TK_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) -I$(BITMAPDIR) -I$(XLIBDIR) \
-I$(TCLDIR)\generic -I$(TCLDIR)\win
-TK_DEFINES = -D__WIN32__ $(DEBUGDEFINES) $(THREADDEFINES) SUPPORT_CONFIG_EMBEDDED
+TK_DEFINES = -D_WIN32 $(DEBUGDEFINES) $(THREADDEFINES) SUPPORT_CONFIG_EMBEDDED
######################################################################
# Compile flags
diff --git a/win/makefile.vc b/win/makefile.vc index d2795c9..ae43eb6 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -213,8 +213,8 @@ TTK_SQUARE_WIDGET = 0 STUBPREFIX = $(PROJECT)stub
WISHNAMEPREFIX = wish
-BINROOT = $(MAKEDIR) # originally .
-ROOT = $(MAKEDIR)\.. # originally ..
+BINROOT = $(MAKEDIR) # originally .
+ROOT = $(MAKEDIR)\.. # originally ..
TK_LIBRARY = $(ROOT)\library
@@ -294,6 +294,7 @@ TKOBJS = \ $(TMP_DIR)\tkAtom.obj \
$(TMP_DIR)\tkBind.obj \
$(TMP_DIR)\tkBitmap.obj \
+ $(TMP_DIR)\tkBusy.obj \
$(TMP_DIR)\tkButton.obj \
$(TMP_DIR)\tkCanvArc.obj \
$(TMP_DIR)\tkCanvBmap.obj \
@@ -325,12 +326,15 @@ TKOBJS = \ $(TMP_DIR)\tkImage.obj \
$(TMP_DIR)\tkImgBmap.obj \
$(TMP_DIR)\tkImgGIF.obj \
+ $(TMP_DIR)\tkImgPNG.obj \
$(TMP_DIR)\tkImgPPM.obj \
$(TMP_DIR)\tkImgPhoto.obj \
+ $(TMP_DIR)\tkImgPhInstance.obj \
$(TMP_DIR)\tkImgUtil.obj \
$(TMP_DIR)\tkListbox.obj \
$(TMP_DIR)\tkMacWinMenu.obj \
$(TMP_DIR)\tkMain.obj \
+ $(TMP_DIR)\tkMain2.obj \
$(TMP_DIR)\tkMenu.obj \
$(TMP_DIR)\tkMenubutton.obj \
$(TMP_DIR)\tkMenuDraw.obj \
@@ -517,7 +521,9 @@ dlllflags = $(lflags) -dll conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
-baselibs = kernel32.lib user32.lib
+tcllibs = $(TCLSTUBLIB) $(TCLIMPLIB)
+
+baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
@@ -564,12 +570,7 @@ test-classic: setup $(TKTEST) $(TKLIB) $(CAT32) !else
@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
!endif
-!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
$(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) | $(CAT32)
-!else
- $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) > tests.log
- type tests.log | more
-!endif
test-ttk: setup $(TKTEST) $(TKLIB) $(CAT32)
@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
@@ -580,12 +581,7 @@ test-ttk: setup $(TKTEST) $(TKLIB) $(CAT32) !else
@set PATH=$(_TCLDIR)\win\$(BUILDDIRTOP);$(PATH)
!endif
-!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
$(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/ttk/all.tcl" $(TESTFLAGS) | $(CAT32)
-!else
- $(DEBUGGER) $(TKTEST) "$(ROOT:\=/)/tests/ttk/all.tcl" $(TESTFLAGS) > tests.log
- type tests.log | more
-!endif
runtest: setup $(TKTEST) $(TKLIB) $(CAT32)
@set TCL_LIBRARY=$(TCL_LIBRARY:\=/)
@@ -660,18 +656,18 @@ $(TKSTUBLIB): $(TKSTUBOBJS) $(lib32) -nologo -nodefaultlib -out:$@ $**
-$(WISH): $(WISHOBJS) $(TKIMPLIB)
- $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(TCLIMPLIB) $**
+$(WISH): $(WISHOBJS) $(TKSTUBLIB) $(TKIMPLIB)
+ $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $**
$(_VC_MANIFEST_EMBED_EXE)
-$(WISHC): $(WISHOBJS) $(TKIMPLIB)
- $(link32) $(conlflags) -stack:2300000 -out:$@ $(guilibs) $(TCLIMPLIB) $**
+$(WISHC): $(WISHOBJS) $(TKSTUBLIB) $(TKIMPLIB)
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $**
$(_VC_MANIFEST_EMBED_EXE)
-$(TKTEST): $(TKTESTOBJS) $(TKIMPLIB)
- $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(TCLIMPLIB) $**
+$(TKTEST): $(TKTESTOBJS) $(TKSTUBLIB) $(TKIMPLIB)
+ $(link32) $(guilflags) -stack:2300000 -out:$@ $(guilibs) $(tcllibs) $**
$(_VC_MANIFEST_EMBED_EXE)
@@ -850,6 +846,9 @@ $(TMP_DIR)\winMain.obj: $(WINDIR)\winMain.c -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
-Fo$@ $?
+$(TMP_DIR)\tkMain2.obj: $(GENERICDIR)\tkMain.c
+ $(cc32) -DBUILD_tk $(TK_CFLAGS) -DTK_ASCII_MAIN -Fo$@ $?
+
# The following objects are part of the stub library and should not
# be built as DLL objects but none of the symbols should be exported
# and no reference made to a C runtime.
@@ -962,7 +961,7 @@ install-binaries: !if !$(STATIC_BUILD)
@echo creating package index
@type << > $(OUT_DIR)\pkgIndex.tcl
-if {[catch {package present Tcl $(TK_DOTVERSION).0}]} { return }
+if {[catch {package present Tcl $(TCL_PATCH_LEVEL)}]} { return }
if {($$::tcl_platform(platform) eq "unix") && ([info exists ::env(DISPLAY)]
|| ([info exists ::argv] && ("-display" in $$::argv)))} {
package ifneeded Tk $(TK_PATCH_LEVEL) [list load [file join $$dir .. .. bin libtk$(TK_DOTVERSION).dll] Tk]
diff --git a/win/rc/lamp.bmp b/win/rc/lamp.bmp Binary files differindex 834c0f9..1e2f9d4 100644 --- a/win/rc/lamp.bmp +++ b/win/rc/lamp.bmp diff --git a/win/rc/tk.ico b/win/rc/tk.ico Binary files differindex 5fdb9a7..e254318 100644 --- a/win/rc/tk.ico +++ b/win/rc/tk.ico diff --git a/win/rc/wish.ico b/win/rc/wish.ico Binary files differindex 1825751..5801fb8 100644 --- a/win/rc/wish.ico +++ b/win/rc/wish.ico diff --git a/win/rules.vc b/win/rules.vc index a43fac6..0d8cd6b 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -159,7 +159,7 @@ DEBUGFLAGS = $(DEBUGFLAGS) -RTC1 DEBUGFLAGS = $(DEBUGFLAGS) -GZ
!endif
-COMPILERFLAGS =-W3
+COMPILERFLAGS =-W3 -DUNICODE -D_UNICODE
# In v13 -GL and -YX are incompatible.
!if [nmakehlp -c -YX]
@@ -213,7 +213,7 @@ LINKERFLAGS =-ltcg !if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
STATIC_BUILD = 0
-TCL_THREADS = 0
+TCL_THREADS = 1
DEBUG = 0
SYMBOLS = 0
PROFILE = 0
@@ -221,7 +221,7 @@ PGO = 0 MSVCRT = 1
LOIMPACT = 0
TCL_USE_STATIC_PACKAGES = 0
-USE_THREAD_ALLOC = 0
+USE_THREAD_ALLOC = 1
UNCHECKED = 0
!else
!if [nmakehlp -f $(OPTS) "static"]
@@ -246,13 +246,13 @@ TCL_USE_STATIC_PACKAGES = 1 !else
TCL_USE_STATIC_PACKAGES = 0
!endif
-!if [nmakehlp -f $(OPTS) "threads"]
-!message *** Doing threads
-TCL_THREADS = 1
-USE_THREAD_ALLOC = 1
-!else
+!if [nmakehlp -f $(OPTS) "nothreads"]
+!message *** Compile explicitly for non-threaded tcl
TCL_THREADS = 0
-USE_THREAD_ALLOC = 0
+USE_THREAD_ALLOC= 0
+!else
+TCL_THREADS = 1
+USE_THREAD_ALLOC= 1
!endif
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
@@ -588,8 +588,8 @@ TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:x=).lib"
!endif
TCL_LIBRARY = $(_TCLDIR)\lib
-TCLREGLIB = "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
+TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib"
COFFBASE = \must\have\tcl\sources\to\build\this\target
TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES = -I"$(_TCLDIR)\include"
@@ -604,8 +604,8 @@ TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:x=).lib"
!endif
TCL_LIBRARY = $(_TCLDIR)\library
-TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib"
-TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
+TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
+TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib"
COFFBASE = "$(_TCLDIR)\win\coffbase.txt"
TCLTOOLSDIR = $(_TCLDIR)\tools
TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
diff --git a/win/stubs.c b/win/stubs.c index 4564639..1cf23ef 100644 --- a/win/stubs.c +++ b/win/stubs.c @@ -404,3 +404,71 @@ XGetWindowProperty( *prop_return = NULL; return BadValue; } + +/* + * The following functions were implemented as macros under Windows. + */ + +int +XFlush( + Display *display) +{ + return 0; +} + +int +XGrabServer( + Display *display) +{ + return 0; +} + +int +XUngrabServer( + Display *display) +{ + return 0; +} + +int +XFree( + void *data) +{ + if ((data) != NULL) { + ckfree(data); + } + return 0; +} + +int +XNoOp( + Display *display) +{ + display->request++; + return 0; +} + +XAfterFunction +XSynchronize( + Display *display, + Bool bool) +{ + display->request++; + return NULL; +} + +int +XSync( + Display *display, + Bool bool) +{ + display->request++; + return 0; +} + +VisualID +XVisualIDFromVisual( + Visual *visual) +{ + return visual->visualid; +} @@ -247,7 +247,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Results: # -# Subst the following vars: +# Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE @@ -401,11 +401,11 @@ AC_DEFUN([SC_ENABLE_SHARED], [ AC_DEFUN([SC_ENABLE_THREADS], [ AC_MSG_CHECKING(for building with threads) - AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: off)], - [tcl_ok=$enableval], [tcl_ok=no]) + AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)], + [tcl_ok=$enableval], [tcl_ok=yes]) if test "$tcl_ok" = "yes"; then - AC_MSG_RESULT(yes) + AC_MSG_RESULT([yes (default)]) TCL_THREADS=1 AC_DEFINE(TCL_THREADS) # USE_THREAD_ALLOC tells us to try the special thread-based @@ -413,7 +413,7 @@ AC_DEFUN([SC_ENABLE_THREADS], [ AC_DEFINE(USE_THREAD_ALLOC) else TCL_THREADS=0 - AC_MSG_RESULT([no (default)]) + AC_MSG_RESULT(no) fi AC_SUBST(TCL_THREADS) ]) @@ -557,6 +557,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # Set some defaults (may get changed below) EXTRA_CFLAGS="" + AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden]) AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo) @@ -571,7 +572,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_CACHE_CHECK(for cross-compile version of gcc, ac_cv_cross, AC_TRY_COMPILE([ - #ifndef __WIN32__ + #ifndef _WIN32 #error cross-compiler #endif ], [], @@ -638,7 +639,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_CACHE_CHECK(for mingw32 version of gcc, ac_cv_win32, AC_TRY_COMPILE([ - #ifdef __WIN32__ + #ifdef _WIN32 #error win32 #endif ], [], @@ -648,13 +649,31 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if test "$ac_cv_win32" != "yes"; then AC_MSG_ERROR([${CC} cannot produce win32 executables.]) fi + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain" + AC_CACHE_CHECK(for working -municode linker flag, + ac_cv_municode, + AC_TRY_LINK([ + #include <windows.h> + int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;} + ], + [], + ac_cv_municode=yes, + ac_cv_municode=no) + ) + CFLAGS=$hold_cflags + if test "$ac_cv_municode" = "yes" ; then + extra_ldflags="$extra_ldflags -municode" + else + extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" + fi fi AC_MSG_CHECKING([compiler flags]) if test "${GCC}" = "yes" ; then SHLIB_LD="" - SHLIB_LD_LIBS="" - LIBS="-lws2_32" + SHLIB_LD_LIBS='${LIBS}' + LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -luserenv -lws2_32" # mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32" STLIB_LD='${AR} cr' @@ -673,9 +692,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # static AC_MSG_RESULT([using static flags]) runtime= - MAKE_DLL="echo " - LIBSUFFIX="s\${DBGX}.a" - LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" else @@ -689,29 +705,29 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ fi runtime= - # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. - SHLIB_LD='${CC} -shared' - SHLIB_LD_LIBS='${LIBS}' # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ - -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" - LIBSUFFIX="\${DBGX}.a" - LIBFLAGSUFFIX="\${DBGX}" EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" fi + # Link with gcc since ld does not link to default libs like + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS='${LIBS}' + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ + -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" + LIBSUFFIX="\${DBGX}.a" + LIBFLAGSUFFIX="\${DBGX}" SHLIB_SUFFIX=.dll EXTRA_CFLAGS="${extra_cflags}" CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall" + CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= @@ -766,23 +782,15 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ # static AC_MSG_RESULT([using static flags]) runtime=-MT - MAKE_DLL="echo " - LIBSUFFIX="s\${DBGX}.lib" - LIBFLAGSUFFIX="s\${DBGX}" LIBRARIES="\${STATIC_LIBRARIES}" EXESUFFIX="s\${DBGX}.exe" - SHLIB_LD_LIBS="" else # dynamic AC_MSG_RESULT([using shared flags]) runtime=-MD # Add SHLIB_LD_LIBS to the Make rule, not here. - MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" - LIBSUFFIX="\${DBGX}.lib" - LIBFLAGSUFFIX="\${DBGX}" - EXESUFFIX="\${DBGX}.exe" LIBRARIES="\${SHARED_LIBRARIES}" - SHLIB_LD_LIBS='${LIBS}' + EXESUFFIX="\${DBGX}.exe" case "x`echo \${VisualStudioVersion}`" in x1[[4-9]]*) lflags="${lflags} -nodefaultlib:libucrt.lib" @@ -791,9 +799,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ ;; esac fi + MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@" # DLLSUFFIX is separate because it is the building block for # users of tclConfig.sh that may build shared or static. DLLSUFFIX="\${DBGX}.dll" + LIBSUFFIX="\${DBGX}.lib" + LIBFLAGSUFFIX="\${DBGX}" # This is a 2-stage check to make sure we have the 64-bit SDK # We have to know where the SDK is installed. @@ -820,7 +831,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) fi - LIBS="user32.lib advapi32.lib ws2_32.lib" + LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib" case "x`echo \${VisualStudioVersion}`" in x1[[4-9]]*) @@ -954,6 +965,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ fi SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}" + SHLIB_LD_LIBS='${LIBS}' # link -lib only works when -lib is the first arg STLIB_LD="${LINKBIN} -lib ${lflags}" RC_OUT=-fo @@ -1114,13 +1126,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ #------------------------------------------------------------------------ AC_DEFUN([SC_WITH_TCL], [ - if test -d ../../tcl8.5$1/win; then - TCL_BIN_DEFAULT=../../tcl8.5$1/win + if test -d ../../tcl8.6$1/win; then + TCL_BIN_DEFAULT=../../tcl8.6$1/win else - TCL_BIN_DEFAULT=../../tcl8.5/win + TCL_BIN_DEFAULT=../../tcl8.6/win fi - AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.5 binaries from DIR], + AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`) if test ! -d $TCL_BIN_DIR; then AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist) diff --git a/win/tkWin.h b/win/tkWin.h index 00d3486..4d278d7 100644 --- a/win/tkWin.h +++ b/win/tkWin.h @@ -16,9 +16,9 @@ /* * We must specify the lower version we intend to support. In particular * the SystemParametersInfo API doesn't like to receive structures that - * are larger than it expects which affects the font assignements. + * are larger than it expects which affects the font assignments. * - * WINVER = 0x0410 means Windows 98 and above + * WINVER = 0x0500 means Windows 2000 and above */ #ifndef WINVER @@ -36,16 +36,11 @@ #include <windows.h> #undef WIN32_LEAN_AND_MEAN -#ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT -#endif - /* * The following messages are used to communicate between a Tk toplevel - * and its container window. A Tk container may not be able to provide - * service to all of the following requests at the moment. But an embedded - * Tk window will send out these requests to support external Tk container + * and its container window. A Tk container may not be able to provide + * service to all of the following requests at the moment. But an embedded + * Tk window will send out these requests to support external Tk container * application. */ @@ -66,7 +61,7 @@ /* * The following are sub-messages (wParam) for TK_INFO. An embedded window may - * send a TK_INFO message with one of the sub-messages to query a container + * send a TK_INFO message with one of the sub-messages to query a container * for verification and availability */ #define TK_CONTAINER_VERIFY 0x01 @@ -83,7 +78,4 @@ #include "tkPlatDecls.h" -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TKWIN */ diff --git a/win/tkWin3d.c b/win/tkWin3d.c index df6aa95..d3c443d 100644 --- a/win/tkWin3d.c +++ b/win/tkWin3d.c @@ -43,7 +43,7 @@ typedef struct { TkBorder * TkpGetBorder(void) { - WinBorder *borderPtr = (WinBorder *) ckalloc(sizeof(WinBorder)); + WinBorder *borderPtr = ckalloc(sizeof(WinBorder)); borderPtr->light2ColorPtr = NULL; borderPtr->dark2ColorPtr = NULL; diff --git a/win/tkWinButton.c b/win/tkWinButton.c index 9e1960d..e46bcb3 100644 --- a/win/tkWinButton.c +++ b/win/tkWinButton.c @@ -86,7 +86,7 @@ static void InitBoxes(void); * The class procedure table for the button widgets. */ -Tk_ClassProcs tkpButtonProcs = { +const Tk_ClassProcs tkpButtonProcs = { sizeof(Tk_ClassProcs), /* size */ TkButtonWorldChanged, /* worldChangedProc */ CreateProc, /* createProc */ @@ -131,7 +131,7 @@ InitBoxes(void) ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - hrsrc = FindResource(module, "buttons", RT_BITMAP); + hrsrc = FindResource(module, TEXT("buttons"), RT_BITMAP); if (hrsrc == NULL) { Tcl_Panic("FindResource() failed for buttons bitmap resource, " "resources in tk_base.rc must be linked into Tk dll or static executable"); @@ -148,7 +148,7 @@ InitBoxes(void) && !(tsdPtr->boxesPtr->biHeight % 2)) { size = tsdPtr->boxesPtr->biSize + (1 << tsdPtr->boxesPtr->biBitCount) * sizeof(RGBQUAD) + tsdPtr->boxesPtr->biSizeImage; - newBitmap = (LPBITMAPINFOHEADER) ckalloc(size); + newBitmap = ckalloc(size); memcpy(newBitmap, tsdPtr->boxesPtr, size); tsdPtr->boxesPtr = newBitmap; tsdPtr->boxWidth = tsdPtr->boxesPtr->biWidth / 4; @@ -184,9 +184,9 @@ void TkpButtonSetDefaults() { int width = GetSystemMetrics(SM_CXEDGE); - if (width > 0) { - sprintf(tkDefButtonBorderWidth, "%d", width); - } + if (width > 0) { + sprintf(tkDefButtonBorderWidth, "%d", width); + } } /* @@ -211,7 +211,7 @@ TkpCreateButton( { WinButton *butPtr; - butPtr = (WinButton *)ckalloc(sizeof(WinButton)); + butPtr = ckalloc(sizeof(WinButton)); butPtr->hwnd = NULL; return (TkButton *) butPtr; } @@ -241,15 +241,15 @@ CreateProc( { Window window; HWND parent; - char *class; + const TCHAR *class; WinButton *butPtr = (WinButton *)instanceData; parent = Tk_GetHWND(parentWin); if (butPtr->info.type == TYPE_LABEL) { - class = "STATIC"; + class = TEXT("STATIC"); butPtr->style = SS_OWNERDRAW | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS; } else { - class = "BUTTON"; + class = TEXT("BUTTON"); butPtr->style = BS_OWNERDRAW | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS; } butPtr->hwnd = CreateWindow(class, NULL, butPtr->style, @@ -258,7 +258,7 @@ CreateProc( SetWindowPos(butPtr->hwnd, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE); butPtr->oldProc = (WNDPROC)SetWindowLongPtr(butPtr->hwnd, GWLP_WNDPROC, - (INT_PTR) ButtonProc); + (LONG_PTR) ButtonProc); window = Tk_AttachHWND(tkwin, butPtr->hwnd); return window; @@ -288,7 +288,7 @@ TkpDestroyButton( HWND hwnd = winButPtr->hwnd; if (hwnd) { - SetWindowLongPtr(hwnd, GWLP_WNDPROC, (INT_PTR) winButPtr->oldProc); + SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR) winButPtr->oldProc); } } @@ -1281,7 +1281,7 @@ ButtonProc( if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) { Tcl_AddErrorInfo(interp, "\n (button invoke)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); } Tcl_Release((ClientData)interp); } diff --git a/win/tkWinClipboard.c b/win/tkWinClipboard.c index 76711b5..200883f 100644 --- a/win/tkWinClipboard.c +++ b/win/tkWinClipboard.c @@ -12,6 +12,7 @@ #include "tkWinInt.h" #include "tkSelect.h" +#include <shlobj.h> /* for DROPFILES */ static void UpdateClipboard(HWND hwnd); @@ -52,7 +53,7 @@ TkSelGetSelection( Tcl_DString ds; HGLOBAL handle; Tcl_Encoding encoding; - int result, locale; + int result, locale, noBackslash = 0; if ((selection != Tk_InternAtom(tkwin, "CLIPBOARD")) || (target != XA_STRING) @@ -104,7 +105,7 @@ TkSelGetSelection( */ locale = LANGIDFROMLCID(*((int*)data)); - GetLocaleInfo(locale, LOCALE_IDEFAULTANSICODEPAGE, + GetLocaleInfoA(locale, LOCALE_IDEFAULTANSICODEPAGE, Tcl_DStringValue(&ds)+2, Tcl_DStringLength(&ds)-2); GlobalUnlock(handle); @@ -132,7 +133,37 @@ TkSelGetSelection( if (encoding) { Tcl_FreeEncoding(encoding); } + } else if (IsClipboardFormatAvailable(CF_HDROP)) { + DROPFILES *drop; + handle = GetClipboardData(CF_HDROP); + if (!handle) { + CloseClipboard(); + goto error; + } + Tcl_DStringInit(&ds); + drop = (DROPFILES *) GlobalLock(handle); + if (drop->fWide) { + WCHAR *fname = (WCHAR *) ((char *) drop + drop->pFiles); + Tcl_DString dsTmp; + int count = 0, len; + + while (*fname != 0) { + if (count) { + Tcl_DStringAppend(&ds, "\n", 1); + } + len = Tcl_UniCharLen((Tcl_UniChar *) fname); + Tcl_DStringInit(&dsTmp); + Tcl_UniCharToUtfDString((Tcl_UniChar *) fname, len, &dsTmp); + Tcl_DStringAppend(&ds, Tcl_DStringValue(&dsTmp), + Tcl_DStringLength(&dsTmp)); + Tcl_DStringFree(&dsTmp); + fname += len + 1; + count++; + } + noBackslash = (count > 0); + } + GlobalUnlock(handle); } else { CloseClipboard(); goto error; @@ -146,6 +177,9 @@ TkSelGetSelection( while (*data) { if (data[0] == '\r' && data[1] == '\n') { data++; + } else if (noBackslash && data[0] == '\\') { + data++; + *destPtr++ = '/'; } else { *destPtr++ = *data++; } @@ -156,15 +190,16 @@ TkSelGetSelection( * Pass the data off to the selection procedure. */ - result = (*proc)(clientData, interp, Tcl_DStringValue(&ds)); + result = proc(clientData, interp, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); CloseClipboard(); return result; error: - Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection), - " selection doesn't exist or form \"", - Tk_GetAtomName(tkwin, target), "\" not defined", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s selection doesn't exist or form \"%s\" not defined", + Tk_GetAtomName(tkwin, selection), Tk_GetAtomName(tkwin, target))); + Tcl_SetErrorCode(interp, "TK", "SELECTION", "EXISTS", NULL); return TCL_ERROR; } @@ -274,7 +309,7 @@ TkWinClipboardRender( * Copy the data and change EOL characters. */ - buffer = rawText = ckalloc((unsigned)length + 1); + buffer = rawText = ckalloc(length + 1); if (targetPtr != NULL) { for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL; cbPtr = cbPtr->nextPtr) { @@ -294,7 +329,7 @@ TkWinClipboardRender( * encoding before placing it on the clipboard. */ - if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { +#ifdef UNICODE Tcl_DStringInit(&ds); Tcl_UtfToUniCharDString(rawText, -1, &ds); ckfree(rawText); @@ -310,7 +345,7 @@ TkWinClipboardRender( GlobalUnlock(handle); Tcl_DStringFree(&ds); SetClipboardData(CF_UNICODETEXT, handle); - } else { +#else Tcl_UtfToExternalDString(NULL, rawText, -1, &ds); ckfree(rawText); handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE, @@ -325,7 +360,7 @@ TkWinClipboardRender( GlobalUnlock(handle); Tcl_DStringFree(&ds); SetClipboardData(CF_TEXT, handle); - } +#endif } /* @@ -384,7 +419,7 @@ UpdateClipboard( * possible. */ - if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { + if (TkWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS) { SetClipboardData(CF_UNICODETEXT, NULL); } else { SetClipboardData(CF_TEXT, NULL); diff --git a/win/tkWinColor.c b/win/tkWinColor.c index 20ab2e0..ba9815c 100644 --- a/win/tkWinColor.c +++ b/win/tkWinColor.c @@ -31,11 +31,11 @@ typedef struct WinColor { */ typedef struct { - char *name; + const char *name; int index; } SystemColorEntry; -static SystemColorEntry sysColors[] = { +static const SystemColorEntry sysColors[] = { {"3dDarkShadow", COLOR_3DDKSHADOW}, {"3dLight", COLOR_3DLIGHT}, {"ActiveBorder", COLOR_ACTIVEBORDER}, @@ -61,15 +61,9 @@ static SystemColorEntry sysColors[] = { {"Scrollbar", COLOR_SCROLLBAR}, {"Window", COLOR_WINDOW}, {"WindowFrame", COLOR_WINDOWFRAME}, - {"WindowText", COLOR_WINDOWTEXT}, - {NULL, 0} + {"WindowText", COLOR_WINDOWTEXT} }; -typedef struct ThreadSpecificData { - int ncolors; -} ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; - /* * Forward declarations for functions defined later in this file. */ @@ -102,37 +96,14 @@ FindSystemColor( int *indexPtr) /* Out parameter to store color index. */ { int l, u, r, i; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - - /* - * Count the number of elements in the color array if we haven't done so - * yet. - */ - - if (tsdPtr->ncolors == 0) { - SystemColorEntry *ePtr; - int version; - - version = LOBYTE(LOWORD(GetVersion())); - for (ePtr = sysColors; ePtr->name != NULL; ePtr++) { - if (version < 4) { - if (ePtr->index == COLOR_3DDKSHADOW) { - ePtr->index = COLOR_BTNSHADOW; - } else if (ePtr->index == COLOR_3DLIGHT) { - ePtr->index = COLOR_BTNHIGHLIGHT; - } - } - tsdPtr->ncolors++; - } - } + int index; /* * Perform a binary search on the sorted array of colors. */ l = 0; - u = tsdPtr->ncolors - 1; + u = (sizeof(sysColors) / sizeof(sysColors[0])) - 1; while (l <= u) { i = (l + u) / 2; r = strcasecmp(name, sysColors[i].name); @@ -148,8 +119,8 @@ FindSystemColor( return 0; } - *indexPtr = sysColors[i].index; - colorPtr->pixel = GetSysColor(sysColors[i].index); + *indexPtr = index = sysColors[i].index; + colorPtr->pixel = GetSysColor(index); /* * x257 is (value<<8 + value) to get the properly bit shifted and padded @@ -202,7 +173,7 @@ TkpGetColor( && FindSystemColor(name+6, &color, &index)) || TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), name, &color)) { - winColPtr = (WinColor *) ckalloc(sizeof(WinColor)); + winColPtr = ckalloc(sizeof(WinColor)); winColPtr->info.color = color; winColPtr->index = index; @@ -240,7 +211,7 @@ TkpGetColorByValue( XColor *colorPtr) /* Red, green, and blue fields indicate * desired color. */ { - WinColor *tkColPtr = (WinColor *) ckalloc(sizeof(WinColor)); + WinColor *tkColPtr = ckalloc(sizeof(WinColor)); tkColPtr->info.color.red = colorPtr->red; tkColPtr->info.color.green = colorPtr->green; @@ -345,7 +316,8 @@ XAllocColor( if (GetDeviceCaps(dc, RASTERCAPS) & RC_PALETTE) { unsigned long sizePalette = GetDeviceCaps(dc, SIZEPALETTE); UINT newPixel, closePixel; - int new, refCount; + int new; + size_t refCount; Tcl_HashEntry *entryPtr; UINT index; @@ -375,7 +347,7 @@ XAllocColor( color->blue = closeEntry.peBlue * 257; entry = closeEntry; if (index >= cmap->size) { - OutputDebugString("XAllocColor: Colormap is bigger than we thought"); + OutputDebugStringA("XAllocColor: Colormap is bigger than we thought"); } } else { cmap->size++; @@ -390,9 +362,9 @@ XAllocColor( if (new) { refCount = 1; } else { - refCount = (PTR2INT(Tcl_GetHashValue(entryPtr))) + 1; + refCount = (size_t)Tcl_GetHashValue(entryPtr) + 1; } - Tcl_SetHashValue(entryPtr, INT2PTR(refCount)); + Tcl_SetHashValue(entryPtr, (void *)refCount); } else { /* * Determine what color will actually be used on non-colormap systems. @@ -436,7 +408,8 @@ XFreeColors( { TkWinColormap *cmap = (TkWinColormap *) colormap; COLORREF cref; - UINT count, index, refCount; + UINT count, index; + size_t refCount; int i; PALETTEENTRY entry, *entries; Tcl_HashEntry *entryPtr; @@ -454,27 +427,26 @@ XFreeColors( for (i = 0; i < npixels; i++) { entryPtr = Tcl_FindHashEntry(&cmap->refCounts, INT2PTR(pixels[i])); if (!entryPtr) { - Tcl_Panic("Tried to free a color that isn't allocated."); + Tcl_Panic("Tried to free a color that isn't allocated"); } - refCount = PTR2INT(Tcl_GetHashValue(entryPtr)) - 1; + refCount = (size_t)Tcl_GetHashValue(entryPtr) - 1; if (refCount == 0) { cref = pixels[i] & 0x00ffffff; index = GetNearestPaletteIndex(cmap->palette, cref); GetPaletteEntries(cmap->palette, index, 1, &entry); if (cref == RGB(entry.peRed, entry.peGreen, entry.peBlue)) { count = cmap->size - index; - entries = (PALETTEENTRY *) - ckalloc(sizeof(PALETTEENTRY) * count); + entries = ckalloc(sizeof(PALETTEENTRY) * count); GetPaletteEntries(cmap->palette, index+1, count, entries); SetPaletteEntries(cmap->palette, index, count, entries); - ckfree((char *) entries); + ckfree(entries); cmap->size--; } else { - Tcl_Panic("Tried to free a color that isn't allocated."); + Tcl_Panic("Tried to free a color that isn't allocated"); } Tcl_DeleteHashEntry(entryPtr); } else { - Tcl_SetHashValue(entryPtr, INT2PTR(refCount)); + Tcl_SetHashValue(entryPtr, (size_t)refCount); } } } @@ -524,7 +496,7 @@ XCreateColormap( logPalettePtr->palNumEntries = GetPaletteEntries(sysPal, 0, 256, logPalettePtr->palPalEntry); - cmap = (TkWinColormap *) ckalloc(sizeof(TkWinColormap)); + cmap = ckalloc(sizeof(TkWinColormap)); cmap->size = logPalettePtr->palNumEntries; cmap->stale = 0; cmap->palette = CreatePalette(logPalettePtr); @@ -569,10 +541,10 @@ XFreeColormap( TkWinColormap *cmap = (TkWinColormap *) colormap; if (!DeleteObject(cmap->palette)) { - Tcl_Panic("Unable to free colormap, palette is still selected."); + Tcl_Panic("Unable to free colormap, palette is still selected"); } Tcl_DeleteHashTable(&cmap->refCounts); - ckfree((char *) cmap); + ckfree(cmap); return Success; } diff --git a/win/tkWinConfig.c b/win/tkWinConfig.c index 422e399..aeb9405 100644 --- a/win/tkWinConfig.c +++ b/win/tkWinConfig.c @@ -35,8 +35,8 @@ Tcl_Obj * TkpGetSystemDefault( Tk_Window tkwin, /* A window to use. */ - CONST char *dbName, /* The option database name. */ - CONST char *className) /* The name of the option class. */ + const char *dbName, /* The option database name. */ + const char *className) /* The name of the option class. */ { Tcl_Obj *valueObjPtr; Tk_Uid classUid; diff --git a/win/tkWinCursor.c b/win/tkWinCursor.c index dee3419..622ba4d 100644 --- a/win/tkWinCursor.c +++ b/win/tkWinCursor.c @@ -40,7 +40,7 @@ typedef struct { */ static struct CursorName { - char *name; + const char *name; LPCTSTR id; } cursorNames[] = { {"starting", IDC_APPSTARTING}, @@ -72,7 +72,6 @@ static struct CursorName { */ #define TK_DEFAULT_CURSOR IDC_ARROW - /* *---------------------------------------------------------------------- @@ -100,7 +99,7 @@ TkGetCursorByName( struct CursorName *namePtr; TkWinCursor *cursorPtr; int argc; - CONST char **argv = NULL; + const char **argv = NULL; /* * All cursor names are valid lists of one element (for @@ -114,7 +113,7 @@ TkGetCursorByName( goto badCursorSpec; } - cursorPtr = (TkWinCursor *) ckalloc(sizeof(TkWinCursor)); + cursorPtr = ckalloc(sizeof(TkWinCursor)); cursorPtr->info.cursor = (Tk_Cursor) cursorPtr; cursorPtr->winCursor = NULL; cursorPtr->system = 0; @@ -131,13 +130,14 @@ TkGetCursorByName( */ if (Tcl_IsSafe(interp)) { - Tcl_AppendResult(interp, "can't get cursor from a file in", - " a safe interpreter", NULL); - ckfree((char *) argv); - ckfree((char *) cursorPtr); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't get cursor from a file in a safe interpreter",-1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "CURSOR_FILE", NULL); + ckfree(argv); + ckfree(cursorPtr); return NULL; } - cursorPtr->winCursor = LoadCursorFromFile(&(argv[0][1])); + cursorPtr->winCursor = LoadCursorFromFileA(&(argv[0][1])); } else { /* * Check for the cursor in the system cursor set. @@ -156,22 +156,23 @@ TkGetCursorByName( * one of our application resources. */ - cursorPtr->winCursor = LoadCursor(Tk_GetHINSTANCE(), argv[0]); + cursorPtr->winCursor = LoadCursorA(Tk_GetHINSTANCE(), argv[0]); } else { cursorPtr->system = 1; } } if (cursorPtr->winCursor == NULL) { - ckfree((char *) cursorPtr); + ckfree(cursorPtr); badCursorSpec: - ckfree((char *) argv); - Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"", NULL); + ckfree(argv); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad cursor spec \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "CURSOR", NULL); return NULL; - } else { - ckfree((char *) argv); - return (TkCursor *) cursorPtr; } + ckfree(argv); + return (TkCursor *) cursorPtr; } /* @@ -193,8 +194,8 @@ TkGetCursorByName( TkCursor * TkCreateCursorFromData( Tk_Window tkwin, /* Window in which cursor will be used. */ - CONST char *source, /* Bitmap data for cursor shape. */ - CONST char *mask, /* Bitmap data for cursor mask. */ + const char *source, /* Bitmap data for cursor shape. */ + const char *mask, /* Bitmap data for cursor mask. */ int width, int height, /* Dimensions of cursor. */ int xHot, int yHot, /* Location of hot-spot in cursor. */ XColor fgColor, /* Foreground color for cursor. */ diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index d0bae8f..c52cc4d 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -68,7 +68,7 @@ #define DEF_BUTTON_HIGHLIGHT HIGHLIGHT #define DEF_LABEL_HIGHLIGHT_WIDTH "0" #define DEF_BUTTON_HIGHLIGHT_WIDTH "1" -#define DEF_BUTTON_IMAGE (char *) NULL +#define DEF_BUTTON_IMAGE ((char *) NULL) #define DEF_BUTTON_INDICATOR "1" #define DEF_BUTTON_JUSTIFY "center" #define DEF_BUTTON_OFF_VALUE "0" @@ -84,10 +84,10 @@ #define DEF_BUTTON_REPEAT_INTERVAL "0" #define DEF_BUTTON_SELECT_COLOR INDICATOR #define DEF_BUTTON_SELECT_MONO BLACK -#define DEF_BUTTON_SELECT_IMAGE (char *) NULL +#define DEF_BUTTON_SELECT_IMAGE ((char *) NULL) #define DEF_BUTTON_STATE "normal" #define DEF_LABEL_TAKE_FOCUS "0" -#define DEF_BUTTON_TAKE_FOCUS (char *) NULL +#define DEF_BUTTON_TAKE_FOCUS ((char *) NULL) #define DEF_BUTTON_TEXT "" #define DEF_BUTTON_TEXT_VARIABLE "" #define DEF_BUTTON_TRISTATE_VALUE "" @@ -126,7 +126,7 @@ #define DEF_CANVAS_SELECT_BD_MONO "0" #define DEF_CANVAS_SELECT_FG_COLOR SELECT_FG #define DEF_CANVAS_SELECT_FG_MONO WHITE -#define DEF_CANVAS_TAKE_FOCUS (char *) NULL +#define DEF_CANVAS_TAKE_FOCUS ((char *) NULL) #define DEF_CANVAS_WIDTH "10c" #define DEF_CANVAS_X_SCROLL_CMD "" #define DEF_CANVAS_X_SCROLL_INCREMENT "0" @@ -167,9 +167,9 @@ #define DEF_ENTRY_SELECT_BD_MONO "0" #define DEF_ENTRY_SELECT_FG_COLOR SELECT_FG #define DEF_ENTRY_SELECT_FG_MONO WHITE -#define DEF_ENTRY_SHOW (char *) NULL +#define DEF_ENTRY_SHOW ((char *) NULL) #define DEF_ENTRY_STATE "normal" -#define DEF_ENTRY_TAKE_FOCUS (char *) NULL +#define DEF_ENTRY_TAKE_FOCUS ((char *) NULL) #define DEF_ENTRY_TEXT_VARIABLE "" #define DEF_ENTRY_WIDTH "20" @@ -235,36 +235,36 @@ #define DEF_LISTBOX_SELECT_MODE "browse" #define DEF_LISTBOX_SET_GRID "0" #define DEF_LISTBOX_STATE "normal" -#define DEF_LISTBOX_TAKE_FOCUS (char *) NULL +#define DEF_LISTBOX_TAKE_FOCUS ((char *) NULL) #define DEF_LISTBOX_WIDTH "20" /* * Defaults for individual entries of menus: */ -#define DEF_MENU_ENTRY_ACTIVE_BG (char *) NULL -#define DEF_MENU_ENTRY_ACTIVE_FG (char *) NULL -#define DEF_MENU_ENTRY_ACCELERATOR (char *) NULL -#define DEF_MENU_ENTRY_BG (char *) NULL +#define DEF_MENU_ENTRY_ACTIVE_BG ((char *) NULL) +#define DEF_MENU_ENTRY_ACTIVE_FG ((char *) NULL) +#define DEF_MENU_ENTRY_ACCELERATOR ((char *) NULL) +#define DEF_MENU_ENTRY_BG ((char *) NULL) #define DEF_MENU_ENTRY_BITMAP None #define DEF_MENU_ENTRY_COLUMN_BREAK "0" -#define DEF_MENU_ENTRY_COMMAND (char *) NULL +#define DEF_MENU_ENTRY_COMMAND ((char *) NULL) #define DEF_MENU_ENTRY_COMPOUND "none" -#define DEF_MENU_ENTRY_FG (char *) NULL -#define DEF_MENU_ENTRY_FONT (char *) NULL +#define DEF_MENU_ENTRY_FG ((char *) NULL) +#define DEF_MENU_ENTRY_FONT ((char *) NULL) #define DEF_MENU_ENTRY_HIDE_MARGIN "0" -#define DEF_MENU_ENTRY_IMAGE (char *) NULL +#define DEF_MENU_ENTRY_IMAGE ((char *) NULL) #define DEF_MENU_ENTRY_INDICATOR "1" -#define DEF_MENU_ENTRY_LABEL (char *) NULL -#define DEF_MENU_ENTRY_MENU (char *) NULL +#define DEF_MENU_ENTRY_LABEL ((char *) NULL) +#define DEF_MENU_ENTRY_MENU ((char *) NULL) #define DEF_MENU_ENTRY_OFF_VALUE "0" #define DEF_MENU_ENTRY_ON_VALUE "1" -#define DEF_MENU_ENTRY_SELECT_IMAGE (char *) NULL +#define DEF_MENU_ENTRY_SELECT_IMAGE ((char *) NULL) #define DEF_MENU_ENTRY_STATE "normal" -#define DEF_MENU_ENTRY_VALUE (char *) NULL -#define DEF_MENU_ENTRY_CHECK_VARIABLE (char *) NULL +#define DEF_MENU_ENTRY_VALUE ((char *) NULL) +#define DEF_MENU_ENTRY_CHECK_VARIABLE ((char *) NULL) #define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton" -#define DEF_MENU_ENTRY_SELECT (char *) NULL +#define DEF_MENU_ENTRY_SELECT ((char *) NULL) #define DEF_MENU_ENTRY_UNDERLINE "-1" /* @@ -290,7 +290,7 @@ #define DEF_MENU_SELECT_MONO BLACK #define DEF_MENU_TAKE_FOCUS "0" #define DEF_MENU_TEAROFF "1" -#define DEF_MENU_TEAROFF_CMD (char *) NULL +#define DEF_MENU_TEAROFF_CMD ((char *) NULL) #define DEF_MENU_TITLE "" #define DEF_MENU_TYPE "normal" @@ -318,7 +318,7 @@ #define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO DEF_MENUBUTTON_BG_MONO #define DEF_MENUBUTTON_HIGHLIGHT HIGHLIGHT #define DEF_MENUBUTTON_HIGHLIGHT_WIDTH "0" -#define DEF_MENUBUTTON_IMAGE (char *) NULL +#define DEF_MENUBUTTON_IMAGE ((char *) NULL) #define DEF_MENUBUTTON_INDICATOR "0" #define DEF_MENUBUTTON_JUSTIFY "center" #define DEF_MENUBUTTON_MENU "" @@ -419,7 +419,7 @@ #define DEF_SCALE_LENGTH "100" #define DEF_SCALE_ORIENT "vertical" #define DEF_SCALE_RELIEF "flat" -#define DEF_SCALE_REPEAT_DELAY "300" +#define DEF_SCALE_REPEAT_DELAY "300" #define DEF_SCALE_REPEAT_INTERVAL "100" #define DEF_SCALE_RESOLUTION "1" #define DEF_SCALE_TROUGH_COLOR TROUGH @@ -428,7 +428,7 @@ #define DEF_SCALE_SLIDER_LENGTH "30" #define DEF_SCALE_SLIDER_RELIEF "raised" #define DEF_SCALE_STATE "normal" -#define DEF_SCALE_TAKE_FOCUS (char *) NULL +#define DEF_SCALE_TAKE_FOCUS ((char *) NULL) #define DEF_SCALE_TICK_INTERVAL "0" #define DEF_SCALE_TO "100" #define DEF_SCALE_VARIABLE "" @@ -455,7 +455,7 @@ #define DEF_SCROLLBAR_RELIEF "sunken" #define DEF_SCROLLBAR_REPEAT_DELAY "300" #define DEF_SCROLLBAR_REPEAT_INTERVAL "100" -#define DEF_SCROLLBAR_TAKE_FOCUS (char *) NULL +#define DEF_SCROLLBAR_TAKE_FOCUS ((char *) NULL) #define DEF_SCROLLBAR_TROUGH_COLOR TROUGH #define DEF_SCROLLBAR_TROUGH_MONO WHITE #define DEF_SCROLLBAR_WIDTH "10" @@ -482,8 +482,9 @@ #define DEF_TEXT_INSERT_BD_MONO "0" #define DEF_TEXT_INSERT_OFF_TIME "300" #define DEF_TEXT_INSERT_ON_TIME "600" +#define DEF_TEXT_INSERT_UNFOCUSSED "none" #define DEF_TEXT_INSERT_WIDTH "2" -#define DEF_TEXT_MAX_UNDO "0" +#define DEF_TEXT_MAX_UNDO "0" #define DEF_TEXT_PADX "1" #define DEF_TEXT_PADY "1" #define DEF_TEXT_RELIEF "sunken" @@ -502,8 +503,8 @@ #define DEF_TEXT_STATE "normal" #define DEF_TEXT_TABS "" #define DEF_TEXT_TABSTYLE "tabular" -#define DEF_TEXT_TAKE_FOCUS (char *) NULL -#define DEF_TEXT_UNDO "0" +#define DEF_TEXT_TAKE_FOCUS ((char *) NULL) +#define DEF_TEXT_UNDO "0" #define DEF_TEXT_WIDTH "80" #define DEF_TEXT_WRAP "char" #define DEF_TEXT_XSCROLL_COMMAND "" @@ -525,4 +526,10 @@ #define DEF_TOPLEVEL_SCREEN "" #define DEF_TOPLEVEL_USE "" +/* + * Defaults for busy windows: + */ + +#define DEF_BUSY_CURSOR "wait" + #endif /* _TKWINDEFAULT */ diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index e03862c..d7f63fb 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -8,24 +8,25 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#define WINVER 0x0500 /* Requires Windows 2K definitions */ -#define _WIN32_WINNT 0x0500 + #include "tkWinInt.h" #include "tkFileFilter.h" +#include "tkFont.h" #include <commdlg.h> /* includes common dialog functionality */ -#ifdef _MSC_VER -# pragma comment (lib, "comdlg32.lib") -#endif #include <dlgs.h> /* includes common dialog template defines */ #include <cderr.h> /* includes the common dialog error codes */ #include <shlobj.h> /* includes SHBrowseForFolder */ + #ifdef _MSC_VER # pragma comment (lib, "shell32.lib") +# pragma comment (lib, "comdlg32.lib") +# pragma comment (lib, "uuid.lib") #endif /* These needed for compilation with VC++ 5.2 */ +/* XXX - remove these since need at least VC 6 */ #ifndef BIF_EDITBOX #define BIF_EDITBOX 0x10 #endif @@ -34,6 +35,7 @@ #define BIF_VALIDATE 0x0020 #endif +/* This "new" dialog style is now actually the "old" dialog style post-Vista */ #ifndef BIF_NEWDIALOGSTYLE #define BIF_NEWDIALOGSTYLE 0x0040 #endif @@ -46,10 +48,6 @@ #endif #endif /* BFFM_VALIDATEFAILED */ -#ifndef OPENFILENAME_SIZE_VERSION_400 -#define OPENFILENAME_SIZE_VERSION_400 76 -#endif - typedef struct ThreadSpecificData { int debugFlag; /* Flags whether we should output debugging * information while displaying a builtin @@ -61,6 +59,10 @@ typedef struct ThreadSpecificData { HHOOK hMsgBoxHook; /* Hook proc for tk_messageBox and the */ HICON hSmallIcon; /* icons used by a parent to be used in */ HICON hBigIcon; /* the message box */ + int newFileDialogsState; +#define FDLG_STATE_INIT 0 /* Uninitialized */ +#define FDLG_STATE_USE_NEW 1 /* Use the new dialogs */ +#define FDLG_STATE_USE_OLD 2 /* Use the old dialogs */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -118,11 +120,11 @@ static const struct {int type; int btnIds[3];} allowedTypes[] = { */ #define TkWinGetHInstance(from) \ - ((HINSTANCE) GetWindowLongPtrW((from), GWLP_HINSTANCE)) + ((HINSTANCE) GetWindowLongPtr((from), GWLP_HINSTANCE)) #define TkWinGetUserData(from) \ - GetWindowLongPtrW((from), GWLP_USERDATA) + GetWindowLongPtr((from), GWLP_USERDATA) #define TkWinSetUserData(to,what) \ - SetWindowLongPtrW((to), GWLP_USERDATA, (LPARAM)(what)) + SetWindowLongPtr((to), GWLP_USERDATA, (LPARAM)(what)) /* * The value of TK_MULTI_MAX_PATH dictates how many files can be retrieved @@ -141,8 +143,8 @@ static const struct {int type; int btnIds[3];} allowedTypes[] = { */ typedef struct { - WCHAR initDir[MAX_PATH]; /* Initial folder to use */ - WCHAR retDir[MAX_PATH]; /* Returned folder to use */ + TCHAR initDir[MAX_PATH]; /* Initial folder to use */ + TCHAR retDir[MAX_PATH]; /* Returned folder to use */ Tcl_Interp *interp; int mustExist; /* True if file must exist to return from * callback */ @@ -159,10 +161,412 @@ typedef struct OFNData { int dynFileBufferSize; /* Dynamic filename buffer size, stored to * avoid shrinking and expanding the buffer * when selection changes */ - WCHAR *dynFileBuffer; /* Dynamic filename buffer */ + TCHAR *dynFileBuffer; /* Dynamic filename buffer */ } OFNData; /* + * The following structure is used to gather options used by various + * file dialogs + */ +typedef struct OFNOpts { + Tk_Window tkwin; /* Owner window for dialog */ + Tcl_Obj *extObj; /* Default extension */ + Tcl_Obj *titleObj; /* Title for dialog */ + Tcl_Obj *filterObj; /* File type filter list */ + Tcl_Obj *typeVariableObj; /* Variable in which to store type selected */ + Tcl_Obj *initialTypeObj; /* Initial value of above, or NULL */ + Tcl_DString utfDirString; /* Initial dir */ + int multi; /* Multiple selection enabled */ + int confirmOverwrite; /* Confirm before overwriting */ + int mustExist; /* Used only for */ + int forceXPStyle; /* XXX - Force XP style even on newer systems */ + TCHAR file[TK_MULTI_MAX_PATH]; /* File name + XXX - fixed size because it was so + historically. Why not malloc'ed ? + XXX - also, TCHAR should really be WCHAR + because TkWinGetUnicodeEncoding is always + UCS2. + */ +} OFNOpts; + +/* Define the operation for which option parsing is to be done. */ +enum OFNOper { + OFN_FILE_SAVE, /* tk_getOpenFile */ + OFN_FILE_OPEN, /* tk_getSaveFile */ + OFN_DIR_CHOOSE /* tk_chooseDirectory */ +}; + + +/* + * The following definitions are required when using older versions of + * Visual C++ (like 6.0) and possibly MingW. Those headers do not contain + * required definitions for interfaces new to Vista that we need for + * the new file dialogs. Duplicating definitions is OK because they + * should forever remain unchanged. + * + * XXX - is there a better/easier way to use new data definitions with + * older compilers? Should we prefix definitions with Tcl_ instead + * of using the same names as in the SDK? + */ +#ifndef __IShellItem_INTERFACE_DEFINED__ +# define __IShellItem_INTERFACE_DEFINED__ +#ifdef __MSVCRT__ +typedef struct IShellItem IShellItem; + +typedef enum __MIDL_IShellItem_0001 { + SIGDN_NORMALDISPLAY = 0,SIGDN_PARENTRELATIVEPARSING = 0x80018001,SIGDN_PARENTRELATIVEFORADDRESSBAR = 0x8001c001, + SIGDN_DESKTOPABSOLUTEPARSING = 0x80028000,SIGDN_PARENTRELATIVEEDITING = 0x80031001,SIGDN_DESKTOPABSOLUTEEDITING = 0x8004c000, + SIGDN_FILESYSPATH = 0x80058000,SIGDN_URL = 0x80068000 +} SIGDN; + +typedef DWORD SICHINTF; + +typedef struct IShellItemVtbl +{ + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface)(IShellItem *, REFIID, void **); + ULONG (STDMETHODCALLTYPE *AddRef)(IShellItem *); + ULONG (STDMETHODCALLTYPE *Release)(IShellItem *); + HRESULT (STDMETHODCALLTYPE *BindToHandler)(IShellItem *, IBindCtx *, REFGUID, REFIID, void **); + HRESULT (STDMETHODCALLTYPE *GetParent)(IShellItem *, IShellItem **); + HRESULT (STDMETHODCALLTYPE *GetDisplayName)(IShellItem *, SIGDN, LPOLESTR *); + HRESULT (STDMETHODCALLTYPE *GetAttributes)(IShellItem *, SFGAOF, SFGAOF *); + HRESULT (STDMETHODCALLTYPE *Compare)(IShellItem *, IShellItem *, SICHINTF, int *); + + END_INTERFACE +} IShellItemVtbl; +struct IShellItem { + CONST_VTBL struct IShellItemVtbl *lpVtbl; +}; +#endif +#endif + +#ifndef __IShellItemArray_INTERFACE_DEFINED__ +#define __IShellItemArray_INTERFACE_DEFINED__ + +typedef enum SIATTRIBFLAGS { + SIATTRIBFLAGS_AND = 0x1, + SIATTRIBFLAGS_OR = 0x2, + SIATTRIBFLAGS_APPCOMPAT = 0x3, + SIATTRIBFLAGS_MASK = 0x3, + SIATTRIBFLAGS_ALLITEMS = 0x4000 +} SIATTRIBFLAGS; +#ifdef __MSVCRT__ +typedef ULONG SFGAOF; +#endif /* __MSVCRT__ */ +typedef struct IShellItemArray IShellItemArray; +typedef struct IShellItemArrayVtbl +{ + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IShellItemArray *, REFIID riid,void **ppvObject); + ULONG ( STDMETHODCALLTYPE *AddRef )(IShellItemArray *); + ULONG ( STDMETHODCALLTYPE *Release )(IShellItemArray *); + HRESULT ( STDMETHODCALLTYPE *BindToHandler )(IShellItemArray *, + IBindCtx *, REFGUID, REFIID, void **); + /* flags is actually is enum GETPROPERTYSTOREFLAGS */ + HRESULT ( STDMETHODCALLTYPE *GetPropertyStore )( + IShellItemArray *, int, REFIID, void **); + /* keyType actually REFPROPERTYKEY */ + HRESULT ( STDMETHODCALLTYPE *GetPropertyDescriptionList )( + IShellItemArray *, void *, REFIID, void **); + HRESULT ( STDMETHODCALLTYPE *GetAttributes )(IShellItemArray *, + SIATTRIBFLAGS, SFGAOF, SFGAOF *); + HRESULT ( STDMETHODCALLTYPE *GetCount )( + IShellItemArray *, DWORD *); + HRESULT ( STDMETHODCALLTYPE *GetItemAt )( + IShellItemArray *, DWORD, IShellItem **); + /* ppenumShellItems actually (IEnumShellItems **) */ + HRESULT ( STDMETHODCALLTYPE *EnumItems )( + IShellItemArray *, void **); + + END_INTERFACE +} IShellItemArrayVtbl; + +struct IShellItemArray { + CONST_VTBL struct IShellItemArrayVtbl *lpVtbl; +}; + +#endif /* __IShellItemArray_INTERFACE_DEFINED__ */ + +/* + * Older compilers do not define these CLSIDs so we do so here under + * a slightly different name so as to not clash with the definitions + * in new compilers + */ +static const CLSID ClsidFileOpenDialog = { + 0xDC1C5A9C, 0xE88A, 0X4DDE, {0xA5, 0xA1, 0x60, 0xF8, 0x2A, 0x20, 0xAE, 0xF7} +}; +static const CLSID ClsidFileSaveDialog = { + 0xC0B4E2F3, 0xBA21, 0x4773, {0x8D, 0xBA, 0x33, 0x5E, 0xC9, 0x46, 0xEB, 0x8B} +}; +static const IID IIDIFileOpenDialog = { + 0xD57C7288, 0xD4AD, 0x4768, {0xBE, 0x02, 0x9D, 0x96, 0x95, 0x32, 0xD9, 0x60} +}; +static const IID IIDIFileSaveDialog = { + 0x84BCCD23, 0x5FDE, 0x4CDB, {0xAE, 0xA4, 0xAF, 0x64, 0xB8, 0x3D, 0x78, 0xAB} +}; +static const IID IIDIShellItem = { + 0x43826D1E, 0xE718, 0x42EE, {0xBC, 0x55, 0xA1, 0xE2, 0x61, 0xC3, 0x7B, 0xFE} +}; + +#ifdef __IFileDialog_INTERFACE_DEFINED__ +# define TCLCOMDLG_FILTERSPEC COMDLG_FILTERSPEC +#else + +/* Forward declarations for structs that are referenced but not used */ +typedef struct IPropertyStore IPropertyStore; +typedef struct IPropertyDescriptionList IPropertyDescriptionList; +typedef struct IFileOperationProgressSink IFileOperationProgressSink; +typedef enum FDAP { + FDAP_BOTTOM = 0, + FDAP_TOP = 1 +} FDAP; + +typedef struct { + LPCWSTR pszName; + LPCWSTR pszSpec; +} TCLCOMDLG_FILTERSPEC; + +enum _FILEOPENDIALOGOPTIONS { + FOS_OVERWRITEPROMPT = 0x2, + FOS_STRICTFILETYPES = 0x4, + FOS_NOCHANGEDIR = 0x8, + FOS_PICKFOLDERS = 0x20, + FOS_FORCEFILESYSTEM = 0x40, + FOS_ALLNONSTORAGEITEMS = 0x80, + FOS_NOVALIDATE = 0x100, + FOS_ALLOWMULTISELECT = 0x200, + FOS_PATHMUSTEXIST = 0x800, + FOS_FILEMUSTEXIST = 0x1000, + FOS_CREATEPROMPT = 0x2000, + FOS_SHAREAWARE = 0x4000, + FOS_NOREADONLYRETURN = 0x8000, + FOS_NOTESTFILECREATE = 0x10000, + FOS_HIDEMRUPLACES = 0x20000, + FOS_HIDEPINNEDPLACES = 0x40000, + FOS_NODEREFERENCELINKS = 0x100000, + FOS_DONTADDTORECENT = 0x2000000, + FOS_FORCESHOWHIDDEN = 0x10000000, + FOS_DEFAULTNOMINIMODE = 0x20000000, + FOS_FORCEPREVIEWPANEON = 0x40000000 +} ; +typedef DWORD FILEOPENDIALOGOPTIONS; + +typedef struct IFileDialog IFileDialog; +typedef struct IFileDialogVtbl +{ + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IFileDialog *, REFIID, void **); + ULONG ( STDMETHODCALLTYPE *AddRef )( IFileDialog *); + ULONG ( STDMETHODCALLTYPE *Release )( IFileDialog *); + HRESULT ( STDMETHODCALLTYPE *Show )( IFileDialog *, HWND); + HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileDialog *, + UINT, const TCLCOMDLG_FILTERSPEC *); + HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(IFileDialog *, UINT); + HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(IFileDialog *, UINT *); + /* XXX - Actually pfde is IFileDialogEvents* but we do not use + this call and do not want to define IFileDialogEvents as that + pulls in a whole bunch of other stuff. */ + HRESULT ( STDMETHODCALLTYPE *Advise )( + IFileDialog *, void *, DWORD *); + HRESULT ( STDMETHODCALLTYPE *Unadvise )(IFileDialog *, DWORD); + HRESULT ( STDMETHODCALLTYPE *SetOptions )( + IFileDialog *, FILEOPENDIALOGOPTIONS); + HRESULT ( STDMETHODCALLTYPE *GetOptions )( + IFileDialog *, FILEOPENDIALOGOPTIONS *); + HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( + IFileDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *SetFolder )( + IFileDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *GetFolder )( + IFileDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( + IFileDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *SetFileName )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetFileName )( + IFileDialog *, LPWSTR *); + HRESULT ( STDMETHODCALLTYPE *SetTitle )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetResult )( + IFileDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *AddPlace )( + IFileDialog *, IShellItem *, FDAP); + HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( + IFileDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *Close )( IFileDialog *, HRESULT); + HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( + IFileDialog *, REFGUID); + HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileDialog *); + /* pFilter actually IShellItemFilter. But deprecated in Win7 AND we do + not use it anyways. So define as void* */ + HRESULT ( STDMETHODCALLTYPE *SetFilter )( + IFileDialog *, void *); + + END_INTERFACE +} IFileDialogVtbl; + +struct IFileDialog { + CONST_VTBL struct IFileDialogVtbl *lpVtbl; +}; + + +typedef struct IFileSaveDialog IFileSaveDialog; +typedef struct IFileSaveDialogVtbl { + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IFileSaveDialog *, REFIID, void **); + ULONG ( STDMETHODCALLTYPE *AddRef )( IFileSaveDialog *); + ULONG ( STDMETHODCALLTYPE *Release )( IFileSaveDialog *); + HRESULT ( STDMETHODCALLTYPE *Show )( + IFileSaveDialog *, HWND); + HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileSaveDialog * this, + UINT, const TCLCOMDLG_FILTERSPEC *); + HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )( + IFileSaveDialog *, UINT); + HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )( + IFileSaveDialog *, UINT *); + /* Actually pfde is IFileSaveDialogEvents* */ + HRESULT ( STDMETHODCALLTYPE *Advise )( + IFileSaveDialog *, void *, DWORD *); + HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileSaveDialog *, DWORD); + HRESULT ( STDMETHODCALLTYPE *SetOptions )( + IFileSaveDialog *, FILEOPENDIALOGOPTIONS); + HRESULT ( STDMETHODCALLTYPE *GetOptions )( + IFileSaveDialog *, FILEOPENDIALOGOPTIONS *); + HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( + IFileSaveDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *SetFolder )( + IFileSaveDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *GetFolder )( + IFileSaveDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( + IFileSaveDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *SetFileName )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetFileName )( + IFileSaveDialog *, LPWSTR *); + HRESULT ( STDMETHODCALLTYPE *SetTitle )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetResult )( + IFileSaveDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *AddPlace )( + IFileSaveDialog *, IShellItem *, FDAP); + HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( + IFileSaveDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *Close )( IFileSaveDialog *, HRESULT); + HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( + IFileSaveDialog *, REFGUID); + HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileSaveDialog *); + /* pFilter Actually IShellItemFilter* */ + HRESULT ( STDMETHODCALLTYPE *SetFilter )( + IFileSaveDialog *, void *); + HRESULT ( STDMETHODCALLTYPE *SetSaveAsItem )( + IFileSaveDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *SetProperties )( + IFileSaveDialog *, IPropertyStore *); + HRESULT ( STDMETHODCALLTYPE *SetCollectedProperties )( + IFileSaveDialog *, IPropertyDescriptionList *, BOOL); + HRESULT ( STDMETHODCALLTYPE *GetProperties )( + IFileSaveDialog *, IPropertyStore **); + HRESULT ( STDMETHODCALLTYPE *ApplyProperties )( + IFileSaveDialog *, IShellItem *, IPropertyStore *, + HWND, IFileOperationProgressSink *); + + END_INTERFACE + +} IFileSaveDialogVtbl; + +struct IFileSaveDialog { + CONST_VTBL struct IFileSaveDialogVtbl *lpVtbl; +}; + +typedef struct IFileOpenDialog IFileOpenDialog; +typedef struct IFileOpenDialogVtbl { + BEGIN_INTERFACE + + HRESULT ( STDMETHODCALLTYPE *QueryInterface )( + IFileOpenDialog *, REFIID, void **); + ULONG ( STDMETHODCALLTYPE *AddRef )( IFileOpenDialog *); + ULONG ( STDMETHODCALLTYPE *Release )( IFileOpenDialog *); + HRESULT ( STDMETHODCALLTYPE *Show )( IFileOpenDialog *, HWND); + HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileOpenDialog *, + UINT, const TCLCOMDLG_FILTERSPEC *); + HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )( + IFileOpenDialog *, UINT); + HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )( + IFileOpenDialog *, UINT *); + /* Actually pfde is IFileDialogEvents* */ + HRESULT ( STDMETHODCALLTYPE *Advise )( + IFileOpenDialog *, void *, DWORD *); + HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileOpenDialog *, DWORD); + HRESULT ( STDMETHODCALLTYPE *SetOptions )( + IFileOpenDialog *, FILEOPENDIALOGOPTIONS); + HRESULT ( STDMETHODCALLTYPE *GetOptions )( + IFileOpenDialog *, FILEOPENDIALOGOPTIONS *); + HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( + IFileOpenDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *SetFolder )( + IFileOpenDialog *, IShellItem *); + HRESULT ( STDMETHODCALLTYPE *GetFolder )( + IFileOpenDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( + IFileOpenDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *SetFileName )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetFileName )( + IFileOpenDialog *, LPWSTR *); + HRESULT ( STDMETHODCALLTYPE *SetTitle )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *GetResult )( + IFileOpenDialog *, IShellItem **); + HRESULT ( STDMETHODCALLTYPE *AddPlace )( + IFileOpenDialog *, IShellItem *, FDAP); + HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( + IFileOpenDialog *, LPCWSTR); + HRESULT ( STDMETHODCALLTYPE *Close )( IFileOpenDialog *, HRESULT); + HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( + IFileOpenDialog *, REFGUID); + HRESULT ( STDMETHODCALLTYPE *ClearClientData )( + IFileOpenDialog *); + HRESULT ( STDMETHODCALLTYPE *SetFilter )( + IFileOpenDialog *, + /* pFilter is actually IShellItemFilter */ + void *); + HRESULT ( STDMETHODCALLTYPE *GetResults )( + IFileOpenDialog *, IShellItemArray **); + HRESULT ( STDMETHODCALLTYPE *GetSelectedItems )( + IFileOpenDialog *, IShellItemArray **); + + END_INTERFACE +} IFileOpenDialogVtbl; + +struct IFileOpenDialog +{ + CONST_VTBL struct IFileOpenDialogVtbl *lpVtbl; +}; + +#endif /* __IFileDialog_INTERFACE_DEFINED__ */ + +/* * Definitions of functions used only in this file. */ @@ -170,9 +574,21 @@ static UINT APIENTRY ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg, LPARAM wParam, LPARAM lParam); static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam, LPARAM lParam); +static void CleanupOFNOptions(OFNOpts *optsPtr); +static int ParseOFNOptions(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], enum OFNOper oper, OFNOpts *optsPtr); +static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr, + enum OFNOper oper); +static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr, + enum OFNOper oper); static int GetFileName(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[], int isOpen); + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], enum OFNOper oper); +static int MakeFilterVista(Tcl_Interp *interp, OFNOpts *optsPtr, + DWORD *countPtr, TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr, + DWORD *defaultFilterIndexPtr); +static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr); static int MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_DString *dsPtr, Tcl_Obj *initialPtr, int *indexPtr); @@ -180,8 +596,68 @@ static UINT APIENTRY OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam, LPARAM lParam); static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam); static void SetTkDialog(ClientData clientData); -static const char *ConvertExternalFilename(WCHAR *filename, +static const char *ConvertExternalFilename(TCHAR *filename, Tcl_DString *dsPtr); +static void LoadShellProcs(void); + + +/* Definitions of dynamically loaded Win32 calls */ +typedef HRESULT (STDAPICALLTYPE SHCreateItemFromParsingNameProc)( + PCWSTR pszPath, IBindCtx *pbc, REFIID riid, void **ppv); +struct ShellProcPointers { + SHCreateItemFromParsingNameProc *SHCreateItemFromParsingName; +} ShellProcs; + + +/* + *------------------------------------------------------------------------- + * + * LoadShellProcs -- + * + * Some shell functions are not available on older versions of + * Windows. This function dynamically loads them and stores pointers + * to them in ShellProcs. Any function that is not available has + * the corresponding pointer set to NULL. + * + * Note this call never fails. Unavailability of a function is not + * a reason for failure. Caller should check whether a particular + * function pointer is NULL or not. Once loaded a function stays + * forever loaded. + * + * XXX - we load the function pointers into global memory. This implies + * there is a potential (however small) for race conditions between + * threads. However, Tk is in any case meant to be loaded in exactly + * one thread so this should not be an issue and saves us from + * unnecessary bookkeeping. + * + * Return value: + * None. + * + * Side effects: + * ShellProcs is populated. + *------------------------------------------------------------------------- + */ +static void LoadShellProcs() +{ + static HMODULE shell32_handle = NULL; + + if (shell32_handle != NULL) + return; /* We have already been through here. */ + + /* + * XXX - Note we never call FreeLibrary. There is no point because + * shell32.dll is loaded at startup anyways and stays for the duration + * of the process so why bother with keeping track of when to unload + */ + shell32_handle = LoadLibrary(TEXT("shell32.dll")); + if (shell32_handle == NULL) /* Should never happen but check anyways. */ + return; + + ShellProcs.SHCreateItemFromParsingName = + (SHCreateItemFromParsingNameProc*) GetProcAddress(shell32_handle, + "SHCreateItemFromParsingName"); +} + /* *------------------------------------------------------------------------- @@ -252,7 +728,7 @@ void TkWinDialogDebug( int debug) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->debugFlag = debug; @@ -284,14 +760,14 @@ Tk_ChooseColorObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData, parent; + Tk_Window tkwin = clientData, parent; HWND hWnd; int i, oldMode, winCode, result; - CHOOSECOLORW chooseColor; + CHOOSECOLOR chooseColor; static int inited = 0; static COLORREF dwCustColors[16]; static long oldColor; /* the color selected last time */ - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "-initialcolor", "-parent", "-title", NULL }; enum options { @@ -315,7 +791,7 @@ Tk_ChooseColorObjCmd( } parent = tkwin; - chooseColor.lStructSize = sizeof(CHOOSECOLORW); + chooseColor.lStructSize = sizeof(CHOOSECOLOR); chooseColor.hwndOwner = NULL; chooseColor.hInstance = NULL; chooseColor.rgbResult = oldColor; @@ -323,7 +799,7 @@ Tk_ChooseColorObjCmd( chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK; chooseColor.lCustData = (LPARAM) NULL; chooseColor.lpfnHook = (LPOFNHOOKPROC) ColorDlgHookProc; - chooseColor.lpTemplateName = (LPWSTR) interp; + chooseColor.lpTemplateName = (LPTSTR) interp; for (i = 1; i < objc; i += 2) { int index; @@ -333,14 +809,14 @@ Tk_ChooseColorObjCmd( optionPtr = objv[i]; valuePtr = objv[i + 1]; - if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } if (i + 1 == objc) { - string = Tcl_GetString(optionPtr); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", NULL); return TCL_ERROR; } @@ -375,7 +851,7 @@ Tk_ChooseColorObjCmd( chooseColor.hwndOwner = hWnd; oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - winCode = ChooseColorW(&chooseColor); + winCode = ChooseColor(&chooseColor); (void) Tcl_SetServiceMode(oldMode); /* @@ -401,13 +877,11 @@ Tk_ChooseColorObjCmd( /* * User has selected a color */ - char color[100]; - sprintf(color, "#%02x%02x%02x", + Tcl_SetObjResult(interp, Tcl_ObjPrintf("#%02x%02x%02x", GetRValue(chooseColor.rgbResult), GetGValue(chooseColor.rgbResult), - GetBValue(chooseColor.rgbResult)); - Tcl_AppendResult(interp, color, NULL); + GetBValue(chooseColor.rgbResult))); oldColor = chooseColor.rgbResult; result = TCL_OK; } @@ -440,10 +914,10 @@ ColorDlgHookProc( WPARAM wParam, /* First message parameter. */ LPARAM lParam) /* Second message parameter. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); const char *title; - CHOOSECOLORW *ccPtr; + CHOOSECOLOR *ccPtr; if (WM_INITDIALOG == uMsg) { @@ -451,18 +925,18 @@ ColorDlgHookProc( * Set the title string of the dialog. */ - ccPtr = (CHOOSECOLORW *) lParam; + ccPtr = (CHOOSECOLOR *) lParam; title = (const char *) ccPtr->lCustData; if ((title != NULL) && (title[0] != '\0')) { Tcl_DString ds; - SetWindowTextW(hDlg, (WCHAR *)Tcl_WinUtfToTChar(title,-1,&ds)); + SetWindowText(hDlg, Tcl_WinUtfToTChar(title,-1,&ds)); Tcl_DStringFree(&ds); } if (tsdPtr->debugFlag) { tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName; - Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg); + Tcl_DoWhenIdle(SetTkDialog, hDlg); } return TRUE; } @@ -493,7 +967,7 @@ Tk_GetOpenFileObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return GetFileName(clientData, interp, objc, objv, 1); + return GetFileName(clientData, interp, objc, objv, OFN_FILE_OPEN); } /* @@ -520,51 +994,61 @@ Tk_GetSaveFileObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return GetFileName(clientData, interp, objc, objv, 0); + return GetFileName(clientData, interp, objc, objv, OFN_FILE_SAVE); } /* *---------------------------------------------------------------------- * - * GetFileName -- + * CleanupOFNOptions -- * - * Calls GetOpenFileName() or GetSaveFileName(). + * Cleans up any storage allocated by ParseOFNOptions * * Results: - * See user documentation. + * None. * * Side effects: - * See user documentation. + * Releases resources held by *optsPtr + *---------------------------------------------------------------------- + */ +static void CleanupOFNOptions(OFNOpts *optsPtr) +{ + Tcl_DStringFree(&optsPtr->utfDirString); +} + + + +/* + *---------------------------------------------------------------------- + * + * ParseOFNOptions -- + * + * Option parsing for tk_get{Open,Save}File + * + * Results: + * TCL_OK on success, TCL_ERROR otherwise * + * Side effects: + * Returns option values in *optsPtr. Note these may include string + * pointers into objv[] *---------------------------------------------------------------------- */ static int -GetFileName( +ParseOFNOptions( ClientData clientData, /* Main window associated with interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ - int open) /* 1 to call GetOpenFileName(), 0 to call - * GetSaveFileName(). */ + enum OFNOper oper, /* 1 for Open, 0 for Save */ + OFNOpts *optsPtr) /* Output, uninitialized on entry */ { - OPENFILENAMEW ofn; - WCHAR file[TK_MULTI_MAX_PATH]; - OFNData ofnData; - int cdlgerr; - int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0; - int confirmOverwrite = 1; - const char *extension = NULL, *title = NULL; - Tk_Window tkwin = (Tk_Window) clientData; - HWND hWnd; - Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL; - Tcl_DString utfFilterString, utfDirString, ds; - Tcl_DString extString, filterString, dirString, titleString; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int i; + Tcl_DString ds; enum options { FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_PARENT, - FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW + FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW, + FILE_MUSTEXIST, }; struct Options { const char *name; @@ -592,118 +1076,528 @@ GetFileName( {"-typevariable", FILE_TYPEVARIABLE}, {NULL, FILE_DEFAULT/*ignored*/ } }; - const struct Options *options = open ? openOptions : saveOptions; + static const struct Options dirOptions[] = { + {"-initialdir", FILE_INITDIR}, + {"-mustexist", FILE_MUSTEXIST}, + {"-parent", FILE_PARENT}, + {"-title", FILE_TITLE}, + {NULL, FILE_DEFAULT/*ignored*/ } + }; - file[0] = '\0'; - ZeroMemory(&ofnData, sizeof(OFNData)); - Tcl_DStringInit(&utfFilterString); - Tcl_DStringInit(&utfDirString); + const struct Options *options = NULL; - /* - * Parse the arguments. - */ + switch (oper) { + case OFN_FILE_SAVE: options = saveOptions; break; + case OFN_DIR_CHOOSE: options = dirOptions; break; + case OFN_FILE_OPEN: options = openOptions; break; + } + + ZeroMemory(optsPtr, sizeof(*optsPtr)); + // optsPtr->forceXPStyle = 1; + optsPtr->tkwin = clientData; + optsPtr->confirmOverwrite = 1; /* By default we ask for confirmation */ + Tcl_DStringInit(&optsPtr->utfDirString); + optsPtr->file[0] = 0; for (i = 1; i < objc; i += 2) { int index; const char *string; - Tcl_Obj *valuePtr = objv[i + 1]; + Tcl_Obj *valuePtr; if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, sizeof(struct Options), "option", 0, &index) != TCL_OK) { - goto end; + /* + * XXX -xpstyle is explicitly checked for as it is undocumented + * and we do not want it to show in option error messages. + */ + if (strcmp(Tcl_GetString(objv[i]), "-xpstyle")) + goto error_return; + if (i + 1 == objc) { + Tcl_SetResult(interp, "value for \"-xpstyle\" missing", TCL_STATIC); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); + goto error_return; + } + if (Tcl_GetBooleanFromObj(interp, objv[i+1], + &optsPtr->forceXPStyle) != TCL_OK) + goto error_return; + + continue; + } else if (i + 1 == objc) { - Tcl_AppendResult(interp, "value for \"", options[index].name, - "\" missing", NULL); - goto end; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", options[index].name)); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); + goto error_return; } + valuePtr = objv[i + 1]; string = Tcl_GetString(valuePtr); switch (options[index].value) { case FILE_DEFAULT: - if (string[0] == '.') { - string++; - } - extension = string; + optsPtr->extObj = valuePtr; break; case FILE_TYPES: - filterObj = valuePtr; + optsPtr->filterObj = valuePtr; break; case FILE_INITDIR: - Tcl_DStringFree(&utfDirString); + Tcl_DStringFree(&optsPtr->utfDirString); if (Tcl_TranslateFileName(interp, string, - &utfDirString) == NULL) { - goto end; - } + &optsPtr->utfDirString) == NULL) + goto error_return; break; case FILE_INITFILE: - if (Tcl_TranslateFileName(interp, string, &ds) == NULL) { - goto end; - } + if (Tcl_TranslateFileName(interp, string, &ds) == NULL) + goto error_return; Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(), - Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL, - (char *) file, sizeof(file), NULL, NULL, NULL); + Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL, + (char *) &optsPtr->file[0], sizeof(optsPtr->file), + NULL, NULL, NULL); Tcl_DStringFree(&ds); break; case FILE_PARENT: - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { - goto end; - } + optsPtr->tkwin = Tk_NameToWindow(interp, string, clientData); + if (optsPtr->tkwin == NULL) + goto error_return; break; case FILE_TITLE: - title = string; + optsPtr->titleObj = valuePtr; break; case FILE_TYPEVARIABLE: - typeVariableObj = valuePtr; - initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL, - TCL_GLOBAL_ONLY); + optsPtr->typeVariableObj = valuePtr; + optsPtr->initialTypeObj = Tcl_ObjGetVar2(interp, valuePtr, + NULL, TCL_GLOBAL_ONLY); break; case FILE_MULTIPLE: - if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) { - return TCL_ERROR; - } + if (Tcl_GetBooleanFromObj(interp, valuePtr, + &optsPtr->multi) != TCL_OK) + goto error_return; break; case FILE_CONFIRMOW: if (Tcl_GetBooleanFromObj(interp, valuePtr, - &confirmOverwrite) != TCL_OK) { - return TCL_ERROR; - } + &optsPtr->confirmOverwrite) != TCL_OK) + goto error_return; break; + case FILE_MUSTEXIST: + if (Tcl_GetBooleanFromObj(interp, valuePtr, + &optsPtr->mustExist) != TCL_OK) + goto error_return; + break; } } - if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj, - &filterIndex) != TCL_OK) { - goto end; + return TCL_OK; + +error_return: /* interp should already hold error */ + /* On error, we need to clean up anything we might have allocated */ + CleanupOFNOptions(optsPtr); + return TCL_ERROR; + +} + + +/* + *---------------------------------------------------------------------- + * VistaFileDialogsAvailable + * + * Checks whether the new (Vista) file dialogs can be used on + * the system. + * + * Returns: + * 1 if new dialogs are available, 0 otherwise + * + * Side effects: + * Loads required procedures dynamically if available. + * If new dialogs are available, COM is also initialized. + *---------------------------------------------------------------------- + */ +static int VistaFileDialogsAvailable() +{ + HRESULT hr; + IFileDialog *fdlgPtr = NULL; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (tsdPtr->newFileDialogsState == FDLG_STATE_INIT) { + tsdPtr->newFileDialogsState = FDLG_STATE_USE_OLD; + LoadShellProcs(); + if (ShellProcs.SHCreateItemFromParsingName != NULL) { + hr = CoInitialize(0); + /* XXX - need we schedule CoUninitialize at thread shutdown ? */ + + /* Ensure all COM interfaces we use are available */ + if (SUCCEEDED(hr)) { + hr = CoCreateInstance(&ClsidFileOpenDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgPtr); + if (SUCCEEDED(hr)) { + fdlgPtr->lpVtbl->Release(fdlgPtr); + hr = CoCreateInstance(&ClsidFileSaveDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog, + (void **) &fdlgPtr); + if (SUCCEEDED(hr)) { + fdlgPtr->lpVtbl->Release(fdlgPtr); + + /* Looks like we have all we need */ + tsdPtr->newFileDialogsState = FDLG_STATE_USE_NEW; + } + } + } + } } - Tk_MakeWindowExist(tkwin); - hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); + return (tsdPtr->newFileDialogsState == FDLG_STATE_USE_NEW); +} + +/* + *---------------------------------------------------------------------- + * + * GetFileNameVista -- + * + * Displays the new file dialogs on Vista and later. + * This function must generally not be called unless the + * tsdPtr->newFileDialogsState is FDLG_STATE_USE_NEW but if + * it is, it will just pass the call to the older GetFileNameXP + * + * Results: + * TCL_OK - dialog was successfully displayed, results returned in interp + * TCL_ERROR - error return + * + * Side effects: + * Dialogs is displayed + *---------------------------------------------------------------------- + */ +static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr, + enum OFNOper oper) +{ + HRESULT hr; + HWND hWnd; + DWORD flags, nfilters, defaultFilterIndex; + TCLCOMDLG_FILTERSPEC *filterPtr = NULL; + IFileDialog *fdlgIf = NULL; + IShellItem *dirIf = NULL; + LPWSTR wstr; + Tcl_Obj *resultObj = NULL; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int oldMode; + + if (tsdPtr->newFileDialogsState != FDLG_STATE_USE_NEW) { + /* XXX - should be an assert but Tcl does not seem to have one? */ + Tcl_SetResult(interp, "Internal error: GetFileNameVista: IFileDialog API not available", TCL_STATIC); + return TCL_ERROR; + } + + /* + * At this point new interfaces are supposed to be available. + * fdlgIf is actually a IFileOpenDialog or IFileSaveDialog + * both of which inherit from IFileDialog. We use the common + * IFileDialog interface for the most part, casting only for + * type-specific calls. + */ + Tk_MakeWindowExist(optsPtr->tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin)); + + /* + * The only validation we need to do w.r.t caller supplied data + * is the filter specification so do that before creating + */ + if (MakeFilterVista(interp, optsPtr, &nfilters, &filterPtr, + &defaultFilterIndex) != TCL_OK) + return TCL_ERROR; + + /* + * Beyond this point, do not just return on error as there will be + * resources that need to be released/freed. + */ + + if (oper == OFN_FILE_OPEN || oper == OFN_DIR_CHOOSE) + hr = CoCreateInstance(&ClsidFileOpenDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgIf); + else + hr = CoCreateInstance(&ClsidFileSaveDialog, NULL, + CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog, (void **) &fdlgIf); + + if (FAILED(hr)) + goto vamoose; + + /* + * Get current settings first because we want to preserve existing + * settings like whether to show hidden files etc. based on the + * user's existing preference + */ + hr = fdlgIf->lpVtbl->GetOptions(fdlgIf, &flags); + if (FAILED(hr)) + goto vamoose; + + if (filterPtr) { + /* + * Causes -filetypes {{All *}} -defaultextension ext to return + * foo.ext.ext when foo is typed into the entry box + * flags |= FOS_STRICTFILETYPES; + */ + hr = fdlgIf->lpVtbl->SetFileTypes(fdlgIf, nfilters, filterPtr); + if (FAILED(hr)) + goto vamoose; + hr = fdlgIf->lpVtbl->SetFileTypeIndex(fdlgIf, defaultFilterIndex); + if (FAILED(hr)) + goto vamoose; + } + + /* Flags are equivalent to those we used in the older API */ + + /* + * Following flags must be set irrespective of original setting + * XXX - should FOS_NOVALIDATE be there ? Note FOS_NOVALIDATE has different + * semantics than OFN_NOVALIDATE in the old API. + */ + flags |= + FOS_FORCEFILESYSTEM | /* Only want files, not other shell items */ + FOS_NOVALIDATE | /* Don't check for access denied etc. */ + FOS_PATHMUSTEXIST; /* The *directory* path must exist */ + + + if (oper == OFN_DIR_CHOOSE) { + flags |= FOS_PICKFOLDERS; + if (optsPtr->mustExist) + flags |= FOS_FILEMUSTEXIST; /* XXX - check working */ + } else + flags &= ~ FOS_PICKFOLDERS; + + if (optsPtr->multi) + flags |= FOS_ALLOWMULTISELECT; + else + flags &= ~FOS_ALLOWMULTISELECT; + + if (optsPtr->confirmOverwrite) + flags |= FOS_OVERWRITEPROMPT; + else + flags &= ~FOS_OVERWRITEPROMPT; + + hr = fdlgIf->lpVtbl->SetOptions(fdlgIf, flags); + if (FAILED(hr)) + goto vamoose; + + if (optsPtr->extObj != NULL) { + wstr = Tcl_GetUnicode(optsPtr->extObj); + if (wstr[0] == L'.') + ++wstr; + hr = fdlgIf->lpVtbl->SetDefaultExtension(fdlgIf, wstr); + if (FAILED(hr)) + goto vamoose; + } + + if (optsPtr->titleObj != NULL) { + hr = fdlgIf->lpVtbl->SetTitle(fdlgIf, + Tcl_GetUnicode(optsPtr->titleObj)); + if (FAILED(hr)) + goto vamoose; + } + + if (optsPtr->file[0]) { + hr = fdlgIf->lpVtbl->SetFileName(fdlgIf, optsPtr->file); + if (FAILED(hr)) + goto vamoose; + } + + if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') { + Tcl_Obj *normPath, *iniDirPath; + iniDirPath = Tcl_NewStringObj(Tcl_DStringValue(&optsPtr->utfDirString), -1); + Tcl_IncrRefCount(iniDirPath); + normPath = Tcl_FSGetNormalizedPath(interp, iniDirPath); + /* XXX - Note on failures do not raise error, simply ignore ini dir */ + if (normPath) { + const WCHAR *nativePath; + Tcl_IncrRefCount(normPath); + nativePath = Tcl_FSGetNativePath(normPath); /* Points INTO normPath*/ + if (nativePath) { + hr = ShellProcs.SHCreateItemFromParsingName( + nativePath, NULL, + &IIDIShellItem, (void **) &dirIf); + if (SUCCEEDED(hr)) { + /* Note we use SetFolder, not SetDefaultFolder - see MSDN */ + fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */ + } + } + Tcl_DecrRefCount(normPath); /* ALSO INVALIDATES nativePath !! */ + } + Tcl_DecrRefCount(iniDirPath); + } + + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); + hr = fdlgIf->lpVtbl->Show(fdlgIf, hWnd); + Tcl_SetServiceMode(oldMode); + + /* + * Ensure that hWnd is enabled, because it can happen that we have updated + * the wrapper of the parent, which causes us to leave this child disabled + * (Windows loses sync). + */ + + if (hWnd) + EnableWindow(hWnd, 1); + + /* + * Clear interp result since it might have been set during the modal loop. + * http://core.tcl.tk/tk/tktview/4a0451f5291b3c9168cc560747dae9264e1d2ef6 + */ + Tcl_ResetResult(interp); - ZeroMemory(&ofn, sizeof(OPENFILENAMEW)); - if (LOBYTE(LOWORD(GetVersion())) < 5) { - ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400; + if (SUCCEEDED(hr)) { + if ((oper == OFN_FILE_OPEN) && optsPtr->multi) { + IShellItemArray *multiIf; + DWORD dw, count; + IFileOpenDialog *fodIf = (IFileOpenDialog *) fdlgIf; + hr = fodIf->lpVtbl->GetResults(fodIf, &multiIf); + if (SUCCEEDED(hr)) { + Tcl_Obj *multiObj; + hr = multiIf->lpVtbl->GetCount(multiIf, &count); + multiObj = Tcl_NewListObj(count, NULL); + if (SUCCEEDED(hr)) { + IShellItem *itemIf; + for (dw = 0; dw < count; ++dw) { + hr = multiIf->lpVtbl->GetItemAt(multiIf, dw, &itemIf); + if (FAILED(hr)) + break; + hr = itemIf->lpVtbl->GetDisplayName(itemIf, + SIGDN_FILESYSPATH, &wstr); + if (SUCCEEDED(hr)) { + Tcl_DString fnds; + ConvertExternalFilename(wstr, &fnds); + CoTaskMemFree(wstr); + Tcl_ListObjAppendElement( + interp, multiObj, + Tcl_NewStringObj(Tcl_DStringValue(&fnds), + Tcl_DStringLength(&fnds))); + } + itemIf->lpVtbl->Release(itemIf); + if (FAILED(hr)) + break; + } + } + multiIf->lpVtbl->Release(multiIf); + if (SUCCEEDED(hr)) + resultObj = multiObj; + else + Tcl_DecrRefCount(multiObj); + } + } else { + IShellItem *resultIf; + hr = fdlgIf->lpVtbl->GetResult(fdlgIf, &resultIf); + if (SUCCEEDED(hr)) { + hr = resultIf->lpVtbl->GetDisplayName(resultIf, SIGDN_FILESYSPATH, + &wstr); + if (SUCCEEDED(hr)) { + Tcl_DString fnds; + ConvertExternalFilename(wstr, &fnds); + resultObj = Tcl_NewStringObj(Tcl_DStringValue(&fnds), + Tcl_DStringLength(&fnds)); + CoTaskMemFree(wstr); + } + resultIf->lpVtbl->Release(resultIf); + } + } + if (SUCCEEDED(hr)) { + if (filterPtr && optsPtr->typeVariableObj) { + UINT ftix; + hr = fdlgIf->lpVtbl->GetFileTypeIndex(fdlgIf, &ftix); + if (SUCCEEDED(hr)) { + /* Note ftix is a 1-based index */ + if (ftix > 0 && ftix <= nfilters) { + Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL, + Tcl_NewUnicodeObj(filterPtr[ftix-1].pszName, -1), + TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + } + } + } + } } else { - ofn.lStructSize = sizeof(OPENFILENAMEW); + if (hr == HRESULT_FROM_WIN32(ERROR_CANCELLED)) + hr = 0; /* User cancelled, return empty string */ } + +vamoose: /* (hr != 0) => error */ + if (dirIf) + dirIf->lpVtbl->Release(dirIf); + if (fdlgIf) + fdlgIf->lpVtbl->Release(fdlgIf); + + if (filterPtr) + FreeFilterVista(nfilters, filterPtr); + + if (hr == 0) { + if (resultObj) /* May be NULL if user cancelled */ + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; + } else { + if (resultObj) + Tcl_DecrRefCount(resultObj); + Tcl_SetObjResult(interp, TkWin32ErrorObj(hr)); + return TCL_ERROR; + } +} + + +/* + *---------------------------------------------------------------------- + * + * GetFileNameXP -- + * + * Displays the old pre-Vista file dialogs. + * + * Results: + * TCL_OK - if dialog was successfully displayed + * TCL_ERROR - error return + * + * Side effects: + * See user documentation. + *---------------------------------------------------------------------- + */ +static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr, enum OFNOper oper) +{ + OPENFILENAME ofn; + OFNData ofnData; + int cdlgerr; + int filterIndex = 0, result = TCL_ERROR, winCode, oldMode; + HWND hWnd; + Tcl_DString utfFilterString, ds; + Tcl_DString extString, filterString, dirString, titleString; + const char *str; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + ZeroMemory(&ofnData, sizeof(OFNData)); + Tcl_DStringInit(&utfFilterString); + Tcl_DStringInit(&dirString); /* XXX - original code was missing this + leaving dirString uninitialized for + the unlikely code path where cwd failed */ + + if (MakeFilter(interp, optsPtr->filterObj, &utfFilterString, + optsPtr->initialTypeObj, &filterIndex) != TCL_OK) { + goto end; + } + + Tk_MakeWindowExist(optsPtr->tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin)); + + ZeroMemory(&ofn, sizeof(OPENFILENAME)); + ofn.lStructSize = sizeof(OPENFILENAME); ofn.hwndOwner = hWnd; ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner); - ofn.lpstrFile = file; + ofn.lpstrFile = optsPtr->file; ofn.nMaxFile = TK_MULTI_MAX_PATH; ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR - | OFN_EXPLORER | OFN_ENABLEHOOK| OFN_ENABLESIZING; + | OFN_EXPLORER| OFN_ENABLEHOOK| OFN_ENABLESIZING; ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc; ofn.lCustData = (LPARAM) &ofnData; - if (open != 0) { + if (oper != OFN_FILE_SAVE) { ofn.Flags |= OFN_FILEMUSTEXIST; - } else if (confirmOverwrite) { + } else if (optsPtr->confirmOverwrite) { ofn.Flags |= OFN_OVERWRITEPROMPT; } if (tsdPtr->debugFlag != 0) { ofnData.interp = interp; } - if (multi != 0) { + if (optsPtr->multi != 0) { ofn.Flags |= OFN_ALLOWMULTISELECT; /* @@ -712,22 +1606,25 @@ GetFileName( */ ofnData.dynFileBufferSize = 512; - ofnData.dynFileBuffer = (WCHAR *)ckalloc(512 * sizeof(WCHAR)); + ofnData.dynFileBuffer = ckalloc(512 * sizeof(TCHAR)); } - if (extension != NULL) { - Tcl_WinUtfToTChar(extension, -1, &extString); - ofn.lpstrDefExt = (WCHAR *) Tcl_DStringValue(&extString); + if (optsPtr->extObj != NULL) { + str = Tcl_GetString(optsPtr->extObj); + if (str[0] == '.') + ++str; + Tcl_WinUtfToTChar(str, -1, &extString); + ofn.lpstrDefExt = (TCHAR *) Tcl_DStringValue(&extString); } Tcl_WinUtfToTChar(Tcl_DStringValue(&utfFilterString), Tcl_DStringLength(&utfFilterString), &filterString); - ofn.lpstrFilter = (WCHAR *) Tcl_DStringValue(&filterString); + ofn.lpstrFilter = (TCHAR *) Tcl_DStringValue(&filterString); ofn.nFilterIndex = filterIndex; - if (Tcl_DStringValue(&utfDirString)[0] != '\0') { - Tcl_WinUtfToTChar(Tcl_DStringValue(&utfDirString), - Tcl_DStringLength(&utfDirString), &dirString); + if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') { + Tcl_WinUtfToTChar(Tcl_DStringValue(&optsPtr->utfDirString), + Tcl_DStringLength(&optsPtr->utfDirString), &dirString); } else { /* * NT 5.0 changed the meaning of lpstrInitialDir, so we have to ensure @@ -736,10 +1633,10 @@ GetFileName( Tcl_DString cwd; - Tcl_DStringFree(&utfDirString); - if ((Tcl_GetCwd(interp, &utfDirString) == NULL) || + Tcl_DStringFree(&optsPtr->utfDirString); + if ((Tcl_GetCwd(interp, &optsPtr->utfDirString) == NULL) || (Tcl_TranslateFileName(interp, - Tcl_DStringValue(&utfDirString), &cwd) == NULL)) { + Tcl_DStringValue(&optsPtr->utfDirString), &cwd) == NULL)) { Tcl_ResetResult(interp); } else { Tcl_WinUtfToTChar(Tcl_DStringValue(&cwd), @@ -747,11 +1644,11 @@ GetFileName( } Tcl_DStringFree(&cwd); } - ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString); + ofn.lpstrInitialDir = (TCHAR *) Tcl_DStringValue(&dirString); - if (title != NULL) { - Tcl_WinUtfToTChar(title, -1, &titleString); - ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString); + if (optsPtr->titleObj != NULL) { + Tcl_WinUtfToTChar(Tcl_GetString(optsPtr->titleObj), -1, &titleString); + ofn.lpstrTitle = (TCHAR *) Tcl_DStringValue(&titleString); } /* @@ -759,10 +1656,10 @@ GetFileName( */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - if (open != 0) { - winCode = GetOpenFileNameW(&ofn); + if (oper != OFN_FILE_SAVE) { + winCode = GetOpenFileName(&ofn); } else { - winCode = GetSaveFileNameW(&ofn); + winCode = GetSaveFileName(&ofn); } Tcl_SetServiceMode(oldMode); EatSpuriousMessageBugFix(); @@ -816,7 +1713,7 @@ GetFileName( * first element is the directory path. */ - WCHAR *files = ofnData.dynFileBuffer; + TCHAR *files = ofnData.dynFileBuffer; Tcl_Obj *returnList = Tcl_NewObj(); int count = 0; @@ -862,34 +1759,51 @@ GetFileName( Tcl_SetObjResult(interp, returnList); Tcl_DStringFree(&ds); } else { - Tcl_AppendResult(interp, ConvertExternalFilename( - ofn.lpstrFile, &ds), NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + ConvertExternalFilename(ofn.lpstrFile, &ds), -1)); gotFilename = (Tcl_DStringLength(&ds) > 0); Tcl_DStringFree(&ds); } result = TCL_OK; - if ((ofn.nFilterIndex > 0) && gotFilename && typeVariableObj - && filterObj) { + if ((ofn.nFilterIndex > 0) && gotFilename && optsPtr->typeVariableObj + && optsPtr->filterObj) { int listObjc, count; Tcl_Obj **listObjv = NULL; Tcl_Obj **typeInfo = NULL; - if (Tcl_ListObjGetElements(interp, filterObj, + if (Tcl_ListObjGetElements(interp, optsPtr->filterObj, &listObjc, &listObjv) != TCL_OK) { result = TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, listObjv[ofn.nFilterIndex - 1], &count, &typeInfo) != TCL_OK) { result = TCL_ERROR; - } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL, - typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { - result = TCL_ERROR; + } else { + /* + * BUGFIX for d43a10ce2fed950e00890049f3c273f2cdd12583 + * The original code was broken because it passed typeinfo[0] + * directly into Tcl_ObjSetVar2. In the case of typeInfo[0] + * pointing into a list which is also referenced by + * typeVariableObj, TOSV2 shimmers the object into + * variable intrep which loses the list representation. + * This invalidates typeInfo[0] which is freed but + * nevertheless stored as the value of the variable. + */ + Tcl_Obj *selFilterObj = typeInfo[0]; + Tcl_IncrRefCount(selFilterObj); + if (Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL, + selFilterObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) { + result = TCL_ERROR; + } + Tcl_DecrRefCount(selFilterObj); } } } else if (cdlgerr == FNERR_INVALIDFILENAME) { - Tcl_SetResult(interp, "invalid filename \"", TCL_STATIC); - Tcl_AppendResult(interp, ConvertExternalFilename( - ofn.lpstrFile, &ds), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid filename \"%s\"", + ConvertExternalFilename(ofn.lpstrFile, &ds))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "INVALID_FILENAME", + NULL); Tcl_DStringFree(&ds); } else { result = TCL_OK; @@ -899,6 +1813,8 @@ GetFileName( Tcl_DStringFree(&titleString); } if (ofn.lpstrInitialDir != NULL) { + /* XXX - huh? lpstrInitialDir is set from Tcl_DStringValue which + can never return NULL */ Tcl_DStringFree(&dirString); } Tcl_DStringFree(&filterString); @@ -906,16 +1822,58 @@ GetFileName( Tcl_DStringFree(&extString); } - end: - Tcl_DStringFree(&utfDirString); +end: Tcl_DStringFree(&utfFilterString); if (ofnData.dynFileBuffer != NULL) { - ckfree((char *)ofnData.dynFileBuffer); + ckfree(ofnData.dynFileBuffer); ofnData.dynFileBuffer = NULL; } return result; } + + +/* + *---------------------------------------------------------------------- + * + * GetFileName -- + * + * Calls GetOpenFileName() or GetSaveFileName(). + * + * Results: + * See user documentation. + * + * Side effects: + * See user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +GetFileName( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[], /* Argument objects. */ + enum OFNOper oper) /* 1 to call GetOpenFileName(), 0 to call + * GetSaveFileName(). */ +{ + OFNOpts ofnOpts; + int result; + + result = ParseOFNOptions(clientData, interp, objc, objv, oper, &ofnOpts); + if (result != TCL_OK) + return result; + + if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle) + result = GetFileNameVista(interp, &ofnOpts, oper); + else + result = GetFileNameXP(interp, &ofnOpts, oper); + + CleanupOFNOptions(&ofnOpts); + return result; +} + /* *------------------------------------------------------------------------- @@ -943,15 +1901,15 @@ OFNHookProc( WPARAM wParam, /* Message parameter */ LPARAM lParam) /* Message parameter */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - OPENFILENAMEW *ofnPtr; + OPENFILENAME *ofnPtr; OFNData *ofnData; if (uMsg == WM_INITDIALOG) { TkWinSetUserData(hdlg, lParam); } else if (uMsg == WM_NOTIFY) { - OFNOTIFYW *notifyPtr = (OFNOTIFYW *) lParam; + OFNOTIFY *notifyPtr = (OFNOTIFY *) lParam; /* * This is weird... or not. The CDN_FILEOK is NOT sent when the @@ -967,7 +1925,7 @@ OFNHookProc( if (notifyPtr->hdr.code == CDN_FILEOK || notifyPtr->hdr.code == CDN_SELCHANGE) { int dirsize, selsize; - WCHAR *buffer; + TCHAR *buffer; int buffersize; /* @@ -980,8 +1938,8 @@ OFNHookProc( buffer = ofnData->dynFileBuffer; hdlg = GetParent(hdlg); - selsize = SendMessageW(hdlg, CDM_GETSPEC, 0, 0); - dirsize = SendMessageW(hdlg, CDM_GETFOLDERPATH, 0, 0); + selsize = (int) SendMessage(hdlg, CDM_GETSPEC, 0, 0); + dirsize = (int) SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0); buffersize = (selsize + dirsize + 1); /* @@ -991,15 +1949,15 @@ OFNHookProc( if ((selsize > 1) && (dirsize > 0)) { if (ofnData->dynFileBufferSize < buffersize) { - buffer = (WCHAR *) ckrealloc((char *) buffer, buffersize * sizeof(WCHAR)); + buffer = ckrealloc(buffer, buffersize * sizeof(TCHAR)); ofnData->dynFileBufferSize = buffersize; ofnData->dynFileBuffer = buffer; } - SendMessageW(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer); + SendMessage(hdlg, CDM_GETFOLDERPATH, dirsize, (LPARAM) buffer); buffer += dirsize; - SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer); + SendMessage(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer); /* * If there are multiple files, delete the quotes and change @@ -1008,7 +1966,7 @@ OFNHookProc( if (buffer[0] == '"') { BOOL findquote = TRUE; - WCHAR *tmp = buffer; + TCHAR *tmp = buffer; while (*buffer != '\0') { if (findquote) { @@ -1037,8 +1995,8 @@ OFNHookProc( if (TCL_PATH_ABSOLUTE == Tcl_GetPathType(Tcl_DStringValue(&tmpfile))) { /* re-get the full path to the start of the buffer */ - buffer = (WCHAR *) ofnData->dynFileBuffer; - SendMessageW(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer); + buffer = (TCHAR *) ofnData->dynFileBuffer; + SendMessage(hdlg, CDM_GETSPEC, selsize, (LPARAM) buffer); } else { *(buffer-1) = '\\'; } @@ -1062,7 +2020,7 @@ OFNHookProc( * information every time it gets a WM_WINDOWPOSCHANGED message. */ - ofnPtr = (OPENFILENAMEW *) TkWinGetUserData(hdlg); + ofnPtr = (OPENFILENAME *) TkWinGetUserData(hdlg); if (ofnPtr != NULL) { ofnData = (OFNData *) ofnPtr->lCustData; if (ofnData->interp != NULL) { @@ -1137,12 +2095,13 @@ MakeFilter( *p = '\0'; } else { - int len; + size_t len; if (valuePtr == NULL) { len = 0; } else { - (void) Tcl_GetStringFromObj(valuePtr, &len); + (void) Tcl_GetString(valuePtr); + len = valuePtr->length; } /* @@ -1159,7 +2118,7 @@ MakeFilter( * twice the size of the string to format the filter */ - filterStr = ckalloc((unsigned int) len * 3); + filterStr = ckalloc(len * 3); for (filterPtr = flist.filters, p = filterStr; filterPtr; filterPtr = filterPtr->next) { @@ -1229,7 +2188,7 @@ MakeFilter( } Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr)); - ckfree((char *) filterStr); + ckfree(filterStr); TkFreeFileFilters(&flist); return TCL_OK; @@ -1238,6 +2197,145 @@ MakeFilter( /* *---------------------------------------------------------------------- * + * FreeFilterVista + * + * Frees storage previously allocated by MakeFilterVista. + * count is the number of elements in dlgFilterPtr[] + */ +static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr) +{ + if (dlgFilterPtr != NULL) { + DWORD dw; + for (dw = 0; dw < count; ++dw) { + if (dlgFilterPtr[dw].pszName != NULL) + ckfree(dlgFilterPtr[dw].pszName); + if (dlgFilterPtr[dw].pszSpec != NULL) + ckfree(dlgFilterPtr[dw].pszSpec); + } + ckfree(dlgFilterPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * MakeFilterVista -- + * + * Returns file type filters in a format required + * by the Vista file dialogs. + * + * Results: + * A standard TCL return value. + * + * Side effects: + * Various values are returned through the parameters as + * described in the comments below. + *---------------------------------------------------------------------- + */ +static int MakeFilterVista( + Tcl_Interp *interp, /* Current interpreter. */ + OFNOpts *optsPtr, /* Caller specified options */ + DWORD *countPtr, /* Will hold number of filters */ + TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr, /* Will hold pointer to filter array. + Set to NULL if no filters specified. + Must be freed by calling + FreeFilterVista */ + DWORD *initialIndexPtr) /* Will hold index of default type */ +{ + TCLCOMDLG_FILTERSPEC *dlgFilterPtr; + const char *initial = NULL; + FileFilterList flist; + FileFilter *filterPtr; + DWORD initialIndex = 0; + Tcl_DString ds, patterns; + int i; + + if (optsPtr->filterObj == NULL) { + *dlgFilterPtrPtr = NULL; + *countPtr = 0; + return TCL_OK; + } + + if (optsPtr->initialTypeObj) + initial = Tcl_GetString(optsPtr->initialTypeObj); + + TkInitFileFilters(&flist); + if (TkGetFileFilters(interp, &flist, optsPtr->filterObj, 1) != TCL_OK) + return TCL_ERROR; + + if (flist.filters == NULL) { + *dlgFilterPtrPtr = NULL; + *countPtr = 0; + return TCL_OK; + } + + Tcl_DStringInit(&ds); + Tcl_DStringInit(&patterns); + dlgFilterPtr = ckalloc(flist.numFilters * sizeof(*dlgFilterPtr)); + + for (i = 0, filterPtr = flist.filters; + filterPtr; + filterPtr = filterPtr->next, ++i) { + const char *sep; + FileFilterClause *clausePtr; + int nbytes; + + /* Check if this entry should be shown as the default */ + if (initial && strcmp(initial, filterPtr->name) == 0) + initialIndex = i+1; /* Windows filter indices are 1-based */ + + /* First stash away the text description of the pattern */ + Tcl_WinUtfToTChar(filterPtr->name, -1, &ds); + nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */ + nbytes += sizeof(WCHAR); /* Terminating \0 */ + dlgFilterPtr[i].pszName = ckalloc(nbytes); + memmove((void *) dlgFilterPtr[i].pszName, Tcl_DStringValue(&ds), nbytes); + Tcl_DStringFree(&ds); + + /* + * Loop through and join patterns with a ";" Each "clause" + * corresponds to a single textual description (called typename) + * in the tk_getOpenFile docs. Each such typename may occur + * multiple times and all these form a single filter entry + * with one clause per occurence. Further each clause may specify + * multiple patterns. Hence the nested loop here. + */ + sep = ""; + for (clausePtr=filterPtr->clauses ; clausePtr; + clausePtr=clausePtr->next) { + GlobPattern *globPtr; + for (globPtr = clausePtr->patterns; globPtr; + globPtr = globPtr->next) { + Tcl_DStringAppend(&patterns, sep, -1); + Tcl_DStringAppend(&patterns, globPtr->pattern, -1); + sep = ";"; + } + } + + /* Again we need a Unicode form of the string */ + Tcl_WinUtfToTChar(Tcl_DStringValue(&patterns), -1, &ds); + nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */ + nbytes += sizeof(WCHAR); /* Terminating \0 */ + dlgFilterPtr[i].pszSpec = ckalloc(nbytes); + memmove((void *)dlgFilterPtr[i].pszSpec, Tcl_DStringValue(&ds), nbytes); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&patterns); + } + + if (initialIndex == 0) + initialIndex = 1; /* If no default, show first entry */ + *initialIndexPtr = initialIndex; + *dlgFilterPtrPtr = dlgFilterPtr; + *countPtr = flist.numFilters; + + TkFreeFileFilters(&flist); + return TCL_OK; +} + + +/* + *---------------------------------------------------------------------- + * * Tk_ChooseDirectoryObjCmd -- * * This function implements the "tk_chooseDirectory" dialog box for the @@ -1312,103 +2410,61 @@ Tk_ChooseDirectoryObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - WCHAR path[MAX_PATH]; - int oldMode, result = TCL_ERROR, i; + TCHAR path[MAX_PATH]; + int oldMode, result; LPCITEMIDLIST pidl; /* Returned by browser */ - BROWSEINFOW bInfo; /* Used by browser */ + BROWSEINFO bInfo; /* Used by browser */ ChooseDir cdCBData; /* Structure to pass back and forth */ LPMALLOC pMalloc; /* Used by shell */ - Tk_Window tkwin = (Tk_Window) clientData; HWND hWnd; - const char *utfTitle = NULL;/* Title for window */ - WCHAR saveDir[MAX_PATH]; + TCHAR saveDir[MAX_PATH]; Tcl_DString titleString; /* Title */ - Tcl_DString initDirString; /* Initial directory */ Tcl_DString tempString; /* temporary */ Tcl_Obj *objPtr; - static const char *optionStrings[] = { - "-initialdir", "-mustexist", "-parent", "-title", NULL - }; - enum options { - DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE - }; + OFNOpts ofnOpts; + const char *utfDir; + + result = ParseOFNOptions(clientData, interp, objc, objv, + OFN_DIR_CHOOSE, &ofnOpts); + if (result != TCL_OK) + return result; + + /* Use new dialogs if available */ + if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle) { + result = GetFileNameVista(interp, &ofnOpts, OFN_DIR_CHOOSE); + CleanupOFNOptions(&ofnOpts); + return result; + } - /* - * Initialize - */ + /* Older dialogs */ path[0] = '\0'; ZeroMemory(&cdCBData, sizeof(ChooseDir)); cdCBData.interp = interp; + cdCBData.mustExist = ofnOpts.mustExist; - /* - * Process the command line options - */ - - for (i = 1; i < objc; i += 2) { - int index; - const char *string; - const WCHAR *uniStr; - Tcl_Obj *optionPtr, *valuePtr; - - optionPtr = objv[i]; - valuePtr = objv[i + 1]; - - if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 0, - &index) != TCL_OK) { - goto cleanup; - } - if (i + 1 == objc) { - string = Tcl_GetString(optionPtr); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); - goto cleanup; - } + utfDir = Tcl_DStringValue(&ofnOpts.utfDirString); + if (utfDir[0] != '\0') { + const TCHAR *uniStr; - string = Tcl_GetString(valuePtr); - switch ((enum options) index) { - case DIR_INITIAL: - if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) { - goto cleanup; - } - Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1, - &tempString); - uniStr = (WCHAR *) Tcl_DStringValue(&tempString); + Tcl_WinUtfToTChar(Tcl_DStringValue(&ofnOpts.utfDirString), -1, + &tempString); + uniStr = (TCHAR *) Tcl_DStringValue(&tempString); - /* - * Convert possible relative path to full path to keep dialog - * happy. - */ + /* Convert possible relative path to full path to keep dialog happy. */ - GetFullPathNameW(uniStr, MAX_PATH, saveDir, NULL); - wcsncpy(cdCBData.initDir, saveDir, MAX_PATH); - Tcl_DStringFree(&initDirString); - Tcl_DStringFree(&tempString); - break; - case DIR_EXIST: - if (Tcl_GetBooleanFromObj(interp, valuePtr, - &cdCBData.mustExist) != TCL_OK) { - goto cleanup; - } - break; - case DIR_PARENT: - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { - goto cleanup; - } - break; - case FILE_TITLE: - utfTitle = string; - break; - } + GetFullPathName(uniStr, MAX_PATH, saveDir, NULL); + _tcsncpy(cdCBData.initDir, saveDir, MAX_PATH); } + /* XXX - rest of this (original) code has no error checks at all. */ + /* * Get ready to call the browser */ - Tk_MakeWindowExist(tkwin); - hWnd = Tk_GetHWND(Tk_WindowId(tkwin)); + Tk_MakeWindowExist(ofnOpts.tkwin); + hWnd = Tk_GetHWND(Tk_WindowId(ofnOpts.tkwin)); /* * Setup the parameters used by SHBrowseForFolder @@ -1417,16 +2473,16 @@ Tk_ChooseDirectoryObjCmd( bInfo.hwndOwner = hWnd; bInfo.pszDisplayName = path; bInfo.pidlRoot = NULL; - if (wcslen(cdCBData.initDir) == 0) { - GetCurrentDirectoryW(MAX_PATH, cdCBData.initDir); + if (_tcslen(cdCBData.initDir) == 0) { + GetCurrentDirectory(MAX_PATH, cdCBData.initDir); } bInfo.lParam = (LPARAM) &cdCBData; - if (utfTitle != NULL) { - Tcl_WinUtfToTChar(utfTitle, -1, &titleString); - bInfo.lpszTitle = (LPWSTR) Tcl_DStringValue(&titleString); + if (ofnOpts.titleObj != NULL) { + Tcl_WinUtfToTChar(Tcl_GetString(ofnOpts.titleObj), -1, &titleString); + bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString); } else { - bInfo.lpszTitle = L"Please choose a directory, then select OK."; + bInfo.lpszTitle = TEXT("Please choose a directory, then select OK."); } /* @@ -1459,9 +2515,13 @@ Tk_ChooseDirectoryObjCmd( */ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - GetCurrentDirectoryW(MAX_PATH, saveDir); + GetCurrentDirectory(MAX_PATH, saveDir); if (SHGetMalloc(&pMalloc) == NOERROR) { - pidl = SHBrowseForFolderW(&bInfo); + /* + * XXX - MSDN says CoInitialize must have been called before + * SHBrowseForFolder can be used but don't see that called anywhere. + */ + pidl = SHBrowseForFolder(&bInfo); /* * This is a fix for Windows 2000, which seems to modify the folder @@ -1476,17 +2536,18 @@ Tk_ChooseDirectoryObjCmd( */ if (pidl != NULL) { - if (!SHGetPathFromIDListW(pidl, path)) { - Tcl_SetResult(interp, "Error: Not a file system folder\n", - TCL_VOLATILE); + if (!SHGetPathFromIDList(pidl, path)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error: not a file system folder", -1)); + Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "PSEUDO", NULL); } pMalloc->lpVtbl->Free(pMalloc, (void *) pidl); - } else if (wcslen(cdCBData.retDir) > 0) { - wcscpy(path, cdCBData.retDir); + } else if (_tcslen(cdCBData.retDir) > 0) { + _tcscpy(path, cdCBData.retDir); } pMalloc->lpVtbl->Release(pMalloc); } - SetCurrentDirectoryW(saveDir); + SetCurrentDirectory(saveDir); Tcl_SetServiceMode(oldMode); /* @@ -1506,19 +2567,13 @@ Tk_ChooseDirectoryObjCmd( if (*path) { Tcl_DString ds; - Tcl_AppendResult(interp, ConvertExternalFilename(path, - &ds), NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + ConvertExternalFilename(path, &ds), -1)); Tcl_DStringFree(&ds); } - result = TCL_OK; - - if (utfTitle != NULL) { - Tcl_DStringFree(&titleString); - } - - cleanup: - return result; + CleanupOFNOptions(&ofnOpts); + return TCL_OK; } /* @@ -1544,17 +2599,17 @@ ChooseDirectoryValidateProc( LPARAM lParam, LPARAM lpData) { - WCHAR selDir[MAX_PATH]; + TCHAR selDir[MAX_PATH]; ChooseDir *chooseDirSharedData = (ChooseDir *) lpData; Tcl_DString tempString; Tcl_DString initDirString; - WCHAR string[MAX_PATH]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TCHAR string[MAX_PATH]; + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->debugFlag) { tsdPtr->debugInterp = (Tcl_Interp *) chooseDirSharedData->interp; - Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd); + Tcl_DoWhenIdle(SetTkDialog, hwnd); } chooseDirSharedData->retDir[0] = '\0'; switch (message) { @@ -1582,11 +2637,11 @@ ChooseDirectoryValidateProc( Tcl_DStringFree(&initDirString); Tcl_WinUtfToTChar(Tcl_DStringValue(&tempString), -1, &initDirString); Tcl_DStringFree(&tempString); - wcsncpy(string, (WCHAR *) Tcl_DStringValue(&initDirString), + _tcsncpy(string, (TCHAR *) Tcl_DStringValue(&initDirString), MAX_PATH); Tcl_DStringFree(&initDirString); - if (SetCurrentDirectoryW(string) == 0) { + if (SetCurrentDirectory(string) == 0) { /* * Get the full path name to the user entry, at this point it does @@ -1594,16 +2649,17 @@ ChooseDirectoryValidateProc( * it. */ - GetFullPathNameW(string, MAX_PATH, + GetFullPathName(string, MAX_PATH, chooseDirSharedData->retDir, NULL); if (chooseDirSharedData->mustExist) { /* * User HAS to select a valid directory. */ - wsprintfW(selDir, L"Directory '%.200s' does not exist,\nplease select or enter an existing directory.", + wsprintf(selDir, TEXT("Directory '%s' does not exist,\n") + TEXT("please select or enter an existing directory."), chooseDirSharedData->retDir); - MessageBoxW(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK); + MessageBox(NULL, selDir, NULL, MB_ICONEXCLAMATION|MB_OK); chooseDirSharedData->retDir[0] = '\0'; return 1; } @@ -1613,7 +2669,7 @@ ChooseDirectoryValidateProc( * directory in utfRetDir. */ - GetCurrentDirectoryW(MAX_PATH, chooseDirSharedData->retDir); + GetCurrentDirectory(MAX_PATH, chooseDirSharedData->retDir); return 0; } return 0; @@ -1628,13 +2684,13 @@ ChooseDirectoryValidateProc( * Not called when user changes edit box directly. */ - if (SHGetPathFromIDListW((LPITEMIDLIST) lParam, selDir)) { - SendMessageW(hwnd, BFFM_SETSTATUSTEXTW, 0, (LPARAM) selDir); + if (SHGetPathFromIDList((LPITEMIDLIST) lParam, selDir)) { + SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, (LPARAM) selDir); // enable the OK button - SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); + SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); } else { // disable the OK button - SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0); + SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 0); } UpdateWindow(hwnd); return 1; @@ -1645,9 +2701,9 @@ ChooseDirectoryValidateProc( * specified parameter. */ - WCHAR *initDir = chooseDirSharedData->initDir; + TCHAR *initDir = chooseDirSharedData->initDir; - SetCurrentDirectoryW(initDir); + SetCurrentDirectory(initDir); if (*initDir == '\\') { /* @@ -1664,10 +2720,10 @@ ChooseDirectoryValidateProc( ULONG ulCount, ulAttr; if (SUCCEEDED(psfFolder->lpVtbl->ParseDisplayName( - psfFolder, hwnd, NULL, (WCHAR *) + psfFolder, hwnd, NULL, (TCHAR *) initDir, &ulCount,&pidlMain,&ulAttr)) && (pidlMain != NULL)) { - SendMessageW(hwnd, BFFM_SETSELECTIONW, FALSE, + SendMessage(hwnd, BFFM_SETSELECTION, FALSE, (LPARAM) pidlMain); pMalloc->lpVtbl->Free(pMalloc, pidlMain); } @@ -1676,9 +2732,9 @@ ChooseDirectoryValidateProc( pMalloc->lpVtbl->Release(pMalloc); } } else { - SendMessageW(hwnd, BFFM_SETSELECTIONW, TRUE, (LPARAM) initDir); + SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM) initDir); } - SendMessageW(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); + SendMessage(hwnd, BFFM_ENABLEOK, 0, (LPARAM) 1); break; } @@ -1711,13 +2767,13 @@ Tk_MessageBoxObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData, parent; + Tk_Window tkwin = clientData, parent; HWND hWnd; Tcl_Obj *messageObj, *titleObj, *detailObj, *tmpObj; int defaultBtn, icon, type; int i, oldMode, winCode; UINT flags; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "-default", "-detail", "-icon", "-message", "-parent", "-title", "-type", NULL }; @@ -1725,7 +2781,7 @@ Tk_MessageBoxObjCmd( MSG_DEFAULT, MSG_DETAIL, MSG_ICON, MSG_MESSAGE, MSG_PARENT, MSG_TITLE, MSG_TYPE }; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); defaultBtn = -1; @@ -1743,14 +2799,14 @@ Tk_MessageBoxObjCmd( optionPtr = objv[i]; valuePtr = objv[i + 1]; - if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } if (i + 1 == objc) { - const char *string = Tcl_GetString(optionPtr); - Tcl_AppendResult(interp, "value for \"", string, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(optionPtr))); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL); return TCL_ERROR; } @@ -1819,9 +2875,10 @@ Tk_MessageBoxObjCmd( } } if (defaultBtnIdx < 0) { - Tcl_AppendResult(interp, "invalid default button \"", - TkFindStateString(buttonMap, defaultBtn), - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid default button \"%s\"", + TkFindStateString(buttonMap, defaultBtn))); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL); return TCL_ERROR; } break; @@ -1853,9 +2910,9 @@ Tk_MessageBoxObjCmd( tsdPtr->hSmallIcon = TkWinGetIcon(parent, ICON_SMALL); tsdPtr->hBigIcon = TkWinGetIcon(parent, ICON_BIG); - tsdPtr->hMsgBoxHook = SetWindowsHookExW(WH_CBT, MsgBoxCBTProc, NULL, + tsdPtr->hMsgBoxHook = SetWindowsHookEx(WH_CBT, MsgBoxCBTProc, NULL, GetCurrentThreadId()); - winCode = MessageBoxW(hWnd, Tcl_GetUnicode(tmpObj), + winCode = MessageBox(hWnd, Tcl_GetUnicode(tmpObj), titleObj ? Tcl_GetUnicode(titleObj) : L"", flags); UnhookWindowsHookEx(tsdPtr->hMsgBoxHook); (void) Tcl_SetServiceMode(oldMode); @@ -1869,8 +2926,8 @@ Tk_MessageBoxObjCmd( EnableWindow(hWnd, 1); Tcl_DecrRefCount(tmpObj); - - Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + TkFindStateString(buttonMap, winCode), -1)); return TCL_OK; } @@ -1880,7 +2937,7 @@ MsgBoxCBTProc( WPARAM wParam, LPARAM lParam) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (nCode == HCBT_CREATEWND) { @@ -1897,9 +2954,9 @@ MsgBoxCBTProc( if (WC_DIALOG == lpcbtcreate->lpcs->lpszClass) { HWND hwnd = (HWND) wParam; - SendMessageW(hwnd, WM_SETICON, ICON_SMALL, + SendMessage(hwnd, WM_SETICON, ICON_SMALL, (LPARAM) tsdPtr->hSmallIcon); - SendMessageW(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon); + SendMessage(hwnd, WM_SETICON, ICON_BIG, (LPARAM) tsdPtr->hBigIcon); } } @@ -1927,12 +2984,12 @@ static void SetTkDialog( ClientData clientData) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); char buf[32]; sprintf(buf, "0x%p", (HWND) clientData); - Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY); + Tcl_SetVar2(tsdPtr->debugInterp, "tk_dialog", NULL, buf, TCL_GLOBAL_ONLY); } /* @@ -1941,12 +2998,12 @@ SetTkDialog( static const char * ConvertExternalFilename( - WCHAR *filename, + TCHAR *filename, Tcl_DString *dsPtr) { char *p; - Tcl_WinTCharToUtf((TCHAR *) filename, -1, dsPtr); + Tcl_WinTCharToUtf(filename, -1, dsPtr); for (p = Tcl_DStringValue(dsPtr); *p != '\0'; p++) { /* * Change the pathname to the Tcl "normalized" pathname, where back @@ -1961,6 +3018,569 @@ ConvertExternalFilename( } /* + * ---------------------------------------------------------------------- + * + * GetFontObj -- + * + * Convert a windows LOGFONT into a Tk font description. + * + * Result: + * A list containing a Tk font description. + * + * ---------------------------------------------------------------------- + */ + +static Tcl_Obj * +GetFontObj( + HDC hdc, + LOGFONT *plf) +{ + Tcl_DString ds; + Tcl_Obj *resObj; + int pt = 0; + + resObj = Tcl_NewListObj(0, NULL); + Tcl_WinTCharToUtf(plf->lfFaceName, -1, &ds); + Tcl_ListObjAppendElement(NULL, resObj, + Tcl_NewStringObj(Tcl_DStringValue(&ds), -1)); + Tcl_DStringFree(&ds); + pt = -MulDiv(plf->lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY)); + Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewIntObj(pt)); + if (plf->lfWeight >= 700) { + Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewStringObj("bold", -1)); + } + if (plf->lfItalic) { + Tcl_ListObjAppendElement(NULL, resObj, + Tcl_NewStringObj("italic", -1)); + } + if (plf->lfUnderline) { + Tcl_ListObjAppendElement(NULL, resObj, + Tcl_NewStringObj("underline", -1)); + } + if (plf->lfStrikeOut) { + Tcl_ListObjAppendElement(NULL, resObj, + Tcl_NewStringObj("overstrike", -1)); + } + return resObj; +} + +static void +ApplyLogfont( + Tcl_Interp *interp, + Tcl_Obj *cmdObj, + HDC hdc, + LOGFONT *logfontPtr) +{ + int objc; + Tcl_Obj **objv, **tmpv; + + Tcl_ListObjGetElements(NULL, cmdObj, &objc, &objv); + tmpv = ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); + memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc); + tmpv[objc] = GetFontObj(hdc, logfontPtr); + TkBackgroundEvalObjv(interp, objc+1, tmpv, TCL_EVAL_GLOBAL); + ckfree(tmpv); +} + +/* + * ---------------------------------------------------------------------- + * + * HookProc -- + * + * Font selection hook. If the user selects Apply on the dialog, we call + * the applyProc script with the currently selected font as arguments. + * + * ---------------------------------------------------------------------- + */ + +typedef struct HookData { + Tcl_Interp *interp; + Tcl_Obj *titleObj; + Tcl_Obj *cmdObj; + Tcl_Obj *parentObj; + Tcl_Obj *fontObj; + HWND hwnd; + Tk_Window parent; +} HookData; + +static UINT_PTR CALLBACK +HookProc( + HWND hwndDlg, + UINT msg, + WPARAM wParam, + LPARAM lParam) +{ + CHOOSEFONT *pcf = (CHOOSEFONT *) lParam; + HWND hwndCtrl; + static HookData *phd = NULL; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (WM_INITDIALOG == msg && lParam != 0) { + phd = (HookData *) pcf->lCustData; + phd->hwnd = hwndDlg; + if (tsdPtr->debugFlag) { + tsdPtr->debugInterp = phd->interp; + Tcl_DoWhenIdle(SetTkDialog, hwndDlg); + } + if (phd->titleObj != NULL) { + Tcl_DString title; + + Tcl_WinUtfToTChar(Tcl_GetString(phd->titleObj), -1, &title); + if (Tcl_DStringLength(&title) > 0) { + SetWindowText(hwndDlg, (LPCTSTR) Tcl_DStringValue(&title)); + } + Tcl_DStringFree(&title); + } + + /* + * Disable the colour combobox (0x473) and its label (0x443). + */ + + hwndCtrl = GetDlgItem(hwndDlg, 0x443); + if (IsWindow(hwndCtrl)) { + EnableWindow(hwndCtrl, FALSE); + } + hwndCtrl = GetDlgItem(hwndDlg, 0x473); + if (IsWindow(hwndCtrl)) { + EnableWindow(hwndCtrl, FALSE); + } + TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility"); + return 1; /* we handled the message */ + } + + if (WM_DESTROY == msg) { + phd->hwnd = NULL; + TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility"); + return 0; + } + + /* + * Handle apply button by calling the provided command script as a + * background evaluation (ie: errors dont come back here). + */ + + if (WM_COMMAND == msg && LOWORD(wParam) == 1026) { + LOGFONT lf = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {0, 0}}; + HDC hdc = GetDC(hwndDlg); + + SendMessage(hwndDlg, WM_CHOOSEFONT_GETLOGFONT, 0, (LPARAM) &lf); + if (phd && phd->cmdObj) { + ApplyLogfont(phd->interp, phd->cmdObj, hdc, &lf); + } + if (phd && phd->parent) { + TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged"); + } + return 1; + } + return 0; /* pass on for default processing */ +} + +/* + * Helper for the FontchooserConfigure command to return the current value of + * any of the options (which may be NULL in the structure) + */ + +enum FontchooserOption { + FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd, + FontchooserVisible +}; + +static Tcl_Obj * +FontchooserCget( + HookData *hdPtr, + int optionIndex) +{ + Tcl_Obj *resObj = NULL; + + switch(optionIndex) { + case FontchooserParent: + if (hdPtr->parentObj) { + resObj = hdPtr->parentObj; + } else { + resObj = Tcl_NewStringObj(".", 1); + } + break; + case FontchooserTitle: + if (hdPtr->titleObj) { + resObj = hdPtr->titleObj; + } else { + resObj = Tcl_NewStringObj("", 0); + } + break; + case FontchooserFont: + if (hdPtr->fontObj) { + resObj = hdPtr->fontObj; + } else { + resObj = Tcl_NewStringObj("", 0); + } + break; + case FontchooserCmd: + if (hdPtr->cmdObj) { + resObj = hdPtr->cmdObj; + } else { + resObj = Tcl_NewStringObj("", 0); + } + break; + case FontchooserVisible: + resObj = Tcl_NewBooleanObj(hdPtr->hwnd && IsWindow(hdPtr->hwnd)); + break; + default: + resObj = Tcl_NewStringObj("", 0); + } + return resObj; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserConfigureCmd -- + * + * Implementation of the 'tk fontchooser configure' ensemble command. See + * the user documentation for what it does. + * + * Results: + * See the user documentation. + * + * Side effects: + * Per-interp data structure may be modified + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserConfigureCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tk_Window tkwin = clientData; + HookData *hdPtr = NULL; + int i, r = TCL_OK; + static const char *const optionStrings[] = { + "-parent", "-title", "-font", "-command", "-visible", NULL + }; + + hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL); + + /* + * With no arguments we return all the options in a dict. + */ + + if (objc == 1) { + Tcl_Obj *keyObj, *valueObj; + Tcl_Obj *dictObj = Tcl_NewDictObj(); + + for (i = 0; r == TCL_OK && optionStrings[i] != NULL; ++i) { + keyObj = Tcl_NewStringObj(optionStrings[i], -1); + valueObj = FontchooserCget(hdPtr, i); + r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj); + } + if (r == TCL_OK) { + Tcl_SetObjResult(interp, dictObj); + } + return r; + } + + for (i = 1; i < objc; i += 2) { + int optionIndex; + + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, + sizeof(char *), "option", 0, &optionIndex) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 2) { + /* + * If one option and no arg - return the current value. + */ + + Tcl_SetObjResult(interp, FontchooserCget(hdPtr, optionIndex)); + return TCL_OK; + } + if (i + 1 == objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case FontchooserVisible: { + static const char *msg = "cannot change read-only option " + "\"-visible\": use the show or hide command"; + + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL); + return TCL_ERROR; + } + case FontchooserParent: { + Tk_Window parent = Tk_NameToWindow(interp, + Tcl_GetString(objv[i+1]), tkwin); + + if (parent == None) { + return TCL_ERROR; + } + if (hdPtr->parentObj) { + Tcl_DecrRefCount(hdPtr->parentObj); + } + hdPtr->parentObj = objv[i+1]; + if (Tcl_IsShared(hdPtr->parentObj)) { + hdPtr->parentObj = Tcl_DuplicateObj(hdPtr->parentObj); + } + Tcl_IncrRefCount(hdPtr->parentObj); + break; + } + case FontchooserTitle: + if (hdPtr->titleObj) { + Tcl_DecrRefCount(hdPtr->titleObj); + } + hdPtr->titleObj = objv[i+1]; + if (Tcl_IsShared(hdPtr->titleObj)) { + hdPtr->titleObj = Tcl_DuplicateObj(hdPtr->titleObj); + } + Tcl_IncrRefCount(hdPtr->titleObj); + break; + case FontchooserFont: + if (hdPtr->fontObj) { + Tcl_DecrRefCount(hdPtr->fontObj); + } + (void)Tcl_GetString(objv[i+1]); + if (objv[i+1]->length) { + hdPtr->fontObj = objv[i+1]; + if (Tcl_IsShared(hdPtr->fontObj)) { + hdPtr->fontObj = Tcl_DuplicateObj(hdPtr->fontObj); + } + Tcl_IncrRefCount(hdPtr->fontObj); + } else { + hdPtr->fontObj = NULL; + } + break; + case FontchooserCmd: + if (hdPtr->cmdObj) { + Tcl_DecrRefCount(hdPtr->cmdObj); + } + (void)Tcl_GetString(objv[i+1]); + if (objv[i+1]->length) { + hdPtr->cmdObj = objv[i+1]; + if (Tcl_IsShared(hdPtr->cmdObj)) { + hdPtr->cmdObj = Tcl_DuplicateObj(hdPtr->cmdObj); + } + Tcl_IncrRefCount(hdPtr->cmdObj); + } else { + hdPtr->cmdObj = NULL; + } + break; + } + } + return TCL_OK; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserShowCmd -- + * + * Implements the 'tk fontchooser show' ensemble command. The per-interp + * configuration data for the dialog is held in an interp associated + * structure. + * + * Calls the Win32 FontChooser API which provides a modal dialog. See + * HookProc where we make a few changes to the dialog and set some + * additional state. + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserShowCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_DString ds; + Tk_Window tkwin = clientData, parent; + CHOOSEFONT cf; + LOGFONT lf; + HDC hdc; + HookData *hdPtr; + int r = TCL_OK, oldMode = 0; + + hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL); + + parent = tkwin; + if (hdPtr->parentObj) { + parent = Tk_NameToWindow(interp, Tcl_GetString(hdPtr->parentObj), + tkwin); + if (parent == None) { + return TCL_ERROR; + } + } + + Tk_MakeWindowExist(parent); + + ZeroMemory(&cf, sizeof(CHOOSEFONT)); + ZeroMemory(&lf, sizeof(LOGFONT)); + lf.lfCharSet = DEFAULT_CHARSET; + cf.lStructSize = sizeof(CHOOSEFONT); + cf.hwndOwner = Tk_GetHWND(Tk_WindowId(parent)); + cf.lpLogFont = &lf; + cf.nFontType = SCREEN_FONTTYPE; + cf.Flags = CF_SCREENFONTS | CF_EFFECTS | CF_ENABLEHOOK; + cf.rgbColors = RGB(0,0,0); + cf.lpfnHook = HookProc; + cf.lCustData = (INT_PTR) hdPtr; + hdPtr->interp = interp; + hdPtr->parent = parent; + hdc = GetDC(cf.hwndOwner); + + if (hdPtr->fontObj != NULL) { + TkFont *fontPtr; + Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, hdPtr->fontObj); + + if (f == NULL) { + return TCL_ERROR; + } + fontPtr = (TkFont *) f; + cf.Flags |= CF_INITTOLOGFONTSTRUCT; + Tcl_WinUtfToTChar(fontPtr->fa.family, -1, &ds); + _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds), + LF_FACESIZE-1); + Tcl_DStringFree(&ds); + lf.lfFaceName[LF_FACESIZE-1] = 0; + lf.lfHeight = -MulDiv(TkFontGetPoints(tkwin, fontPtr->fa.size), + GetDeviceCaps(hdc, LOGPIXELSY), 72); + if (fontPtr->fa.weight == TK_FW_BOLD) { + lf.lfWeight = FW_BOLD; + } + if (fontPtr->fa.slant != TK_FS_ROMAN) { + lf.lfItalic = TRUE; + } + if (fontPtr->fa.underline) { + lf.lfUnderline = TRUE; + } + if (fontPtr->fa.overstrike) { + lf.lfStrikeOut = TRUE; + } + Tk_FreeFont(f); + } + + if (TCL_OK == r && hdPtr->cmdObj != NULL) { + int len = 0; + + r = Tcl_ListObjLength(interp, hdPtr->cmdObj, &len); + if (len > 0) { + cf.Flags |= CF_APPLY; + } + } + + if (TCL_OK == r) { + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); + if (ChooseFont(&cf)) { + if (hdPtr->cmdObj) { + ApplyLogfont(hdPtr->interp, hdPtr->cmdObj, hdc, &lf); + } + if (hdPtr->parent) { + TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged"); + } + } + Tcl_SetServiceMode(oldMode); + EnableWindow(cf.hwndOwner, 1); + } + + ReleaseDC(cf.hwndOwner, hdc); + return r; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserHideCmd -- + * + * Implementation of the 'tk fontchooser hide' ensemble. See the user + * documentation for details. + * As the Win32 FontChooser function is always modal all we do here is + * destroy the dialog + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserHideCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + HookData *hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL); + + if (hdPtr->hwnd && IsWindow(hdPtr->hwnd)) { + EndDialog(hdPtr->hwnd, 0); + } + return TCL_OK; +} + +/* + * ---------------------------------------------------------------------- + * + * DeleteHookData -- + * + * Clean up the font chooser configuration data when the interp is + * destroyed. + * + * ---------------------------------------------------------------------- + */ + +static void +DeleteHookData(ClientData clientData, Tcl_Interp *interp) +{ + HookData *hdPtr = clientData; + + if (hdPtr->parentObj) { + Tcl_DecrRefCount(hdPtr->parentObj); + } + if (hdPtr->fontObj) { + Tcl_DecrRefCount(hdPtr->fontObj); + } + if (hdPtr->titleObj) { + Tcl_DecrRefCount(hdPtr->titleObj); + } + if (hdPtr->cmdObj) { + Tcl_DecrRefCount(hdPtr->cmdObj); + } + ckfree(hdPtr); +} + +/* + * ---------------------------------------------------------------------- + * + * TkInitFontchooser -- + * + * Associate the font chooser configuration data with the Tcl + * interpreter. There is one font chooser per interp. + * + * ---------------------------------------------------------------------- + */ + +MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[]; +const TkEnsemble tkFontchooserEnsemble[] = { + { "configure", FontchooserConfigureCmd, NULL }, + { "show", FontchooserShowCmd, NULL }, + { "hide", FontchooserHideCmd, NULL }, + { NULL, NULL, NULL } +}; + +int +TkInitFontchooser(Tcl_Interp *interp, ClientData clientData) +{ + HookData *hdPtr = ckalloc(sizeof(HookData)); + + memset(hdPtr, 0, sizeof(HookData)); + Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteHookData, hdPtr); + return TCL_OK; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tkWinDraw.c b/win/tkWinDraw.c index 1897bc8..ba4176c 100644 --- a/win/tkWinDraw.c +++ b/win/tkWinDraw.c @@ -17,14 +17,13 @@ * These macros convert between X's bizarre angle units to radians. */ -#define PI 3.14159265358979 #define XAngleToRadians(a) ((double)(a) / 64 * PI / 180); /* * Translation table between X gc functions and Win32 raster op modes. */ -CONST int tkpWinRopModes[] = { +const int tkpWinRopModes[] = { R2_BLACK, /* GXclear */ R2_MASKPEN, /* GXand */ R2_MASKPENNOT, /* GXandReverse */ @@ -55,7 +54,7 @@ CONST int tkpWinRopModes[] = { #define SRCORREVERSE (DWORD)0x00DD0228 /* dest = source OR (NOT dest) */ #define SRCNAND (DWORD)0x007700E6 /* dest = NOT (source AND dest) */ -CONST int tkpWinBltModes[] = { +const int tkpWinBltModes[] = { BLACKNESS, /* GXclear */ SRCAND, /* GXand */ SRCERASE, /* GXandReverse */ @@ -102,7 +101,7 @@ CONST int tkpWinBltModes[] = { * The followng typedef is used to pass Windows GDI drawing functions. */ -typedef BOOL (CALLBACK *WinDrawFunc)(HDC dc, CONST POINT* points, int npoints); +typedef BOOL (CALLBACK *WinDrawFunc)(HDC dc, const POINT *points, int npoints); typedef struct ThreadSpecificData { POINT *winPoints; /* Array of points that is reused. */ @@ -243,9 +242,9 @@ ConvertPoints( if (npoints > tsdPtr->nWinPoints) { if (tsdPtr->winPoints != NULL) { - ckfree((char *) tsdPtr->winPoints); + ckfree(tsdPtr->winPoints); } - tsdPtr->winPoints = (POINT *) ckalloc(sizeof(POINT) * npoints); + tsdPtr->winPoints = ckalloc(sizeof(POINT) * npoints); if (tsdPtr->winPoints == NULL) { tsdPtr->nWinPoints = -1; return NULL; @@ -554,10 +553,10 @@ TkPutImage( usePalette = (image->bits_per_pixel < 16); if (usePalette) { - infoPtr = (BITMAPINFO *) ckalloc(sizeof(BITMAPINFOHEADER) + infoPtr = ckalloc(sizeof(BITMAPINFOHEADER) + sizeof(RGBQUAD)*ncolors); } else { - infoPtr = (BITMAPINFO *) ckalloc(sizeof(BITMAPINFOHEADER)); + infoPtr = ckalloc(sizeof(BITMAPINFOHEADER)); } infoPtr->bmiHeader.biSize = sizeof(BITMAPINFOHEADER); @@ -584,10 +583,10 @@ TkPutImage( } bitmap = CreateDIBitmap(dc, &infoPtr->bmiHeader, CBM_INIT, image->data, infoPtr, DIB_RGB_COLORS); - ckfree((char *) infoPtr); + ckfree(infoPtr); } if (!bitmap) { - Tcl_Panic("Fail to allocate bitmap\n"); + Tcl_Panic("Fail to allocate bitmap"); DeleteDC(dcMem); TkWinReleaseDrawableDC(d, dc, &state); return BadValue; @@ -749,7 +748,7 @@ RenderObject( HPEN pen, WinDrawFunc func) { - RECT rect = {0, 0, 0, 0}; + RECT rect = {0,0,0,0}; HPEN oldPen; HBRUSH oldBrush; POINT *winPoints = ConvertPoints(points, npoints, mode, &rect); @@ -817,7 +816,7 @@ RenderObject( SetPolyFillMode(dcMem, (gc->fill_rule == EvenOddRule) ? ALTERNATE : WINDING); oldMemBrush = SelectObject(dcMem, CreateSolidBrush(gc->foreground)); - (*func)(dcMem, winPoints, npoints); + func(dcMem, winPoints, npoints); BitBlt(dc, rect.left, rect.top, width, height, dcMem, 0, 0, COPYFG); /* @@ -829,7 +828,7 @@ RenderObject( if (gc->fill_style == FillOpaqueStippled) { DeleteObject(SelectObject(dcMem, CreateSolidBrush(gc->background))); - (*func)(dcMem, winPoints, npoints); + func(dcMem, winPoints, npoints); BitBlt(dc, rect.left, rect.top, width, height, dcMem, 0, 0, COPYBG); } @@ -845,9 +844,7 @@ RenderObject( SetPolyFillMode(dc, (gc->fill_rule == EvenOddRule) ? ALTERNATE : WINDING); - - (*func)(dc, winPoints, npoints); - + func(dc, winPoints, npoints); SelectObject(dc, oldPen); } DeleteObject(SelectObject(dc, oldBrush)); diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c index a0670cc..8bfd295 100644 --- a/win/tkWinEmbed.c +++ b/win/tkWinEmbed.c @@ -69,15 +69,15 @@ void TkWinCleanupContainerList(void) { Container *nextPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - for (; tsdPtr->firstContainerPtr != (Container *) NULL; + for (; tsdPtr->firstContainerPtr != NULL; tsdPtr->firstContainerPtr = nextPtr) { nextPtr = tsdPtr->firstContainerPtr->nextPtr; - ckfree((char *) tsdPtr->firstContainerPtr); + ckfree(tsdPtr->firstContainerPtr); } - tsdPtr->firstContainerPtr = (Container *) NULL; + tsdPtr->firstContainerPtr = NULL; } /* @@ -101,8 +101,8 @@ int TkpTestembedCmd( ClientData clientData, Tcl_Interp *interp, - int argc, - CONST char **argv) + int objc, + Tcl_Obj *const objv[]) { return TCL_OK; } @@ -134,7 +134,7 @@ Tk_DetachEmbeddedWindow( TkpWinToplevelOverrideRedirect(winPtr, 0); } } - + /* *---------------------------------------------------------------------- * @@ -230,7 +230,7 @@ TkpUseWindow( * string is bogus. */ Tk_Window tkwin, /* Tk window that does not yet have an * associated X window. */ - CONST char *string) /* String identifying an X window to use for + const char *string) /* String identifying an X window to use for * tkwin; must be an integer value. */ { TkWindow *winPtr = (TkWindow *) tkwin; @@ -243,8 +243,9 @@ TkpUseWindow( /* if (winPtr->window != None) { - Tcl_AppendResult(interp, - "can't modify container after widget is created", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't modify container after widget is created", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL); return TCL_ERROR; } */ @@ -275,8 +276,9 @@ TkpUseWindow( if (!IsWindow(hwnd)) { if (interp != NULL) { - Tcl_AppendResult(interp, "window \"", string, - "\" doesn't exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" doesn't exist", string)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "EXIST", NULL); } return TCL_ERROR; } @@ -284,12 +286,15 @@ TkpUseWindow( id = SendMessage(hwnd, TK_INFO, TK_CONTAINER_VERIFY, 0); if (id == PTR2INT(hwnd)) { if (!SendMessage(hwnd, TK_INFO, TK_CONTAINER_ISAVAILABLE, 0)) { - Tcl_AppendResult(interp, "The container is already in use", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "The container is already in use", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "IN_USE", NULL); return TCL_ERROR; } } else if (id == -PTR2INT(hwnd)) { - Tcl_AppendResult(interp, "the window to use is not a Tk container", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "the window to use is not a Tk container", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL); return TCL_ERROR; } else { /* @@ -301,9 +306,11 @@ TkpUseWindow( char msg[256]; sprintf(msg, "Unable to get information of window \"%.80s\". Attach to this\nwindow may have unpredictable results if it is not a valid container.\n\nPress Ok to proceed or Cancel to abort attaching.", string); - if (IDCANCEL == MessageBox(hwnd, msg, "Tk Warning", + if (IDCANCEL == MessageBoxA(hwnd, msg, "Tk Warning", MB_OKCANCEL | MB_ICONWARNING)) { - Tcl_SetResult(interp, "Operation has been canceled", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Operation has been canceled", -1)); + Tcl_SetErrorCode(interp, "TK", "EMBED", "CANCEL", NULL); return TCL_ERROR; } } @@ -364,7 +371,7 @@ TkpMakeContainer( */ Tk_MakeWindowExist(tkwin); - containerPtr = (Container *) ckalloc(sizeof(Container)); + containerPtr = ckalloc(sizeof(Container)); containerPtr->parentPtr = winPtr; containerPtr->parentHWnd = Tk_GetHWND(Tk_WindowId(tkwin)); containerPtr->embeddedHWnd = NULL; @@ -938,7 +945,7 @@ Tk_GetEmbeddedHWnd( } return NULL; } - + /* *---------------------------------------------------------------------- * @@ -1098,7 +1105,7 @@ EmbedWindowDeleted( } else { prevPtr->nextPtr = containerPtr->nextPtr; } - ckfree((char *) containerPtr); + ckfree(containerPtr); } } diff --git a/win/tkWinFont.c b/win/tkWinFont.c index f209716..9172b00 100644 --- a/win/tkWinFont.c +++ b/win/tkWinFont.c @@ -33,7 +33,7 @@ typedef struct FontFamily { struct FontFamily *nextPtr; /* Next in list of all known font families. */ - int refCount; /* How many SubFonts are referring to this + size_t refCount; /* How many SubFonts are referring to this * FontFamily. When the refCount drops to * zero, this FontFamily may be freed. */ /* @@ -50,7 +50,7 @@ typedef struct FontFamily { int isSymbolFont; /* Non-zero if this is a symbol font. */ int isWideFont; /* 1 if this is a double-byte font, 0 * otherwise. */ - BOOL (WINAPI *textOutProc)(HDC, int, int, TCHAR *, int); + BOOL (WINAPI *textOutProc)(HDC hdc, int x, int y, TCHAR *str, int len); /* The procedure to use to draw text after it * has been converted from UTF-8 to the * encoding of this font. */ @@ -94,10 +94,12 @@ typedef struct FontFamily { typedef struct SubFont { char **fontMap; /* Pointer to font map from the FontFamily, * cached here to save a dereference. */ - HFONT hFont; /* The specific screen font that will be used + HFONT hFont0; /* The specific screen font that will be used * when displaying/measuring chars belonging * to the FontFamily. */ FontFamily *familyPtr; /* The FontFamily for this SubFont. */ + HFONT hFontAngled; + double angle; } SubFont; /* @@ -123,7 +125,6 @@ typedef struct WinFont { * attributes. Usually points to * staticSubFonts, but may point to malloced * space if there are lots of SubFonts. */ - HWND hwnd; /* Toplevel window of application that owns * this font, used for getting HDC for * offscreen measurements. */ @@ -172,7 +173,7 @@ typedef struct ThreadSpecificData { * currently loaded. As screen fonts are * loaded, this list grows to hold information * about what characters exist in each font - * family. */ + * family. */ Tcl_HashTable uidTable; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -189,40 +190,45 @@ static Tcl_Encoding systemEncoding; static FontFamily * AllocFontFamily(HDC hdc, HFONT hFont, int base); static SubFont * CanUseFallback(HDC hdc, WinFont *fontPtr, - char *fallbackName, int ch, + const char *fallbackName, int ch, SubFont **subFontPtrPtr); static SubFont * CanUseFallbackWithAliases(HDC hdc, WinFont *fontPtr, - char *faceName, int ch, Tcl_DString *nameTriedPtr, + const char *faceName, int ch, + Tcl_DString *nameTriedPtr, SubFont **subFontPtrPtr); -static int FamilyExists(HDC hdc, CONST char *faceName); -static char * FamilyOrAliasExists(HDC hdc, CONST char *faceName); +static int FamilyExists(HDC hdc, const char *faceName); +static const char * FamilyOrAliasExists(HDC hdc, const char *faceName); static SubFont * FindSubFontForChar(WinFont *fontPtr, int ch, SubFont **subFontPtrPtr); static void FontMapInsert(SubFont *subFontPtr, int ch); static void FontMapLoadPage(SubFont *subFontPtr, int row); static int FontMapLookup(SubFont *subFontPtr, int ch); static void FreeFontFamily(FontFamily *familyPtr); -static HFONT GetScreenFont(CONST TkFontAttributes *faPtr, - CONST char *faceName, int pixelSize); +static HFONT GetScreenFont(const TkFontAttributes *faPtr, + const char *faceName, int pixelSize, + double angle); static void InitFont(Tk_Window tkwin, HFONT hFont, int overstrike, WinFont *tkFontPtr); -static void InitSubFont(HDC hdc, HFONT hFont, int base, +static inline void InitSubFont(HDC hdc, HFONT hFont, int base, SubFont *subFontPtr); static int CreateNamedSystemLogFont(Tcl_Interp *interp, - Tk_Window tkwin, CONST char* name, + Tk_Window tkwin, const char* name, LOGFONT* logFontPtr); static int CreateNamedSystemFont(Tcl_Interp *interp, - Tk_Window tkwin, CONST char* name, HFONT hFont); + Tk_Window tkwin, const char* name, HFONT hFont); static int LoadFontRanges(HDC hdc, HFONT hFont, USHORT **startCount, USHORT **endCount, int *symbolPtr); static void MultiFontTextOut(HDC hdc, WinFont *fontPtr, - CONST char *source, int numBytes, int x, int y); + const char *source, int numBytes, int x, int y, + double angle); static void ReleaseFont(WinFont *fontPtr); -static void ReleaseSubFont(SubFont *subFontPtr); -static int SeenName(CONST char *name, Tcl_DString *dsPtr); -static void SwapLong(PULONG p); -static void SwapShort(USHORT *p); +static inline void ReleaseSubFont(SubFont *subFontPtr); +static int SeenName(const char *name, Tcl_DString *dsPtr); +static inline HFONT SelectFont(HDC hdc, WinFont *fontPtr, + SubFont *subFontPtr, double angle); +static inline void SwapLong(PULONG p); +static inline void SwapShort(USHORT *p); static int CALLBACK WinFontCanUseProc(ENUMLOGFONT *lfPtr, NEWTEXTMETRIC *tmPtr, int fontType, LPARAM lParam); @@ -298,7 +304,7 @@ TkpFontPkgInit( TkFont * TkpGetNativeFont( Tk_Window tkwin, /* For display where font will be used. */ - CONST char *name) /* Platform-specific font name. */ + const char *name) /* Platform-specific font name. */ { int object; WinFont *fontPtr; @@ -309,7 +315,7 @@ TkpGetNativeFont( } tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr; - fontPtr = (WinFont *) ckalloc(sizeof(WinFont)); + fontPtr = ckalloc(sizeof(WinFont)); InitFont(tkwin, GetStockObject(object), 0, fontPtr); return (TkFont *) fontPtr; @@ -317,13 +323,13 @@ TkpGetNativeFont( /* *--------------------------------------------------------------------------- + * * CreateNamedSystemFont -- * * This function registers a Windows logical font description with the Tk * named font mechanism. * - * Side effects - * + * Side effects: * A new named font is added to the Tk font registry. * *--------------------------------------------------------------------------- @@ -333,12 +339,12 @@ static int CreateNamedSystemLogFont( Tcl_Interp *interp, Tk_Window tkwin, - CONST char* name, - LOGFONTA* logFontPtr) + const char* name, + LOGFONT* logFontPtr) { HFONT hFont; int r; - + hFont = CreateFontIndirect(logFontPtr); r = CreateNamedSystemFont(interp, tkwin, name, hFont); DeleteObject((HGDIOBJ)hFont); @@ -347,13 +353,13 @@ CreateNamedSystemLogFont( /* *--------------------------------------------------------------------------- - * CreateNamedSystemFont -- * - * This function registers a Windows font with the Tk - * named font mechanism. + * CreateNamedSystemFont -- * - * Side effects + * This function registers a Windows font with the Tk named font + * mechanism. * + * Side effects: * A new named font is added to the Tk font registry. * *--------------------------------------------------------------------------- @@ -363,12 +369,12 @@ static int CreateNamedSystemFont( Tcl_Interp *interp, Tk_Window tkwin, - CONST char* name, + const char* name, HFONT hFont) { WinFont winfont; int r; - + TkDeleteNamedFont(NULL, tkwin, name); InitFont(tkwin, hFont, 0, &winfont); r = TkCreateNamedFont(interp, tkwin, name, &winfont.font.fa); @@ -378,16 +384,19 @@ CreateNamedSystemFont( /* *--------------------------------------------------------------------------- + * * TkWinSystemFonts -- * * Create some platform specific named fonts that to give access to the - * system fonts. These are all defined for the Windows desktop parameters. + * system fonts. These are all defined for the Windows desktop + * parameters. * *--------------------------------------------------------------------------- */ void -TkWinSetupSystemFonts(TkMainInfo *mainPtr) +TkWinSetupSystemFonts( + TkMainInfo *mainPtr) { Tcl_Interp *interp; Tk_Window tkwin; @@ -401,14 +410,14 @@ TkWinSetupSystemFonts(TkMainInfo *mainPtr) /* force this for now */ if (((TkWindow *) tkwin)->mainPtr == NULL) { - ((TkWindow *) tkwin)->mainPtr = mainPtr; + ((TkWindow *) tkwin)->mainPtr = mainPtr; } /* - * If this API call fails then we will fallback to setting these - * named fonts from script in ttk/fonts.tcl. So far I've only - * seen it fail when WINVER has been defined for a higher platform than - * we are running on. (ie: WINVER=0x0600 and running on XP). + * If this API call fails then we will fallback to setting these named + * fonts from script in ttk/fonts.tcl. So far I've only seen it fail when + * WINVER has been defined for a higher platform than we are running on. + * (i.e. WINVER=0x0600 and running on XP). */ ZeroMemory(&ncMetrics, sizeof(ncMetrics)); @@ -416,26 +425,26 @@ TkWinSetupSystemFonts(TkMainInfo *mainPtr) if (SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics), &ncMetrics, 0)) { CreateNamedSystemLogFont(interp, tkwin, "TkDefaultFont", - &ncMetrics.lfMessageFont); + &ncMetrics.lfMessageFont); CreateNamedSystemLogFont(interp, tkwin, "TkHeadingFont", - &ncMetrics.lfMessageFont); + &ncMetrics.lfMessageFont); CreateNamedSystemLogFont(interp, tkwin, "TkTextFont", - &ncMetrics.lfMessageFont); + &ncMetrics.lfMessageFont); CreateNamedSystemLogFont(interp, tkwin, "TkMenuFont", - &ncMetrics.lfMenuFont); + &ncMetrics.lfMenuFont); CreateNamedSystemLogFont(interp, tkwin, "TkTooltipFont", - &ncMetrics.lfStatusFont); + &ncMetrics.lfStatusFont); CreateNamedSystemLogFont(interp, tkwin, "TkCaptionFont", - &ncMetrics.lfCaptionFont); + &ncMetrics.lfCaptionFont); CreateNamedSystemLogFont(interp, tkwin, "TkSmallCaptionFont", - &ncMetrics.lfSmCaptionFont); + &ncMetrics.lfSmCaptionFont); } iconMetrics.cbSize = sizeof(iconMetrics); if (SystemParametersInfo(SPI_GETICONMETRICS, sizeof(iconMetrics), &iconMetrics, 0)) { CreateNamedSystemLogFont(interp, tkwin, "TkIconFont", - &iconMetrics.lfFont); + &iconMetrics.lfFont); } /* @@ -444,9 +453,9 @@ TkWinSetupSystemFonts(TkMainInfo *mainPtr) */ { - LOGFONTA lfFixed = { + LOGFONT lfFixed = { 0, 0, 0, 0, FW_NORMAL, FALSE, FALSE, FALSE, DEFAULT_CHARSET, - 0, 0, DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN, "" + 0, 0, DEFAULT_QUALITY, FIXED_PITCH | FF_MODERN, TEXT("") }; long pointSize, dpi; HDC hdc = GetDC(NULL); @@ -457,13 +466,13 @@ TkWinSetupSystemFonts(TkMainInfo *mainPtr) CreateNamedSystemLogFont(interp, tkwin, "TkFixedFont", &lfFixed); } - /* + /* * Setup the remaining standard Tk font names as named fonts. */ for (mapPtr = systemMap; mapPtr->strKey != NULL; mapPtr++) { - hFont = (HFONT)GetStockObject(mapPtr->numKey); - CreateNamedSystemFont(interp, tkwin, mapPtr->strKey, hFont); + hFont = (HFONT) GetStockObject(mapPtr->numKey); + CreateNamedSystemFont(interp, tkwin, mapPtr->strKey, hFont); } } @@ -505,7 +514,7 @@ TkpGetFontFromAttributes( * will be released. If NULL, a new TkFont * structure is allocated. */ Tk_Window tkwin, /* For display where font will be used. */ - CONST TkFontAttributes *faPtr) + const TkFontAttributes *faPtr) /* Set of attributes to match. */ { int i, j; @@ -514,7 +523,7 @@ TkpGetFontFromAttributes( HFONT hFont; Window window; WinFont *fontPtr; - char ***fontFallbacks; + const char *const *const *fontFallbacks; Tk_Uid faceName, fallback, actualName; tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr; @@ -562,9 +571,9 @@ TkpGetFontFromAttributes( ReleaseDC(hwnd, hdc); hFont = GetScreenFont(faPtr, faceName, - TkFontGetPixels(tkwin, faPtr->size)); + TkFontGetPixels(tkwin, faPtr->size), 0.0); if (tkFontPtr == NULL) { - fontPtr = (WinFont *) ckalloc(sizeof(WinFont)); + fontPtr = ckalloc(sizeof(WinFont)); } else { fontPtr = (WinFont *) tkFontPtr; ReleaseFont(fontPtr); @@ -629,10 +638,12 @@ TkpGetFontFamilies( HDC hdc; HWND hwnd; Window window; + Tcl_Obj *resultObj; window = Tk_WindowId(tkwin); hwnd = (window == None) ? NULL : TkWinGetHWND(window); hdc = GetDC(hwnd); + resultObj = Tcl_NewObj(); /* * On any version NT, there may fonts with international names. Use the @@ -649,14 +660,10 @@ TkpGetFontFamilies( * because it only exists under NT. */ - if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontFamilyEnumProc, - (LPARAM) interp); - } else { - EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontFamilyEnumProc, - (LPARAM) interp); - } + EnumFontFamilies(hdc, NULL, (FONTENUMPROC) WinFontFamilyEnumProc, + (LPARAM) resultObj); ReleaseDC(hwnd, hdc); + Tcl_SetObjResult(interp, resultObj); } static int CALLBACK @@ -666,17 +673,13 @@ WinFontFamilyEnumProc( int fontType, /* Type of font (not used). */ LPARAM lParam) /* Result object to hold result. */ { - char *faceName; + char *faceName = (char *) lfPtr->elfLogFont.lfFaceName; + Tcl_Obj *resultObj = (Tcl_Obj *) lParam; Tcl_DString faceString; - Tcl_Obj *strPtr; - Tcl_Interp *interp; - interp = (Tcl_Interp *) lParam; - faceName = lfPtr->elfLogFont.lfFaceName; Tcl_ExternalToUtfDString(systemEncoding, faceName, -1, &faceString); - strPtr = Tcl_NewStringObj(Tcl_DStringValue(&faceString), - Tcl_DStringLength(&faceString)); - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), strPtr); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tcl_DStringValue(&faceString), Tcl_DStringLength(&faceString))); Tcl_DStringFree(&faceString); return 1; } @@ -709,13 +712,14 @@ TkpGetSubFonts( FontFamily *familyPtr; Tcl_Obj *resultPtr, *strPtr; - resultPtr = Tcl_GetObjResult(interp); + resultPtr = Tcl_NewObj(); fontPtr = (WinFont *) tkfont; for (i = 0; i < fontPtr->numSubFonts; i++) { familyPtr = fontPtr->subFontArray[i].familyPtr; strPtr = Tcl_NewStringObj(familyPtr->faceName, -1); Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } + Tcl_SetObjResult(interp, resultPtr); } /* @@ -740,7 +744,7 @@ TkpGetFontAttrsForChar( Tk_Window tkwin, /* Window on the font's display */ Tk_Font tkfont, /* Font to query */ Tcl_UniChar c, /* Character of interest */ - TkFontAttributes* faPtr) /* Output: Font attributes */ + TkFontAttributes *faPtr) /* Output: Font attributes */ { WinFont *fontPtr = (WinFont *) tkfont; /* Structure describing the logical font */ @@ -748,22 +752,22 @@ TkpGetFontAttrsForChar( /* GDI device context */ SubFont *lastSubFontPtr = &fontPtr->subFontArray[0]; /* Pointer to subfont array in case - * FindSubFontForChar needs to fix up - * the memory allocation */ - SubFont *thisSubFontPtr = FindSubFontForChar(fontPtr, c, - &lastSubFontPtr); - /* Pointer to the subfont to use for - * the given character */ + * FindSubFontForChar needs to fix up the + * memory allocation */ + SubFont *thisSubFontPtr = + FindSubFontForChar(fontPtr, c, &lastSubFontPtr); + /* Pointer to the subfont to use for the given + * character */ FontFamily *familyPtr = thisSubFontPtr->familyPtr; HFONT oldfont; /* Saved font from the device context */ - TEXTMETRIC tm; /* Font metrics of the selected subfont */ + TEXTMETRICA tm; /* Font metrics of the selected subfont */ /* * Get the font attributes. */ - oldfont = SelectObject(hdc, thisSubFontPtr->hFont); - GetTextMetrics(hdc, &tm); + oldfont = SelectObject(hdc, thisSubFontPtr->hFont0); + GetTextMetricsA(hdc, &tm); SelectObject(hdc, oldfont); ReleaseDC(fontPtr->hwnd, hdc); faPtr->family = familyPtr->faceName; @@ -778,7 +782,7 @@ TkpGetFontAttrsForChar( /* *--------------------------------------------------------------------------- * - * Tk_MeasureChars -- + * Tk_MeasureChars -- * * Determine the number of bytes from the string that will fit in the * given horizontal span. The measurement is done under the assumption @@ -798,7 +802,7 @@ TkpGetFontAttrsForChar( int Tk_MeasureChars( Tk_Font tkfont, /* Font in which characters will be drawn. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ int numBytes, /* Maximum number of bytes to consider from * source string. */ @@ -829,7 +833,7 @@ Tk_MeasureChars( FontFamily *familyPtr; Tcl_DString runString; SubFont *thisSubFontPtr, *lastSubFontPtr; - CONST char *p, *end, *next = NULL, *start; + const char *p, *end, *next = NULL, *start; if (numBytes == 0) { *lengthPtr = 0; @@ -840,7 +844,7 @@ Tk_MeasureChars( hdc = GetDC(fontPtr->hwnd); lastSubFontPtr = &fontPtr->subFontArray[0]; - oldFont = SelectObject(hdc, lastSubFontPtr->hFont); + oldFont = SelectObject(hdc, lastSubFontPtr->hFont0); /* * A three step process: @@ -862,8 +866,8 @@ Tk_MeasureChars( Tcl_UtfToExternalDString(familyPtr->encoding, start, (int) (p - start), &runString); size.cx = 0; - (*familyPtr->getTextExtentPoint32Proc)(hdc, - Tcl_DStringValue(&runString), + familyPtr->getTextExtentPoint32Proc(hdc, + (TCHAR *)Tcl_DStringValue(&runString), Tcl_DStringLength(&runString) >> familyPtr->isWideFont, &size); Tcl_DStringFree(&runString); @@ -875,7 +879,7 @@ Tk_MeasureChars( lastSubFontPtr = thisSubFontPtr; start = p; - SelectObject(hdc, lastSubFontPtr->hFont); + SelectObject(hdc, lastSubFontPtr->hFont0); } p = next; } @@ -890,8 +894,7 @@ Tk_MeasureChars( Tcl_UtfToExternalDString(familyPtr->encoding, start, (int) (p - start), &runString); size.cx = 0; - (*familyPtr->getTextExtentPoint32Proc)(hdc, - Tcl_DStringValue(&runString), + familyPtr->getTextExtentPoint32Proc(hdc, (TCHAR *) Tcl_DStringValue(&runString), Tcl_DStringLength(&runString) >> familyPtr->isWideFont, &size); Tcl_DStringFree(&runString); @@ -924,8 +927,8 @@ Tk_MeasureChars( &dstWrote, NULL); Tcl_DStringAppend(&runString,buf,dstWrote); size.cx = 0; - (*familyPtr->getTextExtentPoint32Proc)(hdc, - Tcl_DStringValue(&runString), + familyPtr->getTextExtentPoint32Proc(hdc, + (TCHAR *) Tcl_DStringValue(&runString), Tcl_DStringLength(&runString) >> familyPtr->isWideFont, &size); if ((curX+size.cx) > maxLength) { @@ -966,7 +969,7 @@ Tk_MeasureChars( * procedure without the maxLength limit or any flags. */ - CONST char *lastWordBreak = NULL; + const char *lastWordBreak = NULL; Tcl_UniChar ch2; end = p; @@ -1000,7 +1003,7 @@ Tk_MeasureChars( /* *--------------------------------------------------------------------------- * - * TkpMeasureCharsInContext -- + * TkpMeasureCharsInContext -- * * Determine the number of bytes from the string that will fit in the * given horizontal span. The measurement is done under the assumption @@ -1025,7 +1028,7 @@ Tk_MeasureChars( int TkpMeasureCharsInContext( Tk_Font tkfont, /* Font in which characters will be drawn. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. */ int numBytes, /* Maximum number of bytes to consider from * source string in all. */ @@ -1077,7 +1080,7 @@ Tk_DrawChars( GC gc, /* Graphics context for drawing characters. */ Tk_Font tkfont, /* Font in which characters will be drawn; * must be the same as font used in GC. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. All Tk meta-characters * (tabs, control characters, and newlines) * should be stripped out of the string that @@ -1104,18 +1107,18 @@ Tk_DrawChars( SetROP2(dc, tkpWinRopModes[gc->function]); if ((gc->clip_mask != None) && - ((TkpClipMask*)gc->clip_mask)->type == TKP_CLIP_REGION) { - SelectClipRgn(dc, (HRGN)((TkpClipMask*)gc->clip_mask)->value.region); + ((TkpClipMask *) gc->clip_mask)->type == TKP_CLIP_REGION) { + SelectClipRgn(dc, (HRGN)((TkpClipMask *)gc->clip_mask)->value.region); } if ((gc->fill_style == FillStippled || gc->fill_style == FillOpaqueStippled) && gc->stipple != None) { - TkWinDrawable *twdPtr = (TkWinDrawable *)gc->stipple; + TkWinDrawable *twdPtr = (TkWinDrawable *) gc->stipple; HBRUSH oldBrush, stipple; HBITMAP oldBitmap, bitmap; HDC dcMem; - TEXTMETRIC tm; + TEXTMETRICA tm; SIZE size; if (twdPtr->type != TWD_BITMAP) { @@ -1141,8 +1144,8 @@ Tk_DrawChars( * Compute the bounding box and create a compatible bitmap. */ - GetTextExtentPoint(dcMem, source, numBytes, &size); - GetTextMetrics(dcMem, &tm); + GetTextExtentPointA(dcMem, source, numBytes, &size); + GetTextMetricsA(dcMem, &tm); size.cx -= tm.tmOverhang; bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy); oldBitmap = SelectObject(dcMem, bitmap); @@ -1156,11 +1159,11 @@ Tk_DrawChars( */ PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS); - MultiFontTextOut(dc, fontPtr, source, numBytes, x, y); + MultiFontTextOut(dc, fontPtr, source, numBytes, x, y, 0.0); BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem, 0, 0, 0xEA02E9); PatBlt(dcMem, 0, 0, size.cx, size.cy, WHITENESS); - MultiFontTextOut(dc, fontPtr, source, numBytes, x, y); + MultiFontTextOut(dc, fontPtr, source, numBytes, x, y, 0.0); BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem, 0, 0, 0x8A0E06); @@ -1177,11 +1180,11 @@ Tk_DrawChars( SetTextAlign(dc, TA_LEFT | TA_BASELINE); SetTextColor(dc, gc->foreground); SetBkMode(dc, TRANSPARENT); - MultiFontTextOut(dc, fontPtr, source, numBytes, x, y); + MultiFontTextOut(dc, fontPtr, source, numBytes, x, y, 0.0); } else { HBITMAP oldBitmap, bitmap; HDC dcMem; - TEXTMETRIC tm; + TEXTMETRICA tm; SIZE size; dcMem = CreateCompatibleDC(dc); @@ -1195,13 +1198,14 @@ Tk_DrawChars( * Compute the bounding box and create a compatible bitmap. */ - GetTextExtentPoint(dcMem, source, numBytes, &size); - GetTextMetrics(dcMem, &tm); + GetTextExtentPointA(dcMem, source, numBytes, &size); + GetTextMetricsA(dcMem, &tm); size.cx -= tm.tmOverhang; bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy); oldBitmap = SelectObject(dcMem, bitmap); - MultiFontTextOut(dcMem, fontPtr, source, numBytes, 0, tm.tmAscent); + MultiFontTextOut(dcMem, fontPtr, source, numBytes, 0, tm.tmAscent, + 0.0); BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem, 0, 0, (DWORD) tkpWinBltModes[gc->function]); @@ -1216,6 +1220,154 @@ Tk_DrawChars( TkWinReleaseDrawableDC(drawable, dc, &state); } +void +TkDrawAngledChars( + Display *display, /* Display on which to draw. */ + Drawable drawable, /* Window or pixmap in which to draw. */ + GC gc, /* Graphics context for drawing characters. */ + Tk_Font tkfont, /* Font in which characters will be drawn; + * must be the same as font used in GC. */ + const char *source, /* UTF-8 string to be displayed. Need not be + * '\0' terminated. All Tk meta-characters + * (tabs, control characters, and newlines) + * should be stripped out of the string that + * is passed to this function. If they are not + * stripped out, they will be displayed as + * regular printing characters. */ + int numBytes, /* Number of bytes in string. */ + double x, double y, /* Coordinates at which to place origin of + * string when drawing. */ + double angle) +{ + HDC dc; + WinFont *fontPtr; + TkWinDCState state; + + fontPtr = (WinFont *) gc->font; + display->request++; + + if (drawable == None) { + return; + } + + dc = TkWinGetDrawableDC(display, drawable, &state); + + SetROP2(dc, tkpWinRopModes[gc->function]); + + if ((gc->clip_mask != None) && + ((TkpClipMask *) gc->clip_mask)->type == TKP_CLIP_REGION) { + SelectClipRgn(dc, (HRGN)((TkpClipMask *)gc->clip_mask)->value.region); + } + + if ((gc->fill_style == FillStippled + || gc->fill_style == FillOpaqueStippled) + && gc->stipple != None) { + TkWinDrawable *twdPtr = (TkWinDrawable *)gc->stipple; + HBRUSH oldBrush, stipple; + HBITMAP oldBitmap, bitmap; + HDC dcMem; + TEXTMETRICA tm; + SIZE size; + + if (twdPtr->type != TWD_BITMAP) { + Tcl_Panic("unexpected drawable type in stipple"); + } + + /* + * Select stipple pattern into destination dc. + */ + + dcMem = CreateCompatibleDC(dc); + + stipple = CreatePatternBrush(twdPtr->bitmap.handle); + SetBrushOrgEx(dc, gc->ts_x_origin, gc->ts_y_origin, NULL); + oldBrush = SelectObject(dc, stipple); + + SetTextAlign(dcMem, TA_LEFT | TA_BASELINE); + SetTextColor(dcMem, gc->foreground); + SetBkMode(dcMem, TRANSPARENT); + SetBkColor(dcMem, RGB(0, 0, 0)); + + /* + * Compute the bounding box and create a compatible bitmap. + */ + + GetTextExtentPointA(dcMem, source, numBytes, &size); + GetTextMetricsA(dcMem, &tm); + size.cx -= tm.tmOverhang; + bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy); + oldBitmap = SelectObject(dcMem, bitmap); + + /* + * The following code is tricky because fonts are rendered in multiple + * colors. First we draw onto a black background and copy the white + * bits. Then we draw onto a white background and copy the black bits. + * Both the foreground and background bits of the font are ANDed with + * the stipple pattern as they are copied. + */ + + PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS); + MultiFontTextOut(dc, fontPtr, source, numBytes, (int)x, (int)y, angle); + BitBlt(dc, (int)x, (int)y - tm.tmAscent, size.cx, size.cy, dcMem, + 0, 0, 0xEA02E9); + PatBlt(dcMem, 0, 0, size.cx, size.cy, WHITENESS); + MultiFontTextOut(dc, fontPtr, source, numBytes, (int)x, (int)y, angle); + BitBlt(dc, (int)x, (int)y - tm.tmAscent, size.cx, size.cy, dcMem, + 0, 0, 0x8A0E06); + + /* + * Destroy the temporary bitmap and restore the device context. + */ + + SelectObject(dcMem, oldBitmap); + DeleteObject(bitmap); + DeleteDC(dcMem); + SelectObject(dc, oldBrush); + DeleteObject(stipple); + } else if (gc->function == GXcopy) { + SetTextAlign(dc, TA_LEFT | TA_BASELINE); + SetTextColor(dc, gc->foreground); + SetBkMode(dc, TRANSPARENT); + MultiFontTextOut(dc, fontPtr, source, numBytes, (int)x, (int)y, angle); + } else { + HBITMAP oldBitmap, bitmap; + HDC dcMem; + TEXTMETRICA tm; + SIZE size; + + dcMem = CreateCompatibleDC(dc); + + SetTextAlign(dcMem, TA_LEFT | TA_BASELINE); + SetTextColor(dcMem, gc->foreground); + SetBkMode(dcMem, TRANSPARENT); + SetBkColor(dcMem, RGB(0, 0, 0)); + + /* + * Compute the bounding box and create a compatible bitmap. + */ + + GetTextExtentPointA(dcMem, source, numBytes, &size); + GetTextMetricsA(dcMem, &tm); + size.cx -= tm.tmOverhang; + bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy); + oldBitmap = SelectObject(dcMem, bitmap); + + MultiFontTextOut(dcMem, fontPtr, source, numBytes, 0, tm.tmAscent, + angle); + BitBlt(dc, (int)x, (int)y - tm.tmAscent, size.cx, size.cy, dcMem, + 0, 0, (DWORD) tkpWinBltModes[gc->function]); + + /* + * Destroy the temporary bitmap and restore the device context. + */ + + SelectObject(dcMem, oldBitmap); + DeleteObject(bitmap); + DeleteDC(dcMem); + } + TkWinReleaseDrawableDC(drawable, dc, &state); +} + /* *--------------------------------------------------------------------------- * @@ -1241,7 +1393,7 @@ TkpDrawCharsInContext( GC gc, /* Graphics context for drawing characters. */ Tk_Font tkfont, /* Font in which characters will be drawn; * must be the same as font used in GC. */ - CONST char *source, /* UTF-8 string to be displayed. Need not be + const char *source, /* UTF-8 string to be displayed. Need not be * '\0' terminated. All Tk meta-characters * (tabs, control characters, and newlines) * should be stripped out of the string that @@ -1256,8 +1408,8 @@ TkpDrawCharsInContext( * drawing. */ { (void) numBytes; /*unused*/ - Tk_DrawChars(display, drawable, gc, tkfont, - source + rangeStart, rangeLength, x, y); + Tk_DrawChars(display, drawable, gc, tkfont, source + rangeStart, + rangeLength, x, y); } /* @@ -1285,23 +1437,24 @@ MultiFontTextOut( HDC hdc, /* HDC to draw into. */ WinFont *fontPtr, /* Contains set of fonts to use when drawing * following string. */ - CONST char *source, /* Potentially multilingual UTF-8 string. */ + const char *source, /* Potentially multilingual UTF-8 string. */ int numBytes, /* Length of string in bytes. */ - int x, int y) /* Coordinates at which to place origin of + int x, int y, /* Coordinates at which to place origin of * string when drawing. */ + double angle) { Tcl_UniChar ch; SIZE size; HFONT oldFont; FontFamily *familyPtr; Tcl_DString runString; - CONST char *p, *end, *next; + const char *p, *end, *next; SubFont *lastSubFontPtr, *thisSubFontPtr; - TEXTMETRIC tm; + TEXTMETRICA tm; lastSubFontPtr = &fontPtr->subFontArray[0]; - oldFont = SelectObject(hdc, lastSubFontPtr->hFont); - GetTextMetrics(hdc, &tm); + oldFont = SelectFont(hdc, fontPtr, lastSubFontPtr, angle); + GetTextMetricsA(hdc, &tm); end = source + numBytes; for (p = source; p < end; ) { @@ -1312,11 +1465,11 @@ MultiFontTextOut( familyPtr = lastSubFontPtr->familyPtr; Tcl_UtfToExternalDString(familyPtr->encoding, source, (int) (p - source), &runString); - (*familyPtr->textOutProc)(hdc, x-(tm.tmOverhang/2), y, - Tcl_DStringValue(&runString), + familyPtr->textOutProc(hdc, x-(tm.tmOverhang/2), y, + (TCHAR *)Tcl_DStringValue(&runString), Tcl_DStringLength(&runString)>>familyPtr->isWideFont); - (*familyPtr->getTextExtentPoint32Proc)(hdc, - Tcl_DStringValue(&runString), + familyPtr->getTextExtentPoint32Proc(hdc, + (TCHAR *)Tcl_DStringValue(&runString), Tcl_DStringLength(&runString) >> familyPtr->isWideFont, &size); x += size.cx; @@ -1324,8 +1477,8 @@ MultiFontTextOut( } lastSubFontPtr = thisSubFontPtr; source = p; - SelectObject(hdc, lastSubFontPtr->hFont); - GetTextMetrics(hdc, &tm); + SelectFont(hdc, fontPtr, lastSubFontPtr, angle); + GetTextMetricsA(hdc, &tm); } p = next; } @@ -1333,13 +1486,38 @@ MultiFontTextOut( familyPtr = lastSubFontPtr->familyPtr; Tcl_UtfToExternalDString(familyPtr->encoding, source, (int) (p - source), &runString); - (*familyPtr->textOutProc)(hdc, x-(tm.tmOverhang/2), y, - Tcl_DStringValue(&runString), + familyPtr->textOutProc(hdc, x-(tm.tmOverhang/2), y, + (TCHAR *)Tcl_DStringValue(&runString), Tcl_DStringLength(&runString) >> familyPtr->isWideFont); Tcl_DStringFree(&runString); } SelectObject(hdc, oldFont); } + +static inline HFONT +SelectFont( + HDC hdc, + WinFont *fontPtr, + SubFont *subFontPtr, + double angle) +{ + if (angle == 0.0) { + return SelectObject(hdc, subFontPtr->hFont0); + } else if (angle == subFontPtr->angle) { + return SelectObject(hdc, subFontPtr->hFontAngled); + } else { + if (subFontPtr->hFontAngled) { + DeleteObject(subFontPtr->hFontAngled); + } + subFontPtr->hFontAngled = GetScreenFont(&fontPtr->font.fa, + subFontPtr->familyPtr->faceName, fontPtr->pixelSize, angle); + if (subFontPtr->hFontAngled == NULL) { + return SelectObject(hdc, subFontPtr->hFont0); + } + subFontPtr->angle = angle; + return SelectObject(hdc, subFontPtr->hFontAngled); + } +} /* *--------------------------------------------------------------------------- @@ -1378,20 +1556,20 @@ InitFont( HDC hdc; HWND hwnd; HFONT oldFont; - TEXTMETRIC tm; + TEXTMETRICA tm; Window window; TkFontMetrics *fmPtr; Tcl_Encoding encoding; Tcl_DString faceString; TkFontAttributes *faPtr; - char buf[LF_FACESIZE * sizeof(WCHAR)]; + TCHAR buf[LF_FACESIZE]; window = Tk_WindowId(tkwin); hwnd = (window == None) ? NULL : TkWinGetHWND(window); hdc = GetDC(hwnd); oldFont = SelectObject(hdc, hFont); - GetTextMetrics(hdc, &tm); + GetTextMetricsA(hdc, &tm); /* * On any version NT, there may fonts with international names. Use the @@ -1408,12 +1586,8 @@ InitFont( * GetTextFace because it only exists under NT. */ - if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf); - } else { - GetTextFaceA(hdc, LF_FACESIZE, (char *) buf); - } - Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString); + GetTextFace(hdc, LF_FACESIZE, buf); + Tcl_ExternalToUtfDString(systemEncoding, (char *) buf, -1, &faceString); fontPtr->font.fid = (Font) fontPtr; fontPtr->hwnd = hwnd; @@ -1423,7 +1597,7 @@ InitFont( faPtr->family = Tk_GetUid(Tcl_DStringValue(&faceString)); faPtr->size = - TkFontGetPoints(tkwin, -(fontPtr->pixelSize)); + TkFontGetPoints(tkwin, -(fontPtr->pixelSize)); faPtr->weight = (tm.tmWeight > FW_MEDIUM) ? TK_FW_BOLD : TK_FW_NORMAL; faPtr->slant = (tm.tmItalic != 0) ? TK_FS_ITALIC : TK_FS_ROMAN; @@ -1442,7 +1616,7 @@ InitFont( encoding = fontPtr->subFontArray[0].familyPtr->encoding; if (encoding == TkWinGetUnicodeEncoding()) { - GetCharWidthW(hdc, 0, BASE_CHARS - 1, fontPtr->widths); + GetCharWidth(hdc, 0, BASE_CHARS - 1, fontPtr->widths); } else { GetCharWidthA(hdc, 0, BASE_CHARS - 1, fontPtr->widths); } @@ -1479,7 +1653,7 @@ ReleaseFont( ReleaseSubFont(&fontPtr->subFontArray[i]); } if (fontPtr->subFontArray != fontPtr->staticSubFonts) { - ckfree((char *) fontPtr->subFontArray); + ckfree(fontPtr->subFontArray); } } @@ -1501,7 +1675,7 @@ ReleaseFont( *------------------------------------------------------------------------- */ -static void +static inline void InitSubFont( HDC hdc, /* HDC in which font can be selected. */ HFONT hFont, /* The screen font. */ @@ -1510,9 +1684,11 @@ InitSubFont( SubFont *subFontPtr) /* Filled with SubFont constructed from above * attributes. */ { - subFontPtr->hFont = hFont; + subFontPtr->hFont0 = hFont; subFontPtr->familyPtr = AllocFontFamily(hdc, hFont, base); subFontPtr->fontMap = subFontPtr->familyPtr->fontMap; + subFontPtr->hFontAngled = NULL; + subFontPtr->angle = 0.0; } /* @@ -1532,11 +1708,14 @@ InitSubFont( *--------------------------------------------------------------------------- */ -static void +static inline void ReleaseSubFont( SubFont *subFontPtr) /* The SubFont to delete. */ { - DeleteObject(subFontPtr->hFont); + DeleteObject(subFontPtr->hFont0); + if (subFontPtr->hFontAngled) { + DeleteObject(subFontPtr->hFontAngled); + } FreeFontFamily(subFontPtr->familyPtr); } @@ -1579,17 +1758,13 @@ AllocFontFamily( FontFamily *familyPtr; Tcl_DString faceString; Tcl_Encoding encoding; - char buf[LF_FACESIZE * sizeof(WCHAR)]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TCHAR buf[LF_FACESIZE]; + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); hFont = SelectObject(hdc, hFont); - if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf); - } else { - GetTextFaceA(hdc, LF_FACESIZE, (char *) buf); - } - Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString); + GetTextFace(hdc, LF_FACESIZE, buf); + Tcl_ExternalToUtfDString(systemEncoding, (char *) buf, -1, &faceString); faceName = Tk_GetUid(Tcl_DStringValue(&faceString)); Tcl_DStringFree(&faceString); hFont = SelectObject(hdc, hFont); @@ -1602,7 +1777,7 @@ AllocFontFamily( } } - familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily)); + familyPtr = ckalloc(sizeof(FontFamily)); memset(familyPtr, 0, sizeof(FontFamily)); familyPtr->nextPtr = tsdPtr->fontFamilyList; tsdPtr->fontFamilyList = familyPtr; @@ -1688,14 +1863,13 @@ FreeFontFamily( { int i; FontFamily **familyPtrPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (familyPtr == NULL) { return; } - familyPtr->refCount--; - if (familyPtr->refCount > 0) { + if (familyPtr->refCount-- > 1) { return; } for (i = 0; i < FONTMAP_PAGES; i++) { @@ -1704,10 +1878,10 @@ FreeFontFamily( } } if (familyPtr->startCount != NULL) { - ckfree((char *) familyPtr->startCount); + ckfree(familyPtr->startCount); } if (familyPtr->endCount != NULL) { - ckfree((char *) familyPtr->endCount); + ckfree(familyPtr->endCount); } if (familyPtr->encoding != TkWinGetUnicodeEncoding()) { Tcl_FreeEncoding(familyPtr->encoding); @@ -1719,13 +1893,13 @@ FreeFontFamily( for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) { if (*familyPtrPtr == familyPtr) { - *familyPtrPtr = familyPtr->nextPtr; + *familyPtrPtr = familyPtr->nextPtr; break; } familyPtrPtr = &(*familyPtrPtr)->nextPtr; } - ckfree((char *) familyPtr); + ckfree(familyPtr); } /* @@ -1759,9 +1933,10 @@ FindSubFontForChar( HDC hdc; int i, j, k; CanUse canUse; - char **aliases, **anyFallbacks; - char ***fontFallbacks; - char *fallbackName; + const char *const *aliases; + const char *const *anyFallbacks; + const char *const *const *fontFallbacks; + const char *fallbackName; SubFont *subFontPtr; Tcl_DString ds; @@ -1850,13 +2025,8 @@ FindSubFontForChar( canUse.ch = ch; canUse.subFontPtr = NULL; canUse.subFontPtrPtr = subFontPtrPtr; - if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontCanUseProc, - (LPARAM) &canUse); - } else { - EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontCanUseProc, - (LPARAM) &canUse); - } + EnumFontFamilies(hdc, NULL, (FONTENUMPROC) WinFontCanUseProc, + (LPARAM) &canUse); subFontPtr = canUse.subFontPtr; end: @@ -1864,7 +2034,7 @@ FindSubFontForChar( if (subFontPtr == NULL) { /* - * No font can display this character. We will use the base font and + * No font can display this character. We will use the base font and * have it display the "unknown" character. */ @@ -1897,7 +2067,7 @@ WinFontCanUseProc( fontPtr = canUsePtr->fontPtr; nameTriedPtr = canUsePtr->nameTriedPtr; - fallbackName = lfPtr->elfLogFont.lfFaceName; + fallbackName = (char *) lfPtr->elfLogFont.lfFaceName; Tcl_ExternalToUtfDString(systemEncoding, fallbackName, -1, &faceString); fallbackName = Tcl_DStringValue(&faceString); @@ -2022,7 +2192,7 @@ FontMapLoadPage( USHORT *startCount, *endCount; int i, j, bitOffset, end, segCount; - subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8); + subFontPtr->fontMap[row] = ckalloc(FONTMAP_BITSPERPAGE / 8); memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8); familyPtr = subFontPtr->familyPtr; @@ -2046,7 +2216,8 @@ FontMapLoadPage( if (endCount[j] >= i) { if (startCount[j] <= i) { bitOffset = i & (FONTMAP_BITSPERPAGE - 1); - subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7); + subFontPtr->fontMap[row][bitOffset >> 3] |= + 1 << (bitOffset & 7); } break; } @@ -2104,7 +2275,7 @@ CanUseFallbackWithAliases( HDC hdc, /* HDC in which font can be selected. */ WinFont *fontPtr, /* The font object that will own the new * screen font. */ - char *faceName, /* Desired face name for new screen font. */ + const char *faceName, /* Desired face name for new screen font. */ int ch, /* The Unicode character that the new screen * font must be able to display. */ Tcl_DString *nameTriedPtr, /* Records face names that have already been @@ -2115,7 +2286,7 @@ CanUseFallbackWithAliases( * array of subfonts. */ { int i; - char **aliases; + const char *const *aliases; SubFont *subFontPtr; if (SeenName(faceName, nameTriedPtr) == 0) { @@ -2160,11 +2331,11 @@ CanUseFallbackWithAliases( static int SeenName( - CONST char *name, /* The name to check. */ + const char *name, /* The name to check. */ Tcl_DString *dsPtr) /* Contains names that have already been * seen. */ { - CONST char *seen, *end; + const char *seen, *end; seen = Tcl_DStringValue(dsPtr); end = seen + Tcl_DStringLength(dsPtr); @@ -2174,7 +2345,7 @@ SeenName( } seen += strlen(seen) + 1; } - Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1)); + Tcl_DStringAppend(dsPtr, name, (int) (strlen(name) + 1)); return 0; } @@ -2207,7 +2378,7 @@ CanUseFallback( HDC hdc, /* HDC in which font can be selected. */ WinFont *fontPtr, /* The font object that will own the new * screen font. */ - char *faceName, /* Desired face name for new screen font. */ + const char *faceName, /* Desired face name for new screen font. */ int ch, /* The Unicode character that the new screen * font must be able to display. */ SubFont **subFontPtrPtr) /* Variable to fix-up if we realloc the array @@ -2235,7 +2406,8 @@ CanUseFallback( * Load this font and see if it has the desired character. */ - hFont = GetScreenFont(&fontPtr->font.fa, faceName, fontPtr->pixelSize); + hFont = GetScreenFont(&fontPtr->font.fa, faceName, fontPtr->pixelSize, + 0.0); InitSubFont(hdc, hFont, 0, &subFont); if (((ch < 256) && (subFont.familyPtr->isSymbolFont)) || (FontMapLookup(&subFont, ch) == 0)) { @@ -2251,12 +2423,11 @@ CanUseFallback( if (fontPtr->numSubFonts >= SUBFONT_SPACE) { SubFont *newPtr; - newPtr = (SubFont *) ckalloc(sizeof(SubFont) - * (fontPtr->numSubFonts + 1)); - memcpy((char *) newPtr, fontPtr->subFontArray, + newPtr = ckalloc(sizeof(SubFont) * (fontPtr->numSubFonts + 1)); + memcpy(newPtr, fontPtr->subFontArray, fontPtr->numSubFonts * sizeof(SubFont)); if (fontPtr->subFontArray != fontPtr->staticSubFonts) { - ckfree((char *) fontPtr->subFontArray); + ckfree(fontPtr->subFontArray); } /* @@ -2291,22 +2462,24 @@ CanUseFallback( static HFONT GetScreenFont( - CONST TkFontAttributes *faPtr, + const TkFontAttributes *faPtr, /* Desired font attributes for new HFONT. */ - CONST char *faceName, /* Overrides font family specified in font + const char *faceName, /* Overrides font family specified in font * attributes. */ - int pixelSize) /* Overrides size specified in font + int pixelSize, /* Overrides size specified in font * attributes. */ + double angle) /* What is the desired orientation of the + * font. */ { Tcl_DString ds; HFONT hFont; - LOGFONTW lf; + LOGFONT lf; memset(&lf, 0, sizeof(lf)); lf.lfHeight = -pixelSize; lf.lfWidth = 0; - lf.lfEscapement = 0; - lf.lfOrientation = 0; + lf.lfEscapement = ROUND16(angle * 10); + lf.lfOrientation = ROUND16(angle * 10); lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD; lf.lfItalic = faPtr->slant; lf.lfUnderline = faPtr->underline; @@ -2318,36 +2491,10 @@ GetScreenFont( lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE; Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &ds); - - if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - Tcl_UniChar *src, *dst; - - /* - * We can only store up to LF_FACESIZE wide characters - */ - - if ((size_t)Tcl_DStringLength(&ds) >= (LF_FACESIZE * sizeof(WCHAR))) { - Tcl_DStringSetLength(&ds, LF_FACESIZE); - } - src = (Tcl_UniChar *) Tcl_DStringValue(&ds); - dst = (Tcl_UniChar *) lf.lfFaceName; - while (*src != '\0') { - *dst++ = *src++; - } - *dst = '\0'; - hFont = CreateFontIndirectW(&lf); - } else { - /* - * We can only store up to LF_FACESIZE characters - */ - - if (Tcl_DStringLength(&ds) >= LF_FACESIZE) { - Tcl_DStringSetLength(&ds, LF_FACESIZE); - } - strcpy((char *) lf.lfFaceName, Tcl_DStringValue(&ds)); - hFont = CreateFontIndirectA((LOGFONTA *) &lf); - } + _tcsncpy(lf.lfFaceName, (TCHAR *)Tcl_DStringValue(&ds), LF_FACESIZE-1); Tcl_DStringFree(&ds); + lf.lfFaceName[LF_FACESIZE-1] = 0; + hFont = CreateFontIndirect(&lf); return hFont; } @@ -2373,7 +2520,7 @@ GetScreenFont( static int FamilyExists( HDC hdc, /* HDC in which font family will be used. */ - CONST char *faceName) /* Font family to query. */ + const char *faceName) /* Font family to query. */ { int result; Tcl_DString faceString; @@ -2403,27 +2550,22 @@ FamilyExists( * non-zero value. */ - if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - result = EnumFontFamiliesW(hdc, (WCHAR*) Tcl_DStringValue(&faceString), - (FONTENUMPROCW) WinFontExistProc, 0); - } else { - result = EnumFontFamiliesA(hdc, (char *) Tcl_DStringValue(&faceString), - (FONTENUMPROCA) WinFontExistProc, 0); - } + result = EnumFontFamilies(hdc, (TCHAR*) Tcl_DStringValue(&faceString), + (FONTENUMPROC) WinFontExistProc, 0); Tcl_DStringFree(&faceString); return (result == 0); } -static char * +static const char * FamilyOrAliasExists( HDC hdc, - CONST char *faceName) + const char *faceName) { - char **aliases; + const char *const *aliases; int i; if (FamilyExists(hdc, faceName) != 0) { - return (char *) faceName; + return faceName; } aliases = TkFontGetAliasList(faceName); if (aliases != NULL) { @@ -2453,7 +2595,7 @@ WinFontExistProc( #pragma pack(1) /* Structures are byte aligned in file. */ -#define CMAPHEX 0x636d6170 /* Key for character map resource. */ +#define CMAPHEX 0x636d6170 /* Key for character map resource. */ typedef struct CMAPTABLE { USHORT version; /* Table version number (0). */ @@ -2495,7 +2637,7 @@ typedef struct SUBHEADER { } SUBHEADER; typedef struct HIBYTETABLE { - USHORT format; /* Format number is set to 2. */ + USHORT format; /* Format number is set to 2. */ USHORT length; /* The actual length in bytes of this * subtable. */ USHORT version; /* Version number (starts at 0). */ @@ -2613,7 +2755,7 @@ LoadFontRanges( } n = GetFontData(hdc, cmapKey, 0, &cmapTable, sizeof(cmapTable)); - if (n != (int)GDI_ERROR) { + if (n != (int) GDI_ERROR) { if (swapped) { SwapShort(&cmapTable.numTables); } @@ -2651,8 +2793,8 @@ LoadFontRanges( segCount = subTable.segment.segCountX2 / 2; cbData = segCount * sizeof(USHORT); - startCount = (USHORT *) ckalloc((unsigned)cbData); - endCount = (USHORT *) ckalloc((unsigned)cbData); + startCount = ckalloc(cbData); + endCount = ckalloc(cbData); offset = encTable.offset + sizeof(subTable.segment); GetFontData(hdc, cmapKey, (DWORD) offset, endCount, cbData); @@ -2695,8 +2837,8 @@ LoadFontRanges( segCount = 1; cbData = segCount * sizeof(USHORT); - startCount = (USHORT *) ckalloc((unsigned) cbData); - endCount = (USHORT *) ckalloc((unsigned) cbData); + startCount = ckalloc(cbData); + endCount = ckalloc(cbData); startCount[0] = 0x0000; endCount[0] = 0x00ff; } @@ -2724,14 +2866,14 @@ LoadFontRanges( *------------------------------------------------------------------------- */ -static void +static inline void SwapShort( PUSHORT p) { *p = (SHORT)(HIBYTE(*p) + (LOBYTE(*p) << 8)); } -static void +static inline void SwapLong( PULONG p) { diff --git a/win/tkWinImage.c b/win/tkWinImage.c index 8e6ef38..d61b84a 100644 --- a/win/tkWinImage.c +++ b/win/tkWinImage.c @@ -39,9 +39,9 @@ DestroyImage( { if (imagePtr) { if (imagePtr->data) { - ckfree((char*)imagePtr->data); + ckfree(imagePtr->data); } - ckfree((char*)imagePtr); + ckfree(imagePtr); } return 0; } @@ -211,7 +211,7 @@ XCreateImage( int bitmap_pad, int bytes_per_line) { - XImage* imagePtr = (XImage *) ckalloc(sizeof(XImage)); + XImage* imagePtr = ckalloc(sizeof(XImage)); imagePtr->width = width; imagePtr->height = height; imagePtr->xoffset = offset; @@ -301,8 +301,7 @@ XGetImageZPixmap( BOOL ret; if (format != ZPixmap) { - TkpDisplayWarning( - "XGetImageZPixmap: only ZPixmap types are implemented", + TkpDisplayWarning("Only ZPixmap types are implemented", "XGetImageZPixmap Failure"); return NULL; } @@ -350,7 +349,7 @@ XGetImageZPixmap( if (depth <= 8) { size += sizeof(unsigned short) * (1 << depth); } - bmInfo = (BITMAPINFO *) ckalloc((unsigned)size); + bmInfo = ckalloc(size); bmInfo->bmiHeader.biSize = sizeof(BITMAPINFOHEADER); bmInfo->bmiHeader.biWidth = width; @@ -368,16 +367,16 @@ XGetImageZPixmap( unsigned char *p, *pend; GetDIBits(hdcMem, hbmp, 0, height, NULL, bmInfo, DIB_PAL_COLORS); - data = (unsigned char *) ckalloc(bmInfo->bmiHeader.biSizeImage); + data = ckalloc(bmInfo->bmiHeader.biSizeImage); if (!data) { /* printf("Failed to allocate data area for XImage.\n"); */ ret_image = NULL; goto cleanup; } - ret_image = XCreateImage(display, NULL, depth, ZPixmap, 0, (char *)data, + ret_image = XCreateImage(display, NULL, depth, ZPixmap, 0, (char *) data, width, height, 32, (int) ((width + 31) >> 3) & ~1); if (ret_image == NULL) { - ckfree((char *)data); + ckfree(data); goto cleanup; } @@ -387,8 +386,8 @@ XGetImageZPixmap( if (GetDIBits(hdcMem, hbmp, 0, height, data, bmInfo, DIB_PAL_COLORS) == 0) { - ckfree((char *) ret_image->data); - ckfree((char *) ret_image); + ckfree(ret_image->data); + ckfree(ret_image); ret_image = NULL; goto cleanup; } @@ -404,16 +403,16 @@ XGetImageZPixmap( unsigned char *p; GetDIBits(hdcMem, hbmp, 0, height, NULL, bmInfo, DIB_PAL_COLORS); - data = (unsigned char *) ckalloc(bmInfo->bmiHeader.biSizeImage); + data = ckalloc(bmInfo->bmiHeader.biSizeImage); if (!data) { /* printf("Failed to allocate data area for XImage.\n"); */ ret_image = NULL; goto cleanup; } - ret_image = XCreateImage(display, NULL, 8, ZPixmap, 0, (char *)data, + ret_image = XCreateImage(display, NULL, 8, ZPixmap, 0, (char *) data, width, height, 8, (int) width); if (ret_image == NULL) { - ckfree((char *) data); + ckfree(data); goto cleanup; } @@ -423,8 +422,8 @@ XGetImageZPixmap( if (GetDIBits(hdcMem, hbmp, 0, height, data, bmInfo, DIB_PAL_COLORS) == 0) { - ckfree((char *) ret_image->data); - ckfree((char *) ret_image); + ckfree(ret_image->data); + ckfree(ret_image); ret_image = NULL; goto cleanup; } @@ -435,7 +434,7 @@ XGetImageZPixmap( } } else if (depth == 16) { GetDIBits(hdcMem, hbmp, 0, height, NULL, bmInfo, DIB_RGB_COLORS); - data = (unsigned char *) ckalloc(bmInfo->bmiHeader.biSizeImage); + data = ckalloc(bmInfo->bmiHeader.biSizeImage); if (!data) { /* printf("Failed to allocate data area for XImage.\n"); */ ret_image = NULL; @@ -444,7 +443,7 @@ XGetImageZPixmap( ret_image = XCreateImage(display, NULL, 16, ZPixmap, 0, (char *) data, width, height, 16, 0 /* will be calc'ed from bitmap_pad */); if (ret_image == NULL) { - ckfree((char *) data); + ckfree(data); goto cleanup; } @@ -454,14 +453,14 @@ XGetImageZPixmap( if (GetDIBits(hdcMem, hbmp, 0, height, ret_image->data, bmInfo, DIB_RGB_COLORS) == 0) { - ckfree((char *) ret_image->data); - ckfree((char *) ret_image); + ckfree(ret_image->data); + ckfree(ret_image); ret_image = NULL; goto cleanup; } } else { GetDIBits(hdcMem, hbmp, 0, height, NULL, bmInfo, DIB_RGB_COLORS); - data = (unsigned char *) ckalloc(width * height * 4); + data = ckalloc(width * height * 4); if (!data) { /* printf("Failed to allocate data area for XImage.\n"); */ ret_image = NULL; @@ -470,7 +469,7 @@ XGetImageZPixmap( ret_image = XCreateImage(display, NULL, 32, ZPixmap, 0, (char *) data, width, height, 0, (int) width * 4); if (ret_image == NULL) { - ckfree((char *) data); + ckfree(data); goto cleanup; } @@ -484,10 +483,10 @@ XGetImageZPixmap( unsigned int byte_width, h, w; byte_width = ((width * 3 + 3) & ~(unsigned)3); - smallBitBase = (unsigned char *) ckalloc(byte_width * height); + smallBitBase = ckalloc(byte_width * height); if (!smallBitBase) { - ckfree((char *) ret_image->data); - ckfree((char *) ret_image); + ckfree(ret_image->data); + ckfree(ret_image); ret_image = NULL; goto cleanup; } @@ -499,9 +498,9 @@ XGetImageZPixmap( if (GetDIBits(hdcMem, hbmp, 0, height, smallBitData, bmInfo, DIB_RGB_COLORS) == 0) { - ckfree((char *) ret_image->data); - ckfree((char *) ret_image); - ckfree((char *) smallBitBase); + ckfree(ret_image->data); + ckfree(ret_image); + ckfree(smallBitBase); ret_image = NULL; goto cleanup; } @@ -511,7 +510,7 @@ XGetImageZPixmap( */ for (h = 0; h < height; h++) { - bigBitData = (unsigned char *) (ret_image->data + h * ret_image->bytes_per_line); + bigBitData = (unsigned char *) ret_image->data + h * ret_image->bytes_per_line; smallBitData = smallBitBase + h * byte_width; for (w = 0; w < width; w++) { @@ -526,7 +525,7 @@ XGetImageZPixmap( * Free the Device contexts, and the Bitmap. */ - ckfree((char *) smallBitBase); + ckfree(smallBitBase); } else { /* * Get the BITMAP info directly into the Image. @@ -534,8 +533,8 @@ XGetImageZPixmap( if (GetDIBits(hdcMem, hbmp, 0, height, ret_image->data, bmInfo, DIB_RGB_COLORS) == 0) { - ckfree((char *) ret_image->data); - ckfree((char *) ret_image); + ckfree(ret_image->data); + ckfree(ret_image); ret_image = NULL; goto cleanup; } @@ -544,7 +543,7 @@ XGetImageZPixmap( cleanup: if (bmInfo) { - ckfree((char *) bmInfo); + ckfree(bmInfo); } if (hPal) { SelectPalette(hdcMem, hPalPrev1, FALSE); @@ -639,7 +638,7 @@ XGetImage( imagePtr = XGetImageZPixmap(display, d, x, y, width, height, plane_mask, format); } else { - char *errMsg = NULL; + const char *errMsg = NULL; char infoBuf[sizeof(BITMAPINFO) + sizeof(RGBQUAD)]; BITMAPINFO *infoPtr = (BITMAPINFO*)infoBuf; @@ -661,8 +660,7 @@ XGetImage( imagePtr = XCreateImage(display, NULL, 1, XYBitmap, 0, NULL, width, height, 32, 0); - imagePtr->data = - ckalloc((unsigned) imagePtr->bytes_per_line*imagePtr->height); + imagePtr->data = ckalloc(imagePtr->bytes_per_line * imagePtr->height); dc = GetDC(NULL); diff --git a/win/tkWinInit.c b/win/tkWinInit.c index 31304d3..b1b2d6b 100644 --- a/win/tkWinInit.c +++ b/win/tkWinInit.c @@ -68,9 +68,9 @@ TkpGetAppName( Tcl_DString *namePtr) /* A previously initialized Tcl_DString. */ { int argc, namelength; - CONST char **argv = NULL, *name, *p; + const char **argv = NULL, *name, *p; - name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); + name = Tcl_GetVar2(interp, "argv0", NULL, TCL_GLOBAL_ONLY); namelength = -1; if (name != NULL) { Tcl_SplitPath(name, &argc, &argv); @@ -90,7 +90,7 @@ TkpGetAppName( } Tcl_DStringAppend(namePtr, name, namelength); if (argv != NULL) { - ckfree((char *)argv); + ckfree(argv); } } @@ -113,12 +113,13 @@ TkpGetAppName( void TkpDisplayWarning( - CONST char *msg, /* Message to be displayed. */ - CONST char *title) /* Title of warning. */ + const char *msg, /* Message to be displayed. */ + const char *title) /* Title of warning. */ { #define TK_MAX_WARN_LEN 1024 - WCHAR msgString[TK_MAX_WARN_LEN + 5]; - WCHAR titleString[TK_MAX_WARN_LEN + 1]; + WCHAR titleString[TK_MAX_WARN_LEN]; + WCHAR *msgString; /* points to titleString, just after title, leaving space for ": " */ + int len; /* size of title, including terminating NULL */ /* If running on Cygwin and we have a stderr channel, use it. */ #if !defined(STATIC_BUILD) @@ -134,20 +135,81 @@ TkpDisplayWarning( } #endif /* !STATIC_BUILD */ - MultiByteToWideChar(CP_UTF8, 0, msg, -1, msgString, TK_MAX_WARN_LEN); - MultiByteToWideChar(CP_UTF8, 0, title, -1, titleString, TK_MAX_WARN_LEN); + len = MultiByteToWideChar(CP_UTF8, 0, title, -1, titleString, TK_MAX_WARN_LEN); + msgString = &titleString[len + 1]; + titleString[TK_MAX_WARN_LEN - 1] = L'\0'; + MultiByteToWideChar(CP_UTF8, 0, msg, -1, msgString, (TK_MAX_WARN_LEN - 1) - len); /* * Truncate MessageBox string if it is too long to not overflow the screen * and cause possible oversized window error. */ - memcpy(msgString + TK_MAX_WARN_LEN, L" ...", 5 * sizeof(WCHAR)); - titleString[TK_MAX_WARN_LEN] = L'\0'; - MessageBoxW(NULL, msgString, titleString, - MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL - | MB_SETFOREGROUND | MB_TOPMOST); + if (titleString[TK_MAX_WARN_LEN - 1] != L'\0') { + memcpy(titleString + (TK_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); + } + if (IsDebuggerPresent()) { + titleString[len - 1] = L':'; + titleString[len] = L' '; + OutputDebugStringW(titleString); + } else { + titleString[len - 1] = L'\0'; + MessageBoxW(NULL, msgString, titleString, + MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL + | MB_SETFOREGROUND | MB_TOPMOST); + } } /* + * ---------------------------------------------------------------------- + * + * Win32ErrorObj -- + * + * Returns a string object containing text from a COM or Win32 error code + * + * Results: + * A Tcl_Obj containing the Win32 error message. + * + * Side effects: + * Removed the error message from the COM threads error object. + * + * ---------------------------------------------------------------------- + */ + +Tcl_Obj* +TkWin32ErrorObj( + HRESULT hrError) +{ + LPTSTR lpBuffer = NULL, p = NULL; + TCHAR sBuffer[30]; + Tcl_Obj* errPtr = NULL; + + FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError, + LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL); + + if (lpBuffer == NULL) { + lpBuffer = sBuffer; + wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError); + } + + if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) { + *p = TEXT('\0'); + } + +#ifdef _UNICODE + errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); +#else + errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); +#endif /* _UNICODE */ + + if (lpBuffer != sBuffer) { + LocalFree((HLOCAL)lpBuffer); + } + + return errPtr; +} + + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/win/tkWinInt.h b/win/tkWinInt.h index abac7b0..0e2c844 100644 --- a/win/tkWinInt.h +++ b/win/tkWinInt.h @@ -26,10 +26,6 @@ #include "tkWin.h" #endif -#ifndef _TKPORT -#include "tkPort.h" -#endif - /* * Define constants missing from older Win32 SDK header files. */ @@ -121,8 +117,8 @@ typedef struct { * The following macros define the class names for Tk Window types. */ -#define TK_WIN_TOPLEVEL_CLASS_NAME "TkTopLevel" -#define TK_WIN_CHILD_CLASS_NAME "TkChild" +#define TK_WIN_TOPLEVEL_CLASS_NAME TEXT("TkTopLevel") +#define TK_WIN_CHILD_CLASS_NAME TEXT("TkChild") /* * The following variable is a translation table between X gc functions and @@ -146,70 +142,33 @@ MODULE_SCOPE const int tkpWinBltModes[]; #include "tkIntPlatDecls.h" -#ifdef BUILD_tk -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT -#endif - /* * Special proc needed as tsd accessor function between * tkWinX.c:GenerateXEvent and tkWinClipboard.c:UpdateClipboard */ -EXTERN void TkWinUpdatingClipboard(int mode); +MODULE_SCOPE void TkWinUpdatingClipboard(int mode); /* * Used by tkWinDialog.c to associate the right icon with tk_messageBox */ -EXTERN HICON TkWinGetIcon(Tk_Window tkw, DWORD iconsize); +MODULE_SCOPE HICON TkWinGetIcon(Tk_Window tkw, DWORD iconsize); /* * Used by tkWinX.c on for certain system display change messages and cleanup * up containers */ -EXTERN void TkWinDisplayChanged(Display *display); +MODULE_SCOPE void TkWinDisplayChanged(Display *display); MODULE_SCOPE void TkWinCleanupContainerList(void); /* * Used by tkWinWm.c for embedded menu handling. May become public. */ -EXTERN HWND Tk_GetMenuHWND(Tk_Window tkwin); -EXTERN HWND Tk_GetEmbeddedMenuHWND(Tk_Window tkwin); - -/* - * The following structure keeps track of whether we are using the multi-byte - * or the wide-character interfaces to the operating system. System calls - * should be made through the following function table. - * - * While some system calls need to use this A/W jump-table, it is not - * necessary for all calls to do it, which is why you won't see this used - * throughout the Tk code, but only in key areas. -- hobbs - */ - -typedef struct TkWinProcs { - int useWide; - LRESULT (WINAPI *callWindowProc)(WNDPROC lpPrevWndFunc, HWND hWnd, - UINT Msg, WPARAM wParam, LPARAM lParam); - LRESULT (WINAPI *defWindowProc)(HWND hWnd, UINT Msg, WPARAM wParam, - LPARAM lParam); - ATOM (WINAPI *registerClass)(const WNDCLASS *lpWndClass); - BOOL (WINAPI *setWindowText)(HWND hWnd, LPCTSTR lpString); - HWND (WINAPI *createWindowEx)(DWORD dwExStyle, LPCTSTR lpClassName, - LPCTSTR lpWindowName, DWORD dwStyle, int x, int y, - int nWidth, int nHeight, HWND hWndParent, HMENU hMenu, - HINSTANCE hInstance, LPVOID lpParam); - BOOL (WINAPI *insertMenu)(HMENU hMenu, UINT uPosition, UINT uFlags, - UINT uIDNewItem, LPCTSTR lpNewItem); - int (WINAPI *getWindowText)(HWND hWnd, LPCTSTR lpString, int nMaxCount); -} TkWinProcs; - -EXTERN TkWinProcs *tkWinProcs; - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT +MODULE_SCOPE HWND Tk_GetMenuHWND(Tk_Window tkwin); +MODULE_SCOPE HWND Tk_GetEmbeddedMenuHWND(Tk_Window tkwin); /* * The following allows us to cache these encoding for multiple functions. @@ -231,20 +190,26 @@ MODULE_SCOPE void TkWinSetupSystemFonts(TkMainInfo *mainPtr); * The following is implemented in tkWinWm and used by tkWinEmbed.c */ -void TkpWinToplevelWithDraw(TkWindow *winPtr); -void TkpWinToplevelIconify(TkWindow *winPtr); -void TkpWinToplevelDeiconify(TkWindow *winPtr); -long TkpWinToplevelIsControlledByWm(TkWindow *winPtr); -long TkpWinToplevelMove(TkWindow *winPtr, int x, int y); -long TkpWinToplevelOverrideRedirect(TkWindow *winPtr, +MODULE_SCOPE void TkpWinToplevelWithDraw(TkWindow *winPtr); +MODULE_SCOPE void TkpWinToplevelIconify(TkWindow *winPtr); +MODULE_SCOPE void TkpWinToplevelDeiconify(TkWindow *winPtr); +MODULE_SCOPE long TkpWinToplevelIsControlledByWm(TkWindow *winPtr); +MODULE_SCOPE long TkpWinToplevelMove(TkWindow *winPtr, int x, int y); +MODULE_SCOPE long TkpWinToplevelOverrideRedirect(TkWindow *winPtr, int reqValue); -void TkpWinToplevelDetachWindow(TkWindow *winPtr); -int TkpWmGetState(TkWindow *winPtr); +MODULE_SCOPE void TkpWinToplevelDetachWindow(TkWindow *winPtr); +MODULE_SCOPE int TkpWmGetState(TkWindow *winPtr); + +/* + * Common routines used in Windows implementation + */ +MODULE_SCOPE Tcl_Obj * TkWin32ErrorObj(HRESULT hrError); + /* * The following functions are not present in old versions of Windows - * API headers but are used in the Tk source to ensure 64bit - * compatability. + * API headers but are used in the Tk source to ensure 64bit + * compatibility. */ #ifndef GetClassLongPtr diff --git a/win/tkWinKey.c b/win/tkWinKey.c index daf2ecc..ed546f7 100644 --- a/win/tkWinKey.c +++ b/win/tkWinKey.c @@ -23,7 +23,7 @@ #define MAX_KEYCODE 145 /* VK_SCROLL is the last entry in our table below */ -static KeySym keymap[] = { +static const KeySym keymap[] = { NoSymbol, NoSymbol, NoSymbol, XK_Cancel, NoSymbol, NoSymbol, NoSymbol, NoSymbol, XK_BackSpace, XK_Tab, NoSymbol, NoSymbol, XK_Clear, XK_Return, NoSymbol, @@ -79,7 +79,7 @@ static KeySym KeycodeToKeysym(unsigned int keycode, *---------------------------------------------------------------------- */ -char * +const char * TkpGetString( TkWindow *winPtr, /* Window where event occurred: needed to get * input context. */ @@ -502,12 +502,11 @@ TkpInitKeymapInfo( */ if (dispPtr->modKeyCodes != NULL) { - ckfree((char *) dispPtr->modKeyCodes); + ckfree(dispPtr->modKeyCodes); } dispPtr->numModKeyCodes = 0; arraySize = KEYCODE_ARRAY_SIZE; - dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned) - (KEYCODE_ARRAY_SIZE * sizeof(KeyCode))); + dispPtr->modKeyCodes = ckalloc(KEYCODE_ARRAY_SIZE * sizeof(KeyCode)); for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) { if (*codePtr == 0) { continue; @@ -530,11 +529,10 @@ TkpInitKeymapInfo( */ arraySize *= 2; - new = (KeyCode *) ckalloc((unsigned) - (arraySize * sizeof(KeyCode))); - memcpy((void *) new, (void *) dispPtr->modKeyCodes, - (dispPtr->numModKeyCodes * sizeof(KeyCode))); - ckfree((char *) dispPtr->modKeyCodes); + new = ckalloc(arraySize * sizeof(KeyCode)); + memcpy(new, dispPtr->modKeyCodes, + dispPtr->numModKeyCodes * sizeof(KeyCode)); + ckfree(dispPtr->modKeyCodes); dispPtr->modKeyCodes = new; } dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr; @@ -660,11 +658,10 @@ XModifierKeymap * XGetModifierMapping( Display *display) { - XModifierKeymap *map = (XModifierKeymap *) - ckalloc(sizeof(XModifierKeymap)); + XModifierKeymap *map = ckalloc(sizeof(XModifierKeymap)); map->max_keypermod = 1; - map->modifiermap = (KeyCode *) ckalloc(sizeof(KeyCode)*8); + map->modifiermap = ckalloc(sizeof(KeyCode) * 8); map->modifiermap[ShiftMapIndex] = VK_SHIFT; map->modifiermap[LockMapIndex] = VK_CAPITAL; map->modifiermap[ControlMapIndex] = VK_CONTROL; @@ -696,8 +693,8 @@ int XFreeModifiermap( XModifierKeymap *modmap) { - ckfree((char *) modmap->modifiermap); - ckfree((char *) modmap); + ckfree(modmap->modifiermap); + ckfree(modmap); return Success; } diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c index 48bc16b..4593928 100644 --- a/win/tkWinMenu.c +++ b/win/tkWinMenu.c @@ -11,20 +11,16 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#define WINVER 0x0500 /* Requires Windows 2K definitions */ -#define _WIN32_WINNT 0x0500 #define OEMRESOURCE #include "tkWinInt.h" #include "tkMenu.h" -#include <string.h> - /* * The class of the window for popup menus. */ -#define MENU_CLASS_NAME "MenuWindowClass" -#define EMBEDDED_MENU_CLASS_NAME "EmbeddedMenuWindowClass" +#define MENU_CLASS_NAME TEXT("MenuWindowClass") +#define EMBEDDED_MENU_CLASS_NAME TEXT("EmbeddedMenuWindowClass") /* * Used to align a windows bitmap inside a rectangle @@ -159,7 +155,7 @@ static void DrawWindowsSystemBitmap(Display *display, Drawable drawable, GC gc, const RECT *rectPtr, int bitmapID, int alignFlags); static void FreeID(WORD commandID); -static TCHAR * GetEntryText(TkMenuEntry *mePtr); +static char * GetEntryText(TkMenuEntry *mePtr); static void GetMenuAccelGeometry(TkMenu *menuPtr, TkMenuEntry *mePtr, Tk_Font tkfont, const Tk_FontMetrics *fmPtr, int *widthPtr, @@ -192,6 +188,26 @@ static LRESULT CALLBACK TkWinMenuProc(HWND hwnd, UINT message, WPARAM wParam, static LRESULT CALLBACK TkWinEmbeddedMenuProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); +static inline void +ScheduleMenuReconfigure( + TkMenu *menuPtr) +{ + if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { + menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; + Tcl_DoWhenIdle(ReconfigureWindowsMenu, menuPtr); + } +} + +static inline void +CallPendingReconfigureImmediately( + TkMenu *menuPtr) +{ + if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { + Tcl_CancelIdleCall(ReconfigureWindowsMenu, menuPtr); + ReconfigureWindowsMenu(menuPtr); + } +} + /* *---------------------------------------------------------------------- * @@ -217,7 +233,7 @@ GetNewID( TkMenuEntry *mePtr, /* The menu we are working with. */ WORD *menuIDPtr) /* The resulting id. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); WORD curID = tsdPtr->lastCommandID; @@ -241,7 +257,7 @@ GetNewID( commandEntryPtr = Tcl_CreateHashEntry(&tsdPtr->commandTable, INT2PTR(curID), &new); if (new) { - Tcl_SetHashValue(commandEntryPtr, (char *) mePtr); + Tcl_SetHashValue(commandEntryPtr, mePtr); *menuIDPtr = curID; tsdPtr->lastCommandID = curID; return TCL_OK; @@ -269,7 +285,7 @@ static void FreeID( WORD commandID) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -278,7 +294,8 @@ FreeID( if (tsdPtr->menuHWND != NULL) { Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, - ((char *) NULL) + commandID); + INT2PTR(commandID)); + if (entryPtr != NULL) { Tcl_DeleteHashEntry(entryPtr); } @@ -311,14 +328,14 @@ TkpNewMenu( HMENU winMenuHdl; Tcl_HashEntry *hashEntryPtr; int newEntry; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); winMenuHdl = CreatePopupMenu(); - if (winMenuHdl == NULL) { - Tcl_AppendResult(menuPtr->interp, "No more menus can be allocated.", - (char *) NULL); + Tcl_SetObjResult(menuPtr->interp, Tcl_NewStringObj( + "No more menus can be allocated.", -1)); + Tcl_SetErrorCode(menuPtr->interp, "TK", "MENU", "SYSTEM_RESOURCES", NULL); return TCL_ERROR; } @@ -329,7 +346,7 @@ TkpNewMenu( hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl, &newEntry); - Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr); + Tcl_SetHashValue(hashEntryPtr, menuPtr); menuPtr->platformData = (TkMenuPlatformData) winMenuHdl; return TCL_OK; @@ -356,12 +373,12 @@ TkpDestroyMenu( TkMenu *menuPtr) /* The common menu structure */ { HMENU winMenuHdl = (HMENU) menuPtr->platformData; - char *searchName; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + const char *searchName; + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { - Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr); + Tcl_CancelIdleCall(ReconfigureWindowsMenu, menuPtr); } if (winMenuHdl == NULL) { @@ -404,6 +421,7 @@ TkpDestroyMenu( if (tsdPtr->menuHWND != NULL) { Tcl_HashEntry *hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl); + if (hashEntryPtr != NULL) { Tcl_DeleteHashEntry(hashEntryPtr); } @@ -441,10 +459,7 @@ TkpDestroyMenuEntry( HMENU winMenuHdl = (HMENU) menuPtr->platformData; if (NULL != winMenuHdl) { - if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr); - } + ScheduleMenuReconfigure(menuPtr); } FreeID((WORD) PTR2INT(mePtr->platformEntryData)); mePtr->platformEntryData = NULL; @@ -489,9 +504,9 @@ GetEntryText( strcpy(itemText, "( )"); } else { int i; - char *label = (mePtr->labelPtr == NULL) ? "" + const char *label = (mePtr->labelPtr == NULL) ? "" : Tcl_GetString(mePtr->labelPtr); - char *accel = (mePtr->accelPtr == NULL) ? "" + const char *accel = (mePtr->accelPtr == NULL) ? "" : Tcl_GetString(mePtr->accelPtr); const char *p, *next; Tcl_DString itemString; @@ -525,7 +540,7 @@ GetEntryText( } } - itemText = ckalloc((unsigned)Tcl_DStringLength(&itemString) + 1); + itemText = ckalloc(Tcl_DStringLength(&itemString) + 1); strcpy(itemText, Tcl_DStringValue(&itemString)); Tcl_DStringFree(&itemString); } @@ -553,10 +568,10 @@ static void ReconfigureWindowsMenu( ClientData clientData) /* The menu we are rebuilding */ { - TkMenu *menuPtr = (TkMenu *) clientData; + TkMenu *menuPtr = clientData; TkMenuEntry *mePtr; HMENU winMenuHdl = (HMENU) menuPtr->platformData; - TCHAR *itemText = NULL; + char *itemText = NULL; const TCHAR *lpNewItem; UINT flags; UINT itemID; @@ -594,7 +609,7 @@ ReconfigureWindowsMenu( if ((menuPtr->menuType == MENUBAR) || (menuPtr->menuFlags & MENU_SYSTEM_MENU)) { Tcl_WinUtfToTChar(itemText, -1, &translatedText); - lpNewItem = Tcl_DStringValue(&translatedText); + lpNewItem = (const TCHAR *) Tcl_DStringValue(&translatedText); flags |= MF_STRING; } else { lpNewItem = (LPCTSTR) mePtr; @@ -680,23 +695,17 @@ ReconfigureWindowsMenu( && (menuPtr->parentTopLevelPtr != NULL) && (systemMenuPtr->masterMenuPtr == menuRefPtr->menuPtr)) { - HMENU systemMenuHdl = - (HMENU) systemMenuPtr->platformData; + HMENU systemMenuHdl = (HMENU) systemMenuPtr->platformData; HWND wrapper = TkWinGetWrapperWindow(menuPtr ->parentTopLevelPtr); + if (wrapper != NULL) { DestroyMenu(systemMenuHdl); systemMenuHdl = GetSystemMenu(wrapper, FALSE); systemMenuPtr->menuFlags |= MENU_SYSTEM_MENU; systemMenuPtr->platformData = (TkMenuPlatformData) systemMenuHdl; - if (!(systemMenuPtr->menuFlags - & MENU_RECONFIGURE_PENDING)) { - systemMenuPtr->menuFlags - |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, - (ClientData) systemMenuPtr); - } + ScheduleMenuReconfigure(systemMenuPtr); } } } @@ -706,8 +715,7 @@ ReconfigureWindowsMenu( } } if (!systemMenu) { - (*tkWinProcs->insertMenu)(winMenuHdl, 0xFFFFFFFF, flags, - itemID, lpNewItem); + InsertMenu(winMenuHdl, 0xFFFFFFFF, flags, itemID, lpNewItem); } Tcl_DStringFree(&translatedText); if (itemText != NULL) { @@ -719,8 +727,8 @@ ReconfigureWindowsMenu( if ((menuPtr->menuType == MENUBAR) && (menuPtr->parentTopLevelPtr != NULL)) { - HANDLE bar; - bar = TkWinGetWrapperWindow(menuPtr->parentTopLevelPtr); + HANDLE bar = TkWinGetWrapperWindow(menuPtr->parentTopLevelPtr); + if (bar) { DrawMenuBar(bar); } @@ -757,15 +765,12 @@ TkpPostMenu( POINT point; Tk_Window parentWindow = Tk_Parent(menuPtr->tkwin); int oldServiceMode = Tcl_GetServiceMode(); - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->inPostMenu++; - if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { - Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr); - ReconfigureWindowsMenu((ClientData) menuPtr); - } + CallPendingReconfigureImmediately(menuPtr); result = TkPreprocessMenu(menuPtr); if (result != TCL_OK) { @@ -860,12 +865,7 @@ TkpMenuNewEntry( if (GetNewID(mePtr, &commandID) != TCL_OK) { return TCL_ERROR; } - - if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr); - } - + ScheduleMenuReconfigure(menuPtr); mePtr->platformEntryData = (TkMenuPlatformEntryData) INT2PTR(commandID); return TCL_OK; @@ -899,7 +899,7 @@ TkWinMenuProc( LRESULT lResult; if (!TkWinHandleMenuEvent(&hwnd, &message, &wParam, &lParam, &lResult)) { - lResult = DefWindowProc(hwnd, message, wParam, lParam); + lResult = DefWindowProcA(hwnd, message, wParam, lParam); } return lResult; } @@ -928,11 +928,12 @@ UpdateEmbeddedMenu( { RECT rc; HWND hMenuWnd = (HWND)clientData; + GetClientRect(hMenuWnd, &rc); InvalidateRect(hMenuWnd, &rc, FALSE); UpdateWindow(hMenuWnd); } - + /* *---------------------------------------------------------------------- * @@ -959,7 +960,7 @@ TkWinEmbeddedMenuProc( { static int nIdles = 0; LRESULT lResult = 1; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); switch(message) { @@ -997,12 +998,12 @@ TkWinEmbeddedMenuProc( } default: - lResult = DefWindowProc(hwnd, message, wParam, lParam); + lResult = DefWindowProcA(hwnd, message, wParam, lParam); break; } return lResult; } - + /* *---------------------------------------------------------------------- * @@ -1035,7 +1036,7 @@ TkWinHandleMenuEvent( int returnResult = 0; TkMenu *menuPtr; TkMenuEntry *mePtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); switch (*pMessage) { @@ -1043,7 +1044,7 @@ TkWinHandleMenuEvent( hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, (char *) *pwParam); if (hashEntryPtr != NULL) { - menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); + menuPtr = Tcl_GetHashValue(hashEntryPtr); if ((menuPtr->menuRefPtr != NULL) && (menuPtr->menuRefPtr->parentEntryPtr != NULL)) { TkPostSubmenu(menuPtr->interp, @@ -1058,27 +1059,22 @@ TkWinHandleMenuEvent( (char *) *pwParam); if (hashEntryPtr != NULL) { tsdPtr->oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); - menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); + menuPtr = Tcl_GetHashValue(hashEntryPtr); tsdPtr->modalMenuPtr = menuPtr; - if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) { - Tcl_CancelIdleCall(ReconfigureWindowsMenu, - (ClientData) menuPtr); - ReconfigureWindowsMenu((ClientData) menuPtr); - } + CallPendingReconfigureImmediately(menuPtr); RecursivelyClearActiveMenu(menuPtr); if (!tsdPtr->inPostMenu) { - Tcl_Interp *interp; + Tcl_Interp *interp = menuPtr->interp; int code; - interp = menuPtr->interp; - Tcl_Preserve((ClientData)interp); + Tcl_Preserve(interp); code = TkPreprocessMenu(menuPtr); if ((code != TCL_OK) && (code != TCL_CONTINUE) && (code != TCL_BREAK)) { Tcl_AddErrorInfo(interp, "\n (menu preprocess)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); } - Tcl_Release((ClientData)interp); + Tcl_Release(interp); } TkActivateMenuEntry(menuPtr, -1); *plResult = 0; @@ -1095,11 +1091,11 @@ TkWinHandleMenuEvent( break; } hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, - ((char *) NULL) + LOWORD(*pwParam)); + INT2PTR(LOWORD(*pwParam))); if (hashEntryPtr == NULL) { break; } - mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr); + mePtr = Tcl_GetHashValue(hashEntryPtr); if (mePtr != NULL) { TkMenuReferences *menuRefPtr; TkMenuEntry *parentEntryPtr; @@ -1117,7 +1113,7 @@ TkWinHandleMenuEvent( if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr != NULL)) { for (parentEntryPtr = menuRefPtr->parentEntryPtr ; ; parentEntryPtr = parentEntryPtr->nextCascadePtr) { - char *name = Tcl_GetString(parentEntryPtr->namePtr); + const char *name = Tcl_GetString(parentEntryPtr->namePtr); if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) { break; @@ -1131,13 +1127,13 @@ TkWinHandleMenuEvent( } interp = menuPtr->interp; - Tcl_Preserve((ClientData)interp); + Tcl_Preserve(interp); code = TkInvokeMenu(interp, menuPtr, mePtr->index); if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) { Tcl_AddErrorInfo(interp, "\n (menu invoke)"); - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, code); } - Tcl_Release((ClientData)interp); + Tcl_Release(interp); *plResult = 0; returnResult = 1; } @@ -1152,7 +1148,7 @@ TkWinHandleMenuEvent( Tcl_UniChar *wlabel, menuChar; *plResult = 0; - menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); + menuPtr = Tcl_GetHashValue(hashEntryPtr); /* * Assume we have something directly convertable to Tcl_UniChar. * True at least for wide systems. @@ -1218,7 +1214,7 @@ TkWinHandleMenuEvent( } mePtr = (TkMenuEntry *) itemPtr->itemData; menuPtr = mePtr->menuPtr; - twdPtr = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable)); + twdPtr = ckalloc(sizeof(TkWinDrawable)); twdPtr->type = TWD_WINDC; twdPtr->winDC.hdc = itemPtr->hDC; @@ -1261,7 +1257,7 @@ TkWinHandleMenuEvent( itemPtr->rcItem.bottom - itemPtr->rcItem.top, 0, drawingParameters); - ckfree((char *) twdPtr); + ckfree(twdPtr); } *plResult = 1; returnResult = 1; @@ -1284,7 +1280,7 @@ TkWinHandleMenuEvent( hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, (char *) *plParam); if (hashEntryPtr != NULL) { - menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr); + menuPtr = Tcl_GetHashValue(hashEntryPtr); } } @@ -1297,10 +1293,9 @@ TkWinHandleMenuEvent( mePtr = menuPtr->entries[entryIndex]; } else { hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable, - ((char *) NULL) + entryIndex); + INT2PTR(entryIndex)); if (hashEntryPtr != NULL) { - mePtr = (TkMenuEntry *) - Tcl_GetHashValue(hashEntryPtr); + mePtr = Tcl_GetHashValue(hashEntryPtr); } } } @@ -1309,7 +1304,7 @@ TkWinHandleMenuEvent( TkActivateMenuEntry(menuPtr, -1); } else { if (mePtr->index >= menuPtr->numEntries) { - Tcl_Panic("Trying to activate an entry which doesn't exist."); + Tcl_Panic("Trying to activate an entry which doesn't exist"); } TkActivateMenuEntry(menuPtr, mePtr->index); } @@ -1389,7 +1384,7 @@ TkpSetWindowMenuBar( TkMenu *menuPtr) /* The menu we are inserting */ { HMENU winMenuHdl; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (menuPtr != NULL) { @@ -1404,13 +1399,10 @@ TkpSetWindowMenuBar( winMenuHdl = CreateMenu(); hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl, &newEntry); - Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr); + Tcl_SetHashValue(hashEntryPtr, menuPtr); menuPtr->platformData = (TkMenuPlatformData) winMenuHdl; TkWinSetMenu(tkwin, winMenuHdl); - if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr); - } + ScheduleMenuReconfigure(menuPtr); } else { TkWinSetMenu(tkwin, NULL); } @@ -1437,7 +1429,7 @@ void TkpSetMainMenubar( Tcl_Interp *interp, /* The interpreter of the application */ Tk_Window tkwin, /* The frame we are setting up */ - char *menuName) /* The name of the menu to put in front. If + const char *menuName) /* The name of the menu to put in front. If * NULL, use the default menu bar. */ { /* @@ -1513,7 +1505,7 @@ GetMenuAccelGeometry( } else if (mePtr->accelPtr == NULL) { *widthPtr = 0; } else { - char *accel = Tcl_GetString(mePtr->accelPtr); + const char *accel = Tcl_GetString(mePtr->accelPtr); *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength); } @@ -1628,7 +1620,7 @@ DrawWindowsSystemBitmap( SelectObject(scratchDC, bitmap); SetMapMode(scratchDC, GetMapMode(hdc)); - GetObject(bitmap, sizeof(BITMAP), &bm); + GetObjectA(bitmap, sizeof(BITMAP), &bm); ptSize.x = bm.bmWidth; ptSize.y = bm.bmHeight; DPtoLP(scratchDC, &ptSize, 1); @@ -1769,7 +1761,7 @@ DrawMenuEntryAccelerator( { int baseline; int leftEdge = x + mePtr->indicatorSpace + mePtr->labelWidth; - char *accel; + const char *accel; if (mePtr->accelPtr != NULL) { accel = Tcl_GetString(mePtr->accelPtr); @@ -1789,7 +1781,7 @@ DrawMenuEntryAccelerator( COLORREF oldFgColor = gc->foreground; gc->foreground = GetSysColor(COLOR_3DHILIGHT); - if ((mePtr->entryFlags & ENTRY_PLATFORM_FLAG1) == 0) { + if (!(mePtr->entryFlags & ENTRY_PLATFORM_FLAG1)) { Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel, mePtr->accelLength, leftEdge + 1, baseline + 1); } @@ -1856,6 +1848,7 @@ DrawMenuEntryArrow( mePtr->menuPtr->tkwin, (mePtr->activeBorderPtr == NULL) ? mePtr->menuPtr->activeBorderPtr : mePtr->activeBorderPtr)); + gc->background = activeBgColor->pixel; } @@ -1955,7 +1948,7 @@ DrawMenuUnderline( if (mePtr->underline < len) { const char *label, *start, *end; - label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL); + label = Tcl_GetString(mePtr->labelPtr); start = Tcl_UtfAtIndex(label, mePtr->underline); end = Tcl_UtfNext(start); Tk_UnderlineChars(menuPtr->display, d, @@ -2028,33 +2021,33 @@ TkWinMenuKeyObjCmd( if (eventPtr->type == KeyPress) { switch (keySym) { case XK_Alt_L: - scanCode = MapVirtualKey(VK_LMENU, 0); - CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), + scanCode = MapVirtualKeyA(VK_LMENU, 0); + CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSKEYDOWN, VK_MENU, (int) (scanCode << 16) | (1 << 29)); break; case XK_Alt_R: - scanCode = MapVirtualKey(VK_RMENU, 0); - CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), + scanCode = MapVirtualKeyA(VK_RMENU, 0); + CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSKEYDOWN, VK_MENU, (int) (scanCode << 16) | (1 << 29) | (1 << 24)); break; case XK_F10: - scanCode = MapVirtualKey(VK_F10, 0); - CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), + scanCode = MapVirtualKeyA(VK_F10, 0); + CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSKEYDOWN, VK_F10, (int) (scanCode << 16)); break; default: virtualKey = XKeysymToKeycode(winPtr->display, keySym); - scanCode = MapVirtualKey(virtualKey, 0); + scanCode = MapVirtualKeyA(virtualKey, 0); if (0 != scanCode) { XKeyEvent xkey = eventPtr->xkey; - CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), + CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSKEYDOWN, virtualKey, (int) ((scanCode << 16) | (1 << 29))); if (xkey.nbytes > 0) { for (i = 0; i < xkey.nbytes; i++) { - CallWindowProc(DefWindowProc, + CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSCHAR, xkey.trans_chars[i], (int) ((scanCode << 16) | (1 << 29))); @@ -2065,28 +2058,28 @@ TkWinMenuKeyObjCmd( } else if (eventPtr->type == KeyRelease) { switch (keySym) { case XK_Alt_L: - scanCode = MapVirtualKey(VK_LMENU, 0); - CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), + scanCode = MapVirtualKeyA(VK_LMENU, 0); + CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSKEYUP, VK_MENU, (int) (scanCode << 16) | (1 << 29) | (1 << 30) | (1 << 31)); break; case XK_Alt_R: - scanCode = MapVirtualKey(VK_RMENU, 0); - CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), + scanCode = MapVirtualKeyA(VK_RMENU, 0); + CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSKEYUP, VK_MENU, (int) (scanCode << 16) | (1 << 24) | (0x111 << 29) | (1 << 30) | (1 << 31)); break; case XK_F10: - scanCode = MapVirtualKey(VK_F10, 0); - CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), + scanCode = MapVirtualKeyA(VK_F10, 0); + CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSKEYUP, VK_F10, (int) (scanCode << 16) | (1 << 30) | (1 << 31)); break; default: virtualKey = XKeysymToKeycode(winPtr->display, keySym); - scanCode = MapVirtualKey(virtualKey, 0); + scanCode = MapVirtualKeyA(virtualKey, 0); if (0 != scanCode) { - CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)), + CallWindowProcA(DefWindowProcA, Tk_GetHWND(Tk_WindowId(tkwin)), WM_SYSKEYUP, virtualKey, (int) ((scanCode << 16) | (1 << 29) | (1 << 30) | (1 << 31))); } @@ -2212,12 +2205,13 @@ DrawMenuEntryLabel( haveImage = 1; } else if (mePtr->bitmapPtr != NULL) { Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, &imageWidth, &imageHeight); haveImage = 1; } if (!haveImage || (mePtr->compound != COMPOUND_NONE)) { if (mePtr->labelLength > 0) { - char *label = Tcl_GetString(mePtr->labelPtr); + const char *label = Tcl_GetString(mePtr->labelPtr); textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength); textHeight = fmPtr->linespace; @@ -2312,7 +2306,7 @@ DrawMenuEntryLabel( if ((mePtr->compound != COMPOUND_NONE) || !haveImage) { if (mePtr->labelLength > 0) { int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2; - char *label = Tcl_GetString(mePtr->labelPtr); + const char *label = Tcl_GetString(mePtr->labelPtr); if (TkWinGetPlatformTheme() == TK_THEME_WIN_CLASSIC) { /* @@ -2321,8 +2315,9 @@ DrawMenuEntryLabel( */ if ((mePtr->state == ENTRY_DISABLED) && - ((mePtr->entryFlags & ENTRY_PLATFORM_FLAG1) == 0)) { + !(mePtr->entryFlags & ENTRY_PLATFORM_FLAG1)) { COLORREF oldFgColor = gc->foreground; + gc->foreground = GetSysColor(COLOR_3DHILIGHT); Tk_DrawChars(menuPtr->display, d, gc, tkfont, label, mePtr->labelLength, leftEdge + textXOffset + 1, @@ -2455,12 +2450,7 @@ TkpConfigureMenuEntry( register TkMenuEntry *mePtr)/* Information about menu entry; may or may * not already have values for some fields. */ { - TkMenu *menuPtr = mePtr->menuPtr; - - if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr); - } + ScheduleMenuReconfigure(mePtr->menuPtr); return TCL_OK; } @@ -2548,7 +2538,7 @@ TkpDrawMenuEntry( } else { TkMenuEntry *cascadeEntryPtr; int parentDisabled = 0; - char *name; + const char *name; for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr; cascadeEntryPtr != NULL; @@ -2676,6 +2666,7 @@ GetMenuLabelGeometry( haveImage = 1; } else if (mePtr->bitmapPtr != NULL) { Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr); + Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr); haveImage = 1; } else { @@ -2694,7 +2685,7 @@ GetMenuLabelGeometry( if (mePtr->labelPtr != NULL) { int textWidth; - char *label = Tcl_GetString(mePtr->labelPtr); + const char *label = Tcl_GetString(mePtr->labelPtr); textWidth = Tk_TextWidth(tkfont, label, mePtr->labelLength); @@ -3024,7 +3015,7 @@ MenuSelectEvent( void TkpMenuNotifyToplevelCreate( Tcl_Interp *interp, /* The interp the menu lives in. */ - char *menuName) /* The name of the menu to reconfigure. */ + const char *menuName) /* The name of the menu to reconfigure. */ { TkMenuReferences *menuRefPtr; TkMenu *menuPtr; @@ -3034,11 +3025,8 @@ TkpMenuNotifyToplevelCreate( if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) { for (menuPtr = menuRefPtr->menuPtr->masterMenuPtr; menuPtr != NULL; menuPtr = menuPtr->nextInstancePtr) { - if ((menuPtr->menuType == MENUBAR) - && !(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) { - menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING; - Tcl_DoWhenIdle(ReconfigureWindowsMenu, - (ClientData) menuPtr); + if (menuPtr->menuType == MENUBAR) { + ScheduleMenuReconfigure(menuPtr); } } } @@ -3068,8 +3056,9 @@ HWND Tk_GetMenuHWND( Tk_Window tkwin) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TkMenuInit(); return tsdPtr->embeddedMenuHWND; } @@ -3119,7 +3108,7 @@ static void MenuThreadExitHandler( ClientData clientData) /* Not used */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); DestroyWindow(tsdPtr->menuHWND); @@ -3195,7 +3184,7 @@ SetDefaults( HDC scratchDC; int bold = 0; int italic = 0; - TEXTMETRIC tm; + TEXTMETRICA tm; int pointSize; HFONT menuFont; /* See: [Bug #3239768] tk8.4.19 (and later) WIN32 menu font support */ @@ -3217,7 +3206,7 @@ SetDefaults( defaultBorderWidth = GetSystemMetrics(SM_CYBORDER); } - scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL); + scratchDC = CreateDCA("DISPLAY", NULL, NULL, NULL); if (!firstTime) { Tcl_DStringFree(&menuFontDString); } @@ -3235,8 +3224,8 @@ SetDefaults( &nc.metrics, 0); menuFont = CreateFontIndirect(&nc.metrics.lfMenuFont); SelectObject(scratchDC, menuFont); - GetTextMetrics(scratchDC, &tm); - GetTextFace(scratchDC, LF_FACESIZE, faceName); + GetTextMetricsA(scratchDC, &tm); + GetTextFaceA(scratchDC, LF_FACESIZE, faceName); pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading, 72, GetDeviceCaps(scratchDC, LOGPIXELSY)); if (tm.tmWeight >= 700) { @@ -3279,17 +3268,11 @@ SetDefaults( * only way to ensure menu items line up, and is not documented. */ - if (TkWinGetPlatformId() >= VER_PLATFORM_WIN32_WINDOWS) { - indicatorDimensions[0] = GetSystemMetrics(SM_CYMENUCHECK); - indicatorDimensions[1] = ((GetSystemMetrics(SM_CXFIXEDFRAME) + - GetSystemMetrics(SM_CXBORDER) - + GetSystemMetrics(SM_CXMENUCHECK) + 7) & 0xFFF8) - - GetSystemMetrics(SM_CXFIXEDFRAME); - } else { - DWORD dimensions = GetMenuCheckMarkDimensions(); - indicatorDimensions[0] = HIWORD(dimensions); - indicatorDimensions[1] = LOWORD(dimensions); - } + indicatorDimensions[0] = GetSystemMetrics(SM_CYMENUCHECK); + indicatorDimensions[1] = ((GetSystemMetrics(SM_CXFIXEDFRAME) + + GetSystemMetrics(SM_CXBORDER) + + GetSystemMetrics(SM_CXMENUCHECK) + 7) & 0xFFF8) + - GetSystemMetrics(SM_CXFIXEDFRAME); /* * Accelerators used to be always underlines until Win2K when a system @@ -3298,7 +3281,7 @@ SetDefaults( showMenuAccelerators = TRUE; if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - SystemParametersInfo(SPI_GETKEYBOARDCUES, 0, &showMenuAccelerators, 0); + SystemParametersInfoA(SPI_GETKEYBOARDCUES, 0, &showMenuAccelerators, 0); } } @@ -3334,16 +3317,16 @@ TkpMenuInit(void) wndClass.lpszMenuName = NULL; wndClass.lpszClassName = MENU_CLASS_NAME; if (!RegisterClass(&wndClass)) { - Tcl_Panic("Failed to register menu window class."); + Tcl_Panic("Failed to register menu window class"); } wndClass.lpfnWndProc = TkWinEmbeddedMenuProc; wndClass.lpszClassName = EMBEDDED_MENU_CLASS_NAME; if (!RegisterClass(&wndClass)) { - Tcl_Panic("Failed to register embedded menu window class."); + Tcl_Panic("Failed to register embedded menu window class"); } - TkCreateExitHandler(MenuExitHandler, (ClientData) NULL); + TkCreateExitHandler(MenuExitHandler, NULL); SetDefaults(1); } @@ -3367,28 +3350,28 @@ TkpMenuInit(void) void TkpMenuThreadInit(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - tsdPtr->menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP, + tsdPtr->menuHWND = CreateWindow(MENU_CLASS_NAME, TEXT("MenuWindow"), WS_POPUP, 0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL); if (!tsdPtr->menuHWND) { - Tcl_Panic("Failed to create the menu window."); + Tcl_Panic("Failed to create the menu window"); } tsdPtr->embeddedMenuHWND = - CreateWindow(EMBEDDED_MENU_CLASS_NAME, "EmbeddedMenuWindow", + CreateWindow(EMBEDDED_MENU_CLASS_NAME, TEXT("EmbeddedMenuWindow"), WS_POPUP, 0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL); if (!tsdPtr->embeddedMenuHWND) { - Tcl_Panic("Failed to create the embedded menu window."); + Tcl_Panic("Failed to create the embedded menu window"); } Tcl_InitHashTable(&tsdPtr->winMenuTable, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(&tsdPtr->commandTable, TCL_ONE_WORD_KEYS); - TkCreateThreadExitHandler(MenuThreadExitHandler, (ClientData) NULL); + TkCreateThreadExitHandler(MenuThreadExitHandler, NULL); } /* diff --git a/win/tkWinPixmap.c b/win/tkWinPixmap.c index 51f0f59..1cf0634 100644 --- a/win/tkWinPixmap.c +++ b/win/tkWinPixmap.c @@ -42,7 +42,7 @@ Tk_GetPixmap( display->request++; - newTwdPtr = (TkWinDrawable*) ckalloc(sizeof(TkWinDrawable)); + newTwdPtr = ckalloc(sizeof(TkWinDrawable)); newTwdPtr->type = TWD_BITMAP; newTwdPtr->bitmap.depth = depth; twdPtr = (TkWinDrawable *) d; @@ -100,12 +100,12 @@ Tk_GetPixmap( LPVOID lpMsgBuf; repeatError = 1; - if (FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | + if (FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS, NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), - (LPTSTR) &lpMsgBuf, 0, NULL)) { - MessageBox(NULL, (LPCTSTR) lpMsgBuf, + (LPSTR) &lpMsgBuf, 0, NULL)) { + MessageBoxA(NULL, (LPCSTR) lpMsgBuf, "Tk_GetPixmap: Error from CreateDIBSection", MB_OK | MB_ICONINFORMATION); LocalFree(lpMsgBuf); @@ -114,7 +114,7 @@ Tk_GetPixmap( } if (newTwdPtr->bitmap.handle == NULL) { - ckfree((char *) newTwdPtr); + ckfree(newTwdPtr); return None; } @@ -147,7 +147,7 @@ Tk_FreePixmap( display->request++; if (twdPtr != NULL) { DeleteObject(twdPtr->bitmap.handle); - ckfree((char *) twdPtr); + ckfree(twdPtr); } } diff --git a/win/tkWinPointer.c b/win/tkWinPointer.c index dcddb8f..6f1f840 100644 --- a/win/tkWinPointer.c +++ b/win/tkWinPointer.c @@ -362,6 +362,20 @@ XWarpPointer( SetCursorPos(r.left+dest_x, r.top+dest_y); return Success; } + +void +TkpWarpPointer( + TkDisplay *dispPtr) +{ + if (dispPtr->warpWindow) { + RECT r; + + GetWindowRect(Tk_GetHWND(Tk_WindowId(dispPtr->warpWindow)), &r); + SetCursorPos(r.left + dispPtr->warpX, r.top + dispPtr->warpY); + } else { + SetCursorPos(dispPtr->warpX, dispPtr->warpY); + } +} /* *---------------------------------------------------------------------- diff --git a/win/tkWinPort.h b/win/tkWinPort.h index b94628e..965dbc5 100644 --- a/win/tkWinPort.h +++ b/win/tkWinPort.h @@ -14,21 +14,23 @@ #ifndef _WINPORT #define _WINPORT -#include <X11/Xlib.h> -#include <X11/cursorfont.h> -#include <X11/keysym.h> -#include <X11/Xatom.h> -#include <X11/Xutil.h> +/* + *--------------------------------------------------------------------------- + * The following sets of #includes and #ifdefs are required to get Tcl to + * compile under the windows compilers. + *--------------------------------------------------------------------------- + */ -#include <malloc.h> +#include <wchar.h> +#include <io.h> +#include <stdlib.h> #include <errno.h> +#include <fcntl.h> +#include <malloc.h> #include <ctype.h> #include <math.h> -#include <stdlib.h> #include <string.h> #include <limits.h> -#include <fcntl.h> -#include <io.h> /* * Need to block out this include for building extensions with MetroWerks @@ -61,6 +63,11 @@ typedef _TCHAR TCHAR; #endif +#include <X11/Xlib.h> +#include <X11/cursorfont.h> +#include <X11/keysym.h> +#include <X11/Xatom.h> +#include <X11/Xutil.h> #ifndef __GNUC__ # define strncasecmp _strnicmp @@ -98,14 +105,6 @@ #endif /* _MSC_VER */ /* - * The following stubs implement various calls that don't do anything - * under Windows. - */ - -#define TkFreeWindowId(dispPtr,w) -#define TkInitXId(dispPtr) - -/* * The following Tk functions are implemented as macros under Windows. */ @@ -113,7 +112,7 @@ | ((p)->green & 0xff00) | (((p)->blue << 8) & 0xff0000)) | 0x20000000) /* - * These calls implement native bitmaps which are not currently + * These calls implement native bitmaps which are not currently * supported under Windows. The macros eliminate the calls. */ diff --git a/win/tkWinScrlbr.c b/win/tkWinScrlbr.c index 46aad58..1b3717e 100644 --- a/win/tkWinScrlbr.c +++ b/win/tkWinScrlbr.c @@ -62,10 +62,7 @@ TCL_DECLARE_MUTEX(winScrlbrMutex) static Window CreateProc(Tk_Window tkwin, Window parent, ClientData instanceData); -static void ModalLoopProc(Tk_Window tkwin, XEvent *eventPtr); -static int ScrollbarBindProc(ClientData clientData, - Tcl_Interp *interp, XEvent *eventPtr, - Tk_Window tkwin, KeySym keySym); +static void ModalLoop(WinScrollbar *, XEvent *eventPtr); static LRESULT CALLBACK ScrollbarProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); static void UpdateScrollbar(WinScrollbar *scrollPtr); @@ -75,13 +72,25 @@ static void UpdateScrollbarMetrics(void); * The class procedure table for the scrollbar widget. */ -Tk_ClassProcs tkpScrollbarProcs = { +const Tk_ClassProcs tkpScrollbarProcs = { sizeof(Tk_ClassProcs), /* size */ NULL, /* worldChangedProc */ CreateProc, /* createProc */ - ModalLoopProc, /* modalProc */ + NULL /* modalProc */ }; +static void +WinScrollbarEventProc(ClientData clientData, XEvent *eventPtr) +{ + WinScrollbar *scrollPtr = clientData; + + if (eventPtr->type == ButtonPress) { + ModalLoop(scrollPtr, eventPtr); + } else { + TkScrollbarEventProc(clientData, eventPtr); + } +} + /* *---------------------------------------------------------------------- @@ -104,7 +113,6 @@ TkpCreateScrollbar( Tk_Window tkwin) { WinScrollbar *scrollPtr; - TkWindow *winPtr = (TkWindow *)tkwin; if (!initialized) { Tcl_MutexLock(&winScrlbrMutex); @@ -113,22 +121,13 @@ TkpCreateScrollbar( Tcl_MutexUnlock(&winScrlbrMutex); } - scrollPtr = (WinScrollbar *) ckalloc(sizeof(WinScrollbar)); + scrollPtr = ckalloc(sizeof(WinScrollbar)); scrollPtr->winFlags = 0; scrollPtr->hwnd = NULL; Tk_CreateEventHandler(tkwin, - ExposureMask|StructureNotifyMask|FocusChangeMask, - TkScrollbarEventProc, (ClientData) scrollPtr); - - if (!Tcl_GetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL)) { - Tcl_SetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL, - (ClientData)1); - TkCreateBindingProcedure(winPtr->mainPtr->interp, - winPtr->mainPtr->bindingTable, - (ClientData)Tk_GetUid("Scrollbar"), "<ButtonPress>", - ScrollbarBindProc, NULL, NULL); - } + ExposureMask|StructureNotifyMask|FocusChangeMask|ButtonPressMask, + WinScrollbarEventProc, scrollPtr); return (TkScrollbar *) scrollPtr; } @@ -218,13 +217,13 @@ CreateProc( if (scrollPtr->info.vertical) { style = WS_CHILD | WS_VISIBLE | WS_CLIPCHILDREN | WS_CLIPSIBLINGS - | SBS_VERT | SBS_RIGHTALIGN; + | SBS_VERT; } else { style = WS_CHILD | WS_VISIBLE | WS_CLIPCHILDREN | WS_CLIPSIBLINGS - | SBS_HORZ | SBS_BOTTOMALIGN; + | SBS_HORZ; } - scrollPtr->hwnd = CreateWindow("SCROLLBAR", NULL, style, + scrollPtr->hwnd = CreateWindow(TEXT("SCROLLBAR"), NULL, style, Tk_X(tkwin), Tk_Y(tkwin), Tk_Width(tkwin), Tk_Height(tkwin), parent, NULL, Tk_GetHINSTANCE(), NULL); @@ -247,7 +246,7 @@ CreateProc( scrollPtr->lastVertical = scrollPtr->info.vertical; scrollPtr->oldProc = (WNDPROC)SetWindowLongPtr(scrollPtr->hwnd, - GWLP_WNDPROC, (INT_PTR) ScrollbarProc); + GWLP_WNDPROC, (LONG_PTR) ScrollbarProc); window = Tk_AttachHWND(tkwin, scrollPtr->hwnd); UpdateScrollbar(scrollPtr); @@ -292,7 +291,7 @@ TkpDisplayScrollbar( if (scrollPtr->lastVertical != scrollPtr->info.vertical) { HWND hwnd = Tk_GetHWND(Tk_WindowId(tkwin)); - SetWindowLongPtr(hwnd, GWLP_WNDPROC, (INT_PTR) scrollPtr->oldProc); + SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR) scrollPtr->oldProc); DestroyWindow(hwnd); CreateProc(tkwin, Tk_WindowId(Tk_Parent(tkwin)), @@ -556,7 +555,7 @@ ScrollbarProc( 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); + Tcl_BackgroundException(interp, code); } Tcl_DStringFree(&cmdString); @@ -599,66 +598,26 @@ TkpConfigureScrollbar( } /* - *-------------------------------------------------------------- - * - * ScrollbarBindProc -- - * - * This procedure is invoked when the default <ButtonPress> binding on - * the Scrollbar bind tag fires. - * - * Results: - * None. - * - * Side effects: - * The event enters a modal loop. - * - *-------------------------------------------------------------- - */ - -static int -ScrollbarBindProc( - ClientData clientData, - Tcl_Interp *interp, - XEvent *eventPtr, - Tk_Window tkwin, - KeySym keySym) -{ - TkWindow *winPtr = (TkWindow *) tkwin; - - if (eventPtr->type == ButtonPress) { - winPtr->flags |= TK_DEFER_MODAL; - } - return TCL_OK; -} - -/* *---------------------------------------------------------------------- * - * ModalLoopProc -- - * - * This function is invoked at the end of the event processing whenever - * the ScrollbarBindProc has been invoked for a ButtonPress event. + * ModalLoop -- * - * Results: - * None. - * - * Side effects: - * Enters a modal loop. + * This function is invoked in response to a ButtonPress event. + * It resends the event to the Scrollbar window procedure, + * which in turn enters a modal loop. * *---------------------------------------------------------------------- */ static void -ModalLoopProc( - Tk_Window tkwin, +ModalLoop( + WinScrollbar *scrollPtr, XEvent *eventPtr) { - TkWindow *winPtr = (TkWindow *) tkwin; - WinScrollbar *scrollPtr = (WinScrollbar *) winPtr->instanceData; int oldMode; if (scrollPtr->hwnd) { - Tcl_Preserve(scrollPtr); + Tcl_Preserve((ClientData)scrollPtr); scrollPtr->winFlags |= IN_MODAL_LOOP; oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); TkWinResendEvent(scrollPtr->oldProc, scrollPtr->hwnd, eventPtr); @@ -667,7 +626,7 @@ ModalLoopProc( if (scrollPtr->hwnd && scrollPtr->winFlags & ALREADY_DEAD) { DestroyWindow(scrollPtr->hwnd); } - Tcl_Release(scrollPtr); + Tcl_Release((ClientData)scrollPtr); } } diff --git a/win/tkWinSend.c b/win/tkWinSend.c index 4b25963..6c4731a 100644 --- a/win/tkWinSend.c +++ b/win/tkWinSend.c @@ -14,10 +14,6 @@ #include "tkInt.h" #include "tkWinSendCom.h" -#ifdef _MSC_VER -#define vsnprintf _vsnprintf -#endif - /* * Should be defined in WTypes.h but mingw 1.0 is missing them. */ @@ -59,7 +55,7 @@ typedef struct { int initialized; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * Functions internal to this file. @@ -70,18 +66,17 @@ static void CmdDeleteProc(ClientData clientData); static void InterpDeleteProc(ClientData clientData, Tcl_Interp *interp); static void RevokeObjectRegistration(RegisteredInterp *riPtr); -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ static HRESULT BuildMoniker(const char *name, LPMONIKER *pmk); #ifdef TK_SEND_ENABLED_ON_WINDOWS static HRESULT RegisterInterp(const char *name, RegisteredInterp *riPtr); -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ static int FindInterpreterObject(Tcl_Interp *interp, const char *name, LPDISPATCH *ppdisp); static int Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, int async, ClientData clientData, int objc, Tcl_Obj *const objv[]); -static Tcl_Obj * Win32ErrorObj(HRESULT hrError); static void SendTrace(const char *format, ...); static Tcl_EventProc SendEventProc; @@ -89,7 +84,7 @@ static Tcl_EventProc SendEventProc; #define TRACE SendTrace #else #define TRACE 1 ? ((void)0) : SendTrace -#endif +#endif /* DEBUG || _DEBUG */ /* *-------------------------------------------------------------- @@ -140,9 +135,7 @@ Tk_SetAppName( HRESULT hr = S_OK; interp = winPtr->mainPtr->interp; - - tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* * Initialise the COM library for this interpreter just once. @@ -151,8 +144,9 @@ Tk_SetAppName( if (tsdPtr->initialized == 0) { hr = CoInitialize(0); if (FAILED(hr)) { - Tcl_SetResult(interp, - "failed to initialize the COM library", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "failed to initialize the COM library", -1)); + Tcl_SetErrorCode(interp, "TK", "SEND", "COM", NULL); return ""; } tsdPtr->initialized = 1; @@ -169,7 +163,7 @@ Tk_SetAppName( if (riPtr == NULL) { LPUNKNOWN *objPtr; - riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); + riPtr = ckalloc(sizeof(RegisteredInterp)); memset(riPtr, 0, sizeof(RegisteredInterp)); riPtr->interp = interp; @@ -286,7 +280,7 @@ TkGetInterpNames( if (objList != NULL) { Tcl_DecrRefCount(objList); } - Tcl_SetObjResult(interp, Win32ErrorObj(hr)); + Tcl_SetObjResult(interp, TkWin32ErrorObj(hr)); result = TCL_ERROR; } @@ -326,7 +320,7 @@ Tk_SendObjCmd( enum { SEND_ASYNC, SEND_DISPLAYOF, SEND_LAST }; - static const char *sendOptions[] = { + static const char *const sendOptions[] = { "-async", "-displayof", "--", NULL }; int result = TCL_OK; @@ -338,8 +332,8 @@ Tk_SendObjCmd( */ for (i = 1; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions, - "option", 0, &optind) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], sendOptions, + sizeof(char *), "option", 0, &optind) != TCL_OK) { break; } if (optind == SEND_ASYNC) { @@ -367,9 +361,10 @@ Tk_SendObjCmd( */ if (displayPtr) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), - "option not implemented: \"displayof\" is not available " - "for this platform.", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "option not implemented: \"displayof\" is not available" + " for this platform.", -1)); + Tcl_SetErrorCode(interp, "TK", "SEND", "DISPLAYOF_WIN", NULL); result = TCL_ERROR; } @@ -379,6 +374,7 @@ Tk_SendObjCmd( /* FIX ME: we need to check for local interp */ if (result == TCL_OK) { LPDISPATCH pdisp; + result = FindInterpreterObject(interp, Tcl_GetString(objv[i]), &pdisp); if (result == TCL_OK) { i++; @@ -440,9 +436,10 @@ FindInterpreterObject( pUnkInterp->lpVtbl->Release(pUnkInterp); } else { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, - "no application named \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no application named \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "APPLICATION", + NULL); result = TCL_ERROR; } @@ -453,7 +450,7 @@ FindInterpreterObject( pROT->lpVtbl->Release(pROT); } if (FAILED(hr) && result == TCL_OK) { - Tcl_SetObjResult(interp, Win32ErrorObj(hr)); + Tcl_SetObjResult(interp, TkWin32ErrorObj(hr)); result = TCL_ERROR; } return result; @@ -557,7 +554,7 @@ RevokeObjectRegistration( riPtr->name = NULL; } } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -584,7 +581,7 @@ InterpDeleteProc( { CoUninitialize(); } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -705,7 +702,7 @@ RegisterInterp( Tcl_DStringFree(&dString); return hr; } -#endif +#endif /* TK_SEND_ENABLED_ON_WINDOWS */ /* * ---------------------------------------------------------------------- @@ -786,21 +783,14 @@ Send( * variables. */ - if (hr == DISP_E_EXCEPTION) { + if (hr == DISP_E_EXCEPTION && ei.bstrSource != NULL) { Tcl_Obj *opError, *opErrorCode, *opErrorInfo; - if (ei.bstrSource != NULL) { - int len; - char *szErrorInfo; - - opError = Tcl_NewUnicodeObj(ei.bstrSource, -1); - Tcl_ListObjIndex(interp, opError, 0, &opErrorCode); - Tcl_SetObjErrorCode(interp, opErrorCode); - - Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo); - szErrorInfo = Tcl_GetStringFromObj(opErrorInfo, &len); - Tcl_AddObjErrorInfo(interp, szErrorInfo, len); - } + opError = Tcl_NewUnicodeObj(ei.bstrSource, -1); + Tcl_ListObjIndex(interp, opError, 0, &opErrorCode); + Tcl_SetObjErrorCode(interp, opErrorCode); + Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo); + Tcl_AppendObjToErrorInfo(interp, opErrorInfo); } /* @@ -818,57 +808,7 @@ Send( /* * ---------------------------------------------------------------------- * - * Win32ErrorObj -- - * - * Returns a string object containing text from a COM or Win32 error code - * - * Results: - * A Tcl_Obj containing the Win32 error message. - * - * Side effects: - * Removed the error message from the COM threads error object. - * - * ---------------------------------------------------------------------- - */ - -static Tcl_Obj* -Win32ErrorObj( - HRESULT hrError) -{ - LPTSTR lpBuffer = NULL, p = NULL; - TCHAR sBuffer[30]; - Tcl_Obj* errPtr = NULL; - - FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, - NULL, (DWORD)hrError, LANG_NEUTRAL, - (LPTSTR)&lpBuffer, 0, NULL); - - if (lpBuffer == NULL) { - lpBuffer = sBuffer; - wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError); - } - - if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) { - *p = TEXT('\0'); - } - -#ifdef _UNICODE - errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer)); -#else - errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer)); -#endif - - if (lpBuffer != sBuffer) { - LocalFree((HLOCAL)lpBuffer); - } - - return errPtr; -} - -/* - * ---------------------------------------------------------------------- - * - * SetErrorInfo -- + * TkWinSend_SetExcepInfo -- * * Convert the error information from a Tcl interpreter into a COM * exception structure. This information is then registered with the COM @@ -885,48 +825,51 @@ Win32ErrorObj( */ void -SetExcepInfo( - Tcl_Interp* interp, +TkWinSend_SetExcepInfo( + Tcl_Interp *interp, EXCEPINFO *pExcepInfo) { - if (pExcepInfo) { - Tcl_Obj *opError, *opErrorInfo, *opErrorCode; - ICreateErrorInfo *pCEI; - IErrorInfo *pEI, **ppEI = &pEI; - HRESULT hr; - - opError = Tcl_GetObjResult(interp); - opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo",NULL, TCL_GLOBAL_ONLY); - opErrorCode = Tcl_GetVar2Ex(interp, "errorCode",NULL, TCL_GLOBAL_ONLY); - - if (Tcl_IsShared(opErrorCode)) { - Tcl_Obj *ec = Tcl_DuplicateObj(opErrorCode); - - Tcl_IncrRefCount(ec); - Tcl_DecrRefCount(opErrorCode); - opErrorCode = ec; - } - Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo); + Tcl_Obj *opError, *opErrorInfo, *opErrorCode; + ICreateErrorInfo *pCEI; + IErrorInfo *pEI, **ppEI = &pEI; + HRESULT hr; + + if (!pExcepInfo) { + return; + } - pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError)); - pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode)); - pExcepInfo->scode = E_FAIL; + opError = Tcl_GetObjResult(interp); + opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); + opErrorCode = Tcl_GetVar2Ex(interp, "errorCode", NULL, TCL_GLOBAL_ONLY); - hr = CreateErrorInfo(&pCEI); - if (SUCCEEDED(hr)) { - hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch); - hr = pCEI->lpVtbl->SetDescription(pCEI, - pExcepInfo->bstrDescription); - hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource); - hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, - (void**) ppEI); - if (SUCCEEDED(hr)) { - SetErrorInfo(0, pEI); - pEI->lpVtbl->Release(pEI); - } - pCEI->lpVtbl->Release(pCEI); - } + /* + * Pack the trace onto the end of the Tcl exception descriptor. + */ + + opErrorCode = Tcl_DuplicateObj(opErrorCode); + Tcl_IncrRefCount(opErrorCode); + Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo); + /* TODO: Handle failure to append */ + + pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError)); + pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode)); + Tcl_DecrRefCount(opErrorCode); + pExcepInfo->scode = E_FAIL; + + hr = CreateErrorInfo(&pCEI); + if (!SUCCEEDED(hr)) { + return; + } + + hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch); + hr = pCEI->lpVtbl->SetDescription(pCEI, pExcepInfo->bstrDescription); + hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource); + hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, (void **) ppEI); + if (SUCCEEDED(hr)) { + SetErrorInfo(0, pEI); + pEI->lpVtbl->Release(pEI); } + pCEI->lpVtbl->Release(pCEI); } /* @@ -955,7 +898,7 @@ TkWinSend_QueueCommand( TRACE("SendQueueCommand()\n"); - evPtr = (SendEvent *)ckalloc(sizeof(SendEvent)); + evPtr = ckalloc(sizeof(SendEvent)); evPtr->header.proc = SendEventProc; evPtr->header.nextPtr = NULL; evPtr->interp = interp; @@ -1035,8 +978,8 @@ SendTrace( static char buffer[1024]; va_start(args, format); - vsnprintf(buffer, 1023, format, args); - OutputDebugString(buffer); + _vsnprintf(buffer, 1023, format, args); + OutputDebugStringA(buffer); va_end(args); } diff --git a/win/tkWinSendCom.c b/win/tkWinSendCom.c index 3bbdd63..83dd56b 100644 --- a/win/tkWinSendCom.c +++ b/win/tkWinSendCom.c @@ -100,7 +100,6 @@ TkWinSendCom_CreateInstance( ISupportErrorInfo_Release, ISupportErrorInfo_InterfaceSupportsErrorInfo, }; - HRESULT hr = S_OK; TkWinSendCom *obj = NULL; /* @@ -111,21 +110,19 @@ TkWinSendCom_CreateInstance( obj = (TkWinSendCom *) CoTaskMemAlloc(sizeof(TkWinSendCom)); if (obj == NULL) { *ppv = NULL; - hr = E_OUTOFMEMORY; - } else { - obj->lpVtbl = &vtbl; - obj->lpVtbl2 = &vtbl2; - obj->refcount = 0; - obj->interp = interp; - - /* - * lock the interp? Tcl_AddRef/Retain? - */ - - hr = obj->lpVtbl->QueryInterface((IDispatch*)obj, riid, ppv); + return E_OUTOFMEMORY; } - return hr; + obj->lpVtbl = &vtbl; + obj->lpVtbl2 = &vtbl2; + obj->refcount = 0; + obj->interp = interp; + + /* + * lock the interp? Tcl_AddRef/Retain? + */ + + return obj->lpVtbl->QueryInterface((IDispatch *) obj, riid, ppv); } /* @@ -147,7 +144,7 @@ static void TkWinSendCom_Destroy( LPDISPATCH pdisp) { - CoTaskMemFree((void*)pdisp); + CoTaskMemFree((void *) pdisp); } /* @@ -169,17 +166,17 @@ WinSendCom_QueryInterface( void **ppvObject) { HRESULT hr = E_NOINTERFACE; - TkWinSendCom *this = (TkWinSendCom*)This; + TkWinSendCom *this = (TkWinSendCom *) This; *ppvObject = NULL; if (memcmp(riid, &IID_IUnknown, sizeof(IID)) == 0 || memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) { - *ppvObject = (void**)this; + *ppvObject = (void **) this; this->lpVtbl->AddRef(This); hr = S_OK; } else if (memcmp(riid, &IID_ISupportErrorInfo, sizeof(IID)) == 0) { - *ppvObject = (void**)(this + 1); - this->lpVtbl2->AddRef((ISupportErrorInfo*)(this + 1)); + *ppvObject = (void **) (this + 1); + this->lpVtbl2->AddRef((ISupportErrorInfo *) (this + 1)); hr = S_OK; } return hr; @@ -316,16 +313,16 @@ ISupportErrorInfo_QueryInterface( REFIID riid, void **ppvObject) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + TkWinSendCom *this = (TkWinSendCom *)(This - 1); - return this->lpVtbl->QueryInterface((IDispatch*)this, riid, ppvObject); + return this->lpVtbl->QueryInterface((IDispatch *) this, riid, ppvObject); } static STDMETHODIMP_(ULONG) ISupportErrorInfo_AddRef( ISupportErrorInfo *This) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + TkWinSendCom *this = (TkWinSendCom *)(This - 1); return InterlockedIncrement(&this->refcount); } @@ -334,9 +331,9 @@ static STDMETHODIMP_(ULONG) ISupportErrorInfo_Release( ISupportErrorInfo *This) { - TkWinSendCom *this = (TkWinSendCom*)(This - 1); + TkWinSendCom *this = (TkWinSendCom *)(This - 1); - return this->lpVtbl->Release((IDispatch*)this); + return this->lpVtbl->Release((IDispatch *) this); } static STDMETHODIMP @@ -378,22 +375,20 @@ Async( hr = VariantChangeType(&vCmd, &Cmd, 0, VT_BSTR); if (FAILED(hr)) { - Tcl_SetStringObj(Tcl_GetObjResult(obj->interp), - "invalid args: Async(command)", -1); - SetExcepInfo(obj->interp, pExcepInfo); + Tcl_SetObjResult(obj->interp, Tcl_NewStringObj( + "invalid args: Async(command)", -1)); + TkWinSend_SetExcepInfo(obj->interp, pExcepInfo); hr = DISP_E_EXCEPTION; } - if (SUCCEEDED(hr)) { - if (obj->interp) { - Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal, - (int)SysStringLen(vCmd.bstrVal)); - TkWinSend_QueueCommand(obj->interp, scriptPtr); - } + if (SUCCEEDED(hr) && obj->interp) { + Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal, + (int) SysStringLen(vCmd.bstrVal)); + + TkWinSend_QueueCommand(obj->interp, scriptPtr); } VariantClear(&vCmd); - return hr; } @@ -427,29 +422,36 @@ Send( HRESULT hr = S_OK; int result = TCL_OK; VARIANT v; + register Tcl_Interp *interp = obj->interp; + Tcl_Obj *scriptPtr; + if (interp == NULL) { + return S_OK; + } VariantInit(&v); hr = VariantChangeType(&v, &vCmd, 0, VT_BSTR); - if (SUCCEEDED(hr)) { - if (obj->interp) { - Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, - (int)SysStringLen(v.bstrVal)); - - result = Tcl_EvalObjEx(obj->interp, scriptPtr, - TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); - if (pvResult) { - VariantInit(pvResult); - pvResult->vt = VT_BSTR; - pvResult->bstrVal = SysAllocString( - Tcl_GetUnicode(Tcl_GetObjResult(obj->interp))); - } - if (result == TCL_ERROR) { - hr = DISP_E_EXCEPTION; - SetExcepInfo(obj->interp, pExcepInfo); - } - } - VariantClear(&v); + if (!SUCCEEDED(hr)) { + return hr; + } + + scriptPtr = Tcl_NewUnicodeObj(v.bstrVal, (int) SysStringLen(v.bstrVal)); + Tcl_Preserve(interp); + Tcl_IncrRefCount(scriptPtr); + result = Tcl_EvalObjEx(interp, scriptPtr, + TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(scriptPtr); + if (pvResult != NULL) { + VariantInit(pvResult); + pvResult->vt = VT_BSTR; + pvResult->bstrVal = SysAllocString(Tcl_GetUnicode( + Tcl_GetObjResult(interp))); + } + if (result == TCL_ERROR) { + hr = DISP_E_EXCEPTION; + TkWinSend_SetExcepInfo(interp, pExcepInfo); } + Tcl_Release(interp); + VariantClear(&v); return hr; } diff --git a/win/tkWinSendCom.h b/win/tkWinSendCom.h index 4928bc7..cd6ec18 100644 --- a/win/tkWinSendCom.h +++ b/win/tkWinSendCom.h @@ -45,11 +45,11 @@ typedef struct { * TkWinSendCom public functions */ -HRESULT TkWinSendCom_CreateInstance(Tcl_Interp *interp, +MODULE_SCOPE HRESULT TkWinSendCom_CreateInstance(Tcl_Interp *interp, REFIID riid, void **ppv); -int TkWinSend_QueueCommand(Tcl_Interp *interp, +MODULE_SCOPE int TkWinSend_QueueCommand(Tcl_Interp *interp, Tcl_Obj *cmdPtr); -void SetExcepInfo(Tcl_Interp *interp, +MODULE_SCOPE void TkWinSend_SetExcepInfo(Tcl_Interp *interp, EXCEPINFO *pExcepInfo); #endif /* _tkWinSendCom_h_INCLUDE */ diff --git a/win/tkWinTest.c b/win/tkWinTest.c index 2498864..d824ee4 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -12,6 +12,10 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#undef USE_TCL_STUBS +#define USE_TCL_STUBS +#undef USE_TK_STUBS +#define USE_TK_STUBS #include "tkWinInt.h" HWND tkWinCurrentDialog; @@ -23,8 +27,9 @@ HWND tkWinCurrentDialog; static int TestclipboardObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestwineventCmd(ClientData clientData, - Tcl_Interp *interp, int argc, const char **argv); +static int TestwineventObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); static int TestfindwindowObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -34,7 +39,7 @@ static int TestgetwindowinfoObjCmd(ClientData clientData, static int TestwinlocaleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); +static Tk_GetSelProc SetSelectionResult; /* *---------------------------------------------------------------------- @@ -63,7 +68,7 @@ TkplatformtestInit( Tcl_CreateObjCommand(interp, "testclipboard", TestclipboardObjCmd, (ClientData) Tk_MainWindow(interp), NULL); - Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd, + Tcl_CreateObjCommand(interp, "testwinevent", TestwineventObjCmd, (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testfindwindow", TestfindwindowObjCmd, (ClientData) Tk_MainWindow(interp), NULL); @@ -74,6 +79,42 @@ TkplatformtestInit( return TCL_OK; } +struct TestFindControlState { + int id; + HWND control; +}; + +/* Callback for window enumeration - used for TestFindControl */ +BOOL CALLBACK TestFindControlCallback( + HWND hwnd, + LPARAM lParam +) +{ + struct TestFindControlState *fcsPtr = (struct TestFindControlState *)lParam; + fcsPtr->control = GetDlgItem(hwnd, fcsPtr->id); + /* If we have found the control, return FALSE to stop the enumeration */ + return fcsPtr->control == NULL ? TRUE : FALSE; +} + +/* + * Finds the descendent control window with the specified ID and returns + * its HWND. + */ +HWND TestFindControl(HWND root, int id) +{ + struct TestFindControlState fcs; + + fcs.control = GetDlgItem(root, id); + if (fcs.control == NULL) { + /* Control is not a direct child. Look in descendents */ + fcs.id = id; + fcs.control = NULL; + EnumChildWindows(root, TestFindControlCallback, (LPARAM) &fcs); + } + return fcs.control; +} + + /* *---------------------------------------------------------------------- * @@ -106,7 +147,8 @@ AppendSystemError( if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } - length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM + length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr, 0, NULL); @@ -114,6 +156,7 @@ AppendSystemError( char *msgPtr; length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr, 0, NULL); @@ -185,50 +228,36 @@ AppendSystemError( */ static int +SetSelectionResult( + ClientData dummy, + Tcl_Interp *interp, + const char *selection) +{ + Tcl_AppendResult(interp, selection, NULL); + return TCL_OK; +} + +static int TestclipboardObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - HGLOBAL handle; - char *data; - int code = TCL_OK; + Tk_Window tkwin = (Tk_Window) clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - 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 - */ - handle = GetClipboardData(CF_TEXT); - if (handle != NULL) { - data = GlobalLock(handle); - Tcl_AppendResult(interp, data, NULL); - GlobalUnlock(handle); - } else { - Tcl_AppendResult(interp, "null clipboard handle", NULL); - code = TCL_ERROR; - } - CloseClipboard(); - return code; - } else { - Tcl_AppendResult(interp, "couldn't open clipboard: ", NULL); - AppendSystemError(interp, GetLastError()); - return TCL_ERROR; - } - return TCL_OK; + return TkSelGetSelection(interp, tkwin, Tk_InternAtom(tkwin, "CLIPBOARD"), + XA_STRING, SetSelectionResult, NULL); } /* *---------------------------------------------------------------------- * - * TestwineventCmd -- + * TestwineventObjCmd -- * * This function implements the testwinevent command. It provides a way * to send messages to windows dialogs. @@ -243,19 +272,21 @@ TestclipboardObjCmd( */ static int -TestwineventCmd( +TestwineventObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { HWND hwnd = 0; HWND child = 0; + HWND control; int id; char *rest; UINT message; WPARAM wParam; LPARAM lParam; + LRESULT result; static const TkStateMap messageMap[] = { {WM_LBUTTONDOWN, "WM_LBUTTONDOWN"}, {WM_LBUTTONUP, "WM_LBUTTONUP"}, @@ -266,38 +297,38 @@ TestwineventCmd( {-1, NULL} }; - if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) { + if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "debug") == 0)) { int b; - if (Tcl_GetBoolean(interp, argv[2], &b) != TCL_OK) { + if (Tcl_GetBoolean(interp, Tcl_GetString(objv[2]), &b) != TCL_OK) { return TCL_ERROR; } TkWinDialogDebug(b); return TCL_OK; } - if (argc < 4) { + if (objc < 4) { return TCL_ERROR; } - hwnd = INT2PTR(strtol(argv[1], &rest, 0)); - if (rest == argv[1]) { - hwnd = FindWindow(NULL, argv[1]); + hwnd = INT2PTR(strtol(Tcl_GetString(objv[1]), &rest, 0)); + if (rest == Tcl_GetString(objv[1])) { + hwnd = FindWindowA(NULL, Tcl_GetString(objv[1])); if (hwnd == NULL) { - Tcl_SetResult(interp, "no such window", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("no such window", -1)); return TCL_ERROR; } } UpdateWindow(hwnd); - id = strtol(argv[2], &rest, 0); - if (rest == argv[2]) { + id = strtol(Tcl_GetString(objv[2]), &rest, 0); + if (rest == Tcl_GetString(objv[2])) { char buf[256]; child = GetWindow(hwnd, GW_CHILD); while (child != NULL) { - SendMessage(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf); - if (strcasecmp(buf, argv[2]) == 0) { + SendMessageA(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf); + if (strcasecmp(buf, Tcl_GetString(objv[2])) == 0) { id = GetDlgCtrlID(child); break; } @@ -305,19 +336,20 @@ TestwineventCmd( } if (child == NULL) { Tcl_AppendResult(interp, "could not find a control matching \"", - argv[2], "\"", NULL); + Tcl_GetString(objv[2]), "\"", NULL); return TCL_ERROR; } } - message = TkFindStateNum(NULL, NULL, messageMap, argv[3]); + + message = TkFindStateNum(NULL, NULL, messageMap, Tcl_GetString(objv[3])); wParam = 0; lParam = 0; - if (argc > 4) { - wParam = strtol(argv[4], NULL, 0); + if (objc > 4) { + wParam = strtol(Tcl_GetString(objv[4]), NULL, 0); } - if (argc > 5) { - lParam = strtol(argv[5], NULL, 0); + if (objc > 5) { + lParam = strtol(Tcl_GetString(objv[5]), NULL, 0); } switch (message) { @@ -325,7 +357,19 @@ TestwineventCmd( Tcl_DString ds; char buf[256]; - GetDlgItemText(hwnd, id, buf, 256); +#if 0 + GetDlgItemTextA(hwnd, id, buf, 256); +#else + control = TestFindControl(hwnd, id); + if (control == NULL) { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Could not find control with id %d", id)); + return TCL_ERROR; + } + buf[0] = 0; + SendMessageA(control, WM_GETTEXT, (WPARAM)sizeof(buf), + (LPARAM) buf); +#endif Tcl_ExternalToUtfDString(NULL, buf, -1, &ds); Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); Tcl_DStringFree(&ds); @@ -333,34 +377,40 @@ TestwineventCmd( } case WM_SETTEXT: { Tcl_DString ds; - BOOL result; - Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); - result = SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); + control = TestFindControl(hwnd, id); + if (control == NULL) { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Could not find control with id %d", id)); + return TCL_ERROR; + } + Tcl_UtfToExternalDString(NULL, Tcl_GetString(objv[4]), -1, &ds); + result = SendMessageA(control, WM_SETTEXT, 0, + (LPARAM) 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; + Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1)); + AppendSystemError(interp, GetLastError()); + return TCL_ERROR; } break; } case WM_COMMAND: { char buf[TCL_INTEGER_SPACE]; - if (argc < 5) { + if (objc < 5) { wParam = MAKEWPARAM(id, 0); lParam = (LPARAM)child; } - sprintf(buf, "%d", (int) SendMessage(hwnd, message, wParam, lParam)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + sprintf(buf, "%d", (int) SendMessageA(hwnd, message, wParam, lParam)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); break; } default: { char buf[TCL_INTEGER_SPACE]; sprintf(buf, "%d", - (int) SendDlgItemMessage(hwnd, id, message, wParam, lParam)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + (int) SendDlgItemMessageA(hwnd, id, message, wParam, lParam)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); break; } } @@ -385,18 +435,48 @@ TestfindwindowObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - const char *title = NULL, *class = NULL; + const TCHAR *title = NULL, *class = NULL; + Tcl_DString titleString, classString; HWND hwnd = NULL; int r = TCL_OK; + DWORD myPid; + + Tcl_DStringInit(&classString); + Tcl_DStringInit(&titleString); if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "title ?class?"); return TCL_ERROR; } - title = Tcl_GetString(objv[1]); - if (objc == 3) - class = Tcl_GetString(objv[2]); - hwnd = FindWindowA(class, title); + + title = Tcl_WinUtfToTChar(Tcl_GetString(objv[1]), -1, &titleString); + if (objc == 3) { + class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString); + } + if (title[0] == 0) + title = NULL; +#if 0 + hwnd = FindWindow(class, title); +#else + /* We want find a window the belongs to us and not some other process */ + hwnd = NULL; + myPid = GetCurrentProcessId(); + while (1) { + DWORD pid, tid; + hwnd = FindWindowEx(NULL, hwnd, class, title); + if (hwnd == NULL) + break; + tid = GetWindowThreadProcessId(hwnd, &pid); + if (tid == 0) { + /* Window has gone */ + hwnd = NULL; + break; + } + if (pid == myPid) + break; /* Found it */ + } + +#endif if (hwnd == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1)); @@ -405,7 +485,11 @@ TestfindwindowObjCmd( } else { Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd))); } + + Tcl_DStringFree(&titleString); + Tcl_DStringFree(&classString); return r; + } static BOOL CALLBACK @@ -427,10 +511,10 @@ TestgetwindowinfoObjCmd( Tcl_Obj *const objv[]) { long hwnd; - Tcl_Obj *resObj = NULL, *classObj = NULL, *textObj = NULL; + Tcl_Obj *dictObj = NULL, *classObj = NULL, *textObj = NULL; Tcl_Obj *childrenObj = NULL; - char buf[512]; - int cch, cchBuf = tkWinProcs->useWide ? 256 : 512; + TCHAR buf[512]; + int cch, cchBuf = 256; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "hwnd"); @@ -440,46 +524,35 @@ 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); - } else { - cch = GetClassNameA(INT2PTR(hwnd), (LPSTR)buf, sizeof(buf)); - classObj = Tcl_NewStringObj((LPSTR)buf, cch); - } + cch = GetClassName(INT2PTR(hwnd), buf, cchBuf); if (cch == 0) { - Tcl_SetResult(interp, "failed to get class name: ", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to get class name: ", -1)); AppendSystemError(interp, GetLastError()); return TCL_ERROR; + } else { + Tcl_DString ds; + Tcl_WinTCharToUtf(buf, -1, &ds); + classObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); } - 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_NewLongObj(GetWindowLong(INT2PTR(hwnd), GWL_ID))); + dictObj = Tcl_NewDictObj(); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("class", 5), classObj); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("id", 2), + Tcl_NewLongObj(GetWindowLongA(INT2PTR(hwnd), GWL_ID))); - cch = tkWinProcs->getWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf); - if (tkWinProcs->useWide) { - textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch); - } else { - textObj = Tcl_NewStringObj((LPCSTR)buf, cch); - } + cch = GetWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf); + textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch); - 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_NewLongObj(PTR2INT(GetParent(INT2PTR(hwnd))))); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6), + Tcl_NewLongObj(PTR2INT(GetParent((INT2PTR(hwnd)))))); childrenObj = Tcl_NewListObj(0, NULL); EnumChildWindows(INT2PTR(hwnd), EnumChildrenProc, (LPARAM)childrenObj); - Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("children", -1)); - Tcl_ListObjAppendElement(interp, resObj, childrenObj); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("children", -1), childrenObj); - Tcl_SetObjResult(interp, resObj); + Tcl_SetObjResult(interp, dictObj); return TCL_OK; } @@ -494,7 +567,7 @@ TestwinlocaleObjCmd( Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetSystemDefaultLCID())); + Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetThreadLocale())); return TCL_OK; } diff --git a/win/tkWinWindow.c b/win/tkWinWindow.c index 3dfc078..ade15bc 100644 --- a/win/tkWinWindow.c +++ b/win/tkWinWindow.c @@ -11,6 +11,7 @@ */ #include "tkWinInt.h" +#include "tkBusy.h" typedef struct ThreadSpecificData { int initialized; /* 0 means table below needs initializing. */ @@ -65,7 +66,7 @@ Tk_AttachHWND( */ if (twdPtr == NULL) { - twdPtr = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable)); + twdPtr = ckalloc(sizeof(TkWinDrawable)); twdPtr->type = TWD_WINDOW; twdPtr->window.winPtr = (TkWindow *) tkwin; } else if (twdPtr->window.handle != NULL) { @@ -80,7 +81,7 @@ Tk_AttachHWND( twdPtr->window.handle = hwnd; entryPtr = Tcl_CreateHashEntry(&tsdPtr->windowTable, (char *)hwnd, &new); - Tcl_SetHashValue(entryPtr, (ClientData)tkwin); + Tcl_SetHashValue(entryPtr, tkwin); return (Window)twdPtr; } @@ -172,12 +173,13 @@ TkpPrintWindowId( /* * Use pointer representation, because Win64 is P64 (*not* LP64). Windows * doesn't print the 0x for %p, so we do it. - * bug #2026405: cygwin does output 0x for %p so test and recover. + * Bug 2026405: cygwin does output 0x for %p so test and recover. */ sprintf(buf, "0x%p", hwnd); - if (buf[2] == '0' && buf[3] == 'x') + if (buf[2] == '0' && buf[3] == 'x') { sprintf(buf, "%p", hwnd); + } } /* @@ -204,12 +206,15 @@ TkpPrintWindowId( int TkpScanWindowId( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ - CONST char *string, /* String containing a (possibly signed) + const char *string, /* String containing a (possibly signed) * integer in a form acceptable to strtol. */ Window *idPtr) /* Place to store converted result. */ { Tk_Window tkwin; - void *number, *numberPtr = &number; + union { + HWND hwnd; + int number; + } win; /* * We want sscanf for the 64-bit check, but if that doesn't work, then @@ -218,13 +223,13 @@ TkpScanWindowId( if ( #ifdef _WIN64 - (sscanf(string, "0x%p", &number) != 1) && + (sscanf(string, "0x%p", &win.hwnd) != 1) && #endif - Tcl_GetInt(interp, string, (int *) numberPtr) != TCL_OK) { + Tcl_GetInt(interp, string, &win.number) != TCL_OK) { return TCL_ERROR; } - tkwin = Tk_HWNDToWindow((HWND) number); + tkwin = Tk_HWNDToWindow(win.hwnd); if (tkwin) { *idPtr = Tk_WindowId(tkwin); } else { @@ -323,7 +328,7 @@ XDestroyWindow( Tcl_DeleteHashEntry(entryPtr); } - ckfree((char *)twdPtr); + ckfree(twdPtr); /* * Don't bother destroying the window if we are going to destroy the @@ -794,27 +799,174 @@ TkWinSetWindowPos( /* *---------------------------------------------------------------------- * - * TkpWindowWasRecentlyDeleted -- + * TkpShowBusyWindow -- * - * Determines whether we know if the window given as argument was - * recently deleted. Called by the generic code error handler to handle - * BadWindow events. + * Makes a busy window "appear". * * Results: - * Always 0. We do not keep this information on Windows. + * None. * * Side effects: + * Arranges for the busy window to start intercepting events and the + * cursor to change to the configured "hey, I'm busy!" setting. + * + *---------------------------------------------------------------------- + */ + +void +TkpShowBusyWindow( + TkBusy busy) +{ + Busy *busyPtr = (Busy *) busy; + HWND hWnd; + POINT point; + Display *display; + Window window; + + if (busyPtr->tkBusy != NULL) { + Tk_MapWindow(busyPtr->tkBusy); + window = Tk_WindowId(busyPtr->tkBusy); + display = Tk_Display(busyPtr->tkBusy); + hWnd = Tk_GetHWND(window); + display->request++; + SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE); + } + + /* + * Under Win32, cursors aren't associated with windows. Tk fakes this by + * watching Motion events on its windows. So Tk will automatically change + * the cursor when the pointer enters the Busy window. But Windows does + * not immediately change the cursor; it waits for the cursor position to + * change or a system call. We need to change the cursor before the + * application starts processing, so set the cursor position redundantly + * back to the current position. + */ + + GetCursorPos(&point); + SetCursorPos(point.x, point.y); +} + +/* + *---------------------------------------------------------------------- + * + * TkpHideBusyWindow -- + * + * Makes a busy window "disappear". + * + * Results: * None. * + * Side effects: + * Arranges for the busy window to stop intercepting events, and the + * cursor to change back to its normal setting. + * *---------------------------------------------------------------------- */ -int -TkpWindowWasRecentlyDeleted( - Window win, - TkDisplay *dispPtr) +void +TkpHideBusyWindow( + TkBusy busy) { - return 0; + Busy *busyPtr = (Busy *) busy; + POINT point; + + if (busyPtr->tkBusy != NULL) { + Tk_UnmapWindow(busyPtr->tkBusy); + } + + /* + * Under Win32, cursors aren't associated with windows. Tk fakes this by + * watching Motion events on its windows. So Tk will automatically change + * the cursor when the pointer enters the Busy window. But Windows does + * not immediately change the cursor: it waits for the cursor position to + * change or a system call. We need to change the cursor before the + * application starts processing, so set the cursor position redundantly + * back to the current position. + */ + + GetCursorPos(&point); + SetCursorPos(point.x, point.y); +} + +/* + *---------------------------------------------------------------------- + * + * TkpMakeTransparentWindowExist -- + * + * Construct the platform-specific resources for a transparent window. + * + * Results: + * None. + * + * Side effects: + * Moves the specified window in the stacking order. + * + *---------------------------------------------------------------------- + */ + +void +TkpMakeTransparentWindowExist( + Tk_Window tkwin, /* Token for window. */ + Window parent) /* Parent window. */ +{ + TkWindow *winPtr = (TkWindow *) tkwin; + HWND hParent = (HWND) parent, hWnd; + int style = WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS; + DWORD exStyle = WS_EX_TRANSPARENT | WS_EX_TOPMOST; + + hWnd = CreateWindowEx(exStyle, TK_WIN_CHILD_CLASS_NAME, NULL, style, + Tk_X(tkwin), Tk_Y(tkwin), Tk_Width(tkwin), Tk_Height(tkwin), + hParent, NULL, Tk_GetHINSTANCE(), NULL); + winPtr->window = Tk_AttachHWND(tkwin, hWnd); +} + +/* + *---------------------------------------------------------------------- + * + * TkpCreateBusy -- + * + * Construct the platform-specific parts of a busy window. Note that this + * postpones the actual creation of the window resource until later. + * + * Results: + * None. + * + * Side effects: + * Sets up part of the busy window structure. + * + *---------------------------------------------------------------------- + */ + +void +TkpCreateBusy( + Tk_FakeWin *winPtr, + Tk_Window tkRef, + Window *parentPtr, + Tk_Window tkParent, + TkBusy busy) +{ + Busy *busyPtr = (Busy *) busy; + + if (winPtr->flags & TK_REPARENTED) { + /* + * This works around a bug in the implementation of menubars for + * non-Macintosh window systems (Win32 and X11). Tk doesn't reset the + * pointers to the parent window when the menu is reparented + * (winPtr->parentPtr points to the wrong window). We get around this + * by determining the parent via the native API calls. + */ + + HWND hWnd = GetParent(Tk_GetHWND(Tk_WindowId(tkRef))); + RECT rect; + + if (GetWindowRect(hWnd, &rect)) { + busyPtr->width = rect.right - rect.left; + busyPtr->height = rect.bottom - rect.top; + } + } else { + *parentPtr = Tk_WindowId(tkParent); + *parentPtr = (Window) Tk_GetHWND(*parentPtr); + } } /* diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 2c3b0e4..768ee69 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -58,7 +58,7 @@ typedef struct ProtocolHandler { * same top-level window, or NULL for end of * list. */ Tcl_Interp *interp; /* Interpreter in which to invoke command. */ - char command[4]; /* Tcl command to invoke when a client message + char command[1]; /* Tcl command to invoke when a client message * for this protocol arrives. The actual size * of the structure varies to accommodate the * needs of the actual command. THIS MUST BE @@ -66,7 +66,7 @@ typedef struct ProtocolHandler { } ProtocolHandler; #define HANDLER_SIZE(cmdLength) \ - ((unsigned) (sizeof(ProtocolHandler) - 3 + cmdLength)) + ((unsigned) ((Tk_Offset(ProtocolHandler, command) + 1) + cmdLength)) /* * Helper type passed via lParam to TkWmStackorderToplevelEnumProc @@ -74,7 +74,7 @@ typedef struct ProtocolHandler { typedef struct TkWmStackorderToplevelPair { Tcl_HashTable *table; - TkWindow **window_ptr; + TkWindow **windowPtr; } TkWmStackorderToplevelPair; /* @@ -148,7 +148,7 @@ typedef struct { */ typedef struct WinIconInstance { - int refCount; /* Number of instances that share this data + size_t refCount; /* Number of instances that share this data * structure. */ BlockOfIconImagesPtr iconBlock; /* Pointer to icon resource data for image */ @@ -395,23 +395,6 @@ static Tcl_ThreadDataKey dataKey; static int initialized; /* Flag indicating whether module has been * initialized. */ -/* - * A pointer to a shell proc which allows us to extract icons from any file. - * We just initialize this when we start up (if we can) and then it never - * changes - */ - -DWORD* (WINAPI *shgetfileinfoProc) (LPCTSTR pszPath, DWORD dwFileAttributes, - SHFILEINFO* psfi, UINT cbFileInfo, UINT uFlags) = NULL; - -/* - * A pointer to SetLayeredWindowAttributes (user32.dll) which we retrieve - * dynamically because it is only valid on Win2K+. - */ - -BOOL (WINAPI *setLayeredWindowAttributesProc) (HWND hwnd, COLORREF crKey, - BYTE bAlpha, DWORD dwFlags) = NULL; - TCL_DECLARE_MUTEX(winWmMutex) /* @@ -432,7 +415,7 @@ static int InstallColormaps(HWND hwnd, int message, int isForemost); static void InvalidateSubTree(TkWindow *winPtr, Colormap colormap); static void InvalidateSubTreeDepth(TkWindow *winPtr); -static int ParseGeometry(Tcl_Interp *interp, char *string, +static int ParseGeometry(Tcl_Interp *interp, const char *string, TkWindow *winPtr); static void RefreshColormap(Colormap colormap, TkDisplay *dispPtr); static void SetLimits(HWND hwnd, MINMAXINFO *info); @@ -650,7 +633,7 @@ static LPSTR FindDIBBits( LPSTR lpbi) { - return lpbi + *(LPDWORD)lpbi + PaletteSize(lpbi); + return lpbi + *((LPDWORD) lpbi) + PaletteSize(lpbi); } /* @@ -706,7 +689,7 @@ AdjustIconImagePointers( * BITMAPINFO is at beginning of bits. */ - lpImage->lpbi = (LPBITMAPINFO)lpImage->lpBits; + lpImage->lpbi = (LPBITMAPINFO) lpImage->lpBits; /* * Width - simple enough. @@ -732,14 +715,14 @@ AdjustIconImagePointers( * XOR bits follow the header and color table. */ - lpImage->lpXOR = (LPBYTE)FindDIBBits(((LPSTR)lpImage->lpbi)); + lpImage->lpXOR = (LPBYTE) FindDIBBits((LPSTR) lpImage->lpbi); /* * AND bits follow the XOR bits. */ - lpImage->lpAND = lpImage->lpXOR + (lpImage->Height* - BytesPerLine((LPBITMAPINFOHEADER)(lpImage->lpbi))); + lpImage->lpAND = lpImage->lpXOR + + lpImage->Height*BytesPerLine((LPBITMAPINFOHEADER) lpImage->lpbi); return TRUE; } @@ -762,49 +745,30 @@ MakeIconOrCursorFromResource( LPICONIMAGE lpIcon, BOOL isIcon) { - HICON hIcon ; - static FARPROC pfnCreateIconFromResourceEx=NULL; - static int initinfo=0; + HICON hIcon; /* * Sanity Check */ - if (lpIcon == NULL) { + if (lpIcon == NULL || lpIcon->lpBits == NULL) { return NULL; } - if (lpIcon->lpBits == NULL) { - return NULL; - } - - if (!initinfo) { - HMODULE hMod = GetModuleHandleA("USER32.DLL"); - - initinfo = 1; - if (hMod) { - pfnCreateIconFromResourceEx = - GetProcAddress(hMod, "CreateIconFromResourceEx"); - } - } /* * Let the OS do the real work :) */ - if (pfnCreateIconFromResourceEx != NULL) { - hIcon = (HICON) (pfnCreateIconFromResourceEx) (lpIcon->lpBits, - lpIcon->dwNumBytes, isIcon, 0x00030000, - (*(LPBITMAPINFOHEADER)(lpIcon->lpBits)).biWidth, - (*(LPBITMAPINFOHEADER)(lpIcon->lpBits)).biHeight/2, 0); - } else { - hIcon = NULL; - } + hIcon = (HICON) CreateIconFromResourceEx(lpIcon->lpBits, + lpIcon->dwNumBytes, isIcon, 0x00030000, + (*(LPBITMAPINFOHEADER) lpIcon->lpBits).biWidth, + (*(LPBITMAPINFOHEADER) lpIcon->lpBits).biHeight/2, 0); /* * It failed, odds are good we're on NT so try the non-Ex way. */ - if (hIcon == NULL) { + if (hIcon == NULL) { /* * We would break on NT if we try with a 16bpp image. */ @@ -892,40 +856,20 @@ static int InitWindowClass( WinIconPtr titlebaricon) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (! tsdPtr->initialized) { + if (!tsdPtr->initialized) { tsdPtr->initialized = 1; tsdPtr->firstWindow = 1; tsdPtr->iconPtr = NULL; } - if (! initialized) { + if (!initialized) { Tcl_MutexLock(&winWmMutex); - if (! initialized) { - Tcl_DString classString; + if (!initialized) { WNDCLASS class; - initialized = 1; - if (shgetfileinfoProc == NULL) { - HINSTANCE hInstance = LoadLibraryA("shell32"); - if (hInstance != NULL) { - shgetfileinfoProc = (DWORD* (WINAPI *) (LPCTSTR pszPath, - DWORD dwFileAttributes, SHFILEINFO* psfi, - UINT cbFileInfo, UINT uFlags)) - GetProcAddress(hInstance, "SHGetFileInfo"); - FreeLibrary(hInstance); - } - } - if (setLayeredWindowAttributesProc == NULL) { - HINSTANCE hInstance = LoadLibraryA("user32"); - if (hInstance != NULL) { - setLayeredWindowAttributesProc = (BOOL (WINAPI*)(HWND hwnd, - COLORREF crKey, BYTE bAlpha, DWORD dwFlags)) - GetProcAddress(hInstance,"SetLayeredWindowAttributes"); - FreeLibrary(hInstance); - } - } + initialized = 1; /* * The only difference between WNDCLASSW and WNDCLASSA are in @@ -936,11 +880,10 @@ InitWindowClass( class.style = CS_HREDRAW | CS_VREDRAW; class.hInstance = Tk_GetHINSTANCE(); - Tcl_WinUtfToTChar(TK_WIN_TOPLEVEL_CLASS_NAME, -1, &classString); - class.lpszClassName = (LPCTSTR) Tcl_DStringValue(&classString); + class.lpszClassName = TK_WIN_TOPLEVEL_CLASS_NAME; class.lpfnWndProc = WmProc; if (titlebaricon == NULL) { - class.hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk"); + class.hIcon = LoadIcon(Tk_GetHINSTANCE(), TEXT("tk")); } else { class.hIcon = GetIcon(titlebaricon, ICON_BIG); if (class.hIcon == NULL) { @@ -956,11 +899,9 @@ InitWindowClass( } class.hCursor = LoadCursor(NULL, IDC_ARROW); - if (!(*tkWinProcs->registerClass)(&class)) { + if (!RegisterClass(&class)) { Tcl_Panic("Unable to register TkTopLevel class"); } - - Tcl_DStringFree(&classString); } Tcl_MutexUnlock(&winWmMutex); } @@ -1031,8 +972,10 @@ WinSetIcon( } if (!(Tk_IsTopLevel(tkw))) { - Tcl_AppendResult(interp, "window \"", Tk_PathName(tkw), - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", Tk_PathName(tkw))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", Tk_PathName(tkw), + NULL); return TCL_ERROR; } if (Tk_WindowId(tkw) == None) { @@ -1043,7 +986,7 @@ WinSetIcon( * We must get the window's wrapper, not the window itself. */ - wmPtr = ((TkWindow*)tkw)->wmInfoPtr; + wmPtr = ((TkWindow *) tkw)->wmInfoPtr; hwnd = wmPtr->wrapper; if (application) { @@ -1065,7 +1008,9 @@ WinSetIcon( if (!initialized) { if (InitWindowClass(titlebaricon) != TCL_OK) { - Tcl_AppendResult(interp, "Unable to set icon", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Unable to set icon", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "FAILED", NULL); return TCL_ERROR; } } else { @@ -1104,7 +1049,7 @@ WinSetIcon( /* * The following code is exercised if you do * - * toplevel .t ; wm titlebaricon .t foo.icr + * toplevel .t ; wm titlebaricon .t foo.icr * * i.e. the wm hasn't had time to properly create the '.t' window * before you set the icon. @@ -1117,11 +1062,12 @@ WinSetIcon( */ UpdateWrapper(wmPtr->winPtr); - wmPtr = ((TkWindow*)tkw)->wmInfoPtr; + wmPtr = ((TkWindow *) tkw)->wmInfoPtr; hwnd = wmPtr->wrapper; if (hwnd == NULL) { - Tcl_AppendResult(interp, - "Can't set icon; window has no wrapper.", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Can't set icon; window has no wrapper.", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "WRAPPER", NULL); return TCL_ERROR; } } @@ -1176,7 +1122,7 @@ TkWinGetIcon( { WmInfo *wmPtr; HICON icon; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->iconPtr != NULL) { @@ -1184,7 +1130,7 @@ TkWinGetIcon( * return default toplevel icon */ - return GetIcon(tsdPtr->iconPtr, (int)iconsize); + return GetIcon(tsdPtr->iconPtr, (int) iconsize); } /* @@ -1208,7 +1154,7 @@ TkWinGetIcon( * return window toplevel icon */ - return GetIcon(wmPtr->iconPtr, (int)iconsize); + return GetIcon(wmPtr->iconPtr, (int) iconsize); } /* @@ -1270,11 +1216,13 @@ ReadIconFromFile( WinIconPtr titlebaricon = NULL; BlockOfIconImagesPtr lpIR; +#if 0 /* TODO: Dead code? */ if (0 /* If we already have an icon for this filename */) { titlebaricon = NULL; /* Get the real value from a lookup */ titlebaricon->refCount++; return titlebaricon; } +#endif /* * First check if it is a .ico file. @@ -1288,7 +1236,7 @@ ReadIconFromFile( * switching) display uses the right icon. */ - if (lpIR == NULL && shgetfileinfoProc != NULL) { + if (lpIR == NULL) { SHFILEINFO sfiSM; Tcl_DString ds, ds2; DWORD *res; @@ -1298,9 +1246,9 @@ ReadIconFromFile( if (file == NULL) { return NULL; } - Tcl_UtfToExternalDString(NULL, file, -1, &ds2); + Tcl_WinUtfToTChar(file, -1, &ds2); Tcl_DStringFree(&ds); - res = (*shgetfileinfoProc)(Tcl_DStringValue(&ds2), 0, &sfiSM, + res = (DWORD *)SHGetFileInfo((TCHAR *)Tcl_DStringValue(&ds2), 0, &sfiSM, sizeof(SHFILEINFO), SHGFI_SMALLICON|SHGFI_ICON); if (res != 0) { @@ -1308,7 +1256,7 @@ ReadIconFromFile( unsigned size; Tcl_ResetResult(interp); - res = (*shgetfileinfoProc)(Tcl_DStringValue(&ds2), 0, &sfi, + res = (DWORD *)SHGetFileInfo((TCHAR *)Tcl_DStringValue(&ds2), 0, &sfi, sizeof(SHFILEINFO), SHGFI_ICON); /* @@ -1317,7 +1265,7 @@ ReadIconFromFile( size = sizeof(BlockOfIconImages) + ((res != 0) ? sizeof(ICONIMAGE) : 0); - lpIR = (BlockOfIconImagesPtr) ckalloc(size); + lpIR = ckalloc(size); if (lpIR == NULL) { if (res != 0) { DestroyIcon(sfi.hIcon); @@ -1348,7 +1296,7 @@ ReadIconFromFile( Tcl_DStringFree(&ds2); } if (lpIR != NULL) { - titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance)); + titlebaricon = ckalloc(sizeof(WinIconInstance)); titlebaricon->iconBlock = lpIR; titlebaricon->refCount = 1; } @@ -1393,7 +1341,7 @@ GetIconFromPixmap( Pixmap pixmap) { WinIconPtr titlebaricon = NULL; - TkWinDrawable *twdPtr = (TkWinDrawable*) pixmap; + TkWinDrawable *twdPtr = (TkWinDrawable *) pixmap; BlockOfIconImagesPtr lpIR; ICONINFO icon; HICON hIcon; @@ -1403,11 +1351,13 @@ GetIconFromPixmap( return NULL; } +#if 0 /* TODO: Dead code?*/ if (0 /* If we already have an icon for this pixmap */) { titlebaricon = NULL; /* Get the real value from a lookup */ titlebaricon->refCount++; return titlebaricon; } +#endif Tk_SizeOfBitmap(dsPtr, pixmap, &width, &height); @@ -1422,7 +1372,7 @@ GetIconFromPixmap( return NULL; } - lpIR = (BlockOfIconImagesPtr) ckalloc(sizeof(BlockOfIconImages)); + lpIR = ckalloc(sizeof(BlockOfIconImages)); if (lpIR == NULL) { DestroyIcon(hIcon); return NULL; @@ -1443,7 +1393,7 @@ GetIconFromPixmap( lpIR->IconImages[0].lpXOR = 0; lpIR->IconImages[0].lpAND = 0; - titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance)); + titlebaricon = ckalloc(sizeof(WinIconInstance)); titlebaricon->iconBlock = lpIR; titlebaricon->refCount = 1; return titlebaricon; @@ -1471,15 +1421,13 @@ static void DecrIconRefCount( WinIconPtr titlebaricon) { - titlebaricon->refCount--; - - if (titlebaricon->refCount <= 0) { + if (titlebaricon->refCount-- <= 1) { if (titlebaricon->iconBlock != NULL) { FreeIconBlock(titlebaricon->iconBlock); } titlebaricon->iconBlock = NULL; - ckfree((char*)titlebaricon); + ckfree(titlebaricon); } } @@ -1510,15 +1458,15 @@ FreeIconBlock( * Free all the bits. */ - for (i=0; i< lpIR->nNumImages; i++) { + for (i=0 ; i<lpIR->nNumImages ; i++) { if (lpIR->IconImages[i].lpBits != NULL) { - ckfree((char*)lpIR->IconImages[i].lpBits); + ckfree(lpIR->IconImages[i].lpBits); } if (lpIR->IconImages[i].hIcon != NULL) { DestroyIcon(lpIR->IconImages[i].hIcon); } } - ckfree ((char*)lpIR); + ckfree(lpIR); } /* @@ -1540,6 +1488,8 @@ GetIcon( int icon_size) { BlockOfIconImagesPtr lpIR; + unsigned int size = (icon_size == 0 ? 16 : 32); + int i; if (titlebaricon == NULL) { return NULL; @@ -1548,30 +1498,27 @@ GetIcon( lpIR = titlebaricon->iconBlock; if (lpIR == NULL) { return NULL; - } else { - unsigned int size = (icon_size == 0 ? 16 : 32); - int i; - - for (i = 0; i < lpIR->nNumImages; i++) { - /* - * Take the first or a 32x32 16 color icon - */ - - if ((lpIR->IconImages[i].Height == size) - && (lpIR->IconImages[i].Width == size) - && (lpIR->IconImages[i].Colors >= 4)) { - return lpIR->IconImages[i].hIcon; - } - } + } + for (i=0 ; i<lpIR->nNumImages ; i++) { /* - * If we get here, then just return the first one, it will have to do! + * Take the first or a 32x32 16 color icon */ - if (lpIR->nNumImages >= 1) { - return lpIR->IconImages[0].hIcon; + if ((lpIR->IconImages[i].Height == size) + && (lpIR->IconImages[i].Width == size) + && (lpIR->IconImages[i].Colors >= 4)) { + return lpIR->IconImages[i].hIcon; } } + + /* + * If we get here, then just return the first one, it will have to do! + */ + + if (lpIR->nNumImages >= 1) { + return lpIR->IconImages[0].hIcon; + } return NULL; } @@ -1589,7 +1536,7 @@ TclWinReadCursorFromFile( return NULL; } if (lpIR->nNumImages >= 1) { - res = CopyImage(lpIR->IconImages[0].hIcon, IMAGE_CURSOR,0,0,0); + res = CopyImage(lpIR->IconImages[0].hIcon, IMAGE_CURSOR, 0, 0, 0); } FreeIconBlock(lpIR); return res; @@ -1631,8 +1578,9 @@ ReadIconOrCursorFromFile( channel = Tcl_FSOpenFileChannel(interp, fileName, "r", 0); if (channel == NULL) { - Tcl_AppendResult(interp,"Error opening file \"", - Tcl_GetString(fileName), "\" for reading", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error opening file \"%s\" for reading: %s", + Tcl_GetString(fileName), Tcl_PosixError(interp))); return NULL; } if (Tcl_SetChannelOption(interp, channel, "-translation", "binary") @@ -1650,16 +1598,17 @@ ReadIconOrCursorFromFile( * Allocate memory for the resource structure */ - lpIR = (BlockOfIconImagesPtr) ckalloc(sizeof(BlockOfIconImages)); + lpIR = ckalloc(sizeof(BlockOfIconImages)); /* * Read in the header */ - if ((lpIR->nNumImages = ReadICOHeader(channel)) == -1) { - Tcl_AppendResult(interp, "Invalid file header", NULL); + lpIR->nNumImages = ReadICOHeader(channel); + if (lpIR->nNumImages == -1) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid file header", -1)); Tcl_Close(NULL, channel); - ckfree((char*) lpIR); + ckfree(lpIR); return NULL; } @@ -1667,27 +1616,28 @@ ReadIconOrCursorFromFile( * Adjust the size of the struct to account for the images. */ - lpIR = (BlockOfIconImagesPtr) ckrealloc((char*) lpIR, - sizeof(BlockOfIconImages) - + ((lpIR->nNumImages - 1) * sizeof(ICONIMAGE))); + lpIR = ckrealloc(lpIR, sizeof(BlockOfIconImages) + + (lpIR->nNumImages - 1) * sizeof(ICONIMAGE)); /* * Allocate enough memory for the icon directory entries. */ - lpIDE = (LPICONDIRENTRY) ckalloc(lpIR->nNumImages * sizeof(ICONDIRENTRY)); + lpIDE = ckalloc(lpIR->nNumImages * sizeof(ICONDIRENTRY)); /* * Read in the icon directory entries. */ - dwBytesRead = Tcl_Read(channel, (char*) lpIDE, - (int)(lpIR->nNumImages * sizeof(ICONDIRENTRY))); + dwBytesRead = Tcl_Read(channel, (char *) lpIDE, + (int) (lpIR->nNumImages * sizeof(ICONDIRENTRY))); if (dwBytesRead != lpIR->nNumImages * sizeof(ICONDIRENTRY)) { - Tcl_AppendResult(interp, "Error reading file", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading file: %s", Tcl_PosixError(interp))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "READ", NULL); Tcl_Close(NULL, channel); - ckfree((char *) lpIDE); - ckfree((char *) lpIR); + ckfree(lpIDE); + ckfree(lpIR); return NULL; } @@ -1708,7 +1658,7 @@ ReadIconOrCursorFromFile( * Allocate memory for the resource. */ - lpIR->IconImages[i].lpBits = (LPBYTE) ckalloc(lpIDE[i].dwBytesInRes); + lpIR->IconImages[i].lpBits = ckalloc(lpIDE[i].dwBytesInRes); lpIR->IconImages[i].dwNumBytes = lpIDE[i].dwBytesInRes; /* @@ -1716,7 +1666,8 @@ ReadIconOrCursorFromFile( */ if (Tcl_Seek(channel, lpIDE[i].dwImageOffset, FILE_BEGIN) == -1) { - Tcl_AppendResult(interp, "Error seeking in file", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error seeking in file: %s", Tcl_PosixError(interp))); goto readError; } @@ -1724,10 +1675,11 @@ ReadIconOrCursorFromFile( * Read it in. */ - dwBytesRead = Tcl_Read(channel, (char *) lpIR->IconImages[i].lpBits, + dwBytesRead = Tcl_Read(channel, (char *)lpIR->IconImages[i].lpBits, (int) lpIDE[i].dwBytesInRes); if (dwBytesRead != lpIDE[i].dwBytesInRes) { - Tcl_AppendResult(interp, "Error reading file", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading file: %s", Tcl_PosixError(interp))); goto readError; } @@ -1735,37 +1687,33 @@ ReadIconOrCursorFromFile( * Set the internal pointers appropriately. */ - if (!AdjustIconImagePointers( &(lpIR->IconImages[i]))) { - Tcl_AppendResult(interp, "Error converting to internal format", - NULL); + if (!AdjustIconImagePointers(&lpIR->IconImages[i])) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Error converting to internal format", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICON", "FORMAT", NULL); goto readError; } lpIR->IconImages[i].hIcon = - MakeIconOrCursorFromResource(&(lpIR->IconImages[i]), isIcon); + MakeIconOrCursorFromResource(&lpIR->IconImages[i], isIcon); } /* * Clean up */ - ckfree((char *) lpIDE); + ckfree(lpIDE); Tcl_Close(NULL, channel); - if (lpIR == NULL){ - Tcl_AppendResult(interp, "Reading of ", Tcl_GetString(fileName), - " failed!", NULL); - return NULL; - } return lpIR; readError: Tcl_Close(NULL, channel); for (i = 0; i < lpIR->nNumImages; i++) { if (lpIR->IconImages[i].lpBits != NULL) { - ckfree((char *) lpIR->IconImages[i].lpBits); + ckfree(lpIR->IconImages[i].lpBits); } } - ckfree((char *) lpIDE); - ckfree((char *) lpIR); + ckfree(lpIDE); + ckfree(lpIR); return NULL; } @@ -1789,7 +1737,7 @@ static TkWindow * GetTopLevel( HWND hwnd) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* @@ -1931,8 +1879,7 @@ TkWinWmCleanup( } initialized = 0; - tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { return; @@ -1963,9 +1910,7 @@ void TkWmNewWindow( TkWindow *winPtr) /* Newly-created top-level window. */ { - register WmInfo *wmPtr; - - wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo)); + register WmInfo *wmPtr = ckalloc(sizeof(WmInfo)); /* * Initialize full structure, then set what isn't NULL @@ -2002,7 +1947,7 @@ TkWmNewWindow( wmPtr->x = winPtr->changes.x; wmPtr->y = winPtr->changes.y; wmPtr->crefObj = NULL; - wmPtr->colorref = (COLORREF)0; + wmPtr->colorref = (COLORREF) 0; wmPtr->alpha = 1.0; wmPtr->configWidth = -1; @@ -2017,14 +1962,14 @@ TkWmNewWindow( */ Tk_CreateEventHandler((Tk_Window) winPtr, StructureNotifyMask, - TopLevelEventProc, (ClientData) winPtr); + TopLevelEventProc, winPtr); /* * Arrange for geometry requests to be reflected from the window to the * window manager. */ - Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, (ClientData) 0); + Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, NULL); } /* @@ -2057,9 +2002,9 @@ UpdateWrapper( WINDOWPLACEMENT place; HICON hSmallIcon = NULL; HICON hBigIcon = NULL; - Tcl_DString titleString, classString; + Tcl_DString titleString; int *childStateInfo = NULL; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (winPtr->window == None) { @@ -2092,7 +2037,6 @@ UpdateWrapper( if (!IsWindow(wmPtr->wrapper)) { Tcl_Panic("UpdateWrapper: Container was destroyed"); } - } else { /* * Pick the decorative frame style. Override redirect windows get @@ -2127,8 +2071,8 @@ UpdateWrapper( wmPtr->style = WM_TRANSIENT_STYLE; wmPtr->exStyle = EX_TRANSIENT_STYLE; parentHWND = Tk_GetHWND(Tk_WindowId(wmPtr->masterPtr)); - if (! ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) && - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE))) { + if (! ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) + && (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE))) { wmPtr->style |= WS_THICKFRAME; } } else { @@ -2149,7 +2093,7 @@ UpdateWrapper( */ wmPtr->flags |= WM_CREATE_PENDING|WM_MOVE_PENDING; - UpdateGeometryInfo((ClientData)winPtr); + UpdateGeometryInfo(winPtr); wmPtr->flags &= ~(WM_CREATE_PENDING|WM_MOVE_PENDING); width = wmPtr->borderWidth + winPtr->changes.width; @@ -2185,33 +2129,30 @@ UpdateWrapper( Tcl_WinUtfToTChar(((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), -1, &titleString); - Tcl_WinUtfToTChar(TK_WIN_TOPLEVEL_CLASS_NAME, -1, &classString); - - wmPtr->wrapper = (*tkWinProcs->createWindowEx)(wmPtr->exStyle, - (LPCTSTR) Tcl_DStringValue(&classString), + wmPtr->wrapper = CreateWindowEx(wmPtr->exStyle, + TK_WIN_TOPLEVEL_CLASS_NAME, (LPCTSTR) Tcl_DStringValue(&titleString), wmPtr->style, x, y, width, height, parentHWND, NULL, Tk_GetHINSTANCE(), NULL); - Tcl_DStringFree(&classString); Tcl_DStringFree(&titleString); - SetWindowLongPtr(wmPtr->wrapper, GWLP_USERDATA, (INT_PTR) winPtr); + SetWindowLongPtr(wmPtr->wrapper, GWLP_USERDATA, (LONG_PTR) winPtr); tsdPtr->createWindow = NULL; - if ((wmPtr->exStyleConfig & WS_EX_LAYERED) - && setLayeredWindowAttributesProc != NULL) { + if (wmPtr->exStyleConfig & WS_EX_LAYERED) { /* * The user supplies a double from [0..1], but Windows wants an * int (transparent) 0..255 (opaque), so do the translation. Add * the 0.5 to round the value. */ - setLayeredWindowAttributesProc((HWND) wmPtr->wrapper, + SetLayeredWindowAttributes((HWND) wmPtr->wrapper, wmPtr->colorref, (BYTE) (wmPtr->alpha * 255 + 0.5), (unsigned)(LWA_ALPHA | (wmPtr->crefObj?LWA_COLORKEY:0))); } else { /* * Layering not used or supported. */ + wmPtr->alpha = 1.0; if (wmPtr->crefObj) { Tcl_DecrRefCount(wmPtr->crefObj); @@ -2224,8 +2165,9 @@ UpdateWrapper( wmPtr->x = place.rcNormalPosition.left; wmPtr->y = place.rcNormalPosition.top; - if( !(winPtr->flags & TK_ALREADY_DEAD) ) + if (!(winPtr->flags & TK_ALREADY_DEAD)) { TkInstallFrameMenu((Tk_Window) winPtr); + } if (oldWrapper && (oldWrapper != wmPtr->wrapper) && !(wmPtr->exStyle & WS_EX_TOPMOST)) { @@ -2248,20 +2190,20 @@ UpdateWrapper( WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS); if (winPtr->flags & TK_EMBEDDED) { - SetWindowLongPtr(child, GWLP_WNDPROC, (INT_PTR) TopLevelProc); + SetWindowLongPtr(child, GWLP_WNDPROC, (LONG_PTR) TopLevelProc); } SetParent(child, wmPtr->wrapper); if (oldWrapper) { - hSmallIcon = (HICON) SendMessage(oldWrapper, WM_GETICON, ICON_SMALL, - (LPARAM) NULL); - hBigIcon = (HICON) SendMessage(oldWrapper, WM_GETICON, ICON_BIG, - (LPARAM) NULL); + hSmallIcon = (HICON) + SendMessage(oldWrapper, WM_GETICON, ICON_SMALL, (LPARAM)NULL); + hBigIcon = (HICON) + SendMessage(oldWrapper, WM_GETICON, ICON_BIG, (LPARAM) NULL); } if (oldWrapper && (oldWrapper != wmPtr->wrapper) && (oldWrapper != GetDesktopWindow())) { - SetWindowLongPtr(oldWrapper, GWLP_USERDATA, (LONG) 0); + SetWindowLongPtr(oldWrapper, GWLP_USERDATA, (LONG_PTR) 0); if (wmPtr->numTransients > 0) { /* @@ -2271,8 +2213,7 @@ UpdateWrapper( WmInfo *wmPtr2; - childStateInfo = (int *) - ckalloc((unsigned) wmPtr->numTransients * sizeof(int)); + childStateInfo = ckalloc(wmPtr->numTransients * sizeof(int)); state = 0; for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL; wmPtr2 = wmPtr2->nextPtr) { @@ -2294,11 +2235,11 @@ UpdateWrapper( } wmPtr->flags &= ~WM_NEVER_MAPPED; - if (winPtr->flags & TK_EMBEDDED - && SendMessage(wmPtr->wrapper, TK_ATTACHWINDOW, (WPARAM)child, 0)){ + if (winPtr->flags & TK_EMBEDDED && + SendMessage(wmPtr->wrapper, TK_ATTACHWINDOW, (WPARAM) child, 0)) { SendMessage(wmPtr->wrapper, TK_GEOMETRYREQ, - Tk_ReqWidth((Tk_Window)winPtr), - Tk_ReqHeight((Tk_Window)winPtr)); + Tk_ReqWidth((Tk_Window) winPtr), + Tk_ReqHeight((Tk_Window) winPtr)); SendMessage(wmPtr->wrapper, TK_SETMENU, (WPARAM) wmPtr->hMenu, (LPARAM) Tk_GetMenuHWND((Tk_Window) winPtr)); } @@ -2319,10 +2260,11 @@ UpdateWrapper( wmPtr->hints.initial_state = state; if (hSmallIcon != NULL) { - SendMessage(wmPtr->wrapper,WM_SETICON,ICON_SMALL,(LPARAM)hSmallIcon); + SendMessage(wmPtr->wrapper, WM_SETICON, ICON_SMALL, + (LPARAM) hSmallIcon); } if (hBigIcon != NULL) { - SendMessage(wmPtr->wrapper,WM_SETICON,ICON_BIG,(LPARAM)hBigIcon); + SendMessage(wmPtr->wrapper, WM_SETICON, ICON_BIG, (LPARAM) hBigIcon); } /* @@ -2334,7 +2276,7 @@ UpdateWrapper( */ if (winPtr->flags & TK_EMBEDDED) { - if(state+1 != SendMessage(wmPtr->wrapper, TK_STATE, state, 0)) { + if (state+1 != SendMessage(wmPtr->wrapper, TK_STATE, state, 0)) { TkpWmSetState(winPtr, NormalState); wmPtr->hints.initial_state = NormalState; } @@ -2370,7 +2312,7 @@ UpdateWrapper( } } - ckfree((char *) childStateInfo); + ckfree(childStateInfo); } /* @@ -2418,7 +2360,7 @@ TkWmMapWindow( * mapped. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (!tsdPtr->initialized) { @@ -2430,8 +2372,7 @@ TkWmMapWindow( * Don't map a transient if the master is not mapped. */ - if (wmPtr->masterPtr != NULL && - !Tk_IsMapped(wmPtr->masterPtr)) { + if (wmPtr->masterPtr != NULL && !Tk_IsMapped(wmPtr->masterPtr)) { wmPtr->hints.initial_state = WithdrawnState; return; } @@ -2523,7 +2464,7 @@ TkpWmSetState( } else if (state == ZoomState) { cmd = SW_SHOWMAXIMIZED; } else { - goto setStateEnd; + goto setStateEnd; } ShowWindow(wmPtr->wrapper, cmd); @@ -2659,6 +2600,7 @@ TkWmDeadWindow( winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr; } else { register WmInfo *prevPtr; + for (prevPtr = winPtr->dispPtr->firstWmPtr; ; prevPtr = prevPtr->nextPtr) { if (prevPtr == NULL) { @@ -2681,7 +2623,7 @@ TkWmDeadWindow( wmPtr->numTransients--; Tk_DeleteEventHandler((Tk_Window) wmPtr2->masterPtr, VisibilityChangeMask|StructureNotifyMask, - WmWaitVisibilityOrMapProc, (ClientData) wmPtr2->winPtr); + WmWaitVisibilityOrMapProc, wmPtr2->winPtr); wmPtr2->masterPtr = NULL; if ((wmPtr2->wrapper != None) && !(wmPtr2->flags & (WM_NEVER_MAPPED))) { @@ -2721,16 +2663,16 @@ TkWmDeadWindow( protPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr->nextPtr; - Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(protPtr, TCL_DYNAMIC); } if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + ckfree(wmPtr->cmdArgv); } if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); + ckfree(wmPtr->clientMachine); } if (wmPtr->flags & WM_UPDATE_PENDING) { - Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); } if (wmPtr->masterPtr != NULL) { wmPtr2 = wmPtr->masterPtr->wmInfoPtr; @@ -2744,7 +2686,7 @@ TkWmDeadWindow( } Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, VisibilityChangeMask|StructureNotifyMask, - WmWaitVisibilityOrMapProc, (ClientData) winPtr); + WmWaitVisibilityOrMapProc, winPtr); wmPtr->masterPtr = NULL; } if (wmPtr->crefObj != NULL) { @@ -2777,7 +2719,7 @@ TkWmDeadWindow( DecrIconRefCount(wmPtr->iconPtr); } - ckfree((char *) wmPtr); + ckfree(wmPtr); winPtr->wmInfoPtr = NULL; } @@ -2833,8 +2775,8 @@ Tk_WmObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Tk_Window tkwin = (Tk_Window) clientData; - static const char *optionStrings[] = { + Tk_Window tkwin = clientData; + static const char *const optionStrings[] = { "aspect", "attributes", "client", "colormapwindows", "command", "deiconify", "focusmodel", "forget", "frame", "geometry", "grid", "group", "iconbitmap", @@ -2847,17 +2789,20 @@ Tk_WmObjCmd( }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, - WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, WMOPT_FRAME, + WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FORGET, + WMOPT_FRAME, WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP, WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPHOTO, WMOPT_ICONPOSITION, - WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, + WMOPT_ICONWINDOW, WMOPT_MANAGE, WMOPT_MAXSIZE, WMOPT_MINSIZE, + WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, WMOPT_WITHDRAW }; - int index, length; - char *argv1; + int index; + size_t length; + const char *argv1; TkWindow *winPtr, **winPtrPtr = &winPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; @@ -2867,8 +2812,9 @@ Tk_WmObjCmd( return TCL_ERROR; } - argv1 = Tcl_GetStringFromObj(objv[1], &length); - if ((argv1[0] == 't') && !strncmp(argv1, "tracing", (unsigned) length) + argv1 = Tcl_GetString(objv[1]); + length = objv[1]->length; + if ((argv1[0] == 't') && !strncmp(argv1, "tracing", length) && (length >= 3)) { int wmTracing; @@ -2877,9 +2823,8 @@ Tk_WmObjCmd( return TCL_ERROR; } if (objc == 2) { - Tcl_SetResult(interp, - ((dispPtr->flags & TK_DISPLAY_WM_TRACING) ? "on" : "off"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + dispPtr->flags & TK_DISPLAY_WM_TRACING)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) { @@ -2893,8 +2838,8 @@ Tk_WmObjCmd( return TCL_OK; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -2906,10 +2851,12 @@ Tk_WmObjCmd( != TCL_OK) { return TCL_ERROR; } - if (!Tk_IsTopLevel(winPtr) && - (index != WMOPT_MANAGE) && (index != WMOPT_FORGET)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", NULL); + if (!Tk_IsTopLevel(winPtr) && (index != WMOPT_MANAGE) + && (index != WMOPT_FORGET)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "TOPLEVEL", winPtr->pathName, + NULL); return TCL_ERROR; } @@ -3019,12 +2966,13 @@ WmAspectCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PAspect) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x, - wmPtr->minAspect.y, wmPtr->maxAspect.x, - wmPtr->maxAspect.y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->minAspect.x); + results[1] = Tcl_NewIntObj(wmPtr->minAspect.y); + results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x); + results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -3038,7 +2986,9 @@ WmAspectCmd( return TCL_ERROR; } if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) || (denom2 <= 0)) { - Tcl_SetResult(interp, "aspect number can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "aspect number can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "ASPECT", NULL); return TCL_ERROR; } wmPtr->minAspect.x = numer1; @@ -3078,8 +3028,9 @@ WmAttributesCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; LONG style, exStyle, styleBit, *stylePtr = NULL; - char *string; - int i, boolean, length; + const char *string; + int i, boolean; + size_t length; int config_fullscreen = 0, updatewrapper = 0; int fullscreen_attr_changed = 0, fullscreen_attr = 0; @@ -3126,23 +3077,24 @@ WmAttributesCmd( return TCL_OK; } for (i = 3; i < objc; i += 2) { - string = Tcl_GetStringFromObj(objv[i], &length); + string = Tcl_GetString(objv[i]); + length = objv[i]->length; if ((length < 2) || (string[0] != '-')) { goto configArgs; } - if (strncmp(string, "-disabled", (unsigned) length) == 0) { + if (strncmp(string, "-disabled", length) == 0) { stylePtr = &style; styleBit = WS_DISABLED; - } else if ((strncmp(string, "-alpha", (unsigned) length) == 0) + } else if ((strncmp(string, "-alpha", length) == 0) || ((length > 2) && (strncmp(string, "-transparentcolor", - (unsigned) length) == 0))) { + length) == 0))) { stylePtr = &exStyle; styleBit = WS_EX_LAYERED; - } else if (strncmp(string, "-fullscreen", (unsigned) length) == 0) { + } else if (strncmp(string, "-fullscreen", length) == 0) { config_fullscreen = 1; styleBit = 0; } else if ((length > 3) - && (strncmp(string, "-toolwindow", (unsigned) length) == 0)) { + && (strncmp(string, "-toolwindow", length) == 0)) { stylePtr = &exStyle; styleBit = WS_EX_TOOLWINDOW; if (objc != 4) { @@ -3152,12 +3104,14 @@ WmAttributesCmd( updatewrapper = 1; } } else if ((length > 3) - && (strncmp(string, "-topmost", (unsigned) length) == 0)) { + && (strncmp(string, "-topmost", length) == 0)) { stylePtr = &exStyle; styleBit = WS_EX_TOPMOST; if ((i < objc-1) && (winPtr->flags & TK_EMBEDDED)) { - Tcl_AppendResult(interp, "can't set topmost flag on ", - winPtr->pathName, ": it is an embedded window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set topmost flag on %s: it is an embedded window", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "TOPMOST", NULL); return TCL_ERROR; } } else { @@ -3192,8 +3146,9 @@ WmAttributesCmd( } wmPtr->alpha = dval; } else { /* -transparentcolor */ - char *crefstr = Tcl_GetStringFromObj(objv[i+1], &length); + const char *crefstr = Tcl_GetString(objv[i+1]); + length = objv[i+1]->length; if (length == 0) { /* reset to no transparent color */ if (wmPtr->crefObj) { @@ -3221,15 +3176,15 @@ WmAttributesCmd( /* * Only ever add the WS_EX_LAYERED bit, as it can cause - * flashing to change this window style. This allows things + * flashing to change this window style. This allows things * like fading tooltips to avoid flash ugliness without * forcing all window to be layered. */ + if ((wmPtr->alpha < 1.0) || (wmPtr->crefObj != NULL)) { *stylePtr |= styleBit; } - if ((setLayeredWindowAttributesProc != NULL) - && (wmPtr->wrapper != NULL)) { + if (wmPtr->wrapper != NULL) { /* * Set the window directly regardless of UpdateWrapper. * The user supplies a double from [0..1], but Windows @@ -3241,30 +3196,30 @@ WmAttributesCmd( SetWindowLongPtr(wmPtr->wrapper, GWL_EXSTYLE, *stylePtr); } - setLayeredWindowAttributesProc((HWND) wmPtr->wrapper, + SetLayeredWindowAttributes((HWND) wmPtr->wrapper, wmPtr->colorref, (BYTE) (wmPtr->alpha * 255 + 0.5), (unsigned) (LWA_ALPHA | (wmPtr->crefObj ? LWA_COLORKEY : 0))); } } } else { - if ((i < objc-1) && - (Tcl_GetBooleanFromObj(interp, objv[i+1], &boolean) - != TCL_OK)) { + if ((i < objc-1) + && Tcl_GetBooleanFromObj(interp, objv[i+1], &boolean) + != TCL_OK) { return TCL_ERROR; } if (config_fullscreen) { if (objc == 4) { - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), - (wmPtr->flags & WM_FULLSCREEN)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + wmPtr->flags & WM_FULLSCREEN)); } else { fullscreen_attr_changed = 1; fullscreen_attr = boolean; } config_fullscreen = 0; } else if (objc == 4) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), - ((*stylePtr & styleBit) != 0)); + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(*stylePtr & styleBit)); } else if (boolean) { *stylePtr |= styleBit; } else { @@ -3276,6 +3231,7 @@ WmAttributesCmd( * Force the topmost position aspect to ensure that switching * between (no)topmost reflects properly when rewrapped. */ + SetWindowPos(wmPtr->wrapper, ((exStyle & WS_EX_TOPMOST) ? HWND_TOPMOST : HWND_NOTOPMOST), 0, 0, 0, 0, @@ -3311,10 +3267,11 @@ WmAttributesCmd( if (fullscreen_attr_changed) { if (fullscreen_attr) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, - "can't set fullscreen attribute for \"", - winPtr->pathName, "\": override-redirect flag is set", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set fullscreen attribute for \"%s\":" + " override-redirect flag is set", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", + "OVERRIDE_REDIRECT", NULL); return TCL_ERROR; } @@ -3328,10 +3285,10 @@ WmAttributesCmd( (WidthOfScreen(Tk_Screen(winPtr)) > wmPtr->maxWidth)) || ((wmPtr->maxHeight > 0) && (HeightOfScreen(Tk_Screen(winPtr)) > wmPtr->maxHeight))) { - Tcl_AppendResult(interp, - "can't set fullscreen attribute for \"", - winPtr->pathName, "\": max width/height is too small", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set fullscreen attribute for \"%s\":" + " max width/height is too small", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ATTR", "SMALL_MAX", NULL); return TCL_ERROR; } } @@ -3368,8 +3325,8 @@ WmClientCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; - int length; + const char *argv3; + size_t length; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name?"); @@ -3377,14 +3334,16 @@ WmClientCmd( } if (objc == 3) { if (wmPtr->clientMachine != NULL) { - Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(wmPtr->clientMachine, -1)); } return TCL_OK; } - argv3 = Tcl_GetStringFromObj(objv[3], &length); + argv3 = Tcl_GetString(objv[3]); + length = objv[3]->length; if (argv3[0] == 0) { if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); + ckfree(wmPtr->clientMachine); wmPtr->clientMachine = NULL; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XDeleteProperty(winPtr->display, winPtr->window, @@ -3394,11 +3353,10 @@ WmClientCmd( return TCL_OK; } if (wmPtr->clientMachine != NULL) { - ckfree((char *) wmPtr->clientMachine); + ckfree(wmPtr->clientMachine); } - wmPtr->clientMachine = (char *) - ckalloc((unsigned) (length + 1)); - strcpy(wmPtr->clientMachine, argv3); + wmPtr->clientMachine = ckalloc(length + 1); + memcpy(wmPtr->clientMachine, argv3, length + 1); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XTextProperty textProp; @@ -3438,10 +3396,9 @@ WmColormapwindowsCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - TkWindow **cmapList; - TkWindow *winPtr2, **winPtr2Ptr = &winPtr2; + TkWindow **cmapList, *winPtr2, **winPtr2Ptr = &winPtr2; int i, windowObjc, gotToplevel; - Tcl_Obj **windowObjv; + Tcl_Obj **windowObjv, *resultObj; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?windowList?"); @@ -3449,26 +3406,28 @@ WmColormapwindowsCmd( } if (objc == 3) { Tk_MakeWindowExist((Tk_Window) winPtr); + resultObj = Tcl_NewObj(); for (i = 0; i < wmPtr->cmapCount; i++) { if ((i == (wmPtr->cmapCount-1)) && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) { break; } - Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName); + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) wmPtr->cmapList[i])); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (Tcl_ListObjGetElements(interp, objv[3], &windowObjc, &windowObjv) != TCL_OK) { return TCL_ERROR; } - cmapList = (TkWindow **) ckalloc((unsigned) - ((windowObjc+1)*sizeof(TkWindow*))); + cmapList = ckalloc((windowObjc + 1) * sizeof(TkWindow*)); gotToplevel = 0; for (i = 0; i < windowObjc; i++) { if (TkGetWindowFromObj(interp, tkwin, windowObjv[i], (Tk_Window *) winPtr2Ptr) != TCL_OK) { - ckfree((char *) cmapList); + ckfree(cmapList); return TCL_ERROR; } if (winPtr2 == winPtr) { @@ -3488,7 +3447,7 @@ WmColormapwindowsCmd( } wmPtr->flags |= WM_COLORMAPS_EXPLICIT; if (wmPtr->cmapList != NULL) { - ckfree((char *)wmPtr->cmapList); + ckfree(wmPtr->cmapList); } wmPtr->cmapList = cmapList; wmPtr->cmapCount = windowObjc; @@ -3531,7 +3490,7 @@ WmCommandCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; + const char *argv3; int cmdArgc; const char **cmdArgv; @@ -3541,15 +3500,17 @@ WmCommandCmd( } if (objc == 3) { if (wmPtr->cmdArgv != NULL) { - Tcl_SetResult(interp, - Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv), TCL_DYNAMIC); + char *merged = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv); + + Tcl_SetObjResult(interp, Tcl_NewStringObj(merged, -1)); + ckfree(merged); } return TCL_OK; } argv3 = Tcl_GetString(objv[3]); if (argv3[0] == 0) { if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + ckfree(wmPtr->cmdArgv); wmPtr->cmdArgv = NULL; if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XDeleteProperty(winPtr->display, winPtr->window, @@ -3562,7 +3523,7 @@ WmCommandCmd( return TCL_ERROR; } if (wmPtr->cmdArgv != NULL) { - ckfree((char *) wmPtr->cmdArgv); + ckfree(wmPtr->cmdArgv); } wmPtr->cmdArgc = cmdArgc; wmPtr->cmdArgv = cmdArgv; @@ -3604,14 +3565,18 @@ WmDeiconifyCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't deiconify ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "DEICONIFY", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { if (!SendMessage(wmPtr->wrapper, TK_DEICONIFY, 0, 0)) { - Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName, - ": the container does not support the request", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't deiconify %s: the container does not support the request", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } return TCL_OK; @@ -3646,7 +3611,7 @@ WmFocusmodelCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "active", "passive", NULL }; enum options { @@ -3659,13 +3624,13 @@ WmFocusmodelCmd( return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + wmPtr->hints.input ? "passive" : "active", -1)); return TCL_OK; } - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0,&index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_ACTIVE) { @@ -3694,14 +3659,14 @@ WmFocusmodelCmd( */ static int -WmForgetCmd(tkwin, winPtr, interp, objc, objv) - Tk_Window tkwin; /* Main window of the application. */ - TkWindow *winPtr; /* Toplevel or Frame to work with */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *const objv[]; /* Argument objects. */ +WmForgetCmd( + Tk_Window tkwin, /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel or Frame to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - register Tk_Window frameWin = (Tk_Window)winPtr; + register Tk_Window frameWin = (Tk_Window) winPtr; if (Tk_IsTopLevel(frameWin)) { Tk_UnmapWindow(frameWin); @@ -3716,7 +3681,8 @@ WmForgetCmd(tkwin, winPtr, interp, objc, objv) /* Already not managed by wm - ignore it */ } return TCL_OK; -} +} + /* *---------------------------------------------------------------------- * @@ -3744,7 +3710,6 @@ WmFrameCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; HWND hwnd; - char buf[TCL_INTEGER_SPACE]; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "window"); @@ -3757,8 +3722,7 @@ WmFrameCmd( if (hwnd == NULL) { hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr)); } - sprintf(buf, "0x%x", PTR2INT(hwnd)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("0x%x", PTR2INT(hwnd))); return TCL_OK; } @@ -3790,16 +3754,14 @@ WmGeometryCmd( register WmInfo *wmPtr = winPtr->wmInfoPtr; char xSign, ySign; int width, height; - char *argv3; + const char *argv3; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newGeometry?"); return TCL_ERROR; } - if (objc == 3) { - char buf[16 + TCL_INTEGER_SPACE * 4]; - int x, y; + if (objc == 3) { xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+'; ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+'; if (wmPtr->gridWin != NULL) { @@ -3811,17 +3773,17 @@ WmGeometryCmd( width = winPtr->changes.width; height = winPtr->changes.height; } - if(winPtr->flags & TK_EMBEDDED) { + if (winPtr->flags & TK_EMBEDDED) { int result = SendMessage(wmPtr->wrapper, TK_MOVEWINDOW, -1, -1); + wmPtr->x = result >> 16; wmPtr->y = result & 0x0000ffff; } - x = wmPtr->x; - y = wmPtr->y; - sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, x, ySign, y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d%c%d%c%d", + width, height, xSign, wmPtr->x, ySign, wmPtr->y)); return TCL_OK; } + argv3 = Tcl_GetString(objv[3]); if (*argv3 == '\0') { wmPtr->width = -1; @@ -3867,12 +3829,13 @@ WmGridCmd( } if (objc == 3) { if (wmPtr->sizeHintsFlags & PBaseSize) { - char buf[TCL_INTEGER_SPACE * 4]; + Tcl_Obj *results[4]; - sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth, - wmPtr->reqGridHeight, wmPtr->widthInc, - wmPtr->heightInc); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth); + results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight); + results[2] = Tcl_NewIntObj(wmPtr->widthInc); + results[3] = Tcl_NewIntObj(wmPtr->heightInc); + Tcl_SetObjResult(interp, Tcl_NewListObj(4, results)); } return TCL_OK; } @@ -3899,19 +3862,27 @@ WmGridCmd( return TCL_ERROR; } if (reqWidth < 0) { - Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "baseWidth can't be < 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (reqHeight < 0) { - Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "baseHeight can't be < 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (widthInc <= 0) { - Tcl_SetResult(interp, "widthInc can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "widthInc can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } if (heightInc <= 0) { - Tcl_SetResult(interp, "heightInc can't be <= 0", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "heightInc can't be <= 0", -1)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GRID", NULL); return TCL_ERROR; } Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc, @@ -3948,8 +3919,8 @@ WmGroupCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; Tk_Window tkwin2; - char *argv3; - int length; + const char *argv3; + size_t length; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?pathName?"); @@ -3957,11 +3928,12 @@ WmGroupCmd( } if (objc == 3) { if (wmPtr->hints.flags & WindowGroupHint) { - Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj(wmPtr->leaderName, -1)); } return TCL_OK; } - argv3 = Tcl_GetStringFromObj(objv[3], &length); + argv3 = Tcl_GetString(objv[3]); + length = objv[3]->length; if (*argv3 == '\0') { wmPtr->hints.flags &= ~WindowGroupHint; if (wmPtr->leaderName != NULL) { @@ -3978,8 +3950,8 @@ WmGroupCmd( } wmPtr->hints.window_group = Tk_WindowId(tkwin2); wmPtr->hints.flags |= WindowGroupHint; - wmPtr->leaderName = ckalloc((unsigned) (length + 1)); - strcpy(wmPtr->leaderName, argv3); + wmPtr->leaderName = ckalloc(length + 1); + memcpy(wmPtr->leaderName, argv3, length + 1); } return TCL_OK; } @@ -4011,7 +3983,7 @@ WmIconbitmapCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; TkWindow *useWinPtr = winPtr; /* window to apply to (NULL if -default) */ - char *string; + const char *string; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?-default? ?image?"); @@ -4021,11 +3993,12 @@ WmIconbitmapCmd( * If we have 5 arguments, we must have a '-default' flag. */ - char *argv3 = Tcl_GetString(objv[3]); + const char *argv3 = Tcl_GetString(objv[3]); if (strcmp(argv3, "-default")) { - Tcl_AppendResult(interp, "illegal option \"", argv3, - "\" must be \"-default\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "illegal option \"%s\" must be \"-default\"", argv3)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONBITMAP", "OPTION",NULL); return TCL_ERROR; } useWinPtr = NULL; @@ -4035,9 +4008,9 @@ WmIconbitmapCmd( */ if (wmPtr->hints.flags & IconPixmapHint) { - Tcl_SetResult(interp, (char *) + Tcl_SetObjResult(interp, Tcl_NewStringObj( Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap), - TCL_STATIC); + -1)); } return TCL_OK; } @@ -4096,6 +4069,7 @@ WmIconbitmapCmd( */ Pixmap pixmap; + Tcl_ResetResult(interp); pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr, string); if (pixmap == None) { @@ -4149,25 +4123,34 @@ WmIconifyCmd( return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { - if(!SendMessage(wmPtr->wrapper, TK_ICONIFY, 0, 0)) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": the container does not support the request", NULL); + if (!SendMessage(wmPtr->wrapper, TK_ICONIFY, 0, 0)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: the container does not support the request", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "EMBEDDED", NULL); return TCL_ERROR; } } if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT", + NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL); return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName, - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify %s: it is an icon for %s", + winPtr->pathName, Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "ICON", NULL); return TCL_ERROR; } TkpWmSetState(winPtr, IconicState); @@ -4201,7 +4184,7 @@ WmIconmaskCmd( { register WmInfo *wmPtr = winPtr->wmInfoPtr; Pixmap pixmap; - char *argv3; + const char *argv3; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?bitmap?"); @@ -4209,9 +4192,9 @@ WmIconmaskCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconMaskHint) { - Tcl_SetResult(interp, (char *) + Tcl_SetObjResult(interp, Tcl_NewStringObj( Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask), - TCL_STATIC); + -1)); } return TCL_OK; } @@ -4258,25 +4241,25 @@ WmIconnameCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; - int length; + const char *argv3; + size_t length; if (objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "window ?newName?"); return TCL_ERROR; } if (objc == 3) { - Tcl_SetResult(interp, - ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + (wmPtr->iconName ? wmPtr->iconName : ""), -1)); return TCL_OK; } else { if (wmPtr->iconName != NULL) { - ckfree((char *) wmPtr->iconName); + ckfree(wmPtr->iconName); } - argv3 = Tcl_GetStringFromObj(objv[3], &length); - wmPtr->iconName = ckalloc((unsigned) (length + 1)); - strcpy(wmPtr->iconName, argv3); + argv3 = Tcl_GetString(objv[3]); + length = objv[3]->length; + wmPtr->iconName = ckalloc(length + 1); + memcpy(wmPtr->iconName, argv3, length + 1); if (!(wmPtr->flags & WM_NEVER_MAPPED)) { XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName); } @@ -4314,7 +4297,7 @@ WmIconphotoCmd( Tk_PhotoImageBlock block; int i, width, height, idx, bufferSize, startObj = 3; union {unsigned char *ptr; void *voidPtr;} bgraPixel; - void *bgraMaskPtr; + union {unsigned char *ptr; void *voidPtr;} bgraMask; BlockOfIconImagesPtr lpIR; WinIconPtr titlebaricon = NULL; HICON hIcon; @@ -4344,8 +4327,10 @@ WmIconphotoCmd( for (i = startObj; i < objc; i++) { photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i])); if (photo == NULL) { - Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]), - "\" as iconphoto: not a photo image", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use \"%s\" as iconphoto: not a photo image", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "PHOTO", NULL); return TCL_ERROR; } } @@ -4356,7 +4341,7 @@ WmIconphotoCmd( */ size = sizeof(BlockOfIconImages) + (sizeof(ICONIMAGE) * (objc-startObj-1)); - lpIR = (BlockOfIconImagesPtr) attemptckalloc(size); + lpIR = attemptckalloc(size); if (lpIR == NULL) { return TCL_ERROR; } @@ -4371,18 +4356,19 @@ WmIconphotoCmd( /* * Don't use CreateIcon to create the icon, as it requires color - * bitmap data in device-dependent format. Instead we use - * CreateIconIndirect which takes device-independent bitmaps - * and converts them as required. Initialise icon info structure. + * bitmap data in device-dependent format. Instead we use + * CreateIconIndirect which takes device-independent bitmaps and + * converts them as required. Initialise icon info structure. */ - ZeroMemory( &iconInfo, sizeof iconInfo ); + ZeroMemory(&iconInfo, sizeof(iconInfo)); iconInfo.fIcon = TRUE; /* * Create device-independant color bitmap. */ - ZeroMemory(&bmInfo,sizeof bmInfo); + + ZeroMemory(&bmInfo, sizeof bmInfo); bmInfo.bmiHeader.biSize = sizeof(BITMAPINFOHEADER); bmInfo.bmiHeader.biWidth = width; bmInfo.bmiHeader.biHeight = -height; @@ -4390,18 +4376,21 @@ WmIconphotoCmd( bmInfo.bmiHeader.biBitCount = 32; bmInfo.bmiHeader.biCompression = BI_RGB; - iconInfo.hbmColor = CreateDIBSection( NULL, &bmInfo, - DIB_RGB_COLORS, &bgraPixel.voidPtr, NULL, 0 ); - if ( !iconInfo.hbmColor ) { - ckfree((char *) lpIR); - Tcl_AppendResult(interp, "failed to create color bitmap for \"", - Tcl_GetString(objv[i]), "\"", NULL); + iconInfo.hbmColor = CreateDIBSection(NULL, &bmInfo, DIB_RGB_COLORS, + &bgraPixel.voidPtr, NULL, 0); + if (!iconInfo.hbmColor) { + ckfree(lpIR); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "failed to create color bitmap for \"%s\"", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "BITMAP", NULL); return TCL_ERROR; } /* * Convert the photo image data into BGRA format (RGBQUAD). */ + bufferSize = height * width * 4; for (idx = 0 ; idx < bufferSize ; idx += 4) { bgraPixel.ptr[idx] = block.pixelPtr[idx+2]; @@ -4411,28 +4400,32 @@ WmIconphotoCmd( } /* - * Create a dummy mask bitmap. The contents of this don't - * appear to matter, as CreateIconIndirect will setup the icon - * mask based on the alpha channel in our color bitmap. + * Create a dummy mask bitmap. The contents of this don't appear to + * matter, as CreateIconIndirect will setup the icon mask based on the + * alpha channel in our color bitmap. */ + bmInfo.bmiHeader.biBitCount = 1; - iconInfo.hbmMask = CreateDIBSection( NULL, &bmInfo, - DIB_RGB_COLORS, &bgraMaskPtr, NULL, 0 ); - if ( !iconInfo.hbmMask ) { + iconInfo.hbmMask = CreateDIBSection(NULL, &bmInfo, DIB_RGB_COLORS, + &bgraMask.voidPtr, NULL, 0); + if (!iconInfo.hbmMask) { DeleteObject(iconInfo.hbmColor); - ckfree((char *) lpIR); - Tcl_AppendResult(interp, "failed to create mask bitmap for \"", - Tcl_GetString(objv[i]), "\"", NULL); + ckfree(lpIR); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "failed to create mask bitmap for \"%s\"", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "MASK", NULL); return TCL_ERROR; } - ZeroMemory( bgraMaskPtr, width*height/8 ); + ZeroMemory(bgraMask.ptr, width*height/8); /* * Create an icon from the bitmaps. */ - hIcon = CreateIconIndirect( &iconInfo); + + hIcon = CreateIconIndirect(&iconInfo); DeleteObject(iconInfo.hbmColor); DeleteObject(iconInfo.hbmMask); if (hIcon == NULL) { @@ -4440,9 +4433,11 @@ WmIconphotoCmd( * XXX should free up created icons. */ - ckfree((char *) lpIR); - Tcl_AppendResult(interp, "failed to create icon for \"", - Tcl_GetString(objv[i]), "\"", NULL); + ckfree(lpIR); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "failed to create icon for \"%s\"", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONPHOTO", "ICON", NULL); return TCL_ERROR; } lpIR->IconImages[i-startObj].Width = width; @@ -4451,7 +4446,7 @@ WmIconphotoCmd( lpIR->IconImages[i-startObj].hIcon = hIcon; } - titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance)); + titlebaricon = ckalloc(sizeof(WinIconInstance)); titlebaricon->iconBlock = lpIR; titlebaricon->refCount = 1; if (WinSetIcon(interp, titlebaricon, (Tk_Window) useWinPtr) != TCL_OK) { @@ -4499,11 +4494,11 @@ WmIconpositionCmd( } if (objc == 3) { if (wmPtr->hints.flags & IconPositionHint) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", wmPtr->hints.icon_x, - wmPtr->hints.icon_y); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x); + results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); } return TCL_OK; } @@ -4511,7 +4506,7 @@ WmIconpositionCmd( wmPtr->hints.flags &= ~IconPositionHint; } else { if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) - || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)){ + || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) { return TCL_ERROR; } wmPtr->hints.icon_x = x; @@ -4557,7 +4552,7 @@ WmIconwindowCmd( } if (objc == 3) { if (wmPtr->icon != NULL) { - Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj(wmPtr->icon)); } return TCL_OK; } @@ -4582,15 +4577,18 @@ WmIconwindowCmd( return TCL_ERROR; } if (!Tk_IsTopLevel(tkwin2)) { - Tcl_AppendResult(interp, "can't use ", Tcl_GetString(objv[3]), - " as icon window: not at top level", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use %s as icon window: not at top level", + Tcl_GetString(objv[3]))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "INNER", NULL); return TCL_ERROR; } wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr; if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, Tcl_GetString(objv[3]), - " is already an icon for ", Tk_PathName(wmPtr2->iconFor), - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s is already an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "ICONWINDOW", "ICON", NULL); return TCL_ERROR; } if (wmPtr->icon != NULL) { @@ -4646,21 +4644,22 @@ WmIconwindowCmd( */ static int -WmManageCmd(tkwin, winPtr, interp, objc, objv) - Tk_Window tkwin; /* Main window of the application. */ - TkWindow *winPtr; /* Toplevel or Frame to work with */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *const objv[]; /* Argument objects. */ +WmManageCmd( + Tk_Window tkwin, /* Main window of the application. */ + TkWindow *winPtr, /* Toplevel or Frame to work with */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - register Tk_Window frameWin = (Tk_Window)winPtr; + register Tk_Window frameWin = (Tk_Window) winPtr; register WmInfo *wmPtr = winPtr->wmInfoPtr; if (!Tk_IsTopLevel(frameWin)) { if (!Tk_IsManageable(frameWin)) { - Tcl_AppendResult(interp, "window \"", - Tk_PathName(frameWin), "\" is not manageable: must be " - "a frame, labelframe or toplevel", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" is not manageable: must be a frame," + " labelframe or toplevel", Tk_PathName(frameWin))); + Tcl_SetErrorCode(interp, "TK", "WM", "MANAGE", NULL); return TCL_ERROR; } TkFocusSplit(winPtr); @@ -4714,11 +4713,12 @@ WmMaxsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMaxSize(wmPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -4764,11 +4764,12 @@ WmMinsizeCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; GetMinSize(wmPtr, &width, &height); - sprintf(buf, "%d %d", width, height); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewIntObj(width); + results[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetIntFromObj(interp, objv[3], &width) != TCL_OK) @@ -4814,25 +4815,26 @@ WmOverrideredirectCmd( Tcl_WrongNumArgs(interp, 2, objv, "window ?boolean?"); return TCL_ERROR; } - if(winPtr->flags & TK_EMBEDDED) { + if (winPtr->flags & TK_EMBEDDED) { curValue = SendMessage(wmPtr->wrapper, TK_OVERRIDEREDIRECT, -1, -1)-1; if (curValue < 0) { - Tcl_AppendResult(interp, - "Container does not support overrideredirect", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Container does not support overrideredirect", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } else { curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect; } if (objc == 3) { - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(curValue)); return TCL_OK; } if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) { return TCL_ERROR; } if (curValue != boolean) { - if(winPtr->flags & TK_EMBEDDED) { + if (winPtr->flags & TK_EMBEDDED) { SendMessage(wmPtr->wrapper, TK_OVERRIDEREDIRECT, boolean, 0); } else { /* @@ -4844,7 +4846,7 @@ WmOverrideredirectCmd( Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect, &atts); if (!(wmPtr->flags & (WM_NEVER_MAPPED)) - && !(winPtr->flags & TK_EMBEDDED)) { + && !(winPtr->flags & TK_EMBEDDED)) { UpdateWrapper(winPtr); } } @@ -4878,7 +4880,7 @@ WmPositionfromCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "program", "user", NULL }; enum options { @@ -4891,18 +4893,21 @@ WmPositionfromCmd( return TCL_ERROR; } if (objc == 3) { + const char *sourceStr = ""; + if (wmPtr->sizeHintsFlags & USPosition) { - Tcl_SetResult(interp, "user", TCL_STATIC); + sourceStr = "user"; } else if (wmPtr->sizeHintsFlags & PPosition) { - Tcl_SetResult(interp, "program", TCL_STATIC); + sourceStr = "program"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1)); return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~(USPosition|PPosition); } else { - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_USER) { @@ -4945,8 +4950,9 @@ WmProtocolCmd( register WmInfo *wmPtr = winPtr->wmInfoPtr; register ProtocolHandler *protPtr, *prevPtr; Atom protocol; - char *cmd; - int cmdLength; + const char *cmd; + size_t cmdLength; + Tcl_Obj *resultObj; if ((objc < 3) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "window ?name? ?command?"); @@ -4957,11 +4963,13 @@ WmProtocolCmd( * Return a list of all defined protocols for the window. */ + resultObj = Tcl_NewObj(); for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { - Tcl_AppendElement(interp, - Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( + Tk_GetAtomName((Tk_Window)winPtr, protPtr->protocol), -1)); } + Tcl_SetObjResult(interp, resultObj); return TCL_OK; } protocol = Tk_InternAtom((Tk_Window) winPtr, Tcl_GetString(objv[3])); @@ -4973,7 +4981,8 @@ WmProtocolCmd( for (protPtr = wmPtr->protPtr; protPtr != NULL; protPtr = protPtr->nextPtr) { if (protPtr->protocol == protocol) { - Tcl_SetResult(interp, protPtr->command, TCL_STATIC); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(protPtr->command, -1)); return TCL_OK; } } @@ -4993,13 +5002,14 @@ WmProtocolCmd( } else { prevPtr->nextPtr = protPtr->nextPtr; } - Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(protPtr, TCL_DYNAMIC); break; } } - cmd = Tcl_GetStringFromObj(objv[4], &cmdLength); + cmd = Tcl_GetString(objv[4]); + cmdLength = objv[4]->length; if (cmdLength > 0) { - protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength)); + protPtr = ckalloc(HANDLER_SIZE(cmdLength)); protPtr->protocol = protocol; protPtr->nextPtr = wmPtr->protPtr; wmPtr->protPtr = protPtr; @@ -5042,12 +5052,11 @@ WmResizableCmd( return TCL_ERROR; } if (objc == 3) { - char buf[TCL_INTEGER_SPACE * 2]; + Tcl_Obj *results[2]; - sprintf(buf, "%d %d", - (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1, - (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + results[0] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE)); + results[1] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE)); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, results)); return TCL_OK; } if ((Tcl_GetBooleanFromObj(interp, objv[3], &width) != TCL_OK) @@ -5098,7 +5107,7 @@ WmSizefromCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "program", "user", NULL }; enum options { @@ -5111,19 +5120,22 @@ WmSizefromCmd( return TCL_ERROR; } if (objc == 3) { + const char *sourceStr = ""; + if (wmPtr->sizeHintsFlags & USSize) { - Tcl_SetResult(interp, "user", TCL_STATIC); + sourceStr = "user"; } else if (wmPtr->sizeHintsFlags & PSize) { - Tcl_SetResult(interp, "program", TCL_STATIC); + sourceStr = "program"; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(sourceStr, -1)); return TCL_OK; } if (*Tcl_GetString(objv[3]) == '\0') { wmPtr->sizeHintsFlags &= ~(USSize|PSize); } else { - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_USER) { @@ -5163,13 +5175,14 @@ WmStackorderCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - TkWindow **windows, **window_ptr; - static const char *optionStrings[] = { + TkWindow **windows, **windowPtr; + static const char *const optionStrings[] = { "isabove", "isbelow", NULL }; enum options { OPT_ISABOVE, OPT_ISBELOW }; + Tcl_Obj *resultObj; int index; if ((objc != 3) && (objc != 5)) { @@ -5181,16 +5194,19 @@ WmStackorderCmd( windows = TkWmStackorderToplevel(winPtr); if (windows == NULL) { Tcl_Panic("TkWmStackorderToplevel failed"); - } else { - for (window_ptr = windows; *window_ptr ; window_ptr++) { - Tcl_AppendElement(interp, (*window_ptr)->pathName); - } - ckfree((char *) windows); - return TCL_OK; } + + resultObj = Tcl_NewObj(); + for (windowPtr = windows; *windowPtr ; windowPtr++) { + Tcl_ListObjAppendElement(NULL, resultObj, + TkNewWindowObj((Tk_Window) *windowPtr)); + } + Tcl_SetObjResult(interp, resultObj); + ckfree(windows); + return TCL_OK; } else { TkWindow *winPtr2, **winPtr2Ptr = &winPtr2; - int index1=-1, index2=-1, result; + int index1 = -1, index2 = -1, result; if (TkGetWindowFromObj(interp, tkwin, objv[4], (Tk_Window *) winPtr2Ptr) != TCL_OK) { @@ -5198,20 +5214,24 @@ WmStackorderCmd( } if (!Tk_IsTopLevel(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't a top-level window", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't a top-level window", + winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "TOPLEVEL", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr)) { - Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } if (!Tk_IsMapped(winPtr2)) { - Tcl_AppendResult(interp, "window \"", winPtr2->pathName, - "\" isn't mapped", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window \"%s\" isn't mapped", winPtr2->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STACK", "MAPPED", NULL); return TCL_ERROR; } @@ -5221,31 +5241,31 @@ WmStackorderCmd( */ windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); - if (windows == NULL) { - Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "TkWmStackorderToplevel failed", -1)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; - } else { - for (window_ptr = windows; *window_ptr ; window_ptr++) { - if (*window_ptr == winPtr) { - index1 = (window_ptr - windows); - } - if (*window_ptr == winPtr2) { - index2 = (window_ptr - windows); - } - } - if (index1 == -1) { - Tcl_Panic("winPtr window not found"); + } + + for (windowPtr = windows; *windowPtr ; windowPtr++) { + if (*windowPtr == winPtr) { + index1 = (windowPtr - windows); } - if (index2 == -1) { - Tcl_Panic("winPtr2 window not found"); + if (*windowPtr == winPtr2) { + index2 = (windowPtr - windows); } - - ckfree((char *) windows); } + if (index1 == -1) { + Tcl_Panic("winPtr window not found"); + } else if (index2 == -1) { + Tcl_Panic("winPtr2 window not found"); + } + + ckfree(windows); - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_ISABOVE) { @@ -5253,10 +5273,9 @@ WmStackorderCmd( } else { /* OPT_ISBELOW */ result = index1 < index2; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), result); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } - return TCL_OK; } /* @@ -5285,7 +5304,7 @@ WmStateCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - static const char *optionStrings[] = { + static const char *const optionStrings[] = { "normal", "iconic", "withdrawn", "zoomed", NULL }; enum options { @@ -5299,13 +5318,14 @@ WmStateCmd( } if (objc == 4) { if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't change state of ", - Tcl_GetString(objv[2]), ": it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "ICON", NULL); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[3], optionStrings, "argument", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], optionStrings, + sizeof(char *), "argument", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -5330,9 +5350,10 @@ WmStateCmd( } if (state+1 != SendMessage(wmPtr->wrapper, TK_STATE, state, 0)) { - Tcl_AppendResult(interp, "can't change state of ", - winPtr->pathName, - ": the container does not support the request", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't change state of %s: the container does not support the request", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } return TCL_OK; @@ -5348,13 +5369,19 @@ WmStateCmd( */ } else if (index == OPT_ICONIC) { if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) { - Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName, - "\": override-redirect flag is set", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": override-redirect flag is set", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", + "OVERRIDE_REDIRECT", NULL); return TCL_ERROR; } if (wmPtr->masterPtr != NULL) { - Tcl_AppendResult(interp, "can't iconify \"", - winPtr->pathName, "\": it is a transient", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't iconify \"%s\": it is a transient", + winPtr->pathName)); + Tcl_SetErrorCode(interp, "TK", "WM", "STATE", "TRANSIENT", + NULL); return TCL_ERROR; } TkpWmSetState(winPtr, IconicState); @@ -5367,31 +5394,26 @@ WmStateCmd( Tcl_Panic("wm state not matched"); } } else { + const char *stateStr = ""; + if (wmPtr->iconFor != NULL) { - Tcl_SetResult(interp, "icon", TCL_STATIC); + stateStr = "icon"; } else { int state; if (winPtr->flags & TK_EMBEDDED) { - state = SendMessage(wmPtr->wrapper, TK_STATE, -1, -1)-1; + state = SendMessage(wmPtr->wrapper, TK_STATE, -1, -1) - 1; } else { state = wmPtr->hints.initial_state; } switch (state) { - case NormalState: - Tcl_SetResult(interp, "normal", TCL_STATIC); - break; - case IconicState: - Tcl_SetResult(interp, "iconic", TCL_STATIC); - break; - case WithdrawnState: - Tcl_SetResult(interp, "withdrawn", TCL_STATIC); - break; - case ZoomState: - Tcl_SetResult(interp, "zoomed", TCL_STATIC); - break; + case NormalState: stateStr = "normal"; break; + case IconicState: stateStr = "iconic"; break; + case WithdrawnState: stateStr = "withdrawn"; break; + case ZoomState: stateStr = "zoomed"; break; } } + Tcl_SetObjResult(interp, Tcl_NewStringObj(stateStr, -1)); } return TCL_OK; } @@ -5422,8 +5444,8 @@ WmTitleCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { register WmInfo *wmPtr = winPtr->wmInfoPtr; - char *argv3; - int length; + const char *argv3; + size_t length; HWND wrapper; if (objc > 4) { @@ -5431,39 +5453,41 @@ WmTitleCmd( return TCL_ERROR; } - if(winPtr->flags & TK_EMBEDDED) { - wrapper = (HWND)SendMessage(wmPtr->wrapper, TK_GETFRAMEWID, 0, 0); + if (winPtr->flags & TK_EMBEDDED) { + wrapper = (HWND) SendMessage(wmPtr->wrapper, TK_GETFRAMEWID, 0, 0); } else { wrapper = wmPtr->wrapper; } if (objc == 3) { if (wrapper) { - char buf[512]; + TCHAR buf[256]; Tcl_DString titleString; - int size = tkWinProcs->useWide ? 256 : 512; + int size = 256; - (*tkWinProcs->getWindowText)(wrapper, (LPCTSTR)buf, size); + GetWindowText(wrapper, buf, size); Tcl_WinTCharToUtf(buf, -1, &titleString); - Tcl_SetResult(interp, Tcl_DStringValue(&titleString),TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_DStringValue(&titleString), + Tcl_DStringLength(&titleString))); Tcl_DStringFree(&titleString); } else { - Tcl_SetResult(interp, (char *) - ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid), - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + (wmPtr->title ? wmPtr->title : winPtr->nameUid), -1)); } } else { if (wmPtr->title != NULL) { - ckfree((char *) wmPtr->title); + ckfree(wmPtr->title); } - argv3 = Tcl_GetStringFromObj(objv[3], &length); - wmPtr->title = ckalloc((unsigned) (length + 1)); - strcpy(wmPtr->title, argv3); + argv3 = Tcl_GetString(objv[3]); + length = objv[3]->length; + wmPtr->title = ckalloc(length + 1); + memcpy(wmPtr->title, argv3, length + 1); if (!(wmPtr->flags & WM_NEVER_MAPPED) && wmPtr->wrapper != NULL) { Tcl_DString titleString; + Tcl_WinUtfToTChar(wmPtr->title, -1, &titleString); - (*tkWinProcs->setWindowText)(wrapper, - (LPCTSTR) Tcl_DStringValue(&titleString)); + SetWindowText(wrapper, (LPCTSTR) Tcl_DStringValue(&titleString)); Tcl_DStringFree(&titleString); } } @@ -5505,7 +5529,7 @@ WmTransientCmd( } if (objc == 3) { if (masterPtr != NULL) { - Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC); + Tcl_SetObjResult(interp, TkNewWindowObj((Tk_Window) masterPtr)); } return TCL_OK; } @@ -5519,7 +5543,7 @@ WmTransientCmd( masterPtr->wmInfoPtr->numTransients--; Tk_DeleteEventHandler((Tk_Window) masterPtr, VisibilityChangeMask|StructureNotifyMask, - WmWaitVisibilityOrMapProc, (ClientData) winPtr); + WmWaitVisibilityOrMapProc, winPtr); } wmPtr->masterPtr = NULL; @@ -5538,24 +5562,27 @@ WmTransientCmd( Tk_MakeWindowExist((Tk_Window) masterPtr); if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[2]), - "\" a transient: it is an icon for ", - Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a transient: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } wmPtr2 = masterPtr->wmInfoPtr; if (wmPtr2->iconFor != NULL) { - Tcl_AppendResult(interp, "can't make \"", Tcl_GetString(objv[3]), - "\" a master: it is an icon for ", - Tk_PathName(wmPtr2->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" a master: it is an icon for %s", + Tcl_GetString(objv[3]), Tk_PathName(wmPtr2->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL); return TCL_ERROR; } if (masterPtr == winPtr) { - Tcl_AppendResult(interp, "can't make \"", Tk_PathName(winPtr), - "\" its own master", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't make \"%s\" its own master", Tk_PathName(winPtr))); + Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL); return TCL_ERROR; } else if (masterPtr != wmPtr->masterPtr) { /* @@ -5568,21 +5595,21 @@ WmTransientCmd( wmPtr->masterPtr->wmInfoPtr->numTransients--; Tk_DeleteEventHandler((Tk_Window) wmPtr->masterPtr, VisibilityChangeMask|StructureNotifyMask, - WmWaitVisibilityOrMapProc, (ClientData) winPtr); + WmWaitVisibilityOrMapProc, winPtr); } masterPtr->wmInfoPtr->numTransients++; Tk_CreateEventHandler((Tk_Window) masterPtr, VisibilityChangeMask|StructureNotifyMask, - WmWaitVisibilityOrMapProc, (ClientData) winPtr); + WmWaitVisibilityOrMapProc, winPtr); wmPtr->masterPtr = masterPtr; } } if (!((wmPtr->flags & WM_NEVER_MAPPED) && !(winPtr->flags & TK_EMBEDDED))) { - if (wmPtr->masterPtr != NULL && - !Tk_IsMapped(wmPtr->masterPtr)) { + if (wmPtr->masterPtr != NULL + && !Tk_IsMapped(wmPtr->masterPtr)) { TkpWmSetState(winPtr, WithdrawnState); } else { UpdateWrapper(winPtr); @@ -5623,15 +5650,19 @@ WmWithdrawCmd( return TCL_ERROR; } if (wmPtr->iconFor != NULL) { - Tcl_AppendResult(interp, "can't withdraw ", Tcl_GetString(objv[2]), - ": it is an icon for ", Tk_PathName(wmPtr->iconFor), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't withdraw %s: it is an icon for %s", + Tcl_GetString(objv[2]), Tk_PathName(wmPtr->iconFor))); + Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL); return TCL_ERROR; } if (winPtr->flags & TK_EMBEDDED) { if (SendMessage(wmPtr->wrapper, TK_WITHDRAW, 0, 0) < 0) { - Tcl_AppendResult(interp, "can't withdraw", Tcl_GetString(objv[2]), - ": the container does not support the request", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't withdraw %s: the container does not support the request", + Tcl_GetString(objv[2]))); + Tcl_SetErrorCode(interp, "TK", "WM", "COMMUNICATION", NULL); return TCL_ERROR; } } else { @@ -5652,7 +5683,7 @@ WmUpdateGeom( TkWindow *winPtr) { if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } @@ -5663,7 +5694,7 @@ WmWaitVisibilityOrMapProc( ClientData clientData, /* Pointer to window. */ XEvent *eventPtr) /* Information about event. */ { - TkWindow *winPtr = (TkWindow *) clientData; + TkWindow *winPtr = clientData; TkWindow *masterPtr = winPtr->wmInfoPtr->masterPtr; if (masterPtr == NULL) @@ -5792,7 +5823,7 @@ Tk_SetGrid( wmPtr->heightInc = heightInc; wmPtr->sizeHintsFlags |= PBaseSize|PResizeInc; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } @@ -5852,7 +5883,7 @@ Tk_UnsetGrid( wmPtr->heightInc = 1; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } } @@ -5880,7 +5911,7 @@ TopLevelEventProc( ClientData clientData, /* Window for which event occurred. */ XEvent *eventPtr) /* Event that just happened. */ { - register TkWindow *winPtr = (TkWindow *) clientData; + register TkWindow *winPtr = clientData; if (eventPtr->type == DestroyNotify) { Tk_ErrorHandler handler; @@ -5895,7 +5926,7 @@ TopLevelEventProc( */ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1, - (Tk_ErrorProc *) NULL, (ClientData) NULL); + NULL, NULL); Tk_DestroyWindow((Tk_Window) winPtr); Tk_DeleteErrorHandler(handler); } @@ -5971,7 +6002,7 @@ UpdateGeometryInfo( int width, height; /* Size of client area. */ int min, max; RECT rect; - register TkWindow *winPtr = (TkWindow *) clientData; + register TkWindow *winPtr = clientData; register WmInfo *wmPtr = winPtr->wmInfoPtr; wmPtr->flags &= ~WM_UPDATE_PENDING; @@ -6247,7 +6278,7 @@ UpdateGeometryInfo( static int ParseGeometry( Tcl_Interp *interp, /* Used for error reporting. */ - char *string, /* String containing new geometry. Has the + const char *string, /* String containing new geometry. Has the * standard form "=wxh+x+y". */ TkWindow *winPtr) /* Pointer to top-level window whose geometry * is to be changed. */ @@ -6255,7 +6286,7 @@ ParseGeometry( register WmInfo *wmPtr = winPtr->wmInfoPtr; int x, y, width, height, flags; char *end; - register char *p = string; + register const char *p = string; /* * The leading "=" is optional. @@ -6328,7 +6359,7 @@ ParseGeometry( * them. */ - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; } } @@ -6347,13 +6378,15 @@ ParseGeometry( wmPtr->flags = flags; if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } return TCL_OK; error: - Tcl_AppendResult(interp, "bad geometry specifier \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad geometry specifier \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "GEOMETRY", NULL); return TCL_ERROR; } @@ -6520,7 +6553,7 @@ Tk_MoveToplevelWindow( wmPtr->y = y; wmPtr->flags |= WM_MOVE_PENDING; wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y); - if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) { + if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) { wmPtr->sizeHintsFlags |= USPosition; } @@ -6532,9 +6565,9 @@ Tk_MoveToplevelWindow( if (!(wmPtr->flags & WM_NEVER_MAPPED)) { if (wmPtr->flags & WM_UPDATE_PENDING) { - Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); } - UpdateGeometryInfo((ClientData) winPtr); + UpdateGeometryInfo(winPtr); } } @@ -6582,18 +6615,18 @@ TkWmProtocolEventProc( const char *name = Tk_GetAtomName((Tk_Window) winPtr, protocol); - Tcl_Preserve((ClientData) protPtr); + Tcl_Preserve(protPtr); interp = protPtr->interp; - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL); if (result != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n (command for \""); - Tcl_AddErrorInfo(interp, name); - Tcl_AddErrorInfo(interp, "\" window manager protocol)"); - Tcl_BackgroundError(interp); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (command for \"%s\" window manager protocol)", + name)); + Tcl_BackgroundException(interp, result); } - Tcl_Release((ClientData) interp); - Tcl_Release((ClientData) protPtr); + Tcl_Release(interp); + Tcl_Release(protPtr); return; } } @@ -6640,7 +6673,7 @@ TkWmStackorderToplevelEnumProc( hPtr = Tcl_FindHashEntry(pair->table, (char *) hwnd); if (hPtr != NULL) { - childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr); + childWinPtr = Tcl_GetHashValue(hPtr); /* * Double check that same HWND does not get passed twice. @@ -6655,7 +6688,7 @@ TkWmStackorderToplevelEnumProc( fprintf(stderr, "Found mapped HWND %d -> %x (%s)\n", hwnd, childWinPtr, childWinPtr->pathName); */ - *(pair->window_ptr)-- = childWinPtr; + *(pair->windowPtr)-- = childWinPtr; } return TRUE; } @@ -6688,8 +6721,8 @@ TkWmStackorderToplevelWrapperMap( HWND wrapper; int newEntry; - if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr) && - !Tk_IsEmbedded(winPtr) && (winPtr->display == display)) { + if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr) + && !Tk_IsEmbedded(winPtr) && (winPtr->display == display)) { wrapper = TkWinGetWrapperWindow((Tk_Window) winPtr); /* @@ -6740,8 +6773,7 @@ TkWmStackorderToplevel( Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS); TkWmStackorderToplevelWrapperMap(parentPtr, parentPtr->display, &table); - windows = (TkWindow **) ckalloc((table.numEntries+1) - * sizeof(TkWindow *)); + windows = ckalloc((table.numEntries+1) * sizeof(TkWindow *)); /* * Special cases: If zero or one toplevels were mapped there is no need to @@ -6754,7 +6786,7 @@ TkWmStackorderToplevel( goto done; case 1: hPtr = Tcl_FirstHashEntry(&table, &search); - windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr); + windows[0] = Tcl_GetHashValue(hPtr); windows[1] = NULL; goto done; } @@ -6766,14 +6798,14 @@ TkWmStackorderToplevel( */ pair.table = &table; - pair.window_ptr = windows + table.numEntries; - *pair.window_ptr-- = NULL; + pair.windowPtr = windows + table.numEntries; + *pair.windowPtr-- = NULL; if (EnumWindows((WNDENUMPROC) TkWmStackorderToplevelEnumProc, (LPARAM) &pair) == 0) { - ckfree((char *) windows); + ckfree(windows); windows = NULL; - } else if (pair.window_ptr != (windows-1)) { + } else if (pair.windowPtr != (windows-1)) { Tcl_Panic("num matched toplevel windows does not equal num children"); } @@ -6840,7 +6872,7 @@ TkWmRestackToplevel( if (winPtr->flags & TK_EMBEDDED) { SendMessage(winPtr->wmInfoPtr->wrapper, TK_RAISEWINDOW, - (WPARAM)insertAfter, aboveBelow); + (WPARAM) insertAfter, aboveBelow); } else { TkWinSetWindowPos(hwnd, insertAfter, aboveBelow); } @@ -6919,7 +6951,7 @@ TkWmAddToColormapWindows( * Automatically add the toplevel itself as the last element of the list. */ - newPtr = (TkWindow **) ckalloc((unsigned) ((count+2)*sizeof(TkWindow*))); + newPtr = ckalloc((count+2) * sizeof(TkWindow *)); if (count > 0) { memcpy(newPtr, oldPtr, count * sizeof(TkWindow*)); } @@ -6929,7 +6961,7 @@ TkWmAddToColormapWindows( newPtr[count-1] = winPtr; newPtr[count] = topPtr; if (oldPtr != NULL) { - ckfree((char *) oldPtr); + ckfree(oldPtr); } topPtr->wmInfoPtr->cmapList = newPtr; @@ -7061,12 +7093,12 @@ TkWinSetMenu( } if (!(winPtr->flags & TK_EMBEDDED)) { if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING|WM_MOVE_PENDING; } } else { - SendMessage(wmPtr->wrapper, TK_SETMENU, - (WPARAM)hMenu, (LPARAM)Tk_GetMenuHWND(tkwin)); + SendMessage(wmPtr->wrapper, TK_SETMENU, (WPARAM) hMenu, + (LPARAM) Tk_GetMenuHWND(tkwin)); } } @@ -7146,7 +7178,7 @@ ConfigureTopLevel( */ if (!(wmPtr->flags & WM_UPDATE_PENDING)) { - Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); + Tcl_DoWhenIdle(UpdateGeometryInfo, winPtr); wmPtr->flags |= WM_UPDATE_PENDING; } /* fall through */ @@ -7349,7 +7381,7 @@ InstallColormaps( ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - if (winPtr == NULL || (winPtr->flags & TK_ALREADY_DEAD) ) { + if (winPtr == NULL || (winPtr->flags & TK_ALREADY_DEAD)) { return 0; } @@ -7379,11 +7411,9 @@ InstallColormaps( SelectPalette(dc, oldPalette, TRUE); RealizePalette(dc); ReleaseDC(hwnd, dc); - SendMessage(hwnd, WM_PALETTECHANGED, (WPARAM)hwnd, - (LPARAM)NULL); + SendMessage(hwnd, WM_PALETTECHANGED, (WPARAM) hwnd, (LPARAM) NULL); return TRUE; } - } else { /* * Window is being notified of a change in the system palette. If this @@ -7845,7 +7875,7 @@ WmProc( break; case WM_ACTIVATE: - if ( WA_ACTIVE == LOWORD(wParam) ) { + if (WA_ACTIVE == LOWORD(wParam)) { winPtr = GetTopLevel(hwnd); if (winPtr && (TkGrabState(winPtr) == TK_GRAB_EXCLUDED)) { /* @@ -7922,7 +7952,7 @@ WmProc( case WM_PALETTECHANGED: result = InstallColormaps(hwnd, WM_PALETTECHANGED, - hwnd == (HWND)wParam); + hwnd == (HWND) wParam); goto done; case WM_QUERYNEWPALETTE: @@ -7968,8 +7998,7 @@ WmProc( * 2272] */ - result = (*tkWinProcs->defWindowProc)(hwnd, message, - wParam, lParam); + result = DefWindowProc(hwnd, message, wParam, lParam); goto done; } @@ -8043,7 +8072,7 @@ WmProc( case WM_ENTERIDLE: case WM_INITMENUPOPUP: if (winPtr) { - HWND hMenuHWnd = Tk_GetEmbeddedMenuHWND((Tk_Window)winPtr); + HWND hMenuHWnd = Tk_GetEmbeddedMenuHWND((Tk_Window) winPtr); if (hMenuHWnd) { if (SendMessage(hMenuHWnd, message, wParam, lParam)) { @@ -8065,11 +8094,10 @@ WmProc( result = 0; } else if (!Tk_TranslateWinEvent(child, message, wParam, lParam, &result)) { - result = (*tkWinProcs->defWindowProc)(hwnd, message, - wParam, lParam); + result = DefWindowProc(hwnd, message, wParam, lParam); } } else { - result = (*tkWinProcs->defWindowProc)(hwnd, message, wParam, lParam); + result = DefWindowProc(hwnd, message, wParam, lParam); } done: @@ -8115,8 +8143,8 @@ TkpMakeMenuWindow( if ((atts.override_redirect != Tk_Attributes(tkwin)->override_redirect) || (atts.save_under != Tk_Attributes(tkwin)->save_under)) { - Tk_ChangeWindowAttributes(tkwin, - CWOverrideRedirect|CWSaveUnder, &atts); + Tk_ChangeWindowAttributes(tkwin, CWOverrideRedirect|CWSaveUnder, + &atts); } } @@ -8141,8 +8169,9 @@ HWND TkWinGetWrapperWindow( Tk_Window tkwin) /* The window we need the wrapper from */ { - TkWindow *winPtr = (TkWindow *)tkwin; - return (winPtr->wmInfoPtr->wrapper); + TkWindow *winPtr = (TkWindow *) tkwin; + + return winPtr->wmInfoPtr->wrapper; } /* @@ -8218,8 +8247,8 @@ TkpGetWrapperWindow( static void GenerateActivateEvent(TkWindow * winPtr, const int *flagPtr) { - ActivateEvent *eventPtr; - eventPtr = (ActivateEvent *)ckalloc(sizeof(ActivateEvent)); + ActivateEvent *eventPtr = ckalloc(sizeof(ActivateEvent)); + eventPtr->ev.proc = ActivateWindow; eventPtr->winPtr = winPtr; eventPtr->flagPtr = flagPtr; @@ -8352,6 +8381,7 @@ TkpWinToplevelWithDraw( TkWindow *winPtr) { register WmInfo *wmPtr = winPtr->wmInfoPtr; + wmPtr->flags |= WM_WITHDRAWN; TkpWmSetState(winPtr, WithdrawnState); } @@ -8411,10 +8441,10 @@ TkpWinToplevelDeiconify( * deiconified by TkpWmSetState. Don't bother if we've never been mapped. */ - if ((wmPtr->flags & WM_UPDATE_PENDING) && - !(wmPtr->flags & WM_NEVER_MAPPED)) { - Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr); - UpdateGeometryInfo((ClientData) winPtr); + if ((wmPtr->flags & WM_UPDATE_PENDING) + && !(wmPtr->flags & WM_NEVER_MAPPED)) { + Tcl_CancelIdleCall(UpdateGeometryInfo, winPtr); + UpdateGeometryInfo(winPtr); } /* @@ -8471,11 +8501,10 @@ TkpWinToplevelIsControlledByWm( { register WmInfo *wmPtr = winPtr->wmInfoPtr; - if (wmPtr) { - return ((wmPtr->width != -1) && (wmPtr->height != -1))? 1:0; - } else { + if (!wmPtr) { return 0; } + return ((wmPtr->width != -1) && (wmPtr->height != -1)) ? 1 : 0; } /* @@ -8503,7 +8532,7 @@ TkpWinToplevelMove( register WmInfo *wmPtr = winPtr->wmInfoPtr; if (wmPtr && x >= 0 && y >= 0 && !TkpWinToplevelIsControlledByWm(winPtr)) { - Tk_MoveToplevelWindow((Tk_Window)winPtr, x, y); + Tk_MoveToplevelWindow((Tk_Window) winPtr, x, y); } return ((winPtr->changes.x << 16) & 0xffff0000) | (winPtr->changes.y & 0xffff); @@ -8535,7 +8564,9 @@ TkpWinToplevelOverrideRedirect( register WmInfo *wmPtr = winPtr->wmInfoPtr; curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect; - if(reqValue < 0) return curValue; + if (reqValue < 0) { + return curValue; + } if (curValue != reqValue) { XSetWindowAttributes atts; @@ -8601,8 +8632,7 @@ TkpWinToplevelDetachWindow( * * RemapWindows * - * Adjust parent/child relation ships of - * the given window hierarchy. + * Adjust parent/child relation ships of the given window hierarchy. * * Results: * none @@ -8614,14 +8644,17 @@ TkpWinToplevelDetachWindow( */ static void -RemapWindows(winPtr, parentHWND) - TkWindow *winPtr; - HWND parentHWND; +RemapWindows( + TkWindow *winPtr, + HWND parentHWND) { TkWindow *childPtr; const char *className = Tk_Class(winPtr); - /* Skip Menus as they are handled differently */ + /* + * Skip menus as they are handled differently. + */ + if (className != NULL && strcmp(className, "Menu") == 0) { return; } @@ -8629,9 +8662,12 @@ RemapWindows(winPtr, parentHWND) SetParent(Tk_GetHWND(winPtr->window), parentHWND); } - /* Repeat for all the children */ + /* + * Repeat for all the children. + */ + for (childPtr = winPtr->childList; childPtr != NULL; - childPtr = childPtr->nextPtr) { + childPtr = childPtr->nextPtr) { RemapWindows(childPtr, winPtr->window ? Tk_GetHWND(winPtr->window) : NULL); } diff --git a/win/tkWinX.c b/win/tkWinX.c index cbd6032..6c44059 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -11,14 +11,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -/* - * Make sure the SendInput API is available (NT SP 3): - */ -#if (_WIN32_WINNT <= 0x0400) -#undef _WIN32_WINNT -#define _WIN32_WINNT 0x0403 -#endif - #include "tkWinInt.h" /* @@ -28,7 +20,7 @@ */ #ifndef _WIN32_IE -#define _WIN32_IE 0x0501 /* IE 5 */ +#define _WIN32_IE 0x0550 /* IE 5.5 */ #endif #include <commctrl.h> @@ -61,49 +53,11 @@ #define UNICODE_NOCHAR 0xFFFF #endif -static TkWinProcs asciiProcs = { - 0, - - (LRESULT (WINAPI *)(WNDPROC lpPrevWndFunc, HWND hWnd, UINT Msg, - WPARAM wParam, LPARAM lParam)) CallWindowProcA, - (LRESULT (WINAPI *)(HWND hWnd, UINT Msg, WPARAM wParam, - LPARAM lParam)) DefWindowProcA, - (ATOM (WINAPI *)(CONST WNDCLASS *lpWndClass)) RegisterClassA, - (BOOL (WINAPI *)(HWND hWnd, LPCTSTR lpString)) SetWindowTextA, - (HWND (WINAPI *)(DWORD dwExStyle, LPCTSTR lpClassName, - LPCTSTR lpWindowName, DWORD dwStyle, int x, int y, - int nWidth, int nHeight, HWND hWndParent, HMENU hMenu, - HINSTANCE hInstance, LPVOID lpParam)) CreateWindowExA, - (BOOL (WINAPI *)(HMENU hMenu, UINT uPosition, UINT uFlags, - UINT uIDNewItem, LPCTSTR lpNewItem)) InsertMenuA, - (int (WINAPI *)(HWND hWnd, LPCTSTR lpString, int nMaxCount)) GetWindowTextA, -}; - -static TkWinProcs unicodeProcs = { - 1, - - (LRESULT (WINAPI *)(WNDPROC lpPrevWndFunc, HWND hWnd, UINT Msg, - WPARAM wParam, LPARAM lParam)) CallWindowProcW, - (LRESULT (WINAPI *)(HWND hWnd, UINT Msg, WPARAM wParam, - LPARAM lParam)) DefWindowProcW, - (ATOM (WINAPI *)(CONST WNDCLASS *lpWndClass)) RegisterClassW, - (BOOL (WINAPI *)(HWND hWnd, LPCTSTR lpString)) SetWindowTextW, - (HWND (WINAPI *)(DWORD dwExStyle, LPCTSTR lpClassName, - LPCTSTR lpWindowName, DWORD dwStyle, int x, int y, - int nWidth, int nHeight, HWND hWndParent, HMENU hMenu, - HINSTANCE hInstance, LPVOID lpParam)) CreateWindowExW, - (BOOL (WINAPI *)(HMENU hMenu, UINT uPosition, UINT uFlags, - UINT uIDNewItem, LPCTSTR lpNewItem)) InsertMenuW, - (int (WINAPI *)(HWND hWnd, LPCTSTR lpString, int nMaxCount)) GetWindowTextW, -}; - -TkWinProcs *tkWinProcs; - /* * Declarations of static variables used in this file. */ -static char winScreenName[] = ":0"; /* Default name of windows display. */ +static const char winScreenName[] = ":0"; /* Default name of windows display. */ static HINSTANCE tkInstance = NULL; /* Application instance handle. */ static int childClassInitialized; /* Registered child class? */ static WNDCLASS childClass; /* Window class for child windows. */ @@ -191,7 +145,7 @@ TkGetServerInfo( ); buffer[0] = 'W'; } - Tcl_SetResult(interp, buffer, TCL_STATIC); + Tcl_AppendResult(interp, buffer, NULL); } /* @@ -278,12 +232,6 @@ TkWinXInit( Tcl_Panic("Unable to load common controls?!"); } - if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - tkWinProcs = &unicodeProcs; - } else { - tkWinProcs = &asciiProcs; - } - childClass.style = CS_HREDRAW | CS_VREDRAW; childClass.cbClsExtra = 0; childClass.cbWndExtra = 0; @@ -376,9 +324,10 @@ TkWinXCleanup( * * Results: * The return value is one of: - * VER_PLATFORM_WIN32s Win32s on Windows 3.1. - * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95. - * VER_PLATFORM_WIN32_NT Win32 on Windows NT + * VER_PLATFORM_WIN32s Win32s on Windows 3.1 (not supported) + * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME (not supported) + * VER_PLATFORM_WIN32_NT Win32 on Windows XP, Vista, Windows 7, Windows 8 + * VER_PLATFORM_WIN32_CE Win32 on Windows CE * * Side effects: * None. @@ -405,8 +354,8 @@ TkWinGetPlatformId(void) if ((os.dwPlatformId == VER_PLATFORM_WIN32_NT) && (os.dwMajorVersion == 5 && os.dwMinorVersion == 1)) { HKEY hKey; - LPCSTR szSubKey = TEXT("Control Panel\\Appearance"); - LPCSTR szCurrent = TEXT("Current"); + LPCTSTR szSubKey = TEXT("Control Panel\\Appearance"); + LPCTSTR szCurrent = TEXT("Current"); DWORD dwSize = 200; char pBuffer[200]; @@ -474,10 +423,10 @@ TkWinGetPlatformTheme(void) *---------------------------------------------------------------------- */ -CONST char * +const char * TkGetDefaultScreenName( Tcl_Interp *interp, /* Not used. */ - CONST char *screenName) /* If NULL, use default string. */ + const char *screenName) /* If NULL, use default string. */ { if ((screenName == NULL) || (screenName[0] == '\0')) { screenName = winScreenName; @@ -535,9 +484,9 @@ TkWinDisplayChanged( screen->root_depth = GetDeviceCaps(dc, BITSPIXEL) * PTR2INT(screen->ext_data); if (screen->root_visual != NULL) { - ckfree((char *) screen->root_visual); + ckfree(screen->root_visual); } - screen->root_visual = (Visual *) ckalloc(sizeof(Visual)); + screen->root_visual = ckalloc(sizeof(Visual)); screen->root_visual->visualid = 0; if (GetDeviceCaps(dc, RASTERCAPS) & RC_PALETTE) { screen->root_visual->map_entries = GetDeviceCaps(dc, SIZEPALETTE); @@ -599,12 +548,12 @@ TkWinDisplayChanged( TkDisplay * TkpOpenDisplay( - CONST char *display_name) + const char *display_name) { Screen *screen; TkWinDrawable *twdPtr; Display *display; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->winDisplay != NULL) { @@ -615,10 +564,10 @@ TkpOpenDisplay( } } - display = (Display *) ckalloc(sizeof(Display)); + display = ckalloc(sizeof(Display)); ZeroMemory(display, sizeof(Display)); - display->display_name = (char *) ckalloc(strlen(display_name)+1); + display->display_name = ckalloc(strlen(display_name) + 1); strcpy(display->display_name, display_name); display->cursor_font = 1; @@ -626,7 +575,7 @@ TkpOpenDisplay( display->request = 1; display->qlen = 0; - screen = (Screen *) ckalloc(sizeof(Screen)); + screen = ckalloc(sizeof(Screen)); ZeroMemory(screen, sizeof(Screen)); screen->display = display; @@ -634,7 +583,7 @@ TkpOpenDisplay( * Set up the root window. */ - twdPtr = (TkWinDrawable*) ckalloc(sizeof(TkWinDrawable)); + twdPtr = ckalloc(sizeof(TkWinDrawable)); if (twdPtr == NULL) { return None; } @@ -657,7 +606,7 @@ TkpOpenDisplay( TkWinDisplayChanged(display); - tsdPtr->winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay)); + tsdPtr->winDisplay = ckalloc(sizeof(TkDisplay)); ZeroMemory(tsdPtr->winDisplay, sizeof(TkDisplay)); tsdPtr->winDisplay->display = display; tsdPtr->updatingClipboard = FALSE; @@ -702,17 +651,17 @@ TkpCloseDisplay( } if (display->screens != NULL) { if (display->screens->root_visual != NULL) { - ckfree((char *) display->screens->root_visual); + ckfree(display->screens->root_visual); } if (display->screens->root != None) { - ckfree((char *) display->screens->root); + ckfree(display->screens->root); } if (display->screens->cmap != None) { XFreeColormap(display, display->screens->cmap); } - ckfree((char *) display->screens); + ckfree(display->screens); } - ckfree((char *) display); + ckfree(display); } /* @@ -1017,7 +966,23 @@ GenerateXEvent( ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - winPtr = (TkWindow *)Tk_HWNDToWindow(hwnd); + if (message == WM_MOUSEWHEEL) { + union {LPARAM lParam; POINTS point;} root; + POINT pos; + root.lParam = lParam; + + /* + * Redirect mousewheel events to the window containing the cursor. + * That feels much less strange to users, and is how all the other + * platforms work. + */ + + pos.x = root.point.x; + pos.y = root.point.y; + hwnd = WindowFromPoint(pos); + } + + winPtr = (TkWindow *) Tk_HWNDToWindow(hwnd); if (!winPtr || winPtr->window == None) { return; } @@ -1116,11 +1081,6 @@ GenerateXEvent( break; case WM_MOUSEWHEEL: - /* - * The mouse wheel event is closer to a key event than a mouse event - * in that the message is sent to the window that has focus. - */ - case WM_CHAR: case WM_UNICHAR: case WM_SYSKEYDOWN: @@ -1399,12 +1359,12 @@ GetTranslatedKey( xkey->nbytes = 0; while ((xkey->nbytes < XMaxTransChars) - && PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) { + && PeekMessageA(&msg, NULL, 0, 0, PM_NOREMOVE)) { if ((msg.message != WM_CHAR) && (msg.message != WM_SYSCHAR)) { break; } - GetMessage(&msg, NULL, 0, 0); + GetMessageA(&msg, NULL, 0, 0); /* * If this is a normal character message, we may need to strip off the @@ -1575,7 +1535,6 @@ HandleIMEComposition( { HIMC hIMC; int n; - BOOL isWinNT = (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT); if ((lParam & GCS_RESULTSTR) == 0) { /* @@ -1590,47 +1549,15 @@ HandleIMEComposition( return 0; } - if (isWinNT) { - n = ImmGetCompositionStringW(hIMC, GCS_RESULTSTR, NULL, 0); - } else { - n = ImmGetCompositionStringA(hIMC, GCS_RESULTSTR, NULL, 0); - } + n = ImmGetCompositionString(hIMC, GCS_RESULTSTR, NULL, 0); if (n > 0) { - char *buff = ckalloc((unsigned) n); + char *buff = ckalloc(n); TkWindow *winPtr; XEvent event; int i; - if (isWinNT) { - n = ImmGetCompositionStringW(hIMC, GCS_RESULTSTR, buff, - (unsigned) n); - } else { - Tcl_DString utfString, unicodeString; - Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding(); - - n = ImmGetCompositionStringA(hIMC, GCS_RESULTSTR, buff, - (unsigned) n); - Tcl_DStringInit(&utfString); - Tcl_ExternalToUtfDString(keyInputEncoding, buff, n, &utfString); - Tcl_UtfToExternalDString(unicodeEncoding, - Tcl_DStringValue(&utfString), -1, &unicodeString); - i = Tcl_DStringLength(&unicodeString); - if (n < i) { - /* - * Only alloc more space if we need, otherwise just use what - * we've created. Don't realloc as that may copy data we no - * longer need. - */ - - ckfree((char *) buff); - buff = (char *) ckalloc((unsigned) i); - } - n = i; - memcpy(buff, Tcl_DStringValue(&unicodeString), (unsigned) n); - Tcl_DStringFree(&utfString); - Tcl_DStringFree(&unicodeString); - } + n = ImmGetCompositionString(hIMC, GCS_RESULTSTR, buff, (unsigned) n); /* * Set up the fields pertinent to key event. @@ -1943,32 +1870,10 @@ long Tk_GetUserInactiveTime( Display *dpy) /* Ignored on Windows */ { - struct tagLASTINPUTINFO { - UINT cbSize; - DWORD dwTime; - } li; + LASTINPUTINFO li; - /* - * Multiple settings of either of these variables should be OK; any thread - * hazards should just cause inefficiency... - */ - - static FARPROC pfnGetLastInputInfo = NULL; - static int initinfo = 0; - - if (!initinfo) { - HMODULE hMod = GetModuleHandleA("USER32.DLL"); - - initinfo = 1; - if (hMod){ - pfnGetLastInputInfo = GetProcAddress(hMod, "GetLastInputInfo"); - } - } - if (pfnGetLastInputInfo == NULL) { - return -1; - } li.cbSize = sizeof(li); - if (!(BOOL)(pfnGetLastInputInfo)(&li)) { + if (!(BOOL)GetLastInputInfo(&li)) { return -1; } diff --git a/win/ttkWinMonitor.c b/win/ttkWinMonitor.c index 25c9c0c..c6e906b 100644 --- a/win/ttkWinMonitor.c +++ b/win/ttkWinMonitor.c @@ -74,7 +74,7 @@ CreateThemeMonitorWindow(HINSTANCE hinst, Tcl_Interp *interp) HWND hwnd = NULL; TCHAR title[32] = TEXT("TtkMonitorWindow"); TCHAR name[32] = TEXT("TtkMonitorClass"); - + wc.cbSize = sizeof(WNDCLASSEX); wc.style = CS_HREDRAW | CS_VREDRAW; wc.lpfnWndProc = (WNDPROC)WndProc; @@ -92,14 +92,14 @@ CreateThemeMonitorWindow(HINSTANCE hinst, Tcl_Interp *interp) hwnd = CreateWindow( name, title, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, NULL, NULL, hinst, NULL ); - SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR)interp); + SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) interp); ShowWindow(hwnd, SW_HIDE); UpdateWindow(hwnd); } return hwnd; } -static void +static void DestroyThemeMonitorWindow(void *clientData) { HWND hwnd = (HWND)clientData; diff --git a/win/ttkWinTheme.c b/win/ttkWinTheme.c index e0a0eda..63e9704 100644 --- a/win/ttkWinTheme.c +++ b/win/ttkWinTheme.c @@ -490,7 +490,7 @@ static void TroughClientDataDeleteProc(void *clientData) static TroughClientData *TroughClientDataInit(Tcl_Interp *interp) { - TroughClientData *cd = (TroughClientData*)ckalloc(sizeof(*cd)); + TroughClientData *cd = ckalloc(sizeof(*cd)); cd->PatternBitmap = CreateBitmap(8, 8, 1, 1, Pattern); cd->PatternBrush = CreatePatternBrush(cd->PatternBitmap); Ttk_RegisterCleanup(interp, cd, TroughClientDataDeleteProc); diff --git a/win/ttkWinXPTheme.c b/win/ttkWinXPTheme.c index 6359891..08569a3 100644 --- a/win/ttkWinXPTheme.c +++ b/win/ttkWinXPTheme.c @@ -106,7 +106,7 @@ LoadXPThemeProcs(HINSTANCE *phlib) * We have successfully loaded the library. Proceed in storing the * addresses of the functions we want to use. */ - XPThemeProcs *procs = (XPThemeProcs*)ckalloc(sizeof(XPThemeProcs)); + XPThemeProcs *procs = ckalloc(sizeof(XPThemeProcs)); #define LOADPROC(name) \ (0 != (procs->name = (name ## Proc *)GetProcAddress(handle, #name) )) @@ -124,7 +124,7 @@ LoadXPThemeProcs(HINSTANCE *phlib) return procs; } #undef LOADPROC - ckfree((char*)procs); + ckfree(procs); } return 0; } @@ -411,7 +411,7 @@ typedef struct static ElementData * NewElementData(XPThemeProcs *procs, ElementInfo *info) { - ElementData *elementData = (ElementData*)ckalloc(sizeof(ElementData)); + ElementData *elementData = ckalloc(sizeof(ElementData)); elementData->procs = procs; elementData->info = info; @@ -429,10 +429,10 @@ static void DestroyElementData(void *clientData) { ElementData *elementData = clientData; if (elementData->info->flags & HEAP_ELEMENT) { - ckfree((char *)elementData->info->statemap); - ckfree((char *)elementData->info->className); - ckfree((char *)elementData->info->elementName); - ckfree((char *)elementData->info); + ckfree(elementData->info->statemap); + ckfree(elementData->info->className); + ckfree(elementData->info->elementName); + ckfree(elementData->info); } ckfree(clientData); } @@ -1062,13 +1062,14 @@ GetSysFlagFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr) if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) return TCL_ERROR; if (objc != 2) { - Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args", -1)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } for (i = 0; i < objc; ++i) { int option; - if (Tcl_GetIndexFromObj(interp, objv[i], names, "system constant", 0, &option) - != TCL_OK) + if (Tcl_GetIndexFromObjStruct(interp, objv[i], names, + sizeof(char *), "system constant", 0, &option) != TCL_OK) return TCL_ERROR; *resultPtr |= (flags[option] << (8 * (1 - i))); } @@ -1116,8 +1117,9 @@ Ttk_CreateVsapiElement( O_HALFHEIGHT, O_HALFWIDTH }; if (objc < 2) { - Tcl_AppendResult(interp, - "missing required arguments 'class' and/or 'partId'", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing required arguments 'class' and/or 'partId'", -1)); + Tcl_SetErrorCode(interp, "TTK", "VSAPI", "REQUIRED", NULL); return TCL_ERROR; } @@ -1132,12 +1134,14 @@ Ttk_CreateVsapiElement( for (i = 3; i < objc; i += 2) { int tmp = 0; if (i == objc -1) { - Tcl_AppendResult(interp, "Missing value for \"", - Tcl_GetString(objv[i]), "\".", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Missing value for \"%s\".", + Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TTK", "VSAPI", "MISSING", NULL); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, - "option", 0, &option) != TCL_OK) + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings, + sizeof(char *), "option", 0, &option) != TCL_OK) return TCL_ERROR; switch (option) { case O_PADDING: @@ -1197,8 +1201,7 @@ Ttk_CreateVsapiElement( if (Tcl_ListObjGetElements(interp, objv[2], &count, &specs) != TCL_OK) return TCL_ERROR; /* we over-allocate to ensure there is a terminating entry */ - stateTable = (Ttk_StateTable *) - ckalloc(sizeof(Ttk_StateTable) * (count + 1)); + stateTable = ckalloc(sizeof(Ttk_StateTable) * (count + 1)); memset(stateTable, 0, sizeof(Ttk_StateTable) * (count + 1)); for (n = 0, j = 0; status == TCL_OK && n < count; n += 2, ++j) { Ttk_StateSpec spec = {0,0}; @@ -1211,15 +1214,15 @@ Ttk_CreateVsapiElement( } } if (status != TCL_OK) { - ckfree((char *)stateTable); + ckfree(stateTable); return status; } } else { - stateTable = (Ttk_StateTable *)ckalloc(sizeof(Ttk_StateTable)); + stateTable = ckalloc(sizeof(Ttk_StateTable)); memset(stateTable, 0, sizeof(Ttk_StateTable)); } - elementPtr = (ElementInfo *)ckalloc(sizeof(ElementInfo)); + elementPtr = ckalloc(sizeof(ElementInfo)); elementPtr->elementSpec = elementSpec; elementPtr->partId = partId; elementPtr->statemap = stateTable; @@ -1232,7 +1235,7 @@ Ttk_CreateVsapiElement( elementPtr->elementName = name; /* set the class name to an allocated copy */ - wname = (LPWSTR) ckalloc(sizeof(WCHAR) * (length + 1)); + wname = ckalloc(sizeof(WCHAR) * (length + 1)); wcscpy(wname, className); elementPtr->className = wname; @@ -1279,7 +1282,7 @@ MODULE_SCOPE int TtkXPTheme_Init(Tcl_Interp *interp, HWND hwnd) * Set theme data and cleanup proc */ - themeData = (XPThemeData *)ckalloc(sizeof(XPThemeData)); + themeData = ckalloc(sizeof(XPThemeData)); themeData->procs = procs; themeData->hlibrary = hlibrary; diff --git a/win/winMain.c b/win/winMain.c index 01a5e23..62bcbd8 100644 --- a/win/winMain.c +++ b/win/winMain.c @@ -1,29 +1,29 @@ /* * winMain.c -- * - * Main entry point for wish and other Tk-based applications. + * Provides a default version of the main program and Tcl_AppInit + * procedure for wish and other Tk-based applications. * - * Copyright (c) 1995-1997 Sun Microsystems, Inc. - * Copyright (c) 1998-1999 by Scriptics Corporation. + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tkInt.h" +#include "tk.h" #define WIN32_LEAN_AND_MEAN #include <windows.h> #undef WIN32_LEAN_AND_MEAN #include <locale.h> +#include <stdlib.h> +#include <tchar.h> #if defined(__GNUC__) int _CRT_glob = 0; #endif /* __GNUC__ */ -/* - * The following declarations refer to internal Tk routines. These interfaces - * are available for use, but are not supported. - */ #ifdef TK_TEST extern Tcl_PackageInitProc Tktest_Init; #endif /* TK_TEST */ @@ -34,12 +34,14 @@ extern Tcl_PackageInitProc Dde_Init; extern Tcl_PackageInitProc Dde_SafeInit; #endif +#ifdef TCL_BROKEN_MAINARGS +static void setargv(int *argcPtr, TCHAR ***argvPtr); +#endif + /* * Forward declarations for procedures defined later in this file: */ -static void WishPanic(CONST char *format, ...); - static BOOL consoleRequired = TRUE; /* @@ -51,7 +53,10 @@ static BOOL consoleRequired = TRUE; #ifndef TK_LOCAL_APPINIT #define TK_LOCAL_APPINIT Tcl_AppInit #endif -extern int TK_LOCAL_APPINIT(Tcl_Interp *interp); +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif +MODULE_SCOPE int TK_LOCAL_APPINIT(Tcl_Interp *interp); /* * The following #if block allows you to change how Tcl finds the startup @@ -60,13 +65,17 @@ extern int TK_LOCAL_APPINIT(Tcl_Interp *interp); */ #ifdef TK_LOCAL_MAIN_HOOK -extern int TK_LOCAL_MAIN_HOOK(int *argc, char ***argv); +MODULE_SCOPE int TK_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); #endif + +/* Make sure the stubbed variants of those are never used. */ +#undef Tcl_ObjSetVar2 +#undef Tcl_NewStringObj /* *---------------------------------------------------------------------- * - * WinMain -- + * _tWinMain -- * * Main entry point from Windows. * @@ -80,17 +89,23 @@ extern int TK_LOCAL_MAIN_HOOK(int *argc, char ***argv); */ int APIENTRY +#ifdef TCL_BROKEN_MAINARGS WinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpszCmdLine, int nCmdShow) +#else +_tWinMain( + HINSTANCE hInstance, + HINSTANCE hPrevInstance, + LPTSTR lpszCmdLine, + int nCmdShow) +#endif { - char **argv; + TCHAR **argv; int argc; - char *p; - - Tcl_SetPanicProc(WishPanic); + TCHAR *p; /* * Create the console channels and install them as the standard channels. @@ -111,8 +126,12 @@ WinMain( * Get our args from the c-runtime. Ignore lpszCmdLine. */ +#if defined(TCL_BROKEN_MAINARGS) + setargv(&argc, &argv); +#else argc = __argc; - argv = __argv; + argv = __targv; +#endif /* * Forward slashes substituted for backslashes. @@ -129,7 +148,7 @@ WinMain( #endif Tk_Main(argc, argv, TK_LOCAL_APPINIT); - return 1; + return 0; /* Needed only to prevent compiler warning. */ } /* @@ -155,14 +174,11 @@ int Tcl_AppInit( Tcl_Interp *interp) /* Interpreter for application. */ { -#define TK_MAX_WARN_LEN 1024 - WCHAR msgString[TK_MAX_WARN_LEN + 5]; - - if (Tcl_Init(interp) == TCL_ERROR) { - goto error; + if ((Tcl_Init)(interp) == TCL_ERROR) { + return TCL_ERROR; } if (Tk_Init(interp) == TCL_ERROR) { - goto error; + return TCL_ERROR; } Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); @@ -173,26 +189,26 @@ Tcl_AppInit( if (consoleRequired) { if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) { - goto error; + return TCL_ERROR; } } #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES if (Registry_Init(interp) == TCL_ERROR) { - goto error; + return TCL_ERROR; } - Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); + Tcl_StaticPackage(interp, "registry", Registry_Init, 0); if (Dde_Init(interp) == TCL_ERROR) { - goto error; + return TCL_ERROR; } - Tcl_StaticPackage(interp, "dde", Dde_Init, NULL); + Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); #endif #ifdef TK_TEST if (Tktest_Init(interp) == TCL_ERROR) { - goto error; + return TCL_ERROR; } - Tcl_StaticPackage(interp, "Tktest", Tktest_Init, NULL); + Tcl_StaticPackage(interp, "Tktest", Tktest_Init, 0); #endif /* TK_TEST */ /* @@ -208,7 +224,7 @@ Tcl_AppInit( */ /* - * Call Tcl_CreateCommand for application-specific commands, if they + * Call Tcl_CreateObjCommand for application-specific commands, if they * weren't already created by the init procedures called above. */ @@ -219,76 +235,16 @@ Tcl_AppInit( * specific startup file will be run under any conditions. */ - Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/wishrc.tcl", -1), TCL_GLOBAL_ONLY); return TCL_OK; - -error: - MultiByteToWideChar(CP_UTF8, 0, Tcl_GetStringResult(interp), -1, - msgString, TK_MAX_WARN_LEN); - /* - * Truncate MessageBox string if it is too long to not overflow the screen - * and cause possible oversized window error. - */ - memcpy(msgString + TK_MAX_WARN_LEN, L" ...", 5 * sizeof(WCHAR)); - MessageBeep(MB_ICONEXCLAMATION); - MessageBoxW(NULL, msgString, L"Error in Wish", - MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); - ExitProcess(1); - - /* - * We won't reach this, but we need the return. - */ - - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * WishPanic -- - * - * Display a message and exit. - * - * Results: - * None. - * - * Side effects: - * Exits the program. - * - *---------------------------------------------------------------------- - */ - -void -WishPanic( - CONST char *format, ...) -{ - va_list argList; - char buf[TK_MAX_WARN_LEN]; - WCHAR msgString[TK_MAX_WARN_LEN + 5]; - - va_start(argList, format); - vsprintf(buf, format, argList); - - MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TK_MAX_WARN_LEN); - /* - * Truncate MessageBox string if it is too long to not overflow the screen - * and cause possible oversized window error. - */ - memcpy(msgString + TK_MAX_WARN_LEN, L" ...", 5 * sizeof(WCHAR)); - MessageBeep(MB_ICONEXCLAMATION); - MessageBoxW(NULL, msgString, L"Fatal Error in Wish", - MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND); -#ifdef _MSC_VER - DebugBreak(); -#endif - ExitProcess(1); } #if defined(TK_TEST) /* *---------------------------------------------------------------------- * - * main -- + * _tmain -- * * Main entry point from the console. * @@ -302,13 +258,20 @@ WishPanic( *---------------------------------------------------------------------- */ +#ifdef TCL_BROKEN_MAINARGS int main( int argc, - char **argv) + char **dummy) { - Tcl_SetPanicProc(WishPanic); - + TCHAR **argv; +#else +int +_tmain( + int argc, + TCHAR **argv) +{ +#endif /* * Set up the default locale to be standard "C" locale so parsing is * performed correctly. @@ -316,6 +279,13 @@ main( setlocale(LC_ALL, "C"); +#ifdef TCL_BROKEN_MAINARGS + /* + * Get our args from the c-runtime. Ignore argc/argv. + */ + + setargv(&argc, &argv); +#endif /* * Console emulation widget not required as this entry is from the * console subsystem, thus stdin,out,err already have end-points. @@ -323,10 +293,140 @@ main( consoleRequired = FALSE; +#ifdef TK_LOCAL_MAIN_HOOK + TK_LOCAL_MAIN_HOOK(&argc, &argv); +#endif + Tk_Main(argc, argv, Tcl_AppInit); return 0; } -#endif /* TK_TEST */ +#endif /* !__GNUC__ || TK_TEST */ + + +/* + *------------------------------------------------------------------------- + * + * setargv -- + * + * Parse the Windows command line string into argc/argv. Done here + * because we don't trust the builtin argument parser in crt0. Windows + * applications are responsible for breaking their command line into + * arguments. + * + * 2N backslashes + quote -> N backslashes + begin quoted string + * 2N + 1 backslashes + quote -> literal + * N backslashes + non-quote -> literal + * quote + quote in a quoted string -> single quote + * quote + quote not in quoted string -> empty string + * quote -> begin quoted string + * + * Results: + * Fills argcPtr with the number of arguments and argvPtr with the array + * of arguments. + * + * Side effects: + * Memory allocated. + * + *-------------------------------------------------------------------------- + */ + +#ifdef TCL_BROKEN_MAINARGS +static void +setargv( + int *argcPtr, /* Filled with number of argument strings. */ + TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */ +{ + TCHAR *cmdLine, *p, *arg, *argSpace; + TCHAR **argv; + int argc, size, inquote, copy, slashes; + + cmdLine = GetCommandLine(); + + /* + * Precompute an overly pessimistic guess at the number of arguments in + * the command line by counting non-space spans. + */ + + size = 2; + for (p = cmdLine; *p != '\0'; p++) { + if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + size++; + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + p++; + } + if (*p == '\0') { + break; + } + } + } + + /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ + #undef Tcl_Alloc + #undef Tcl_DbCkalloc + + argSpace = ckalloc(size * sizeof(char *) + + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); + argv = (TCHAR **) argSpace; + argSpace += size * (sizeof(char *)/sizeof(TCHAR)); + size--; + + p = cmdLine; + for (argc = 0; argc < size; argc++) { + argv[argc] = arg = argSpace; + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + p++; + } + if (*p == '\0') { + break; + } + + inquote = 0; + slashes = 0; + while (1) { + copy = 1; + while (*p == '\\') { + slashes++; + p++; + } + if (*p == '"') { + if ((slashes & 1) == 0) { + copy = 0; + if ((inquote) && (p[1] == '"')) { + p++; + copy = 1; + } else { + inquote = !inquote; + } + } + slashes >>= 1; + } + + while (slashes) { + *arg = '\\'; + arg++; + slashes--; + } + + if ((*p == '\0') || (!inquote && + ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ + break; + } + if (copy != 0) { + *arg = *p; + arg++; + } + p++; + } + *arg = '\0'; + argSpace = arg + 1; + } + argv[argc] = NULL; + + *argcPtr = argc; + *argvPtr = argv; +} +#endif /* TCL_BROKEN_MAINARGS */ + /* * Local Variables: * mode: c diff --git a/xlib/rgb.txt b/xlib/rgb.txt index 3b7ba4d..7a4f983 100644 --- a/xlib/rgb.txt +++ b/xlib/rgb.txt @@ -3,9 +3,14 @@ ! aqua - 0 255 255 ! crimson - 220 20 60 ! fuchsia - 255 0 255 +! gray 190 190 190 128 128 128 +! green 0 255 0 0 128 0 +! grey 190 190 190 128 128 128 ! indigo - 75 0 130 ! lime - 0 255 0 +! maroon 176 48 96 128 0 0 ! olive - 128 128 0 +! purple 160 32 240 128 0 128 ! silver - 192 192 192 ! teal - 0 128 128 ! @@ -162,7 +167,7 @@ 238 180 34 goldenrod2 205 155 29 goldenrod3 139 105 20 goldenrod4 -190 190 190 gray +128 128 128 gray 3 3 3 gray1 5 5 5 gray2 8 8 8 gray3 @@ -264,13 +269,13 @@ 252 252 252 gray99 255 255 255 gray100 0 0 0 gray0 - 0 255 0 green + 0 128 0 green 0 255 0 green1 0 238 0 green2 0 205 0 green3 0 139 0 green4 173 255 47 greenYellow -190 190 190 grey +128 128 128 grey 3 3 3 grey1 5 5 5 grey2 8 8 8 grey3 @@ -467,7 +472,7 @@ 238 0 238 magenta2 205 0 205 magenta3 139 0 139 magenta4 -176 48 96 maroon +128 0 0 maroon 255 52 179 maroon1 238 48 167 maroon2 205 41 144 maroon3 @@ -560,7 +565,7 @@ 205 150 205 plum3 139 102 139 plum4 176 224 230 powderBlue -160 32 240 purple +128 0 128 purple 155 48 255 purple1 145 44 238 purple2 125 38 205 purple3 diff --git a/xlib/xcolors.c b/xlib/xcolors.c index 66591c7..b5e45c9 100644 --- a/xlib/xcolors.c +++ b/xlib/xcolors.c @@ -105,12 +105,12 @@ static const elem xColors[] = { "old\0 \213\165\000\315\255\000\356\311\000\377\327\000\377\327\000\4", "oldenrod\0 \213\151\024\315\233\035\356\264\042\377\301\045\332\245\040\4", "ray\0\024\024\024\022\022\022\017\017\017\015\015\015\012\012\012" - "\010\010\010\005\005\005\003\003\003\276\276\276\10", + "\010\010\010\005\005\005\003\003\003\200\200\200\10", "ray0\0 \000\000\000", - "reen\0 \000\213\000\000\315\000\000\356\000\000\377\000\000\377\000\4", + "reen\0 \000\213\000\000\315\000\000\356\000\000\377\000\000\200\000\4", "reenYellow\0 \255\377\057", "rey\0\024\024\024\022\022\022\017\017\017\015\015\015\012\012\012" - "\010\010\010\005\005\005\003\003\003\276\276\276\10", + "\010\010\010\005\005\005\003\003\003\200\200\200\10", "rey0\0 \000\000\000", /* Colors starting with 'h' */ "oneydew\0 \203\213\203\301\315\301\340\356\340\360\377\360\360\377\360\4", @@ -150,7 +150,7 @@ static const elem xColors[] = { "inen\0 \372\360\346", /* Colors starting with 'm' */ "agenta\0 \213\000\213\315\000\315\356\000\356\377\000\377\377\000\377\4", - "aroon\0 \213\034\142\315\051\220\356\060\247\377\064\263\260\060\140\4", + "aroon\0 \213\034\142\315\051\220\356\060\247\377\064\263\200\000\000\4", "ediumAquamarine\0 \146\315\252", "ediumBlue\0 \000\000\315", "ediumOrchid\0 \172\067\213\264\122\315\321\137\356\340\146\377\272\125\323\4", @@ -186,7 +186,7 @@ static const elem xColors[] = { "ink\0 \213\143\154\315\221\236\356\251\270\377\265\305\377\300\313\4", "lum\0 \213\146\213\315\226\315\356\256\356\377\273\377\335\240\335\4", "owderBlue\0 \260\340\346", - "urple\0 \125\032\213\175\046\315\221\054\356\233\060\377\240\040\360\4", + "urple\0 \125\032\213\175\046\315\221\054\356\233\060\377\200\000\200\4", /* Colors starting with 'q' */ "\377" /* placeholder */, /* Colors starting with 'r' */ @@ -12,7 +12,7 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include <tkInt.h> +#include "tkInt.h" #if !defined(MAC_OSX_TK) # include <X11/Xlib.h> @@ -51,7 +51,7 @@ static TkpClipMask *AllocClipMask(GC gc) { TkpClipMask *clip_mask = (TkpClipMask*) gc->clip_mask; if (clip_mask == None) { - clip_mask = (TkpClipMask*) ckalloc(sizeof(TkpClipMask)); + clip_mask = ckalloc(sizeof(TkpClipMask)); gc->clip_mask = (Pixmap) clip_mask; #ifdef MAC_OSX_TK } else if (clip_mask->type == TKP_CLIP_REGION) { @@ -84,7 +84,7 @@ static void FreeClipMask(GC gc) { TkpReleaseRegion(((TkpClipMask*) gc->clip_mask)->value.region); } #endif - ckfree((char*) gc->clip_mask); + ckfree(gc->clip_mask); gc->clip_mask = None; } } @@ -123,8 +123,7 @@ XCreateGC( #define MAX_DASH_LIST_SIZE 10 - gp = (XGCValues *) ckalloc(sizeof(XGCValues) + MAX_DASH_LIST_SIZE + - gcCacheSize); + gp = ckalloc(sizeof(XGCValues) + MAX_DASH_LIST_SIZE + gcCacheSize); if (!gp) { return None; } @@ -272,7 +271,7 @@ int XFreeGC( if (gc != None) { FreeClipMask(gc); TkpFreeGCCache(gc); - ckfree((char *) gc); + ckfree(gc); } return Success; } diff --git a/xlib/xutil.c b/xlib/xutil.c index 267a624..0514d7a 100644 --- a/xlib/xutil.c +++ b/xlib/xutil.c @@ -68,7 +68,8 @@ XGetVisualInfo( XVisualInfo *vinfo_template, int *nitems_return) { - XVisualInfo *info = (XVisualInfo *) ckalloc(sizeof(XVisualInfo)); + XVisualInfo *info = ckalloc(sizeof(XVisualInfo)); + info->visual = DefaultVisual(display, 0); info->visualid = info->visual->visualid; info->screen = 0; @@ -99,7 +100,7 @@ XGetVisualInfo( || ((vinfo_mask & VisualBlueMaskMask) && (vinfo_template->blue_mask != info->blue_mask)) ) { - ckfree((char *) info); + ckfree(info); return NULL; } |